:-J=['% strategic voting by prolog'
,'%------------------------------------------------------'
,'% vote01.pl (5-9 Jan 2006)'
], forall(member(X,J),(nl,write(X))).


%-------------------------------------------------
% a TOB example in Dixit and Nalebuff(1991)
%-------------------------------------------------
  
% Reference
% A. Dixit and B. Nalebuff (1991). Thinking Strategically.
% the voters(=agents) 
%  1: owner proprietor,
%  2-5: other executives
% and the choice objects(=alternatives)
%  a: "white knight",
%  b: "MBO",
%  c: "poison pill",
%  d: "wait and see." 

% Claim DN (Dixit and Nalebuff,1991)
% By means of precommit himself into the preference of voter 5,
% the owner of company can manipulate his preferable outcome c.


% choice objects.
%-------------------------------------------------
alternative(a).
alternative(b).
alternative(c).
alternative(d).
alternatives([a,b,c,d]).

% voters
%-------------------------------------------------
voter(1).
voter(2).
voter(3).
voter(4).
voter(5).
voters([1,2,3,4,5]).

% stages of vote
%-------------------------------------------------
stage_of_vote(3).
stage_of_vote(2).
stage_of_vote(1).
stages([3,2,1]).

last_stage_of_vote(3).
sequence_of_tournament( [d,c,b,a]).

possible_match(stage(1),[b,a]).
possible_match(stage(2),[c,W]):-member(W,[a,b]).
possible_match(stage(3),[d,W]):-member(W,[a,b,c]).

last_stage_winner(stage(K),W):-
   possible_match(stage(K),[_,W]).


possible_winner(stage(K),W):-
   possible_match(stage(K),[_,W]).


possible_winner(stage(K),W):-
   possible_match(stage(K),[W,_]),
   !.


% preference orderings of voters
%-------------------------------------------------

:- dynamic preference_of_voter/2. 

preference_of_voter(1,[c,b,a,d]).
preference_of_voter(2,[a,c,d,b]).
preference_of_voter(3,[a,c,d,b]).
preference_of_voter(4,[b,c,d,a]).
preference_of_voter(5,[d,a,c,b]).
%preference_of_voter(1,[d,a,c,b]).  % the case of precommitment.

voter_prefer_to(J,A,B):-
   preference_of_voter(J,R),
   append(_,[A|Y],R),
   member(B, Y).


%-------------------------------------------------
%  Modeling binary sequential vote
%-------------------------------------------------

% possible results of sequential vote
%-------------------------------------------------

possible_act( stage(K), voter(J, O), select_from([X,Y])):-
   possible_match(stage(K),[X,Y]),
   voter(J),
   member(O,[X,Y]).

possible_stage_vote_1( _, [], [], _).
possible_stage_vote_1(  K, [J|N], [(J,O)|H], (X,Y)):-
   possible_stage_vote_1(  K, N, H, (X,Y)),
   possible_act( stage(K), voter(J, O), select_from([X,Y])).

possible_stage_vote( K, V, R, XY):-
   voters(N),
   possible_stage_vote_1( K, N, V, XY),
   poll(V,R).

/*

?- possible_stage_vote(T, V, E, X).

T = 1
V = [ (1, b), (2, b), (3, b), (4, b), (5, b)]
E = [ (5, b), (0, d), (0, c), (0, a)]
X = b, a 

Yes
?- 
*/

poll_1([], [],[]).
poll_1([X|O],V,[(P,X)|R]):-
   findall( (J,X), member((J,X),V), L),
   length(L, P),
   subtract(V,L,V1),
   poll_1(O,V1,R).

poll(V,R):-
   alternatives(O),
   poll_1(O,V,R1),
   sort(R1,R2),
   reverse(R2,R).

possible_sequential_vote_1( 0, [], [_], []).
possible_sequential_vote_1( K, [H|V], [W,Y|E], [(X,Y)|M]):-
   K1 is K - 1,
   possible_sequential_vote_1(K1, V, [Y|E], M),
   possible_stage_vote( K, H ,[(_,W)|_], (X,Y)).

possible_sequential_vote( V, E, M):-
   last_stage_of_vote(T),
   length(V,T),
   possible_sequential_vote_1( T, V, E, M).

possible_sequential_vote( V, E):-
   possible_sequential_vote( V, E, _).

possible_sequential_vote_at_stage(K,(X,Y)->W, V, E):-
   possible_sequential_vote( V, E),
   sequence_of_tournament(Q),
   last_stage_of_vote(T),
   stage_of_vote(K),
   K1 is T - K + 1,
   K2 is K1 + 1,
   nth1(K1,Q,X),
   nth1(K2,E,Y),
   nth1(K1,E,W).

% alternative
possible_sequential_vote_at_stage_b(K,(X,Y)->W, V, E):-
   last_stage_of_vote(T),
   length(V,T),
   possible_sequential_vote_1( T, V, E, M),
   stage_of_vote(K),
   K1 is T - K + 1,
   nth1(K1,M,(X,Y)),
   nth1(K1,E,W).

/*

?- possible_sequential_vote([A,B,C],[a|E]).

A = [ (1, a), (2, a), (3, a), (4, d), (5, d)]
B = [ (1, a), (2, a), (3, a), (4, c), (5, c)]
C = [ (1, a), (2, a), (3, a), (4, b), (5, b)]
E = [a, a, a] ;

A = [ (1, a), (2, a), (3, d), (4, a), (5, d)]
B = [ (1, a), (2, a), (3, a), (4, c), (5, c)]
C = [ (1, a), (2, a), (3, a), (4, b), (5, b)]
E = [a, a, a] ;

A = [ (1, a), (2, d), (3, a), (4, a), (5, d)]
B = [ (1, a), (2, a), (3, a), (4, c), (5, c)]
C = [ (1, a), (2, a), (3, a), (4, b), (5, b)]
E = [a, a, a] ;

A = [ (1, d), (2, a), (3, a), (4, a), (5, d)]
B = [ (1, a), (2, a), (3, a), (4, c), (5, c)]
C = [ (1, a), (2, a), (3, a), (4, b), (5, b)]
E = [a, a, a] 

Yes
?- possible_sequential_vote_at_stage(K,VSW, V, E).

K = 3
VSW = d, c->d
V = [[ (1, d), (2, d), (3, d), (4, d), (5, d)], [ (1, c), (2, c), (3, c), (4, c), (5, c)], [ (1, b), (2, b), (3, b), (4, b), (5, b)]]
E = [d, c, b, a] 

Yes
*/


%-------------------------------------------------
% Modeling rational voters
%-------------------------------------------------
% edited: 5-8 Jan 2006 (abolish.)
% modified: 9 Jan 2006 (totally modified.)

% different patterns of stage vote with a single deviator
%-------------------------------------------------

unilateral_deviation_by_voter(J,O->O1,Vf->Vg,W->W1,(R,S)):-
   member((O1,O),[(R,S),(S,R)]),
   append( H, [(J,O)| B], Vf),
   append( H, [(J,O1)| B], Vg),
   (var(W)->poll(Vf,[(_,W)|_]);true),
   poll(Vg,[(_,W1)|_]).


% judging truthfulness w.r.t. true preference
%-------------------------------------------------

is_truthful_or_not( yes, J,[R,S]->O):-
   \+ is_truthful_or_not( no, J,[R,S]->O).

is_truthful_or_not( no, J,[R,S]->R):-
   voter_prefer_to(J, S, R).

is_truthful_or_not( no, J,[R,S]->S):-
   voter_prefer_to(J, R, S).


% Truthfulness is best at any terminal decision node
%-------------------------------------------------
% At the last stage voters has no incentive to manipulate his own true preference.
% Voting for the top ranked in truthful preference is weakly dominant strategy. 


rational_voter( J, stage(K), select([X:X,Y:Y]->O),truthful(yes)):-
   last_stage_of_vote(K),
   possible_act( stage(K), voter(J, O), select_from([X,Y])),
   (voter_prefer_to(J, X,Y)->O=X;O=Y).


% The backward reasoning of inductively rational voting.
%-------------------------------------------------
% Assuming rational voters, the last statement is also true for each intermidiate 
% stage if the consequent stages of each of candidates matched at that stage 
% can be resolved itself into a unique terminal outcome respectively. 
% Otherwise indifferent.


rational_voter( J, stage(K),select([X:G,Y:G1]->O),truthful(T)):-
   stage_of_vote(K),
   \+ last_stage_of_vote(K),
   possible_act( stage(K), voter(J, O), select_from([X,Y])),
   K1 is K + 1,
   rational_voter( all, stage(K1), select([_,X:_]->_:G), _),
   rational_voter( all, stage(K1), select([_,Y:_]->_:G1), _),
   (G = G1 -> true; (voter_prefer_to(J,G,G1)->O=X; O=Y)),
   is_truthful_or_not( T, J,[X,Y]->O).


%  equilibrium act profile and the winner at each stage 
%-------------------------------------------------
% choice objects = proxy:final

rational_voter( all, stage(K),select([X:O,Y:O1]->W:G),(V,D)):-
   stage_of_vote(K),
   voters(N),
   rational_voter_1( K, [X:O,Y:O1], N, V, D),
   poll(V,[(_,W)|_]),
   is_proxy_of( (W,X,Y):(G,O,O1)).

is_proxy_of( (W,X,Y):(G,O,O1)):-
   member(W:G,[X:O,Y:O1]).

rational_voter_1(_,_,[],[],[]).
rational_voter_1(K,[X:G,Y:G1],[J|N],[(J,O)|V],[(J,T)|D]):-
   rational_voter_1(K,[X:G,Y:G1],N,V,D),
   rational_voter( J,
     stage(K),
     select([X:G,Y:G1]->O),
     truthful(T)
   ).

/*

?- rational_voter(all, stage(3),select(O),(V,T)).

O = [d:d, a:a]->a:a
V = [ (1, a), (2, a), (3, a), (4, d), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

O = [d:d, b:b]->d:d
V = [ (1, b), (2, d), (3, d), (4, b), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

O = [d:d, c:c]->c:c
V = [ (1, c), (2, c), (3, c), (4, c), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

No
?- 

?- rational_voter(all, stage(2),select(O),(V,T)).

O = [c:c, a:a]->a:a
V = [ (1, c), (2, a), (3, a), (4, c), (5, a)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

O = [c:c, b:d]->c:c
V = [ (1, c), (2, c), (3, c), (4, c), (5, b)]
T = [ (1, yes), (2, yes), (3, yes), (4, no), (5, no)] ;

No
?- 

?- rational_voter(all, stage(1),select(O),(V,T)).

O = [b:c, a:a]->a:a
V = [ (1, b), (2, a), (3, a), (4, b), (5, a)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

No
?- 

*/


%-------------------------------------------------
%  Modeling precommitment of voter 1 :
%  Verifying the Claim DN 
%-------------------------------------------------

precommit_preference( of(J,R), as(J1,R1), [select:O, vote:V, truthfulness:T]):-
   retract( preference_of_voter( J, R)),
   preference_of_voter( J1, R1),
   assert( preference_of_voter( J, R1)),
   nl,
   write(' query the result of vote:'),
   nl, tab(1),
   Q= rational_voter(all, stage(1), select(O), (V,T)),
   write( 'rational_voter(all, stage(1), select(O), (V,T))'),
   nl,
   write('go ahead ? (y)|'),
   read(y),
   call(Q).

/*

?- precommit_preference(of(1,R1),as(5,R5),[A,B,C]).

 query the result of vote:
 rational_voter(all, stage(1), select(O), (V,T))
go ahead ? (y)|y.

R1 = [c, b, a, d]
R5 = [d, a, c, b]
A = select: ([b:c, a:c]->b:c)
B = vote:[ (1, b), (2, b), (3, b), (4, b), (5, b)]
C = truthfulness:[ (1, no), (2, no), (3, no), (4, yes), (5, no)] 

Yes
?- rational_voter(all, stage(2),select(O),(V,T)).

O = [c:c, a:d]->c:c
V = [ (1, a), (2, c), (3, c), (4, c), (5, a)]
T = [ (1, yes), (2, no), (3, no), (4, yes), (5, yes)] ;

O = [c:c, b:d]->c:c
V = [ (1, b), (2, c), (3, c), (4, c), (5, b)]
T = [ (1, no), (2, yes), (3, yes), (4, no), (5, no)] ;

No
?- rational_voter(all, stage(3),select(O),(V,T)).

O = [d:d, a:a]->d:d
V = [ (1, d), (2, a), (3, a), (4, d), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

O = [d:d, b:b]->d:d
V = [ (1, d), (2, d), (3, d), (4, b), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

O = [d:d, c:c]->c:c
V = [ (1, d), (2, c), (3, c), (4, c), (5, d)]
T = [ (1, yes), (2, yes), (3, yes), (4, yes), (5, yes)] ;

No
?- 

*/


% end of program
%-------------------------------------------------

% p.s. Former program I had been trying to extend vote0.pl  
% during two weeks before 5 Jan 2005 resulted in pretty codes for 
% inductive (non)manipulablity, but I decided to suspend it.