me( 'market with indivisibilities by prolog'
, 'with an introductory reading and references.'
, 'price01.pl (developed on SWI-prolog 5.0.9)'
, '2005.8.19-9.10;19-26,28;10.7 17:25 pm'
, 'By Kenryo INDO (Kanto Gakuen University)'
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% preface
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% CAUTION!! This system comes with absolutely no warranty.
% Theoretical misunderstanding or bugs of programming may remain.
% It is not intended that this code used for any practical or
% serious purposes, but for the individual study.
% Execuse me for my poor English.
% revision (2005.9.18-19.)
% 1. The title has changed appropriately to the contents.
% 2. Correction. solve_wep_1/2 (and f/3, k/4, k_N/3) to reflect d_star/3,
% the minimal demand correspondence.
% 3. Revision. preference analysis sections, models and tools.
% 4. Correction. utilities for job_matching_1 and job_matching_2 (u(k,[1]) and u(k,[3])).
% revision (2005.9.20-25.)
% 5. Extention. game analysis with utility or disutility of co-workers.
% revision (2005.9.26.)
% 6. Modification. pp/2 by adding warn_user_if_no_p_slant_2_clause/0.
% 7. Correct. Paragraph above. And a reference [21].
% revision (2005.10.7.)
% 8. Correct. the title of this section, some sentences below, and a reference [6].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% model base
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% For the setting models in this system the reader is
% referred to `model management tool' section below
% by text search with a word `(MMT).'
% Example. A unit demand case of job assignment market game in Leonard(1983).
model( assign_1, agents:[firm,worker_1,worker_2], items:[job_a,job_b],
'owner of unsold item': firm, % a dummy firm
endowments:[
e(firm,0,[job_a,job_b]),
e(worker_1,0,[]),
e(worker_2,0,[])
],
utilities:[
u(firm,_)=0,
u(worker_1,[job_a])=12,
u(worker_1,[job_b])=7,
u(worker_1,[job_a, job_b])=12,
u(worker_2,[job_a])=11,
u(worker_2,[job_b])=4,
u(worker_2,[job_a, job_b])=11]
).
% Note: If u(worker_1,[job_a, job_b])=12+e,e>0 or
% u(worker_2,[job_a, job_b])=11+f,f>0 then
% the minimal equilibrium price does not equal
% the incentive compatible payments for each purchased item.
% See also the game analysis section below.
% Example. A unit demand case of job assignment market game in Leonard(1983).
model( assign_2,
agents:[firm(a),firm(b),worker(1),worker(2)],
items:[job_a,job_b],
'owner of unsold item': firm(_), % a dummy firm
endowments:[
e(firm(a),0,[job_a]),
e(firm(b),0,[job_b]),
e(worker(1),0,[]),
e(worker(2),0,[])
],
utilities:[
u(firm(_),_)=0,
u(worker(1),[job_a])=12,
u(worker(1),[job_b])=7,
u(worker(1),[job_a, job_b])=12,
u(worker(2),[job_a])=11,
u(worker(2),[job_b])=4,
u(worker(2),[job_a, job_b])=11]
).
% Example. The parametric unit demand job assignment.
model( assign_0(X), agents:[firm,worker_1,worker_2], items:[job_a,job_b],
'owner of unsold item': firm, % a dummy firm
endowments:[
e(firm,0,[job_a,job_b]),
e(worker_1,0,[]),
e(worker_2,0,[])
],
utilities:[
u(firm,_)=0,
u(worker_1,[job_a])=U1,
u(worker_1,[job_b])=U2,
u(worker_1,[job_a, job_b])=U3,
u(worker_2,[job_a])=U4,
u(worker_2,[job_b])=U5,
u(worker_2,[job_a, job_b])=U6]
):-
X=[A,U1,U2,U3,U4,U5,U6],
positive_number(10,2,U1),
positive_number(10,2,U2),
positive_number(10,2,U3),
positive_number(10,2,U4),
positive_number(10,2,U5),
positive_number(10,2,U6),
(A == repeat ->true ; A= cut, !).
% Example. Gul and Stacchetti(2000).
model( auction_1, agents:[i,j,k], items:[a,b],
'owner of unsold item': i,
endowments:[e(i,0,[a,b]),e(j,0,[]),e(k,0,[])],
utilities:[
u(i,_)=0,
u(j,[a])=8,
u(j,[b])=9,
u(j,[a, b])=12,
u(k,[a])=6,
u(k,[b])=8,
u(k,[a, b])=14]
).
% k-replica economy with k(=#I+1=3) times copied for I and N.
model( auction_1_r3,
agents:[i,j(1),k(1),j(2),k(2),j(3),k(3)],
items:ITEMS,
'owner of unsold item': i,
endowments:[
e(i,0,[a(1),a(2),a(3),b(1),b(2),b(3)]),
e(j(1),0,[]),
e(k(1),0,[]),
e(j(2),0,[]),
e(k(2),0,[]),
e(j(3),0,[]),
e(k(3),0,[])
],
utilities:[ u(i,_)=0 | ReplicaUtilities ]
):-
ITEMS =[a(1),b(1),a(2),b(2),a(3),b(3)],
findall( u(J,B)=V,
(
subset_of(B,_,ITEMS),
member(R,[1,2,3]),
member(J,[j(R),k(R)]),
intersection(B,[a(_),b(_)],Br),
% Br \=[],
(Br=[]->V=0;true),
(J=j(R),Br=[a(_)]->V=8;true),
(J=j(R),Br=[b(_)]->V=9;true),
(J=j(R),Br=[a(_),b(_)]->V=12;true),
(J=k(R),Br=[a(_)]->V=6;true),
(J=k(R),Br=[b(_)]->V=8;true),
(J=k(R),Br=[a(_),b(_)]->V=14;true)
),
ReplicaUtilities ).
/*
?- intersection([b(1),a(1),a(2)],[a(_),b(_)],B).
B = [b(1), a(1)] ;
*/
% Example in the proof of theorem 6 of Gul and Stacchetti(2000).
model( auction_2(X,Y), agents:[0,1,2,3], items:[a,b,c,d],
'owner of unsold item': 0,
endowments:[e(0,0,[a,b,c,d]),e(1,0,[]),e(2,0,[]),e(3,0,[])],
utilities:Utilities
):-
UBOX=[
([],0,0,0),
([a],8,6,Y),
([b],8,6,0),
([c],8,X,6),
([d],8,0,6),
([a, b],9,12,Y),
([a, c],16,6,6),
([b, d],16,6,6),
([c, d],9,X,12)
],
member(X,[1,2,3]),
member(Y,[1,2,3]),
ITEMS =[a,b,c,d],
findall( u(J,B)=V,
(
subset_of(B,_,ITEMS),
member(J,[1,2,3]),
intersection(B,[a,b],BR1),
intersection(B,[c,d],BR2),
intersection(B,[a,c],BC1),
intersection(B,[b,d],BC2),
(J=1->member((BR1,V1,_,_),UBOX);true),
(J=2->member((BC1,_,V1,_),UBOX);true),
(J=3->member((BC1,_,_,V1),UBOX);true),
(J=1->member((BR2,V2,_,_),UBOX);true),
(J=2->member((BC2,_,V2,_),UBOX);true),
(J=3->member((BC2,_,_,V2),UBOX);true),
V is V1 +V2
),
Utilities ).
% Example in Bikichandani et al.(2002), Table 1.
model( auction_3, agents:[0,1,2,3], items:[a,b,c,d],
'owner of unsold item': 0,
endowments:[e(0,0,[a,b,c,d]),e(1,0,[]),e(2,0,[]),e(3,0,[])],
utilities:Utilities
):-
UBOX=[
([],[0,0,0]),
([a],[10,4,2]),
([b],[10,7,2]),
([c],[10,9,2]),
([d],[10,8,4])
],
ITEMS =[a,b,c,d],
findall( u(J,B)=V,
(
subset_of(B,_,ITEMS),
member(J,[1,2,3]),
intersection(B,[X,Y],BR1),
(BR1=[X]
-> (member(([X],U123),UBOX),
nth1(J,U123,V)
)
;true
),
(BR1=[_,_|_]
->
max(U,(
subset_of([X,Y],2,BR1),
member(([X],U123),UBOX),
nth1(J,U123,V1),
member(([Y],U123),UBOX),
nth1(J,U123,V2),
U is V1 + V2
))
;true
)
),
Utilities ).
% demo (preview)
/*
?- set_model(auction_3),coalition(S1),
agents_are_substitutes(_:S1,T,false,_:([B|_],[_|E])).
S1 = []
T = 23-0>=27
B = 23
E = [27, [4, 10, 9, 4]]
No
?-
*/
% a parameterized job matching problem:
% Kelso and Crawford(1982), also see Ma(1998).
% workers: 1,2,3
% firms: i(=dummy),j,k
model(job_matching_1([E,E1,E2]),
agents:[i,j,k],
items:[1,2,3],
'owner of unsold item': i,
endowments:[e(i,0,[1,2,3]),e(j,0,[]),e(k,0,[])],
utilities:[
u(i,_)=0,
u(j,[1])=4,
u(j,[2])=4,
u(j,[3])=4+E1,
u(j,[1,2])=7+E,
u(j,[1,3])=7,
u(j,[2,3])=7,
u(j,[1,2,3])=9,
u(k,[1])=4+E2,
u(k,[2])=4,
u(k,[3])=4,
u(k,[1,2])=7,
u(k,[1,3])=7,
u(k,[2,3])=7+E,
u(k,[1,2,3])=9]
):-
% perturbations of utilities.
P = 0.25,
change_precision(P),
nonnegative_number([0,3],P,E1),
nonnegative_number([0,3],P,E2),
nonnegative_number([0,1],P,E).
% another form of the job matching:
% Kelso and Crawford(1982), also see Ma(1998).
% workers: 1,2,3
% firms: i1,i2,i3(=dummies),j,k
model(job_matching_2([E,E1,E2]),
agents:[i1,i2,i3,j,k],
items:[1,2,3],
'owner of unsold item': i1, % also i2 and i3
endowments:[
e(i1,0,[1]),
e(i2,0,[2]),
e(i3,0,[3]),
e(j,0,[]),
e(k,0,[])],
utilities:[
u(i1,_)=0,
u(i2,_)=0,
u(i3,_)=0,
u(j,[1])=4,
u(j,[2])=4,
u(j,[3])=4+E1,
u(j,[1,2])=7+E,
u(j,[1,3])=7,
u(j,[2,3])=7,
u(j,[1,2,3])=9,
u(k,[1])=4+E2,
u(k,[2])=4,
u(k,[3])=4,
u(k,[1,2])=7,
u(k,[1,3])=7,
u(k,[2,3])=7+E,
u(k,[1,2,3])=9]
):-
% perturbations of utilities.
P = 0.25,
change_precision(P),
nonnegative_number([0,3],P,E1),
nonnegative_number([0,3],P,E2),
nonnegative_number([0,1],P,E).
% precision ==> MMT
nonnegative_number([L,_],_,L).
nonnegative_number([L,U],P,N):-
D is U -L,
positive_number(D,P,M),
N is L + M.
% about positive_number/3, see numerical tools
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% model of economy : money and exchange
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% x: allocation of items (agent-oriented)
% e: initially endowed
% Both above are collections of tuple, (agent, money, items), over agents.
% a: allocation of item (item-oriented)
% o: initial owner of item
% t: transfers of an item, t:e->x
% p: market price. pp: price vector.
% c: cost/value of payment under the price c(p,x)=
% u: utility function (see sections `model base' and `model management')
%%%%
:- dynamic e/3, x/3, p/2.
% a preset for auction_1
%-----------------------------------------
/*
e( i, 0, [a,b]).
e( j, 1000, []).
e( k, 1000, []).
x( i, 1300, []).
x( j, 400, [a]).
x( k, 300, [b]).
p( a, 600).
p( b, 700).
*/
% a preset for job_match_1
%-----------------------------------------
/*
e( i, 0, [1,2,3]).
e( j, 1000, []).
e( k, 1000, []).
x( i, 1700, []).
x( j, 100, [1]).
x( k, 200, [2,3]).
p( 1, 900).
p( 2, 300).
p( 3, 500).
*/
% a preset for auction_1_r3
%-----------------------------------------
/*
e( i, 0, [a(1),b(1),a(2),b(2),a(3),b(3)]).
e( j(R), 1000, []):- member(R,[1,2,3]).
e( k(R), 1000, []):- member(R,[1,2,3]).
x( i(R), 1300, []):- member(R,[1,2,3]).
x( j(R), 400, [a(R)]):- member(R,[1,2,3]).
x( k(R), 300, [b(R)]):- member(R,[1,2,3]).
p( a(R), 600):- member(R,[1,2,3]).
p( b(R), 700):- member(R,[1,2,3]).
*/
% profiles
%-----------------------------------------
% revised: 26 Sep 2005 (added warn_user_if_no_p_slant_2_clause/0)
pp(PP):-
warn_user_if_no_p_slant_2_clause,
set_of_all_items(O),pp0(O,PP).
pp0([],[]).
pp0([X|O],[(X->P)|Q]):- pp0(O,Q),p(X,P).
warn_user_if_no_p_slant_2_clause:-
clause( p(_,_),_),
!.
warn_user_if_no_p_slant_2_clause:-
\+ clause( p(_,_),_) ,
!,
nl,
write( ' I looked for some p/2s, but there was none asserted. '),
nl,
write( ' Would you let zero prices?. (y/n)>'),
read(U),
(U=y->set_0_prices; fail).
% revised: 20 Sep 2005
bundle( A):-
bundle( A,_,_).
bundle( A,Ia,L):-
set_of_all_items( O),
list_projection( Ia,O,A),
length( A, L).
% an earlier code (abolish)
% bundle(A):- var(A),set_of_all_items(O),subset_of(A,_,O).
% bundle(A):- \+ var(A),set_of_all_items(O),subset(A,O).
o(Item -> Owner):- e(Owner,_, E), member(Item, E).
a(Item -> Owner):- x(Owner,_, X), member(Item, X).
xx(XX):- findall((O->J),a(O->J),XX).
% free disposal (with u(O,A)=0 forall items A)
%-----------------------------------------
% dependency: owner_of_unsold_items/1.
unsold_items( X0):- owner_of_unsold_items( J0), x( J0, _, X0).
unsold_item( A):- unsold_items( X0), member(A, X0).
% cost/wealth analysis
%-----------------------------------------
c(P,A,C):-
(var(P)->pp(P);true),
(var(A)->bundle(A);true),
c_0(P,A,C).
c_0(_,[],0).
c_0(P,[A|B],C):-
c_0(P,B,D),
member((A->Pa),P),
C is D + Pa.
% demo
%-----------------------------------------
/*
?- c(P,[1,2,3],Q).
P = [900, 300, 500]
Q = 1700 ;
No
?- c(P,[1,3],Q).
P = [900, 500]
Q = 1400
Yes
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% a simulation of trading
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
t(1,i->j).
t(2,i->k).
t(3,i->k).
tt(TT):- findall((O,T),t(O,T),TT).
tJget(J,TT):- T=(J->_),findall((O,T),t(O,T),TT).
tJput(J,TT):- T=(_->J),findall((O,T),t(O,T),TT).
% a naiive simulation of trade process
%-----------------------------------------
:- dynamic temp_x/3, temp_t/2.
go_t:-
initialize_t_x,
fail.
go_t:-
temp_t( not_yet, T ),
T = [_O,I->J],
transaction_data( T, Tid, S_Data, B_Data ),
retract( temp_t(not_yet, T) ),
Tid1 is Tid + 1,
assert( temp_t(done(t=Tid1), T) ),
update_allocation_for_buyer( Tid, J, B_Data ),
update_allocation_for_seller( Tid, I, S_Data ),
fail.
go_t:-
finalize_t_x.
initialize_t_x:-
abolish( temp_x/3 ),
abolish( temp_t/2 ),
C1 = temp_x( 0, (I,M,E), [] ),
C2 = temp_t(not_yet, [O,I->J]),
forall( e(I,M,E), assert(C1) ),
forall( t(O,I->J), assert(C2) ).
transaction_data([O,I->J], Tid, S_Data, B_Data):-
temp_x(Tid, (I,Wi,Ei), Hi),
temp_x(Tid, (J,Wj,Ej), Hj),
check_feasibility(O,_Po,[Ei,Ej,Wi,Wj],[Wi1,Wj1]),
append(Ej,[O],Ej1),
subtract(Ei,[O],Ei1),
Tid1 is Tid + 1,
S_Data = [Tid1, (I, Wi1, Ei1), [(O,to(J))|Hi]],
B_Data = [Tid1, (J, Wj1, Ej1), [(O,from(I))|Hj]],
!.
check_feasibility(O,P,[Ei,_Ej,Wi,Wj],[Wi1,Wj1]):-
member(O, Ei),
p(O, P),
Wi1 is Wi + P,
Wj1 is Wj - P.
% Wj1 >=0.
update_allocation_for_buyer(Tid, J, B_Data):-
retract(temp_x(Tid, (J,_,_), _)),
CB =.. [temp_x|B_Data],
assert(CB),
!.
update_allocation_for_seller(Tid, I, S_Data):-
retract(temp_x(Tid, (I,_,_), _)),
SB =.. [temp_x|S_Data],
assert(SB),
!.
finalize_t_x:-
write( complete ),
listing( temp_t ),
listing( temp_x ).
% demo
%-----------------------------------------
/*
?- go_t.
complete
:- dynamic temp_t/1.
:- dynamic temp_t/2.
temp_t(done(t=1), [1, (i->j)]).
temp_t(done(t=1), [2, (i->k)]).
temp_t(done(t=2), [3, (i->k)]).
:- dynamic temp_x/3.
temp_x(0, (j, 0, []), []).
temp_x(0, (k, 0, []), []).
temp_x(1, (j, 100, [1]), [ (1, from(i))]).
temp_x(1, (i, 300, [1, 3]), [ (2, to(k))]).
temp_x(2, (k, 200, [2, 3]), [ (3, from(i)), (2, from(i))]).
temp_x(2, (i, 1400, [2]), [ (3, to(k)), (1, to(j))]).
Yes
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% competitive equilibrium
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% vt: trading profit function (characteristic function, the value of asset)
% d: demand correspomdence
% wep: competitive equilibrium and the price (Walrasian equilibrium / price)
% xds: excess demand set
%%%%
:- dynamic utility_scale/1.
utility_scale(100).
% trading profit function
%-----------------------------------------
vt(J,A,P,V):-
vt(J,A,P,_,V).
vt(J,A,P,W1+W2=W,V):-
(var(P)->pp(P);true),
u(J,A,U),
c(P,A,C),
e(J,W1,O),
c(P,O,W2),
W is W1 + W2,
utility_scale( H),
V is H * U + W - C.
% demand correspondence
%-----------------------------------------
d(J,P,D):-
agent(J),
pp(P),
setof(A,
max(V,vt(J,A,P,V)),
D).
dd(W):-
findall(J->D, d(J,_,D),W).
% minimal demand correspondence
%-----------------------------------------
% to be used for computing auction prices.
d_star(J,P,D_star):-
agent(J),
% pp(P),
MLen = (member(A,D),length(A,K)),
setof(A,
min( K, (d(J,P,D),MLen) ),
D_star).
% competitive equilibrium
%-----------------------------------------
% def. (p,X) is Walrasian ( competitive) equilibrium
% if allocation X consists of Xi in the demand set Di
% for each agent ( and
=0)
wep(P, Y):-
pp(P),
feasible_allocation(Y),
wep_0(P,Y),
complementarity_condition.
wep_0(_,[]).
wep_0(P,[A->J|Y]):-
wep_0(P,Y),
d(J,P,Dj),
member(A,Dj).
complementarity_condition:-
sumall(P,(unsold_item(A),p(A,P)),0).
% feasible allocation (i.e., partition of items)
%-----------------------------------------
feasible_allocation(X):-
feasible_allocation(_,_,X).
feasible_allocation(N,O,Y):-
set_of_all_agents(N),
set_of_all_items(O),
feasible_allocation_0(item,N,O,X),
transform_into_allocation( X, Y).
feasible_allocation_0(_,_,[],[]).
feasible_allocation_0(item,I,[A|O],[A->J|X]):-
feasible_allocation_0(item,I,O,X),
item(A),
agent(J),
member(J,I).
transform_into_allocation( X, Y):-
findall(Xj->J,
(
agent(J),
findall(A, member(A->J,X), Xj)
),
Y).
% display only nonempty assignments given a feasible allocation.
%-----------------------------------------
% It may be a help, despite current uses of this rule
% occurs only in extended game analysis later.
nonempty_assignments(Y->Ya):-
forall( member(X,Y), (\+ var(X),X=(_->_))),
findall(A,
(
member(A,Y),
A \= ([]->_)
),
Ya).
% support
%-----------------------------------------
% (p,X) is equilibrium iff p supports X and
=0
wep_1(P, X):-
price_supports_allocation( P, X),
complementarity_condition.
out_of_demand_set_at_price( P, I, Xi, Di):-
x(I, _, Xi),
d(I, P, Di),
\+ member( Xi, Di).
price_supports_allocation( P, X):-
\+ out_of_demand_set_at_price( P, _I, _Xi, _Di),
pp(P),
xx(X).
price_supports_bundle( P, X):-
bundle(A),
price_supports_allocation( P, X),
unsold_items( X0),
set_of_all_items( OX),
subtract( OX, A, Ac),
set_equivalent( X0, Ac).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% excess demand
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The key block for updating prices in dynamic auctions.
% Gul and Stacchetti(2000) developed the algorithm
% based on matroid theory.
% revised: 18-19 Sep 2005
% requirement function
%-----------------------------------------
% dual rank function, k(=ro^#), in matroid theory,
% if the SI property has satisfied.
% k is bounded, monotone, and supermodular.
k( J, B, P, K):-
bundle(B),
d( J, P, Dp),
min( K,
(
member(A, Dp),
intersection(A,B,C),
length(C,K)
)
),
!.
k_star( J, B, P, K):-
bundle(B),
d_star( J, P, Dp),
min( K,
(
member(A, Dp),
intersection(A,B,C),
length(C,K)
)
),
!.
k_N( B, P, KN):-
bundle(B),
pp(P),
sumall(K, (agent(J),k( J, B, P, K)), KN).
k_star_N( B, P, KN):-
bundle(B),
pp(P),
sumall(K, (agent(J),k_star( J, B, P, K)), KN).
% demanded bundles
%-----------------------------------------
:- dynamic f/3.
f_1( A, P, F):-
k_N( A, P, KN),
length(A, L),
F is KN -L.
f( A, P, F):-
k_star_N( A, P, KN),
length(A, L),
F is KN -L.
% By the Corollary of Theorem 3 of Gull & Stacchetti(2000),
% wep(P, _) -> f(A) =< 0 forall bundle A.
% ch_f/1: change f -> f1 or vice versa (recover f).
% => see MMT section.
% max-demanded bundles at prices p
%-----------------------------------------
% the collection of max-demaded O is a lattice for each P.
% (Lemma 5 of Gull & Stacchetti(2000), p.76.)
max_demanded_bundle( P, A :F):-
max(F, f( A, P, F)).
% excess demand set (over-demanded items)
%-----------------------------------------
% the smallest element of the lattice is called
% the `excess demand set.'
xds( P, B : F):-
excess_demand_set( P, B : F).
excess_demand_set( P, B : F):-
min(K,
(
max_demanded_bundle( P, A : F),
length( A, K)
)
),
B = A.
excess_demand_item(P,A):-
item(A),
excess_demand_set( P, B : _F),
member(A, B).
show_excess_demand_items:-
pp(P),
nl,
write(prices:P:' excess demand set: '),
forall(excess_demand_set(_P,O:_),
(
write( O)
)
).
% another correspondence in the proof
%-----------------------------------------
% added: 19 Sep 2005
% member(A, D_hat(p)) -> member(C,D(p)), subset(C,A).
% (Lemma 1 of GS00, p.72)
d_hat(J,P,D_hat):-
agent(J),
pp(P),
MLen = (intersection(A,B,C),length(C,L)),
setof(A,
(
bundle(A),
forall(
bundle(B),
(k(J,B, P,K),MLen, L >= K )
)
),
D_hat).
% a test for the requirement function
%-----------------------------------------
/*
?- set_model(job_matching_1([0.5,1,0])).
Yes
?- ch_f(A).
A = use:f1
Yes
?- solve_wep_1(P,Y).
init p:[ (1->0), (2->0), (3->0)];xds:[1, 2, 3]
p:[ (1->150), (2->150), (3->150)];xds:[1, 2, 3]->[2]
p:[ (1->150), (2->200), (3->150)];xds:[2]->[1, 2, 3]
p:[ (1->200), (2->250), (3->200)];xds:[1, 2, 3]->[]
I can`t update prices, because
there is no excess demand item.
P = [ (1->200), (2->250), (3->200)]
Y = _G158
Yes
?- display_goals((agent(J),bundle(B),k(J,B,P,K),
k_star(J,B,P,K1),K1\=K)).
agent(j), bundle([3]), k(j, [3], [ (1->200), (2->250), (3->200)], 0),
k_star(j, [3], [ (1->200), (2->250), (3->200)], 1), 1\=0
J = _G160
B = _G162
P = _G166
K = _G167
K1 = _G172
Yes
?- display_goals(d(_,_,_)).
d(i, [ (1->200), (2->250), (3->200)], [[]])
d(j, [ (1->200), (2->250), (3->200)], [[1, 2], [1, 3], [3]])
d(k, [ (1->200), (2->250), (3->200)], [[1, 3], [2, 3]])
Yes
?- display_goals(d_star(_,_,_)).
d_star(i, [ (1->200), (2->250), (3->200)], [[]])
d_star(j, [ (1->200), (2->250), (3->200)], [[3]])
d_star(k, [ (1->200), (2->250), (3->200)], [[1, 3], [2, 3]])
Yes
?- display_goals(d_hat(_,_,_)).
d_hat(i, [ (1->200), (2->250), (3->200)], [[], [1], [1, 2], [1, 2, 3], [1, 3], [2], [2, 3], [3]])
d_hat(j, [ (1->200), (2->250), (3->200)], [[1, 2], [1, 2, 3], [1, 3], [2, 3], [3]])
d_hat(k, [ (1->200), (2->250), (3->200)], [[1, 2, 3], [1, 3], [2, 3]])
Yes
?- display_goals(vt(j,_,_,_)).
vt(j, [3], [ (1->200), (2->250), (3->200)], 300)
vt(j, [2], [ (1->200), (2->250), (3->200)], 150)
vt(j, [2, 3], [ (1->200), (2->250), (3->200)], 250)
vt(j, [1], [ (1->200), (2->250), (3->200)], 200)
vt(j, [1, 3], [ (1->200), (2->250), (3->200)], 300)
vt(j, [1, 2], [ (1->200), (2->250), (3->200)], 300)
vt(j, [1, 2, 3], [ (1->200), (2->250), (3->200)], 250)
vt(j, [], [ (1->200), (2->250), (3->200)], 0)
Yes
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% a solver for equilibrium
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% See last section and references.
% a naive wep-solver
%-----------------------------------------
% backtrack with `price revision tools' below.
solve_wep(P, Y):-
generate_price_vector(P),
wep(P, Y).
tell_solve_wep:-
tell_goal('solve_wep.txt',
display_goals(solve_wep_0(P, Y),[P:Y])
),
fail.
tell_solve_wep:-
current_stream('solve_wep.txt',write,S),
close(S).
% demo
%-----------------------------------------
% In this example, the minimal (smallest) Walrasian price is,
% p_min = (6,7).
% And the corrsponding efficient allocation X is
% X =([a]->j;[b]->k),
% both consists the equilibrium, (p,X).
% As experimental data shown below, the (discrete)
% Warlasian price vectors forms a triangular region
% consists of the grid points whose vertices are
% (6,6), (6,7), and (7,7)
% in (Pa,Pb) of the two dimensional coordinates.
/*
% file output start time , [date(2005/8/26), time(22:49:45)]
%---------- start from here ------------%
[ (a->600), (b->700)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->600), (b->710)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->610), (b->710)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->600), (b->720)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->610), (b->720)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->620), (b->720)]:[ ([]->i), ([a]->j), ([b]->k)];
(...)
[ (a->690), (b->790)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->600), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->610), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->620), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->630), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->640), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->650), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->660), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->670), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->680), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->690), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
[ (a->700), (b->800)]:[ ([]->i), ([a]->j), ([b]->k)];
*/
% a wep-solver with simple stopping rule
%-----------------------------------------
% Stop1 <= true : if find a wep then stop.
% Stop1 <= fail : continue search totally.
% Stop2 <= fail : continuation.
% Stop2 <= (C->true;fail) : certain truncation rule.
solve_wep(P, Y, Stop1, Stop2):-
generate_price_vector(P),
(wep(P, Y)
->(nl,write(P:Y:'equilibrium!'),Stop1)
; (nl,write(P:'fail'),Stop2)
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% auction as solver for equilibrium
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% solve_wep_1/2.
% the ascending auction based wep-solver
%-----------------------------------------
% The code below implements the `English auction game'
% algorithm by Gull & Stacchetti(2000). This can be explained
% as a primal-dual algorithm (See Bikhchandani et al., 2002).
% bugfix. (18 Sep 2005) solve_wep_1/2. simplified the stopping rule.
% bugfix. (19 Sep 2005 6:47am-- 22:00pm) model: job_matching_1(E).
% You can try out an earlier version of the rule
% by means of ch_f/1 => See MMT section.
% On revisoning for solve_wep_1/2
%-----------------------------------------
% phenomena.
% E=[0.25,0,0],[0.75,0,0],[0.25,0.25,0]
% ... were the cases of anomal termination.
% A wep/2 used in advance of the stopping rule in earlier
% version causes them.
% diagnosis.
% The problem accompanied with the code for excess demand set
% (xds) and function k, f, and so on.
% The bidding process stops only when the xds become empty,
% even if not yet an equilibrium. But a failure of preceeding
% wep/2 may deter it, so does not terminate.
% treatment.
% (1) simplification of the stopping rule.
% By means of this, even if not reached an equilibrium,
% the bidding stops when xds become empty.
% (2) using d_star, k_star, f_star instead.
% This avoides the wrong premature stoppings. The right
% cases are of no competitive equilibrium.
% Caveat.(apology)
% The second part of above treatment is NOT
% a literal interpretation of the GS algorithm.
% At the present time of development of code, either
% their lemma 2 or the modeling code seems dubious.
% an outlook of the algorithm.
%-----------------------------------------
% Adjusting prices upwards directed toward in the excess demand set,
% the algorithm has option to stop at T1, the first time when
% a competitive allocation is possible (and the excess demand set
% simultaneously become empty). This means the minimal Walrasian price.
% The algorithm must stop at T, the first time when
% the excess demand set becomes empty.
% The algorithm can compute (minimal) Walrasian prices
% by Theorem 4 of Gull & Stacchetti(2000), p.77.
% Let p(T1) the price at first optional stop time T1 of a EAG,
% and p_we is Walrasian equilibrium price of the game. Then
% p(T1)= min(p_we),
% T1=T.
solve_wep_1( P, Y):-
abolish(p/2),
set_0_prices,
stopping_rule_for_wep( P, Y).
solve_wep_1( P, Y):-
price_revision_on_excess_demand_set(P),
stopping_rule_for_wep( P, Y),
!.
% stopping rules for solve_wep_1
%-----------------------------------------
stopping_rule_for_wep( P, Y):-
wep(P, Y),
nl,
write( ' equilibrium ! ').
stopping_rule_for_wep( P,_):-
\+ excess_demand_item( P,_A),
nl,
nl,
write( 'I can`t update prices, because '),
nl,
write( 'there is no excess demand item. ').
stopping_rule_for_wep(_,_):-
it_has_been_reached_max_prices,
nl,
nl,
write( 'I can`t update prices, because '),
nl,
write( 'of the boundedness of prices.').
it_has_been_reached_max_prices:-
pp(PP),
forall( member(Item->P, PP),
(
max_price( Item, Pmax),
P >= Pmax
)
).
% ex post analysis
%-----------------------------------------
display_revision_data:-
display_recorded_excess_demand_set(t),
display_recorded_demand_set(t).
display_recorded_excess_demand_set(Y):-
(var(Y)->Y=t;true),
Op =(Y=t->O\=O1;true),
forall(
(temp_price_revision(N,[P,O,O1,_]),Op),
(nl,write([N]),write(P:O->O1))
).
display_recorded_demand_set(Y):-
(var(Y)->Y=t;true),
Op =(Y=t->O\=O1;true),
forall(
(temp_price_revision(N,[_P,O,O1,D]),Op),
(nl,write([N]),write(D))
).
recover_prices_recorded(N,P):-
temp_price_revision(N,[P|_]),
generate_price_vector(P).
verify_upper_min_wep(Q,Y):-
temp_price_revision(70,[P|_]),
generate_price_vector(Q),
\+ (member((X->Qx),Q),member((X->Px),P),Px > Qx),
\+ wep(Q,Y).
% demo
%-----------------------------------------
/*
?- set_model(auction_1).
Yes
?- stopwatch(solve_wep_1(P,Y),T).
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
% time elapsed (sec): 0.188
P = [ (a->600), (b->700)]
Y = [ ([]->i), ([a]->j), ([b]->k)]
T = 0.188
Yes
?- display_recorded_excess_demand_set(t).
[30][ (a->300), (b->300)]:[a, b]->[b]
[40][ (a->300), (b->400)]:[b]->[a, b]
[70][ (a->600), (b->700)]:[a, b]->[]
Yes
?- display_recorded_demand_set(t).
[30][ (i->[[]]), (j->[[a, b], [b]]), (k->[[a, b]])]
[40][ (i->[[]]), (j->[[a], [a, b], [b]]), (k->[[a, b]])]
[70][ (i->[[]]), (j->[[a], [b]]), (k->[[a, b], [b]])]
Yes
?- dd(I).
I = [ (i->[[]]), (j->[[a], [b]]), (k->[[a, b], [b]])]
Yes
?- display_goals((recover_prices_recorded(N,P),wep(P,Y)),[N:P:Y]).
70:[ (a->600), (b->700)]:[ ([]->i), ([a]->j), ([b]->k)];
No
?-
% p=(6,7) is the minimal competitive price vector in this example.
% (utility scale= x1000)
*/
% no gap condition is satisfied for the
% k-replica economy with k=#I+1 times copied for I and N
% and the extended utility functions.
% (See Gul and Stacchetti(1999), Theorem 9.)
% demo
%-----------------------------------------
% for auction_1_r3 the 3-replica economy of auction_1.
% note: A run below took about 24 minutes (1437.3 sec).
% (Windows XP Pro SP2, Celeron 1.4GHz, 504MB RAM.)
/*
?- set_model(auction_1_r3).
Yes
?- solve_wep_1(P,Y).
init p:[ (a(1)->0), (b(1)->0), (a(2)->0), (b(2)->0), (a(3)->0), (b(3)->0)];xds:[a(1), a(2), a(3), b(1), b(2), b(3)]
p:[ (a(1)->300), (b(1)->300), (a(2)->300), (b(2)->300), (a(3)->300), (b(3)->300)];xds:[a(1), a(2), a(3), b(1), b(2), b(3)]->[b(1), b(2), b(3)]
p:[ (a(1)->300), (b(1)->400), (a(2)->300), (b(2)->400), (a(3)->300), (b(3)->400)];xds:[b(1), b(2), b(3)]->[a(1), a(2), a(3), b(1), b(2), b(3)]
p:[ (a(1)->600), (b(1)->700), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)];xds:[a(1), a(2), a(3), b(1), b(2), b(3)]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
P = [ (a(1)->600), (b(1)->700), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)]
Y = [ ([]->i), ([a(3)]->j(1)), ([b(3)]->k(1)), ([a(2)]->j(2)), ([b(2)]->k(2)), ([a(1)]->j(3)), ([b(1)]->k(3))]
Yes
?- Y = [ ([]->i), ([a(1)]->j(1)), ([b(1)]->k(1)), ([a(2)]->j(2)), ([b(2)]->k(2)), ([a(3)]->j(3)), ([b(3)]->k(3))] ,
P = [ (a(1)->600), (b(1)->700), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)],
display_goals((member((A->J),Y),c(P,A,C),u(J,A,U)),[A->J,c=C,u=U]).
[]->i; c=0; u=0;
[b(1)]->k(1); c=700; u=8;
[a(2)]->j(2); c=600; u=8;
[b(2)]->k(2); c=700; u=8;
[a(3)]->j(3); c=600; u=8;
[b(3)]->k(3); c=700; u=8;
No
?-
*/
% demo
%-----------------------------------------
% job matching model in Kelso and Crawford(1982).
% See also Ma(1998, 2001).
% revised: 19-20 Sep 2005.
% As it has alleged in the literature(Kelso and Crawford,1982),
% that the game model: job_matching_1([0.5,0.25,0.25])
% has no competitive equilibrium.
% The rule solve_wep_1/2, incorporated the EAG algorithm,
% to stop at a price vector below.
/*
?- set_model(job_matching_1([0.5,0.25,0.25])).
Yes
?- solve_wep_1(P,Y).
init p:[ (1->0), (2->0), (3->0)];xds:[1, 2, 3]
p:[ (1->150), (2->150), (3->150)];xds:[1, 2, 3]->[2]
p:[ (1->150), (2->200), (3->150)];xds:[2]->[1, 2, 3]
p:[ (1->280), (2->330), (3->280)];xds:[1, 2, 3]->[]
I can`t update prices, because
there is no excess demand item.
P = [ (1->280), (2->330), (3->280)]
Y = _G161
Yes
?- display_goals(d_star(_,_,_)).
d_star(i, [ (1->280), (2->330), (3->280)], [[]])
d_star(j, [ (1->280), (2->330), (3->280)], [[3]])
d_star(k, [ (1->280), (2->330), (3->280)], [[1]])
Yes
?- display_goals(d(_,_,_)).
d(i, [ (1->280), (2->330), (3->280)], [[]])
d(j, [ (1->280), (2->330), (3->280)], [[3]])
d(k, [ (1->280), (2->330), (3->280)], [[1]])
Yes
?- xds(O,Y).
O = [ (1->280), (2->330), (3->280)]
Y = []:0
Yes
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% price revison tools
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% price adjustment rules for solve_wep_1
%-----------------------------------------
price_revision_on_excess_demand_set(P):-
excess_demand_set(P,O:_),
assert(temp_price_revision(0,[P,O,start])),
nl,write('init p':P;xds:O),
O =[], % exit and exceute the rules of check & stop.
!.
price_revision_on_excess_demand_set(Q):-
repeat,
excess_demand_set(P,Op:_),
Op \= [],
price_increment_for_bundle(Op, 1, P->Q),
excess_demand_set(Q,Oq:_),
dd(D),
record_price_revision([Q,Op,Oq,D]),
warn_user_if_xds_changed(Q,Op,Oq),
Oq \= Op.
warn_user_if_xds_changed(_,Op,Op):-!.
warn_user_if_xds_changed(Q,Op,Oq):-
nl,write(p:Q;xds:Op->Oq).
set_0_prices:-
abolish( p/2),
abolish( temp_price_revision/2),
initialize_uid,
forall( item(X), assert(p(X,0))).
% recorder of revisioning prices / demands
%-----------------------------------------
:- dynamic temp_price_revision/2, temp_uid/1.
record_price_revision(Data):-
update_uid(_->N),
assert(temp_price_revision(N,Data)).
tem_uid(0).
initialize_uid:-
abolish(temp_uid/1),
assert(temp_uid(0)).
update_uid(Prev->Next):-
retract(temp_uid(Prev)),
Next is Prev +1,
assert(temp_uid(Next)).
% another code ( not effective)
%-----------------------------------------
/*
% caution: if you backtrack this,
% cumulative side-effects on your goal stack.
price_revision_on_excess_demand_set_0:-
price_revision_on_excess_demand_set_0(_,_,_, stop).
price_revision_on_excess_demand_set_0([],O,P,Sea):-
excess_demand_set(P,O:_),
(O \= [] ->Sea = continue ; (!,Sea=stop)).
price_revision_on_excess_demand_set_0([Op|X],Oq,Q, Sea) :-
price_revision_on_excess_demand_set_0(X,Op,P, continue),
price_increment_for_bundle(Op, 1, P->Q),
excess_demand_set(Q,Oq:_),
% debug %
nl,write( rev_p_xds(Q;Op->Oq)),
(Oq = Op -> Sea =continue; (!, Sea =stop)).
*/
% possible prices
%-----------------------------------------
:- dynamic max_price/2, min_price/2, price_discretional_step/2.
max_price(_anyItem,1000).
min_price(_,0).
price_incremental_step(_,10).
max_number_of_steps(Item, K):-
max_price(Item,U),
min_price(Item,L),
price_incremental_step(Item,D),
K is int( U-L)/D.
generate_price_vector(P):-
possible_price_vector(P),
abolish(p/2),
forall(
member((X->Px),P),
assert(p(X,Px))
).
possible_price_vector(P):-
set_of_all_items(O),
possible_price_vector_0(O,P).
possible_price_vector_0([],[]).
possible_price_vector_0([X|O],[X->Px|P]):-
possible_price_vector_0(O,P),
possible_price(X,_,Px).
possible_price(X,[L,U],P):-
item(X),
max_price(X,U),
min_price(X,L),
price_incremental_step(X,D),
nonnegative_number([L,U],D,P).
% increasing price by a unit
%-----------------------------------------
price_increment(A, Pa->Pa1):-
price_increment(A, 1, Pa->Pa1).
price_increment(A, K, Pa->Pa1):-
retract( p( A, Pa)),
price_incremental_step( A, Delta),
Pa1 is Pa + K * Delta,
assert( p( A, Pa1)).
price_increment_for_bundle(S, K, P->P1):-
pp(P),
(var(K)->K=1;true),
bundle(S),
forall(member(A,S),
price_increment(A, K, _)
),
pp(P1).
% increasing price other than a subset of the all items
%-----------------------------------------
% (to be used for analyzing the gross substitutes condition.)
% revised: 19 Sep 2005
price_increment_other_than(S, P->Q):-
pp(P),
set_of_all_items(O),
no_less_than_price_vector_0(O,P,Q, S),
generate_price_vector(Q).
no_less_than_price_vector_0([],[], [], []).
no_less_than_price_vector_0([X|O],[X->Px|P],[X->Qx|Q],S1):-
no_less_than_price_vector_0(O,P, Q, S),
possible_price(X,_,Px),
possible_price(X,_,Qx),
Px =< Qx,
( Px=Qx -> S1 =[X|S]; S1=S).
% a naive code ( which will be inefficient depends on the use)
price_increment_other_than_1(S, P->Q):-
price_no_greater_than( P =< Q),
same_price_items( P, Q, S).
same_price_items( P, Q, S):-
intersection( P, Q, MP),
findall( Item, member( (Item-> _), MP), S).
price_no_greater_than( P =< Q):-
possible_price_vector(P),
possible_price_vector(Q),
findall( Item-> Pi,
(
member( (Item->Pi), P),
member( (Item->Qi), Q),
Pi =< Qi
),
P).
% old rules which were used in gs condition (abolish).
unit_price_increment_other_than(S, P->P1):-
price_increment_other_than(S, 1, P->P1).
k_unit_price_increment_other_than(S, K, P->P1):-
set_of_all_items(O),
bundle(S),
subtract(O,S,C),
price_increment_for_bundle(C, K, P->P1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% VCG mechanism and replica economy
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% added: 30 Aug 2005
% preliminary :
% maximizing surplus of coalition of bidders
% with restricted items
%-----------------------------------------
%
% For any subset S of N, and any subset (a bundle) Q of I,
% let V(S;Q) is the maximum surplus of a coalition of bidders
% with restricited items. More precisely,
% V(S;Q):= max Sum_over_S( u_j(b) | b is a member of x(Q)),
% where x(Q) represents an allocation of I retricted to Q,
% a* := argmax V(N;I) = argmax sum_over_N(u_j),
% and I will omit the second argument if Q=I.
%
% Theorem. (maximal and minimal Warlasian price vectors)
% When agent's utility functions are monotone and SI then
% for each bundle A,
% for item `a' in A,
% max (Warlasian price of item a) = V(S)-V(S;Q-a),
% and for item `a' not in A,
% min (supprting price of A) =V(S;A+a)-V(S;A),
% especially,
% min (Warlasian price of item a) = V(S;I+a)-V(S).
% (See Gul and Stacchetti(1999), Theorem 4 and Theorem 5.)
coalition(S):-
coalition(S, _, _).
coalition(S,[K,Sc,N]):-
coalition(S, K, N),
subtract( N, S, Sc).
% revised: 20-21 Sep 2005
coalition(S, K, N):-
find_subset(I, agent(I), N, S),
length(S, K).
% a tool of partial collection
%-----------------------------------------
% a generalization for alternative codes below.
find_subset(Item, Goal, F, C):-
findall( Item, Goal, F),
list_projection( _, F, C).
%% alt.
%(1)
/*
coalition(S, K, N):-
set_of_all_agents(N),
coalition_0(S, K, N).
coalition_0([], 0, []).
coalition_0(S, K, [J|N]):-
coalition_0(S, K, N),
agent(J).
coalition_0([J|S], K1, [J|N]):-
coalition_0(S, K, N),
agent(J),
K1 is K + 1.
*/
%(2)
% coalition(S, K, N):-
% set_of_all_agents(N),
% list_projection(_, N, S),
% length(S,K).
% optimal allocation
%-----------------------------------------
% revised: 8, 24 Sep 2005
% without backtrack
a_star( V, Y):- a_star_0( V, Y), !.
max_surplus_of_coalition( V, Y, S ):-
max_surplus_of_coalition_0( V, Y, S), !.
% with backtrack
a_star_0( V, Y):-
set_of_all_agents(N),
max_surplus_of_coalition_0( V, Y, N ).
max_surplus_of_coalition_0( V, Y, S ):-
set_of_all_items(I),
max_surplus_of_coalition_0( V, Y, S, I).
max_surplus_of_coalition( V, Y, S, Q):-
max_surplus_of_coalition_0( V, Y, S, Q),
!.
max_surplus_of_coalition_0( V, Y, S, Q):-
coalition(S),
S\=[],
bundle(Q),
max( V,
surplus_of_coalition_restricted_to_items( V, Y, S, Q)
).
max_surplus_of_coalition_0( 0, _, [], _).
surplus_of_coalition_restricted_to_items( V, Y, S, Q):-
feasible_allocation_restricted_to( Y, _:S, _:Q),
sumall( Vj, (member( A -> J, Y ), u(J,A,Vj)), V).
feasible_allocation_restricted_to( Y, agents:S, items:Q):-
coalition(S),
%S\=[],
bundle(Q),
feasible_allocation_0(item,S,Q,X),
transform_into_allocation( X, Y).
% VCG prices in sealed bid auctions
%-----------------------------------------
% definition: VCG payment q_i(Xi) is
% q_i(Xi) = V(N-i;I) - V(N-i;I-Xi)
% = V(N-i) - (V(N) - u_i(a*))
% = V(N-i) - Surplus of other than i.
% (See the definition by Gul and Stacchetti(1999) and
% compare it with that of Leonard(1986) for unit demand case.
% Also confer Bikhchandani et al.(2002).)
% Therefore individual's net benefit equals the marginal product,
% u_i(a*) -q_i(Xi) = V(N)-V(N-i).
vcg_payment( J, [Qf, Y, A], Q):-
coalition(S,[_,[J],_N]),
max_surplus_of_coalition( V, Y, S ),
a_star( Va, A),
member( Aj->J, A),
u( J, Aj, Uaj),
Qf = V - ( Va - Uaj),
Q is Qf.
% The VCG payment q_i(Xi) gives a lower bound of that of
% Warlasian equilibrium (p, X). That is
% q_i(Xi) =<
% (Gul and Stacchetti, 1999).
% (A classical theorem)
% unit demand preferences => vcg for i q_i=
% where p is the minimal equilibrium price.
% For example, see Leonard(1983), Demange et al. (1986).
% Gul and Stacchetti(1999) has proved for the replica economy
% of monotone SI preferences.
% note: the price vector 'minimal' in the sense that
% every other Walrasian price vector weakly dominates it.
% demo
%-----------------------------------------
% part 1.
/*
?- set_model(auction_1).
Yes
?- a_star(Y,V).
Y = 16
V = [ ([]->i), ([a]->j), ([b]->k)] ;
No
?- display_goals(max_surplus_of_coalition( V, Y, S),[V,Y,S]).
14; [ ([]->i), ([]->j), ([a, b]->k)]; [k];
12; [ ([]->i), ([a, b]->j), ([]->k)]; [j];
16; [ ([]->i), ([a]->j), ([b]->k)]; [j, k];
0; [ ([a, b]->i), ([]->j), ([]->k)]; [i];
14; [ ([]->i), ([]->j), ([a, b]->k)]; [i, k];
12; [ ([]->i), ([a, b]->j), ([]->k)]; [i, j];
16; [ ([]->i), ([a]->j), ([b]->k)]; [i, j, k];
No
?- display_goals(vcg_payment(J,[Qf,Y,A],Q),[Q,Qf,J,A,Y]).
0; 16- (16-0); i; [ ([]->i), ([a]->j), ([b]->k)]; [ ([]->i), ([a]->j), ([b]->k)];
6; 14- (16-8); j; [ ([]->i), ([a]->j), ([b]->k)]; [ ([]->i), ([]->j), ([a, b]->k)];
4; 12- (16-8); k; [ ([]->i), ([a]->j), ([b]->k)]; [ ([]->i), ([a, b]->j), ([]->k)];
No
?- display_goals((wep(P,Y),member(A->J,Y),c(P,A,C)),[A->J,C]).
[]->i; 0;
[a]->j; 600;
[b]->k; 700;
No
?- display_goals((wep(P,Y),member(A->J,Y),u(J,A,V)),[A->J,V]).
[]->i; 0;
[a]->j; 8;
[b]->k; 8;
No
*/
% demo
%-----------------------------------------
% part 2. VCG payment from definition and solve_wep_1.
% For a replica-economy case, vcg_payment/3 (and a_star/2, wep/2, etc.)
% will consume much time or cause a global stack over.
% The way shown below is slow but feasible in the case.
/*
?- set_model_without_agent(J,M).
J = j
M = auction_1
Yes
?- solve_wep_1(P,Y).
equilibrium!
P = [ (a->0), (b->0)]
Y = [ ([]->i), ([a, b]->k)]
Yes
?- display_goals((wep(P,Y),member(A->J,Y),u(J,A,V)),[A->J,V]).
[]->i; 0;
[a, b]->k; 14;
No
?- set_model_without_agent(J,auction_1_r3).
J = j(1)
Yes
?- solve_wep_1(P,Y).
init p:[ (a(1)->0), (b(1)->0), (a(2)->0), (b(2)->0), (a(3)->0), (b(3)->0)];xds:[a(2), a(3), b(2), b(3)]
p:[ (a(1)->0), (b(1)->0), (a(2)->300), (b(2)->300), (a(3)->300), (b(3)->300)];xds:[a(2), a(3), b(2), b(3)]->[b(2), b(3)]
p:[ (a(1)->0), (b(1)->0), (a(2)->300), (b(2)->400), (a(3)->300), (b(3)->400)];xds:[b(2), b(3)]->[a(2), a(3), b(2), b(3)]
p:[ (a(1)->0), (b(1)->0), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)];xds:[a(2), a(3), b(2), b(3)]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
P = [ (a(1)->0), (b(1)->0), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)]
Y = [ ([]->i), ([a(1), b(1)]->k(1)), ([a(2)]->j(2)), ([b(2)]->k(2)), ([a(3)]->j(3)), ([b(3)]->k(3))]
Yes
?- P = [ (a(1)->600), (b(1)->700), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)],
Y = [ ([]->i), ([a(3),b(3)]->k(1)), ([a(2)]->j(2)), ([b(2)]->k(2)), ([a(1)]->j(3)), ([b(1)]->k(3))],
display_goals((member((A->J),Y),c(P,A,C),u(J,A,U)),[A->J,c=C,u=U]).
[]->i; c=0; u=0;
[a(3), b(3)]->k(1); c=1300; u=14;
[a(2)]->j(2); c=600; u=8;
[b(2)]->k(2); c=700; u=8;
[a(1)]->j(3); c=600; u=8;
[b(1)]->k(3); c=700; u=8;
No
?- Vj1 is ( 14 - 8).
Vj1 = 6
Yes
?- set_model_without_agent(k(1),auction_1_r3).
Yes
?- P = [ (a(1)->600), (b(1)->700), (a(2)->600), (b(2)->700), (a(3)->600), (b(3)->700)],
Y = [ ([]->i), ([b(3)]->j(1)), ([a(3)]->j(2)), ([a(2), b(2)]->k(2)), ([a(1)]->j(3)), ([b(1)]->k(3))],
display_goals((member((A->J),Y),c(P,A,C),u(J,A,U)),[A->J,c=C,u=U]).
[]->i; c=0; u=0;
[b(3)]->j(1); c=700; u=9;
[a(3)]->j(2); c=600; u=8;
[a(2), b(2)]->k(2); c=1300; u=14;
[a(1)]->j(3); c=600; u=8;
[b(1)]->k(3); c=700; u=8;
No
?- Vk1 is ( 9 - 8 ) + ( 14 - 8 ).
Vj1 = 7
Yes
*/
% demo
%-----------------------------------------
% part 3.
% model: s 2x2 Job assignment problem in Leonard(1983).
% added: 8 Sep 2005
% revised: 9 Sep 2005
/*
?- set_model(assign_1),
solve_wep_1(P,Y),
display_goals(vcg_payment(A,[B|_],C),[A,B,C]).
init p:[ (job_a->0), (job_b->0)];xds:[job_a]
p:[ (job_a->500), (job_b->0)];xds:[job_a]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
firm; 18- (18-0); 0;
worker_1; 11- (18-7); 0;
worker_2; 12- (18-11); 5;
No
?- set_model(assign_2),
solve_wep_1(P,Y),
display_goals(vcg_payment(A,[B|_],C),[A,B,C]).
init p:[ (job_a->0), (job_b->0)];xds:[job_a]
p:[ (job_a->500), (job_b->0)];xds:[job_a]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
firm(a); 18- (18-0); 0;
firm(b); 18- (18-0); 0;
worker(1); 11- (18-7); 0;
worker(2); 12- (18-11); 5;
No
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% `agents are substitutes' condition
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% added: 3-4 Sep 2005.
% revised: 7-8 Sep 2005.
% For SI and monotone preferences (=> see next section),
% the following condition is necessary and sufficient for
% the dual solution of the primal-dual algorithm
% ( ascending auction) yields VCG payments.
%
% Def. (The `agents are substitutes' condition)
% V(N)-V(S) >= Sum_over_i_not_in_S( V(N)-V(N-[i]) )
% = Sum_over_i_not_in_S( v_i(N)-q_i ).
% Meaning: The contribution of a group is not less than
% the sum of each individual contribution out of the group.
% See Bikhchandani et al.(2002).
% model 1: direct verification
%-----------------------------------------
% however not effective except for small sized models.
:- dynamic temp_agtsbst/2.
agents_are_substitutes(coalition:S,T,R,values:([V|D],[Dv|E])):-
(var(V)->a_star( V, Y); true),
(var(Dv)->collect_individual_contributions(V, Y, Dv,Lv,Cv); true),
!,
coalition(S,[_,Sc,N]),
contribution_of_individuals_except_for_coalition(S,Sc,Dv,Cvsc),
( S=N -> (Vs=V, Ys=Y)
;
max_surplus_of_coalition( Vs, Ys, S )
),
T = (V - Vs >= Cvsc),
VData =([V|D],[Dv|E]),
D= [Vs,Cvsc,Y,Ys],
E= [Cv,Lv],
judge_agtsbst_condition_for_coalition(S,T,R, VData).
collect_individual_contributions(V,Y,Dv,Lv,Cv):-
(var(V)->a_star( V, Y); true),
findall((J,Vj =V - Vrj,Yrj),
(
coalition(Nrj,[_,[J],_N]),
max_surplus_of_coalition( Vrj, Yrj, Nrj ),
Vj is V - Vrj
),
Dv),
findall(Vj, member((_,Vj=_,_),Dv),Lv),
sum(Lv,Cv).
contribution_of_individuals_except_for_coalition(S,Sc,Dv,Vsc):-
(
( var(Dv) ; (member(D,Dv),var(D) ) )
->collect_individual_contributions(_,_,Dv,_,_)
; true
),
(var(S)->coalition(S,[_,Sc,_N]);true),
sumall(Vj,
(
member(J,Sc),
member((J,Vj=_,_),Dv)
),
Vsc).
judge_agtsbst_condition_for_coalition(S,T,R, VData):-
VData =([V,Vs,Cvsc|_],_),
T = (V - Vs >= Cvsc),
(T -> R=true ;R=false),
current_model(M),
(
clause( temp_agtsbst(M,[R,S|X]),true )
-> retract( temp_agtsbst(M,[R,S|X]) )
; true
),
assert( temp_agtsbst(M,[R,S,T,VData]) ).
% demo
%-----------------------------------------
% model: auction_1
/*
?- collect_individual_contributions(V,Y,[D1,D2,D3],Lv,Cv).
V = 16
Y = [ ([]->i), ([a]->j), ([b]->k)]
D1 = i, 0=16-16, [ ([]->i), ([a]->j), ([b]->k)]
D2 = j, 2=16-14, [ ([]->i), ([]->j), ([a, b]->k)]
D3 = k, 4=16-12, [ ([]->i), ([a, b]->j), ([]->k)]
Lv = [0, 2, 4]
Cv = 6
Yes
?- contribution_of_individuals_except_for_coalition(S,Sc,Dv,Vsc),
forall_nl_write(Dv).
i, 0=16-16, [ ([]->i), ([a]->j), ([b]->k)]
j, 2=16-14, [ ([]->i), ([]->j), ([a, b]->k)]
k, 4=16-12, [ ([]->i), ([a, b]->j), ([]->k)]
S = []
Sc = [i, j, k]
Dv = [ (i, 0=16-16, [ ([]->i), ([a]->j), ([b]->k)]),
(j, 2=16-14, [ ([]->i), ([]->j), ([a|...]->k)]),
(k, 4=16-12, [ ([]->i), ([a|...]->j), ([]->k)])]
Vsc = 6
Yes
?- display_goals( agents_are_substitutes(_:S,T,R,_),[R,S,T]).
true; []; 16-0>=6;
true; [k]; 16-14>=2;
true; [j]; 16-12>=4;
true; [j, k]; 16-16>=0;
true; [i]; 16-0>=6;
true; [i, k]; 16-14>=2;
true; [i, j]; 16-12>=4;
true; [i, j, k]; 16-16>=0;
No
?- temp_agtsbst(M,[R,S,T,([_,_,_,F,G],_)]),write([M,R,S,G]),nl,fail.
[auction_1, true, [], _G178]
[auction_1, true, [k], [ ([]->i), ([]->j), ([a, b]->k)]]
[auction_1, true, [j], [ ([]->i), ([a, b]->j), ([]->k)]]
[auction_1, true, [j, k], [ ([]->i), ([a]->j), ([b]->k)]]
[auction_1, true, [i], [ ([a, b]->i), ([]->j), ([]->k)]]
[auction_1, true, [i, k], [ ([]->i), ([]->j), ([a, b]->k)]]
[auction_1, true, [i, j], [ ([]->i), ([a, b]->j), ([]->k)]]
[auction_1, true, [i, j, k], [ ([]->i), ([a]->j), ([b]->k)]]
No
?- coalition(S),\+ agents_are_substitutes(_:S,_,_,_).
No
?-
*/
% model 2: using solve_wep_1
%-----------------------------------------
% another code for the `agents are substitutes' codition.
:- dynamic temp_asubst/2.
agents_are_substitutes_1( coalition: S,T,R,values:([V|D],[Dv|E]) ):-
( var(V) ->a_star( V, Y); true),
( var(Dv) ->collect_individual_contributions_1(V, Y, Dv,Lv,Cv); true),
!,
coalition(S,[_,Sc,N]),
contribution_of_individuals_except_for_coalition_1(S,Sc,Dv,Cvsc),
( S=N -> Vs=V, Ys=Y
; max_surplus_of_coalition_1( _, Vs, Ys, (S,Sc) )
),
T = (V - Vs >= Cvsc),
VData =([V|D],[Dv|E]),
D= [Vs,Cvsc,Y,Ys],
E= [Cv,Lv],
judge_agtsbst_condition_for_coalition(S,T,R, VData).
collect_individual_contributions_1(V,Y,Dv,Lv,Cv):-
(var(V)->a_star( V, Y); true),
check_model(M),
findall((J,Vj=V - Vrj,Yrj),
(
coalition(Nrj,[_,[J],_N]),
max_surplus_of_coalition_1(M, Vrj, Yrj, (Nrj,[J]) ),
Vj is V - Vrj
),
Dv),
findall(Vj, member((_,Vj=_,_),Dv),Lv),
sum(Lv,Cv).
check_model(M):-
current_model(M0),
clause(model(M,_,_,_,_,_),_),
( M0=M-_S ; M0=M ),
M \= auction_1_r3.
a_star_1( V,Y):-
collect_surplus_via_solve_wep_1(_P,Y,V).
max_surplus_of_coalition_1( _, 0, _, ([],_) ):-!.
max_surplus_of_coalition_1( M, V, Y, (S,Sc) ):-
check_model(M),
coalition(S,[_,Sc,_]),
S \= [],
set_model_without_coalition(Sc,M),
collect_surplus_via_solve_wep_1( _P,Y,V),
set_model(M),
!.
max_surplus_of_coalition_1( M, _, _, _ ):-
set_model(M).
collect_surplus_via_solve_wep_1( P,Y,V):-
solve_wep_1( P, Y),
sumall(U,
(
member((A->I),Y),
u(I,A,U)
),
V).
contribution_of_individuals_except_for_coalition_1(S,Sc,Dv,Vsc):-
(
( var(Dv) ; (member(D,Dv),var(D) ) )
->collect_individual_contributions_1(_,_,Dv,_,_)
; true
),
(var(S)->coalition(S,[_,Sc,_N]);true),
contribution_of_individuals_except_for_coalition(S,Sc,Dv,Vsc).
% demo
%-----------------------------------------
% model: auction_1
% a reproduction of former code.
/*
?- collect_individual_contributions_1(V,Y,[D1,D2,D3],Lv,Cv).
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item. equilibrium! equilibrium!
V = 16
Y = [ ([]->i), ([a]->j), ([b]->k)]
D1 = i, 0=16-16, [ ([]->i), ([a]->j), ([b]->k)]
D2 = j, 2=16-14, [ ([]->i), ([]->j), ([a, b]->k)]
D3 = k, 4=16-12, [ ([]->i), ([a, b]->j), ([]->k)]
Lv = [0, 2, 4]
Cv = 6
Yes
?- contribution_of_individuals_except_for_coalition_1(S,Sc,Dv,Vsc),
forall_nl_write(Dv).
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item. equilibrium! equilibrium!
i, 0=16-16, [ ([a]->j), ([b]->k)]
j, 2=16-14, [ ([]->i), ([a, b]->k)]
k, 4=16-12, [ ([]->i), ([a, b]->j)]
S = []
Sc = [i, j, k]
Dv = [ (i, 0=16-16, [ ([]->i), ([a]->j), ([b]->k)]),
(j, 2=16-14, [ ([]->i), ([]->j), ([a|...]->k)]),
(k, 4=16-12, [ ([]->i), ([a|...]->j), ([]->k)])]
Vsc = 6
Yes
?- display_goals( agents_are_substitutes(_:S,T,R,_),[R,S,T]).
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item. equilibrium! equilibrium!
true; []; 16-0>=6; equilibrium!
true; [k]; 16-14>=2; equilibrium!
true; [j]; 16-12>=4;
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
true; [j, k]; 16-16>=0; equilibrium!
true; [i]; 16-0>=6; equilibrium!
true; [i, k]; 16-14>=2; equilibrium!
true; [i, j]; 16-12>=4;
true; [i, j, k]; 16-16>=0;
No
?- temp_agtsbst(M,[R,S,T,([_,_,_,F,G],_)]),write([M,R,S,G]),nl,fail.
[auction_1, true, [], _G181]
[auction_1, true, [k], [ ([a, b]->k)]]
[auction_1, true, [j], [ ([a, b]->j)]]
[auction_1, true, [j, k], [ ([a]->j), ([b]->k)]]
[auction_1, true, [i], [ ([a, b]->i)]]
[auction_1, true, [i, k], [ ([]->i), ([a, b]->k)]]
[auction_1, true, [i, j], [ ([]->i), ([a, b]->j)]]
[auction_1, true, [i, j, k], [ ([]->i), ([a]->j), ([b]->k)]]
No
?- coalition(S),\+ agents_are_substitutes_1(_:S,_,_,_).
(...omit...)
No
?-
*/
% demo
%-----------------------------------------
% model: auction_3 (a violation.)
/*
?- set_model(auction_3),coalition(S1),
agents_are_substitutes(_:S1,T,false,_:([B|_],[_|E])).
S1 = []
T = 23-0>=27
B = 23
E = [27, [4, 10, 9, 4]]
No
?-
*/
% demo
%-----------------------------------------
% model: assign_0 with parameterized utilities.
/*
?- set_model(assign_0([repeat|X])),coalition(S),
agents_are_substitutes(_:S,T,false,_:([B|_],[_|E])).
No
?-
*/
% Caveat: It is not easy to generate negative cases.
% Experimentally using some small parameterized models
% such as assign_0 and job_matching_1.
% for larger models, checking condition per se
% would be demanding task in our code.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% preference models and analysis
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% model 1: monotonicity
%-----------------------------------------
preference_model( 'weakly monotone', Quant,Case, Def):-
Quant = forall,
Case = (agent(J),bundle(S),bundle(S1),DiffUtil),
DiffUtil = (u(J,S,U), u(J,S1,U1),DU is U1 - U),
Def = (subset(S,S1) -> DU >= 0; true).
% model 2: unit demand preference
%-----------------------------------------
preference_model( 'a unit demand', Quant,Case, Cond):-
Quant = forall,
Case = (agent(J),bundle(S),u(J,S,U),Unit),
Cond = (S =[] -> Def1 ;Def2),
Def1 = ( 0 is U),
Unit = (member(A,S), u(J,[A],U1)),
Def2 = (max(U1, Unit), 0 is U1 - U).
% model 3: additively separable preference
%-----------------------------------------
preference_model( 'additively separable', Quant,Case, Def):-
Quant = forall,
Case = (agent(J),bundle(S),u(J,S,U),Usum),
Usum = sumall(Ua,(member(A,S), u(J,[A],Ua)), U1),
Def = ( 0 is U1 - U).
% model 4: submodularity
%-----------------------------------------
% monotone SI u -> u and vt are submodular
% (Gul and Stacchetti(1999), Theorem 5)
% u(i)'s are monotone and SI => the linear relaxation yields the optimal.
% (Bikhchandani et al.(2002), Theorem 4, p.90)
preference_model( 'submodular u', Quant,Case, Def):-
Quant = forall,
Case = ( agent(J),u(J,A,Ua),u(J,B,Ub), UI),
UI= ( union(A,B,C1),sort(C1,C),intersection(A,B,D1),sort(D1,D)),
Def = ( u(J,C,Uc),u(J,D,Ud),0 >= (Uc+Ud) -(Ua+Ub)).
% demo
%-----------------------------------------
/*
?- analyze_preference(A,D,(B,C)).
A = 'weakly monotone'
D = subset([3], [2, 3])->0>=7- (4+0);true
B = no
C = agent(j), bundle([3]), bundle([2, 3]), u(j, [3], 4+0), u(j, [2, 3], 7) ;
A = 'a unit demand'
D = [2, 3]=[]->0 is 7;max(4, (member(2, [2, 3]), u(j, [2], 4))), 0 is 4-7
B = no
C = agent(j), bundle([2, 3]), u(j, [2, 3], 7), member(2, [2, 3]), u(j, [2], 4) ;
A = 'additively separable'
D = 0 is 8-7
B = no
C = agent(j), bundle([2, 3]), u(j, [2, 3], 7), sumall(_G283, (member(_G290, [2, 3]), u(j, [_G290], _G283)), 8) ;
(...)
No
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% gross substitutes (GS) condition
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Theorem (Gul and Stacchetti,1999)
% u is monotone => ( GS <=> SI <=> NC ).
% model 5: NC condition : no complementarities
%-----------------------------------------
preference_model( 'no complementarities', Quant,Case, Def):-
Quant = forall( P),
Case = ( agent(J),d(J,P,Dp),member(A,Dp),member(B,Dp),Xab),
Xab = ( asymmetric_differences(A,B,(C1,C2)),bundle(X),subset(X,C1) ),
Axy = ( subtract(A,X,W),union(W,Y,Z) ),
Def = ( bundle(Y),subset(Y,C2), Axy,member(Z, Dp) ).
% model 6: SI condition : single improvement property
%-----------------------------------------
preference_model( 'single improvement', Quant,Case, Def):-
Quant = forall( P),
Case = ( agent(J),d(J,P,Dp),bundle(A), \+ member(A,Dp),vt(J,A,P,Va)),
Improved = ( bundle(B),vt(J,B,P,Vb),Vb > Va ),
Def = ( Improved, no_more_single_difference(A,B) ).
% model 8 : GS condition
%-----------------------------------------
% It would consume time to complete.
preference_model( 'gross substitutes', Quant,Case, Def):-
Quant = forall( P),
Case = ( agent(J),d(J,P,Dp),member(A,Dp),NewPrice, d(J, Q, Dq) ),
NewPrice = ( price_increment_other_than(S, P->Q) ),
Def = ( member(B, Dq), intersection(S,A,S1),subset(S1, B) ).
no_more_single_difference(A,B):-
asymmetric_differences(A,B,(C1,C2)),
length(C1,N1),
N1=<1,
length(C2,N2),
N2=<1.
% Addendum.
% a test of supermodularity for the requirement function k given a price vector.
/*
?- agent(J),bundle(A),bundle(B),subset(A,B),
k(J,A,P,Ka),k(J,B,P,Kb),intersection(A,B,C),
union(A,B,D),k(J,C,P,Kc),k(J,D,P,Kd),
Ka+Kb > Kc+Kd.
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% preference analysis tools
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% background parameter for preference analysis
%-----------------------------------------
% option_for_analyze_preferences( OPT).
% If OPT =given_price, then pp(P), the current price vector,
% otherwise generate_price_vector(P), create new vector.
% (ch_apo/1 ==> MMT section)
% analyzer 1 : Quantifier= forall
%-----------------------------------------
analyze_preference( Condition, Def, Result):-
preference_model( Condition, forall, Case, Def),
(
(Case, \+ Def)
-> Result=(no,Case)
; Result=(yes,no_violation)
).
analyze_preference( (Condition,OPT:P), Def, Result):-
preference_model( Condition, forall(P), Case, Def),
option_for_analyze_preferences( OPT),
( OPT =given_price -> pp(P) ; generate_price_vector(P) ),
(
(Case, \+ Def)
-> Result=(no,Case)
; Result=(yes,no_violation)
).
% analyzer 2 : Quantifier= exisit
%-----------------------------------------
analyze_preference( Name, Def, Result):-
preference_model( Name, exisit, Case, Def),
(
(Case, Def)
-> Result=(yes,Case)
; Result=(no,no_support)
).
analyze_preference( (Condition,OPT:P), Def, Result):-
preference_model( Condition, exisit(P), Case, Def),
option_for_analyze_preferences( OPT),
( OPT =given_price -> pp(P) ; generate_price_vector(P) ),
(
(Case, Def)
-> Result=(yes,Case)
; Result=(no,no_support)
).
% analyzer 3: Case based
%-----------------------------------------
analyze_case_of_preference( Condition, Def, Result):-
preference_model( Condition, forall, Case, Def),
Case,
(Def
-> Result=(yes,Case)
; Result=(no,Case)
).
analyze_case_of_preference( (Condition,OPT:P), Def, Result):-
preference_model( Condition, forall(P), Case, Def),
option_for_analyze_preferences( OPT),
( OPT =given_price -> pp(P) ; generate_price_vector(P) ),
Case,
(Def
-> Result=(yes,Case)
; Result=(no,Case)
).
% demo
%-----------------------------------------
/*
% model: defalt (auction_1)
?- set_0_prices.
Yes
?- analyze_preference(A,D,(B,C)).
(...)
A = 'submodular u'
D = u(_G269, _G296, _G313), u(_G269, _G306, _G320), 0>=_G313+_G320- (_G276+_G283)
B = yes
C = no_violation ;
A = 'no complementarities', given_price:[ (a->1000), (b->1000)]
D = bundle(_G326), subset(_G326, _G308), (subtract(_G291, _G313, _G323), union(_G323, _G326, _G327)), member(_G327, _G286)
B = yes
C = no_violation ;
A = 'single improvement', given_price:[ (a->1000), (b->1000)]
D = (bundle(_G309), vt(_G279, _G309, [ (a->1000), (b->1000)], _G317), _G317>_G304), no_more_single_difference(_G291, _G309)
B = yes
C = no_violation ;
A = 'gross substitutes', given_price:[ (a->1000), (b->1000)]
D = member(_G310, _G299), intersection(_G301, _G291, _G318), subset(_G318, _G310)
B = yes
C = no_violation ;
No
?- A='single improvement',analyze_case_of_preference(A,(I,D),(B,C)).
A = 'single improvement'
O = given_price:[ (a->1000), (b->1000)]
I = bundle([]), vt(i, [], [ (a->1000), (b->1000)], 2000), 2000>1000
D = no_more_single_difference([b], [])
B = yes
C = agent(i), d(i, [ (a->1000), (b->1000)], [[]]), bundle([b]), \+member([b], [[]]), vt(i, [b], [ (a->1000), (b->1000)], 1000) ;
(...)
A = 'single improvement'
O = given_price:[ (a->1000), (b->1000)]
I = bundle([b]), vt(k, [b], [ (a->1000), (b->1000)], -200), -200> -600
D = no_more_single_difference([a, b], [b])
B = yes
C = agent(k), d(k, [ (a->1000), (b->1000)], [[]]), bundle([a, b]), \+member([a, b], [[]]), vt(k, [a, b], [ (a->1000), (b->1000)], -600) ;
No
?-
% model: assign_1 (bilateral, unit demand)
?- set_model(assign_1).
Yes
?- generate_price_vector(P),
A='single improvement',\+ analyze_preference((A,O),D,(B,C)).
No
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% cooperative game modeling
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- dynamic coop/2.
% charactristic functions ( transferable utility assumed )
%-----------------------------------------
% corresponding model: assign_1
% job assignment problem of Leonard(1983)
coop(assign_1,[
v([firm])=0,
v([worker_1])=0,
v([worker_2])=0,
v([worker_1,worker_2])=0,
v([firm,worker_2])=11,
v([firm,worker_1])=12,
v([firm,worker_1,worker_2])=18]
).
% NOTE: In above case, the core - wep is empty.
% In fact, a vector (5,7,6) with q(=p)=(5,0) is the incentive compatible,
% and is minimal equilibrium which we have already verified.
% As Ma(1998) proved, by adding dummy sellers (firms) resolve this.
% Similar for the following example provided by Ma.
coop(assign_2,[
v([firm(a)])=0,
v([firm(b)])=0,
v([worker(1)])=0,
v([worker(2)])=0,
v([worker(1),worker(2)])=0,
v([firm(a),firm(b)])=0,
v([firm(a),worker(2)])=11,
v([firm(a),worker(1)])=12,
v([firm(b),worker(2)])=4,
v([firm(b),worker(1)])=7,
v([firm(a),worker(1),worker(2)])=12,
v([firm(b),worker(1),worker(2)])=7,
v([firm(a),firm(b),worker(1)])=12,
v([firm(a),firm(b),worker(2)])=11,
v([firm(a),firm(b),worker(1),worker(2)])=18]
).
% no-firm model (Ma(1998), Kelso and Crawford(1982))
coop(job_matching_1(LE),[
v([i])=0,
v([j])=0,
v([k])=0,
v([j,k])=0,
v([i,j])=9,
v([i,k])=9,
v([i,j,k])=11+E3]
):-
LE=[E,E1,E2],
% alt % model(job_matching_1(LE),_,_,_,_),
current_model(job_matching_1(LE)),
constraint_of_perturb(E3,E,E1,E2).
coop(job_matching_2(LE),[
v([i1])=0,
v([i2])=0,
v([i3])=0,
v([j])=0,
v([k])=0,
v([i1,i2])=0,
v([i1,i3])=0,
v([i2,i3])=0,
v([j,k])=0,
v([i1,j])=4,
v([i1,k])=4+E2,
v([i2,j])=4,
v([i2,k])=4,
v([i3,j])=4+E1,
v([i3,k])=4,
v([i1,i2,j])=7+E,
v([i1,i2,k])=7,
v([i1,i3,j])=7,
v([i1,i3,k])=7,
v([i2,i3,j])=7,
v([i2,i3,k])=7+E,
v([i1,i2,i3,j])=9,
v([i1,i2,i3,k])=9,
v([i1,i2,i3,j,k])=11+E3]
):-
LE=[E,E1,E2],
current_model(job_matching_2(LE)),
constraint_of_perturb(E3,E,E1,E2).
constraint_of_perturb(E3,E,E1,E2):-
max_of(E3,[E,E1,E2]).
% demo
%-----------------------------------------
/*
constraint_of_perturb(E,E,E1,E2):-
0 =< E1,
E1 =< E,
0 =< E2,
E2 =< E.
constraint_of_perturb(E1,E,E1,E2):-
E2 =< E1,
E =< E1.
constraint_of_perturb(E2,E,E1,E2):-
E1 =< E2,
E =< E2.
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% game model analysis
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% you can compute discrete core of the game,
% optionally, by using coop.pl(Feb 2003).
% :- ['gt/coop.pl'].
% I'm afraid you have not copied one.
% Please include manually.
% Then reload this program.
% ?- [price].
%%%%
% :- dynamic game/4.
% game infomation (by coop/2) which is pegged at the current model.
game(G,GF,GP,PC):-
current_model( G),
GF =form(characteristic),
GP =players(NL),
PC =coalitions(CL),
coop(G,CValues),
setof(C, V^member(v(C)=V,CValues), CL),
flatten(CL, NL1),
sort(NL1, NL).
% the characteristic function
game(G,value,Coalition,V):-
coop(G,CValues),
member(v(Coalition)=V1, CValues),
% alt. % V is V1.
adjust_with_precision(Scale),
V is Scale * V1.
adjust_with_precision(Scale):-
precision(P),
Scale is integer(1 /P).
display_game(M):-
(var(M)->current_model(M);true),
model(M,Agents,Items,_,_),
nl,write('****** game for the model *******'),
nl,write(M),
forall(member(P,[Agents,Items]),(nl,write(P))),
coop(M,CFs),
nl,write('characteristic functions:'),
forall(member(V,CFs),(nl,tab(2),write(V))).
display_core(G):-
%set_game(G),
display_goals(
core(G,players(N),payoff(X)),
[G,N,X]
).
% demo
%-----------------------------------------
% model: assign_2
/*
?- set_model(assign_2).
Yes
?- change_precision(1).
Yes
?- core(game(assign_2),players(N),payoff(U)).
N = [firm(a), firm(b), worker(1), worker(2)]
U = [11, 6, 1, 0] ;
N = [firm(a), firm(b), worker(1), worker(2)]
U = [11, 5, 2, 0]
Yes
?- min(Z,(
core(game(assign_2),players(N),payoff(U)),
U=[A,B,_,_], Z is A+B)).
Z = 5
N = [firm(a), firm(b), worker(1), worker(2)]
U = [5, 0, 7, 6]
A = 5
B = 0 ;
No
?-
*/
% demo
%-----------------------------------------
% model: assign_1
/*
?- core(G,players(N),payoff(X)),nl,write(G:X),fail.
game(assign_2):[11, 6, 1, 0]
game(assign_2):[11, 5, 2, 0]
game(assign_2):[11, 4, 3, 0]
game(assign_2):[10, 5, 2, 1]
game(assign_2):[10, 4, 3, 1]
game(assign_2):[10, 3, 4, 1]
game(assign_2):[9, 4, 3, 2]
game(assign_2):[9, 3, 4, 2]
game(assign_2):[9, 2, 5, 2]
game(assign_2):[8, 3, 4, 3]
game(assign_2):[8, 2, 5, 3]
game(assign_2):[8, 1, 6, 3]
game(assign_2):[7, 2, 5, 4]
game(assign_2):[7, 1, 6, 4]
game(assign_2):[7, 0, 7, 4]
game(assign_2):[6, 1, 6, 5]
game(assign_2):[6, 0, 7, 5]
game(assign_2):[5, 0, 7, 6]
No
?- min(Z,(
core(G,players(N),payoff(V)),
V=[Va,Vb|_],
Z is Va + Vb)).
Z = 5
G = game(assign_2)
N = [firm(a), firm(b), worker(1), worker(2)]
V = [5, 0, 7, 6]
Va = 5
Vb = 0
Yes
?-
*/
% demo
%-----------------------------------------
% model: job_matching_1
% This game is a reformulation by Ma(1998) of
% one-sided job market game in Kelso and Crawford(1982)
% there exists a gap between the core allocations and
% the competitive equilibria.
% Here, we aloso can observe the gap between
% incentive compatible pricing (VCG payments)
% and the equilibrium.
% Ma(1998) proved that the former gap vanishes by adding
% dummy sellers with 0 utilities for each item.
/*
% without adjusting the precision (i.e., precision(1)).
% (coop.pl could not handle fraction.)
?- E=[0,0,0],set_model(job_matching_2(E)).
Yes
?- change_precision(1).
Yes
?- core(G,players(N),payoff(X)),nl,write(G:N:X),fail.
game(job_matching_1([0, 0, 0])):[i, j, k]:[11, 0, 0]
game(job_matching_1([0, 0, 0])):[i, j, k]:[10, 1, 0]
game(job_matching_1([0, 0, 0])):[i, j, k]:[9, 2, 0]
game(job_matching_1([0, 0, 0])):[i, j, k]:[10, 0, 1]
game(job_matching_1([0, 0, 0])):[i, j, k]:[9, 1, 1]
game(job_matching_1([0, 0, 0])):[i, j, k]:[8, 2, 1]
game(job_matching_1([0, 0, 0])):[i, j, k]:[9, 0, 2]
game(job_matching_1([0, 0, 0])):[i, j, k]:[8, 1, 2]
game(job_matching_1([0, 0, 0])):[i, j, k]:[7, 2, 2]
No
?- min(Z,(
core(game(job_matching_1(E)),players(N),payoff(U)),
U=[A,B,_], Z is A+B)).
Z = 9
E = [0, 0, 0]
N = [i, j, k]
U = [7, 2, 2]
A = 7
B = 2
Yes
?- vcg_payment(A,_,C),nl,write(A:C),fail.
i:0:11- (11-0)
j:2:9- (11-4)
k:5:9- (11- (7+0))
No
*/
% demo
%-----------------------------------------
% model: job_matching_2
/*
?- set_model(job_matching_2(E)), solve_wep_1(P,Y).
init p:[ (1->0), (2->0), (3->0)];xds:[1, 2, 3]
p:[ (1->300), (2->300), (3->300)];xds:[1, 2, 3]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
E = [0, 0, 0]
P = [ (1->300), (2->300), (3->300)]
Y = [ ([]->i1), ([]->i2), ([]->i3), ([2, 3]->j), ([1]->k)]
Yes
?- core(game(job_matching_2(E)),players(N),payoff(U)).
E = [0, 0, 0]
N = [i1, i2, i3, j, k]
U = [3, 3, 3, 1, 1] ;
No
?- vcg_payment(A,[B|_],C),nl,write(A:C:B),fail.
i1:0:11- (11-0)
i2:0:11- (11-0)
i3:0:11- (11-0)
j:2:9- (11-4)
k:5:9- (11- (7+0))
No
?-
*/
% demo
%-----------------------------------------
% model: job_matching_1
% a test of the predicates loaded from coop.pl
% after adjustment of the precision( 0.25).
% Let's verify that [v(N)-2,1,1] is always core allocation
% in job_matching_1([E,E1,E2]),
% a claim by Ma(1998).
/*
?- abolish(precision/1),assert(precision(0.01)).
Yes
?- set_model(G),
game(G,value,[i,j,k],VN),A is VN -200,
core(game(G),_,payoff([A,100,100])).
G = job_matching_1([0, 0, 0])
VN = 1100
A = 900 ;
start generating positive numbers:1:0.01
G = job_matching_1([0, 0, 0])
VN = 1100
A = 900 ;
G = job_matching_1([0.01, 0, 0])
VN = 1101
A = 901
Yes
?- abolish(precision/1),assert(precision(0.25)).
Yes
?- set_model(G),
game(G,value,[i,j,k],VN),A is VN -8,
\+ core(game(G),_,payoff([A,4,4])).
No
?-
% Notice (*): Prolog system tend to check the exisitence of clauses
% before processing queries.
% You may have a need to avoid `undifined procedure'.
?- forall(set_model(G),true),
max(B,(core(game(G),_,payoff(X)),X=[A,B,C])).
B = 5
G = job_matching_1([0, 0, 3])
X = [4, 5, 5]
A = 4
C = 5
Yes
?- forall(set_model(G),true),
tell_goal('core_a.txt',forall(set_model(G),
display_goals(
max(B,(core(game(G),_,payoff(X)),X=[A,B,C])),
[G,X,B]
)
)).
?- change_precision(1),forall(set_model(G),true),
forall(set_model(G),
display_goals(
(
max(B,
(core(game(G),_,payoff(X)), X=[A,B,C])
),
!
),
[G,X,B]
)
).
start generating positive numbers:1:1start generating positive numbers:3:1
job_matching_1([0, 0, 0]); [7, 2, 2]; 2;
job_matching_1([1, 0, 0]); [6, 3, 3]; 3;
job_matching_1([0, 0, 1]); [6, 3, 3]; 3;
job_matching_1([1, 0, 1]); [6, 3, 3]; 3;
job_matching_1([0, 0, 2]); [5, 4, 4]; 4;
job_matching_1([1, 0, 2]); [5, 4, 4]; 4;
job_matching_1([0, 0, 3]); [4, 5, 5]; 5;
job_matching_1([1, 0, 3]); [4, 5, 5]; 5;
job_matching_1([0, 1, 0]); [6, 3, 3]; 3;
job_matching_1([1, 1, 0]); [6, 3, 3]; 3;
job_matching_1([0, 1, 1]); [6, 3, 3]; 3;
job_matching_1([1, 1, 1]); [6, 3, 3]; 3;
job_matching_1([0, 1, 2]); [5, 4, 4]; 4;
job_matching_1([1, 1, 2]); [5, 4, 4]; 4;
job_matching_1([0, 1, 3]); [4, 5, 5]; 5;
job_matching_1([1, 1, 3]); [4, 5, 5]; 5;
job_matching_1([0, 2, 0]); [5, 4, 4]; 4;
job_matching_1([1, 2, 0]); [5, 4, 4]; 4;
job_matching_1([0, 2, 1]); [5, 4, 4]; 4;
job_matching_1([1, 2, 1]); [5, 4, 4]; 4;
job_matching_1([0, 2, 2]); [5, 4, 4]; 4;
job_matching_1([1, 2, 2]); [5, 4, 4]; 4;
job_matching_1([0, 2, 3]); [4, 5, 5]; 5;
job_matching_1([1, 2, 3]); [4, 5, 5]; 5;
job_matching_1([0, 3, 0]); [4, 5, 5]; 5;
job_matching_1([1, 3, 0]); [4, 5, 5]; 5;
job_matching_1([0, 3, 1]); [4, 5, 5]; 5;
job_matching_1([1, 3, 1]); [4, 5, 5]; 5;
job_matching_1([0, 3, 2]); [4, 5, 5]; 5;
job_matching_1([1, 3, 2]); [4, 5, 5]; 5;
job_matching_1([0, 3, 3]); [4, 5, 5]; 5;
job_matching_1([1, 3, 3]); [4, 5, 5]; 5;
G = _G157
B = _G175
X = _G166
A = _G172
C = _G178
Yes
?- change_precision(1),forall(set_model(G),true),
forall(set_model(G),
display_goals(
(
max(A,
(core(game(G),_,payoff(X)), X=[A,B,C])
),
!
),
[G,X,B]
)
).
job_matching_1([0, 0, 0]); [11, 0, 0]; 0;
job_matching_1([1, 0, 0]); [12, 0, 0]; 0;
job_matching_1([0, 0, 1]); [12, 0, 0]; 0;
job_matching_1([1, 0, 1]); [12, 0, 0]; 0;
job_matching_1([0, 0, 2]); [13, 0, 0]; 0;
job_matching_1([1, 0, 2]); [13, 0, 0]; 0;
job_matching_1([0, 0, 3]); [14, 0, 0]; 0;
job_matching_1([1, 0, 3]); [14, 0, 0]; 0;
job_matching_1([0, 1, 0]); [12, 0, 0]; 0;
job_matching_1([1, 1, 0]); [12, 0, 0]; 0;
job_matching_1([0, 1, 1]); [12, 0, 0]; 0;
job_matching_1([1, 1, 1]); [12, 0, 0]; 0;
job_matching_1([0, 1, 2]); [13, 0, 0]; 0;
job_matching_1([1, 1, 2]); [13, 0, 0]; 0;
job_matching_1([0, 1, 3]); [14, 0, 0]; 0;
job_matching_1([1, 1, 3]); [14, 0, 0]; 0;
job_matching_1([0, 2, 0]); [13, 0, 0]; 0;
job_matching_1([1, 2, 0]); [13, 0, 0]; 0;
job_matching_1([0, 2, 1]); [13, 0, 0]; 0;
job_matching_1([1, 2, 1]); [13, 0, 0]; 0;
job_matching_1([0, 2, 2]); [13, 0, 0]; 0;
job_matching_1([1, 2, 2]); [13, 0, 0]; 0;
job_matching_1([0, 2, 3]); [14, 0, 0]; 0;
job_matching_1([1, 2, 3]); [14, 0, 0]; 0;
job_matching_1([0, 3, 0]); [14, 0, 0]; 0;
job_matching_1([1, 3, 0]); [14, 0, 0]; 0;
job_matching_1([0, 3, 1]); [14, 0, 0]; 0;
job_matching_1([1, 3, 1]); [14, 0, 0]; 0;
job_matching_1([0, 3, 2]); [14, 0, 0]; 0;
job_matching_1([1, 3, 2]); [14, 0, 0]; 0;
job_matching_1([0, 3, 3]); [14, 0, 0]; 0;
job_matching_1([1, 3, 3]); [14, 0, 0]; 0;
G = _G157
A = _G172
X = _G166
B = _G175
C = _G178
Yes
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% extended game modeling
% with soio-psychological motives
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% added: 19-25 Sep 2005
% About this section of modeling with utility or
% disutility of co-workers, see Ma(2001).
%-----------------------------------------
% Part I. Utility Function With Coworkers
%-----------------------------------------
% utility or disutility of co-workers
%-----------------------------------------
% Zero settings of u_cw/5, the modeling without
% coworkers effect on utility function
% is available by ch_ucw/1 (=>MMT section)
:- dynamic u_cw/6.
% u_cw/5 specified for model job_matching_2(LE),
% and the cases are stored as u_cw/6.
% case 1
% a case of empty core, Example 1 in Ma(2001).
u_cw( case_1, job_matching_2(_), i1, [i1,i2], j, 1).
u_cw( case_1, job_matching_2(_), i2, [i2,i3], k, 1).
% case 2
% a case of nonempty core, but the core equivalence fails,
% Example 7 in Ma(2001).
u_cw( case_2, job_matching_2(_), i1, [i1,i2], j, 0.3).
u_cw( case_2, job_matching_2(_), i2, [i1,i2], j, 0.2).
u_cw( case_2, job_matching_2(_), i2, [i2,i3], k, 0.3).
u_cw( case_2, job_matching_2(_), i3, [i2,i3], k, 0.2).
% the default value is set to zero.
u_cw( M, J, C, I, U):-
case_for_u_cw( Case, on),
u_cw( Case, M, J, C, I, U).
u_cw( M, J, C, I, 0):-
u_cw_is_not_specified_for( M, J, C, I).
% u_cw/4 (without explicit model term)
u_cw( Worker, Coworkers, Firm, Utility):-
current_model( M),
u_cw( M, Worker, Coworkers, Firm, Utility).
% case switcher for u_cw
%-----------------------------------------
% case_for_u_cw/2 => MMT
% workers and firms
%-----------------------------------------
% workers and firms (without explicit model term )
worker( J):- current_model(M), worker( M, J).
firm( I):- current_model(M), firm( M, I).
% workers in the model
worker( job_matching_2(_), i1). % <-- item( 1)
worker( job_matching_2(_), i2). % <-- item( 2)
worker( job_matching_2(_), i3). % <-- item( 3)
% the exceptional case is left to refer below.
worker( M, J):-
worker_if_not_defined_for_model(M, J).
% firms in the model
firm( job_matching_2(_), j).
firm( job_matching_2(_), k).
firm( M, J):-
firm_if_not_defined_for_model(M, J).
% possible colleagues
%-----------------------------------------
is_possible_colleagues_of( Worker, Coworkers):-
find_subset( I, worker(I), _, Coworkers),
member( Worker, Coworkers).
% rules for default or exception
%-----------------------------------------
% utility or disutility in other models
u_cw_is_not_specified_for( M, Worker, Coworkers, Firm):-
current_model( M),
is_possible_colleagues_of( Worker, Coworkers),
firm( Firm),
\+ clause(
u_cw( M, Worker, Coworkers, Firm, _),
true
).
% workers and firms in other models
% default worker := dummy seller.
worker_if_not_defined_for_model(M, J):-
current_model(M),
\+ clause( worker(M, _), true),
owner_of_unsold_items( J).
firm_if_not_defined_for_model(M, J):-
current_model(M),
\+ clause( firm(M, _), true),
owner_of_unsold_items( O),
agent( J),
J \= O.
% aggregated utility of (co-)workers at a firm
%-----------------------------------------
total_effect_of_coworkers_at_firm(Firm,Coworkers,Ucw):-
firm( Firm),
setof(U,
Worker^(
is_possible_colleagues_of( Worker, Coworkers),
u_cw( Worker, Coworkers, Firm, U)
),
Lucw),
sum(Lucw, Ucw).
% demo
%-----------------------------------------
/*
?- display_goals(total_effect_of_coworkers_at_firm(_,_,_)).
total_effect_of_coworkers_at_firm(j, [i3], 0)
total_effect_of_coworkers_at_firm(j, [i2], 0)
total_effect_of_coworkers_at_firm(j, [i2, i3], 0)
total_effect_of_coworkers_at_firm(j, [i1], 0)
total_effect_of_coworkers_at_firm(j, [i1, i3], 0)
total_effect_of_coworkers_at_firm(j, [i1, i2], 1)
total_effect_of_coworkers_at_firm(j, [i1, i2, i3], 0)
total_effect_of_coworkers_at_firm(k, [i3], 0)
total_effect_of_coworkers_at_firm(k, [i2], 0)
total_effect_of_coworkers_at_firm(k, [i2, i3], 1)
total_effect_of_coworkers_at_firm(k, [i1], 0)
total_effect_of_coworkers_at_firm(k, [i1, i3], 0)
total_effect_of_coworkers_at_firm(k, [i1, i2], 0)
total_effect_of_coworkers_at_firm(k, [i1, i2, i3], 0)
Yes
?-
*/
% worker-item table
%-----------------------------------------
item_worker_table( job_matching_2(_), 1, i1).
item_worker_table( job_matching_2(_), 2, i2).
item_worker_table( job_matching_2(_), 3, i3).
item_worker_table( Model, Item, Owner):-
current_model( Model),
\+ clause( item_worker_table( Model,_,_),true),
owner_of_unsold_items( Owner),
!,
item( Item).
item_worker_table( Item, Owner):-
current_model( Model),
item_worker_table( Model, Item, Owner).
% items-workers mapping
%-----------------------------------------
% Items <=> Coworkers (initial belongings)
% case 1: Items -> Workers
items_workers_map( Items, '->', Workers):-
\+ var( Items),
bundle( Items),
% (var( Workers) ; \+ var( Workers)),
items_workers_map_0( Items, Workers0),
sort( Workers0, Workers).
% case 2: Items <- Workers
items_workers_map( Items, '<-', Workers):-
var( Items),
\+ var( Workers),
forall( member( Y, Workers), worker(Y)),
findall(X,
(
member(Y, Workers),
item_worker_table( X, Y)
),
Items).
items_workers_map_0( [], []).
items_workers_map_0( [X|Items], [Y|Workers]):-
items_workers_map_0( Items, Workers),
item_worker_table( X, Y).
% firms-workers coalition and the items
%-----------------------------------------
% 21 Sep 2005 19:18 pm
items_for_coalition( Model, T, Items):-
(var(T)->coalition( T);true),
(var(Model)->current_model( Model);true),
findall( Item,
(
member( Worker, T ),
item_worker_table( Model,Item, Worker)
),
Items).
workers_for_coalition( T, Items, Workers):-
current_model( Model),
items_for_coalition( Model, T, Items),
% bidirection
items_workers_map( Items, _, Workers).
% firms-workers coalition and
%-----------------------------------------
% firms-workers coalition
firms_workers_coalition( T, Firms,Workers,Items):-
workers_for_coalition( T, Items, Workers),
subtract( T, Workers, Firms).
% demo
%-----------------------------------------
/*
?- set_model(job_matching_1([0,0,0])).
Yes
?- display_goals((
firms_workers_coalition( T, Fc,Wc,Ic)),
[T;Fc;Wc;Ic]).
[];[];[];[];
[k];[k];[];[];
[j];[j];[];[];
[j, k];[j, k];[];[];
[i];[];[i];[1, 2, 3];
[i, k];[k];[i];[1, 2, 3];
[i, j];[j];[i];[1, 2, 3];
[i, j, k];[j, k];[i];[1, 2, 3];
No
?-
*/
% feasible allocations in firms-workers coalition
%-----------------------------------------
% Firstly, assign a new owner (a firm or a worker)
% for each item (worker) in the coalition.
% Then, embed the partial-plan into a full allocation.
feasible_allocation_in_f_w_coalition( T,(F,W,O),Y):-
firms_workers_coalition( T, F,W,O),
feasible_allocation_0( item,T,O,X),
transform_into_allocation( X, Y).
% showing just non-empty cells.
feasible_allocation_in_f_w_coalition_1( T,(F,W,O),Ya):-
feasible_allocation_in_f_w_coalition( T,(F,W,O),Y),
nonempty_assignments( Y ->Ya).
% demo
%-----------------------------------------
/*
?- set_model( job_matching_1([0, 0, 0]) ).
Yes
?- display_goals(
feasible_allocation_in_f_w_coalition_1([i,j,k],(F,W,I),Y),
[F;W;Y]).
[j, k];[i];[ ([1, 2, 3]->i)];
[j, k];[i];[ ([2, 3]->i), ([1]->j)];
[j, k];[i];[ ([2, 3]->i), ([1]->k)];
[j, k];[i];[ ([1, 3]->i), ([2]->j)];
[j, k];[i];[ ([3]->i), ([1, 2]->j)];
[j, k];[i];[ ([3]->i), ([2]->j), ([1]->k)];
[j, k];[i];[ ([1, 3]->i), ([2]->k)];
[j, k];[i];[ ([3]->i), ([1]->j), ([2]->k)];
[j, k];[i];[ ([3]->i), ([1, 2]->k)];
[j, k];[i];[ ([1, 2]->i), ([3]->j)];
[j, k];[i];[ ([2]->i), ([1, 3]->j)];
[j, k];[i];[ ([2]->i), ([3]->j), ([1]->k)];
[j, k];[i];[ ([1]->i), ([2, 3]->j)];
[j, k];[i];[ ([1, 2, 3]->j)];
[j, k];[i];[ ([2, 3]->j), ([1]->k)];
[j, k];[i];[ ([1]->i), ([3]->j), ([2]->k)];
[j, k];[i];[ ([1, 3]->j), ([2]->k)];
[j, k];[i];[ ([3]->j), ([1, 2]->k)];
[j, k];[i];[ ([1, 2]->i), ([3]->k)];
[j, k];[i];[ ([2]->i), ([1]->j), ([3]->k)];
[j, k];[i];[ ([2]->i), ([1, 3]->k)];
[j, k];[i];[ ([1]->i), ([2]->j), ([3]->k)];
[j, k];[i];[ ([1, 2]->j), ([3]->k)];
[j, k];[i];[ ([2]->j), ([1, 3]->k)];
[j, k];[i];[ ([1]->i), ([2, 3]->k)];
[j, k];[i];[ ([1]->j), ([2, 3]->k)];
[j, k];[i];[ ([1, 2, 3]->k)];
No
?- set_model(job_matching_2([0,0,0])).
Yes
?- display_goals(
feasible_allocation_in_f_w_coalition_1(C,(F,[i1,i2],I),Y),
[C;Y]).
[i1, i2];[ ([1, 2]->i1)];
[i1, i2];[ ([2]->i1), ([1]->i2)];
[i1, i2];[ ([1]->i1), ([2]->i2)];
[i1, i2];[ ([1, 2]->i2)];
[i1, i2, k];[ ([1, 2]->i1)];
[i1, i2, k];[ ([2]->i1), ([1]->i2)];
[i1, i2, k];[ ([2]->i1), ([1]->k)];
[i1, i2, k];[ ([1]->i1), ([2]->i2)];
[i1, i2, k];[ ([1, 2]->i2)];
[i1, i2, k];[ ([2]->i2), ([1]->k)];
[i1, i2, k];[ ([1]->i1), ([2]->k)];
[i1, i2, k];[ ([1]->i2), ([2]->k)];
[i1, i2, k];[ ([1, 2]->k)];
[i1, i2, j];[ ([1, 2]->i1)];
[i1, i2, j];[ ([2]->i1), ([1]->i2)];
[i1, i2, j];[ ([2]->i1), ([1]->j)];
[i1, i2, j];[ ([1]->i1), ([2]->i2)];
[i1, i2, j];[ ([1, 2]->i2)];
[i1, i2, j];[ ([2]->i2), ([1]->j)];
[i1, i2, j];[ ([1]->i1), ([2]->j)];
[i1, i2, j];[ ([1]->i2), ([2]->j)];
[i1, i2, j];[ ([1, 2]->j)];
[i1, i2, j, k];[ ([1, 2]->i1)];
[i1, i2, j, k];[ ([2]->i1), ([1]->i2)];
[i1, i2, j, k];[ ([2]->i1), ([1]->j)];
[i1, i2, j, k];[ ([2]->i1), ([1]->k)];
[i1, i2, j, k];[ ([1]->i1), ([2]->i2)];
[i1, i2, j, k];[ ([1, 2]->i2)];
[i1, i2, j, k];[ ([2]->i2), ([1]->j)];
[i1, i2, j, k];[ ([2]->i2), ([1]->k)];
[i1, i2, j, k];[ ([1]->i1), ([2]->j)];
[i1, i2, j, k];[ ([1]->i2), ([2]->j)];
[i1, i2, j, k];[ ([1, 2]->j)];
[i1, i2, j, k];[ ([2]->j), ([1]->k)];
[i1, i2, j, k];[ ([1]->i1), ([2]->k)];
[i1, i2, j, k];[ ([1]->i2), ([2]->k)];
[i1, i2, j, k];[ ([1]->j), ([2]->k)];
[i1, i2, j, k];[ ([1, 2]->k)];
No
?-
*/
%-----------------------------------------
% Part II. The Products of F-W Coalition
%-----------------------------------------
% production of a firm with co-workers effect.
%-----------------------------------------
% New production function
% u_f'(i; Si) = u_f(i; Si)
% + Sum_over_coworkers( u_w( j, Si; i)).
% The product of a firm-workers coalition
% is the sum of its product and utility
% or disutility generated
% in the workplace when it hires a group of workers.
% (Ma(2001) p.98)
% This transformation does not change the coalitional
% form game.
product_of_firm_workers_coalition( Firm,Coworkers,Items,Qc+Uc,Vc):-
total_effect_of_coworkers_at_firm( Firm, Coworkers, Uc),
items_workers_map( Items, _,Coworkers ),
u( Firm, Items, Qc),
Vc is Qc + Uc.
% demo
%-----------------------------------------
/*
?- set_model( job_matching_1([0, 0, 0]) ).
Yes
?- display_goals(
product_of_firm_workers_coalition(Firm,Coworkers,Items,Qc+Uc,Vc),
[Vc=Qc+Uc:Firm-Coworkers:Items]).
9=9+0:j-[i]:[1, 2, 3];
9=9+0:k-[i]:[1, 2, 3];
No
?- display_goals(( bundle( Items),
product_of_firm_workers_coalition(Firm,Coworkers,Items,Qc+Uc,Vc)
),[Vc=Qc+Uc:Firm-Coworkers:Items]).
4=4+0+0:j-[i]:[3];
4=4+0:k-[i]:[3];
4=4+0:j-[i]:[2];
4=4+0:k-[i]:[2];
7=7+0:j-[i]:[2, 3];
7=7+0+0:k-[i]:[2, 3];
4=4+0:j-[i]:[1];
4=4+0+0:k-[i]:[1];
7=7+0:j-[i]:[1, 3];
7=7+0:k-[i]:[1, 3];
7=7+0+0:j-[i]:[1, 2];
7=7+0:k-[i]:[1, 2];
9=9+0:j-[i]:[1, 2, 3];
9=9+0:k-[i]:[1, 2, 3];
No
?- set_model( job_matching_2([0, 0, 0]) ).
Yes
?- display_goals(del(job_matching_2([0,0,0])).
product_of_firm_workers_coalition(Firm,Coworkers,Items,Qc+Uc,Vc),
[Vc=Qc+Uc:Firm-Coworkers:Items]).
-4=4+0+0:j-[i3]:[3];
4=4+0:j-[i2]:[2];
7=7+0:j-[i2, i3]:[2, 3];
4=4+0:j-[i1]:[1];
7=7+0:j-[i1, i3]:[1, 3];
8=7+0+1:j-[i1, i2]:[1, 2];
9=9+0:j-[i1, i2, i3]:[1, 2, 3];
4=4+0:k-[i3]:[3];
4=4+0:k-[i2]:[2];
8=7+0+1:k-[i2, i3]:[2, 3];
4=4+0+0:k-[i1]:[1];
7=7+0:k-[i1, i3]:[1, 3];
7=7+0:k-[i1, i2]:[1, 2];
9=9+0:k-[i1, i2, i3]:[1, 2, 3];
No
?-
*/
% aggregated production function for firms-workers coalition.
%-----------------------------------------
% a pache for representing allocation.
% nonempty_assignments(Y->Ya).
total_products_of_firms_workers_coalition( T, [Y,(Cf,Cw,Ci),Lfwv], V):-
feasible_allocation_in_f_w_coalition( T, (Cf,Cw,Ci), Y),
findall((Firm,Workers,Vi),
(
member( Firm, Cf),
member( (Items->Firm), Y),
product_of_firm_workers_coalition( Firm,Workers,Items,_,Vi)
),
Lfwv),
sumall( Vi, member((_,_,Vi),Lfwv),V).
% demo
%-----------------------------------------
/*
?- set_model( job_matching_1([0.5, 1, 0]) ).
Yes
?- display_goals((
total_products_of_firms_workers_coalition( [i,k], [Y|_], V),0, nonempty_assignments(Y->Ya)
V>0, nonempty_assignments(Y->Ya)
),[V;Ya]).
4;[ ([2, 3]->i), ([1]->k)];
4;[ ([1, 3]->i), ([2]->k)];
7;[ ([3]->i), ([1, 2]->k)];
4;[ ([1, 2]->i), ([3]->k)];
7;[ ([2]->i), ([1, 3]->k)];
7.5;[ ([1]->i), ([2, 3]->k)];
9;[ ([1, 2, 3]->k)];
No
?- a_star(V_star,Y),total_products_of_firms_workers_coalition( T, [Y|Dv], V).
V_star = 11
Y = [ ([]->i), ([1]->j), ([2, 3]->k)]
T = [i, j, k]
Dv = [ ([j, k], [i], [1, 2, 3]), [ (j, [i], 5), (k, [i], 7)]]
V = 12
Yes
?- display_goals((
firms_workers_coalition( T, Fc,Wc,Ic),
Dv=[Y,(Fc,Wc,Ic),_Lv],
max( V,
total_products_of_firms_workers_coalition( T, Dv, V)
),nonempty_assignments(Y->Ya)),[V:T:Ya]).
0:[]:[];
0:[k]:[];
0:[j]:[];
0:[j, k]:[];
0:[i]:[ ([1, 2, 3]->i)];
9:[i, k]:[ ([1, 2, 3]->k)];
9:[i, j]:[ ([1, 2, 3]->j)];
12:[i, j, k]:[ ([3]->j), ([1, 2]->k)];
No
?- set_model( job_matching_2([0, 0, 0]) ).
Yes
?- findall((V,T),(
firms_workers_coalition( T, _,_,_),
max( V,
total_products_of_firms_workers_coalition( T, _, V)
)),MTV),sort(MTV,MTV1),forall_nl_write(MTV1),fail.
0, []
0, [i1]
0, [i1, i2]
0, [i1, i2, i3]
0, [i1, i3]
0, [i2]
0, [i2, i3]
0, [i3]
0, [j]
0, [j, k]
0, [k]
4, [i1, j]
4, [i1, j, k]
4, [i1, k]
4, [i2, j]
4, [i2, j, k]
4, [i2, k]
4, [i3, j]
4, [i3, j, k]
4, [i3, k]
7, [i1, i2, k]
7, [i1, i3, j]
7, [i1, i3, k]
7, [i2, i3, j]
8, [i1, i2, j]
8, [i1, i2, j, k]
8, [i1, i3, j, k]
8, [i2, i3, j, k]
8, [i2, i3, k]
9, [i1, i2, i3, j]
9, [i1, i2, i3, k]
12, [i1, i2, i3, j, k]
No
?- set_model( job_matching_2([0.5, 1, 0]) ).
Yes
?- findall((V,T),(el(job_matching_2([0.5,1,0])).
firms_workers_coalition( T, _,_,_),
max( V,
total_products_of_firms_workers_coalition( T, _, V)
)),MTV),sort(MTV,MTV1),forall_nl_write(MTV1),fail.
0, []
0, [i1]
0, [i1, i2]
0, [i1, i2, i3]
0, [i1, i3]
0, [i2]
0, [i2, i3]
0, [i3]
0, [j]
0, [j, k]
0, [k]
4, [i1, j]
4, [i1, j, k]
4, [i1, k]
4, [i2, j]
4, [i2, j, k]
4, [i2, k]
4, [i3, k]
5, [i3, j]
5, [i3, j, k]
7, [i1, i2, k]
7, [i1, i3, j]
7, [i1, i3, k]
7, [i2, i3, j]
8.5, [i1, i2, j]
8.5, [i1, i2, j, k]
8.5, [i2, i3, k]
9, [i1, i2, i3, j]
9, [i1, i2, i3, k]
9, [i1, i3, j, k]
9, [i2, i3, j, k]
12.5, [i1, i2, i3, j, k]
No
?-
*/
%-----------------------------------------
% Part III. Automated Game Design
%-----------------------------------------
% transforming model/6 to coop/2
% with/without utility of co-workers
% characterisitic function of the game
%-----------------------------------------
% v(T):= Max_feasible_allocation_S_in_coalition_T( F )
% where F = Sum_over_firms_in_T( u_f'(i; Si) )
% See Ma(2001).
:- dynamic coop_0/3.
:- dynamic temp_warn_no_optimal/2.
value_of_firms_workers_coalition( Model, Dv,T-> V):-
current_model( Model),
clause(
coop_0( Model, Dv, (T->V)),
true
).
value_of_firms_workers_coalition( Model, Dv, T->V):-
current_model( Model),
\+ clause(
coop_0( Model, _,_),
true
),
firms_workers_coalition( T, Fc,Wc,Ic),
Dv=[_Y,(Fc,Wc,Ic),_Lv],
max_total_products_of_fw_coalition( T, Dv, V),
assert(
coop_0( Model,Dv, (T->V))
).
max_total_products_of_fw_coalition( T, Dv, V):-
(var(T)->firms_workers_coalition( T, Fc,Wc,Ic);true),
Dv=[_Y,(Fc,Wc,Ic),_Lv],
(
max( V,
total_products_of_firms_workers_coalition( T, Dv, V)
)
-> true
; nl,write('no optimal solution for'),write(T),
assert( temp_warn_no_optimal(T,Dv))
).
% setting the characterisitic functions
%-----------------------------------------
:- dynamic temp_coop/2.
transform_coop( Model):-
current_model( Model ),
initialize_transform_coop( Model),
abolish( temp_warn_no_optimal/2),
findall( v( T)=Vcw,
(
value_of_firms_workers_coalition( Model,_,T->Vcw)
),
NewValues),
assert( coop( Model, NewValues)).
transform_coop( Model):-
current_model( Model ),
\+ clause( coop(Model,_), _),
recovery_coop(Model).
initialize_transform_coop( Model):-
abolish( temp_coop/2),
set_model( Model),
keep_current_coop( Model),
!.
keep_current_coop( Model):-
\+ clause( coop(Model,_), _).
keep_current_coop( Model):-
clause( coop(Model,V), B),
retract( (coop(Model, V):-B)),
assert( (temp_coop(Model, V):-B)).
recovery_coop( Model):-
current_model( Model ),
clause( temp_coop( Model, Vb), B),
clause( coop( Model, Va), A ),
retract( (coop( Model, Va):-A) ),
assert( (coop( Model, Vb):-B) ).
% demo
%-----------------------------------------
% A verification for Example 7 in Ma(2001)
% by using new model management tools.
% Modification. For each firm's utility
% (production) function, modify it as loaded with
% co-workers effect in the firm-workers coalition.
% This leads to the core equivalent competitive
% equilibrium (see below), and the several
% tie-breaking outcomes vanish
% (which can be shown by using a_star_0/2)
% for the job market model (M)
% which is named job_matching_2([0,0,0])
% in our modelbase.
% fact to verify (1)
%-----------------------
% the model job_matching_2([0.5,1,0]))
% without coworkers effect
% has a nonempty core.
% fact to verify (2)
%-----------------------
% the model job_matching_2([0.5,1,0]))
% with coworkers effect,
% of the case 1 u_cw/4,
% has NO nonempty core.
% fact to verify (3)
%-----------------------
% the model job_matching_2([0,0,0]))
% with coworkers effect,
% of the case 2 u_cw/4,
% which is loaded in production function of firms,
% has a nonempty core,
% but the competitive price does NOT exists.
% fact to verify (4)
%-----------------------
% the model job_matching_2([0,0,0]))
% with coworkers effect,
% of the case 2 u_cw/4,
% which is loaded in production function of firms,
% has a nonempty core,
% and the competitive price does exists.
%-----------------------
% before above checking,
% a preliminary exam.
%-----------------------
/*
?- set_model(job_matching_1([0,0,0])),
abolish(coop_0/3),transform_coop( Model),
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i])=0
v([i, k])=9
v([i, j])=9
v([i, j, k])=11
A = job_matching_1([0, 0, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i])=0, v([i|...])=9, v([...|...])=9, v(...)=11]
Yes
?- min(U,(core(G,_,P),P=payoff([U,_,_]))).
U = 28
G = game(job_matching_1([0, 0, 0]))
P = payoff([28, 8, 8])
Yes
?- set_model(job_matching_1([0.5,1,0])),).
abolish(coop_0/3),transform_coop( Model),
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i])=0
v([i, k])=9
v([i, j])=9
v([i, j, k])=12
Model = job_matching_1([0.5, 1, 0])
A = job_matching_1([0.5, 1, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i])=0, v([i|...])=9, v([...|...])=9, v(...)=12]
Yes
?- min(U,(core(G,_,P),P=payoff([U,_,_]))).
U = 24
G = game(job_matching_1([0.5, 1, 0]))
P = payoff([24, 12, 12]) ;
No
*/
%-----------------------
% checking fact (2).
%-----------------------
/*
?- set_model(job_matching_2([0.5,1,0])),
abolish(coop_0/3), transform_coop( Model),
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i3])=0
v([i3, k])=4
v([i3, j])=5;
v([i3, j, k])=5
v([i2])=0
v([i2, k])=4
v([i2, j])=4
v([i2, j, k])=4
v([i2, i3])=0
v([i2, i3, k])=8.5
v([i2, i3, j])=7
v([i2, i3, j, k])=9
v([i1])=0
v([i1, k])=4
v([i1, j])=4
v([i1, j, k])=4
v([i1, i3])=0
v([i1, i3, k])=7
v([i1, i3, j])=7
v([i1, i3, j, k])=9
v([i1, i2])=0
v([i1, i2, k])=7
v([i1, i2, j])=8.5
v([i1, i2, j, k])=8.5
v([i1, i2, i3])=0
v([i1, i2, i3, k])=9
v([i1, i2, i3, j])=9
v([i1, i2, i3, j, k])=12.5
A = job_matching_2([0.5, 1, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i3])=0, v([i3|...])=4, v([...|...])=5, v(...)=5, ... =...|...]
Yes
?- min(U,(core(G,_,P),P=payoff([A,B,C,_,_]),U is A+B+C)).
No
*/
%-----------------------
% checking fact (1).
%-----------------------
/*
?- ch_u_cw(I).
I = on->off
Yes
?- set_model(job_matching_2([0.5,1,0])),
abolish(coop_0/3),transform_coop( Model),
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i3])=0
v([i3, k])=4
v([i3, j])=5
v([i3, j, k])=5
v([i2])=0
v([i2, k])=4
v([i2, j])=4
v([i2, j, k])=4
v([i2, i3])=0
v([i2, i3, k])=7.5
v([i2, i3, j])=7
v([i2, i3, j, k])=9
v([i1])=0
v([i1, k])=4
v([i1, j])=4
v([i1, j, k])=4
v([i1, i3])=0
v([i1, i3, k])=7
v([i1, i3, j])=7
v([i1, i3, j, k])=9
v([i1, i2])=0
v([i1, i2, k])=7
v([i1, i2, j])=7.5
v([i1, i2, j, k])=8
v([i1, i2, i3])=0
v([i1, i2, i3, k])=9
v([i1, i2, i3, j])=9
v([i1, i2, i3, j, k])=12
Model = job_matching_2([0.5, 1, 0])
A = job_matching_2([0.5, 1, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i3])=0, v([i3|...])=4, v([...|...])=5, v(...)=5, ... =...|...]
Yes
?- min(U,(core(G,_,P),P=payoff([A,B,C,_,_]),U is A+B+C)).
U = 34
G = game(job_matching_2([0.5, 1, 0]))
P = payoff([10, 12, 12, 8, 6])
A = 10
B = 12
C = 12
Yes
?-
*/
% Summary of (1) and (2)
%-----------------------------------------
% Fact 2. For
% Model = job_matching_1([0.5,1,0])
% CW_Effect = off
% Ucw_Case = all zero
% the generated coop/2 yields No core outcome.
% Fact 1. For
% Model = job_matching_1([0.5,1,0])
% CW_Effect = on
% Ucw_Case = case_1
% the generated coop/2 yields a core outcome
% [2.5, 4, 4, 2, 1.5]
% which is minimal in the sense that
% it minimizes the total of offerd wages for workers.
%-----------------------
% checking fact (3).
%-----------------------
/*
?- set_model(job_matching_2([0,0,0])),
select_case_of_u_cw(_->case_2 ),
cwe_model_status( model:M,cwe:CWE, case:CASE).
u_cw(i1, [i1, i2], j, 0.3), 0.3\=0
u_cw(i2, [i1, i2], j, 0.2), 0.2\=0
u_cw(i2, [i2, i3], k, 0.3), 0.3\=0
u_cw(i3, [i2, i3], k, 0.2), 0.2\=0
M = job_matching_2([0, 0, 0])
CWE = on
CASE = case_2
Yes
?- abolish(coop_0/3),transform_coop( Model),
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i3])=0
v([i3, k])=4
v([i3, j])=4
v([i3, j, k])=4
v([i2])=0
v([i2, k])=4
v([i2, j])=4
v([i2, j, k])=4
v([i2, i3])=0
v([i2, i3, k])=7.5
v([i2, i3, j])=7
v([i2, i3, j, k])=8
v([i1])=0
v([i1, k])=4
v([i1, j])=4
v([i1, j, k])=4
v([i1, i3])=0
v([i1, i3, k])=7
v([i1, i3, j])=7
v([i1, i3, j, k])=8
v([i1, i2])=0
v([i1, i2, k])=7
v([i1, i2, j])=7.5
v([i1, i2, j, k])=8
v([i1, i2, i3])=0
v([i1, i2, i3, k])=9
v([i1, i2, i3, j])=9
v([i1, i2, i3, j, k])=11.5
Model = job_matching_2([0, 0, 0])
A = job_matching_2([0, 0, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i3])=0, v([i3|...])=4, v([...|...])=4, v(...)=4, ... =...|...]
Yes
?- precision(A).
A = 0.25
Yes
?- display_goals(core(G,_,P),[G:P]).
game(job_matching_2([0, 0, 0])):payoff([14, 14, 14, 2, 2]);
game(job_matching_2([0, 0, 0])):payoff([13, 14, 13, 3, 3]);
game(job_matching_2([0, 0, 0])):payoff([12, 14, 12, 4, 4]);
No
?- solve_wep_1(P,Y).
init p:[ (1->0), (2->0), (3->0)];xds:[1, 2, 3]
p:[ (1->300), (2->300), (3->300)];xds:[1, 2, 3]->[]
equilibrium !
P = [ (1->300), (2->300), (3->300)]
Y = [ ([]->i1), ([]->i2), ([]->i3), ([2, 3]->j), ([1]->k)]
Yes
?- display_goals((a_star_0(V,Y),
nonempty_assignments(Y->Y1)),[V;Y1]).
11;[ ([1]->j), ([2, 3]->k)];
11;[ ([1, 2]->j), ([3]->k)];
11;[ ([1, 3]->j), ([2]->k)];
11;[ ([2]->j), ([1, 3]->k)];
11;[ ([2, 3]->j), ([1]->k)];
11;[ ([3]->j), ([1, 2]->k)];
No
?-
*/
%-----------------------
% checking fact (4).
%-----------------------
/*
?- set_model(job_matching_2([0,0,0])),
select_case_of_u_cw(_->case_2 ),
cwe_model_status( model:M,cwe:CWE, case:CASE).
u_cw(i1, [i1, i2], j, 0.3), 0.3\=0
u_cw(i2, [i1, i2], j, 0.2), 0.2\=0
u_cw(i2, [i2, i3], k, 0.3), 0.3\=0
u_cw(i3, [i2, i3], k, 0.2), 0.2\=0
M = job_matching_2([0, 0, 0])
CWE = on
CASE = case_2
Yes
?- ch_m_u_cw(I).
complete transformation.
I = u_f->u_f+u_cw
Yes
?- cwe_model_status( model:M,cwe:CWE, case:CASE).
u_cw(i1, [i1, i2], j, 0.3), 0.3\=0
u_cw(i2, [i1, i2], j, 0.2), 0.2\=0
u_cw(i2, [i2, i3], k, 0.3), 0.3\=0
u_cw(i3, [i2, i3], k, 0.2), 0.2\=0
M = job_matching_2([0, 0, 0])
CWE = off
CASE = case_2
Yes
?- display_goals((u(_,_,D),D>0)).
u(j, [3], 4+0+0), 4+0+0>0
u(j, [2], 4+0), 4+0>0
u(j, [2, 3], 7+0), 7+0>0
u(j, [1], 4+0), 4+0>0
u(j, [1, 3], 7+0), 7+0>0
u(j, [1, 2], 7+0+0.5), 7+0+0.5>0
u(j, [1, 2, 3], 9+0), 9+0>0
u(k, [3], 4+0), 4+0>0
u(k, [2], 4+0), 4+0>0
u(k, [2, 3], 7+0+0.5), 7+0+0.5>0
u(k, [1], 4+0+0), 4+0+0>0
u(k, [1, 3], 7+0), 7+0>0
u(k, [1, 2], 7+0), 7+0>0
u(k, [1, 2, 3], 9+0), 9+0>0
D = _G162
Yes
?- display_non_zero_coworkers_effects.
j;[1, 2];7+0+0.5+0.5;
k;[2, 3];7+0+0.5+0.5;
No
?- a_star_0(V,Y),
nonempty_assignments(Y->Ya),nl,write(V;Ya),fail.
11.5;[ ([1]->j), ([2, 3]->k)]
11.5;[ ([1, 2]->j), ([3]->k)]
No
?- solve_wep_1(P,Y),
nonempty_assignments(Y->Ya).
init p:[ (1->0), (2->0), (3->0)];xds:[1, 2, 3]
p:[ (1->150), (2->150), (3->150)];xds:[1, 2, 3]->[2]
p:[ (1->150), (2->200), (3->150)];xds:[2]->[1, 2, 3]
p:[ (1->300), (2->350), (3->300)];xds:[1, 2, 3]->[]
equilibrium !
P = [ (1->300), (2->350), (3->300)]
Y = [ ([]->i1), ([]->i2), ([]->i3), ([1, 2]->j), ([3]->k)]
Ya = [ ([1, 2]->j), ([3]->k)]
Yes
?- abolish(coop_0/3),transform_coop( Model),e(B).
current_model(A),coop(A,B),forall_nl_write(B).
v([])=0
v([k])=0
v([j])=0
v([j, k])=0
v([i3])=0
v([i3, k])=4
v([i3, j])=4
v([i3, j, k])=4
v([i2])=0
v([i2, k])=4
v([i2, j])=4
v([i2, j, k])=4
v([i2, i3])=0
v([i2, i3, k])=7.5
v([i2, i3, j])=7
v([i2, i3, j, k])=8
v([i1])=0
v([i1, k])=4
v([i1, j])=4
v([i1, j, k])=4
v([i1, i3])=0
v([i1, i3, k])=7
v([i1, i3, j])=7
v([i1, i3, j, k])=8
v([i1, i2])=0
v([i1, i2, k])=7
v([i1, i2, j])=7.5
v([i1, i2, j, k])=8
v([i1, i2, i3])=0
v([i1, i2, i3, k])=9
v([i1, i2, i3, j])=9
v([i1, i2, i3, j, k])=11.5
Model = job_matching_2([0, 0, 0])
A = job_matching_2([0, 0, 0])
B = [v([])=0, v([k])=0, v([j])=0, v([j, k])=0, v([i3])=0, v([i3|...])=4, v([...|...])=4, v(...)=4, ... =...|...]
Yes
?-
*/
% Summary of (3) and (4)
%-----------------------------------------
% Fact 3. For
% Model = job_matching_2([0,0,0])
% CW_Effect = on
% Ucw_Case = case_2
% the generated coop/2 yields a core outcome
% [3, 3.5, 3, 1, 1],
% but the equilibrium price solve_wep_1/2 was
% [3, 3, 3].
% Fact 4. For
% Model = job_matching_2([0,0,0])
% CW_Effect = off
% Ucw_Case = case_2
% the equilibrium price solve_wep_1/2 is
% [3, 3, 3],
% and the efficient allocation plan
% [ ([1, 2]->j), ([3]->k)] or
% [ ([1]->j), ([2, 3]->k)]
% with the total surplus 11.5.
% NOTE:
% The fact 4 above implies the core equivalence.
% Because by using ch_m_u_cw/1 we set zero for
% each worker, as well as each firm,
% in effect it is equivalent of assuming
% the taxes/subsidies schemes (Ma(2001), Shapley
% and Subik(1969))such that
% t(j, Si; i)= u(j, Si; i),
% so it suffices the result.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% mathematical tools
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
positive_number_1(U,P,N):-
IP is integer(U / P),
length(L,IP),
nth1(K,L,_),
N is K*P.
positive_number(U,P,_):-
\+ clause(positive_number_0(U,P,_),true),
generate_positive_numbers(U,P),
fail.
positive_number(U,P,N):-
clause(positive_number_0(U,P,N),true).
:-dynamic positive_number_0/3.
generate_positive_numbers(U,P):-
write('start generating positive numbers':U:P),
abolish(positive_number_0/1),
forall(
positive_number_1(U,P,N),
assert(positive_number_0(U,P,N))
).
% cited from math1.pl
%---------------------------------------------------%
% revised: 21 Sep 2005
% rename. sumof/3->sumall/3,
sumall(X,Goal,S):-
findall(X,Goal,Z),
sum(Z,S).
sum([],0).
sum([X|Members],Sum):-
sum(Members,Sum1),
%number(X),
Sum is Sum1 + X.
product([],1).
product([X|Members],Z):-
product(Members,Z1),
%number(X),
Z is Z1 * X.
product_sum([],[],[],0).
product_sum([P|Q],[A|B],[E|F],V):-
length(Q,N),
length(B,N),
product_sum(Q,B,F,V1),
E is P * A,
V is V1 + E.
% max,min
% ----------------------------------------------------------- %
max_of(X,[X]).
max_of(Z,[X|Y]):-
max_of(Z1,Y),
(X > Z1 -> Z=X; Z=Z1).
min_of(X,[X]).
min_of(Z,[X|Y]):-
min_of(Z1,Y),
(X < Z1 -> Z=X; Z=Z1).
% another rule for max / min without backtrack
amax_of(A,L):-
setof(X,(member(X,L),number(X)),S),
last(A,S).
amin_of(A,L):-
setof(X,(member(X,L),number(X)),[A|_]).
% a solver : maximization of goal wrt arguments
% ----------------------------------------------------------- %
% X: the objective variable,
% Goal: the objective function and constraints,
min(X,Goal):-
max(Z,(Goal,Z is -X)).
max(X,Goal):-
max_1(X,Goal).
%max_2(X,Goal).
%max_3(X,Goal).
% This code is not fast in simple iterations. (see demo below.)
% But the performance was robust for solve_wep_1/2 on auction_1_r3.
max_1(X,Goal):-
setof((X,Goal),Goal,Z),
member((X,Goal),Z),
\+ (
member((Y,_),Z),
Y > X
).
% The following codes works fastly in simple predicates. (see demo below.)
% But it was not effective for my solve_wep_1/2.(by g. stack over)
max_2(X,Goal):-
setof((Goal,W),(Goal,W is -X),Z),
select_minimal(Z,Goal),
member((Goal,Value),Z),
X is -Value.
% select_minimal: a code in Shoham's book (the section of id3)
%-----------------------------------------
select_minimal( [FirstPair|Remain], Best):-
select_minimal_0( Remain, FirstPair, Best).
select_minimal_0( [ ], (A, _), A). % A is the survived.
select_minimal_0( [ (A, Value) | More ], ( _, Incumbent), Best) :-
Value < Incumbent,
!,
select_minimal_0( More, (A, Value), Best).
% allowing local minima.
% whether this or not would affects solve_wep_1/2.
select_minimal_0( [ (A, Value) | More ], ( _, Incumbent), Best) :-
Value = Incumbent,
select_minimal_0( More, (A, Value), Best).
select_minimal_0( [ _P | More ], (A, Value), Best) :-
select_minimal_0( More, (A, Value), Best ).
% another solver :
%-----------------------------------------
:- dynamic temp_max/3,uid_max/2.
max_3(X,G):-
clause(temp_max(_,X,G),true),
!.
max_3(X,G):-
\+ clause(temp_max(_,X,G),true),
max_3(_,X,G).
max_3(Mid,X,G):-
get_time(Mid),
init_max(Mid,(X,G)),
fail.
max_3(Mid,X,Goal):-
Goal,
uid_max(Mid,(X,Goal)),
temp_max(Mid,Y,_),
(X > Y->update_max(Mid,'>',X,Goal);true),
(X = Y->update_max(Mid,'=',X,Goal);fail),
fail.
max_3(Mid,X,G):-
uid_max(Mid,(X,G)),
temp_max(Mid,X,G).
init_max(Mid,(X,G)):-
forall(retract(temp_max(Mid,_,_)),true),
assert(temp_max(Mid,-10^15,_)),
assert(uid_max(Mid,(X,G))).
update_max( Mid, '>',X, G):-
retract( temp_max(Mid, _, _)),
assert( temp_max(Mid, X, G)).
update_max( Mid, '=',X, G):-
\+ clause( temp_max(Mid, X, G),true),
assert( temp_max(Mid, X, G)).
% demo
%---------------------------------------------------%
% comparing the peformances.
/*
?- stopwatch(
max_1(X,positive_number_1(10000,1,X)),T).
% time elapsed (sec): 25.063
X = 10000
T = 25.063
Yes
?- stopwatch(
max_2(X,positive_number_1(10000,1,X)),T).
% time elapsed (sec): 0.063
X = 10000
T = 0.063
Yes
?- stopwatch(
max_3(X,positive_number_1(10000,1,X)),T).
% time elapsed (sec): 0.062
X = 10000
T = 0.062
Yes
?- max_1(X,positive_number_1(100000,1,X)).
ERROR: Out of global stack
?- max_2(X,positive_number_1(100000,1,X)).
ERROR: Out of global stack
?- stopwatch(
max_3(X,positive_number_1(100000,1,X)),T).
% time elapsed (sec): 0.672
X = 100000
T = 0.672
Yes
?-
*/
% set theoretical operations
%---------------------------------------------------%
% cited from set.pl
bag0([],_A,0).
bag0([C|B],A,N):-
length([C|B],N),
bag0(B,A,_N1),
member(C,A).
zeros(Zero,N):-bag0(Zero,[0],N).
ones(One,N):-bag0(One,[1],N).
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).
c_list_projection([],[],[]).
c_list_projection([X|Y],[_A|B],C):-
X = 1,
c_list_projection(Y,B,C).
c_list_projection([X|Y],[A|B],[A|C]):-
X = 0,
c_list_projection(Y,B,C).
subset_of(A,N,As):-
var(A),
length(As,L),
length(D,L),
list_projection(D,As,B),
length(B,N),
sort(B,A).
subset_of(A,N,As):-
\+ var(A),
length(A,N),
subset(A,As).
% 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.
intersection_of_lists([],_).
intersection_of_lists([X|H],Z):-
intersection_of_lists(H,Y),
intersection(X,Y,Z).
asymmetric_differences(A,B,D):-
subtract(A,B,D1),
subtract(B,A,D2),
D=(D1,D2).
set_equivalence(A,B):-
asymmetric_differences(A,B,([],[])).
% permutation.
% ----------------------------------------------------------- %
% reference:
% L. Sterling and E. Shapiro (1994).
% The Art of Prolog. 2nd edition. MIT Press, p.68.
permutation([],[]).
permutation(Q,[A|R]):-
select(A,Q,Q1),
% subtract(Q,[A],Q1) is not valid for multiple-occurence.
permutation(Q1,R).
% allocation
% ----------------------------------------------------------- %
% cited from math1.pl
allocation(N,A,[X|Y]):-
allocation(N,A,A,[X|Y]).
allocation(0,_,0,[]).
allocation(N,A,B,[X|Y]):-
integer(A),
length([X|Y],N),
allocation(_N1,A,B1,Y),
K is A - B1 + 1,
length(L,K),
nth0(X,L,X),
B is B1 + X.
% generating partitons
%-----------------------------------------
partition([S],1,S):-
\+ var(S),
length(S,_).
partition([H|H1],N,S):-
\+ var(S),
length(S,_),
symmetric_complement(H,S1,S),
\+ member([], [H,S1]),
partition(H1,N1,S1),
N is N1 + 1,
all_elements(S1,_,H1).
all_elements([],0,[]).
all_elements(A,N,[H|S]):-
\+ var(S),
length(S,_),
\+ var(H),
length(H,K),
all_elements(B,N1,S),
append(H,B,A),
N is N1 + K.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% tools for output and statistics
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% cited from mainly : menu.pl
% display specified terms separated by semicorons
% for each successful goals.
%--------------------------------
% added: 21 Aug 2005.
% game(G,value,B,C),nl,write(B:C),fail.
% a generalization.
display_goals( Goal, Values):-
clause(Goal,_),!,
length(Values,_),
forall( Goal,
(
nl,
forall(member(X,Values),
(write(X),write('; '))
)
)
),
bagof(X,(member(X,Values),X=complete),Values).
% display all successful goals (with the count).
%--------------------------------
display_goals(G):-
(\+ var(G)->true;G=empty),
forall(G,(nl,write(G))).
display_goals(_).
% goal counting.
%--------------------------------
:- dynamic temp_count/1.
count_goals(_G,0):-
abolish(temp_count/1),
assert(temp_count(0)),
nl,
write('counter initialized.'),
nl,
fail.
count_goals(G,N1):-
G,
update_counter(N1),
% for debug % write([N1,G]),
fail.
count_goals(_G,N):-
temp_count(N),
nl,
write(N),
tab(1),
write('successful goals have been found.').
update_counter(N1):-
retract(temp_count(N)),
N1 is N +1,
assert(temp_count(N1)),
!.
% iteratively writing the goals
%--------------------------------
forall_write(A):- forall(member(X,A),write(X)).
forall_nl_write(A):- forall(member(X,A),(nl,write(X))).
forall_write_goals(A,B):- B,nl,write(A),fail.
forall_write_goals(_,_):- nl,write(complete).
% Save data to a 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).
% save all successful goals to file.
%--------------------------------
tell_goal(File,forall,G):-
G0 = (nl,write(G),write('.')),
G1 = forall(G,G0),
tell_goal(File,G1).
% the conditionalized version
% Aug 2003.
tell_goal(File,forall_such_that,G,Condition):-
% G should be occurred in the Condition.
WRITE = (nl,write(G),write('.')),
G1 = forall(Condition,WRITE),
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.
% measuring time consumption
%--------------------------------
stopwatch_0(Goal,TD):-
get_time(TS),
Goal,
get_time(TF),
TD is TF - TS.
stopwatch(Goal,TD):-
stopwatch_0(Goal,TD),
nl,
write('% time elapsed (sec): '),
write(TD),
nl.
stopwatch_of_iterated_goals(_Goal,0,0,Display):-
rule_of_display_number_in_stopwatch(Display,JOB),
JOB.
stopwatch_of_iterated_goals(Goal,TD,Iteration,Display):-
number(Iteration),
Iteration > 0,
init_count_of_display,
rule_of_display_number_in_stopwatch(Display,JOB),
stopwatch(
forall(
(
Goal, %write(Goal),
update_count_of_display(K),
(K>Iteration->!,fail;true)
),
JOB
),
TD
).
rule_of_display_number_in_stopwatch(no,true):-
!.
rule_of_display_number_in_stopwatch(yes,display_counter).
% a display of counter for iterated goals.
%---------------------------------------
:- dynamic temp_count_of_display/1.
temp_count_of_display(0).
init_count_of_display:-
abolish(temp_count_of_display/1),
assert(temp_count_of_display(0)).
update_count_of_display(K):-
retract(temp_count_of_display(K0)),
K is K0 + 1,
assert(temp_count_of_display(K)).
update_and_display_counter:-
update_count_of_display(_),
display_counter.
display_counter:-
temp_count_of_display(K),
nl,
write([K]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% model management tools (MMT)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- dynamic precision/1.
precision(1).
change_precision(New):-
change_precision(_,New).
change_precision(Current,New):-
member(New,[0.25, 0.5, 1, 0.025, 0.1]),
retract(precision(Current)),
assert(precision(New)).
:- dynamic u/3, agent/1, item/1, e/3, current_model/1,
owner_of_unsold_items/1.
model_predicate( u/3).
model_predicate( agent/1).
model_predicate( item/1).
model_predicate( e/3).
:- dynamic set_of_all_agents/1,set_of_all_items/1.
set_model(M):-
model(M,
agents:N,
items:O,
'owner of unsold item': Doi,
endowments:E,
utilities:U
),
% ---% nl,write( 'now setting the model':M),
abolish( current_model/1),
assert( current_model(M)),
abolish( set_of_all_agents/1),
assert( set_of_all_agents(N)),
abolish( set_of_all_items/1),
assert( set_of_all_items(O)),
abolish( owner_of_unsold_items/1),
assert( owner_of_unsold_items(Doi)),
forall( model_predicate(MP), abolish(MP)),
forall( member(I,N), assert(agent(I))),
forall( member(X,O), assert(item(X))),
forall( (agent(J),member(e(J,Cash,Y),E)), assert(e(J,Cash,Y))),
forall( (agent(J),bundle(S),S\=[],member(u(J,S)=V,U)), assert(u(J,S,V))),
param_of_NFL_condition(NFL),
impose_NFL_condition(NFL).
set_model(M):-
\+ clause( model(M,_,_,_,_,_),_),
nl,
write('Sorry, Sir. I could not find it in model base.').
% no-free-lunch condition
:- dynamic param_of_NFL_condition/1.
param_of_NFL_condition( yes).
% the following invoked by set_model/1.
impose_NFL_condition(no).
impose_NFL_condition(yes):-
forall( agent(J), assert( u(J,[],0) ) ).
ask_user_about_NFL:-
abolish(param_of_NFL_condition/1),
nl,write('impose NFL condititon ? (y/n) >'),
read(User),
(member(User,[y,'Y',yes,'Yes','YES'])->W=yes;W=no),
assert(param_of_NFL_condition( W)),
!.
display_model(M):-
(var(M)->current_model(M);true),
model(M,Agents,Items,Doi, _:Endowments,_:Utilities),
nl,write('****** model *******'),
nl,write(M),
forall(member(P,[Agents,Items,Doi]),(nl,write(P))),
nl,write('endowmens (agent, cash, items):'),
forall(member(X,Endowments),(nl,tab(2),write(X))),
nl,write('utility functions:'),
forall(member(V,Utilities),(nl,tab(2),write(V))).
% for models without a single agent.
display_model(M):-
(var(M)->current_model(M-Jr);true),
model(M,agents:N,Items,Doi, _:Endowments,_:Utilities),
subtract(N,[Jr],Nr),
set_of_all_agents(Nr),
nl,write('****** model *******'),
nl,write(M-Jr),
forall(member(P,[agents:Nr,Items,Doi]),(nl,write(P))),
nl,write('endowmens (agent, cash, items):'),
forall((member(X,Endowments),X\=e(Jr,_,_)),(nl,tab(2),write(X))),
nl,write('utility functions:'),
forall((member(V,Utilities),V\=(u(Jr,_)=_)),(nl,tab(2),write(V))).
% for models retracted agents in a colation.
display_model(M):-
(var(M)->current_model(M-S);true),
model(M,agents:N,Items,Doi, _:Endowments,_:Utilities),
set_of_all_agents(CurrentAgents),
subtract(N,S,CurrentAgents),
nl,write('****** model *******'),
nl,write(M-S),
forall(member(P,[agents:CurrentAgents,Items,Doi]),(nl,write(P))),
nl,write('endowmens (agent, cash, items):'),
forall(
(member(X,Endowments),X=e(J,_,_),\+member(J,S)),
(nl,tab(2),write(X))
),
nl,write('utility functions:'),
forall(
(member(V,Utilities),V=(u(J,_)=_),\+member(J,S)),
(nl,tab(2),write(V))
).
% model without a single agent
%---------------------------------------
% for computing the VCG payments
set_model_without_agent(J,M):-
set_model_without_coalition([J],M).
set_model_without_coalition(S,M):-
current_model(M-S),
!.
set_model_without_coalition(S,M):-
model(M,
agents:N,
items:O,
'owner of unsold item': Doi,
endowments:E,
utilities:U
),
% ---% nl,write( 'now setting the model':M),
coalition(S),
subtract(N,S,Nr),
abolish( current_model/1),
assert( current_model((M-S))),
abolish( set_of_all_agents/1),
assert( set_of_all_agents(Nr)),
abolish( set_of_all_items/1),
assert( set_of_all_items(O)),
abolish( owner_of_unsold_items/1),
assert( owner_of_unsold_items(Doi)),
forall( model_predicate(MP), abolish(MP)),
forall( member(I,Nr), assert(agent(I))),
forall( member(X,O), assert(item(X))),
forall( (agent(J),\+member(J,S),member(e(J,Cash,Y),E)), assert(e(J,Cash,Y))),
forall(
(
agent(J),
bundle(B),
B\=[],
member(u(J,B)=V,U),
\+ member(J,S)
),
assert(u(J,B,V))
),
param_of_NFL_condition(NFL),
impose_NFL_condition(NFL).
set_model_without_coalition(_,M):-
\+ clause( model(M,_,_,_,_,_),_),
nl,
write('Sorry, Sir. I could not find it in model base.').
%%%% game assertion %%%% (abolished)
% see game model section.
%---------------------------------------
% model swithing tools (MST/MMT)
%---------------------------------------
% changing function f
% (for solve_wep_1 the English auction game algorithm)
%---------------------------------------
% added: 19 Sep 2005
% You can try out an earlier rule of auction algorithm
% solve_wep_1/2 and its belonging functions.
% Before query a solve_wep_1/2, by means of ch_f/1
% once again, a flip-flop, you can switch the
% version of the rule.
:- dynamic temp_f/3.
ch_f( use: f1):-
\+ clause( temp_f(J,A,B), _),
clause( f(J,A,B),T),
assert( (temp_f(J,A,B):-T)),
abolish( f/3),
clause( f_1(J,A,C),T1),
assert( (f(J,A,C):-T1)).
ch_f( use: f):-
clause( temp_f(J,A,B),T),
abolish( temp_f/3),
abolish( f/3),
assert( (f(J,A,B):-T)).
% background parameter for preference analysis
%-----------------------------------------
% revised: 19 Sep 2005
:- dynamic option_for_analyze_preferences/1.
option_for_analyze_preferences( given_price).
%option_for_analyze_preferences( variate_prices).
% a flip-flop
ch_apo( OPT->OPT1):-
retract(option_for_analyze_preferences( OPT)),
member( (given_price,variate_price),
[(OPT,OPT1),(OPT1,OPT)]
),
assert(option_for_analyze_preferences( OPT1)).
% switching u_cw/5 on/off the co-workers effect
%-----------------------------------------
% ch_ucw/1 a flip-flop of the parameter
% for the modeling with/without co-workers effect
% given the current model.
:- dynamic option_for_coworkers_effect/1.
option_for_coworkers_effect( on).
%option_for_coworkers_effect( off).
:- dynamic temp_u_cw/5.
% ch_u_cw/1 merely move/add them to the temporary clauses
% because of the fact-based nature u_cw/5.
% `setting each u_cw/5 to zero' option
ch_u_cw( on ->off):-
option_for_coworkers_effect( on),
current_model( M),
Ucw = u_cw( M, J, C, I, U),
Temp = temp_u_cw( M, J, C, I, U),
\+ clause( Temp, _),
clause( Ucw, true),
assert( Temp),
retract( Ucw),
fail.
ch_u_cw( on ->off):-
option_for_coworkers_effect( on),
abolish( option_for_coworkers_effect/1),
assert( option_for_coworkers_effect(off)).
% recovery. (re)activate co-workers effect.
ch_u_cw( off -> on):-
option_for_coworkers_effect( off),
current_model( M),
clause( temp_u_cw( M, J, C, I, U), true),
retract( temp_u_cw( M, J, C, I, U)),
assert( u_cw( M, J, C, I, U)),
fail.
ch_u_cw( off -> on):-
option_for_coworkers_effect( off),
abolish( option_for_coworkers_effect/1),
assert( option_for_coworkers_effect(on)).
% (enforcing or confirmation).
ch_u_cw( B -> A):-
\+ var(A),
ch_u_cw_0( B -> A),
option_for_coworkers_effect( B).
ch_u_cw_0( on -> on).
ch_u_cw_0( off -> off).
% case switcher for u_cw
%-----------------------------------------
% case_for_u_cw/2 => (MMT)
:- dynamic case_for_u_cw/2.
case_for_u_cw( case_1, on).
case_for_u_cw( case_2, off).
select_case_of_u_cw( C->D):-
case_for_u_cw( C, on),
forall(
retract( case_for_u_cw( E, on)),
assert( case_for_u_cw( E, off))
),
case_for_u_cw( D, off),
D \= C,
retract( case_for_u_cw( D, _)),
assert( case_for_u_cw( D, on)).
% switching the modeling of co-workers effect
%-----------------------------------------
ch_m_u_cw( U_old -> U_new):-
ch_m_u_cw( U_old -> U_new, _).
ch_m_u_cw( u_f -> u_f + u_cw, Cmt):-
Cmt ='new u/3 with co-workers effect',
option_for_coworkers_effect( on),
H = product_of_firm_workers_coalition,
Product =..[H, Firm,_,Coworkers1,Qc+Uc,_],
forall(
(
firm( Firm),
Product
),
(
retract( u( Firm, Coworkers1, _)),
assert( u( Firm, Coworkers1, Qc+Uc))
)
),
ch_u_cw( on -> off),
nl,
write( 'complete transformation.').
ch_m_u_cw( u_f + u_cw -> u_f, Cmt):-
Cmt = 'recovered u/3 without co-workers effect',
option_for_coworkers_effect( off),
ch_u_cw( off -> on),
current_model(M),
set_model(M).
% summary of modeling satus of co-workers effect
%-----------------------------------------
cwe_model_status( model:M,cwe:CWE, case:CASE):-
current_model(M),
option_for_coworkers_effect( CWE),
case_for_u_cw(CASE,on),
display_goals((u_cw(_,_,_,D),D\=0)).
display_non_zero_coworkers_effect.
display_non_zero_coworkers_effects:-
display_goals(
(
firm(Firm),
H = product_of_firm_workers_coalition,
Product =..[H, Firm,_,Coworkers1,Qc+Uc,_],
Product,
Uc \= 0
),
[Firm;Coworkers1;Qc+Uc]
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% startup script
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
hl:-
nl,length(L,50),forall(member(_,L),write('=')).
explain_me:-
me(T,T1,P,D,A),
hl,
nl,tab(2),write('title ':T),
nl,tab(2),write( T1),
nl,tab(2),write('code ':P),
nl,tab(2),write('date ':D),
nl,tab(2),write('author ':A),
hl.
% default model : job_matching_1([0,0,0])
:- explain_me,
abolish( temp_agtsbst/2),
abolish( temp_max/3),
abolish( uid_max/2),
%ask_user_about_NFL,
%abolish( coop_0/3),
set_model(auction_1).
% demo
%-----------------------------------------
/*
?- [price].
==================================================
title :assignment market games on prolog
code :price.pl (developed on SWI-prolog 5.0.9)
date :2005.8.19-26
author :By Kenryo INDO
==================================================
% price compiled 0.00 sec, 75,800 bytes
Yes
?- set_model(auction_1).
Yes
?- solve_wep_1(P,Y).
init p:[ (a->0), (b->0)];xds:[a, b]
p:[ (a->300), (b->300)];xds:[a, b]->[b]
p:[ (a->300), (b->400)];xds:[b]->[a, b]
p:[ (a->600), (b->700)];xds:[a, b]->[] equilibrium!
I can`t update prices, because
there is no excess demand item.
P = [ (a->600), (b->700)]
Y = [ ([]->i), ([a]->j), ([b]->k)] ;
No
?- pp(A). % the price vector for items.
A = [ (a->600), (b->700)]
Yes
?- xx(I). % the allocation of items.
I = [ (a->j), (b->k)]
Yes
?- d(J,A,B). % the individuals demand set under the price.
J = i
A = [ (a->600), (b->700)]
B = [[]] ;
J = j
A = [ (a->600), (b->700)]
B = [[a], [b]] ;
J = k
A = [ (a->600), (b->700)]
B = [[a, b], [b]] ;
No
?- wep(P,Y). % the Walrasian price vector and the equilibrium outcome.
P = [ (a->600), (b->700)]
Y = [ ([]->i), ([a]->j), ([b]->k)]
Yes
?- xds(P,X). % the excess demand set X : the value of max f.
P = [ (a->600), (b->700)]
X = []:0 ;
No
?-
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% related literature:
% an introductory reading
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 26-30 Aug 2005
% revised: 8 Sep 2005
% Some basic notations
%-----------------------------------------
% (skim if the reader familiar with the theory)
% Let O=[a,b,...] a finite set of `item's
% and I=[1,...,n] a finite set of `agent's.
% P=[Pa,Pb,...] a point of E^#O is called price (price vector).
% (For convenience, suppose that a special agent identified by, 0,
% the disposal or inventory, is already included in the set I.)
% A subset of G, including empty set, called a `bundle.'
% A partition, X=[X1,...,Xn], of G would be called `allocation'
% if it can be interpreted so that each bundle in Xi corresponds
% to the ownership of agent i.
% We use a notation