% geometric labelling system for the Lemke-Howson algorithm
% : solving bimatrix games using prolog
% file: pf74.pl (developed on SWI-prolog 5.0.9)
% 2005.12.19-20. (lastly modified: 20 Dec 01:56am)
% By Kenryo INDO (Kanto Gakuen University)


% Reference
% [1] L.S. Shapley (1974). A note on the Lemke-Howson algorithm,
%  Mathematical Progamming Study 1: 175-89.

%------------------------------------------------
%   modeling the strategic form game
%------------------------------------------------

player(1).
player(2).

possible_acts( [1,2,3], player(1)).
possible_acts( [4,5,6], player(2)).
possible_acts( [1,2,3,4,5,6], all).

game( [act(1),act(4)], player(1), payoff( 2)). 
game( [act(1),act(5)], player(1), payoff( 2)). 
game( [act(1),act(6)], player(1), payoff( 0)). 
game( [act(2),act(4)], player(1), payoff( 0)). 
game( [act(2),act(5)], player(1), payoff( 3)). 
game( [act(2),act(6)], player(1), payoff( 0)). 
game( [act(3),act(4)], player(1), payoff( 3)). 
game( [act(3),act(5)], player(1), payoff( 0)). 
game( [act(3),act(6)], player(1), payoff( 1)). 

game( [act(1),act(4)], player(2), payoff( 3)). 
game( [act(1),act(5)], player(2), payoff( 0)). 
game( [act(1),act(6)], player(2), payoff( 2)). 
game( [act(2),act(4)], player(2), payoff( 0)). 
game( [act(2),act(5)], player(2), payoff( 3)). 
game( [act(2),act(6)], player(2), payoff( 2)). 
game( [act(3),act(4)], player(2), payoff( 0)). 
game( [act(3),act(5)], player(2), payoff( 0)). 
game( [act(3),act(6)], player(2), payoff( 1)). 

strategy( pure, act(X), player(J)):-
   player(J),
   possible_acts(A, player(J)),
   member( X, A).

strategy(mixed, P, player(J)):-
   mixed_strategy(P, player(J)).

opponent_player_indices( J1, J):-
   player( J),
   player( J1),
   J1 \= J.

%------------------------------------------------
% analyzing the rational strategies and equilibria
%------------------------------------------------

attainable(pure, [A,B],( C,D), deviated(1,A1,G1)):-
   game( [A,B], player(1), payoff( C)), 
   game( [A,B], player(2), payoff( D)), 
   game( [A1,B], player(1), payoff( C1)),
   G1 is C1 - C.
attainable(pure, [A,B],( C,D), deviated(2,B1,G2)):-
   game( [A,B], player(1), payoff( C)), 
   game( [A,B], player(2), payoff( D)), 
   game( [A,B1], player(2), payoff( D1)),
   G2 is D1 - D.

% for the mixed extention.
attainable(pure-mixed, A,B,C):-
   pure_against_mixed_attainable(A,B,C).

profitable_deviation(Type, [A,B],( C,D), (J,F,G)):-
   member(Type, [pure, pure-mixed]),
   attainable(Type, [A,B],( C,D), deviated(J,F,G)),
   G>0.

% the definition of Nash equilibrium (1)

nash(pure, (A,B),( C,D), yes):-
   game( [A,B], player(1), payoff( C)), 
   game( [A,B], player(2), payoff( D)),
   \+ profitable_deviation(pure, [A,B],( C,D), _).


%------------------------------------------------
%   another way for the equilibria
%------------------------------------------------
 
% the definition of Nash equilibrium (2)

nash_1(pure, (A,B),( C,D), yes):-
   best_response( (pure,1,A), against(pure,2,B)),
   best_response( (pure,2,B), against(pure,1,A)),
   game( [A,B], player(1), payoff( C)), 
   game( [A,B], player(2), payoff( D)).

best_response( (pure,1,A), against(pure,2,B)):-
   strategy( pure, A, player(1)),
   strategy( pure, B, player(2)),
   \+ profitable_deviation(pure, [A,B],_, (1,_)). 
best_response( (pure,2,B), against(pure,1,A)):-
   strategy( pure, A, player(1)),
   strategy( pure, B, player(2)),
   \+ profitable_deviation(pure, [A,B],_, (2,_)). 

best_response( (pure,J1,A), against(mixed,J2,B)):-
   best_response_p( (pure,J1,A), against(mixed,J2,B)).


%------------------------------------------------
%   demo
%------------------------------------------------
/*
?- best_response( (pure,J,A), against(pure,J1,B)),
    nl,write(J;A;J1;B),fail.

1;act(2);2;act(5)
1;act(3);2;act(4)
1;act(3);2;act(6)
2;act(4);1;act(1)
2;act(5);1;act(2)
2;act(6);1;act(3)

No
?- nash(A,B,C,yes).

A = pure
B = act(2), act(5)
C = 3, 3 ;

A = pure
B = act(3), act(6)
C = 1, 1 ;

No
?- profitable_deviation(pure, [A,B], (C,D), Dev),
write([A,B]->(C,D):Dev),nl,fail.

[act(1), act(4)]-> (2, 3): (1, act(3), 1)
[act(1), act(5)]-> (2, 0): (1, act(2), 1)
[act(1), act(6)]-> (0, 2): (1, act(3), 1)
[act(2), act(4)]-> (0, 0): (1, act(1), 2)
[act(2), act(4)]-> (0, 0): (1, act(3), 3)
[act(2), act(6)]-> (0, 2): (1, act(3), 1)
[act(3), act(5)]-> (0, 0): (1, act(1), 2)
[act(3), act(5)]-> (0, 0): (1, act(2), 3)
[act(1), act(5)]-> (2, 0): (2, act(4), 3)
[act(1), act(5)]-> (2, 0): (2, act(6), 2)
[act(1), act(6)]-> (0, 2): (2, act(4), 1)
[act(2), act(4)]-> (0, 0): (2, act(5), 3)
[act(2), act(4)]-> (0, 0): (2, act(6), 2)
[act(2), act(6)]-> (0, 2): (2, act(5), 1)
[act(3), act(4)]-> (3, 0): (2, act(6), 1)
[act(3), act(5)]-> (0, 0): (2, act(6), 1)

No

*/

%------------------------------------------------
%   mixed extension of game
%------------------------------------------------

mixed_extension( (P,Q), payoff( E1,E2)):-
   mixed_strategy(P, player(1)),
   mixed_strategy(Q, player(2)),
   expected_payoff((P,Q), E1,player(1)),
   expected_payoff((P,Q), E2,player(2)).

mixed_strategy(P, player(1)):-
  P= [(act(1)->S1),(act(2)->S2),(act(3)->S3)],
  probability_measure( [S1,S2,S3],scale(10), elements(3)).

mixed_strategy(Q, player(2)):-
  Q= [(act(4)->S4),(act(5)->S5),(act(6)->S6)],
  probability_measure( [S4,S5,S6],scale(10), elements(3)).

probability_measure( P,scale(N), elements(3)):-
  %integer(M),
   integer(N),
   Scale is N + 1,
   length(L,Scale),
   nth0( K1,L,S1), 
   nth0( K2,L,S2),
   K2 >= K1,
   S1 is K1,
   S2 is K2 - K1,
   S3 is 10 - K2,
   P=[S1,S2,S3].
 
%------------------------------------------------
%   expected payoffs
%------------------------------------------------

expected_payoff( (I,E), (pure,J,S),against(mixed,J1,P)):-
   opponent_player_indices( J1, J),
   strategy( pure, S, player(J)),
   (var( P)->mixed_strategy(P, player(J1));true),
   %J1=1,P= [act(1)->S1;act(2)->S2;act(3)->S3],
   %J1=2,P= [act(4)->S4;act(5)->S5;act(6)->S6],
   possible_acts(A,player(J1)),
   expected_payoff_of(player(I), (J1, P), (J,S), A, E).

expected_payoff_of(player(_),_, _, [],0).
expected_payoff_of(player(J),(J1,[X->Sx|P]), (J2,S), [K|A],E):-
   opponent_player_indices( J1, J2),
   X = act(K),
   expected_payoff_of(player(J),(J1,P), (J2,S), A, E0),
   (J1=1->Y=[X,S];Y=[S,X]),
   game( Y, player(J), payoff( U)), 
   (E0 is 0 -> E = U * Sx; E = E0 + U * Sx).

%------------------------------------------------
%   best response for opponent's mixed strategy
%------------------------------------------------

best_response_p( (pure,2,T), against(mixed,1,P)):-
   mixed_strategy(P, player(1)),
   strategy( pure, T, player(2)),
   \+ profitable_deviation(pure-mixed, [P,T],_, (2,_)). 
best_response_p( (pure,1,S), against(mixed,2,Q)):-
   mixed_strategy(Q, player(2)),
   strategy( pure, S, player(1)),
   \+ profitable_deviation(pure-mixed, [S,Q],_, (1,_)). 

pure_against_mixed_attainable([S,Q],( C,D), deviated(1,S1,G1)):-
   expected_payoff( (1,C), (pure,1,S),against(mixed,2,Q)),
   expected_payoff( (1,C1), (pure,1,S1),against(mixed,2,Q)),
   expected_payoff( (2,D), (pure,1,S1),against(mixed,2,Q)),
   G1 is C1 - C.

pure_against_mixed_attainable([P,T],( C,D), deviated(2,T1,G2)):-
   expected_payoff( (2,D), (pure,2,T),against(mixed,1,P)),
   expected_payoff( (2,D1), (pure,2,T1),against(mixed,1,P)),
   expected_payoff( (1,C), (pure,2,T1),against(mixed,1,P)),
   G2 is D1 - D.

%------------------------------------------------
%   demo
%------------------------------------------------
/*
?- possible_acts(C,player(J)),
expected_payoff_of( player(J1),(J,P),B,C,D).

C = [1, 2, 3]
J = 1
J1 = 1
P = [ (act(1)->_G339), (act(2)->_G358), (act(3)->_G374)|_G371]
B = 2, act(4)
D = 3*_G374+0*_G358+2*_G339 

Yes
?- expected_payoff( (1,C),(pure,1,S),against(mixed,2,P)).

C = 0*10+2*0+2*0
S = act(1)
P = [ (act(4)->0), (act(5)->0), (act(6)->10)] 

Yes
?- expected_payoff( (2,C),(pure,1,S),against(mixed,2,P)).

C = 2*10+0*0+3*0
S = act(1)
P = [ (act(4)->0), (act(5)->0), (act(6)->10)] 

Yes
?- expected_payoff( (1,C),(pure,2,S),against(mixed,1,P)).

C = 3*10+0*0+2*0
S = act(4)
P = [ (act(1)->0), (act(2)->0), (act(3)->10)] 

Yes
?- pure_against_mixed_attainable([S,P],( C,D), deviated(1,S1,G1)).

S = act(1)
P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
C = 0*10+2*0+2*0
D = 2*10+0*0+3*0
S1 = act(1)
G1 = 0 

Yes
?- pure_against_mixed_attainable([Q,T],( C,D), deviated(2,T1,G)).

Q = [ (act(1)->0), (act(2)->0), (act(3)->10)]
T = act(4)
C = 3*10+0*0+2*0
D = 0*10+0*0+3*0
T1 = act(4)
G = 0 

Yes
?- best_response_p( (pure,2,T), against(mixed,1,P)).

T = act(6)
P = [ (act(1)->0), (act(2)->0), (act(3)->10)] ;

T = act(6)
P = [ (act(1)->0), (act(2)->1), (act(3)->9)] 

Yes
?- 

*/

%------------------------------------------------
%   the labelling system
%------------------------------------------------
% See [1].

:- dynamic pf_label/3.

pf_labelling:-
   abolish( pf_label/3),
   mixed_strategy(P, player(J)),
   pf_labelling(player(J), act(X), P),
   assert( pf_label( player(J), act(X), P) ),
   fail.
pf_labelling:-
   nl,
   write('complete. ('),
   findall(1, pf_label(_,_,_), L),
   length(L,N),
   tab(2),
   write(N),
   write(' records has asserted.)'),
   nl.

pf_labelling(player(J), act(X), P):-
   strategy( pure, act(X), player(J)),
   member((act(X)->0),P).

pf_labelling(player(J), act(Y), P):-
   opponent_player_indices( J1, J),
   strategy( pure, act(Y), player(J1)),
   best_response_p( (pure,J1,act(Y)), against(mixed,J,P)).

pf_label_of_probability( player(J),P, L):-
   mixed_strategy(P, player(J)),
   findall( K,
     pf_label( player(J), act(K), P),
   L).
      
pf_label_of_pair( (P,Q), L):-
   pf_label_of_probability( player(1),P, L1),
   pf_label_of_probability( player(2),Q, L2),
   union( L1,L2,L0),
   sort(L0,L).

completely_labelled_pair( P,Q):-
   pf_label_of_pair( (P,Q), L),
   possible_acts( L, all).

almost_completely_labelled_pair( P,Q, minus(J)):-
   pf_label_of_pair( (P,Q), L),
   possible_acts( Lall, all),
   subtract(Lall,L,[J]).
 

%------------------------------------------------
%   demo
%------------------------------------------------
/*
?- P = [ (act(4)->0), (act(5)->0), (act(6)->10)],
best_response_p( (pure,1,S), against(mixed,2,P)).

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
S = act(3) ;

No
?- P = [ (act(4)->0), (act(5)->0), (act(6)->10)],
pf_labelling(player(J), act(Y), P).


P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
J = 2
Y = 4 ;

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
J = 2
Y = 5 ;

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
J = 2
Y = 3 ;

?- pf_labelling.

complete. (  162 records has asserted.)

Yes
?- P = [ (act(4)->0), (act(5)->0), (act(6)->10)],
pf_label(player(2),act(X),P).

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
X = 4 ;

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
X = 5 ;

P = [ (act(4)->0), (act(5)->0), (act(6)->10)]
X = 3 ;

No
?- P = [ (act(1)->0), (act(2)->0), (act(3)->10)],
pf_label_of_probability(player(1),Q,L).

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(1)->0), (act(2)->0), (act(3)->10)]
L = [1, 2, 6] ;

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(1)->0), (act(2)->1), (act(3)->9)]
L = [1, 6] ;

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(1)->0), (act(2)->2), (act(3)->8)]
L = [1, 6] 

Yes
?- P = [ (act(1)->0), (act(2)->0), (act(3)->10)],
pf_label_of_probability(player(2),Q,L).

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->0), (act(6)->10)]
L = [4, 5, 3] ;

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->1), (act(6)->9)]
L = [4, 3] ;

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->2), (act(6)->8)]
L = [4, 3] 

Yes
?- 
?- pf_label_of_pair( (P,Q), L).

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->0), (act(6)->10)]
L = [1, 2, 3, 4, 5, 6] ;

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->1), (act(6)->9)]
L = [1, 2, 3, 4, 6] 

Yes
?- completely_labelled_pair( P,Q).

P = [ (act(1)->0), (act(2)->0), (act(3)->10)]
Q = [ (act(4)->0), (act(5)->0), (act(6)->10)] ;

P = [ (act(1)->0), (act(2)->10), (act(3)->0)]
Q = [ (act(4)->0), (act(5)->10), (act(6)->0)] ;

No
?- almost_completely_labelled_pair( P,Q,R),
   P=[_->A,_->B,_->C],Q=[_->X,_->Y,_->Z],
   nl,write([A,B,C]:[X,Y,Z]:R),fail.

[0, 0, 10]:[0, 1, 9]:minus(5)
[0, 0, 10]:[0, 2, 8]:minus(5)
[0, 1, 9]:[0, 0, 10]:minus(2)
[0, 2, 8]:[0, 0, 10]:minus(2)
[0, 3, 7]:[0, 0, 10]:minus(2)
[0, 4, 6]:[0, 0, 10]:minus(2)
[0, 5, 5]:[0, 0, 10]:minus(2)
[0, 5, 5]:[0, 1, 9]:minus(2)
[0, 5, 5]:[0, 2, 8]:minus(2)
[0, 5, 5]:[0, 3, 7]:minus(3)
[0, 5, 5]:[0, 4, 6]:minus(3)
[0, 5, 5]:[0, 5, 5]:minus(3)
[0, 5, 5]:[0, 6, 4]:minus(3)
[0, 5, 5]:[0, 7, 3]:minus(3)
[0, 5, 5]:[0, 8, 2]:minus(3)
[0, 5, 5]:[0, 9, 1]:minus(3)
[0, 5, 5]:[0, 10, 0]:minus(3)
[0, 5, 5]:[1, 3, 6]:minus(4)
[0, 6, 4]:[0, 10, 0]:minus(3)
[0, 7, 3]:[0, 10, 0]:minus(3)
[0, 8, 2]:[0, 10, 0]:minus(3)
[0, 9, 1]:[0, 10, 0]:minus(3)
[0, 10, 0]:[0, 3, 7]:minus(6)
[0, 10, 0]:[0, 4, 6]:minus(6)
[0, 10, 0]:[0, 5, 5]:minus(6)
[0, 10, 0]:[0, 6, 4]:minus(6)
[0, 10, 0]:[0, 7, 3]:minus(6)
[0, 10, 0]:[0, 8, 2]:minus(6)
[0, 10, 0]:[0, 9, 1]:minus(6)
[0, 10, 0]:[1, 9, 0]:minus(4)
[0, 10, 0]:[2, 8, 0]:minus(4)
[0, 10, 0]:[3, 7, 0]:minus(4)
[1, 9, 0]:[0, 10, 0]:minus(1)
[2, 8, 0]:[0, 10, 0]:minus(1)
[3, 7, 0]:[0, 10, 0]:minus(1)

No
?- 

*/