You selected nash1c.pl
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 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)).
*/
return to front page.