headline(A):- A=[ '%------------------------------------------------------------', '% Odd election ? : A recursive social choice rule.', '%------------------------------------------------------------', '% vote0.pl ( 23--25 Jan 2004)', '% main: '% choice_rule/3, monotonocity/1,update/1', '% Reference:', '% [1] Y. Saeki (1980). Kimekata No Ronri. Tokyo Daigaku Shuppankai.', '% [Logic of How to Decide. Tokyo University Press. (Japanese)]', '%-------' ]. :- headline(A), forall(member(X,A),(nl,write(X))). %------------------------------------------------- % the preference model of society %------------------------------------------------- % members of society agents([1,2,3,4,5,6,7,8]). members_of_society(A):- agents(A). agent(J):-agents(N),member(J,N). % choice objects. alternatives([x,a,b,c]). alternative(x). alternative(a). alternative(b). alternative(c). %preference orders of members preference(1,[a,x,c,b]). % =>[*] preference(J,[a,x,c,b]):-member(J,[2,3]). preference(J,[b,c,a,x]):-member(J,[4,5,6]). preference(J,[c,a,x,b]):-member(J,[7,8]). % [*] a case of fraud by (or changing taste) of agent 1. %preference(1,[x,a,c,b]). % If the society use the Masuzawa rule, % the fraud of 1 who vote as if a>x ==> x>a (or any % engineering that win 1 over to x`s side) is not profitable. /* *********** a sample execution ******** */ /* ?- choice_rule(A,B,C). A = simple B = from:[x, a, b, c] C = elected:[a, b] ; A = majority B = from:[x, a, b, c] C = elected:[a] ; A = borda B = from:[x, a, b, c] C = elected:[a] ; A = masuzawa(rank:1) B = from:[x, a, b, c] C = elected:[a] ; A = masuzawa B = from:[x, a, b, c] C = elected:[a, x, c, b] ; % ==> ?- update_preference_model(s2). Yes ?- choice_rule(A,B,C). A = simple B = from:[x, a, b, c] C = elected:[b] ; A = majority B = from:[x, a, b, c] C = elected:[a, c] ; A = borda B = from:[x, a, b, c] C = elected:[a, c] ; A = masuzawa(rank:1) B = from:[x, a, b, c] C = elected:[c] ; A = masuzawa B = from:[x, a, b, c] C = elected:[c, a, x, b] ; No ?- */ prefer_to(J,A,B):- preference(J,R), nth1(K,R,A), nth1(K1,R,B), K < K1. top_rank_in(J,A,S):- alternatives(M), preference(J,R), subset_of(S,_,M), member(A,R), \+ (member(B,S),prefer_to(J,B,A)). prefer_to_in(J,A,B,S):- alternatives(M), preference(J,R), subset_of(S,_,M), member(A,R), member(B,R), prefer_to(J,A,B). %------------------------------------------------- % simple vote %------------------------------------------------- choice_rule(simple,from:S,poll:P,elected:A):- alternatives(M), subset_of(S,_,M), max(P, choice_rule(simple,from:S,poll:P,a_candidate:A) ). choice_rule(simple,from:S,poll:P,a_candidate:A):- alternatives(M), subset_of(S,_,M), alternative(A), findall(J, top_rank_in(J,A,S), V), length(V,P). /* % For the original prference profile: ?- alternatives(S), choice_rule(simple,from:S,poll:P,elected:A). S = [x, a, b, c] P = 3 A = a ; S = [x, a, b, c] P = 3 A = b ; No ?- % For the alternative prference profile: ?- alternatives(S), choice_rule(simple,from:S,poll:P,elected:A). S = [x, a, b, c] P = 3 A = b ; No ?- */ %------------------------------------------------- % the `Masuzawa' rule of recursive choice (see Ref.1) %------------------------------------------------- choice_rule(masuzawa(rank:1),from:S,poll:P,elected:A):- alternatives(M), subset_of(S,_,M), choice_rule(simple,from:S,poll:P,a_candidate:A), members_of_society(N), length(N,L), L < 2 * P, !. choice_rule(masuzawa(rank:1),from:S,poll:P,elected:A):- alternatives(M), subset_of(S,_,M), findall((Q,Z), choice_rule(simple,from:S,poll:Q,a_candidate:Z), W), sort(W,W1), reverse(W1,[(_,X),(_,Y)|_]), choice_rule(masuzawa(rank:1),from:[X,Y],poll:P,elected:A). choice_rule(masuzawa,from:S,remain:K,elected:[A|B]):- alternatives(M), subset_of(S,_,M), length(S,K), K> 1, choice_rule(masuzawa(rank:1),from:S,poll:_P,elected:A), subtract(S,[A],S0), K0 is K - 1, choice_rule(masuzawa,from:S0,remain:K0,elected:B). choice_rule(masuzawa,from:[A],remain:1,elected:[A]). /* ?- alternatives(S), choice_rule(masuzawa(rank:1),from:S,poll:P,elected:A). S = [x, a, b, c] P = 5 A = a ; No ?- alternatives(S), choice_rule(masuzawa,from:S,P,elected:RANK). S = [x, a, b, c] P = remain:4 RANK = [c, a, x, b] ; No ?- % ===> ?- alternatives(S), choice_rule(masuzawa(rank:1),from:S,poll:P,elected:A). S = [x, a, b, c] P = 5 A = c ; No ?- alternatives(S), choice_rule(masuzawa,from:S,P,elected:RANK). S = [x, a, b, c] P = remain:4 RANK = [c, a, x, b] ; No ?- */ %------------------------------------------------- % the majority rule :vote for all pairwise comparisons %------------------------------------------------- choice_rule(majority,from:S,poll:P,elected:A):- alternatives(M), subset_of(S,_,M), max(P, choice_rule(majority,from:S,poll:P,a_candidate:A) ). choice_rule(majority,from:S,poll:P,a_candidate:A):- alternatives(M), subset_of(S,_,M), alternative(A), findall((J,B), prefer_to_in(J,A,B,S), V), %(nl,write(A:V)), length(V,P). /* % For the original prference profile: ?- alternatives(S), choice_rule(majority,from:S,poll:P,elected:A). x:[ (1, c), (1, b), (2, c), (2, b), (3, c), (3, b), (7, b), (8, b)] a:[ (1, x), (1, c), (1, b), (2, x), (2, c), (2, b), (3, x), (3, c), (3, b), (4, x), (5, x), (6, x), (7, x), (7, b), (8, x), (8, b)] b:[ (4, c), (4, a), (4, x), (5, c), (5, a), (5, x), (6, c), (6, a), (6, x)] c:[ (1, b), (2, b), (3, b), (4, a), (4, x), (5, a), (5, x), (6, a), (6, x), (7, a), (7, x), (7, b), (8, a), (8, x), (8, b)] S = [x, a, b, c] P = 16 A = a ; No ?- % For the alternative prference profile: ?- alternatives(S), choice_rule(majority,from:S,poll:P,elected:A). S = [x, a, b, c] P = 15 A = a ; S = [x, a, b, c] P = 15 A = c ; No ?- */ %------------------------------------------------- % Borda rule : ranking by weighted average point %------------------------------------------------- choice_rule(borda,from:S,gpa:P,elected:A):- alternatives(M), subset_of(S,_,M), max(P, choice_rule(borda,from:S,gpa:P,a_candidate:A) ). choice_rule(borda,from:S,gpa:P,a_candidate:A):- alternatives(M), subset_of(S,_,M), member(A,S), findall(X, ( agent(J), grade_point_average(J,A,X) ), Y), sum(Y,P). grade_point_average(J,A,G):- preference(J,R), length(R,L), nth1(K,R,A), G is L - K. /* ?- alternatives(S),choice_rule(borda,from:S,gpa:P,elected:A). S = [x, a, b, c] P = 16 A = a ; No */ %------------------------------------------------- % More Social Choice Theory %------------------------------------------------- :- dynamic preference/2. preference(J,s1,[a,x,c,b]):-member(J,[1,2,3]). preference(J,S,[b,c,a,x]):-member(J,[4,5,6]),member(S,[s1,s2]). preference(J,S,[c,a,x,b]):-member(J,[7,8]),member(S,[s1,s2]). preference(1,s2,[x,a,c,b]). preference(J,s2,[a,x,c,b]):-member(J,[2,3]). state(s1). state(s2). update_preference_model(S):- state(S), abolish(preference/2), P=preference(J,S,R), forall(P,assert(preference(J,R))). % scc: social choice rules (i.e., social choice correspondences) scc(simple). scc(majority). scc(borda). scc(masuzawa(rank:1)). scc(masuzawa). scc(F,S,C):- state(S), scc(F), update_preference_model(S), alternatives(W), choice_rule(F,from:W,elected:C). choice_rule(F,from:W,elected:C):- scc(F), F \= masuzawa, alternatives(W), findall(A, choice_rule(F,from:W,_,elected:A), C). choice_rule(masuzawa,from:W,elected:C):- alternatives(W), choice_rule(masuzawa,from:W,_,elected:C). /* ?- scc(A),scc(A,B,C). A = simple B = s1 C = [a, b] ; A = simple B = s2 C = [b] ; A = majority B = s1 C = [a] ; A = majority B = s2 C = [a, c] ; A = borda B = s1 C = [a] ; A = borda B = s2 C = [a, c] ; A = masuzawa(rank:1) B = s1 C = [a] ; A = masuzawa(rank:1) B = s2 C = [c] ; A = masuzawa B = s1 C = [a, x, c, b] ; A = masuzawa B = s2 C = [c, a, x, b] ; No ?- */ %------------------------------------------------- % Maskin Monotonicity %------------------------------------------------- % lower contour set : outcomes worse or equal than A. lcc([I,S,R],A,L) :- preference(I,S,R), member(A,R), append(_Upper, [A|Lower], R), sort([A|Lower],L). monotone(F):- scc(F), forall( ( scc(F,S,C), member(A,C), scc(F,S1,C1), \+ member(A,C1),wrv1(A,F,C,S,C1,S1) ), ( lcc([I,S,_R],A,L1), lcc([I,S1,_R1],A,L2), \+ subtract(L1,L2,[]),wrv2(I,L1,L2) ) ). % to display the reversal outcome when an alternative dropped from scc. wrv1(A,F,C,S,C1,S1):- write([A,is_in,F,[S,C],out,[S1,C1]]),nl. wrv2(I,L1,L2):-tab(3), write([reversal(I),lccs(L1,'->',L2)]),nl. /* ?- monotone(simple). [a, is_in, simple, [s1, [a, b]], out, [s2, [b]]] [reversal(1), lccs([a, b, c, x], (->), [a, b, c])] Yes ?- monotone(majority). [c, is_in, majority, [s2, [a, c]], out, [s1, [a]]] No ?- monotone(masuzawa(rank:1)). [a, is_in, masuzawa(rank:1), [s1, [a]], out, [s2, [c]]] [reversal(1), lccs([a, b, c, x], (->), [a, b, c])] [c, is_in, masuzawa(rank:1), [s2, [c]], out, [s1, [a]]] No ?- monotone(masuzawa). Yes ?- monotone(borda). [c, is_in, borda, [s2, [a, c]], out, [s1, [a]]] No ?- */ veto_outcome(A,J,S,F):- scc(F,S,C), alternatives(As), subtract(As,C,D), member(A,D), agents(Is), preference(J,S,_R), forall((member(K,Is),K\=J), (lcc([K,S,_Rk],A,As)%,write([A,S,J,K]),nl ) ). no_veto_power(F):- agents(Is), scc(F,_,_) -> forall(member(J,Is),\+veto_outcome(_A,J,_S,F)). nvp(F):-no_veto_power(F). %------------------------------------------------- % Common programs %------------------------------------------------- % a sequence of binary choice for a list: %-------------------------------------------------- list_projection([],[],[]). list_projection([X|Y],[_A|B],C):- X = 0, list_projection(Y,B,C). list_projection([X|Y],[A|B],[A|C]):- X = 1, list_projection(Y,B,C). % % subset_of/3 : subset-enumeration % ----------------------------------------------------------- % subset_of(A,N,As):- var(A), length(As,L), length(D,L), list_projection(D,As,B), length(B,N), sort(B,A). subset_of(A,N,As):- \+ var(A), length(A,N), subset(A,As). % maximal solution for given goal clause : a naive solver %--------------------------------------------------------- max(X,Goal):- % X: the objective variable, % Goal: the objective function and constraints, setof((X,Goal),Goal,Z), member((X,Goal),Z), \+ ( member((Y,_),Z), Y > X ). % % max,min % ----------------------------------------------------------- % max_of(X,[X]). max_of(Z,[X|Y]):- max_of(Z1,Y), (X > Z1 -> Z=X; Z=Z1). min_of(X,[X]). min_of(Z,[X|Y]):- min_of(Z1,Y), (X < Z1 -> Z=X; Z=Z1). % sum % ----------------------------------------------------------- % sum([],0). sum([X|Members],Sum):- sum(Members,Sum1), %number(X), Sum is Sum1 + X.