prolog source code

You selected metric_k.pl

% metric_k.pl
% preference evolution and the minimal distances by Kemeny
% date: 2007.6.30-7.2,4-6
% revised: 2007.8.25-27 (excerpt of the basic part of metric01b.pl)

% reference
% Gaertner, W. (2006). 
% A Primer in Social Choice Theory, Oxford Univrsity Press.

% preliminary

:- [metric_d].


% the Kemeny's distance
%--------------------------------------------------------------

% Kemeny's distance for a given alternative 
% and a profile = the minimal number of reversals 
% in order to the profile to be a unanimity.

% <=> the number of asymmetric differences in orderings.


unanimity(RR,R):- sort(RR,[R]).

distance(kemeny(0),R->R,[],[]):-
   rr(R),unanimity(R,_).

distance(kemeny(K),R->Q,[(J,XY,Q0)|H],[D|Z]):-
   trial_step(K),
   K0 is K- 1, length(H,K0),
   malleable(Q->Q0,J,XY),
   majority(Q->D),
%   disagree_index(_,Q,D),
   distance(kemeny(K0),R->Q0,H,Z),
   \+ member((_,_,Q),H).

/*

?- distance(kemeny(0),R->Q0,H,Z).

K0 = 0
R = [[+, +, +], [+, +, +], [+, +, +]]
Q0 = [[+, +, +], [+, +, +], [+, +, +]]
H = []
Z = [] 

Yes
?- distance(kemeny(1),R->Q0,H,Z).

R = [[+, +, +], [+, +, +], [+, +, +]]
Q0 = [[-, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[+, +, +], [+, +, +], [+, +, +]])]
Z = [[+, +, +]] ;

R = [[+, +, +], [+, +, +], [+, +, +]]
Q0 = [[+, +, -], [+, +, +], [+, +, +]]
H = [ (1, (b, c), [[+, +, +], [+, +, +], [+, +, +]])]
Z = [[+, +, +]] ;

R = [[+, +, +], [+, +, +], [+, +, +]]
Q0 = [[+, +, +], [-, +, +], [+, +, +]]
H = [ (2, (a, b), [[+, +, +], [+, +, +], [+, +, +]])]
Z = [[+, +, +]] 

Yes
?- distance(kemeny(3),R->Q0,H,Z).

R = [[-, +, +], [-, +, +], [-, +, +]]
Q0 = [[+, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[-, +, +], [+, +, +], [+, +, +]]), (2, (a, b), [[-, +, +], [-, +, +], [+, +|...]]), (3, (a, b), [[-, +, +], [-, +|...], [-|...]])]
Z = [[+, +, +], [+, +, +], [-, +, +]] 

Yes
?- distance(kemeny(6),R->Q0,H,Z).

R = [[-, -, +], [-, -, +], [-, -, +]]
Q0 = [[+, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[-, +, +], [+, +, +], [+, +, +]]), (1, (a, c), [[-, -, +], [+, +, +], [+, +|...]]), (2, (a, b), [[-, -, +], [-, +|...], [+|...]]), (2, (a, c), [[-, -|...], [-|...], [...|...]]), (3, (a, b), [[-|...], [...|...]|...]), (3, (a, c), [[...|...]|...])]
Z = [[+, +, +], [+, +, +], [+, +, +], [-, +, +], [-, -, +], [-, -, +]] 

Yes
?-
*/

% the minimal distance
%--------------------------------------------------------------

distance(kemeny(min,K),R->Q,H,Z):-
   rr(Q),
   distance(kemeny1(K),R->Q,H,Z).

distance(kemeny1(K),R->Q,H,Z):-
   distance(kemeny(K),R->Q,H,Z),
   !.

/*

?- distance(kemeny(min,K),R->Q,H,Z).

K = 0
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, +, +], [+, +, +], [+, +, +]]
H = []
Z = [] ;

K = 1
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[+, +, +], [+, +, +], [+, +, +]])]
Z = [[+, +, +]] ;

K = 2
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, -, +], [+, +, +], [+, +, +]]
H = [ (1, (a, c), [[-, +, +], [+, +, +], [+, +, +]]), (1, (a, b), [[+, +, +], [+, +, +], [+, +|...]])]
Z = [[+, +, +], [+, +, +]] ;

K = 1
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, +, -], [+, +, +], [+, +, +]]
H = [ (1, (b, c), [[+, +, +], [+, +, +], [+, +, +]])]
Z = [[+, +, +]] ;

K = 2
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, -, -], [+, +, +], [+, +, +]]
H = [ (1, (a, c), [[+, +, -], [+, +, +], [+, +, +]]), (1, (b, c), [[+, +, +], [+, +, +], [+, +|...]])]
Z = [[+, +, +], [+, +, +]] 

Yes
?- distance(kemeny(min,K),R->Q,H,Z),K>3.

K = 4
R = [[-, -, +], [-, -, +], [-, -, +]]
Q = [[+, -, -], [-, -, +], [+, +, +]]
H = [ (1, (a, b), [[-, -, -], [-, -, +], [+, +, +]]), (1, (b, c), [[-, -, +], [-, -, +], [+, +|...]]), (3, (a, b), [[-, -, +], [-, -|...], [-|...]]), (3, (a, c), [[-, -|...], [-|...], [...|...]])]
Z = [[+, -, +], [-, -, +], [-, -, +], [-, -, +]] 

Yes
?- distance(kemeny(min,K),R->Q,H,Z),K>4.

No
?- Q=[[+, -, -], [-, -, +], [+, +, +]],
distance(kemeny(min,K),R->Q,H,Z),
forall(member(U,H),(nl,write(U))).

1, (a, b), [[-, -, -], [-, -, +], [+, +, +]]
1, (b, c), [[-, -, +], [-, -, +], [+, +, +]]
3, (a, b), [[-, -, +], [-, -, +], [-, +, +]]
3, (a, c), [[-, -, +], [-, -, +], [-, -, +]]

Q = [[+, -, -], [-, -, +], [+, +, +]]
K = 4
R = [[-, -, +], [-, -, +], [-, -, +]]
H = [ (1, (a, b), [[-, -, -], [-, -, +], [+, +, +]]), (1, (b, c), [[-, -, +], [-, -, +], [+, +|...]]), (3, (a, b), [[-, -, +], [-, -|...], [-|...]]), (3, (a, c), [[-, -|...], [-|...], [...|...]])]
Z = [[+, -, +], [-, -, +], [-, -, +], [-, -, +]]
U = _G210 

Yes
?- distance(kemeny(min,K),R->Q,H,Z),K=0, sort(R,U),nl,write(Q;U;K),fail.

[[+, +, +], [+, +, +], [+, +, +]];[[+, +, +]];0
[[-, +, +], [-, +, +], [-, +, +]];[[-, +, +]];0
[[-, -, +], [-, -, +], [-, -, +]];[[-, -, +]];0
[[+, +, -], [+, +, -], [+, +, -]];[[+, +, -]];0
[[+, -, -], [+, -, -], [+, -, -]];[[+, -, -]];0
[[-, -, -], [-, -, -], [-, -, -]];[[-, -, -]];0

No
?- rr(Q),\+ distance(kemeny(min,K),R->Q,H,Z),nl,write(Q),fail.

No
?- 

*/


/*
% the case of weak ordering

?- chdom(_->t:Q).

Q = transitive 

Yes
?- distance(kemeny(min,K),R->Q,H,Z),K>4.

No
?- Q=[[+, -, -], [-, -, +], [+, +, +]],
distance(kemeny(min,K),R->Q,H,Z),
forall(member(U,H),(nl,write(U))).

1, (a, b), [[-, -, -], [-, -, +], [+, +, +]]
1, (b, c), [[-, -, +], [-, -, +], [+, +, +]]
3, (a, b), [[-, -, +], [-, -, +], [-, +, +]]
3, (a, c), [[-, -, +], [-, -, +], [-, -, +]]

Q = [[+, -, -], [-, -, +], [+, +, +]]
K = 4
R = [[-, -, +], [-, -, +], [-, -, +]]
H = [ (1, (a, b), [[-, -, -], [-, -, +], [+, +, +]]), (1, (b, c), [[-, -, +], [-, -, +], [+, +|...]]), (3, (a, b), [[-, -, +], [-, -|...], [-|...]]), (3, (a, c), [[-, -|...], [-|...], [...|...]])]
Z = [[+, -, +], [-, -, +], [-, -, +], [-, -, +]]
U = _G210 

Yes
?- Q = [[0, -, -], [-, 0, +], [+, +, +]],
distance(kemeny(min,K),R->Q,H,Z),
forall(member(U,H),(nl,write(U))).

1, (a, b), [[+, -, -], [-, 0, +], [+, +, +]]
1, (a, c), [[+, +, -], [-, 0, +], [+, +, +]]
1, (b, c), [[+, +, +], [-, 0, +], [+, +, +]]
2, (a, c), [[+, +, +], [-, +, +], [+, +, +]]
2, (a, b), [[+, +, +], [+, +, +], [+, +, +]]

Q = [[0, -, -], [-, 0, +], [+, +, +]]
K = 5
R = [[+, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[+, -, -], [-, 0, +], [+, +, +]]), (1, (a, c), [[+, +, -], [-, 0, +], [+, +|...]]), (1, (b, c), [[+, +, +], [-, 0|...], [+|...]]), (2, (a, c), [[+, +|...], [-|...], [...|...]]), (2, (a, b), [[+|...], [...|...]|...])]
Z = [[+, +, +], [+, +, +], [+, +, +], [+, +, +], [+, +, +]]
U = _G210

Yes
?- 

?- chdom(_->o:P).

P = complete 

Yes
?- listing(permit_reversal).

permit_reversal(+, 0).
permit_reversal(-, 0).

Yes
?- Q = [[-, -, -], [0, 0, 0], [+, +, +]],
distance(kemeny(min,K),R->Q,H,Z).

Q = [[-, -, -], [0, 0, 0], [+, +, +]]
K = 6
R = [[0, 0, 0], [0, 0, 0], [0, 0, 0]]
H = [ (1, (a, b), [[0, -, -], [0, 0, 0], [+, +, +]]), (1, (a, c), [[0, 0, -], [0, 0, 0], [+, +|...]]), (1, (b, c), [[0, 0, 0], [0, 0|...], [+|...]]), (3, (a, b), [[0, 0|...], [0|...], [...|...]]), (3, (a, c), [[0|...], [...|...]|...]), (3, (b, c), [[...|...]|...])]
Z = [[+, +, +], [+, +, +], [+, +, +], [+, +, +], [+, +, +], [+, +, +]] 

Yes

% using earlier version

?- rr(Q),distance(kemeny(min,K),R->Q,H,Z),K>5.

Q = [[-, -, -], [0, 0, 0], [+, +, +]]
K = 6
R = [[+, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[-, -, +], [0, 0, 0], [+, +, +]]), (1, (a, b), [[-, +, +], [0, 0, 0], [+, +|...]]), (1, (a, b), [[+, +, +], [0, 0|...], [+|...]]), (2, (a, b), [[+, +|...], [-|...], [...|...]]), (2, (a, b), [[+|...], [...|...]|...]), (2, (a, b), [[...|...]|...])]
Z = [[2, 2, 2], [2, 2, 1], [2, 1, 1], [1, 1, 1], [1, 1, 0], [1, 0, 0], [0, 0|...]] 

Yes

?- chdom(_->o:Q).


Q = complete 

Yes
?- rr(Q),distance(kemeny(min,K),R->Q,H,Z),K>5.

Q = [[-, -, -], [0, 0, 0], [+, +, +]]
K = 6
R = [[+, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[-, -, +], [0, 0, 0], [+, +, +]]), (1, (a, b), [[-, +, +], [0, 0, 0], [+, +|...]]), (1, (a, b), [[+, +, +], [0, 0|...], [+|...]]), (2, (a, b), [[+, +|...], [0|...], [...|...]]), (2, (a, b), [[+|...], [...|...]|...]), (2, (a, b), [[...|...]|...])]
Z = [[2, 2, 2], [2, 2, 1], [2, 1, 1], [1, 1, 1], [1, 1, 0], [1, 0, 0], [0, 0|...]] 

Yes
?- rr(Q),distance(kemeny(min,K),R->Q,H,Z),K>6.

No
?-
*/

% the Kemeny metric (another construction)
%--------------------------------------------------------------

difference_in_profile_for_a_pair(K,XY,RR,D):-
   (var(RR)->rr(RR);true),dop(XY),
   setof(S,(rr_b(XY,BB,RR),member(S,BB)),D),
   length(D,K1),
   K is K1 -1.

disagree_index(K,RR,D):-
   rr(RR),
   findall(F,
    (
     d_pair(XY),
     difference_in_profile_for_a_pair(F,XY,RR,_)
    ),
   D),
   sum(D,K).


kemeny_distance_between(K,(D1,D2),(P,Q)):-
   r(P),r(Q),
   findall(XY,(r(XY,P),\+ r(XY,Q)),D1),
   findall(XY,(r(XY,Q),\+ r(XY,P)),D2),
   length(D1,K1),
   length(D2,K2),
   K is (K1 + K2)/2.

kemeny_distance_from(K,P,RR,D):-
   rr(RR),r(P),
   findall(F,
    (
     r_j(_,RR,R),
     kemeny_distance_between(F,_,(P,R))
    ),
   D),
   sum(D,K).

kemeny_distance(K,P,RR,DL):-
   rr(RR),
   findall((K,P),kemeny_distance_from(K,P,RR,_),L),
   sort(L,[(K,P)|DL]).


/*

?- kemeny_distance(K,P,R,D),K=2.

K = 2
P = [+, +, +]
R = [[-, -, +], [+, +, +], [+, +, +]]
D = [ (3, [-, +, +]), (4, [-, -, +]), (5, [+, +, -]), (6, [+, -, -]), (7, [-, -, -])] 

Yes
?- kemeny_distance(K,P,R,D),K>2.

K = 3
P = [+, +, +]
R = [[-, -, -], [+, +, +], [+, +, +]]
D = [ (4, [+, +, -]), (4, [-, +, +]), (5, [+, -, -]), (5, [-, -, +]), (6, [-, -, -])] 

Yes
?- kemeny_distance(K,P,R,D),K>3.

K = 4
P = [+, +, +]
R = [[+, -, -], [-, -, +], [+, +, +]]
D = [ (4, [+, -, -]), (4, [-, -, +]), (5, [+, +, -]), (5, [-, +, +]), (5, [-, -, -])] 

Yes
?- kemeny_distance(K,P,R,L),K=0,disagree_index(_,R,D),nl,write(R:D),fail.

[[+, +, +], [+, +, +], [+, +, +]]:[0, 0, 0]
[[-, +, +], [-, +, +], [-, +, +]]:[0, 0, 0]
[[-, -, +], [-, -, +], [-, -, +]]:[0, 0, 0]
[[+, +, -], [+, +, -], [+, +, -]]:[0, 0, 0]
[[+, -, -], [+, -, -], [+, -, -]]:[0, 0, 0]
[[-, -, -], [-, -, -], [-, -, -]]:[0, 0, 0]

No
?- R=[R1,R2,R3],R1@Q,H,Z), 
\+ (kemeny_distance(K1,U,Q,D),K=K1).

No
?- rr(Q),kemeny_distance(K1,U,Q,D),
\+ ( distance(kemeny(min,K),R->Q,H,Z), K=K1).

No
?- 

?- rr(Q),kemeny_distance(K1,P,Q,DL),
distance(kemeny(min,K),R->Q,H,Z), O is K1- K,
\+ O is 0, nl,write(Q;K1;K;O),fail.

No
?-

*/



% end
return to front page.