headline:- write('% -------------------------------------------------------- %'),nl, write('% network mechanism design theory simulated by Prolog %'),nl, write('% -------------------------------------------------------- %'),nl, h0. h0:- write('% mechanism / 2: model data using list. '),nl, write('% responsibility / 2: responsible outcomes for agent. '),nl, write('% ihears / 3: part_of_message_that_i_hears. '),nl, write('% concerning_agents / 2: agents each of who has concern about it. '),nl, write('% concern / 2: individual concern (variables occurr in valuation). '),nl, write('% --------complexity measures and evaluations of network-------'),nl, write('% iefforts / 3: individual_effort_vector. '),nl, write('% total_effort / 3: total pipelines in the network. '),nl, write('% dimensionally_minimal / 3: minimal mechanism in the class. '),nl, write('% undominated / 3: undominated mechanism in the class. '),nl, write('% efficient_iefforts / 3: individual_effort_vector. '),nl, write('% diagnosis / 1: batch of above measures for a mechanism. '),nl, write('% --------price mechanism with coordinators-------'),nl, write('% design_price_mechanism /0: designing price mechanism(step1-5). '),nl, write('% [step 1] set_coordinators / 2, '),nl, write('% [step 2] set_price_mechanism / 1, '),nl, write('% [step 3] restore_mechanism / 2, '),nl, write('% [step 4] tell_mechanisms / 0, '),nl, write('% [step 5] diagnosis / 1, '),nl, write('% h0. this.'),nl. me:- write('% file: network0.pl'),nl, write('% created: 30 Jun, 2 July 2003.'),nl, write('% modified: 4-6 Mar 2003.'),nl, write('% cited: dpfirm0.pl(20 Mar 2003) '),nl, write('% author: Kenryo INDO (Kanto Gakuen University) '),nl, write('% url: http://www.us.kanto-gakuen.ac.jp/indo/front.html'), nl. references:- write('% [1] Marschak, T. and S. Rechelstein (1995). '),nl, write('% Communication requirements for individual agents in networks'),nl, write('% and hierarchies. In J. Ledyard(ed.), The Economics of Informational'),nl, write('% Decentralization: Complexity, Efficiency, and Stability.'),nl, write('% Kluwer Academic Press. pp.311-346.'),nl, write('% [2] Marschak, T. and S. Rechelstein (1998). '),nl, write('% Network mechanisms, informational efficiency, and hierarchies. '),nl, write('% Journal of Eonomic Theory 79: 106-141.'),nl, nl. line0('-------------------------------------------------------------'). wl:- line0(L),write(L). :- headline. :- dynamic processor0 /4. :- dynamic temp_tree /4. :- dynamic mechanism /2. :- dynamic coordinators /3. :- dynamic end_of_model/0. :- dynamic agents /1. :- dynamic outputs /1. :- dynamic valuations /1. :- dynamic agent /1. :- dynamic output /3. :- dynamic valuation /3. :- dynamic messages/1. :- dynamic hear /3. :- dynamic agreement_rule/3. %----------------------------------------------------- % the individual agent and the network %----------------------------------------------------- agents(N):-findall(I,agent(I),N). model_preds(environment,[ agent/1, output/3, valuation/3, agents/1, outputs/1, valuations/1 ]). model_preds(mechanism,[ %messages/1, hear/3, agreement_rule/3 ]). % setup the model %------------------------------------------------ set_model(G0):- member(H,[environment,mechanism]), G0=..[H,C], G=..[H,C,X], G, ( model_preds(H,P), forall(member(W,P),abolish(W)) ), forall(member(Y,X),assert(Y)). % network mechanisms %------------------------------------------------ environment(e1,[ %agents agents([1,2,3,4]), agent(1), agent(2), agent(3), agent(4), %output variables outputs([Q1,Q2,I]), %action and its responsibile agent output(1,Q1,agent(1)), output(2,Q2,agent(2)), output(3,I,agent(3)), %local_environments valuations([E1,E2,E3,E4]), valuation(agent(1),cost(E1),[(1,Q1)]), valuation(agent(2),cost(E2),[(2,Q2),(3,I)]), valuation(agent(3),cost(E3),[(3,I)]), valuation(agent(4),revenue(E4),[(1,Q1),(2,Q2)]), end_of_model ]). :- set_model(environment(e1)). mechanism(m1,[ %message space for network communication hear(from:agent(4),to:agent(1),price_of(U1,output(1))), hear(from:agent(1),to:agent(4),quantity_of(Q1,output(1))), hear(from:agent(4),to:agent(2),price_of(U2,output(2))), hear(from:agent(2),to:agent(4),quantity_of(Q2,output(2))), hear(from:agent(3),to:agent(2),quantity_of(I,output(3))), hear(from:agent(2),to:agent(3),price_of(V,output(3))), %agreement rules agreement_rule(agent(1),local(cost(E1)),max(arg([Q1]),U1*Q1-E1)), agreement_rule(agent(2),local(cost(E2)),max(arg([Q2,I]),U2*Q2-E2-V*I)), agreement_rule(agent(3),local(cost(E3)),max(arg([I]),V*I-E3)), agreement_rule(agent(4),local(revenue(E4)),max(arg([Q1,Q2]),E4-U1*Q1-U2*Q2)), end_of_model ]). mechanism(m2,[ %message space for network communication hear(from:agent(4),to:agent(1),price_of(U1,output(1))), hear(from:agent(1),to:agent(4),quantity_of(Q1,output(1))), hear(from:agent(4),to:agent(2),price_of(U2,output(2))), hear(from:agent(2),to:agent(4),quantity_of(Q2,output(2))), hear(from:agent(3),to:agent(2),quantity_of(I2,output(3))), hear(from:agent(2),to:agent(3),price_of(V2,output(3))), hear(from:agent(3),to:agent(1),quantity_of(I1,output(3))), hear(from:agent(1),to:agent(3),price_of(V1,output(3))), %agreement rules agreement_rule(agent(1),local(cost(E1)),max(arg([Q1,I1]),U1*Q1-E1-V1*I)), agreement_rule(agent(2),local(cost(E2)),max(arg([Q2,I2]),U2*Q2-E2-V2*I)), agreement_rule(agent(3),local(cost(E3)),max(arg([I1,I2]),(V1+V2)*(I1+I2)-E3)), agreement_rule(agent(4),local(revenue(E4)),max(arg([Q1,Q2]),E4-U1*Q1-U2*Q2)), end_of_model ]). % dummy of a price mechanism. mechanism(pm(0),dummy). % individual message space %------------------------------------------------ output_message_for_i(M,agent(I),OUT):- mechanism(M,X), agent(I), A=hear(from:agent(I),_,_), findall(A, ( member(A,X) ), OUT). input_message_for_i(M,agent(I),IN):- mechanism(M,X), agent(I), A=hear(_,to:agent(I),_), findall(A, ( member(A,X) ), IN). % Pi(M): hear or send by the agent i %------------------------------------------------ ihears(M,I,PM):- part_of_message_that_i_hears(M,I,PM). part_of_message_that_i_hears(M,I,PM):- output_message_for_i(M,I,P1), mechanism(M,X), Q=hear(from:J,to:I,_), findall(Q, ( member(Q,X), J\=I ), P2), union(P1,P2,PM). % no self-addressed messages %------------------------------------------------ star_messages(M,MX):- mechanism(M,X), O=hear(from:J,to:I,_), findall(O, ( member(O,X), J \= I ), MX). %------------------------------------------------ % dimensional complexities of message space %------------------------------------------------ dimension(M,ihears(I,PM),D):- ihears(M,I,PM), length(PM,D). dimension(M,(from:J,to:I,Msg),D):- mechanism(M,X), O=hear(from:J,to:I,Msg), member(O,X), length(Msg,D). dimension(M,star(MX),D):- star_messages(M,MX), O=hear(from:_J,to:_I,MSG), findall(MSG,member(O,MX),MY), flatten(MY,MZ), length(MZ,D). dimension(M,ihears(I,star(PM)),D):- ihears(M,I,PM), star_messages(M,MX), intersection(PM,MX,PMX), length(PMX,D). %total effort %------------------------------------------------ total_effort(M,star(MX),D):- dimension(M,star(MX),D). %individual effort vector (iefforts) %------------------------------------------------ iefforts(M,Is,DV):- individual_effort_vector(M,Is,DV). individual_effort_vector(M,Is,DV):- mechanism(M,_X), findall(agent(I),agent(I),Is), findall(D, ( member(agent(I),Is), dimension(M,ihears(agent(I),star(_PM)),D) ), DV). %------------------------------------------------ % evaluation measures for network mechanisms: % minimality, dominance, and efficiency %------------------------------------------------ % minimality of mechanisms %------------------------------------------------ dimensionally_minimal(M,Class,dim(star(D))):- var(Class), findall(M1,mechanism(M1,_),C0), subtract(C0,[pm(0)],Class), %total_effort(M,star(MX),D), dimension(M,star(_MX),D), M \= pm(0), \+ ( member(M1,Class), dimension(M1,star(_MX1),D1), D1 < D ). dimensionally_minimal(M,Class,dim(star(D))):- \+ var(Class), forall(member(A,Class),clause(mechanism(A,_),true)), %total_effort(M,star(MX),D), dimension(M,star(_MX),D), member(M,Class), \+ ( member(M1,Class), dimension(M1,star(_MX1),D1), D1 < D ). % dominance %------------------------------------------------ undominated(M,Class,Dx):- var(Class), findall(M1,mechanism(M1,_),C0), subtract(C0,[pm(0)],Class), iefforts(M,_Is,Dx), M \= pm(0), Case1=( dimension(M,ihears(agent(I),star(PM)),D), dimension(M1,ihears(agent(I),star(PM1)),D1), D1 > D ), Case2=forall(agent(I), ( dimension(M,ihears(agent(I),star(PM)),D), dimension(M1,ihears(agent(I),star(PM1)),D1), D1 = D ) ), forall( ( member(M1,Class), M1 \= M ), ( Case1;Case2 ) ). undominated(M,Class,Dx):- \+ var(Class), length(Class,_), forall(member(A,Class),clause(mechanism(A,_),true)), iefforts(M,_Is,Dx), member(M,Class), Case1=( dimension(M,ihears(agent(I),star(PM)),D), dimension(M1,ihears(agent(I),star(PM1)),D1), D1 > D ), Case2=forall(agent(I), ( dimension(M,ihears(agent(I),star(PM)),D), dimension(M1,ihears(agent(I),star(PM1)),D1), D1 = D ) ), forall( ( member(M1,Class), mechanism(M1,_), M1 \= M ), ( Case1;Case2 ) ). %efficiency %------------------------------------------------ efficient_iefforts(M,Is,DV):- undominated(M,_Class,_D), iefforts(M,Is,DV). %------------------------------------------------ % some claims about minimality and efficiency %------------------------------------------------ %claim: minimality implies both dominance and efficiency %------------------------------------------------ claim(no(1),2*total_effort(D)=sum_of_iefforts(D1),Z):- total_effort(M,star(_MX),D), iefforts(M,_Is,DV), sum(DV,D1), D0 is 2* D, (D0 is D1->Z=true;Z=false). claim(no(2),dimensionally_minimal(D)->efficient_iefforts(DV),Z):- dimensionally_minimal(M,_Class,D), (efficient_iefforts(M,_Is,DV)->Z=true;Z=false). %responsibility(i.e., output function) % activities for which the agent is responsible %------------------------------------------------ is_responsible_for(agent(I),output(K,B)):- agent(I), output(K,B,agent(I)). responsibility(agent(I),OUT):- agent(I), findall(output(K,B), ( output(K,B,agent(I)) ), OUT). % concern %------------------------------------------------ has_concern_with(agent(I),output(K,B,J)):- valuation(agent(I),_V,Con), output(K,B,J), member((K,B),Con). concern(agent(I),Y):- valuation(agent(I),_V,Con), findall((K,B,J), ( member((K,B),Con), output(K,B,J) ), Y0), sort(Y0,Y). concerning_agents(X,Js):- X=output(K,B,agent(_I)), X, findall((J), ( valuation(agent(J),_V,Con), member((K,B),Con) ), Js0), sort(Js0,Js). %------------------------------------------------ % Designing for Marschak and Reichelstein's % price mechanism with z(A)-coordinators % (Marschak and Reichelstein,1993, 1998) %------------------------------------------------ % added: 4 July 2003. % modified: 5,7 July 2003. plan(coordinator(agent(I),output(K),concerning_agents(Ta))):- %I: a candidate agent for the Z-coordinator, %Z=(K,A,J): outputs(acts), %T: concerning agents, %U: transfer prices, has_concern_with(agent(I),output(K,A,J)), concerning_agents(output(K,A,J),Ta). %shadow_prices(I,T,U), %proposed_quantities(I,T,Q). plan(coordinators([],[],O)):- findall(output(K), ( output(K,_A,_J) ), O),!. plan(coordinators([J|K],[C|P],R)):- plan(coordinators(K,P,[X|R])), C=coordinator(agent(J),X,concerning_agents(_Ta)), X=..[output|_], plan(C). plan(coordinators([J|K],[C|P])):- plan(coordinators([J|K],[C|P],[])). coordinator(M,J,C):- coordinators(M,_X,Y), C=coordinator(agent(J),_O,_T), member(C,Y). % a meta model: price mechanism with z(a)-coordinator %------------------------------------------------ metamodel(mechanism(pm(N),[ %------------message space for network communication ------------ ( hear(from:agent(J),to:agent(I),price_of(_U,X)):- coordinator(pm(N),J,C), C=coordinator(agent(J),X,concerning_agents(Ta)), member(I,Ta), I \= J ), ( hear(from:agent(I),to:agent(J),quantity_of(_Q,X)):- coordinator(pm(N),J,C), C=coordinator(agent(J),X,concerning_agents(Ta)), member(I,Ta), I \= J ), %------------agreement rules------------ ( agreement_rule(agent(J),local(VAL),max(arg(ARG),Z+sum(R)-sum(C))):- agent(J), valuation(agent(J),VAL,_Concerns), member((VAL,Z),[(cost(E),-VAL),(revenue(E),VAL)]), findall(A, ( hear(from:agent(J),to:agent(I),A) ), ARG), findall((p(U)*q(Q),to(I),X), ( hear(from:agent(J),to:agent(I),quantity_of(Q,X)), hear(from:agent(I),to:agent(J),price_of(U,X)) ), C), findall((p(U)*q(Q),to(I),X), ( hear(from:agent(I),to:agent(J),quantity_of(Q,X)), hear(from:agent(J),to:agent(I),price_of(U,X)) ), R) ), end_of_model ])). % setup and restore price mechanism from metamodel %------------------------------------------------ % added: 6 July 2003. % modified: 7 July 2003. set_coordinators(M,CJ,PLAN):- plan(coordinators(CJ,PLAN)), % init by backtrack retractall(coordinators(M,_,_)), assert(coordinators(M,CJ,PLAN)). set_price_mechanism(M,X):- ( % initialize mechanism db model_preds(mechanism,P), forall(member(W,P),abolish(W)) ), ( % set the price mechanism metamodel(mechanism(M,X)), forall(member(Y,X),assert(Y)) ). restore_mechanism(pm(N),PM):- ( % construct the mechanism db findall(W, ( exec_model_pred(W) ), PM) ), assert(mechanism(pm(N),PM)). exec_model_pred(W):- model_preds(mechanism,P), member(W0,P), W0=..[/,F,Arity], length(B,Arity), W=..[F|B], W. check_latest_no_of_pm(current:N0,next:N):- max(N0,PM0^mechanism(pm(N0),PM0)), N is N0 + 1. %------------------------------------------------ % automated process (with user-interaction) to % designing price mechanisms and report %------------------------------------------------ create_price_mechanism:- check_latest_no_of_pm(_,next:N), M=pm(N), set_coordinators(M,C1,C2), users_decision([M,C1,C2],1), set_price_mechanism(M,_X), restore_mechanism(M,PMX), diagnosis(M), tell_mechanisms([diagnosis,coordinators]), users_decision([M,PMX],2), nl, write('The above price mechanism has added to the database successfully.'). create_all_price_mechanisms:- forall(plan(coordinators(C1,C2)), ( check_latest_no_of_pm(_,next:N), set_coordinators(pm(N),C1,C2), set_price_mechanism(pm(N),_X), restore_mechanism(pm(N),_PMX) ) ), tell_mechanisms([diagnosis,coordinators]), nl, write('The all price mechanism has added to the database successfully.'). users_decision([M,C1,C2],1):- nl, write(coordinators(M):C1), forall(member(A,C2),ppf(A)), nl, write('Will you agree to use the above tuple of coordinators?(y/n)'), read(y). users_decision([A,B],2):- nl, write('Print the new mechanism in detail?(y/n)'), ( read(y) -> show_new_pm(A,B) ; true ). show_new_pm(pm(N),PM):- nl, mechanism(pm(N),PM),N > 0, write(mechanism:pm(N)), forall(member(A,PM),ppf(A)). diagnosis(M):- mechanism(M,_), nl, write('diagnosis for the mechanism:'), nl, write(' mechanism ='), write(M), nl, total_effort(M,_PM,TE), write(' the total effort ='), write(TE), nl, iefforts(M,_Agents,IE), write(' the individual efforts ='), write(IE), nl, ( dimensionally_minimal(M,_,_) -> ( write(' the mechanism is dimensionally minimal. '),nl) ; ( write(' the mechanism is NOT dimensionally minimal. '),nl) ), ( efficient_iefforts(M,_,_) -> ( write(' the mechanism is efficient. '),nl) ; ( write(' the mechanism is NOT efficient. '),nl) ). tell_mechanisms:- tell_mechanisms([]). tell_mechanisms(UserOption):- G=mechanism(A,X), File='mout.txt', tell_goal(File, forall( G, pp_mechanism(A,X,UserOption) ) ), nl, write('report of the mechanisms has written in the file "'), write(File), write('" at the current directory.'). pp_mechanism(A,X,UserOption):- ppl([mechanism:A|X]), if( ( member(coordinators,UserOption), coordinators(A,C1,C2) ), ppl([coordinators(mechanism(A)):C1|C2]), _ ), nl, if( member(diagnosis,UserOption), diagnosis(A), _ ), nl. if(G,A,true):- G, A. if(G,_,false):- \+ G. %----------------------------------------- % utilities %----------------------------------------- % pretty print of the arities for functor and successful goal. %----------------------------------------- %modified: 7 July 2003 (cited from: network0.pl) ppf(Functor):- Functor=..[G|X], nl, write(functor:G), forall(member(Z,X), ( nl, tab(2), write(Z) ) ). ppg(Goal):- Goal=..[G|X], Goal, nl, write(goal:G), forall(member(Z,X),(nl,tab(2),write(Z))). ppl([Head|List]):- nl, write(Head), forall(member(Z,List),(nl,tab(2),write(Z))). % a solver : maximization of goal wrt arguments. %----------------------------------------- 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 ). % addition. %----------------------------------------- sum([],0). sum([X|Y],Z):-sum(Y,Z1),Z is Z1 + X. % a sequence of binary choice for a list: %-------------------------------------------------- list_projection([],[],[]). list_projection([X|Y],[_|B],C):- list_projection(Y,B,C), X = 0. list_projection([X|Y],[A|B],[A|C]):- list_projection(Y,B,C), X = 1. % complementary list projection %-------------------------------------------------- c_list_projection([],[],[]). c_list_projection([X|Y],[_|B],C):- c_list_projection(Y,B,C), X = 1. c_list_projection([X|Y],[A|B],[A|C]):- c_list_projection(Y,B,C), X = 0. % subset_of/3 : subset-enumeration % ----------------------------------------------------------- % subset_of(A,N,As):- length(As,L), length(D,L), list_projection(D,As,B), length(B,N), sort(B,A). % complement and symmetric complement % ----------------------------------------------------------- % complement(AC,A,As):- subset_of(A,_N,As), subtract(As,A,AC). complement_1(AC,A,As):- list_projection(P,As,A), c_list_projection(P,As,AC). symmetric_complement(AC,A,As):- list_projection(P,As,A), c_list_projection(P,As,AC), list_projection(P1,As,AC), P @< P1. % saving goals to file %-------------------------------- tell_goal(File,G):- (current_stream(File,write,S0)->close(S0);true), open(File,write,S), tell(File), nl, tstamp('% file output start time ',_), nl, write('%---------- start from here ------------%'), nl, G, nl, write('%---------- end of data ------------%'), nl, tstamp('% file output end time ',_), tell(user), close(S), % The following is to cope with the duplicated stream problem. (current_stream(File,write,S1)->close(S1);true). tell_goal(File,forall,G):- G0 = (nl,write(G),write('.')), G1 = forall(G,G0), tell_goal(File,G1). % 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. % end.