/* 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