title:-
A=[
'% Second Price Auction : A Vickrey-Clarke-Groves Mechanism ',
'% program: spa.pl ',
'% created: 28-30 Jun 2004.',
'% previous: pivotal.pl(28 Jun 2004)',
'% author: Kenyo Indo (Kanto Gakuen University)',
'% --------main predicates ---------',
'% go/0, pivotal/1, pivotal_data/2.  ',
'% find_best_response_of/5, nash_equilibrium/1.  ',
'% truthful/3, truth_telling_profile/1.  ',
'% explain/0, explain_j/0, reference.',
'% allocation/4 (combinatorial auction in Appendix)'
],   forall(member(L,A),(nl,write(L))),nl.

reference:-
A=[
'% reference:',
'% [1] Clarke, E. (1971). Multipart pricing of public goods. Public Choice 11: 17-33. ',
'% [2] Groves, T. (1973). Incentives in teams. Econometrica 41: 617-31. ',
'% [3] Holtzman, R., N. Kfir-Dahav, D. Monderer, and M. Tennenholtz (2004). Bundling equilibrium in combinatorial auctions. Games and Economic Behavior 47: 104-123. ',
'% [4] Pekec,A. and M. H. Rothkept (2003). Management Science 49(11):1185-1503.',
'% [5] Vickrey, W. (1961). Counterspeculation, auctions, and competitive sealed tenders. Journal of Finance 16: 8-37. '
],   forall(member(L,A),(nl,write(L))).


% generalization : Groves mechanism. 

explain:- 
  forall(explanation(E,F),(nl,write(E),nl, tab(2),write(F))).

explanation('******* VCG Mechanism for Auction *********','definitions').
explanation('cost of implementation for the project: ','r.').
explanation('social decision:','x, allocation of goods. x[i] is the i`s aquisition. ').
explanation('payment for individual i : ','m[i]. The tuple m is a social transfer.').
explanation('utility function: ','u[i] = U[i,truth](x[i]) - m[i], where U is valuation.').
explanation('strategy space: ','each i reports a real number Ur[x,i]. (direct revelation)').
explanation('profile of reports: ','n-dimensional tuple Ur.').
explanation('social choice rule: ','f(Ur) = ( x(Ur), m(Ur) ).').
explanation('(rule1) ','x(Ur)= argmax sum(Ur(x)). ').
explanation('(rule2) ','m[i](Ur) = max sum(Ur[k\=i](x)) - sum(Ur[k\=i](x(Ur)) + h[i](Ur[k\=i]).').




%-------------------------------------
% Script for Mechanisms
%-------------------------------------

:- dynamic pivotal_data/2.

clear:-
   abolish(auction_data/2).

go:-
   clear,
   go1.

go1:-
   auction(_O),
   fail.

go1:-
   write(end).

%-------------------------------------
% Agents and Valuations 
%-------------------------------------
agent(A):-agents(W),member(A,W).
% projects
object(A):-objects(W),member(A,W).

% same as example 1 in model_base/1.
agents([a,b,c]).
objects([x,y,z]).

% true valuation
%  valuation(Agent,State,Object,Utility).
valuation(a,[x],10). 
valuation(b,[x],2). 
valuation(c,[x],9). 
valuation(a,[y],3). 
valuation(b,[y],10). 
valuation(c,[y],5). 
valuation(a,[z],4). 
valuation(b,[z],6). 
valuation(c,[z],1). 

% binary comparison.
prefer_to(Agent,O1,O2):-
   valuation(Agent,O1,U1), 
   valuation(Agent,O2,U2),
   U1 >= U2. 


% agent's bid 

strategy_of(A,B):-
   agent(A),
   length(L,11),
   nth1(K,L,_),
   B is (K-1).

strategy_profile_0([],[]).

strategy_profile_0([A|B],[C|D]):-
   strategy_profile_0(B,D),
   strategy_of(A,C).
   
strategy_profile(B):-
   agents(A),
   strategy_profile_0(A,B).


%------------------------------------
% Vickrey's Second Price Auction : A VCG Mechanism
%------------------------------------

auction(O):-
   object(O),
   agents(I),
   strategy_profile_0(I,P), % profile of bid
   %allocation & transfer
   spa_rule([bids:P,win:W,by:HP,price:SP],allocate:L,prices:T),
   payoff(O,I,L,T,V),
   assert(
     auction_data(
       [object:O,winner:W,by:HP,price:SP],
       [agent:I,bid:P,payment:T,payoff:V]
     )
   ).

% ranking_of_bids(+P,-Top,-Second)
%---------------------------

% The highest bidder wins.
% The winner must pay the second highest value in the bids.
% It is the price what might have paid if he/she did not win.

spa_rule([bids:P,win:Winner,by:TopPrice,price:SecondPrice],allocate:L,prices:T):-
   agents(I),
   rank_bidder_value_pairs(agents:I,bids:P,rank:RANK),
   allocate_rule(agents:I,rank:RANK,allocate:L),
   payments_rule(agents:I,rank:RANK,prices:T),
   RANK=[TopPrice-Winner|[SecondPrice-_|_]].

rank_bidder_value_pairs(agents:I,bids:P,rank:RANK):-
   findall(B-A,(nth1(K,I,A),nth1(K,P,B)),PA),
   sort(PA,SPA),
   reverse(SPA,RANK).

allocate_rule(agents:I,rank:RANK,allocate:L):-
   RANK=[_TopPrice-Winner|_],
   findall(LA, (member(A,I),win_price(Winner-1,A-LA)),L).

payments_rule(agents:I,rank:RANK,prices:T):-
   RANK=[_TopPrice-Winner|[SecondPrice-_|_]],
   findall(TA, (member(A,I),win_price(Winner-SecondPrice,A-TA)),T).

win_price(X,X):-!.
win_price(_,_-0).

/*

?- spa_rule([bids:[1,3,5],A,B,E],C,D).

A = win:c
B = by:5
E = price:3
C = rank:[5-c, 3-b, 1-a]
D = prices:[0, 0, 3] 

Yes
?- 

*/

% payoff(+O,+I,+L,+T,-V)
%---------------------------
payoff(O,I,L,T,V):-
   findall(VA,
    (
     nth1(K,I,A),
     nth1(K,T,TA),
     nth1(K,L,LA),
     valuation(A,[O],UA),
     VA is LA * UA - TA
    ),
   V).

%---------------------------
% find best response of agent
%---------------------------

:- dynamic nash_data/3.

find_best_response_of(A,O,PK,VK,Data):-
   agents(I),
   agent(A),
   object(O),
   nth1(K,I,A),
   nth1(K,V,VK),
   nth1(K,P,PK),
   Data=auction_data(
     [object:O,winner:_W,by:_HP,price:_SP],
     [agent:I,bid:P,payment:_T,payoff:V]
   ),
   (\+ clause(Data,_) ->go;true), 
   find_best_response_0([O,I,A,K,VK,P],Data).

find_best_response_0(X,PD):-
   clause(nash_data(best,X,PD),_),
   !.

find_best_response_0(X,PD):-
   clause(nash_data(not_best,X,PD),_),
   !,
   fail.

find_best_response_0([O,I,A,K,VK,P],AD):-
   X=[O,I,A,K,VK,P],
   DD=auction_data(
     [object:O,winner:_W,by:_HP,price:_SP],
     [agent:I,bid:P1,payment:_T1,payoff:V1]
   ),
   AD,
   \+ (
     DD,
     forall(
       nth1(J,P,PJ),
       (nth1(J,P1,PJ);J=K)
     ),
     nth1(K,V1,V1K),
     V1K >VK,
     assert(nash_data(not_best,X,AD)),
     Y=[O,I,A,K,V1K,P1],
     assert(nash_data(defeat(X),Y,DD))
   ),
   assert(nash_data(best,X,AD)).


% (inefficient)

find_all_best_responses:-
   (clause(nash_data(_,_,_),_)
    ->
     (
      write('Will you abolish all nash_data/3 ? (y/n) '),nl,
      write('Note: It will take you some minutes. >'),
      read(y)
     );true
   ),
   abolish(nash_data/3),
   forall(
     find_best_response_of(_A,_O,_B,_C,_AD),
     true
   ).


nash_equilibrium(AD):-
   (\+ clause(nash_data(_,_,_),_)->find_all_best_responses;true),
   AD=auction_data(
     [object:O,winner:_W,by:_HP,price:_SP],
     [agent:I,bid:P,payment:_T,payoff:_V]
   ),
   AD,
   X=[O,I,A,_K,_VK,P],
   forall(member(A,I),
     nash_data(best,X,AD)
   ).

/*

?- find_all_best_responses.
Will you abolish all nash_data/3 ? (y/n) >y.
end

Yes
?- tell_goal('spa_ne.pl',forall,nash_data(_,_,_)).  % Save Data to File.

Yes

*/


% optimality of truthfulness
%---------------------------

truthful(Y,PD,Z):-
   Y=[O,I,A,K,VK,P],
   _X=[[P,I,K],[A,O,PK,VK]],
   object(O),
   agents(I),
   valuation(A,[O],PK),
   nth1(K,I,A),
   nth1(K,P,PK),
   nth1(K,V,VK),
   PD=auction_data(
     [object:O,winner:_W,by:_HP,price:_SP],
     [agent:I,bid:P,payment:_T,payoff:V]
   ),
   PD,
   is_best_response([A,O,PK,VK,PD],Z1),
   Z=Z1.


is_best_response([A,O,PK,VK,PD],best):-
   find_best_response_of(A,O,PK,VK,PD),
   !.

is_best_response(_,not_best).


truth_telling_profile(PD):-
   PD=auction_data(
     [object:O,winner:_W,by:_HP,price:_SP],
     [agent:I,bid:TT,payment:_T,payoff:_V]
   ),
   PD,
   findall(ZK,
    (
     member(A,I), 
     valuation(A,[O],ZK)
    ),
   TT).

/*

?- truth_telling_profile(A),  nash_equilibrium(A).

A = auction_data([object:x, winner:a, by:10, price:9],
 [agent:[a, b, c], bid:[10, 2, 9], payment:[9, 0, 0], payoff:[1, 0, 0]]) ;

A = auction_data([object:y, winner:b, by:10, price:5],
 [agent:[a, b, c], bid:[3, 10, 5], payment:[0, 5, 0], payoff:[0, 5, 0]]) ;

A = auction_data([object:z, winner:b, by:6, price:4],
 [agent:[a, b, c], bid:[4, 6, 1], payment:[0, 4, 0], payoff:[0, 2, 0]]) ;

No

% proving dominance.
%-----------------------

?- truthful(A,B,not_best).

No

*/

%-----------------------------------------------------------------
%  Appendix. Determining Winner of Combinatorial Auction
%-----------------------------------------------------------------
% mimicing the example of A. Pekec and M. H. Rothkept (2003).

valuation_c(X,[],0):-agents(I),member(X,I).
valuation_c(a,[x],1). 
valuation_c(b,[x],1). 
valuation_c(c,[x],0). 
valuation_c(a,[y],3). 
valuation_c(b,[y],2). 
valuation_c(c,[y],1). 
valuation_c(a,[z],1). 
valuation_c(b,[z],0). 
valuation_c(c,[z],2). 

valuation_c(a,[x,y],Z):-A is 1, valuation_c(a,[x],X),valuation_c(a,[y],Y),Z is X+Y+A. 
valuation_c(b,[x,y],Z):-A is 0, valuation_c(b,[x],X),valuation_c(b,[y],Y),Z is X+Y+A.
valuation_c(c,[x,y],Z):-A is 0, valuation_c(c,[x],X),valuation_c(c,[y],Y),Z is X+Y+A.
valuation_c(a,[y,z],Z):-A is 0, valuation_c(a,[z],X),valuation_c(a,[y],Y),Z is X+Y+A.
valuation_c(b,[y,z],Z):-A is 0, valuation_c(b,[z],X),valuation_c(b,[y],Y),Z is X+Y+A.
valuation_c(c,[y,z],Z):-A is 0, valuation_c(c,[z],X),valuation_c(c,[y],Y),Z is X+Y+A.
valuation_c(a,[x,z],Z):-A is 0, valuation_c(a,[x],X),valuation_c(a,[z],Y),Z is X+Y+A.
valuation_c(b,[x,z],Z):-A is 4, valuation_c(b,[x],X),valuation_c(b,[z],Y),Z is X+Y+A.
valuation_c(c,[x,z],Z):-A is 0, valuation_c(c,[x],X),valuation_c(c,[z],Y),Z is X+Y+A.

valuation_c(a,[x,y,z],4). 
valuation_c(b,[x,y,z],5). 
valuation_c(c,[x,y,z],6). 

goods_c([x,y,z]).
agents_c([a,b,c]).


winner_in_subset(E,I,U):-
   (var(E)->(goods_c(ALL),subset_of(E,_,ALL),E\=[]);true),
   max(U,
    (
     valuation_c(I,E,U)
    )
   ).

/*

?- winner_in_subset(A,B,C),nl,write(A-B-C),fail.

[z]-c-2
[y]-a-3
[y, z]-a-4
[x]-a-1
[x]-b-1
[x, z]-b-5
[x, y]-a-5
[x, y, z]-c-6

No
?- 

*/


allocation_0([],[],[],[],0).
allocation_0(Goods,[X|Sold],[I|Agents],[U|Values],SUM):-
   subset_of(X,_,Goods),
   subtract(Goods,X,Remains),
   allocation_0(Remains,Sold,Agents,Values,SUM_0),
   valuation_c(I,X,U),
   SUM is SUM_0 + U.

allocation(G,A,U ,TotalValue):-
   goods_c(S),
   agents_c(A),
   allocation_0(S,G,A,U ,TotalValue).

/*

?- allocation(B,C,D,E),nl,write(C:D:E:B),fail.

[a, b, c]:[0, 0, 6]:6:[[], [], [x, y, z]]
[a, b, c]:[0, 0, 1]:1:[[], [z], [x, y]]
[a, b, c]:[0, 2, 2]:4:[[], [y], [x, z]]
[a, b, c]:[0, 2, 0]:2:[[], [y, z], [x]]
[a, b, c]:[0, 1, 3]:4:[[], [x], [y, z]]
[a, b, c]:[0, 5, 1]:6:[[], [x, z], [y]]
[a, b, c]:[0, 3, 2]:5:[[], [x, y], [z]]
[a, b, c]:[0, 5, 0]:5:[[], [x, y, z], []]
[a, b, c]:[1, 0, 1]:2:[[z], [], [x, y]]
[a, b, c]:[1, 2, 0]:3:[[z], [y], [x]]
[a, b, c]:[1, 1, 1]:3:[[z], [x], [y]]
[a, b, c]:[1, 3, 0]:4:[[z], [x, y], []]
[a, b, c]:[3, 0, 2]:5:[[y], [], [x, z]]
[a, b, c]:[3, 0, 0]:3:[[y], [z], [x]]
[a, b, c]:[3, 1, 2]:6:[[y], [x], [z]]
[a, b, c]:[3, 5, 0]:8:[[y], [x, z], []]
[a, b, c]:[4, 0, 0]:4:[[y, z], [], [x]]
[a, b, c]:[4, 1, 0]:5:[[y, z], [x], []]
[a, b, c]:[1, 0, 3]:4:[[x], [], [y, z]]
[a, b, c]:[1, 0, 1]:2:[[x], [z], [y]]
[a, b, c]:[1, 2, 2]:5:[[x], [y], [z]]
[a, b, c]:[1, 2, 0]:3:[[x], [y, z], []]
[a, b, c]:[2, 0, 1]:3:[[x, z], [], [y]]
[a, b, c]:[2, 2, 0]:4:[[x, z], [y], []]
[a, b, c]:[5, 0, 2]:7:[[x, y], [], [z]]
[a, b, c]:[5, 0, 0]:5:[[x, y], [z], []]
[a, b, c]:[4, 0, 0]:4:[[x, y, z], [], []]

No
?- max(E,allocation(B,C,D,E)).

E = 8
B = [[y], [x, z], []]
C = [a, b, c]
D = [3, 5, 0] ;

No
?- 

*/


%---------------------------
%  Common Programs
%---------------------------

% sum
%---------------------------
sum([],0).
sum([X|Members],Sum):-
   sum(Members,Sum1),
   Sum is Sum1 + X.

% maximal solution for given goal clause : a naive solver 
%---------------------------------------------------------

max(X,Goal):-
  % X: the objective variable,
  % Goal: the objective function and constraints,
  setof((X,Goal),Goal,Z),
  member((X,Goal),Z),
  \+ (
    member((Y,_),Z),
    Y > X
  ).

% a sequence of binary choice for a list:
%--------------------------------------------------
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).
%
% subset_of/3 : subset-enumeration 
% -----------------------------------------------------------  %
subset_of(A,N,As):-
   length(As,L),
   length(D,L),
   list_projection(D,As,B),
   length(B,N),
   sort(B,A).
%
% complementary list projection
%--------------------------------------------------
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).

% -----------------------------------------------------------  %
% output to file.
% -----------------------------------------------------------  %
tell_test(Goal):-
  open('tell.txt',write,S),
  tell('tell.txt'),
  Goal,
  current_stream('tell.txt',write,S),
  tell(user),wn(end),
  close(S).
%


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).


% saving all successful goals to a file.
%--------------------------------

tell_goal(File,forall,G):-
   G0 = (nl,write(G),write('.')),
   G1 = forall(G,G0),
   tell_goal(File,G1).


% time stamp
%--------------------------------

tstamp(no,T):-
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
   nl.

tstamp(Word,T):-
   \+ var(Word),
   Word \= no,
   get_time(U),
   convert_time(U,A,B,C,D,E,F,_G),
   T = [date(A/B/C), time(D:E:F)],
%   format('~`.t~t~a~30|~`.t~t~70|~n',[Word]),
   write((Word,T)),
   nl.


:- title.

% end