You selected price.pl

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  the payment of agent i under the pair (P,X),
% as the literature, where  represents summation of A over B. 
% Precisely, the dot product of,
% P, a price vector and, B(Xi,X), a bit sequence in [0,1]^n 
% which is the indicator vector of Xi. 
% Similar for each agents, we get, , the vector of payments.  

% Each agent has preference over bundles which can be represented 
% by, u_i(Y), the utility of agent i for a bundle Y.
% So the net value of agent i under an allocation (P,X) 
% is computed as v_i(Y,P):= u_i(Yi) -.  

% An allocation is called `efficient', or `competitive', if it 
% maximizes the total net utility aggregated over the agent set.  
% We say a competitive price vector (or Walrasian price vector )
% supports the efficient allocation when each i-th 
% element of the partition is the best bundle for the i-th agent.
% A competitive equilibrium, (P, X), is a pair of price vector  and 
% the partition supported by it, and =0. 


%  Cooperative game with indivisibilities and core
%-----------------------------------------
% (skim if the reader familiar with the theory) 

% I provide rather informally the definitions in brief. 
% More precisely, the reader should refer Shapley and Scarf(1974),
% Kaneko(1982), or other substantial text book of game theory.

% def. game:-  characteristic function defined over 
%         subsets of N= [1,2,....,n], the set of players, 
%         other than enction defined over 
%         subsets of N= [1,2,....,n], the set of players, 
%         other than empty set []. 
% def. characteristic function :-
%        % game of with side payments (transferable utility)
%          v: 2^N -[] -> R.
% def. characteristic function (transferable utility):-
%        % game of with side payments (transferable utility)
%          V: 2^N -[] -> 2^(E^n),  E^n is the payoff space
%        (1) V(S) is closed, (2) if x is not in V(S), there is at least
%         one j in S who's payoff is improved upon for any y in V(S).
%        (3) (V(S)- U_i_inS int(V([i])) meet E^S is noempty and bounded.
% def. feasibility :-
%         x is included in V(N), where N is all agents.
%      imputation :-
%         feasible and indivisually rational vector,
%         i.e., allocation x in ( V(N)- U_i int(V([i])).
% def. core :-
%         feasible allocation which can not  
%         be (strictly) improved upon by any coalition S,
%            i.e., in interior of V(S).
%    Alternatively,
%       core :-  x is in V(N)- U_s int V(S). 
% p.s. transferable utility assumption: 
%      cases of additively separable utility (no income effect).
%      assginment games with sidepayments, V(i, C) = v(C).
%      See Kaneko(1982), p.208 and p.222. 


%  About market game analysis
%-----------------------------------------
% Game analysis of market economy with indivisible goods
% was a generalization of the prevailed normative thinking that
% decentralization by prices is good mechanism which attains 
% an efficient resource allocation. 
% So to say, the efficient allocation is expected to be a reasonable 
% outcome of the game played by the participants of market 
% with prices as the unified signal.

% Conventionally with the relevant coalitional form games,
% the existence of competitive equilibrium was argued via 
% the existence and the coincidence of `core'
% which is the set of `cannot improved upon' outcomes. 
% (=>see game analysis section) 
% (Shapley and Scarf(1974), Shapley and Shubik(1972), Kaneko(1982),
% Quinzii(1986), Gale(1986),  Ma(1999),Gul and Stacchetti(1999)).

% Not along these vein, other more algorithm-oriented research 
% matching /auction market game analysis originated in Gale and Shapley(1962), 
% has been integrated into the market game analysis (Crawford and Knoer(1981),
% Kelso and Crawford(1982), Leonard(1983), Demange et al.(1986), 
% Kaneko and Yamamoto(1986),Bikhchandani et al.(2002), Ausubel(2004)). 


%  About known theorems 
%-----------------------------------------

% It had proven that the set of monotone and gross substitutes (GS)
% preferences is the maximal
% class including of `unit demand' preferences where 
% competitive equilibrium (Walrasian equilibrium) exists 
% (see Gul and Stacchetti(1999), Kelso and Crawford(1982)).

% Assuming monotone utility functions, Gul and Stacchetti (1999) provide   
% equivalent conditions to the GS condition, the single improvement (SI)  
% condition and the no-complementarity (NC) condition, which have both
% the natural economic interpretation and the lower complexity than GS .   

% For many classical assignment / exchange models the VCG prices 
% coincides with the minimal of the lattice of Walrasian prices, 
% which naturally interpreted as the dual variables 
% (i.e., shadow prices, or marginal product) 
% (Leonard(1983), Demange et al.(1986), Gul and Stacchetti(1999), etc)

% On the behalf of introducing the later part of this article,
% I will summarizes the result with respect to multi-item auctions.

% In the literature of economics, some dynamic auctions expected to 
% converge into the minimal Walrasian price vector. 
% note: the price vector 'minimal' in the sense that 
% every other Walrasian price vector weakly dominates it.

% And it implements VCG payments in many useful preference models
% despite the impossibility of ascending auction has proved
% (Gul and Stachetti, 2000).

% It is conjectured by Bikchandani et al. that we can design 
% a mechanism which implements the VCG prices as an 
% ascending auction is possible 
% if and only if their 'agents are substitutes' 
% condition is satisfied (Bikhchandani et al., 2002).

% Also the theory has also links to both the duality theorem of 
% linear programming and the primal-dual algorithms in
% combinatorial optimization theory (Shapley and Shubik(1972), 
% Leonard(1983), Bikhchandani and Mamer(1997), Bikhchandani et al. (2002)).

% Lastly, we will refer about the bounded rationality perspective
% its relation to auction mechanisms.

% About dynamic (ascending) auction and VCG prices
%-----------------------------------------
% As a normative thought of economics, if not exact in discrete, 
% heterogeneous, multi-item environment, price based mechanisms 
% (such as a market or an auction) 
% expectedly leads to the effective allocation. 

% The formal approach first appeared in Crawford and Knoer(1981), 
% `salary adjustment process' of Kelso and Crawford(1992),
% and `exact' and `approximate' auctions of Demange et al.(1986).
% English auction algorithm by Gul and Stacchetti(2000) is 
% a generalization by using excess demand set.

% These auctions can be seen as primal-dual algorithms, 
% variants of the discrete generalization of a classic one, 
% Kuhn's Hangarian method
% for assignment problem, with Hall's theorem. 

% As well known, the VCG (Vickrey-Clarke-Groves)
% mechanism provides incentive compatibility and yields 
% an efficient outcome in sealed bid auctions. Further, 
% from which other demand revealing mechanisms has been developed.

% These mechanisms commonly enforce each bidder a fee  
% as following. (Also see the VCG mechanism section of my code.)

% definition: VCG payment q_i(Xi) is 
%  q_i(Xi) = V(N-i) - Sum_other_than_i(u_j(a*)),
% where a* is efficient and V(S):= max Sum_over_S(u_j(a)). 
% for a subset S of N.

% The intended applications of VCG mechanism are, for example, 
% the performance measurement in business/industrial enterprise,
% the congestion control of traffic of network 
% (including internet TCP/IP protocol), as well as the 
% sealed bid auction originally the studied by Vickrey in 1961 paper, 
% the public project selection (such as providing public goods),
% by Clarke in 1972 paper, the evaluating and budgeting team 
% performance by Groves in 1978 paper.

% By rule of VCG payment, V(N)-V(N-j), the marginal product of
% a bidder equals his or her net benefit 
% (See Bikhchandani et al.(2002)).
% The VCG payment q_i(Xi) gives a lower bound of that of 
% Walrasian equilibrium (p, X). That is q_i(Xi) =< 
% (See Gul and Stacchetti(1999)).

% In the English auction game proposed by Gul and Stacchetti, 
% at any stage of auction t, q(t) is computed by the auctioneer, 
% as well as the (estimated) excess demand set, 
% given the profile of reported individual demand sets. 

% Whereas the VCG payments are attained by ascending bid auctions 
% under monotone GS preferences in the sense that the honest
% reporting of demand set is 
% Perfect Bayesian-Nash strategy (Gull and Stacchetti, 2000).
% But they also provided a theorem that GS 
% preferences can not generally be implemented VCG 
% payments by using dynamic auctions. 
% So, the `no gap' condition was needed.

% Further, they proved an impossibility result that there
% is no ascending auction which implements the Vickrey payment 
% for every possible GS preferences when more than or equal to 
% 3 agents and more than or equal to 4 items
%(Thoerem 6 of Gul and Stacchetti(2000)).   

% About auction as primal-dual algorithm
%-----------------------------------------
% The dynamic price adjustment processes has been developed 
% can be seen as the primal-dual algorithms for network/
% combinatorial optimization problems.

% Interestingly, in the case of unit demand preferences it 
% can be reduced to a network optimization (shortest path problem)
% and  the `no negative cycle' condition [*]
% to check the existence of competitive equilibrium 
% (Quinzii, 1986). Gale(1986) provided a generalization 
% of Quinzii's result by KKM combinatorial theory.
% --[*] It has been used as the simplex criteria of other  
% non-primal-dual algorithms, such as a Kline method starting with 
% a spanning tree, which solves minimal cost flow --- 

% Conversely, auction can be seen as a decentralized solver   
% system which embodied primal-dual algorithm
% for various network optimization problems. 

% It starts finding an optimal assignment of relaxation problems 
% for each agent and for which the mechanism iteratively 
% strength them keeping the dual optimality with `price' vectors---
% the dual variables or the potential
% (see Bikhchandani et al.(2002)).
% So also it would be generalized in terms of matroid theory
% or of submodular systems (Gul and Stacchetti(2000), 
% Fujishige(1991)).

% However, the solution of relaxation dual of the original 
% (combinatorial) assignment problem may fail to exist, 
% so the auction process can not attain it 
% (Ausubel (2004), Bikhchandani et al. (2002), Gul and Stacchetti (2000)).

% Bikhchandani and Ostroy(see Bikhchandani et al.(2002))
% established the necessary and sufficient
% condition of this class of preferences,
% the `agents are substitutes' condition:
% for all coalition of agents,
%  v(N)-v(S) >= Sum_over_i_other_than_S( v(N)-v(N-[i]) ).
% Intuitively, the contribution of any group is not less than 
% the sum of each individual contribution out of the group.  

% About e-auction, bounded rationality and social emotions
%-----------------------------------------

% Computational aspect/implementation of the market /auction 
% mechanisms and their design have been directed attention of 
% researchers of multi-agent system(distributed AI) or e-commerce. 
% (For example, Nisan and Ronen(2001). Also  `Mathematics of the internet:
% e-auction and markets' (Dietrich and Vohra eds., 2002, Springer Verlag)
% which includes Bikhchandani et al.(2002). ) 

% More generally, game theory draws attention in the context of 
% network computing because of the strategic analysis
% for e-business and e-marketplace, the mechanism design for 
% network trafic congenstion control, 
% and the computational realization of game mechanisms 
% with more efficient algorithm for the solution
% such as the winner determination of combinatorial 
% e-auction.

% As well known, combinatorial auction, bundling equilibrium, 
% automated mechanism design, and so on are recently topics 
% in these researches and the related fields.

% Further, it seems promising that with respect to the development of 
% boundedly rational modeling, not as the mere computational limit,
% but the endogenous explanation by 
% cognitively or sociologically oriented perspectives. 

% The perspectives incorporate societal utility as well as satisficing
% principle (or cognitive limitation), for example `spite', `envy', `hostility',
% `harassment' or even `trust' into the game and their effect on the solutions, 
% the dynamics.

% Above perspective has been investigated mainly by the experimental 
% decision/game theorists.
% Recently, it also draws attention of researchers of e-auctions or mutili-agent 
% systems. Morgan et al.(2003) and Brandt et al.(2005) are both 
% argued the effect of `spite' on the single-item auction outcome 
% and on the VCG payments.

% Some impossibility results of implementation in mechansim 
% design theory have been showed, including above English auction result,
% may be remedied by so called `anomalies' in experimental 
% decision and game theory. 

% As conventional way of justifying the normative theory of 
% economics (or management science/operationas research), 
% peoples in action are not rational as in these theories, 
% therefore an adequate normative (or prescriptive) theory 
% for the decision making and the judgment would be required. 

% But there may exist an another point. They are not so ego-centric,
% in the theory, who have motievs, rather distributed, not always centralized, 
% driven by the socio-emotional factors, 
% and so they also have the intentional device (the consciousness) 
% which rationalize conflicts among them, not merely 
% executing the reservation-level adjusting 
% for which many researchers frequently mentioned as `the satisficing' 
% following Herb. Simon. 

% Modeling for co-workers effect
%-----------------------------------------

% By the way, modeling of societal emotion does not necessarily reqire 
% a totally new technique, since there are many cases  
% where game with externalities can be applied.

% Ma(2001) has extended the model so as to incorporate co-workers (dis)utility,
% and so complementarity between workers (and firms).
% As well as it integrates with the privious modeling technique, 
% it involves with the modeling of soio-psychological motivations. 

% For this labor market model, earlier results for usual market game analysis 
% may not work. 

% Indeed, Ma showed examples where by adding  (dis)utility of co-workers
% to a job market nonempty core vanishes.

% As a result, the sufficinet conditions for a nonempty core 
% (the gross substitutes condition in Kelso and Crawford(1982), 
% or the single improvement condition Gul and Stacchetti(1999) and so on)
% preserves by extending production function as follows.

% According to the way which Shapley and Shubik(1969) used for modeling for 
% game with externality, Ma(2001) transformed it as 
%  u_f'(i; Si) = u_f(i; Si)
%   + Sum_over_coworker_j_in_Si( u_cw(j, Si, i) ) 
% for each firm i.

% That is `the matter of concern' with respect to 
% co-workers effect is moved to each firm from the workers 
% who the firm hires,
% therefore a labaor market `as if no disutility or disutility of co-workers .'
%  
% Also, it may be seen as a degenerate form of combinatorial auction 
% which is restricted to the pooled pricing strategy,
% in that no pricing strategy of bundle(co-workers)-dependent 
% is permited whereas the agent's evaluation may be.

% Because this transformation does not change the coalitional 
% form game, the nonempty core property preserves (Theorem 1 and Theorem 2).

% Togather with two other moderate assumptions (u_f'([])=0 and 
% existence of the optimal u_f' for all firms and partitions of workers),
% the labor market of this new production function has also 
% the sufficient for the nonempty core in usual analysis,
% so the gross substitutes condition is ( Theorem 3). 
% The proof is provided by means of a modification of 
% the `salary-adjustment process' by Kelso and Crawford(1982) ). 

% And togather with the linear programming duality theorem, 
% the dual linear relaxation problem provides  
% the necessary and sufficient condition of nonempty core(Theorem 4).

% Nonliner pricing for co-workers effect 
%-----------------------------------------

% On the other hand, the core equivalence theorem, as for the competitive 
% equilibrium, the balancedness condition (Ma,1998) which is necessary
% and sufficient in standard model, does not preserve since 
% the assumed pricing system is independent of the wffect of
% co-workers. 

% The failure above mentioned can be restored only if 
% one uses a nonlinear pricing where the wage offer profiles
% depend on the firm-workers coalition. 

% Ma argued a job market model augmented with the
% taxation and subsidization scheme in Shapley and Shubik(1969),
% which transfer t
% for example, by setting t(j,Si; i) = u_cw(j,Si; i),
% from the worker j to the firm i,
% preserves both the nonemptiness of the t-core (Theorem 8) and 
% the core equivalence (as for the competitive equilibrium)
% (Theorem 9 ).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   references
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [1] Ausubel, L.M. (2004). An efficient ascending-bid auction 
%  for multiple objects. 
%  American Economic Review 94(5), 1452-75.
% [2] Bikhchandani, S. and Mamer, J.W. (1997).
%  Comptitive equilibrium in an  exchange economy with indivisibilities.
%  Journal of Economic Theory 74, 385-413.
% *[3] Bikhchandani, S. and De Vries, S., Schummer, J., and Vohra, R.V. (2002).
%  Linear programming and Vickrey auctions.
%  In Dietrich, B. and Vohra, R.V. (eds.), 
%  Mathmetics of the internet: e-auction and markets,
%  Springer Verlag, pp. 75-115.
% [4] Brandt, F., Sandholm, T., and Shoham, Y. (2005).
%  Spiteful bidding an sealed-bid auctions.
%  In proccedings of GTDT workshop at IJCAI conference 2005. 
%  (downloadable from author's homepage. http://www.cs.cmu.edu/~sandholm/) 
% [5] Demange, G., Gale, D., and Sotomayor, M. (1986).
%  Multi-item auctions.
%  Journal of Political Economy 94(4), 863-72.
% [6] Fujishige, S. (2005).
%  Submodular Functions and Optimization. 2nd Edition. 
%  North-Holland. (The first edition was published in 1991.)
% [7] Gale, D. (1984).
%  Equilibrium in a discrete exchange economy with money.
%  International Journal of Game Theory 13(1), 61-64.
% [8] Gale, D. and Shapley, L. (1962). 
%  College admissions and the stability of marriage.
%  American Mathematical Monthly 69, 9-15.
% *[9] Gul, F. and Stacchetti, E. (2000).
%  The English auction with differentiated commodities.
%  Journal of Economic Theory 92, 66-95.
% *[10] Gul, F. and Stacchetti, E. (1999).
%  Walrasian equilibrium with gross substitutes.
%  Journal of Economic Theory 87, 95-124.
% [11] Kaneko, M. (1982).
%  The central assignment game and the assignment markets.
%  Journal of Mathematical Economics 10, 205-232.
% [12] Kaneko, M. and Yamamoto, Y. (1986).
%  The existence and computation of competitive equilibria in markets 
%  with an indivisible commodity.
%  Journal of Economic Theory 38(1), 118-136.
% *[13] Kelso, A.S. and Crawford, V.P. (1982). 
%  Job matching, coalition formation, and gross substitutes.
%  Econometrica 50, 1483-504.
% *[14] Leonard,H.B.(1983).
%  Elicitation of honest preferences for the assignment of 
%  indivisuals to positions.
%  Journal of Political Economy 91(3), 461-479.
% *[15] Ma, J. (1998). Competitive equilibrium with indivisibilities. 
%  Journal of Economic Theory 82, 458-68.
% *[16] Ma, J. (2001). Job matching and coalition formation with 
%  utility or disutility od co-workers. 
%  Games and Economic Behavior 34, 83-103.
% [17] Morgan, J., Steiglitz, K., and Reis, G. (2004).
%  The spite motive and equilibrium behavior in auction.
%  Contributions to Economic Analysis and Policy 2(1),
%  article 5. (The B.E. Journals in Economic Analysis & Policy,
%  downloadable from http://www.bepress.com/bejeap)
% [18] Nisan N. and Ronen, A. (2001).
%  Algorithmic mechanism design.
%  Games and Economic Behavior 35, 166-96.
% [19] Quinzii, M. (1984).
%  Core and competitive equilibria with indivisibilities.
%  International Journal of Game Theory 13(1), 41-60.
% [20] Shapley, L. and Scarf, H. (1974). 
%  On cores and indivisibility.
%  Journal of Mathematical Economics 1, 23-37.
% [21] Shapley, L. and Shubik, M. (1969). 
%  On the core of an economic system with externalities.
%  American Economic Review, 59(4), 678-684.
% [22] Shapley, L. and Shubik, M. (1972). 
%  The assignment game I: the core.
%  International Journal of Game Theory 1, 111-30.
%
% Our model base includes examples in above * marked references. 


return to front page.