You selected network0.pl
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.
return to front page.