headline:-
 wn('% ------------------------------------------------------------ %'),
 wn('%  Perfect information games and subgame perfection on Prolog  %'),
 wn('% ------------------------------------------------------------ %'),
 h0.
h0:-
 wn('%  subgame_perfect(G,N,A,P):-  subgame perfect equilibrium,'),
 wn('%  nash(behavior_strategy(G),N,A,P):-  NE for behavior strategies,'),
 wn('%  game(subgame(G,(S,_)),N,A,P):-  subgame of game G,'),
 wn('%  ---  the following predicates are cited from nash1.pl ---'),nl,
 wn('%  figure(A):-  display figures of the games in this program,'),
 wn('%  nash(G,N,S,P):-   Nash equilibrium of the game G,'),
 wn('%  dominance(G,N,S,P):-  dominant stratgy profile,'),
 wn('%  nash(mixed(G),N,S,P):-  approximated mixed equilibrium,'),
 wn('%  nash(fixed(G),N,S,P):-  fixed point is an equilibrium,'),
 wn('%  undominated(G,N,S,P):-  undominated strategy profile,'),
 wn('%  h0:-  this.'),nl.
me:-
 wn('% file: nash1c.pl'),
 wn('% created: 20-27 Apr 2003. '),
 wn('% imported: nash1b.pl (12 Apr 2003)'),
 wn('% imported: nash1.pl (1 Feb 2003)'),
 wn('% cited from: dpfirm0.pl (25 Mar 2003)'),nl.
references:-
 wn('% [1] Muto, S. (2001). An Introduction to Game Theory.'),
 wn('%   Nikkei Bunko. pp.161-194.(Japanese) '),
 wn('% [2] Selten, R. (1975). Reexamination of the perfectness concept'),
 wn('%   for equilibrium points in extensive games. International  '),
 wn('%   Jouranal of Game Theory 4(1): 25-55.'),
 wn('% [3] Kreps, D. M. and R. Wilson (1982). '),
 wn('%   Reputation and imperfect information. '),
 wn('%   Journal of Economic Theory 27: 253-279. '),nl.

wn(X):-write(X),nl.

:- dynamic game/4.
:- dynamic current_model/1.

figure(K/G):-
   game(G,figure(K),Figure1,Caption),
   append(Figure1,['',Caption,''],Figure),
   forall(member(L,Figure),(nl,write(L))).

figure(K/G):-game(G,figure(K),Figure),
   forall(member(L,Figure),(nl,write(L))).

current_model(g1).
probability_steps(2).
precision(5).

:- headline.

% -----------------------------------------------------------  %
% games
% -----------------------------------------------------------  %
games(Y):-
   findall(G,game(G,form(_),_,_),X),
   sort(X,Y).

% example g70
%----------------------------------------------------------------
game(g70(_),
   form(extensive),
   players([[[A,A],[A,A]],[[A,A],[A,A]]]),
   acts([
     [
      [[f(a2,a1,a3,a1),f(a2,a1,a3,b1)],
       [f(a2,a1,b3,a1),f(a2,a1,b3,b1)]],
      [[f(a2,b1,a3,a1),f(a2,b1,a3,b1)],
       [f(a2,b1,b3,a1),f(a2,b1,b3,b1)]]
     ],
     [
      [[f(b2,a1,a3,a1),f(b2,a1,a3,b1)],
       [f(b2,a1,b3,a1),f(b2,a1,b3,b1)]],
      [[f(b2,b1,a3,a1),f(b2,b1,a3,b1)],
       [f(b2,b1,b3,a1),f(b2,b1,b3,b1)]]
     ]
   ])
):- %A=[2,1,3,4].
   A=[e1,m(1),e2,m(2)].

game(g70(_),
   form(standard),
  %players([entrant1,monopolist,entrant2,monopolist]),
   players([e1,m(1),e2,m(2)]),
   acts([
     (e1,[a2,b2]),
     (m(1),[a1,b1]),
     (e2,[a3,b3]),
     (m(2),[a1,b1])
   ])
).


% sample execution.
%--------------------------------------------------------
% the standard form of game g70(a1) has the following two pure NEs.
/*

?- nash(g70(a1),N,A,P).

N = [2, 1, 3, 4]
A = [a2, a1, a3, a1]
P = [0, 10, 0, 10] ;

N = [2, 1, 3, 4]
A = [a2, a1, b3, b1]
P = [0, 8, 2, 8] ;

N = [2, 1, 3, 4]
A = [b2, b1, a3, a1]
P = [2, 8, 0, 8] ;

N = [2, 1, 3, 4]
A = [b2, b1, b3, b1]
P = [2, 6, 2, 6] ;

No
?- 
*/

%
game(g70(a1),payoff,[a2,A,a3,b1],[0,10,0,10]):-member(A,[a1,b1]).
game(g70(a1),payoff,[a2,A,a3,a1],[0,10,0,10]):-member(A,[a1,b1]).
game(g70(a1),payoff,[a2,A,b3,b1],[0,8,2,8]):-member(A,[a1,b1]).
game(g70(a1),payoff,[a2,A,b3,a1],[0,6,-2,6]):-member(A,[a1,b1]).
%
game(g70(a1),payoff,[b2,b1,a3,b1],[2,8,0,8]).
game(g70(a1),payoff,[b2,b1,a3,a1],[2,8,0,8]).
game(g70(a1),payoff,[b2,b1,b3,b1],[2,6,2,6]).
game(g70(a1),payoff,[b2,b1,b3,a1],[2,4,-2,4]).
game(g70(a1),payoff,[b2,a1,a3,b1],[-2,6,0,6]).
game(g70(a1),payoff,[b2,a1,a3,a1],[-2,6,0,6]).
game(g70(a1),payoff,[b2,a1,b3,b1],[-2,4,2,4]).
game(g70(a1),payoff,[b2,a1,b3,a1],[-2,2,-2,2]).
%


% behavior strategy of g70 is left to exercise.



% sample execution for g60.
%--------------------------------------------------------
% the standard form of this game has the following pure NEs.
/*

?- nash(g60,N,A,P).

N = [1, 2, 3]
A = [a1, b2, a3]
P = [3, 3, 4] ;

No
?- nash(behavior_strategy(g60),N,A,P).

N = [1, 2, 3]
A = [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->b3), (b1, b2->a3)]]
P = [3, 3, 4] ;

N = [1, 2, 3]
A = [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->b3), (b1, b2->b3)]]
P = [3, 3, 4] ;

N = [1, 2, 3]
A = [a1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->a3)]]
P = [3, 3, 4] ;

N = [1, 2, 3]
A = [a1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->b3), (b1, b2->a3)]]
P = [3, 3, 4] ;

N = [1, 2, 3]
A = [b1, [ (a1->a2), (b1->a2)], [ (a1, a2->b3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]]
P = [4, 3, 4] ;

N = [1, 2, 3]
A = [b1, [ (a1->a2), (b1->a2)], [ (a1, a2->b3), (a1, b2->b3), (b1, a2->a3), (b1, b2->b3)]]
P = [4, 3, 4] ;

N = [1, 2, 3]
A = [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]]
P = [4, 3, 4] ;

N = [1, 2, 3]
A = [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->b3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]]
P = [4, 3, 4] ;

No
?- subgame_perfect(g60,N,A,P).

<--omit-->

trial([4, 3, 4], [b1, a2, a3], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]])
  subgame(player:1/[1, 0, 0], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:1/[1, 0, 0], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:2/[0, 2, 0], [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:2/[0, 2, 0], [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:2/[0, 2, 0], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:2/[0, 2, 0], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->a2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 2, 3])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->a2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 2, 3])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->a2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 2, 3])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->a2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 2, 3])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:3/[0, 0, 3], [a1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [3, 3, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->a2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->a2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [4, 3, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->a2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 1, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 1, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->a2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 1, 4])ne
  subgame(player:3/[0, 0, 3], [b1, [ (a1->b2), (b1->b2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (b1, b2->b3)]], [5, 1, 4])ne

N = players([1, 2, 3])
A = acts([b1, [ (a1->b2), (b1->a2)], [ (a1, a2->a3), (a1, b2->a3), (b1, a2->a3), (..., ... ->b3)]])
P = payoffs([4, 3, 4]) ;

<--omit-->
No

*/


% example g60, a 3-person perfect information game with 3 stages.
%----------------------------------------------------------------
% The functor f represents the actual play vectors
%  in accordance with behavior strategy profiles.

game(g60,
   form(extensive),
   players([
     [[1,2,3], [1,2,3]],
     [[1,2,3], [1,2,3]]
   ]),
   acts([
     [[f(a1,a2,a3),f(a1,a2,b3)], [f(a1,b2,a3),f(a1,b2,b3)]],
     [[f(b1,a2,a3),f(b1,a2,b3)], [f(b1,b2,a3),f(b1,b2,b3)]]
   ])
).

% this standard form has a single pure NE (3,3,4).
game(g60,
   form(standard),
   players([1,2,3]),
   acts([(1,[a1,b1]), (2,[a2,b2]), (3,[a3,b3])])
).

% payoffs for game g60.
% The basis of modeling.
 
game(g60,payoff,[a1,a2,a3],[5,2,3]).
game(g60,payoff,[a1,a2,b3],[3,5,2]).
game(g60,payoff,[a1,b2,a3],[3,3,4]).
game(g60,payoff,[a1,b2,b3],[6,3,1]).
game(g60,payoff,[b1,a2,a3],[4,3,4]).
game(g60,payoff,[b1,a2,b3],[2,5,3]).
game(g60,payoff,[b1,b2,a3],[2,6,2]).
game(g60,payoff,[b1,b2,b3],[5,1,4]).
%


% behavior strategies of g60(1)
%----------------------------------------------------------------

game(behavior_strategy(g60),
   form(standard),
   players([1,2,3]),
   acts([
     (1,[a1,b1]),
     (2,[[a1->a2,b1->a2],[a1->a2,b1->b2],
         [a1->b2,b1->a2],[a1->b2,b1->b2]]),
     (3,S3)
   ])
 ):-
   X=([(a1,a2)->A,(a1,b2)->B,(b1,a2)->C,(b1,b2)->D]),
   findall(X,
     (
      member(A,[a3,b3]),
      member(B,[a3,b3]),
      member(C,[a3,b3]),
      member(D,[a3,b3])
     ),
   S3).

game(behavior_strategy(g60),payoff,[A,B1,C1],[P1,P2,P3]):-
   game(behavior_strategy(g60),payoff([A,_B,_C]),[A,B1,C1],[P1,P2,P3]).

game(behavior_strategy(g60),payoff([A,B,C]),[A1,A2,A3],[P1,P2,P3]):-
   game(behavior_strategy(g60),
     form(standard),
     players([1,2,3]),
     acts([(1,S1),(2,S2),(3,S3)])
   ),
   member(A1,S1),
   member(A2,S2),
   member(A3,S3),
   A = A1,
   member(A->B,A2),
   member((A,B)->C,A3),
   game(g60,payoff,[A,B,C],[P1,P2,P3]).



%


% sample execution for g50.
%--------------------------------------------------------
/*
?- nash(g50(weak),N,A,P).

N = [1, 2]
A = [a1, a2]
P = [0, 2] ;

N = [1, 2]
A = [b1, b2]
P = [0.5, 0] ;

No
?- nash(behavior_strategy(g50(weak)),N,A,P).

N = [1, 2]
A = [a1, [ (a1->a2), (b1->a2)]]
P = [0, 2] ;

N = [1, 2]
A = [b1, [ (a1->a2), (b1->b2)]]
P = [0.5, 0] ;

N = [1, 2]
A = [a1, [ (a1->b2), (b1->a2)]]
P = [0, 2] ;

N = [1, 2]
A = [b1, [ (a1->b2), (b1->b2)]]
P = [0.5, 0] ;

No
?- subgame_perfect(g50(weak),N,A,P).

trial([0, 2], [a1, a2], [a1, [ (a1->a2), (b1->a2)]])
  subgame(player:1/[1, 0], [a1, [ (a1->a2), (b1->a2)]], [0, 2])ne
  subgame(player:2/[0, 2], [a1, [ (a1->a2), (b1->a2)]], [0, 2])ne
  subgame(player:2/[0, 2], [b1, [ (a1->a2), (b1->a2)]], [0.5-1, -1])
  defeated_by([[b1, [ (a1->a2), (b1->b2)]], [0.5, 0]])
trial([0.5, 0], [b1, b2], [b1, [ (a1->a2), (b1->b2)]])
  subgame(player:1/[1, 0], [b1, [ (a1->a2), (b1->b2)]], [0.5, 0])ne
  subgame(player:2/[0, 2], [a1, [ (a1->a2), (b1->b2)]], [0, 2])ne
  subgame(player:2/[0, 2], [b1, [ (a1->a2), (b1->b2)]], [0.5, 0])ne

N = players([1, 2])
A = acts([b1, [ (a1->a2), (b1->b2)]])
P = payoffs([0.5, 0]) ;

trial([0, 2], [a1, b2], [a1, [ (a1->b2), (b1->a2)]])
  subgame(player:1/[1, 0], [a1, [ (a1->b2), (b1->a2)]], [0, 2])ne
  subgame(player:2/[0, 2], [a1, [ (a1->b2), (b1->a2)]], [0, 2])ne
  subgame(player:2/[0, 2], [b1, [ (a1->b2), (b1->a2)]], [0.5-1, -1])
  defeated_by([[b1, [ (a1->a2), (b1->b2)]], [0.5, 0]])
trial([0.5, 0], [b1, b2], [b1, [ (a1->b2), (b1->b2)]])
  subgame(player:1/[1, 0], [b1, [ (a1->b2), (b1->b2)]], [0.5, 0])ne
  subgame(player:2/[0, 2], [a1, [ (a1->b2), (b1->b2)]], [0, 2])ne
  subgame(player:2/[0, 2], [b1, [ (a1->b2), (b1->b2)]], [0.5, 0])ne

N = players([1, 2])
A = acts([b1, [ (a1->b2), (b1->b2)]])
P = payoffs([0.5, 0]) ;

No
*/

% example g50(_)
%----------------------------------------------------------------
% the chain store game of Selten (Kreps and Milgrom, 1982).
%   player 1: the entrant (challenger),
%   player 2: the monopolist (defending champ).

% the extensive form (i.e., the game tree) of g50(_)
game(g50(_),
   form(extensive),
   players([   % leaf of palyer tree: it means a path of palayer moves
     [1,2],    %  along play history (i.e., the inductive set of players),
     [1,2]     %  not the set of players per se(i.e, the node of act tree).
   ]),
   acts([      %  actual play paths rather than behavior_strategies
     [f(a1, a2),f(a1, b2)],
     [f(b1, a2),f(b1, b2)]
   ])
).

% 23-26 Apr 2003. yet another code for behavior strategies.

game(G,terminal,players(N),acts(A)):-
   game(G,form(standard),players(N0),acts(_)),
   length(N0,LN),
   game(G,terminal(LN,_),players(N),acts(A)).

game(G,terminal(1,Pred),players([J]),acts([A])):-
   game(G,tree,player(J),act(Pred->A)),
   \+ (
     game(G,information(H),player(_J1),choices(_C)),
     member(A,H)
   ).

game(G,terminal(N,Pred),players([J|X]),acts([A|Y])):-
   game(G,tree,player(J),act(Pred->A)),
   game(G,terminal(N1,A),players(X),acts(Y)),
   N is N1 + 1.

game(G,local_strategy,J,H->A):-
   game(G,information(H),player(J),choices(C)),
   game(G,tree,player(J),act(R->A)),
   member(R,H),
   member(A,C).

game(g50,tree,player(1),act(r->a1)).
game(g50,tree,player(1),act(r->b1)).
game(g50,tree,player(2),act(a1->a2)).
game(g50,tree,player(2),act(a1->b2)).
game(g50,tree,player(2),act(b1->a2)).
game(g50,tree,player(2),act(b1->b2)).

game(g50,information([r]),player(1),choices([a1,b1])).
game(g50,information([a1]),player(2),choices([a2,b2])).
game(g50,information([b1]),player(2),choices([a2,b2])).


% the behavior strategy for the game g50. 
% note: behavior strategies contain counterfactual arguments which are 
% not actually played on the equilibrium path. 

game(behavior_strategy(g50(_F)),payoff,[A,B1],[P1,P2]):-
   game(behavior_strategy(g50(_F)),payoff([A,_B]),[A,B1],[P1,P2]).

game(behavior_strategy(g50(_F)),payoff([A,B]),[A,B1],[P1,P2]):-
   game(behavior_strategy(g50(_F)),
     form(standard),
     players([1,2]),
     acts([(1,S1),(2,S2)])
   ),
   member(B1,S2),
   member(A,S1),
   member(A->B,B1),
   game(g50(_F),payoff,[A,B],[P1,P2]).

game(behavior_strategy(g50(_)),
   form(standard),
   players([1,2]),
   acts([
     (1,[a1,b1]),
     (2,[[a1->a2, b1->a2],
         [a1->a2, b1->b2],
         [a1->b2, b1->a2],
         [a1->b2, b1->b2]
     ])
   ])
).



% this form of the game produces a single NE which is not SPE.
game(g50,
   form(standard),
   players([1,2]),
   acts([(1,[a1,b1]), (2,[a2,b2])])
).

game(g50(_),
   form(standard),
   players([1,2]),
   acts([(1,[a1,b1]), (2,[a2,b2])])
).

% the basis of modeling. 

game(g50,parameter,[a:2,b:0.5],_).

game(g50,payoff,A,P):-game(g50(weak),payoff,A,P).

game(g50(weak),payoff,[a1,a2],[0,A]):-game(g50,parameter,[a:A,_],_).
game(g50(weak),payoff,[a1,b2],[0,A]):-game(g50,parameter,[a:A,_],_).
game(g50(weak),payoff,[b1,a2],[B-1,-1]):-game(g50,parameter,[_,b:B],_).
game(g50(weak),payoff,[b1,b2],[B,0]):-game(g50,parameter,[_,b:B],_).
game(g50(tough),payoff,[a1,a2],[0,A]):-game(g50,parameter,[a:A,_],_).
game(g50(tough),payoff,[a1,b2],[0,A]):-game(g50,parameter,[a:A,_],_).
game(g50(tough),payoff,[b1,a2],[B-1,0]):-game(g50,parameter,[_,b:B],_).
game(g50(tough),payoff,[b1,b2],[B,-1]):-game(g50,parameter,[_,b:B],_).
%
game(g50(_),figure(1),Figure,Caption):-
   Figure=[P1,P2,P3,L1,L2,L3,L4,L5,L6,L7,L8,L9],
   P1= '% the chain store game of Selten.',
   P2= '% player 1: the entrant',
   P3= '% player 2: the monopolist',
   L1= '%            entry:       not fight:             ',
   L2= '%            b1           b2                     ',
   L3= '%       [1]--------->[2]--------->[B,C]          ',
   L4= '%        |            |               C=0(weak); ',
   L5= '%     a1 |         a2 |               C=-1(tough)',
   L6= '%        |            |                  ',
   L7= '%        V            V                  ',
   L8= '%      [0,A]        [B-1,D]  D=-1(weak); ',
   L9= '%             A>1,1>B>0      D=0(tough)  ',
   Caption ='% Fig. game tree of g50 (the chainstore game of Selten)'.



% a 2-person game of standard form which represents a game tree below.
game(g40,form(standard), players([1,2]),
        acts([(1,[(a1,l),(a1,r),(b1,l),(b1,r)]), (2,[a2,b2])])).
game(g40,payoff,[(a1,l),a2],[2,5]).
game(g40,payoff,[(a1,r),a2],[2,5]).
game(g40,payoff,[(b1,l),a2],[4,1]).
game(g40,payoff,[(b1,r),a2],[0,0]).
game(g40,payoff,[(a1,l),b2],[2,5]).
game(g40,payoff,[(a1,r),b2],[2,5]).
game(g40,payoff,[(b1,l),b2],[0,0]).
game(g40,payoff,[(b1,r),b2],[1,4]).

game(g40,figure(1),Figure,Caption):-
   Figure=[
     '%         b1         b2                 ',
     '%  [1]------->[2]------>[1]----->[1,4]  ',
     '%a1 |          |     .   |     r        ',
     '%   |        a2|   .   l V              ',
     '%   V          | .      [0,0]           ',
     '% [2,5]        V.  r                    ',
     '%　　　　　　 [1]----->[0,0]            ',
     '%              |               ',
     '%            l V               ',
     '%             [4,1]            '
   ],
   Caption ='% Fig. game tree of g40(cf.,Bicchieri(1993), p.101. figure 3.6)'.

% a 3-person game of standard form 
game(g30,form(standard), players([1,2,3]),
        acts([(1,[a1,a2]), (2,[b1,b2]), (3,[c1,c2])])).
game(g30,payoff,[a1,b1,c1],[2,1,0]).
game(g30,payoff,[a1,b2,c1],[0,0,0]).
game(g30,payoff,[a2,b1,c1],[0,0,0]).
game(g30,payoff,[a2,b2,c1],[1,2,0]).
game(g30,payoff,[a1,b1,c2],[1,2,1]).
game(g30,payoff,[a1,b2,c2],[0,0,1]).
game(g30,payoff,[a2,b1,c2],[0,0,1]).
game(g30,payoff,[a2,b2,c2],[2,1,1]).
%
game(g30,figure(1),Figure,Caption):-
   Figure=[
     '%      c1:b1  c1:b2    c2:b1  c2:b2      ',
     '%    +-------+-------+-------+-------+   ',
     '% c1:|   2   |   0   |  ---  |  ---  |   ',
     '% a1 |   1   |   0   l  ---  |  ---  |   ',
     '%    |   0   |   0   l  ---  |  ---  |   ',
     '%    +-------+-------+-------+-------+   ',
     '% c1:|   0   |   1   |  ---  |  ---  |   ',
     '% a2 |   0   |   2   l  ---  |  ---  |   ',
     '%    |   0   |   0   l  ---  |  ---  |   ',
     '%    +-------+-------+-------+-------+   ',
     '% c2:|  ---  |  ---  |   1   |   0   |   ',
     '% a1 |  ---  |  ---  l   2   |   0   |   ',
     '%    |  ---  |  ---  l   1   |   1   |   ',
     '%    +-------+-------+-------+-------+   ',
     '% c2:|  ---  |  ---  |   0   |   2   |   ',
     '% a2 |  ---  |  ---  l   0   |   1   |   ',
     '%    |  ---  |  ---  l   1   |   1   |   ',
     '%    +-------+-------+-------+-------+   '
   ],
   Caption ='% Fig. game matrix of g30.'.


%-----------------------------------------------------------
% transformation of games into the appropriate forms
% to compute the solutions
%-----------------------------------------------------------
game(G,players(N),acts(A),payoffs(P)):-
   game(G,form(standard),players(N),_),
   game(G,payoff,A,P).

%-----------------------------------------------------------


% re-utilization of game/3 (/2) of fixpo.pl
%game(G,players([1,2]),acts([A,B]),payoffs([P1,P2])):-
%   game(G,[player(1,act(A)),player(2,act(B))],payoffs([P1,P2])).
game(G,form(S),players([1,2]),acts([(1,[a1,a2]),(2,[b1,b2])])):-
   member(G,[g0,g1,g2,g3,g4,g5,g6]),
   S = standard.
game(G,payoff,[A,B],[P1,P2]):-
   member(G,[g0,g1,g2,g3,g4,g5,g6]),
   game(G,[player(1,act(A)),player(2,act(B))],payoffs([P1,P2])).
game(G,players([1,2]),fixed([X,Y]),exp_payoffs([E1,E2])):-
   current_model(G),
   fp([X,Y],_K),
   exp_payoff(G,1,E1,[X,Y]),
   exp_payoff(G,2,E2,[X,Y]).
game(mixed(G),players([1,2]),acts([X,Y]),payoffs([E1,E2])):-
   mixed_strategies(G,[X,Y]),
   exp_payoff(G,1,E1,[X,Y]),
   exp_payoff(G,2,E2,[X,Y]).
game(undoms(G,T),form(standard), players(N), acts(A)):-
   undominated(T,G,N,_,_)->true,
   setof(B,P^undominated(T,G,N,B,P),A).
game(undoms(G,T),players(N),acts(A),payoffs(P)):-
   undominated(T,G,N,A,P).


% subgames for the extensive form game
%-----------------------------------------------------------
% added: 4 Apr 2003.
% modified: 6-12 Apr 2003.
% modified: 20 Apr 2003.
% modified: 22-27 Apr 2003.

game(subgame(G,
     (subtree:S,path:Path,I,player:J,played:POS)),
     players(NS),acts(BS),payoffs(P)
  ):-
   game(G,form(extensive),players(NT),acts(T)),
   I=(level:1/B,no:_O/_M,superior:_,items:_),
   subtree(S,Path,I,T),
   member(F,S),
   F=..[f|A],
   IN=(level:1/B,no:_O/_M,superior:_,items:SOP),
   subtree(SOP,Path,IN,NT),
   % SOP: a series of players move along the game tree.
   game(behavior_strategy(G),payoff(A),BS,P),
   zeros(Z,B),
   reverse(SOP,[J|POS]),
   replace(B/B,Z,J,NS).

game(subgame(G,
     (subtree:S,path:Path,I,player:J,played:POS)),
     players(NS),acts(BS),payoffs(P)
  ):-
   game(G,form(extensive),players(_NT),acts(T)),
   I=(level:L/B,no:K/_M,superior:_,items:_),
   subtree(S,Path,I,T),
   L > 1,
   I1=(level:L1/B,no:_K1/_M1,superior:(L,K),items:_),
   game(
     subgame(G,(_S1,path:[_N|Path],I1,player:_J1,played:[J|POS])),
     players(NS1),acts(BS),payoffs(P)
   ),
   R is B - L1,
   R1 is R + 1,
   replace(R/B,NS1,J,NS0),
   replace(R1/B,NS0,0,NS).


%
% strategy space for each agent 
% -----------------------------------------------------------  %
acts(G,I,S):-
   game(G,form(_),players(N),acts(A)),
   nth1(K,N,I),
   nth1(K,A,(I,S)).
%
% payoffs for each agent
% -----------------------------------------------------------  %
payoff(G,J,S,U):-
   game(G,payoff,S,P),
   game(G,form(_),players(N),_),
   nth1(K,N,J),
   nth1(K,P,U).
%
% -----------------------------------------------------------  %
% Nash strategy equilirium and other solution concepts 
% -----------------------------------------------------------  %
mutate(G,S,J,S1):-
   game(G,players(N),acts(S),_),
   game(G,players(N),acts(S1),_),
   subtract(N,[J],NJ),%write(remains(NJ)),nl,
   forall(member(J1,NJ),
    (
     nth1(K,N,J1),%write(j1(J1,k(J))),
     nth1(K,S,SK),%write(s(SK)),
     nth1(K,S1,SK1),%write(s1(SK1)),nl,
     SK = SK1
    )
   ).
% modified: 30 Jan 2003.
best_response(G,J,N,S,P):-
   game(G,players(N),acts(S),payoffs(P)),
   member(J,N),
   \+ defeated_by(G,J,N,[S,P],_).

defeated_by(G,J,N,[S,P],[S1,P1]):-
   game(G,players(N),acts(S),payoffs(P)),
   nth1(K,N,J),
   (
     mutate(G,S,J,S1), 
     game(G,players(N),acts(S1),payoffs(P1)),
     nth1(K,P1,PK1),
     nth1(K,P,PK),
     PK < PK1
   ).

nash(G,J,N,S,P):- 
   best_response(G,J,N,S,P).
%
nash(G,N,S,P):-
   game(G,players(N),acts(S),payoffs(P)),
   \+ (member(J,N), \+ best_response(G,J,N,S,P)).
%
nash(fixed(G),N,S,E):-
   game(G,players(N),fixed(S),exp_payoffs(E)).
%nash(fixed(G),[1,2],[X,Y],[E1,E2]):-
%   game(G,[X,Y],exp_payoffs([E1,E2])).
%
dominance(G,J,N,S,P):-
   game(G,players(N),acts(S),payoffs(P)),
   nth1(K,N,J),
   nth1(K,S,SJ),
   \+ (
     game(G,players(N),acts(S1),payoffs(P1)),
     nth1(K,S1,SJ),
     \+ (
       best_response(G,J,N,S1,P1)
       ->true;
       (nl,tab(2),write(defeated_by(S1,P1)),fail)
     )
   ).
dominance(G,N,S,P):-
   game(G,players(N),acts(S),payoffs(P)),
   \+ (member(J,N), \+ dominance(G,J,N,S,P)).
%
%  iterated dominance
% -----------------------------------------------------------  %
% modified: 25, 30 Jan 2003.
dominate(strong,G,J,SJ,DJ):-
  % game(G,form(standard),players(N),_),
  % \+ G =.. [mixed,_], 
   action_pair(G,J,[SJ/_S,PJ],[DJ/_D,PDJ]),
   PJ > PDJ,
   \+ (
     game(G,players(N),acts(S1),payoffs(P1)),
     nth1(K,S1,SJ),
     nth1(K,P1,P1J),
     game(G,players(N),acts(S2),payoffs(P2)),
     nth1(K,S2,DJ),
     nth1(K,P2,P2J),
     P2J > P1J
   ).
dominate(weak,G,J,SJ,DJ):-
  % game(G,form(standard),players(N),_),
  % \+ G =.. [mixed,_], 
   action_pair(G,J,[SJ/_S,PJ],[DJ/_D,PDJ]),
   \+ PJ > PDJ,
   \+ (
     game(G,players(N),acts(S1),payoffs(P1)),
     nth1(K,S1,SJ),
     nth1(K,P1,P1J),
     game(G,players(N),acts(S2),payoffs(P2)),
     nth1(K,S2,DJ),
     nth1(K,P2,P2J),
     P2J > P1J
   ).
dominated(T,G,J,S,D):-
   dominate(T,G,J,D,S).
undominated(T,G,N,S,P):-
   game(G,players(N),acts(S),payoffs(P)),
   %\+ G =.. [mixed,_], 
   member(T,[weak,strong]),
   \+ (
     nth1(K,N,J),
     nth1(K,S,SJ),
     dominated(T,G,J,SJ,_D)
   ).
action_pair(G,J,[SJ/S,PJ],[DJ/D,PDJ]):-
   game(G,players(N),acts(S),payoffs(P)),
   nth1(K,N,J),
   nth1(K,S,SJ),
   nth1(K,P,PJ),
   mutate(G,S,J,D),
   game(G,players(N),acts(D),payoffs(PD)),
   nth1(K,D,DJ),
   DJ \= SJ,
   nth1(K,PD,PDJ).

%
%  subgame perfection
% -----------------------------------------------------------  %
% added: 6 Mar 2003.
% modified: 5-25 Mar 2003. abolish.
% modified: 26-27 Mar 2003. a new code.

subgame_perfect(G,players(NS),acts(BS),payoffs(P)):-
  %nash(subgame(G,(_T,path:[],_I,player:_,played:[])),NS,BS,P),
   nash(behavior_strategy(G),NS,BS,P),
   game(behavior_strategy(G),payoff(A),BS,P),
      nl,write(trial(P,A,BS)),
   forall(
     (
      nth1(K,BS,_AJ),
      %member(R->Q,AJ),
      game(subgame(G,SG),players(NS1),acts(BS1),payoffs(P1)),
      nth1(K,NS1,J),
      J \= 0,
      forall(
        (
         nth1(K1,BS,AJ1),
         K1 >= K
        ),
        nth1(K1,BS1,AJ1)
      )
     ),
     (
      nl,tab(2),write(subgame(player:J/NS1,BS1,P1)),
      \+ (
       defeated_by(subgame(G,SG),J,NS1,[BS1,P1],[BS2,P2]),
       forall(
         (
          nth1(K1,BS2,AJ1),
          K1 > K
         ),
         nth1(K1,BS1,AJ1)
       ),
       (nl,tab(2),write(defeated_by([BS2,P2])))
      ),
      write(ne)
     )
   ).
 




%
% -----------------------------------------------------------  %
% mixed strategy and expected payoff
% -----------------------------------------------------------  %
% mixed strategy profile --> probability of each outcome
mixp_precision(5).
mixed_strategies(G,[P1,P2]):-
   game(G,form(standard),players([1,2]),acts([(1,A1),(2,A2)])),
   length(A1,M1),
   length(A2,M2),
   mixp_precision(L),
   make_a_prob(P1,base(M1),steps(L)),
   make_a_prob(P2,base(M2),steps(L)).
exp_payoff(G,J,E,P):-
   findall(V,
     (
      payoff(G,J,S,U),           % wn(payoff(G,J,S,U)),
      index_of_acts(G,S,Index),  % wn(act(Index)),
      index_of_tuple(P,P1,Index),% wn(p(P1)),
      product(P1,Q),             % wn(q(Q)),
      V is U * Q                 %,wn(v(V)),nl
     ),
   Vs),
   sum(Vs,E).
%
% refer to an act profile.
index_of_acts(G,A,Index):-
   game(G,players(N),acts(A),payoffs(_)),
   length(N,LN),
   length(A,LN),
   length(Index,LN),
   findall(L,
     (
      nth1(K,N,J), % K-th agent
      nth1(K,A,AJ),
      acts(G,J,SJ),
      nth1(L,SJ,AJ)
     ),
   Index).
%
%********************************
% cited from previous version (fixpo.pl)
%********************************
% with minor modifications.
%
%--------------------------------------------
% continuous map by Nash (1951)
%--------------------------------------------
%   c[k]=max(v1([s1[k],Y])-v1([X,Y]),0),
%   d[k]=max(v2([X,s2[k]])-v1([X,Y]),0),
%   X'[k]=(X[k]+c[k])/(1+c[1]+...+c[K1]),
%   Y'[k]=(Y[k]+d[k])/(1+d[1]+...+d[K2]).
%
nash_map(G,c(1,C),[X,Y]):-
   exp_payoff(G,1,E,[X,Y]),
   exp_payoff(G,1,E1,[[1,0],Y]),
   C0 is E1 - E,
   (C0 > 0 -> C = C0; C =0). 
nash_map(G,c(2,C),[X,Y]):-
   exp_payoff(G,1,E,[X,Y]),
   exp_payoff(G,1,E1,[[0,1],Y]),
   C0 is E1 - E,
   (C0 > 0 -> C = C0; C =0). 
nash_map(G,d(1,D),[X,Y]):-
   exp_payoff(G,2,E,[X,Y]),
   exp_payoff(G,2,E1,[X,[1,0]]),
   D0 is E1 - E,
   (D0 > 0 -> D = D0; D =0). 
nash_map(G,d(2,D),[X,Y]):-
   exp_payoff(G,2,E,[X,Y]),
   exp_payoff(G,2,E1,[X,[0,1]]),
   D0 is E1 - E,
   (D0 > 0 -> D = D0; D =0). 
%
% it is important that this predicate has separated from updated.
nash_map(G,[C1,C2],[D1,D2],[X,Y]):-
   nash_map(G,c(1,C1),[X,Y]),%wn(C1),
   nash_map(G,c(2,C2),[X,Y]),%wn(C2),
   nash_map(G,d(1,D1),[X,Y]),%wn(D1),
   nash_map(G,d(2,D2),[X,Y]),%wn(D2),
   !.
updated(G,[TX,TY],[X,Y],[[C1,C2],[D1,D2]]):-
  % prob(X,base(2),_),
  % prob(Y,base(2),_),%wn(prob(X,Y)),
   forall(member(P,X),\+var(P)),%wn(ok1),
   forall(member(P,Y),\+var(P)),%wn(ok2),
   nash_map(G,[C1,C2],[D1,D2],[X,Y]),
   X=[X1,X2], 
   Y=[Y1,Y2], 
   SC is  1 + C1 + C2,
   SD is  1 + D1 + D2,
   TX1 is (X1 + C1) / SC,
   TX2 is (X2 + C2) / SC,
   TY1 is (Y1 + D1) / SD,
   TY2 is (Y2 + D2) / SD,
   TX=[TX1,TX2], 
   TY=[TY1,TY2].
%
% a pair of the first coordinate probabilities, each vector of distribution
p2(X,Y):- X=[[A,_A1],[B,_B1]],Y=[A,B].
p2(X):-p2(_,X).
print_seri:-
   path_of_map(B,A,_C,D),p2(B,PB),p2(A,PA),
   write((tp(PB,'exp_gains_against_pure'(D)):-p(PA))),wn('.').
path_of_map([X,Y],[X,Y],[[X1],[Y1]],[[0,0],[0,0]]):-
   probability_steps(ST),
   make_a_prob(X,base(2),steps(ST)), 
   make_a_prob(Y,base(2),steps(ST)),
   p2([X,Y],[X1,Y1]). % X=[X1,_], Y=[Y1,_].
path_of_map([TX,TY],[X,Y],H0):-
   path_of_map([TX,TY],[X,Y],H0,_E0).
path_of_map([TX,TY],[X,Y],[[TX1|H1],[TY1|H2]]):-
   path_of_map([Z1,Z2],[X,Y],[H1,H2]),
   current_model(G),
   updated(G,[TX,TY],[Z1,Z2],_),
   \+converge([TX,TY],[Z1,Z2]),%wn((p(X,Y),t(TX,TY))),%read(y),
   p2([TX,TY],[TX1,TY1]),%wn('%!'),
   length(H1,L),write(level(L)),nl,
   (is_a_long_trip(L)
    -> (write(non_fxp(L,[Z1,Z2])),nl,
	write(' its a so long trip. tired?'),read(y)->!,fail);true).
is_a_long_trip(L):- L >=30.
is_a_very_long_trip(L):- L >=50.
%
%--------------------------------------------
% fixed point of the map --> Nash equilibrium
%--------------------------------------------
fp([TX,TY],K):-
   fixed_point([TX,TY],K).
fixed_point([TX,TY],L):-
   path_of_map([Z1,Z2],_,[H1,_]),
   updated(_G,[TX,TY],[Z1,Z2],_),
   converge([TX,TY],[Z1,Z2]),
   length(H1,L),write(level(L)),nl,
   (is_a_long_trip(L)
    -> (write(fxp(L,[Z1,Z2])),nl,
	write(' its a so long trip. tired?'),read(y)->!,fail);true).
converge([TX,TY],[X,Y]):-
   precision(M),
   converge1([TX,TY],[X,Y],M).
converge1([TX,TY],[X,Y],M):-
   current_model(G),
   exp_payoff(G,1,E1,[X,Y]),
   exp_payoff(G,2,E2,[X,Y]),
   exp_payoff(G,1,F1,[TX,TY]),
   exp_payoff(G,2,F2,[TX,TY]),
   P1 is integer(E1 * (10^M)),
   P2 is integer(E2 * (10^M)),
   Q1 is integer(F1 * (10^M)),
   Q2 is integer(F2 * (10^M)),
   S1 is (Q1-P1)^2,
   S2 is (Q2-P2)^2,write((e(F1-E1,F2-E2),d(S1,S2))),nl,%read(y),
   S is S1 + S2,
   S < 5.
converge2([[TX,_],[TY,_]],[[X,_],[Y,_]],M):-
   TXP is integer(TX * (10^M)),
   TYP is integer(TY * (10^M)),
   XP is integer(X * (10^M)),
   YP is integer(Y * (10^M)),
   S is (TXP-XP)^2 + (TYP-YP)^2,
   S < 1.
%
%%  interface: to display and to change of game payoffs 
game:-
  forall(
    (
     G=game([player(1,act(A1)),player(2,act(B1))],payoffs([P1,P2])),
     G
    ),
    (
     wn((act(A1,B1),'-->',payoffs(P1,P2)))
    )
  ).
set_payoffs:-
  forall(
    (
     G=game(GN,[player(1,act(A1)),player(2,act(B1))],payoffs([P1,P2])),
     G
    ),
    (
     write('the current model: '),write(GN),nl,
     tab(4),wn((act(A1,B1)-->payoffs(P1,P2))),
     write('change the payoffs ? '),read(U),
     write('new name of the model: '),read(GN1),
     (GN=GN1->retract(G);true),
     (
      U=[_,_]
      ->
        (
         G1=game(GN1,[player(1,act(A1)),player(2,act(B1))],payoffs(U)),
         assert(G1)
        );true
     )
    )
  ),
  game.
%
%--------------------------------------------
% other examples of game in fixpo.pl  
%--------------------------------------------
%
%  a game with two pure strategy equilibria.
game(g0,[player(1,act(a1)),player(2,act(b1))],payoffs([1,1])).
game(g0,[player(1,act(a1)),player(2,act(b2))],payoffs([0,0])).
game(g0,[player(1,act(a2)),player(2,act(b1))],payoffs([0,0])).
game(g0,[player(1,act(a2)),player(2,act(b2))],payoffs([0,0])).
game(g0,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   1   |   0   |   ',
     '% a1 |   1   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   0   |   0   |   ',
     '% a2 |   0   |   0   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g0.'
   ].
%  a game with two pure strategy equilibria.
game(g1,[player(1,act(a1)),player(2,act(b1))],payoffs([2,1])).
game(g1,[player(1,act(a1)),player(2,act(b2))],payoffs([0,0])).
game(g1,[player(1,act(a2)),player(2,act(b1))],payoffs([0,0])).
game(g1,[player(1,act(a2)),player(2,act(b2))],payoffs([1,2])).
game(g1,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   2   |   0   |   ',
     '% a1 |   1   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   0   |   1   |   ',
     '% a2 |   0   |   2   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g1.'
   ].
%  a game with a pure strategy equilibrium.
game(g2,[player(1,act(a1)),player(2,act(b1))],payoffs([1,3])).
game(g2,[player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game(g2,[player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game(g2,[player(1,act(a2)),player(2,act(b2))],payoffs([3,1])).
game(g2,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   1   |   1   |   ',
     '% a1 |   3   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   2   |   1   |   ',
     '% a2 |   0   |   3   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g2.'
   ].
%  a game with no pure strategy equilibrium.
game(g3,[player(1,act(a1)),player(2,act(b1))],payoffs([0,3])).
game(g3,[player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game(g3,[player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game(g3,[player(1,act(a2)),player(2,act(b2))],payoffs([0,1])).
game(g3,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   0   |   1   |   ',
     '% a1 |   3   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   2   |   0   |   ',
     '% a2 |   0   |   1   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g3.'
   ].
%  a game with no pure strategy equilibrium.
game(g4,[player(1,act(a1)),player(2,act(b1))],payoffs([0,1])).
game(g4,[player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game(g4,[player(1,act(a2)),player(2,act(b1))],payoffs([1,0])).
game(g4,[player(1,act(a2)),player(2,act(b2))],payoffs([0,1])).
game(g4,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   0   |   1   |   ',
     '% a1 |   1   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   1   |   0   |   ',
     '% a2 |   0   |   1   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g4.'
   ].
% a game with two pure strategy equilibria.
game(g5,[player(1,act(a1)),player(2,act(b1))],payoffs([1,5])).
game(g5,[player(1,act(a1)),player(2,act(b2))],payoffs([0,4])).
game(g5,[player(1,act(a2)),player(2,act(b1))],payoffs([0,0])).
game(g5,[player(1,act(a2)),player(2,act(b2))],payoffs([1,1])).
game(g5,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   1   |   0   |   ',
     '% a1 |   5   |   4   l   ',
     '%    +-------+-------+   ',
     '%    |   0   |   1   |   ',
     '% a2 |   0   |   1   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g5.'
   ].
% a game with no pure strategy equilibrium.
game(g6,[player(1,act(a1)),player(2,act(b1))],payoffs([1,1])).
game(g6,[player(1,act(a1)),player(2,act(b2))],payoffs([2,0])).
game(g6,[player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game(g6,[player(1,act(a2)),player(2,act(b2))],payoffs([1,1])).
game(g6,figure(1),Figure):-
   Figure=[
     '%        b1      b2      ',
     '%    +-------+-------+   ',
     '%    |   1   |   2   |   ',
     '% a1 |   1   |   0   l   ',
     '%    +-------+-------+   ',
     '%    |   2   |   1   |   ',
     '% a2 |   0   |   1   l   ',
     '%    +-------+-------+   ',
     '% Fig. game matrix of g6.'
   ].
%



%
% -----------------------------------------------------------  %
% Arithmetic and so on including probabilistic operators
% -----------------------------------------------------------  %
% cited from: math1.pl
% sum
% -----------------------------------------------------------  %
sum([],0).
sum([X|Members],Sum):-
   sum(Members,Sum1),
  %number(X),
   Sum is Sum1 + X.
%
% product
% -----------------------------------------------------------  %
product([],1).
product([X|Members],Z):-
   product(Members,Z1),
  %number(X),
   Z is Z1 * X.
%
% allocation
% -----------------------------------------------------------  %
allocation(N,A,[X|Y]):-
    allocation(N,A,A,[X|Y]).
allocation(0,_,0,[]).
allocation(N,A,B,[X|Y]):-
    integer(A),
    length([X|Y],N),
    allocation(_N1,A,B1,Y),
    % N1 is N - 1,
    % sum(Y,B1),
    K is A - B1 + 1,
    length(L,K),
    nth0(X,L,X),
    B is B1 + X.
%
% probability (percentile) by using allocation
% -----------------------------------------------------------  %
probabilities(0,[]).
probabilities(N,[X|Y]):-
    integer(N),
    length([X|Y],N),
    allocation(N,100,[X|Y]).
% 
% any ratio (weight) can be interpreted into a prob.
scale(W,1/Z,P):-
    findall(Y,(nth1(_K,W,X),Y is X/Z),P).
probabilities(W,N,P):-
    length(W,N),
    sum(W,Z),
    scale(W,1/Z,P).
%
make_a_prob(P,base(M),steps(L)):-
    var(P),
    length(P,M),
    allocation(M,L,W),
    probabilities(W,M,P).
make_a_prob(P,base(M),_):-
    \+ var(P),
    length(P,M),
    \+ (
     member(P1,P),
     (
      var(P1);
      P1 > 1;
      P1 < 0
     )
    ),
    sum(P,1).
%
% expected value
% -----------------------------------------------------------  %
expected_value(W,A,E):-
    length(A,N),
    probability(W,N,P),
    product_sum(P,A,_,E).
%
% weighted sum
% -----------------------------------------------------------  %
product_sum([],[],[],0).
product_sum([P|Q],[A|B],[E|F],V):-
    length(Q,N),
    length(B,N),
    product_sum(Q,B,F,V1),
    E is P * A,
    V is V1 + E.
%
% -----------------------------------------------------------  %
%   Utilities for list operations
% -----------------------------------------------------------  %
% cited from: set.pl

% index for a tuple.
% -----------------------------------------------------------  %
% 1) only mention for a direct product of sets.
index_of_tuple(B,A,Index):-
   \+ var(B),
   \+ var(A),
   length(B,LN),  % base sets
   length(A,LN),  
   length(Index,LN),
   findall(L,
     (
      nth1(K,B,BJ), %write(a(K,B,BJ)),
      nth1(L,BJ,AJ),%write(b(L,BJ,AJ)),
      nth1(K,A,AJ)  %,write(c(K,A,AJ)),nl
     ),
   Index).
index_of_tuple(B,A,Index):-
   \+ var(B),
   \+ var(Index),
   var(A),
   length(B,LN),  % base sets
   length(Index,LN),
   length(A,LN),  
   findall(AJ,
     (
      nth1(K,B,BJ),
      nth1(K,Index,L),
      nth1(L,BJ,AJ)
     ),
   A).
%
% descending/ascending natural number sequence less than N.
% -----------------------------------------------------------  %
dnum_seq([],N):-N<0,!.
dnum_seq([0],1).
dnum_seq([A|Q],N):-
   A is N - 1,
   length(Q,A),
   dnum_seq(Q,A).
anum_seq(Aseq,N):-dnum_seq(Dseq,N),sort(Dseq,Aseq).
%
% inquire the goal multiplicity
% -----------------------------------------------------------  %
sea_multiple(Goal,Cond,N,M):-
  Clause=..Goal,
  findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M).
%
bag0([],_A,0).
bag0([C|B],A,N):-
   length([C|B],N),
   bag0(B,A,_N1),
   member(C,A).
zeros(Zero,N):-bag0(Zero,[0],N).
ones(One,N):-bag0(One,[1],N).
%

%
% bag1/3 : do not allow multiplicity
% -----------------------------------------------------------  %
% modified: 15 Oct 2002. bag fixed for unboundness.
% modified: 27 Feb 2003. bag (asc_nnseq->anum_seq).
bag1([],_A,0).
bag1([C|B],A,N1):-
  \+var(A),
  length(A,L),
  anum_seq(Q,L),
  member(N,Q),
  length(B,N),bag1(B,A,N),N1 is N + 1,
  member(C,A),\+member(C,B).
%
% ordering/3
% -----------------------------------------------------------  %
% A: an order
% B: base set
% C: length
ordering(A,B,C):-bag1(A,B,C).

% a sequence of binary choice for a list:
%--------------------------------------------------
list_projection([],[],[]).
list_projection([X|Y],[_|B],C):-
   list_projection(Y,B,C),
   X = 0.
list_projection([X|Y],[A|B],[A|C]):-
   list_projection(Y,B,C),
   X = 1.


% subset_of/3 : subset-enumeration 
% -----------------------------------------------------------  %
subset_of(A,N,As):-
   length(As,L),
   length(D,L),
   list_projection(D,As,B),
   length(B,N),
   sort(B,A).

% complement and symmetric complement
% -----------------------------------------------------------  %
complement(AC,A,As):-
   subset_of(A,_N,As),
   subtract(As,A,AC).

complement_1(AC,A,As):-
   list_projection(P,As,A),
   c_list_projection(P,As,AC).

symmetric_complement(AC,A,As):-
   list_projection(P,As,A),
   c_list_projection(P,As,AC),
   list_projection(P1,As,AC),
   P @< P1.



%
% characteristic_vector/3
% -----------------------------------------------------------  %
% modified: 8 Feb 2003.  without using nth1.
% modified: 13 Feb 2003.  bug fix. without using member.
characteristic_vector(X,B,Index):-
   \+ var(B),
   %member(X,B),
   list_projection(Index,B,[X]).

characteristic_vector(1,X,[X|B],[1|DX]):-
   characteristic_vector(X,[X|B],[1|DX]).
characteristic_vector(K,X,[_|B],[0|DX]):-
   characteristic_vector(K1,X,B,DX),
   K is K1 + 1.

/*
% an alternative
characteristic_vector(N,N,[1|O]):-
   integer(N),
   N1 is N - 1,
   length(O,N1),
   zeros(O,N1).
characteristic_vector(K,N,[0|V]):-
   integer(N),
   N1 is N - 1,
   length(V,N1),
   characteristic_vector(K,N1,V).
% old version
characteristic_vector(K,N,V):-
   integer(N),
   length(V,N),
   nth_1(K,V,1),
   findall(X,(nth_1(J,V,X),(J=K->X=1;X=0)),V).
*/
%
% my nth
%--------------------------------------------------
% added: 8 Feb 2003.
nth_1(K,A,X):-
   \+ var(A),
   characteristic_vector(K,_,A,V),
   list_projection(V,A,[X]).
nth_0(K,A,X):-
   nth_1(K1,A,X),
   K is K1 - 1.

%
% replace(Project,Goal,Base,Goal1):-
% -----------------------------------------------------------  %
% added: 15 Oct 2002.
  % a sequence of replacement of a subset of elements in Goal 
  % which specified by a list, Project, 0-1^n, over Base 
  % a list of length n, which brings about Goal1.
  % summary:
  %  X=1 --> preserve the value of Base.
  %  X=0 --> do replace with Goal1.
replace([],[],[],[]).
replace([X|A],[_|B],[Z|C],[Z|D]):-
   X = 0,
   replace(A,B,C,D).
replace([X|A],[Y|B],[_|C],[Y|D]):-
   X = 1,
   replace(A,B,C,D).
%
% replace/4
% -----------------------------------------------------------  %
% modified: 14 Feb 2003. bug fix.
replace(K/N,L,S,L1):-
   \+ var(S),
   \+ var(L),
   length(L,N),
   length(L1,N),
   nth1(K,L1,S),
   characteristic_vector(K,_S0,L,V),
   c_replace(V,L,L1,L1).

%
c_replace([],[],[],[]).
c_replace([X|A],[_|B],[Z|C],[Z|D]):-
   X = 1,
   c_replace(A,B,C,D).
c_replace([X|A],[Y|B],[_|C],[Y|D]):-
   X = 0,
   c_replace(A,B,C,D).

% complementary list projection
%--------------------------------------------------
c_list_projection([],[],[]).
c_list_projection([X|Y],[_|B],C):-
   c_list_projection(Y,B,C),
   X = 1.
c_list_projection([X|Y],[A|B],[A|C]):-
   c_list_projection(Y,B,C),
   X = 0.

asymmetric_difference(reduce(no),A,B,Resid,Meet):-
   length(A,_),
   length(B,_),
  %sort(A,Meet),
   findall(P,
     (
      member(X,A),
      (member(X,B) -> P=0;P=1)
     ),
   ML),
   list_projection(ML,A,Meet),
   c_list_projection(ML,A,Resid).

asymmetric_difference(reduce(yes),A,B,Resid,Meet):-
   length(A,_),
   length(B,_),
  %sort(A,Meet),
   findall(P,
     (
      nth1(K,A,X),
      (member(X,B) -> P1=0;P1=1),
      ((nth1(K1,A,X),K1<K) -> P=0;P=P1)
     ),
   ML),
   list_projection(ML,A,Meet),
   c_list_projection(ML,A,Resid).


%
% sort without removal of duplicates
%--------------------------------------------------
asort(A,B):-
   sort(A,C),
   bagof(CK,
     J^K^(
      nth1(J,C,CK),
      nth1(K,A,CK)
     ),
   B).
%
% permutation.
% -----------------------------------------------------------  %
% modified: 1 Sep 2002. to be used in is_neutral/2. 
% modified: 15 Oct 2002. add a non-variable constraint for the base set A. 
% modified: 26 Apr 2003. cited and made minor modification. 

permutation_of(A,P,APs):-
   \+var(A),
   length(A,M),
   ordering(P,A,M),
   anum_seq(Qm,M),
   maplist(nth_of_permutation(A,P),Qm,APs).

nth_of_permutation(A,P,K,Ak->Pk):-
   length(A,M),
   ordering(P,A,M),
   nth_0(K,A,Ak),
   nth_0(K,P,Pk).


%-----------------------------------------
% generation of partitions and trees(herarchies)
%-----------------------------------------
% cited from: dpfirm0.pl (25 Mar 2003)

% tree formations for the input data (i.e., information items)
% by partitioning the set of input items recursively.
% ?- tree_formation(Mode,levels:L,items:S,tree:T).



%  generating partitons
%-----------------------------------------
partition([S],1,S):-
   \+ var(S),
   length(S,_).

partition([H|H1],N,S):-
   \+ var(S),
   length(S,_),
   symmetric_complement(H,S1,S),
   \+ member([], [H,S1]),
   partition(H1,N1,S1),
   N is N1 + 1,
   all_elements(S1,_,H1).

all_elements([],0,[]).
all_elements(A,N,[H|S]):-
   \+ var(S),
   length(S,_),
   \+ var(H),
   length(H,K),
   all_elements(B,N1,S),
   append(H,B,A),
   N is N1 + K.


% tree_formation(Mode,levels:L, items:A, tree:T).
%-----------------------------------------
tree_formation(list,levels:1, items:A, tree:A):-
   \+ var(A),
   length(A,_).

tree_formation(list,levels:K,
     items: S,
     tree: [T1|T2]
 ):-
   \+ var(S),
   %symmetric_complement(H1,H2,S),
   partition([H1|H2],_,S),
   \+ member([],[H1,H2]),
   tree_formation(list,levels:K1,
      items: H1,
      tree: T1
   ),
   tree_formation(list,levels:K1,
      items: H2,
      tree: T2
   ),
   K is K1+1.

% skip-reporting
tree_formation(list,levels:K, items:A, tree:[T]):-
   number(K),
   tree_formation(list,levels:K1,
      items: A,
      tree: T
   ),
   K is K1 + 1.


% list - binary
%------------

tree_formation(blist,levels:L, items:A, tree:A):-
   length(A,_),
   (var(L)->L =1; true).

tree_formation(blist,levels:K,
     items: S,
     tree: T
 ):-
   \+ var(S),
   T = [T1,T2],
   symmetric_complement(H1,H2,S),
   \+ member([],[H1,H2]),
   tree_formation(blist,levels:K1,
      items: H1,
      tree: T1
   ),
   tree_formation(blist,levels:K2,
      items: H2,
      tree: T2
   ),
   (K1 >= K2 -> K is K1+1; K is K2+1).



% utility: depth of tree
%-----------------------------------------
% slightly modified: 5 Apr 2003

analyze_list([], levels:0, items:[]).
analyze_list(A, levels:0, items:[A]):-
   A\=[],
   (
    atom(A);
    number(A);
    (\+ atom(A),\+ number(A),A=..[F|_],F\='.')
   ).

analyze_list([B|T], levels:L,  items:H):-
   analyze_list(B, levels:L1, items:H2),
   analyze_list(T, levels:L2, items:H1),
   append(H2,H1,H),
   (L1 + 1 >= L2 -> L is L1 + 1; L is L2),
   !.


% utility: subtrees
%-----------------------------------------

subtree(T,(level:L/L,no:1/1, superior:root, items:H),T):-
   % 1st element of the top layer .
   analyze_list(T, levels:L,items:H).

subtree(S,(level:L/M, no:K/N, superior:(L1,K1),items:H),T):-
  %(var(T)->hierarchy(T);true),
   subtree(S1,(level:L1/M,no:K1/_N1, _SUP,_),T),%wn(S1:L1:K1/_N1:_SUP),
   (L1=0->(!,fail);true),
   length(S1,N),
   nth1(K,S1,S),
   analyze_list(S, levels:L,items:H).


% added: 10 Apr 2003.
subtree(T,[],H,T):-
   subtree(T,H,T).

subtree(S,[X|Path],I,T):-
   subtree(S1,Path,I1,T),
   I1 = (level:L1/M,no:K1/_N1, superior:X,_),
   (L1=0->(!,fail);true),
   length(S1,N),
   nth1(K,S1,S),
   analyze_list(S, levels:L,items:H),
   I = (level:L/M, no:K/N, superior:(L1,K1),items:H).

%
% -----------------------------------------------------------  %
%   Utilities for outputs
% -----------------------------------------------------------  %
%
% output to file.
% -----------------------------------------------------------  %
tell_test(Goal):-
  open('tell.txt',write,S),
  tell('tell.txt'),
  Goal,
  current_stream('tell.txt',write,S),
  tell(user),wn(end),
  close(S).
%


tell_goal(File,G):-
   (current_stream(File,write,S0)->close(S0);true),
   open(File,write,S),
   tell(File),
   nl,
   tstamp('% file output start time ',_),
   nl,
   write('%----------  start from here ------------%'),
   nl,
   G,
   nl,
   write('%----------  end of data ------------%'),
   nl,
   tstamp('% file output end time ',_),
   tell(user),
   close(S),
   % The following is to cope with the duplicated stream problem.
   (current_stream(File,write,S1)->close(S1);true).

% 成功するゴールをすべて保存
%--------------------------------

tell_goal(File,forall,G):-
   G0 = (nl,write(G),write('.')),
   G1 = forall(G,G0),
   tell_goal(File,G1).


% 実行時刻の取得
%--------------------------------

tstamp(no,T):-
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
   nl.

tstamp(Word,T):-
   \+ var(Word),
   Word \= no,
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
%   format('~`.t~t~a~30|~`.t~t~70|~n',[Word]),
   write((Word,T)),
   nl.

% end.




/*
game(subgame(G,(T,[],I)),players(NS),acts(BS),payoffs(P)):-
   game(G,form(extensive),players(_NT),acts(T)),
   I=(level:B/B,no:1/_M,superior:root,items:_),
   subtree(T,[],I,T),
   game(behavior_strategy(G),players(NS),acts(BS),payoffs(P)).

game(subgame(G,(S,[SUP|Path],I)),players(NS),acts(BS),payoffs(P)):-
   game(G,form(extensive),players(_NT),acts(T)),
   subtree(S,[SUP|Path],I,T),
   I=(level:_L1/B,no:_K1/_M1,superior:(L,K),items:_),
   I1=(level:L/B,no:K/_M,superior:SUP,items:_),
   game(subgame(G,(_S1,Path,I1)),players(NS),acts(BS),payoffs(P)).

game(subgame_nash(G,(S,[],I,[])),players(NS),acts(BS),payoffs(P)):-
   I=(level:B/B,no:1/_M,superior:root,items:_),
   nash(subgame(G,(S,[],I,[])),NS,BS,P).

game(subgame_nash(G,(S,[SUP|Path],I)),players(NS),acts(BS),payoffs(P)):-
   nash(subgame(G,(S,[SUP|Path],I)),NS,BS,P),
   I=(level:_L1/B,no:_K1/_M1,superior:(L,K),items:_),
   I1=(level:L/B,no:K/_M,superior:SUP,items:_),
   game(
     subgame_nash(G,
       (_S1,Path,I1)
     ),
     players(_NS1),
     acts(BS),
     payoffs(P)
   ).



game(subgame_nash(G,(S,Path,I,POS)),players(NS),acts(BS),payoffs(P)):-
   SG=subgame(G,(subtree:S,path:Path,I,player:_J,played:POS)),
   I=(level:1/_B,no:_O/_M,superior:_,items:_),
   nash(SG,NS,BS,P).

game(subgame_nash(G,(S,Path,I,POS)),players(NS),acts(BS),payoffs(P)):-
   SG=subgame(G,(subtree:S,path:Path,I,player:_J,played:POS)),
   I=(level:L/B,no:K/_M,superior:_,items:_),
   nash(SG,NS,BS,P),
   L > 1,
   I1=(level:_L1/B,no:_K1/_M1,superior:(L,K),items:_),
   SG1=subgame(G,(_,_,I1,_,played:[_|POS])),
   game(SG1,players(_NS1),acts(BS),payoffs(P)).




*/