You selected jasmin02.pl
/*
Jasmin 2002, 17 November in Kanazawa.
Prologでナッシュ遂行理論を学ぶ
Learning Nash Implementation Theory on Prolog
---報告論文中のソースプログラム-----
犬 童 健 良
関東学園大学経済学部経営学科
*/
agents(Js):-setof(J,S^R^preference(J,S,R),Js).
states(Ss):-setof(S,J^R^preference(J,S,R),Ss).
alternatives([a,b]).
scc(f,state(1),[a]).
scc(f,state(2),[b]).
scc(f,state(3),[a]).
scc(f,state(4),[b]).
preference(agent(1),state(1),[a,b]).
preference(agent(1),state(2),[a,b]).
preference(agent(1),state(3),[b,a]).
preference(agent(1),state(4),[b,a]).
preference(agent(2),state(1),[a,b]).
preference(agent(2),state(2),[b,a]).
preference(agent(2),state(3),[a,b]).
preference(agent(2),state(4),[b,a]).
lcc([I,S,R],A,L) :-
preference(I,S,R),member(A,R),
append(_Upper, [A|Lower], R),sort([A|Lower],L).
is_maximal([I,S,R],A,X):-
lcc([I,S,R],A,Lcc),member(A,X),subset(X,Lcc).
is_prefer_to(I,S,X,Y):-
lcc([I,S,_R],X,L),
member(Y,L).
prefer_profile(S,Rks):-
bagof(Rk, I^preference(I,S,Rk), Rks).
monotone0(F):-
scc(F,_,_)->
forall(
(
scc(F,S,C),
scc(F,S1,C1),
subtract(C,C1,D),D\=[]
),
(
forall(member(A,D),
(
lcc([I,S,_R],A,L1),
lcc([I,S1,_R1],A,L2),
\+ subtract(L1,L2,[])
)
)
)
).
monotone(F):-
scc(F,_,_)->
forall(
( scc(F,S,C),
member(A,C),
scc(F,S1,C1),
\+ member(A,C1),wrv1(A,F,C,S,C1,S1)
),
( lcc([I,S,_R],A,L1),
lcc([I,S1,_R1],A,L2),
\+ subtract(L1,L2,[]),wrv2(I,L1,L2)
)
).
wrv1(A,F,C,S,C1,S1):-
write([A,is_in,F,[S,C],out,[S1,C1]]),nl.
wrv2(I,L1,L2):-tab(3),
write([reversal(I),lccs(L1,'->',L2)]),nl.
is_essential(A,X,[I,S,R],F):-
scc(F,S,C),member(A,C), lcc([I,S,R],A,Lcc), subset(Lcc,X).
ess(F,I,X,Ess):-
findall(A, is_essential(A,X,[I,_S,_R],F), Y), sort(Y,Ess).
veto_outcome(A,J,S,F):-
scc(F,S,C),
alternatives(As),
subtract(As,C,D),
member(A,D),
agents(Is),
preference(J,S,_R),
forall((member(K,Is),K\=J),
(lcc([K,S,_Rk],A,As)%,write([A,S,J,K]),nl
)
).
no_veto_power(F):-
agents(Is),
scc(F,_,_)
->
forall(member(J,Is),\+veto_outcome(_A,J,_S,F)).
nvp(F):-no_veto_power(F).
scc(gen(Cc),S,C):-
scc_tuples(Cc),
member([S,C],Cc).
scc_tuples(Cc):-
states(Ss), length(Ss,K),
scc_tuple(Cc,K,Ss).
scc_tuple([],0,[]).
scc_tuple([[S,X]|Cr],K,[S|Sc]):-
scc_tuple(Cr,K1,Sc),
K is K1 + 1,
states(Ss),reverse(Ss,Sr),nth1(K,Sr,S),
alternatives(As),
subset_of(X,As,_N1),
X \= [].
subset_of(A,As,N):-
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).
desc_nnseq([],N):-N<0,!.
desc_nnseq([0],1).
desc_nnseq([A|Q],N):-
A is N - 1,
length(Q,A),
desc_nnseq(Q,A).
asc_nnseq(Aseq,N):-desc_nnseq(Dseq,N),sort(Dseq,Aseq).
counter(N,M,L):-
length(L,_),
findall(M,member(M,L),Mx),
length(Mx,N).
attainables(C, I, [G, Msg], Czs):-
G=..[GF,_P,Scc],
G1=..[GF,_P1,Scc],
mechanism(G, Mz,[C]),
findall( Cz,
( mutate(GF, Scc,I,Msg,Mz),
mechanism(G1, Mz,[Cz])
),
Czs1),
sort(Czs1,Czs).
mutate(GF,Scc,J,Msg,Mz):-
agents(Is), nth1(Nj,Is,J), messages(GF, Scc,Msg), nth1(Nj,Msg,MJ),
messages(GF, Scc,Mz), nth1(Nj,Mz,MJz), MJz \= MJ, subtract(Is,[J],Isz),
forall(member(K,Isz),( nth1(Nk,Is,K), nth1(Nk,Msg,Mk), nth1(Nk,Mz,Mk) )).
best_response(I, S, C, Msg, [GF, P,Scc], [_P1s,Czs,Lcc],Br):-
agents(Is), member(I,Is), alternative(C),
messages(GF, Scc,Msg),
mechanism([GF, P, Scc], Msg,[C]),
attainables(C,I,[[GF, P, Scc],Msg], Czs),
lcc([I,S,_],C,Lcc), (subset(Czs,Lcc)-> Br = yes; Br = no).
nash_equilibrium(Is,_E,[GF,Scc,S,C,P,Msg]):-
forall( member(I,Is),
best_response(I, S, C, Msg, [GF,P, Scc], [_P1s,_Czs,_Lcc],yes)
).
/*
%sample programs in section 2
agents([agent1,agent2]).
states([s1,s2,s3,s4]).
alternatives([a,b]).
sccs([f,g]).
agent(I):-agents(Is),member(I,Is).
state(S):-states(Ss),member(S,Ss).
alternative(A):-alternatives(As),member(A,As).
scc(F):-sccs(Fs),member(F,Fs).
scc(g,State,[a]):-member(State,[s1,s2]).
scc(g,State,[b]):-member(State,[s3,s4]).
preference(Agent,State, [a,b]):-
member([Agent,State],[[1,s1],[1,s2],[2,s1],[2,s3]]).
preference(Agent,State, [b,a]):-
member([Agent,State],[[1,s3],[1,s4],[2,s2],[2,s4]]).
is_prefer_to(I,S,X,Y):-
preference(I,S,Order),nth1(J,Order,X),nth1(K,Order,Y),J =< K.
%sample programs in section 3
lcc([I,S,R],A,Lcc) :-
preference(I,S,R),append(_Succ, [A|_Slcc], Lcc).
is_maximal([I,S,R],A,X):-
lcc([I,S,R],A,Lcc),member(A,X),subset(X,Lcc).
attainables(C, I, Msg, [GF, P, Scc], Czs):-
findall( Cz,
( mutate(GF, Scc,I,Msg,Mz),
mechanism([GF,P1,Scc],Mz,[Cz]) ),
Czs1),
sort(Czs1,Czs).
% 注：setoff /3 だとsort済みだが空リスト用ルールが別に要る。
mutate(GF,Scc,J,Is,Msg,Mz):-
agents(Is),
nth1(Nj,Is,J),
messages(GF, Scc,Msg,Is), nth1(Nj,Msg,MJ),
messages(GF, Scc,Mz,Is), nth1(Nj,Mz,MJz),
MJz \= MJ, subtract(Is,[J],Isz),
forall(member(K,Isz),
( nth1(Nk,Is,K), nth1(Nk,Msg,Mk), nth1(Nk,Mz,Mk) )).
best_response(I, S, C, Msg, [Is, GF, Scc], [P1s,Czs,Lcc],Br):-
agents(Is), member(I,Is), alternative(C), messages(GF, Scc,Msg,Is),
mechanism([GF, P, Scc], Is,Msg,[C]), attainables(C,I,[Is,G,Msg], Czs),
lcc([I,S,_],C,Lcc), (subset(Czs,Lcc)-> Br = yes; Br = no).
nash_equilibrium(Is,E,[GF,Scc,S,C,P,Msg]):-
forall( member(I,Is),
best_response(I, S, C, Msg, [Is, GF, Scc], [P1s,Czs,Lcc],yes)).
%sample programs in section 4
%sample programs in section 5
is_a_dictator(J,F):-
agents(Is), member(J,Is), scc(F), alternatives(B),
forall((scc(F,S,C),member(A,C)),
lcc([J,S,_R],A,B)),
forall(lcc([J,S,_R],A,B),(scc(F,S,C),member(A,C))).
is_weak_parato_optimal(A,S):-
alternative(A), state(S),
forall(alternative(B),is_prefer_to(_J,S,A,B)).
%sample programs in section 6
monotone(F,Is):-scc(F),agents(Is),
forall(
(scc(F,S,C),member(A,C),scc(F,S1,C1),\+ member(A,C1)),
( member(I,Is),
lcc([I,S,_R],A,K1),
lcc([I,S1,_R1],A,K2),
\+ subtract(K1,K2,[])) ).
is_essential(A,X,[I,S,R],F):-
scc(F,S,C),member(A,C),
lcc([I,S,R],A,Lcc), subset(Lcc,X).
ess(F,I,X,Ess):- agent(I),scc(F),
findall(A, is_essential(A,X,[I,S,R],F), Y), sort(Y,Ess).
%sample programs in section 7
game_form(gMR2(1,_Scc), [J1,J2],Msg,[C]):-Msg = [(R,C,_,_,_),(R,C,_,_,_)],!.
game_form(gMR2(P,Scc), [J1,J2],Msg,[C]):- Msg=[MJ1,MJ2],
MJ1 = (R1,A1, B1,Z1,O1), MJ2 = (R2,A2, B2,Z2,O2),
[R1,A1] \= [R2,A2], member(P,[2,3,4,5,6]),
((O1=0,O2=0) -> P=2; (O1>0,O2=0) -> P=3; (O1=0,O2>0) -> P=4; true),
Sum is Z1 + Z2, Mod is Sum mod 2,
((O1>0,O2>0,Mod = 0) -> P=5; (O1>0,O2>0,Mod = 1) -> P=6; true),!,
R1 = [_R11,R12], prefer_profile([J1,J2],S1,R1),
R2 = [R21,_R22], prefer_profile([J1,J2],S2,R2),
(mre(MR,Scc,[[A2,A1],[J1,J2],[S2,S1],[R21,R12]],[Cx1,Cx2],no)
->true; MR=non),
(P=2 -> C = MR ; P=3 -> (member(B1,Cx1)-> C = B1; C=MR);
P=4 -> (member(B2,Cx2)-> C = B2; C=MR); P=5 -> C = B1 ;
P=6 -> C = B2 ; true).
prefer_profile(Is,S,Rks):-
true_prefer_profile(Is,S,Rks).
true_prefer_profile(Is,S,Rks):-
agents(Is),
state(S),
bagof(Rk,
I^(
member(I,Is),preference(I,S,Rk)
),
Rks).
mr_msg(Is,F,J,M):-
M=(R,A,B,_Z), agents(Is), member(J,Is),
state(S),
prefer_profile(Is,S,R),
scc(F,S,V), alternative(A),member(A,V), alternative(B).
mr2_msg([J1,J2],F,J,M2):-
mr_msg([J1,J2],F,J,M),
M=(R,A,B,Z),
M2=(R,A,B,Z,Obj), member(Obj,[0,1]).
mr2_profile([J1,J2],F,Prf):-
agents([J1,J2]), scc(F),
maplist(mr2_msg([J1,J2],F),[J1,J2],Prf).
messages(gMR2, F,M,[J1,J2]):-
scc(F), mr2_profile(Is,F,M).
mechanism(G, Is,Msg,Z):-
G =.. [GF,_P,Scc],
messages(GF, Scc,Msg,Is), game_form(G,E,Msg,Z),!.
*/
% end of source
return to front page.