You selected fixpo.pl
% finding an equilibrium point by contract map: fixed point algorithm
% 16 Oct 2002.
% modified: 20-22 Oct 2002.
% modified: 31 Oct, Nov 2 2002.
game([player(1,act(a1)),player(2,act(b1))],payoffs([2,1])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([0,0])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([0,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([1,2])).
/* a game with a pure strategy equilibrium.
game([player(1,act(a1)),player(2,act(b1))],payoffs([1,3])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([3,1])).
*/
/* a game with no pure strategy equilibrium.
game([player(1,act(a1)),player(2,act(b1))],payoffs([0,3])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([0,1])).
*/
/* a game with no pure strategy equilibrium.
game([player(1,act(a1)),player(2,act(b1))],payoffs([0,1])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([1,0])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([1,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([0,1])).
*/
/* a game with two pure strategy equilibria.
game([player(1,act(a1)),player(2,act(b1))],payoffs([1,5])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([0,4])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([0,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([1,1])).
*/
/* a game with no pure strategy equilibrium.
game([player(1,act(a1)),player(2,act(b1))],payoffs([1,1])).
game([player(1,act(a1)),player(2,act(b2))],payoffs([2,0])).
game([player(1,act(a2)),player(2,act(b1))],payoffs([2,0])).
game([player(1,act(a2)),player(2,act(b2))],payoffs([1,1])).
*/
game(mixed([X,Y]),exp_payoffs([E1,E2])):-
mixed(
[
player(1,prob(X,[1,2])),
player(2,prob(Y,[1,2]))
]
),
exp_payoff(1,E1,[X,Y]),
exp_payoff(2,E2,[X,Y]).
game(fixed([X,Y]),exp_payoffs([E1,E2])):-
fp([X,Y],_K),
exp_payoff(1,E1,[X,Y]),
exp_payoff(2,E2,[X,Y]).
nash([S1,S2],[P1,P2]):-
game(
[
player(1,act(S1)),
player(2,act(S2))
],
payoffs([P1,P2])
),
\+ (game(
[
player(1,act(_X)),
player(2,act(S2))
],
payoffs([Px,_])
),
Px > P1
),
\+ (game([player(1,act(S1)),player(2,act(_Y))],payoffs([_,Py])),Py > P2).
nash([X,Y],[E1,E2]):-
game(
mixed([X,Y]),
exp_payoffs([E1,E2])
),
\+ (game(
mixed([_X1,Y]),
exp_payoffs([Ex,_])
),
Ex > E1
),
\+ (game(
mixed([X,_Y1]),
exp_payoffs([_,Ey])
),
Ey > E2
).
nash([X,Y],[E1,E2]):-
game(
fixed([X,Y]),
exp_payoffs([E1,E2])
).
non_nash([S1,S2],[P1,P2],[SU1,SU2]):-
game([player(1,act(S1)),player(2,act(S2))],payoffs([P1,P2])),
findall(X1,
(game([player(1,act(X1)),player(2,act(S2))],payoffs([Px1,_])),Px1 > P1),
SU1),
findall(X2,
(game([player(1,act(S1)),player(2,act(X2))],payoffs([_,Px2])),Px2 > P2),
SU2).
mixed(
[
player(1,prob(X1,[1,2])),
player(2,prob(X2,[1,2]))
]
):-(
X1=[P11,P12],
length(X1,L1), % これは意味はないが、意味が分かるように書いた。
%member(Step,[2,contracted]),
prob([P11,P12],base(L1),steps(Step)),
X2=[P21,P22],
length(X2,L2),
%member(Step,[2,contracted]),
prob([P21,P22],base(L2),steps(Step)),
true
).
psteps(4).
precision(5).
% P2 is 1 - P1.
prob([P1,P2],base(2),steps(L)):-
psteps(L),
prob(P1,steps(L)),
precision(M),
Q1 is P1 * 10^M,
Q2 is 10^M - Q1,
P2 is Q2 / (10^M).
prob([P1,P2],base(2),nosteps):-
\+var(P1),
P1 < 1,
P1 > 0,
precision(M),
Q1 is P1 * 10^M,
Q2 is 10^M - Q1,
P2 is Q2 / (10^M).
prob(P,steps(L)):-
0 is 100 mod L,
L1 is L + 1,
anum_seq(X,L1),
member(Y,X),
A is 100 / L,
P is Y * A / 100.
exp_payoff(1,E,[X,Y]):-
%prob(X,base(2),_),
%prob(Y,base(2),_),
X=[P11,P12],
exp_payoff(1,E1,a1,[X,Y]),
exp_payoff(1,E2,a2,[X,Y]),
E is P11 * E1 + P12 * E2.
exp_payoff(2,E,[X,Y]):-
%prob(X,base(2),_),
%prob(Y,base(2),_),
Y=[P21,P22],
exp_payoff(2,E1,b1,[X,Y]),
exp_payoff(2,E2,b2,[X,Y]),
E is P21 * E1 + P22 * E2.
exp_payoff(1,E,S1,[_,[P21,P22]]):-
% mixed(
% [_,player(2,prob([P21,P22],[1,2]))]
% ),!,
game([player(1,act(S1)),player(2,act(b1))],payoffs([X1,_])),
game([player(1,act(S1)),player(2,act(b2))],payoffs([X2,_])),
E is P21 * X1 + P22 * X2.
exp_payoff(2,E,S2,[[P11,P12],_]):-
% mixed(
% [player(1,prob([P11,P12],[1,2])),_]
% ),!,
game([player(1,act(a1)),player(2,act(S2))],payoffs([_,Y1])),
game([player(1,act(a2)),player(2,act(S2))],payoffs([_,Y2])),
E is P11 * Y1 + P12 * Y2.
new_mixed([TX,TY],[X,Y],[G1,G2]):-
mixed(
[
player(1,prob(X,[1,2])),
player(2,prob(Y,[1,2]))
]
),
seri_con([TX,TY],[X,Y],_),
wn(
seri_con([TX,TY],[X,Y])
),
[TX,TY] \= [X,Y],
(
(
prob(TX,base(2),steps(_)) %<----note!
)
->true
; assert(prob(TX,base(2),steps(contracted)))
),
(
(
prob(TY,base(2),steps(_)) %<----note!
)
->true
; assert(prob(TY,base(2),steps(contracted)))
),
%write(assert_new_mix([TX,TY])),
exp_payoff(1,G1,[TX,TY]),
exp_payoff(2,G2,[TX,TY]).
%--------------------------------------------
% contract map by Nash
%--------------------------------------------
% 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]).
%
contract(c(1,C),[X,Y]):-
exp_payoff(1,E,[X,Y]),
exp_payoff(1,E1,[[1,0],Y]),
C0 is E1 - E,
(C0 > 0 -> C = C0; C =0).
contract(c(2,C),[X,Y]):-
exp_payoff(1,E,[X,Y]),
exp_payoff(1,E1,[[0,1],Y]),
C0 is E1 - E,
(C0 > 0 -> C = C0; C =0).
contract(d(1,D),[X,Y]):-
exp_payoff(2,E,[X,Y]),
exp_payoff(2,E1,[X,[1,0]]),
D0 is E1 - E,
(D0 > 0 -> D = D0; D =0).
contract(d(2,D),[X,Y]):-
exp_payoff(2,E,[X,Y]),
exp_payoff(2,E1,[X,[0,1]]),
D0 is E1 - E,
(D0 > 0 -> D = D0; D =0).
% contracted からこの処理を分離したことは重要。
contract([C1,C2],[D1,D2],[X,Y]):-
contract(c(1,C1),[X,Y]),%wn(C1),
contract(c(2,C2),[X,Y]),%wn(C2),
contract(d(1,D1),[X,Y]),%wn(D1),
contract(d(2,D2),[X,Y]),%wn(D2),
!.
contracted([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),
contract([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].
mix_p([A,B]):-mixed([player(1,prob(A,[1,2])),player(2,prob(B,[1,2]))]).
% a pair of the first coordinate probabilities, each vector of distribution
p2(X,Y):-%mix_p(X),
X=[[A,_A1],[B,_B1]],Y=[A,B].
p2(X):-p2(_,X).
print_seri:-
seri_con(B,A,_C,D),p2(B,PB),p2(A,PA),
write((tp(PB,'exp_gains_against_pure'(D)):-p(PA))),wn('.').
seri_con([X,Y],[X,Y],[[X1],[Y1]],[[0,0],[0,0]]):-
prob(X,base(2),_),
prob(Y,base(2),_),
p2([X,Y],[X1,Y1]). % X=[X1,_], Y=[Y1,_].
seri_con([TX,TY],[X,Y],H0):-
seri_con([TX,TY],[X,Y],H0,_E0).
seri_con([TX,TY],[X,Y],[[TX1|H1],[TY1|H2]]):-
seri_con([Z1,Z2],[X,Y],[H1,H2]),
contracted([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.
fp([TX,TY],K):-
fixed_point([TX,TY],K).
fixed_point([TX,TY],L):-
seri_con([Z1,Z2],_,[H1,_]),
contracted([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):-
exp_payoff(1,E1,[X,Y]),
exp_payoff(2,E2,[X,Y]),
exp_payoff(1,F1,[TX,TY]),
exp_payoff(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.
%%
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([player(1,act(A1)),player(2,act(B1))],payoffs([P1,P2])),
G
),
(
wn((act(A1,B1),payoffs(P1,P2))),
write('change the payoffs?'),read(U),
(
U=[_,_]
->
(retract(G),
G1=game([player(1,act(A1)),player(2,act(B1))],payoffs(U)),
assert(G1)
);true
)
)
),
games.
% 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).
wn(X):-write(X),nl.
% using tell/1 in order to change the standard 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).
% sum
% ----------------------------------------------------------- %
sum([],0).
sum([X|Members],Sum):-
sum(Members,Sum1),
number(X),
Sum is Sum1 + X.
% ゴールの重複度を調べる。
% ----------------------------------------------------------- %
sea_multiple(Goal,Cond,N,M):-
Clause=..Goal,
findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M).
return to front page.