prolog source code
You selected epcn01.pl
title([''
,'%---------------------------------------------------%'
,'% epistemic conditions for Nash equilibrium'
,'%---------------------------------------------------%'
,'% language: SWI-Prolog (Version 5.0.10)'
,'% reference:'
,'% [1] Aumann, R.J. and A. Brandenburger (1995). '
,'% Epistemic conditions for Nash equilibrium.'
,'% Econometrica 63(5): 1161-1180.'
]).
my_data([''
,'% file: epcn01.pl'
,'% date: 22--25 Feb 2005 (epcn0, no risk mode)'
,'% date: 27 Feb--9 Mar 2005 (epcn01, risk mode)'
,'% date: 10 Mar 2005 (Theorem A and its Lemma)'
,'% author: Kenryo INDO (Kanto Gakuen University)'
]).
initialize_program:-
title(A),fig_2(B),append(A,B,C),
forall(member(X,C),(nl,write(X))).
% notation.
%---------------------------------------------------%
% g: a N-player game, cp: a tuple of conjecture.
% a: a players' action profile of the game.
% g_j, cp_j, a_j: player j's payoff, conjecture, and action.
% g^-j, a^-j, ...: the profile other than player j.
% ,, and are their state-dependent functions
% which can be seen as random variables.
% [=g],[=cp],[=a], or merely [g],[cp],[a],... etc.:
% Here [xxx] represents an event which consists of states
% at which given assertion xxx in square brackets
% is true. (This is only in the comment part.
% Normally it is a list, of course, in Prolog code.
% Our state-space modeling use it in order to represent
% an event, ordered set of states. Please avoide confusion.)
% interactive belief system:
% S_i: possible types of player i,
% P(_;s_i): theory of s_i about S^-i,
% a_i: s_i's action,
% g_i:A->|R; s_i's payoff function.
% game:
% g:A->|R^n; g=(g_1,g_2,..,g_n).
% conjecture ^i(a^-i):=p([a^-i];s_i).
% conjectures :=(^1,^2,...,^n).
% rationality at s if a_i = argmax exp g_i(a_i, ^-i); s_i).
% Ne(g): the set of Nash equilibrium of game g,
% R: s (- R iff all players are rational at s,
% K_iE=K_i(E): s (- K_iE iff event E is known by i at s,
% KE=K(E): s (- KE iff event E is mutually known at s,
% CKE=CK(E): s (- CKE iff event E is commonly known at s.
% We assume that x (- y means x is a member of y.
% theorems in the literature [1]
%---------------------------------------------------%
% 1. If s (- R and s (- K[a] then a (- Ne(g).
% (Preliminary Observation)
% 2. If s (- K[=cp] then =cp at s.(Lemma 4.1)
% 3. If s (- K[=cp & =g & R], then a_j
% =argmax exp(g_j;cp_j) if cp_i(a_j)>0, i=\=j.(Lemma 4.2)
% 4. Let g a two-player game, cp a pair of conjecture.
% s(- K[=g & =cp & R] then (cp_2,cp_1) (- Ne(g).
% (Theorem A)
% 5. Let g an n-player game, cp an n-tuple of conjectures.
% Suppose a common prior P satisfies that P(K(E)&CK(F))>0
% for E=[=g & R], F=[=cp ]. Then ^-j induces
% the same conjecture v_j, and (v_1,...,v_n) (- Ne(g).
% (Theorem B)
% 6. conjunction of K. (Lemma 4.3),
% 7. CKE->K_iCKE. (Lemma 4.4),
% 8. Suppose P is a common prior, K_iH=H, and p(E;s_i)=m
% for all s(-H Then P(E & H)= mP(H). (Lemma 4.5)
% 9. stochastic independence. (Lemma 4.6)
%---------------------------------------------------%
% 1. interactice belief systems and an example
%---------------------------------------------------%
% 22-23 Feb 2005
% revised: 2-5 Mar 2005. state-dependent modeling
% belief system: {S_i,{p(_,s_i)},g_i}_i in N={1,2,...,n}
%---------------------------------------------------%
% ` An interactive belief system (or simply belief system)
% for the game form is defined to consists of:
% (2.1) for each player i, a set S_i of i's possible types,
% and for each type s_i of i,
% (2.2) a probability distribution on the set S^-i of
% (n-1)-tuples of types of the other players (s_i's theory),
% (2.3) an action a_i (i.e., s_i's action) and
% a function g_i:A->|R (s_i's payoff function).
% ([1], pp.1164)
/*************************************************/
% example.
% a two player strategic form game([2], section 3).
fig_1([''
,'%'
,'% Colin`s act'
,'% c d'
,'% +-------+-------+'
,'% Rowena`s C | 2,2 | 0,0 |'
,'% acts +-------+-------+'
,'% D | 0,0 | 1,1 |'
,'% +-------+-------+'
,'%'
,'% Fig 1 : a strategic form game ([1], p.1167).'
]).
% strategic form game
%---------------------------------------------------%
% players
player(rowena).
player(colin).
all_players(N):- findall(J,player(J),N).
% actions and action profiles
action(rowena, act_C).
action(rowena, act_D).
action(colin, act_c).
action(colin, act_d).
action_profile_1([],[],[]).
action_profile_1([J|N],[A|Y],[(J,A)|X]):-
action_profile_1(N,Y,X),
action(J,A).
action_profile(N,Ap,Ap1):-
all_players(N),
action_profile_1(N,Ap,Ap1).
% player's information. (i.e., his/her type)
type(rowena,tC1,act_C).
type(rowena,tD1,act_D).
type(rowena,tD2,act_D).
type(colin,tc1,act_c).
type(colin,td1,act_d).
type(colin,td2,act_d).
type(A,B):- type(A,B,_).
% payoffs of the game
payoff(rowena,[(rowena,act_C),(colin, act_c)],2).
payoff(rowena,[(rowena,act_C),(colin, act_d)],0).
payoff(rowena,[(rowena,act_D),(colin, act_c)],0).
payoff(rowena,[(rowena,act_D),(colin, act_d)],1).
payoff(colin,[(rowena,act_C),(colin, act_c)],2).
payoff(colin,[(rowena,act_C),(colin, act_d)],0).
payoff(colin,[(rowena,act_D),(colin, act_c)],0).
payoff(colin,[(rowena,act_D),(colin, act_d)],1).
% state(type)-dependent payoffs of a game.
% the game above is of constant payoff functions.
payoff((J,T),_action_profile,Payoff):-
type(J,T),
payoff(J,_action_profile,Payoff).
% game g, or (s)=g
%---------------------------------------------------%
% A function g:A->|R^n (an n-tuple of payoff functions) is called a game.'
% ... we call (s) "the game being played at s," or simply
% "the game at s." ([1], pp.1165)
% recursive representation of strategic form game :
% a state-dependent description
game_1([],[],[],[],_,[]).
game_1([T|W],[J|N],[A|AP],[U|UP],Actions,[(J,T,A,U)|Pay]):-
game_1(W,N,AP,UP,Actions,Pay),
% player(J),
% action(J,A),
type(J,T,A),
payoff((J,T),Actions,U),
member((J,A),Actions).
game(W,[N,AP,UP],Actions,Payoffs):-
all_players(N),
game_1(W,N,AP,UP,Actions,Payoffs).
/*************************************************
?- W=[tC1,tc1],state(W), game(W,A,B,C).
W = [tC1, tc1]
A = [[rowena, colin], [act_C, act_c], [2, 2]]
B = [ (rowena, act_C), (colin, act_c)]
C = [ (rowena, tC1, act_C, 2), (colin, tc1, act_c, 2)] ;
W = [tC1, tc1]
A = [[rowena, colin], [act_C, act_d], [0, 0]]
B = [ (rowena, act_C), (colin, act_d)]
C = [ (rowena, tC1, act_C, 0), (colin, tc1, act_d, 0)] ;
W = [tC1, tc1]
A = [[rowena, colin], [act_D, act_c], [0, 0]]
B = [ (rowena, act_D), (colin, act_c)]
C = [ (rowena, tC1, act_D, 0), (colin, tc1, act_c, 0)] ;
W = [tC1, tc1]
A = [[rowena, colin], [act_D, act_d], [1, 1]]
B = [ (rowena, act_D), (colin, act_d)]
C = [ (rowena, tC1, act_D, 1), (colin, tc1, act_d, 1)] ;
No
?-
*************************************************/
fig_2(['%'
,'% type ` type of Colin'
,'% of ` c_1 d_1 d_2'
,'% Rowena +------------+------------+------------+'
,'% C_1 | 1/2, 1/2 | 1/2, 1/2 | 0, 0 |'
,'% +------------+------------+------------+'
,'% D_1 | 1/2, 1/2 | 0, 0 | 1/2, 1/2 |'
,'% +------------+------------+------------+'
,'% D_2 | 0, 0 | 1/2, 1/2 | 1/2, 1/2 |'
,'% +------------+------------+------------+'
,'%'
,'% Fig 2: interactive belief system with a common prior([1], p.1167).'
]).
% `The two entries in each square denote the probabilities
% that the corresponding types of Roweana and Colin ascribe
% to that state. For example, Colin's type d_2 attributes 1/2-1/2
% probabilities to Rowena's type being D_1 or D_2.'
%([1], p.1166)
% `So at the state (D_2, d_2), he knows that
% Rowena will choose the action D. Similarly,
% Rowena knows at (D_2, d_2) that Colin will choose d.
% (...) both palyers are rational at (D_2, d_2) and
% (D,d) is a Nash equilibrium.'
%([1], p.1166)
% (interactive) belief system
%---------------------------------------------------%
% theory of player :
% predictions given his/her information.
theory((rowena,tC1),[(colin,tc1)],1/2).
theory((rowena,tC1),[(colin,td1)],1/2).
theory((rowena,tC1),[(colin,td2)],0).
theory((rowena,tD1),[(colin,tc1)],1/2).
theory((rowena,tD1),[(colin,td1)],0).
theory((rowena,tD1),[(colin,td2)],1/2).
theory((rowena,tD2),[(colin,tc1)],0).
theory((rowena,tD2),[(colin,td1)],1/2).
theory((rowena,tD2),[(colin,td2)],1/2).
theory((colin,tc1),[(rowena,tC1)],1/2).
theory((colin,tc1),[(rowena,tD1)],1/2).
theory((colin,tc1),[(rowena,tD2)],0).
theory((colin,td1),[(rowena,tC1)],1/2).
theory((colin,td1),[(rowena,tD1)],0).
theory((colin,td1),[(rowena,tD2)],1/2).
theory((colin,td2),[(rowena,tC1)],0).
theory((colin,td2),[(rowena,tD1)],1/2).
theory((colin,td2),[(rowena,tD2)],1/2).
%---------------------------------------------------%
% 2. state space, probability, and knowledge
%---------------------------------------------------%
% 22-24 Feb 2005
% revised: 6,8 Mar 2005
% state as type profile
%---------------------------------------------------%
state_1([],[],[]).
state_1([J|X],[T|Y],[(J,T)|Z]):-
state_1(X,Y,Z),
type(J,T).
state(T,P):-
all_players(N),
state_1(N,T,P).
state([TR,TC]):- %type(rowena,TR),type(colin,TC).
state([TR,TC],_).
% revised: 6 Mar 2005 (sorted)
all_states(O):- findall(S,state(S),O1),sort(O1,O).
% state-act profiles (added: 8 Mar 2005)
%---------------------------------------------------%
state_2([],[],[],[]).
state_2([J|X],[T|Y],[A|B],[(J,T,A)|Z]):-
state_2(X,Y,B,Z),
type(J,T,A).
state_and_actions(T,A,P):-
all_players(N),
state_2(N,T,A,P).
state_3([],[],[],[],[]).
state_3([J|X],[T|Y],[A|B],[(J,A)|C],[(J,T,A)|Z]):-
state_3(X,Y,B,C,Z),
type(J,T,A).
state_and_actions(T,A,B,P):-
all_players(N),
state_3(N,T,A,B,P).
/*************************************************
% demo (8 Mar 2005)
?- state_and_actions(A,B,C,D).
A = [tC1, tc1]
B = [act_C, act_c]
C = [ (rowena, act_C), (colin, act_c)]
D = [ (rowena, tC1, act_C), (colin, tc1, act_c)]
Yes
?-
*************************************************/
% events
%---------------------------------------------------%
event(A,X,N):-
var(A),
all_states(O),
length(O,L),
choose_N_units_among(L,N,X),
list_projection(X,O,A).
event(A,X,N):-
\+ var(A),
all_states(O),
list_projection(X,O,A),
length(A,N).
/*************************************************
?- event(E,X,3),hexa_event(E,_,H).
E = [[tC1, tc1], [tC1, td1], [tC1, td2]]
X = [1, 1, 1, 0, 0, 0, 0, 0, 0]
H = '1c0' ;
E = [[tC1, tc1], [tC1, td1], [tD1, tc1]]
X = [1, 1, 0, 1, 0, 0, 0, 0, 0]
H = '1a0' ;
E = [[tC1, tc1], [tC1, td1], [tD1, td1]]
X = [1, 1, 0, 0, 1, 0, 0, 0, 0]
H = '190' ;
E = [[tC1, tc1], [tC1, td1], [tD1, td2]]
X = [1, 1, 0, 0, 0, 1, 0, 0, 0]
H = '188'
Yes
?-
*************************************************/
% state and event which is compatible with type
%---------------------------------------------------%
state_compatible_with_type(J,T,W):-
player(J),
type(J,T),
state(W,WD),
member((J,T),WD).
event_compatible_with_type(J,T,E):-
type(J,T),
findall(W,
(
state_compatible_with_type(J,T,W)
),
E).
% actions in state and event
%---------------------------------------------------%
% added: 8 Mar 2005.
actions_in_event((E,X,L),J,AE):-
event(E,X,L),
player(J),
findall(A,
(
member(W,E),
action_at_state(W,(J,_),A)
),
F),
sort(F,AE).
action_at_state(W,(J,T),A):-
type(J,T,A),
state_compatible_with_type(J,T,W).
action_at_state_1(W,(J,T),A):-
state_and_actions(W,_,AB),
member((J,T,A),AB).
/*************************************************
% demo (8 Mar 2005)
?- action_at_state_1(W,(J,T),A),
\+ action_at_state(W,(J,T),A).
No
?- action_at_state(W,(J,T),A),
\+ action_at_state_1(W,(J,T),A).
No
?- actions_in_event((E,X,3),J,AE),hexa_event(E,X,Hx).
E = [[tC1, tc1], [tC1, td1], [tC1, td2]]
X = [1, 1, 1, 0, 0, 0, 0, 0, 0]
J = rowena
AE = [act_C]
Hx = '1c0' ;
E = [[tC1, tc1], [tC1, td1], [tC1, td2]]
X = [1, 1, 1, 0, 0, 0, 0, 0, 0]
J = colin
AE = [act_c, act_d]
Hx = '1c0'
Yes
?-
*************************************************/
% added: 10 Mar 2005.
% event where the player J's action is a_j, and
% event where the player J's type is T.
event_of_action(J,A,E):-
action(J,A),
findall(W,
(
state_and_actions(W,_,Actions,_),
member((J,A),Actions)
),
E1),
sort(E1,E).
event_of_type(J,T,E):-
type(J,T),
findall(W,
(
state(W,StateDescription),
member((J,T),StateDescription)
),
E1),
sort(E1,E).
/*************************************************
% demo (10 Mar 2005)
?- event_of_action(J,A,E),nl,write(J;A;E),fail.
rowena;act_C;[[tC1, tc1], [tC1, td1], [tC1, td2]]
rowena;act_D;[[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]]
colin;act_c;[[tC1, tc1], [tD1, tc1], [tD2, tc1]]
colin;act_d;[[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
No
?- event_of_type(J,T,E),nl,write((J,T,E)),fail.
rowena, tC1, [[tC1, tc1], [tC1, td1], [tC1, td2]]
rowena, tD1, [[tD1, tc1], [tD1, td1], [tD1, td2]]
rowena, tD2, [[tD2, tc1], [tD2, td1], [tD2, td2]]
colin, tc1, [[tC1, tc1], [tD1, tc1], [tD2, tc1]]
colin, td1, [[tC1, td1], [tD1, td1], [tD2, td1]]
colin, td2, [[tC1, td2], [tD1, td2], [tD2, td2]]
No
?-
*************************************************/
% probability distribution functions
%---------------------------------------------------%
probability((J,T),(E,X,N),(Prob,PP,WP)):-
event_compatible_with_type(J,T,EC),
event(E,X,N),
intersection(EC,E,WP),
findall(Pt,
(
member(W,WP),
state_compatible_with_type(Jo,To,W),
theory((J,T),[(Jo,To)],Pt)
),
PP),sum(PP,Prob).
/*************************************************
% demo (7 Mar 2005)
?- probability((J,T),(E,X,Len),(Prob,PP,WP)).
J = rowena
T = tC1
E = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2|...], [...|...]]
X = [1, 1, 1, 1, 1, 1, 1, 1, 1]
Len = 9
Prob = 1
PP = [1/2, 1/2, 0]
WP = [[tC1, tc1], [tC1, td1], [tC1, td2]]
Yes
?- probability((J,T),(E,X,Len),(Prob,PP,WP)),Prob<1.
J = rowena
T = tC1
E = [[tC1, tc1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2|...]]
X = [1, 0, 1, 1, 1, 1, 1, 1, 1]
Len = 8
Prob = 0.5
PP = [1/2, 0]
WP = [[tC1, tc1], [tC1, td2]]
Yes
?- min(Len,(probability((J,T),(E,X,Len),(Prob,PP,WP)),
Prob>0.5)),nl,write((J,T);(Prob;E;Len)),fail.
colin, tc1;1;[[tC1, tc1], [tD1, tc1]];2
colin, td1;1;[[tC1, td1], [tD2, td1]];2
colin, td2;1;[[tD1, td2], [tD2, td2]];2
rowena, tC1;1;[[tC1, tc1], [tC1, td1]];2
rowena, tD1;1;[[tD1, tc1], [tD1, td2]];2
rowena, tD2;1;[[tD2, td1], [tD2, td2]];2
No
?-
*************************************************/
% event where J attributes probability tt to E.
event_of_probability(J,(P,F,X,L),E):-
player(J),
event(F,X,L),
setof(W,
T^PP^(
probability((J,T),(F,X,L),(P,PP)),
state_compatible_with_type(J,T,W)
),
E1),
sort(E1,E).
/*************************************************
?- event_of_action(J,A,F),
event_of_probability(J,(P,F,XL),E),hexa_event(E,_,H),
nl,write((J,A,F,P)),nl,tab(1),write(H;E),fail.
rowena, act_C, [[tC1, tc1], [tC1, td1], [tC1, td2]], 1
1c0;[[tC1, tc1], [tC1, td1], [tC1, td2]]
rowena, act_C, [[tC1, tc1], [tC1, td1], [tC1, td2]], 0
03f;[[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]]
rowena, act_D, [[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]], 0
1c0;[[tC1, tc1], [tC1, td1], [tC1, td2]]
rowena, act_D, [[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]], 1
03f;[[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]]
colin, act_c, [[tC1, tc1], [tD1, tc1], [tD2, tc1]], 1
124;[[tC1, tc1], [tD1, tc1], [tD2, tc1]]
colin, act_c, [[tC1, tc1], [tD1, tc1], [tD2, tc1]], 0
0db;[[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
colin, act_d, [[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 0
124;[[tC1, tc1], [tD1, tc1], [tD2, tc1]]
colin, act_d, [[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 1
0db;[[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
No
?-
*************************************************/
% knowledge operator
%---------------------------------------------------%
% revised: 4,6,7 Mar 2005.
% `Player i is said to know an event E at s if at s,
% he ascribes probability 1 to E.'
knowledge_at(W,J,(E,X,Len)):-
state_compatible_with_type(J,T,W),
probability((J,T),(E,X,Len),(1,_,_)).
knowledge((KE,Xk,Lk),J,(E,Xe,Le)):-
event(E,Xe,Le),
player(J),
findall(W,knowledge_at(W,J,(E,Xe,Le)),K1),
sort(K1,KE),
event(KE,Xk,Lk).
/*************************************************
% demo (7 Mar 2005)
?- min(Len,knowledge_at(W,J,(E,_,Len))),
hexa_event(E,_,Hx),nl,write(W;(Hx,E,J)),fail.
[tC1, tc1];120, [[tC1, tc1], [tD1, tc1]];colin
[tC1, tc1];180, [[tC1, tc1], [tC1, td1]];rowena
[tC1, td1];082, [[tC1, td1], [tD2, td1]];colin
[tC1, td1];180, [[tC1, tc1], [tC1, td1]];rowena
[tC1, td2];009, [[tD1, td2], [tD2, td2]];colin
[tC1, td2];180, [[tC1, tc1], [tC1, td1]];rowena
[tD1, tc1];120, [[tC1, tc1], [tD1, tc1]];colin
[tD1, tc1];028, [[tD1, tc1], [tD1, td2]];rowena
[tD1, td1];082, [[tC1, td1], [tD2, td1]];colin
[tD1, td1];028, [[tD1, tc1], [tD1, td2]];rowena
[tD1, td2];009, [[tD1, td2], [tD2, td2]];colin
[tD1, td2];028, [[tD1, tc1], [tD1, td2]];rowena
[tD2, tc1];120, [[tC1, tc1], [tD1, tc1]];colin
[tD2, tc1];003, [[tD2, td1], [tD2, td2]];rowena
[tD2, td1];082, [[tC1, td1], [tD2, td1]];colin
[tD2, td1];003, [[tD2, td1], [tD2, td2]];rowena
[tD2, td2];009, [[tD1, td2], [tD2, td2]];colin
[tD2, td2];003, [[tD2, td1], [tD2, td2]];rowena
No
?- min(L,(knowledge(K,J,F),K=(KE,_,_),F=(E,_,L),KE\=[])),
hexa_event(KE,_,Hx),nl,write(J;(E,L);(KE,Hx)),fail.
rowena;[[tC1, tc1], [tC1, td1]], 2;[[tC1, tc1], [tC1, td1], [tC1, td2]], 1c0
colin;[[tC1, tc1], [tD1, tc1]], 2;[[tC1, tc1], [tD1, tc1], [tD2, tc1]], 124
colin;[[tC1, td1], [tD2, td1]], 2;[[tC1, td1], [tD1, td1], [tD2, td1]], 092
colin;[[tD1, td2], [tD2, td2]], 2;[[tC1, td2], [tD1, td2], [tD2, td2]], 049
rowena;[[tD1, tc1], [tD1, td2]], 2;[[tD1, tc1], [tD1, td1], [tD1, td2]], 038
rowena;[[tD2, td1], [tD2, td2]], 2;[[tD2, tc1], [tD2, td1], [tD2, td2]], 007
No
?-
*************************************************/
% knowledge for actions and probabilities
%---------------------------------------------------%
% added: 8 Mar 2005
% revised: 10 Mar 2005.
know_action_profile_at(W,J,A,(E,X,L)):-
action_profile(_,A,_),
findall(W,state_and_actions(W,A,_),F),
sort(F,E),
knowledge_at(W,J,(E,X,L)).
know_action_at(W,J,(J1,A)):-
actions_in_event((E,X,Len),J1,A),
knowledge_at(W,J,(E,X,Len)).
/*************************************************
% demo (8 Mar 2005)
?- know_action_profile_at(W,J,A,(E,X,L)),
hexa_event(E,X,Hx),nl,write(W;J;A;Hx;E),fail.
[tD2, tc1];rowena;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
[tD2, td1];rowena;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
[tD2, td2];rowena;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
[tC1, td2];colin;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
[tD1, td2];colin;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
[tD2, td2];colin;[act_D, act_d];01b;[[tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
No
?-
*************************************************/
% event_of_action/3 has utilized (added: 10 Mar)
know_action_of((J1,A),E,(J,KE)):-
event_of_action(J1,A,E),
knowledge((KE,_,_),J,(E,_,_)).
% knowledge of probability (added: 10 Mar)
know_probability_of((J1,P,F),E,(J,KE)):-
event_of_probability(J1,(P,F,_),E),
knowledge((KE,_,_),J,(E,_,_)).
/*************************************************
% demo (10 Mar 2005)
?- know_action_of((J1,A),E,(J,KE)),
nl,write((J1,A,E);know(J,KE)),fail.
rowena, act_C, [[tC1, tc1], [tC1, td1], [tC1, td2]];know(rowena, [[tC1, tc1], [tC1, td1], [tC1, td2]])
rowena, act_C, [[tC1, tc1], [tC1, td1], [tC1, td2]];know(colin, [])
rowena, act_D, [[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]];know(rowena, [[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]])
rowena, act_D, [[tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]];know(colin, [[tC1, td2], [tD1, td2], [tD2, td2]])
colin, act_c, [[tC1, tc1], [tD1, tc1], [tD2, tc1]];know(rowena, [])
colin, act_c, [[tC1, tc1], [tD1, tc1], [tD2, tc1]];know(colin, [[tC1, tc1], [tD1, tc1], [tD2, tc1]])
colin, act_d, [[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];know(rowena, [[tD2, tc1], [tD2, td1], [tD2, td2]])
colin, act_d, [[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];know(colin, [[tC1, td1], [tC1, td2], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]])
No
?- know_probability_of((J,P,F),E,(J,KE)),
length(F,3),
hexa_event(E,_,He),hexa_event(KE,_,Hk).
J = rowena
P = 1
F = [[tC1, tc1], [tC1, td1], [tC1, td2]]
E = [[tC1, tc1], [tC1, td1], [tC1, td2]]
KE = [[tC1, tc1], [tC1, td1], [tC1, td2]]
He = '1c0'
Hk = '1c0'
Yes
?- know_probability_of((J,P,F),E,(J,KE)),
hexa_event(E,_,He),hexa_event(KE,_,Hk),
E\=KE.
No
?-
% The above confirms Lemma 2.6, i.e., K_i[p]=[p].
*************************************************/
% prior, posterior, and common prior
%---------------------------------------------------%
% added: 10 Mar 2005.
%` A probability distribution P on S is called
% a common prior if for all players i and all of
% their types s_i, the conditional distribution
% of P given s_i is p(_;s_i); ... '
%([1], p.1166)
common_prior(CP,(J,T),(E,X,L),SO):-
event(E,X,L),
Exl=(E,X,L),
type(J,T),
findall((P,Q,J,T,Exl),
(
probability((J,T),Exl,(P,_)),
posterior_by_type([Exl|(J,T)],_,_->(Q=_))
)
,SOL),
setof((P,Q),R^member((P,Q,R),SOL),SO),
(SO=[(CP,CP)]->true;CP=multiple).
/*************************************************
% demo (10 Mar 2005)
?- common_prior(CP,JT,(E,X,L),SO).
CP = 1
JT = rowena, tC1
E = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2|...], [...|...]]
X = [1, 1, 1, 1, 1, 1, 1, 1, 1]
L = 9
SO = [ (1, 1)] ;
CP = 1
JT = rowena, tD1
E = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2|...], [...|...]]
X = [1, 1, 1, 1, 1, 1, 1, 1, 1]
L = 9
SO = [ (1, 1)]
Yes
?-
*************************************************/
posterior_by_type([(E,X,L)|(J,T)],(M,Y,L1),Q):-
event_of_type(J,T,F),
posterior([(E,X,L)|(F,_,_)],(M,Y,L1),Q).
posterior([(E,X,L)|(F,Y,L1)],(M,Z,L2),P->D):-
prior((E,X,L),_,P),
prior((F,Y,L1),_,B),
(B=0->D=zero_divisor
;
intersection(E,F,M),
prior((M,Z,L2),_,R),
Q = R / B, Q1 is Q,
D=(Q1=Q)).
/*************************************************
% demo (10 Mar 2005)
?- event(E,_,_),event(F,_,_),
\+ posterior([(E,X,L)|(F,Y,L1)],(M,Z,L2),Q).
No
?- event_of_type(J,T,E),
posterior_by_type([(E,X,L)|(J,T)],M,Q),
nl,write((J,T,Q)),fail.
rowena, tC1, (0.333333->1=0.333333/0.333333)
rowena, tD1, (0.333333->1=0.333333/0.333333)
rowena, tD2, (0.333333->1=0.333333/0.333333)
colin, tc1, (0.333333->1=0.333333/0.333333)
colin, td1, (0.333333->1=0.333333/0.333333)
colin, td2, (0.333333->1=0.333333/0.333333)
No
?-
*************************************************/
prior((E,X,L),D,Q):-
event(E,X,L),
prior_1(E,D,Q).
prior_1([],[],0).
prior_1([W|E],[(W,P)|D],Q):-
prior_1(E,D,R),
prior([W],P),
Q is P + R.
prior([[tC1, tc1]],1/6).
prior([[tC1, td1]],1/6).
prior([[tC1, td2]],0).
prior([[tD1, tc1]],1/6).
prior([[tD1, td1]],0).
prior([[tD1, td2]],1/6).
prior([[tD2, tc1]],0).
prior([[tD2, td1]],1/6).
prior([[tD2, td2]],1/6).
test_display_2_5(J,(E,X,L),(F,Y,L1),D,D2):-
player(J),
event(E,X,L),event(F,Y,L1),
findall(((J,T),(Pai=QE/QF),(Pai0=PE/PF)),
(
type(J,T),
posterior_by_type([(E,_)|(J,T)],_,PE->(QE=_)),
posterior_by_type([(F,_)|(J,T)],_,PF->(QF=_)),
((QE=0,QF=0,Pai=indef);(QF >0,Pai is QE/QF)),
((PE=0,PF=0,Pai0=indef);(PF >0,Pai0 is PE/PF))
)
,D),
findall((Pai,Pai0),
member((_,(Pai=_),(Pai0=_)),D)
,D1),
sort(D1,D2).
case_violate_for_2_5(fail,_,D2):-
var(D2),
!,
fail.
case_violate_for_2_5(no,_,D2):-
member((Pai,_),D2),
member((Pai1,_),D2),
Pai1\=Pai,
!.
case_violate_for_2_5(yes,(Pai,Pai0,Pai01),D2):-
member((Pai,Pai0),D2),
member((Pai,Pai01),D2),
Pai01\=Pai0,
!.
/*************************************************
% demo (10 Mar 2005)
% The property implied by the exsistence of
% a common prior. The experimentation as follows,
% but it would be compelled to wasting your time.
?- test_display_2_5(J,(E,X,L),(F,Y,L1),D,D2),
case_violate_for_2_5(_yes,_,D2), forall_write(D).
(rowena, tC1), 1=1/1, 1.2=1/0.833333
(rowena, tD1), 1=1/1, 1.2=1/0.833333
(rowena, tD2), 2=1/0.5, 1.2=1/0.833333
J = rowena
E = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2|...], [...|...]]
X = [1, 1, 1, 1, 1, 1, 1, 1, 1]
L = 9
F = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2], [tD2, tc1], [tD2|...]]
Y = [1, 1, 1, 1, 1, 1, 1, 1, 0]
L1 = 8
D = [ ((rowena, tC1), 1=1/1, 1.2=1.0/0.833333), ((rowena, tD1), 1=1/1, 1.2=1.0/0.833333), ((rowena, tD2), 2=1/0.5, 1.2=1.0/0.833333)]
D2 = [ (1, 1.2), (2, 1.2)]
_yes = no
Yes
*************************************************/
% functions of state (viewed like random variables)
%---------------------------------------------------%
% added: 24 Feb 2005
% abolished: 2 Mar 2005 (attendant on the revision)
%---------------------------------------------------%
% 3. conjecture and expected payoff
%---------------------------------------------------%
% 24-25 Feb 2005
% revised: 27-28 Feb 2005
% revised: 8 Mar 2005
% i's conjecture at a state ^i
%---------------------------
% A conjecture ^i of i is a probability distribution on A^-i.
% For j=/= i, the marginal of ^i on A_j is is called the conjecture
% of i about j induced by ^i. The theory of i at a state s
% yields a conjecture ^i(s), called i's conjecture at s,
% given by ^i(a^-i):=p([a^-i];s_i). We denote the n-tuple
% of conjunction at s by (s).
% ([1], pp.1165)
% conjecture_at/5
%---------------------------
% probability on the opponents' action profile.
% The construction is not close to the original
% definition in the literature, but we may use it
% without loss of information.
% See also conjecture_of/5.
conjecture_at(W,(J,T),OAP,OTP,Prob):-
state_compatible_with_type(J,T,W),
theory((J,T),OTP,Prob),
findall((J1,T1,A),
(
member((J1,T1),OTP),
type(J1,T1,A)
),
OAP).
% conjecture_of/5 (added: 10 Mar 2005)
%---------------------------
% Each conjecture of a player has aggregated into
% an action profile other than the player
% according to the definition in [1].
actions_of_opponents(J,B,OAP):-
all_players(N),
subtract(N,[J],O),
action_profile_1(O,B,OAP).
conjecture_of((J,T),W,OAP,OtapCases,Prob):-
state_compatible_with_type(J,T,W),
actions_of_opponents(J,_,OAP),
G1 = member((J1,A),OAP),
G2 = conjecture_at(W,(J,T),Otap,_,Pr),
G3 = member((_,Pr),OtapCases),
findall((J1,_,A),G1,Otap),
findall((Otap,Pr),G2,OtapCases),
findall(Pr,G3,PP),
sum(PP,Prob).
/*************************************************
% demo (10 Mar 2005)
?- conjecture_of((J,T),W,OAP,OtapCases,Prob).
J = rowena
T = tC1
W = [tC1, tc1]
OAP = [ (colin, act_c)]
OtapCases = [ ([ (colin, tc1, act_c)], 1/2)]
Prob = 0.5 ;
J = rowena
T = tC1
W = [tC1, td1]
OAP = [ (colin, act_d)]
OtapCases = [ ([ (colin, td1, act_d)], 1/2), ([ (colin, td2, act_d)], 0)]
Prob = 0.5
Yes
?-
*************************************************/
% set_of_conjectures_at/3 and
% event_conjecture_of/3 (added: 10 Mar 2005)
set_of_conjectures_at(W,J,CJ):-
player(J),
state(W),
findall((OAP,Pr),
conjecture_of((J,_T),W,OAP,_OC,Pr)
,CJ).
event_conjecture_of(J,CJ,E):-
player(J),
setof(W,
set_of_conjectures_at(W,J,CJ)
,E).
know_conjecture_of((J1,C,E),(J,KE)):-
event_conjecture_of(J1,C,E),
knowledge((KE,_,_),J,(E,_,_)).
/*************************************************
% demo (10 Mar 2005)
?- set_of_conjectures_at(W,colin,CJ),
nl,write(W;CJ),fail.
[tC1, tc1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tD1, tc1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tD2, tc1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tC1, td1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tD1, td1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tD2, td1];[ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
[tC1, td2];[ ([ (rowena, act_C)], 0), ([ (rowena, act_D)], 1)]
[tD1, td2];[ ([ (rowena, act_C)], 0), ([ (rowena, act_D)], 1)]
[tD2, td2];[ ([ (rowena, act_C)], 0), ([ (rowena, act_D)], 1)]
No
?- event_conjecture_of(J,CJ,E),hexa_event(E,X,H).
J = rowena
CJ = [ ([ (colin, act_c)], 0.5), ([ (colin, act_d)], 0.5)]
E = [[tC1, tc1], [tC1, td1], [tC1, td2], [tD1, tc1], [tD1, td1], [tD1, td2]]
X = [1, 1, 1, 1, 1, 1, 0, 0, 0]
H = '1f8' ;
J = rowena
CJ = [ ([ (colin, act_c)], 0), ([ (colin, act_d)], 1)]
E = [[tD2, tc1], [tD2, td1], [tD2, td2]]
X = [0, 0, 0, 0, 0, 0, 1, 1, 1]
H = '007' ;
J = colin
CJ = [ ([ (rowena, act_C)], 0.5), ([ (rowena, act_D)], 0.5)]
E = [[tC1, tc1], [tC1, td1], [tD1, tc1], [tD1, td1], [tD2, tc1], [tD2, td1]]
X = [1, 1, 0, 1, 1, 0, 1, 1, 0]
H = '1b6' ;
J = colin
CJ = [ ([ (rowena, act_C)], 0), ([ (rowena, act_D)], 1)]
E = [[tC1, td2], [tD1, td2], [tD2, td2]]
X = [0, 0, 1, 0, 0, 1, 0, 0, 1]
H = '049' ;
No
?- know_conjecture_of((J,C,E),(J,KE)),
hexa_event(E,_,H),hexa_event(KE,_,Hk),
nl,write(J;'conjecture'=H;'knowledge'=Hk),fail.
rowena;conjecture=1f8;knowledge=1f8
rowena;conjecture=007;knowledge=007
colin;conjecture=1b6;knowledge=1b6
colin;conjecture=049;knowledge=049
No
?-
% The above result verifies Lemma 4.1, i.e.,
% K[cp] = [cp], for the example.
*************************************************/
% conjecture profile at a state
%---------------------------
conjecture_profile_1(_W,[],[],[]).
conjecture_profile_1(W,[J|N],[OAP|B],[(J,T,OAP,OTP,P)|X]):-
conjecture_profile_1(W,N,B,X),
conjecture_at(W,(J,T),OAP,OTP,P).
conjecture_profile(W,B,X):-
findall(I,player(I),N),
state(W),
conjecture_profile_1(W,N,B,X).
/*************************************************
% demo (8 Mar 2005)
?- W=[tC1,tc1],conjecture_at(W,(J,T),OA,OT,Prob),
nl,write(W;(J,T);OA;OT;Prob),fail.
[tC1, tc1];rowena, tC1;[ (colin, tc1, act_c)];[ (colin, tc1)];1/2
[tC1, tc1];rowena, tC1;[ (colin, td1, act_d)];[ (colin, td1)];1/2
[tC1, tc1];rowena, tC1;[ (colin, td2, act_d)];[ (colin, td2)];0
[tC1, tc1];colin, tc1;[ (rowena, tC1, act_C)];[ (rowena, tC1)];1/2
[tC1, tc1];colin, tc1;[ (rowena, tD1, act_D)];[ (rowena, tD1)];1/2
[tC1, tc1];colin, tc1;[ (rowena, tD2, act_D)];[ (rowena, tD2)];0
No
?- conjecture_profile(W,B,X).
W = [tC1, tc1]
B = [[ (colin, tc1, act_c)], [ (rowena, tC1, act_C)]]
X = [ (rowena, tC1, [ (colin, tc1, act_c)], [ (colin, tc1)], 1/2), (colin, tc1, [ (rowena, tC1, act_C)], [ (rowena, tC1)], 1/2)]
Yes
?-
*************************************************/
% extended conjecture with expected payoff
%---------------------------------------------------%
% added:27 Feb
% revised:1-2,4,8-9 Mar 2005
conjectural_payoff_at(W,(J,T,A),Actions,(OAP,OTP),P*U=V):-
conjecture_at(W,(J,T),OAP,OTP,P),
payoff((J,T),Actions,U),
member((J,A),Actions),
forall(
member((I,_,B),OAP),
member((I,B),Actions)
),
V is P * U.
% alternative (9 Mar 2005)
conjectural_payoff_at_1(W,(J,T,A),Actions,(OAP,OTP),Pr*U=V):-
conjecture_at(W,(J,T),OAP,OTP,Pr),
state_and_actions(_,_,Actions,TAP),
member((J,A),Actions),
subset(OAP,TAP),
payoff((J,T),Actions,U),
V is Pr * U.
/*************************************************
% demo (8 Mar 2005)
?- conjectural_payoff_at(W,(J,T,A),Actions,(OAP,OTP),P*U=V).
W = [tC1, tc1]
J = rowena
T = tC1
A = act_C
Actions = [ (rowena, act_C), (colin, act_c)]
OAP = [ (colin, tc1, act_c)]
OTP = [ (colin, tc1)]
P = 1/2
U = 2
V = 1
Yes
?- W=[tC1,tc1],
conjectural_payoff_at(W,Jta,Actions,(OTP,TAP),Pue),
nl,write(W;Jta;Actions;Pue),fail.
[tC1, tc1];rowena, tC1, act_C;[ (rowena, act_C), (colin, act_c)];1/2*2=1
[tC1, tc1];rowena, tC1, act_D;[ (rowena, act_D), (colin, act_c)];1/2*0=0
[tC1, tc1];rowena, tC1, act_C;[ (rowena, act_C), (colin, act_d)];1/2*0=0
[tC1, tc1];rowena, tC1, act_D;[ (rowena, act_D), (colin, act_d)];1/2*1=0.5
[tC1, tc1];rowena, tC1, act_C;[ (rowena, act_C), (colin, act_d)];0*0=0
[tC1, tc1];rowena, tC1, act_D;[ (rowena, act_D), (colin, act_d)];0*1=0
[tC1, tc1];colin, tc1, act_c;[ (rowena, act_C), (colin, act_c)];1/2*2=1
[tC1, tc1];colin, tc1, act_d;[ (rowena, act_C), (colin, act_d)];1/2*0=0
[tC1, tc1];colin, tc1, act_c;[ (rowena, act_D), (colin, act_c)];1/2*0=0
[tC1, tc1];colin, tc1, act_d;[ (rowena, act_D), (colin, act_d)];1/2*1=0.5
[tC1, tc1];colin, tc1, act_c;[ (rowena, act_D), (colin, act_c)];0*0=0
[tC1, tc1];colin, tc1, act_d;[ (rowena, act_D), (colin, act_d)];0*1=0
No
?-
*************************************************/
% Case = Conjecture + (Expected) Utility
expected_payoff(W,(J,T,A),Cases,EU):-
state_compatible_with_type(J,T,W),
action(J,A),
findall((Conj,P*U=E),
(
conjectural_payoff_at(W,(J,T,A),_,(Conj,_),P*U=E)
),
Cases),
findall(E,member((_,_=E),Cases),L),
sum(L,EU).
/*************************************************
% demo (8 Mar 2005)
?- expected_payoff(W,(J,T,A),Cases,EU).
W = [tC1, tc1]
J = rowena
T = tC1
A = act_C
Cases = [ ([ (colin, tc1, act_c)], 1/2*2=1), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 0*0=0)]
EU = 1
Yes
?- W=[tD2,td2],
expected_payoff(W,(J,T,A),Cases,EU),
forall_write([(W;J;T;A;EU)|Cases]),nl,fail.
[tD2, td2];rowena;tD2;act_C;0
[ (colin, tc1, act_c)], 0*2=0
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 1/2*0=0
[tD2, td2];rowena;tD2;act_D;1
[ (colin, tc1, act_c)], 0*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 1/2*1=0.5
[tD2, td2];colin;td2;act_c;0
[ (rowena, tC1, act_C)], 0*2=0
[ (rowena, tD1, act_D)], 1/2*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
[tD2, td2];colin;td2;act_d;1
[ (rowena, tC1, act_C)], 0*0=0
[ (rowena, tD1, act_D)], 1/2*1=0.5
[ (rowena, tD2, act_D)], 1/2*1=0.5
No
?-
*************************************************/
% recursive profiles
%--------------------
exp_payoff_profile_1(_,[],[],[],[]).
exp_payoff_profile_1(W,[(J,A)|R],[V|Z],[Q|F],[Cases|D]):-
exp_payoff_profile_1(W,R,Z,F,D),
expected_payoff(W,(J,T,A),Cases,V),
Q=(J,T,A,V).
exp_payoff_profile(W,A,U,Xp,Cases):-
state(W),
action_profile(_,_,A),
exp_payoff_profile_1(W,A,U,Xp,Cases).
% Xp: extended action profile (in tuple) with types and payoffs
% Cp: extended conjecture profile (in tuple) with expected payoffs
/*************************************************
% demo (8 Mar 2005)
?- W=[tD2,td2],exp_payoff_profile(W,A,U,XP,Cases),
nl,write(*;A;U),fail.
*;[ (rowena, act_C), (colin, act_c)];[0, 0]
*;[ (rowena, act_D), (colin, act_c)];[1, 0]
*;[ (rowena, act_C), (colin, act_d)];[0, 1]
*;[ (rowena, act_D), (colin, act_d)];[1, 1]
No
?- W=[tD2,td2],exp_payoff_profile(W,A,U,XP,Cases),
nl,write(*;A;U),tab(1),forall_write(XP),fail.
*;[ (rowena, act_C), (colin, act_c)];[0, 0]
[rowena, tD2, act_C, 0]
[colin, td2, act_c, 0]
*;[ (rowena, act_D), (colin, act_c)];[1, 0]
[rowena, tD2, act_D, 1]
[colin, td2, act_c, 0]
*;[ (rowena, act_C), (colin, act_d)];[0, 1]
[rowena, tD2, act_C, 0]
[colin, td2, act_d, 1]
*;[ (rowena, act_D), (colin, act_d)];[1, 1]
[rowena, tD2, act_D, 1]
[colin, td2, act_d, 1]
No
?- W=[tD2,td2],exp_payoff_profile(W,A,U,XP,Cases),
nl,write(*;A;U),tab(1),forall_write(Cases),fail.
*;[ (rowena, act_C), (colin, act_c)];[0, 0]
[ ([ (colin, tc1, act_c)], 0*2=0), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 1/2*0=0)]
[ ([ (rowena, tC1, act_C)], 0*2=0), ([ (rowena, tD1, act_D)], 1/2*0=0), ([ (rowena, tD2, act_D)], 1/2*0=0)]
*;[ (rowena, act_D), (colin, act_c)];[1, 0]
[ ([ (colin, tc1, act_c)], 0*0=0), ([ (colin, td1, act_d)], 1/2*1=0.5), ([ (colin, td2, act_d)], 1/2*1=0.5)]
[ ([ (rowena, tC1, act_C)], 0*2=0), ([ (rowena, tD1, act_D)], 1/2*0=0), ([ (rowena, tD2, act_D)], 1/2*0=0)]
*;[ (rowena, act_C), (colin, act_d)];[0, 1]
[ ([ (colin, tc1, act_c)], 0*2=0), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 1/2*0=0)]
[ ([ (rowena, tC1, act_C)], 0*0=0), ([ (rowena, tD1, act_D)], 1/2*1=0.5), ([ (rowena, tD2, act_D)], 1/2*1=0.5)]
*;[ (rowena, act_D), (colin, act_d)];[1, 1]
[ ([ (colin, tc1, act_c)], 0*0=0), ([ (colin, td1, act_d)], 1/2*1=0.5), ([ (colin, td2, act_d)], 1/2*1=0.5)]
[ ([ (rowena, tC1, act_C)], 0*0=0), ([ (rowena, tD1, act_D)], 1/2*1=0.5), ([ (rowena, tD2, act_D)], 1/2*1=0.5)]
No
?-
*************************************************/
% revised: 4 Mar 2005
exp_payoff((J,T,A,U),W,(Ap,Xp,Cases)):-
exp_payoff_profile(W,Ap,_Up,Xp,Cases),
member((J,T,A,U), Xp).
test_exp_payoff(J_T_A_U,W):-
exp_payoff(J_T_A_U,W,(Actions,_Xp,Cases)),
nl,write(J_T_A_U),
nl,write(W;Actions),
forall(member(C,Cases),forall_write(C)),
fail.
/*************************************************
% demo (9 Mar 2005)
?- J_T_A_U=(rowena,tC1,_,_),W=[tC1,tc1],
test_exp_payoff(J_T_A_U,W).
rowena, tC1, act_C, 1
[tC1, tc1];[ (rowena, act_C), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 0*0=0
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 1/2*0=0
[ (rowena, tD2, act_D)], 0*0=0
rowena, tC1, act_D, 0.5
[tC1, tc1];[ (rowena, act_D), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 0*1=0
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 1/2*0=0
[ (rowena, tD2, act_D)], 0*0=0
rowena, tC1, act_C, 1
[tC1, tc1];[ (rowena, act_C), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 0*0=0
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 1/2*1=0.5
[ (rowena, tD2, act_D)], 0*1=0
rowena, tC1, act_D, 0.5
[tC1, tc1];[ (rowena, act_D), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 0*1=0
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 1/2*1=0.5
[ (rowena, tD2, act_D)], 0*1=0
No
?- J_T_A_U=(rowena,tC1,_,_),W=[tC1,td1],
test_exp_payoff(J_T_A_U,W).
rowena, tC1, act_C, 1
[tC1, td1];[ (rowena, act_C), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 0*0=0
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 0*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tC1, act_D, 0.5
[tC1, td1];[ (rowena, act_D), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 0*1=0
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 0*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tC1, act_C, 1
[tC1, td1];[ (rowena, act_C), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 0*0=0
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 0*1=0
[ (rowena, tD2, act_D)], 1/2*1=0.5
rowena, tC1, act_D, 0.5
[tC1, td1];[ (rowena, act_D), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 0*1=0
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 0*1=0
[ (rowena, tD2, act_D)], 1/2*1=0.5
No
?- J_T_A_U=(rowena,tD1,_,_),W=[tD1,td1],
test_exp_payoff(J_T_A_U,W).
rowena, tD1, act_C, 1
[tD1, td1];[ (rowena, act_C), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 0*0=0
[ (colin, td2, act_d)], 1/2*0=0
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 0*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tD1, act_D, 0.5
[tD1, td1];[ (rowena, act_D), (colin, act_c)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 0*1=0
[ (colin, td2, act_d)], 1/2*1=0.5
[ (rowena, tC1, act_C)], 1/2*2=1
[ (rowena, tD1, act_D)], 0*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tD1, act_C, 1
[tD1, td1];[ (rowena, act_C), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*2=1
[ (colin, td1, act_d)], 0*0=0
[ (colin, td2, act_d)], 1/2*0=0
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 0*1=0
[ (rowena, tD2, act_D)], 1/2*1=0.5
rowena, tD1, act_D, 0.5
[tD1, td1];[ (rowena, act_D), (colin, act_d)]
[ (colin, tc1, act_c)], 1/2*0=0
[ (colin, td1, act_d)], 0*1=0
[ (colin, td2, act_d)], 1/2*1=0.5
[ (rowena, tC1, act_C)], 1/2*0=0
[ (rowena, tD1, act_D)], 0*1=0
[ (rowena, tD2, act_D)], 1/2*1=0.5
No
?- J_T_A_U=(rowena,_,_,_),W=[tD2,td2],
test_exp_payoff(J_T_A_U,W).
rowena, tD2, act_C, 0
[tD2, td2];[ (rowena, act_C), (colin, act_c)]
[ (colin, tc1, act_c)], 0*2=0
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 1/2*0=0
[ (rowena, tC1, act_C)], 0*2=0
[ (rowena, tD1, act_D)], 1/2*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tD2, act_D, 1
[tD2, td2];[ (rowena, act_D), (colin, act_c)]
[ (colin, tc1, act_c)], 0*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 1/2*1=0.5
[ (rowena, tC1, act_C)], 0*2=0
[ (rowena, tD1, act_D)], 1/2*0=0
[ (rowena, tD2, act_D)], 1/2*0=0
rowena, tD2, act_C, 0
[tD2, td2];[ (rowena, act_C), (colin, act_d)]
[ (colin, tc1, act_c)], 0*2=0
[ (colin, td1, act_d)], 1/2*0=0
[ (colin, td2, act_d)], 1/2*0=0
[ (rowena, tC1, act_C)], 0*0=0
[ (rowena, tD1, act_D)], 1/2*1=0.5
[ (rowena, tD2, act_D)], 1/2*1=0.5
rowena, tD2, act_D, 1
[tD2, td2];[ (rowena, act_D), (colin, act_d)]
[ (colin, tc1, act_c)], 0*0=0
[ (colin, td1, act_d)], 1/2*1=0.5
[ (colin, td2, act_d)], 1/2*1=0.5
[ (rowena, tC1, act_C)], 0*0=0
[ (rowena, tD1, act_D)], 1/2*1=0.5
[ (rowena, tD2, act_D)], 1/2*1=0.5
No
?-
*************************************************/
% revised: 2-3 Mar 2005. (refactoring)
% revised: 8 Mar 2005.
conjectures_in_cases(Cases,Conjectures):-
findall((C, P),
(
member(Cj,Cases),
member((C, P*_U=_E), Cj)
),
Conjectures).
support_in_conjectures(Conjectures,Support) :-
findall((J,A),
(
member((C,P), Conjectures),
P>0,
member((J,_T,A), C)
),
Support).
marginal_agree_with(Jtau,W,Y,D) :-
Y=(Actions,Cases,Conjectures,Support,Meet),
exp_payoff(Jtau,W,(Actions,_Xp,Cases)),
conjectures_in_cases(Cases,Conjectures),
support_in_conjectures(Conjectures,Support),
intersection(Actions,Support,Meet),
asymmetric_differences(Actions,Meet,D).
% asymmetric_differences(A,B,D) -> common programs.
/*************************************************
% demo (8 Mar 2005)
?- W=[tD2,td2],marginal_agree_with(Jtau,W,Y,D),
Y=(Actions,Cases,Conjectures,Support,Meet).
W = [tD2, td2]
Jtau = rowena, tD2, act_C, 0
Y = [ (rowena, act_C), (colin, act_c)], [[ ([ (colin, tc1, act_c)], 0*2=0), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, ..., ...)], ... /... *0=0)], [ ([ (rowena, tC1, act_C)], 0*2=0), ([ (rowena, ..., ...)], ... /... *0=0), ([ (..., ...)], ... *... =0)]], [ ([ (colin, tc1, act_c)], 0), ([ (colin, td1, act_d)], 1/2), ([ (colin, ..., ...)], 1/2), ([ (..., ...)], 0), ([...], ... /...), (..., ...)], [ (colin, act_d), (colin, act_d), (rowena, act_D), (rowena, act_D)], []
D = [ (rowena, act_C), (colin, act_c)], []
Actions = [ (rowena, act_C), (colin, act_c)]
Cases = [[ ([ (colin, tc1, act_c)], 0*2=0), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 1/2*0=0)], [ ([ (rowena, tC1, act_C)], 0*2=0), ([ (rowena, tD1, act_D)], 1/2*0=0), ([ (rowena, tD2, act_D)], 1/2*0=0)]]
Conjectures = [ ([ (colin, tc1, act_c)], 0), ([ (colin, td1, act_d)], 1/2), ([ (colin, td2, act_d)], 1/2), ([ (rowena, tC1, act_C)], 0), ([ (rowena, tD1, act_D)], 1/2), ([ (rowena, ..., ...)], 1/2)]
Support = [ (colin, act_d), (colin, act_d), (rowena, act_D), (rowena, act_D)]
Meet = []
Yes
?- W=[tD2,td2],marginal_agree_with(Jtau,W,Y,D),
Y=(Actions,Cases,Conjectures,Support,Meet),
nl,write(*;W;Jtau;D),forall_write(Y),fail.
*;[tD2, td2];rowena, tD2, act_C, 0;[ (rowena, act_C), (colin, act_c)], []
*;[tD2, td2];colin, td2, act_c, 0;[ (rowena, act_C), (colin, act_c)], []
*;[tD2, td2];rowena, tD2, act_D, 1;[ (colin, act_c)], []
*;[tD2, td2];colin, td2, act_c, 0;[ (colin, act_c)], []
*;[tD2, td2];rowena, tD2, act_C, 0;[ (rowena, act_C)], []
*;[tD2, td2];colin, td2, act_d, 1;[ (rowena, act_C)], []
*;[tD2, td2];rowena, tD2, act_D, 1;[], []
*;[tD2, td2];colin, td2, act_d, 1;[], []
No
?-
*************************************************/
%---------------------------------------------------%
% 4. rationality and knowledge of rationality
%---------------------------------------------------%
% 24-25 Feb 2005
% revised: 27 Feb--9 Mar 2005
% risk mode for the latter part of analysis.
%---------------------------------------------------%
% added: 24-25 Feb 2005 (no-risk mode.)
% revised: 1-3,8 Mar 2005 (added risk mode.)
% modified: 8 Mar 2005 (current_risk_mode/2 separated.)
:- dynamic risk_mode_0/1.
risk_mode_0(off). % default mode.
risk_mode(Switch):-
var(Switch),
risk_mode_0(Switch).
risk_mode(Switch):-
\+ var(Switch),
member(Switch,[on,off,nt]),
abolish(risk_mode_0/1),
assert(risk_mode_0(Switch)).
current_risk_mode(RM,M):-
risk_mode_0(RM),
member((RM,M),
[
(nt,typeless),
(off,no_risk),
(on,risk)
]
).
% rationality without/with risk
%---------------------------------------------------%
% i is called rational at s if ....
% exp g_i(a_i, ^-i); s_i)>=exp g_i(b_i, ^-i); s_i)
% for all b_i in A_i.
% ([1], pp.1165)
rationality(M,(W,N,AP,UP,R),BR_data,Payoffs):-
all_players(N),
current_risk_mode(_,M),
rationality_1(M,W,(W,N,AP,UP,R),BR_data,Payoffs).
rationality_1(_,_,([],[],[],[],[]),_,[]).
rationality_1(M,W,Z,BR_data,[(J,T,A,U,R)|Pay]):-
Z=([T|O],[J|N],[A|AP],[U|UP],[R|RP]),
rationality_1(M,W,(O,N,AP,UP,RP),BR_data,Pay),
best_response(M,W,(J,T,A,U),BR_data,R).
% best response in pure strategies.
best_response(RiskMode,W,(J,T,A,U),BR_data,R):-
beneficial_deviation(RiskMode,W,(J,T,A,U),BR_data,_,Rc),
member([Rc,R],[[y,n],[n,y]]).
beneficial_deviation(typeless,W,(J,T,A,U),BR_data,(J,B,U1),R):-
risk_mode_0(nt),
state_compatible_with_type(J,T,W),
type(J,T,A),
payoff(J,Actions,U),
member((J,A),Actions),
payoff(J,Actions1,U1),
is_unilateral_deviation(Actions,Actions1,(J,A,B)),
(U1 > U->R=y;R=n),
BR_data=(Actions,[],[]).
beneficial_deviation(no_risk,W,(J,T,A,U),BR_data,(J,B,U1),R):-
risk_mode_0(off),
state_compatible_with_type(J,T,W),
payoff((J,T),Actions,U),
member((J,A),Actions),
type(J,T,A), % revised: 4 Mar
payoff((J,T),Actions1,U1),
is_unilateral_deviation(Actions,Actions1,(J,A,B)),
(U1 > U->R=y;R=n),
BR_data=(Actions,[],[]).
beneficial_deviation(risk,W,(J,T,A,U),BR_data,(J,B,U1),R):-
risk_mode_0(on),
state_and_actions(W,_,Actions,_), % revised: 8 Mar
exp_payoff((J,T,A,U),W,(Actions,Xp,Cp)),
%type(J,T,A), % revised: 4 Mar
exp_payoff((J,T,B,U1),W,(Actions1,_,_)),
is_unilateral_deviation(Actions,Actions1,(J,A,B)),
(U1 > U->R=y;R=n),
BR_data=(Actions,Xp,Cp).
is_unilateral_deviation(Actions,Actions1,(J,A,B)):-
subtract(Actions,Actions1,[(J,A)]),
subtract(Actions1,Actions,[(J,B)]).
:- dynamic best_response_0/4.
inspect_all_best_responses:-
risk_mode(on),
abolish(best_response_0/4),
forall(
best_response(risk,W,(J,T,A,U),BR_data,y),
assert(
best_response_0(risk,W,(J,T,A,U),BR_data)
)
).
/*************************************************
% demo (8 Mar 2005)
?- risk_mode(off). % default mode
Yes
?- W=[tC1, tc1],rationality(M,(W,Z),Actions,Pay).
W = [tC1, tc1]
M = no_risk
Z = [rowena, colin], [act_C, act_c], [2, 2], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)], [], []
Pay = [ (rowena, tC1, act_C, 2, y), (colin, tc1, act_c, 2, y)] ;
No
?- risk_mode(on).
Yes
?- W=[tC1, tc1],rationality(M,(W,Z),(Ap,Xp,Cp),Pay).
W = [tC1, tc1]
M = risk
Z = [rowena, colin], [act_C, act_c], [1, 1], [y, y]
Ap = [ (rowena, act_C), (colin, act_c)]
Xp = [ (rowena, tC1, act_C, 1), (colin, tc1, act_c, 1)]
Cp = [[ ([ (colin, tc1, act_c)], 1/2*2=1), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 0*0=0)], [ ([ (rowena, tC1, act_C)], 1/2*2=1), ([ (rowena, tD1, act_D)], 1/2*0=0), ([ (rowena, tD2, act_D)], 0*0=0)]]
Pay = [ (rowena, tC1, act_C, 1, y), (colin, tc1, act_c, 1, y)] ;
No
?- risk_mode(nt).
Yes
?- W=[tC1, tc1],rationality(M,(W,Z),Actions,Pay).
W = [tC1, tc1]
M = typeless
Z = [rowena, colin], [act_C, act_c], [2, 2], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)], [], []
Pay = [ (rowena, tC1, act_C, 2, y), (colin, tc1, act_c, 2, y)] ;
No
?-
*************************************************/
% rationality of each player
is_rational_at(W,(J,T,A,U),Z,(Actions,Xp,Cp)):-
rationality(_risk_mode,(W,Z),(Actions,Xp,Cp),Pay),
member((J,T,A,U,y),Pay).
% Xp: extended action profile (in tuple) with types and payoffs
% Cp: extended conjecture profile (in tuple) with expected payoffs
% note: risk mode can be seen
% as a background variable which
% is determined by the context.
/*************************************************
% demo (8 Mar 2005)
?- risk_mode(nt).
Yes
?- is_rational_at(W,JTAU,Z,(Actions,XpCp)).
W = [tC1, tc1]
JTAU = rowena, tC1, act_C, 2
Z = [rowena, colin], [act_C, act_c], [2, 2], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)]
XpCp = [], [] ;
W = [tC1, tc1]
JTAU = colin, tc1, act_c, 2
Z = [rowena, colin], [act_C, act_c], [2, 2], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)]
XpCp = [], []
Yes
?- risk_mode(on).
Yes
?- is_rational_at(W,JTAU,Z,(Actions,Xp,Cp)).
W = [tC1, tc1]
JTAU = rowena, tC1, act_C, 1
Z = [rowena, colin], [act_C, act_c], [1, 1], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)]
Xp = [ (rowena, tC1, act_C, 1), (colin, tc1, act_c, 1)]
Cp = [[
([ (colin, tc1, act_c)], 1/2*2=1),
([ (colin, td1, act_d)], 1/2*0=0),
([ (colin, td2, act_d)], 0*0=0)],
[ ([ (rowena, tC1, act_C)], 1/2*2=1),
([ (rowena, tD1, act_D)], 1/2*0=0),
([ (rowena, tD2, act_D)], 0*0=0)]] ;
W = [tC1, tc1]
JTAU = colin, tc1, act_c, 1
Z = [rowena, colin], [act_C, act_c], [1, 1], [y, y]
Actions = [ (rowena, act_C), (colin, act_c)]
Xp = [ (rowena, tC1, act_C, 1), (colin, tc1, act_c, 1)]
Cp = [[ ([ (colin, tc1, act_c)], 1/2*2=1), ([ (colin, td1, act_d)], 1/2*0=0), ([ (colin, td2, act_d)], 0*0=0)], [ ([ (rowena, tC1, act_C)], 1/2*2=1), ([ (rowena, tD1, act_D)], 1/2*0=0), ([ (rowena, tD2, act_D)], 0*0=0)]]
Yes
?-
*************************************************/
event_rational(EP):-
findall((W,Z,Axc,Pay),
(
rationality(_risk_mode,(W,Z),Axc,Pay)
),
EP).
event_rational_for_player(J,(RA,PR),R):-
player(J),
findall((W,A,Z,Axc),
(
is_rational_at(W,(J,_T,A,_U),Z,Axc)
),
PR),
findall(W,member((W,_,_,_),PR),R1),
sort(R1,R),
findall(A,member((_,A,_,_),PR),RA1),
sort(RA1,RA).
event_rational_for_player_of_type((J,T),(RA,PR),R):-
type(J,T),
findall((W,A,Z,Axc),
(
is_rational_at(W,(J,T,A,_U),Z,Axc)
),
PR),
findall(W,member((W,_,_,_),PR),R1),
sort(R1,R),
findall(A,member((_,A,_,_),PR),RA1),
sort(RA1,RA).
/*************************************************
% demo (8 Mar 2005)
?- risk_mode(nt).
Yes
?- event_rational_for_player(J,(A,_),R),
hexa_event(R,_,HxR),nl,write(J;A;R;HxR),fail.
rowena;[act_C, act_D];[[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];11b
colin;[act_c, act_d];[[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];11b
No
?- event_rational_for_player_of_type((J,T),(A,_),R),
hexa_event(R,_,HxR),nl,write((J,T);A;R;HxR),fail.
rowena, tC1;[act_C];[[tC1, tc1]];100
rowena, tD1;[act_D];[[tD1, td1], [tD1, td2]];018
rowena, tD2;[act_D];[[tD2, td1], [tD2, td2]];003
colin, tc1;[act_c];[[tC1, tc1]];100
colin, td1;[act_d];[[tD1, td1], [tD2, td1]];012
colin, td2;[act_d];[[tD1, td2], [tD2, td2]];009
No
?- event_rational(E),member((W,X,_),E),,T),(A,_),R),
nl,write(W;X),fail.
[tC1, tc1];[rowena, colin], [act_C, act_c], [2, 2], [y, y]
[tD1, tc1];[rowena, colin], [act_D, act_c], [0, 0], [n, n]
[tD2, tc1];[rowena, colin], [act_D, act_c], [0, 0], [n, n]
[tC1, td1];[rowena, colin], [act_C, act_d], [0, 0], [n, n]
[tD1, td1];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tD2, td1];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tC1, td2];[rowena, colin], [act_C, act_d], [0, 0], [n, n]
[tD1, td2];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tD2, td2];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
No
?- risk_mode(off).
Yes
?- event_rational(E),member((W,X,_),E),
nl,write(W;X),fail.
[tC1, tc1];[rowena, colin], [act_C, act_c], [2, 2], [y, y]
[tD1, tc1];[rowena, colin], [act_D, act_c], [0, 0], [n, n]
[tD2, tc1];[rowena, colin], [act_D, act_c], [0, 0], [n, n]
[tC1, td1];[rowena, colin], [act_C, act_d], [0, 0], [n, n]
[tD1, td1];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tD2, td1];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tC1, td2];[rowena, colin], [act_C, act_d], [0, 0], [n, n]
[tD1, td2];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
[tD2, td2];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
No
?- event_rational_for_player(J1,(A,B),R),
forall_write(B).
[tC1, tc1], act_C, ([rowena, colin], [act_C, act_c], [2, 2], [y, y]), [ (rowena, act_C), (colin, act_c)], [], []
[tD1, td1], act_D, ([rowena, colin], [act_D, act_d], [1, 1], [y, y]), [ (rowena, act_D), (colin, act_d)], [], []
[tD2, td1], act_D, ([rowena, colin], [act_D, act_d], [1, 1], [y, y]), [ (rowena, act_D), (colin, act_d)], [], []
[tD1, td2], act_D, ([rowena, colin], [act_D, act_d], [1, 1], [y, y]), [ (rowena, act_D), (colin, act_d)], [], []
[tD2, td2], act_D, ([rowena, colin], [act_D, act_d], [1, 1], [y, y]), [ (rowena, act_D), (colin, act_d)], [], []
J1 = rowena
A = [act_C, act_D]
B = [ ([tC1, tc1], act_C, ([rowena, colin], [act_C, act_c], [2, 2], [y, y]), [ (rowena, act_C), (colin, act_c)], [], []), ([tD1, td1], act_D, ([rowena, colin], [act_D, act_d], [1|...], [y|...]), [ (rowena, act_D), (colin, act_d)], [], []), ([tD2, td1], act_D, ([rowena, colin], [act_D|...], [...|...], [...|...]), [ (rowena, act_D), (..., ...)], [], []), ([tD1, td2], act_D, ([rowena|...], [...|...], ..., ...), [ (..., ...)|...], [], []), ([tD2, td2], act_D, ([...|...], ..., ...), [...|...], ..., ...)]
R = [[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]]
Yes
?- event_rational_for_player(J,(A,_),R),
hexa_event(R,_,HxR),nl,write(J;A;R;HxR),fail.
rowena;[act_C, act_D];[[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];11b
colin;[act_c, act_d];[[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]];11b
No
?- event_rational_for_player_of_type((J,T),(A,_),R),
hexa_event(R,_,HxR),nl,write((J,T);A;R;HxR),fail.
rowena, tC1;[act_C];[[tC1, tc1]];100
rowena, tD1;[act_D];[[tD1, td1], [tD1, td2]];018
rowena, tD2;[act_D];[[tD2, td1], [tD2, td2]];003
colin, tc1;[act_c];[[tC1, tc1]];100
colin, td1;[act_d];[[tD1, td1], [tD2, td1]];012
colin, td2;[act_d];[[tD1, td2], [tD2, td2]];009
No
?-
?- risk_mode(on).
Yes
?- event_rational(E),member((W,X,_),E),
nl,write(W;X),fail.
[tC1, tc1];[rowena, colin], [act_C, act_c], [1, 1], [y, y]
[tD1, tc1];[rowena, colin], [act_D, act_c], [0.5, 1], [n, y]
[tD2, tc1];[rowena, colin], [act_D, act_c], [1, 1], [y, y]
[tC1, td1];[rowena, colin], [act_C, act_d], [1, 0.5], [y, n]
[tD1, td1];[rowena, colin], [act_D, act_d], [0.5, 0.5], [n, n]
[tD2, td1];[rowena, colin], [act_D, act_d], [1, 0.5], [y, n]
[tC1, td2];[rowena, colin], [act_C, act_d], [1, 1], [y, y]
[tD1, td2];[rowena, colin], [act_D, act_d], [0.5, 1], [n, y]
[tD2, td2];[rowena, colin], [act_D, act_d], [1, 1], [y, y]
No
?- event_rational_for_player(J,(A,_),R),
hexa_event(R,_,HxR),nl,write(J;A;HxR;R),fail.
rowena;[act_C, act_D];1c7;[[tC1, tc1], [tC1, td1], [tC1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]]
colin;[act_c, act_d];16d;[[tC1, tc1], [tC1, td2], [tD1, tc1], [tD1, td2], [tD2, tc1], [tD2, td2]]
No
?- event_rational_for_player_of_type((J,T),(A,_),R),
hexa_event(R,_,HxR),nl,write((J,T);A;HxR;R),fail.
rowena, tC1;[act_C];1c0;[[tC1, tc1], [tC1, td1], [tC1, td2]]
rowena, tD1;[];000;[]
rowena, tD2;[act_D];007;[[tD2, tc1], [tD2, td1], [tD2, td2]]
colin, tc1;[act_c];124;[[tC1, tc1], [tD1, tc1], [tD2, tc1]]
colin, td1;[];000;[]
colin, td2;[act_d];049;[[tC1, td2], [tD1, td2], [tD2, td2]]
No
?-
*************************************************/
% knowledge of rationality
%---------------------------------------------------%
% added: 25 Feb 2005
% revised: 3-8 Feb 2005
knowledge_of_rationality_at(W,J,(J1,A,R)):-
event_rational_for_player(J1,(A,_),R),
knowledge_at(W,J,(R,_,_)).
ignorance_of_rationality_at(W,J,(J1,A,R)):-
event_rational_for_player(J1,(A,_),R),
player(J),
state(W),
\+ knowledge_at(W,J,(R,_,_)).
mutual_knowledge_of_rationality_at(W,(J,A,R)):-
event_rational_for_player(J,(A,_),R),
state(W),
\+ (
ignorance_of_rationality_at(W,_,(J,A,R))
).
/*************************************************
?- risk_mode(nt).
Yes
?- knowledge_of_rationality_at(W,J,(J1,A,R)),R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tD2, tc1];rowena, [act_C, act_D];11b
rowena;[tD2, td1];rowena, [act_C, act_D];11b
rowena;[tD2, td2];rowena, [act_C, act_D];11b
colin;[tC1, td2];rowena, [act_C, act_D];11b
colin;[tD1, td2];rowena, [act_C, act_D];11b
colin;[tD2, td2];rowena, [act_C, act_D];11b
rowena;[tD2, tc1];colin, [act_c, act_d];11b
rowena;[tD2, td1];colin, [act_c, act_d];11b
rowena;[tD2, td2];colin, [act_c, act_d];11b
colin;[tC1, td2];colin, [act_c, act_d];11b
colin;[tD1, td2];colin, [act_c, act_d];11b
colin;[tD2, td2];colin, [act_c, act_d];11b
No
?- W=[tC1,tc1],
ignorance_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tC1, tc1];rowena, [act_C, act_D];11b
colin;[tC1, tc1];rowena, [act_C, act_D];11b
rowena;[tC1, tc1];colin, [act_c, act_d];11b
colin;[tC1, tc1];colin, [act_c, act_d];11b
No
?- W=[tD2,td2],
ignorance_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H,R)),fail.
No
?- risk_mode(off).
Yes
?- knowledge_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tD2, tc1];rowena, [act_C, act_D];11b
rowena;[tD2, td1];rowena, [act_C, act_D];11b
rowena;[tD2, td2];rowena, [act_C, act_D];11b
colin;[tC1, td2];rowena, [act_C, act_D];11b
colin;[tD1, td2];rowena, [act_C, act_D];11b
colin;[tD2, td2];rowena, [act_C, act_D];11b
rowena;[tD2, tc1];colin, [act_c, act_d];11b
rowena;[tD2, td1];colin, [act_c, act_d];11b
rowena;[tD2, td2];colin, [act_c, act_d];11b
colin;[tC1, td2];colin, [act_c, act_d];11b
colin;[tD1, td2];colin, [act_c, act_d];11b
colin;[tD2, td2];colin, [act_c, act_d];11b
No
?- ignorance_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tC1, tc1];rowena, [act_C, act_D];11b
rowena;[tD1, tc1];rowena, [act_C, act_D];11b
rowena;[tC1, td1];rowena, [act_C, act_D];11b
rowena;[tD1, td1];rowena, [act_C, act_D];11b
rowena;[tC1, td2];rowena, [act_C, act_D];11b
rowena;[tD1, td2];rowena, [act_C, act_D];11b
colin;[tC1, tc1];rowena, [act_C, act_D];11b
colin;[tD1, tc1];rowena, [act_C, act_D];11b
colin;[tD2, tc1];rowena, [act_C, act_D];11b
colin;[tC1, td1];rowena, [act_C, act_D];11b
colin;[tD1, td1];rowena, [act_C, act_D];11b
colin;[tD2, td1];rowena, [act_C, act_D];11b
rowena;[tC1, tc1];colin, [act_c, act_d];11b
rowena;[tD1, tc1];colin, [act_c, act_d];11b
rowena;[tC1, td1];colin, [act_c, act_d];11b
rowena;[tD1, td1];colin, [act_c, act_d];11b
rowena;[tC1, td2];colin, [act_c, act_d];11b
rowena;[tD1, td2];colin, [act_c, act_d];11b
colin;[tC1, tc1];colin, [act_c, act_d];11b
colin;[tD1, tc1];colin, [act_c, act_d];11b
colin;[tD2, tc1];colin, [act_c, act_d];11b
colin;[tC1, td1];colin, [act_c, act_d];11b
colin;[tD1, td1];colin, [act_c, act_d];11b
colin;[tD2, td1];colin, [act_c, act_d];11b
No
?- risk_mode(on).
Yes
?- knowledge_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tC1, tc1];rowena, [act_C, act_D];1c7
rowena;[tC1, td1];rowena, [act_C, act_D];1c7
rowena;[tC1, td2];rowena, [act_C, act_D];1c7
rowena;[tD2, tc1];rowena, [act_C, act_D];1c7
rowena;[tD2, td1];rowena, [act_C, act_D];1c7
rowena;[tD2, td2];rowena, [act_C, act_D];1c7
colin;[tC1, td1];rowena, [act_C, act_D];1c7
colin;[tD1, td1];rowena, [act_C, act_D];1c7
colin;[tD2, td1];rowena, [act_C, act_D];1c7
rowena;[tD1, tc1];colin, [act_c, act_d];16d
rowena;[tD1, td1];colin, [act_c, act_d];16d
rowena;[tD1, td2];colin, [act_c, act_d];16d
colin;[tC1, tc1];colin, [act_c, act_d];16d
colin;[tD1, tc1];colin, [act_c, act_d];16d
colin;[tD2, tc1];colin, [act_c, act_d];16d
colin;[tC1, td2];colin, [act_c, act_d];16d
colin;[tD1, td2];colin, [act_c, act_d];16d
colin;[tD2, td2];colin, [act_c, act_d];16d
No
?- ignorance_of_rationality_at(W,J,(J1,A,R)),
hexa_event(R,_,H),nl,write(J;W;(J1,A);(H)),fail.
rowena;[tD1, tc1];rowena, [act_C, act_D];1c7
rowena;[tD1, td1];rowena, [act_C, act_D];1c7
rowena;[tD1, td2];rowena, [act_C, act_D];1c7
colin;[tC1, tc1];rowena, [act_C, act_D];1c7
colin;[tD1, tc1];rowena, [act_C, act_D];1c7
colin;[tD2, tc1];rowena, [act_C, act_D];1c7
colin;[tC1, td2];rowena, [act_C, act_D];1c7
colin;[tD1, td2];rowena, [act_C, act_D];1c7
colin;[tD2, td2];rowena, [act_C, act_D];1c7
rowena;[tC1, tc1];colin, [act_c, act_d];16d
rowena;[tD2, tc1];colin, [act_c, act_d];16d
rowena;[tC1, td1];colin, [act_c, act_d];16d
rowena;[tD2, td1];colin, [act_c, act_d];16d
rowena;[tC1, td2];colin, [act_c, act_d];16d
rowena;[tD2, td2];colin, [act_c, act_d];16d
colin;[tC1, td1];colin, [act_c, act_d];16d
colin;[tD1, td1];colin, [act_c, act_d];16d
colin;[tD2, td1];colin, [act_c, act_d];16d
No
?-
*************************************************/
/*************************************************
% First two simulations which are both without risks (*)
% show us the two cases of of the game ([1], p.1167),
% i.e., Both players are rational at state (tD2,td2).
% (*) type-irrelevant payoffs (nt--typeless),
% or risk sensitive payoffs but constant (off--no_risk))
% current_risk_mode(off,no_risk).
% current_risk_mode(on,risk).
% current_risk_mode(nt,typeless).
% However, the third simulation with shows that this rationality may
% not implies the mutual knowledge of the rationality.
?- risk_mode(nt).
Yes
?- mutual_knowledge_of_rationality_at(W,(J,A,R)),
hexa_event(R,_,Hx),nl,write(W;(J,R,Hx)),fail.
[tD2, td2];rowena, [[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 11b
[tD2, td2];colin, [[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 11b
No
?- risk_mode(off).
Yes
?- mutual_knowledge_of_rationality_at(W,(J,A,R)),
hexa_event(R,_,Hx),nl,write(W;(J,R,Hx)),fail.
[tD2, td2];rowena, [[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 11b
[tD2, td2];colin, [[tC1, tc1], [tD1, td1], [tD1, td2], [tD2, td1], [tD2, td2]], 11b
No
?- risk_mode(on).
Yes
?- mutual_knowledge_of_rationality_at(W,(J,A,R)),
hexa_event(R,_,H),nl,write(W;(J,R,H)),fail.
[tC1, td1];rowena, [[tC1, tc1], [tC1, td1], [tC1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]], 1c7
[tD2, td1];rowena, [[tC1, tc1], [tC1, td1], [tC1, td2], [tD2, tc1], [tD2, td1], [tD2, td2]], 1c7
[tD1, tc1];colin, [[tC1, tc1], [tC1, td2], [tD1, tc1], [tD1, td2], [tD2, tc1], [tD2, td2]], 16d
[tD1, td2];colin, [[tC1, tc1], [tC1, td2], [tD1, tc1], [tD1, td2], [tD2, tc1], [tD2, td2]], 16d
No
?-
*************************************************/
%---------------------------------------------------%
% A1. some additional programs for events
%---------------------------------------------------%
% Hexa reprsentation for events
%---------------------------------------------------%
hexa_event(E,X,Hx):-
event(E,X,_NE), % NE: length of E \= NX
hexa_list(X,_NX,GangOfFour),
concat_list(Hx,GangOfFour).
% complementation
%---------------------------------------------------%
complement(E,N,C):-
all_states(O),
event(E,X,N),
c_list_projection(X,O,C).
% super/sub events
%---------------------------------------------------%
super_event(E,F,N):-
super_event_with_length((E,N),(F,_M)).
super_event_with_length((X,N),(Y,M)):-
(var(X)->fail;true),
event(Y,M),
subset(Y,X),
length(X,N).
super_event_with_length((E,N),(F,L)):-
(var(E)->true;fail),
integer(N),
event(F,XF,L),
%nl,write([N,L:F]),
!,
L =< N,
super_projection_of_length((XE,N),(XF,L)),
% sup_projection(XE,XF),
event(E,XE,N),
subset(F,E).
super_event_with_length((E,N),(P,L)):-
(var(E)->true;fail),
var(N),
event(P,XP,L),
reverse(XP,RXP),
sup_projection(RXE,RXP),
reverse(RXE,XE),
event(E,XE,N).
super_projection_of_length((XE,N),(XF,L)):-
integer(N),
sum(XF,L),
length(XF,U),
length(XE,U),
K is N - L, % K: additional units required.
M is U - L, % M: the current number of zeros.
choose_N_units_among(M,K,Xadd),
findall(I,nth1(I,XF,0),Xzeros),
make_pairs(Xsubst,Xzeros,Xadd),
findall(Z,
(
nth1(I,XF,X),
(member((I-Y),Xsubst)->
Z is X + Y;Z = X)
),
XE).
%---------------------------------------------------%
% A2. common programs
%---------------------------------------------------%
% cited from: math1, set, menu, moji.
% cited from (reflected): math1.pl
%---------------------------------------------------%
inductive_numbers([]).
inductive_numbers([N|H]):-
length(H,N),
inductive_numbers(H).
sum([],0).
sum([X|Members],Sum):-
sum(Members,Sum1),
%number(X),
Sum is Sum1 + X.
product([],1).
product([X|Members],Z):-
product(Members,Z1),
%number(X),
Z is Z1 * X.
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.
% a solver
%---------------------------------------------------%
min(X,Goal):-
max(Z,(Goal,Z is -X)).
max(X,Goal):-
% X: the objective variable,
% Goal: the objective function and constraints,
setof((X,Goal),Goal,Z),
member((X,Goal),Z),
\+ (
member((Y,_),Z),
Y > X
).
% an aggregator
%---------------------------------------------------%
sumof(X,Goal,S):-
findall(X,Goal,Z),
sum(Z,S).
% concat list
%---------------------------------------------------%
% cited from (reflected): moji.pl
concat_list(A,[A]).
concat_list(Z,[L|R]):-
concat_list(Q,R),
concat(L,Q,Z).
% hexa and bits (intended for abbreviation of event)
%---------------------------------------------------%
% 5-6 Feb 2005.
hexa_list(X,N,[Tx|Hx]):-
\+ var(X),
length(X,N),
R is N mod 4,
hexa_list_residual(R,X,Y,Tx),
hexa_list_0(Y,Hx).
hexa_list_0([],[]).
hexa_list_0([A,B,C,D|X],[Hx|Y]):-
hexa_list_0(X,Y),
hexa_1([A,B,C,D],Hx).
hexa_list_residual(0,[A,B,C,D|X],X,Hx):-
hexa_1([A,B,C,D],Hx).
hexa_list_residual(3,[A,B,C|X],X,Hx):-
hexa_1([0,A,B,C],Hx).
hexa_list_residual(2,[A,B|X],X,Hx):-
hexa_1([0,0,A,B],Hx).
hexa_list_residual(1,[A|X],X,Hx):-
hexa_1([0,0,0,A],Hx).
hexa_1(FourBits,Hx):-
list_projection(FourBits,[a,b,c,d],_),
bits(FourBits,Decimal,_B),
hexa_pattern(Hx,Decimal).
hexa_pattern(Hx,Hx):-
Hx <10,
!.
hexa_pattern(Hx,D):-
member((D,Hx),[
(10,a),(11,b),(12,c),(13,d),(14,e),(15,f)
]).
hexa(L,Decimal,Hx):-
concat_list(Hx,[0,x|L]),
atom_chars(Hx,Atoms),
number_chars(Decimal,Atoms).
bits(L,Decimal,B):-
concat_list(B,[0,b|L]),
atom_chars(B,Atoms),
number_chars(Decimal,Atoms).
% intersection of list
%---------------------------------------------------%
% cited from (reflected): set.pl
asymmetric_differences(A,B,D):-
subtract(A,B,D1),
subtract(B,A,D2),
D=(D1,D2).
intersection_of_lists([],_).
intersection_of_lists([X|H],Z):-
intersection_of_lists(H,Y),
intersection(X,Y,Z).
%---------------------------------------------------%
make_pairs([],[],[]).
make_pairs([A-X|Z],[A|B],[X|Y]):-
length(B,N),
length(Y,N),
length(Z,N),
make_pairs(Z,B,Y).
% super set projection
%---------------------------------------------------%
% 1 Feb 2005.
sup_projection([],[]).
sup_projection([W|Z],[X|Y]):-
member((X,W),[(1,1),(0,0),(0,1)]),
sup_projection(Z,Y).
% combinatiton : index function with cardinality
%---------------------------------------------------%
choose_N_units_among(U,N,P):-
integer(U),
\+ var(P),
is_a_bounded_bit_sequence_of_length(P,U),
!,
sum(P,N),
N==N)
->!,true
; (
inductive_numbers([U|M]),
member(N,[U|M])
)),
length(P,U),
choose_N_units_0(P,N,_L).
% validation of bit sequence
is_a_bounded_bit_sequence_of_length(P,L):-
length(P,L),
forall(member(X,P),
(
\+ var(X),
member(X,[0,1])
)
).
% generation of bit sequence
choose_N_units_0([],0,0).
choose_N_units_0(Z,0,0):-
length(Z,R),
zeros(Z,R).
choose_N_units_0(Z,M,L):-
length(Z,R),
M>=R,
ones(Z,R),
L is M -R.
choose_N_units_0([X|Y],M,L1):-
length([X|Y],R),
M >0,
M U=0;integer(U)),
inductive_numbers([U|M]),
!,
reverse([U|M],[0|R]),
list_projection(P,R,W).
% priority-considered version of bag0
%---------------------------------------------------%
variation_seek_sequence([],_A,0).
variation_seek_sequence([C|B],A,N):-
length([C|B],N),
member(C,A),
subtract(A,[C],D),
append(D,[C],E),
variation_seek_sequence(B,E,_N1).
:- dynamic temp_vss/1.
update_temp_vss(C):-
retract(temp_vss(H)),
assert(temp_vss([C|H])).
% cited from set.pl (previously)
%---------------------------------------------------%
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).
subset_of(A,N,As):-
length(As,L),
length(D,L),
list_projection(D,As,B),
length(B,N),
sort(B,A).
list_projection([],[],[]).
list_projection([X|Y],[_A|B],C):-
X = 0,
list_projection(Y,B,C).
list_projection([X|Y],[A|B],[A|C]):-
X = 1,
list_projection(Y,B,C).
c_list_projection([],[],[]).
c_list_projection([X|Y],[_A|B],C):-
X = 1,
c_list_projection(Y,B,C).
c_list_projection([X|Y],[A|B],[A|C]):-
X = 0,
c_list_projection(Y,B,C).
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),
K is A - B1 + 1,
length(L,K),
nth0(X,L,X),
B is B1 + X.
% Utilities for file output and display
%---------------------------------------------------%
% cited from : menu.pl
forall_write(A):- forall(member(X,A),(nl,write(X))).
forall_write_goals(A,B):- B,nl,write(A),fail.
forall_write_goals(_,_):- nl,write(complete).
% display all successful goals (with the count).
display_goals(G):-
(\+ var(G)->true;G=empty),
forall(G,(nl,write(G))).
display_goals(_).
display_goals(G,C):-
(\+ var(G)->true;G=empty),
(\+ var(C)->true;C=true),
forall((G,C),(nl,write(G))).
display_goals(_,_).
display_goals(G,C,N):-
(\+ var(G)->true;G=empty),
(\+ var(C)->true;C=true),
findall(G,(G,C),L),
length(L,N),
display_goals(G,member(G,L)),
nl,
write('the number of goals='),
write(N).
% Equivalence
%--------------------------------
verify_equality_of_goals(G1:V1,G2:V2,S,D):-
findall(V1,G1,S1),
findall(V2,G2,S2),
subtract(S1,S2,D1),
subtract(S2,S1,D2),
S=[S1,S2],D=[D1,D2].
% a script for generating goals as facts
%---------------------------------------------------%
:- dynamic id_of_temp_goal/1.
:- dynamic temp_goal/3.
update_id_of_temp_goal(ID):-
retract(id_of_temp_goal(ID_0)),
ID is ID_0 +1,
assert(id_of_temp_goal(ID)).
preliminary_to_factualize_goals:-
abolish(id_of_temp_goal/1),
abolish(temp_goal/3),
assert(id_of_temp_goal(0)).
factualize_goals(G):-
warn_if_not_a_list(G),
preliminary_to_factualize_goals,
factualize_goals(G,LID),
finalize_factualization(LID).
factualize_goals([Goal|Constraint],ID):-
Goal,
Constraint,
update_id_of_temp_goal(ID),
assert(temp_goal(ID,Goal,Constraint)),
fail.
factualize_goals(_,ID):-
id_of_temp_goal(ID).
finalize_factualization(Last_ID):-
write(complete),
nl,
write(total:Last_ID),
write(' successful goals have asserted as temp_goal/3.').
warn_if_not_a_list(G):-
length(G,_),
forall(member(X,G),clause(X,_)),
!.
warn_if_not_a_list(_):-
write('**** warning : not a list of executable goals.'),
nl,
write('no data has generated.'),
fail.
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).
% save all successful goals to file.
%--------------------------------
tell_goal(File,forall,G):-
G0 = (nl,write(G),write('.')),
G1 = forall(G,G0),
tell_goal(File,G1).
% the conditionalized version
% Aug 2003.
tell_goal(File,forall_such_that,G,Condition):-
% G should be occurred in the Condition.
WRITE = (nl,write(G),write('.')),
G1 = forall(Condition,WRITE),
tell_goal(File,G1).
% time stamp
%--------------------------------
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.
% measuring time consumption
%--------------------------------
stopwatch_0(Goal,TD):-
get_time(TS),
Goal,
get_time(TF),
TD is TF - TS.
stopwatch(Goal,TD):-
stopwatch_0(Goal,TD),
nl,
write('% time elapsed (sec): '),
write(TD),
nl.
:- initialize_program.
% end of program
%---------------------------------------------------%
return to front page.