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