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.

return to front page.