ttl(['***  Nash implementation theory on Prolog 2: the strong implemenation ***
','% code: imple13b.pl (16 Nov 2005 12:25 pm)
','% Sep 2001--Jan 2003; 13-17 Mar, 24-31 Oct, 1-16 Nov 2005
','% language: SWI-prolog 5.0.10.
','% ?- setup_domain or set_model : set the domain model.
','% ?- test_impl : test the Nash implementability.
','% ?- test_nash : generate a nash equilibrium.
','% ?- wsid : a command line help. 
','% ?- contents : contents. 
','% ?- reference_list(v) : references.
','% ?- explain_me: telling stories.
']).

% CAUTION!! This system comes with absolutely no warranty.
% Theoretical misunderstandings or programming bugs 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.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   Contents 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)0

% added: 15 Mar 2005

% You can jump to each section of number # by
% text search with a word (+)#.

contents(C):- C=['
','% CONTENTS
','%  Preface
','%  1. Social choice environment
','%  2. Preference orderings: the domain
','%  3. Model base of preference domains
','%  4. Script for generating preferences
','%  5. Analysis of the preferences
','%  6. SCC: social choice correspondece
','%  7. Script for generating SCC
','%  8. Conditions for SCC
','%  9. Further conditions for SCC
','% 10. Eliminating the awkward outcomes: Condition Mu and Mu2
','% 11. Strong Nash implementation :coalition-proofness (almost complete)
','% 12. Designing mechanisms (1): the message space
','% 13. Designing mechanisms (2): the game forms
','% 14. Nash equilibrium
','% 15. Tesing implementability in Nash equilibrium
','% 16. Command line user interfaces 
','% 17. Getting started with domain : The modelbase management tools
','% 18. Common programs
','% 19. History of development and revision
','% 20. References
','% 21. Startup
'].

contents_jp(C):- C=['
','% ���e
','% �@�܂�����
','% �@�P�D�Љ�I���‹� 
','% �@�Q�D�I�D�����F�h���C��
','% �@�R�D�I�D�h���C���̃��f���x�[�X
','% �@�S�D�I�D�̎��������X�N���v�g
','% �@�T�D�I�D���f���̕��́F�I�D�t�]�A��ʏW��Lcc�A����D�Ȃ�
','% �@�U�D�Љ�I��Ή�  (SCC)
','% �@�V�D�Љ�I��Ή��̐����X�N���v�g
','% �@�W�DSCC�ɂ‚��Ă̏�����(1)�F
	�P�����A�u���b�L���O�A�l�������AMR�����A�����ʂȂ�
','% �@�X�DSCC�ɂ‚��Ă̏�����(2)�F
	�p���[�g�œK�A�������A�ƍفANVP�A�S���v�A�ŏ����R��`�Ȃ�
','% �P�O�DSCC�̏������ɂ‚��Ă̌���(3)�F����Mu��Mu2�A����I���ʂ̏���
','% �P�P�D���i�b�V�����s�F�C�Ӓ�g�ւ̑ϐ��i�قڊ����j
','% �P�Q�D���J�j�Y���̐݌v(1)�F���b�Z�[�W
','% �P�R�D���J�j�Y���̐݌v(2)�F�Q�[���t�H�[��
','% �P�S�D�i�b�V���ύt
','% �P�T�D�i�b�V�����s�̎����X�N���v�g
','% �P�U�D���[�U�C���^�t�F�[�X
','% �P�V�D�h���C���̐ݒ�F���f���x�[�X�Ǘ��c�[��
','% �P�W�D���ʃv���O����
','% �P�X�D�J���Ɖ���
','% �Q�O�D�Q�l����
','% �Q�P�D�V�X�e����������
'].
 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   preface
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% By means of prolog programming, our system intends to mimic 
% (strong) Nash implementation problems under complete information
% for abstract social choice setting. 


% With the game theoretical analysis [*1], Nash implementation theory
% ( Maskin(1998), Maskin and Sjostrom(2002), Moore(1993)) 
% sheds light on the incentive aspect of decentralizd mechanisms for 
% a model of society or economy as well as the aspect of 
% communication and complexity required to realize that control.
% (The later is a somewhat abstracting the information technology.) 

% The approach which models one of above two or both is also called 
% the `mechanism design' theory. 

% With respect to the incentive aspect of decentralization, 
% a mechanism should be expected to provide indirect control
% for agent's selfish behavior, so that the set of Nash equilibrium [*1b]
% coincides with SCC, the socially desired set of choice objects,
% even if each member tends to greed benefit by lying or decieving. [*2]

%  Roughly, the theory 
% aims to support the role of a social planner who has a mission 
% that without knowing the true preference profile of the members 
% of his/her society to realize some idealistic states of the resource allocation
% which is described as a SCC by means of non-cooperative games  
% played by the members.  [*3] 

% This mission is generally not possible if you adopted a preference
% modeling like as the Arrowean setting and the dominace strategy 
% equilibrium as the solution concept.
% The impossiblity is well-known as the Gibbard-Satterthwaite theorem
% in the sense that the SCC should be dictatorial whenever implementable
% under several conditions.

%  The most basic modeling assumes complete information, i.e., 
% the case where each member knows each other the true, and the possible,
% preference ordering profiles.
% This means relatively small sized members, namely, a team. [*4]

%  As naturally conjectured, compromising on the set of Nash 
% equilibrium the result will be improved, however, at the expense of
% leaving a nest of the revelation principle. [*5]

%  Maskin's theorem is well-known since 1970's( See, Maskin(1999)). 
% Many researchers have been tried to expand or generalize the notion of
% Nash implementation per se and the (canonical) mechanism used 
% in his sufficiency proof(See Saijo,1988).

%  In ealry 1990's, the neccesary and sufficient condition  
% has given by Dutta and Sen(1991), and Moore and Repullo(1991), then 
% elaboratively developed by many researchers including the papers
% in references.
% ----------------------------------------------------------- %
% FOOTNOTE:
% [*1] Game theory has been applied for modeling implementation problems, 
% because it is traditional mathematical analysis tools of 
% economic, political, or other autonomous, and often conflicting 
% behavior of agents. Game player is thought as the virtual role for 
% an agent who assumed to have the interrelated motivation with moves  
% of other players but plays selfishly at his/her move of the game
% (i.e., only maximizing the his/her own profit).

% [*1b] Nash equilibrium is the best response tuple of all agents,
% so any single deviator from it would not be benefited. 
% Alternatively it can be defined as follows: 
%  Let respectively, R, a (true) preference profile,
%  and S, a strategy profile, of all agents,
%  the outcome `a' choosen by mechanism a=g(S,R) is a Nash equilibrium 
%  iff for any, s'[i], a strategy of agent i,  
%   g(S/s'[i]) is an element of lcc(i,a,R) for all i,
% where lcc( i,a,R) represents agent i's `lower contour set', 
% i.e., the set of outcomes which is not strictly prefered to a. 
% This is an equivalent definition of the Nash equilibrium for ordinal 
% preference models such as the social choice problems we intended 
% to try modeling in this source code. 

% [*2] The preference of an agent is assummed to be representable as 
% the rankings (preference orderings) for each  social choice objects 
% (alternatives). On the other hand, SCC, the social choice correspondence,
% is defined as a mapping from the possible preference profiles to the subset of 
% alternatives( choice objects for the society). 

% [*3] which is called the `mechanism' or the game form a collection 
% of games with varying payoffs depends on the true preferences of 
% the players (i.e.,members of the society)
% as well as the strategy profile. It would be called
% a direct mechanism if the outcome function defined over possible 
% is the tuple of preference profiles reported by the players. 

% [*4] so it is quite different in the informational aspect of 
% implementation problem in contrast with the strategy-proof mechanisms, 
% as argued in the Gibbard-Satterthwaite theorem. Indeed a relaxation 
% in the direction of informational decentralization (by strengthing the 
% ignorance) makes almost every SCCs implementable (see Matsushima, 1988).

% [*5] mechanisms should have some additional dimensions are needed. 
% But substantial complexity brought in those message space as for 
% preference profiles can be reduced(See Saijo(1988) and Matsushima(1988)). 



% declarations of dynamic predicates.
% ----------------------------------------------------------- %
% modified: 7,8 Jan 2003. for SWI-prolog version 5 and after.

:- dynamic preference/3.
:- dynamic difference/3.
:- dynamic scc/3.
:- dynamic environment/3.
:- dynamic mechanism/3.
:- dynamic impl_stream/3.
:- dynamic br_stream/3.
:- dynamic br_result/1.
:- dynamic current_model_defaults/1.
:- dynamic true_state/1.
:- dynamic last_goal/1.
:- dynamic wsid_history/1.
:- dynamic    game_form/4.



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% �Љ�I���‹� 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)1

% ----------------------------------------------------------- %
%  1. Social choice environment
%  Alternatives, Agents, States, and Preferences
% ----------------------------------------------------------- %
% edited : since Sep 2001.
% modified : 14 Oct 2005. revise
% modified: 31 Oct 2005. added all_objects_in_domain/3.

% social environment, including agents' preferences, states, 
% and alternatives (i.e., candidates of the social choice objectives).


%  collection of objects from domain model base
% ----------------------------------------------------------- %
% added: 31 Oct 2005

all_objects_in_domain( D, O, Os):-
   member( (O:X), [alternative:A,agent:I,state:S]),
   findall(X,
    (
     modelbase(D,preference,I,S,R),
     member(A,R)
    ),
   B),
   sort(B,Os).

/*

?- all_objects_in_domain( jp, O, Os).

O = alternative
Os = [w, x, y, z] ;

O = agent
Os = [1, 2, 3] ;

O = state
Os = [s1, s2] ;

No
?- 
*/

%  preference based construction on current domain
% ----------------------------------------------------------- %

all_alternatives(As):-
   findall(A,
    (
     preference(_,_,R),
     member(A,R)
    ),
   B),
   sort(B,As).

all_agents(Is):-
   findall(J,preference(J,_,_),B),
   sort(B,Is).

all_states(Ss):-
   findall(S,preference(_,S,_),B),
   sort(B,Ss).

%  synonyms
% ----------------------------------------------------------- %
% (the facts *_0/1 would be generated by setmodel.)

:- dynamic set_of_alternatives_0/1.
:- dynamic set_of_states_0/1.
:- dynamic set_of_agents_0/1.

% a sample code 
set_of_alternatives_0([w,x,y,z]).
set_of_agents_0([1,2,3]).
set_of_states_0([s1,s2]).


set_of_alternatives(As):-
   clause( set_of_alternatives_0(As),true).
set_of_alternatives(As):-
   \+ clause( set_of_alternatives_0(_),true),
   all_alternatives(As).

set_of_agents(Is):-
   clause( set_of_agents_0(Is),true).
set_of_agents(Is):-
   \+ clause( set_of_agents_0(_),true),
   all_agents(Is).

set_of_states(Ss):-
   clause( set_of_states_0(Ss),true).
set_of_states(Ss):-
   \+ clause( set_of_states_0(_),true),
   all_states(Ss).


%  individual model objects
% ----------------------------------------------------------- %
% modified: 2 Jan 2002.
% modified: 13,15 Mar 2005.

alternative(A):-
   set_of_alternatives(As),
   member(A,As).
alternative(A):-
   \+ var(A),
   !,
   set_of_alternatives(As),
   \+ member(A,As),
   write(A:'no such alternative.'),
   nl,
   fail.

agent(I):-
   set_of_agents(N),
   member(I,N).
agent(I):-
   \+ var(I),
   !,
   set_of_agents(N),
   \+ member(I,N),
   write(I:'no such agent.'),
   nl,
   fail.

state(S):-
   set_of_states(Ss),
   member(S,Ss).
state(S):-
   \+ var(S),
   !,
   set_of_states(Ss),
   \+ member(S,Ss),
   write(S:'no such state.'),
   nl,
   fail.


%  subsets for some model objects
% ----------------------------------------------------------- %
powerset_of_alternatives(X):-
   set_of_alternatives(As),
   powerset_of(X,As). 

subset_of_alternatives(Y,N):-
   set_of_alternatives(As),
   subset_of(Y,N,As).

subset_of_agents(Y,N):-
   set_of_agents(As),
   subset_of(Y,N,As).

subset_of_states(Y,N):-
   all_states(Ss),
   subset_of(Y,N,Ss).

two_person([J1,J2]):-
   set_of_agents(Is),
   member(J1,Is),
   member(J2,Is),
   J1 < J2.


% A social choice environment for N persons.
% ----------------------------------------------------------- %
% modified: 25 Oct 2002.
% modified: 14 Mar 2005.  separated environment/3.
% modified: 4 Nov 2005.  moved. gen_environment/3 ==>sec. (+)17.

% environment/3 which may be modified by using 
% gen_environment/3 or setup_domain/0 (see section 17).

% environment(
%   [Agents, States, Alternatives],
%   [NumberOfAgents, NumberOfStates, NumberOfAlternatives],
%   PreferenceOrderingsOfEachAgent
% ).


% for default domain (model: jp)

environment(
   [[1,2,3],[s1,s2],[w,x,y,z]],
   [3,2,4],
   [
    [[x,z,y,w],[y,z,x,w],[z,x,w,y]],
    [[x,z,y,w],[y,z,x,w],[z,x,y,w]]
   ]
).



% ���ӁF
%  �h���C���ݒ肨��ъ‹�����(setup_domain, gen_environment)
%  ���R�}���h�͑�17�߂Ɉړ������B
% note:
%  The command setup_domain has moved to Section 17, 
%  17. Getting started with domain models



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% �G�[�W�F���g�̑I�D
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)2

% ----------------------------------------------------------- %
%  2. Preference orderings
% ----------------------------------------------------------- %
% edited from: Sep 2001.

% rational preferences of individuals, which is a profile 
% of (reflective,) complete and transitive binary relations. We will utilize Prolog 
% list operations to represent the preference orders as well as the state space. 

% ----------------------------------------------------------- %
%  (default) preference model 
% ----------------------------------------------------------- %
% please copy a tuple of preference/3 and difference/3
% from following soup stock of examples :

/*  the default domain model  */

preference(1,s1,[x,z,y,w]).
preference(2,s1,[y,z,x,w]).
preference(3,s1,[z,x,w,y]).
preference(1,s2,[x,z,y,w]).
preference(2,s2,[y,z,x,w]).
preference(3,s2,[z,x,y,w]).
% extended relations for above example, optionally.
difference(_,_,[s,s,s,end]).

% note:
% The meaning of each argument in difference/3 
% correspondes to that of preference/3 resp.
% [s:strict_prefer, w:weak_prefer, e:indifferent]
% to the succeeding alternative.



/*
% the example 2 of Moore-Repullo(1990). an elementary coding.
preference(1,s1,[a,c,d,b,z]).
preference(1,s2,[a,d,c,b,z]).
preference(1,s3,[a,c,d,b,z]).
preference(1,s4,[a,d,c,b,z]).
preference(2,s1,[b,c,d,a,z]).
preference(2,s2,[b,d,c,a,z]).
preference(2,s3,[b,d,c,a,z]).
preference(2,s4,[b,c,d,a,z]).
%
% indifference�̎������@�F�I�D��ނ̒lj��B���_�Fprefer_to���������΂悢�B
% �����̂��Ƃ̔�r�͂������������
difference(1,s1,[s,s,s,e,end]).
difference(1,s2,[s,s,s,e,end]).
difference(1,s3,[s,s,s,e,end]).
difference(1,s4,[s,s,s,e,end]).
difference(2,s1,[s,s,s,e,end]).
difference(2,s2,[s,s,s,e,end]).
difference(2,s3,[s,s,s,e,end]).
difference(2,s4,[s,s,s,e,end]).
*/

/*

% the example 2 of Moore-Repullo(1990). more sophisticated modelling.

% the monotone scc mr, which is implementable, is rvp, not nvp,
% with the "bad outcome" z.  
preference(1,S11,[a,c,d,b,z]):-member(S11,[s1,s3]).
preference(2,S21,[b,c,d,a,z]):-member(S21,[s1,s4]).
preference(1,S12,[a,d,c,b,z]):-member(S12,[s2,s4]).
preference(2,S22,[b,d,c,a,z]):-member(S22,[s2,s3]).
difference(_,_,[s,s,s,e,end]).
%
*/


% ----------------------------------------------------------- %
% rational preference ordering
% (weak ordering: transitive, reflective, complete)
% ----------------------------------------------------------- %
%  revised: 14 Oct 2005  new code without nth1/3

% 
is_prefer_to(I,S,X,X):-
   preference(I,S,Order),
   member(X, Order).

is_prefer_to(I,S,X,Y):-
   preference(I,S,Order),
   append(_,[X|W],Order),
   member(Y,W).

is_prefer_to(I,S,X,Y):-
   preference(I,S,Order),
   difference(I,S,Diffs),
   differences_between(Order,Diffs,X->Y,_,XY_Diffs),
   sort( XY_Diffs, [e]).

differences_between(Order,Diffs,X->Y,Between,XY_Diffs):-
   \+ var( Order),
   \+ var( Diffs),
   append(_,[Y|Z],Order),
   append(Between,[X|_],Z),
   list_projection( P, Order, [Y|Between]),
   list_projection( P, Diffs, XY_Diffs).

% indifference relation

indifferent_to(I,S,X,Y):-
   is_prefer_to(I,S,X,Y),
   is_prefer_to(I,S,Y,X).

% strict ordering.
is_strict_prefer_to(I,S,X,Y):-
   is_prefer_to(I,S,X,Y),
   preference(I,S,Order),
   nth1(J,Order,X),
   nth1(K,Order,Y),
   J < K,
   difference(I,S,Diffs),
   nth1(L,Diffs,s),
   L >= J, L =< K. 

% equivalents assuming NAF(nagation as failuare).

%is_strict_prefer_to(I,S,X,Y):-
%   is_prefer_to(I,S,X,Y),
%   \+indifferent_to(I,S,X,Y).

% an erroneous code.
%is_strict_prefer_to(I,S,X,Y):-
%   is_prefer_to(I,S,X,Y),
%   \+is_prefer_to(I,S,Y,X).



% ----------------------------------------------------------- %
% preference profiles
% ----------------------------------------------------------- %
% Sep 2001.
% modified: 25 Aug 2002.
% modified: 24,29,30 Oct 2005.


% true, or false, preference profile
% ----------------------------------------------------------- %

% true_prefer_profile

true_prefer_profile(Is,S,Rs):-
   prefer_profile( Is,S,Rs).

% the true profile with agent indices (added: 30 Oct 2005)

prefer_profile_1( Is, State, Rs):-
   subset_of_agents(Is,_N),
   bagof((I,Rk),
    I^(
     member(I,Is),
     preference(I,State,Rk)
    ),
   Rs).

% the true profile without agent indices 
% (conform ourselves to the earlier modeling)

prefer_profile( Is, State, Rs):-
   prefer_profile_1( Is, State, Rs1),
   findall(Rk,
     member((_I,Rk),Rs1),
   Rs).

% masking the state
% (not restricted to the admissible profile.)
% revised: 30 Oct 2005.

prefer_profile(Is,Rs):-
   subset_of_agents(Is,_N),
   prefer_profile_2( Is,_,Rs).

prefer_profile_2( [], [], []).
prefer_profile_2( [J|Is], [S|States], [R|Rs]):-
   prefer_profile_2( Is, States, Rs),
   preference( J, S, R).


%  set of all possible (admissible) of profiles
% ----------------------------------------------------------- %

% the true profile with state-and-agent indices
%  (added: 30 Oct 2005)

prefer_profiles_1(Is,Ss,Rs):-
   subset_of_agents(Is,_N),
   set_of_states(Ss),
   bagof((S,Rss),
    S^(
     member( S, Ss),
     prefer_profile_1( Is,S,Rss)
    ),
   Rs).

% the true profile without indices
% in accordance with the earlier modeling

prefer_profiles_1(Is,Ss,Rs1,Rs):-
   prefer_profiles_1(Is,Ss,Rs1),
   findall(Rks,
    (
     member((_S,Rss),Rs1),
     findall(Rk,
       member( (_I,Rk),Rss),
       Rks
     )
    ),
   Rs).

% prefer_profiles/3
% (conform ourselves to the earlier modeling)

prefer_profiles(Is,Ss,Rs):-
   prefer_profiles_1(Is,Ss,_,Rs).



% profile by using maplist/3

m_profiles(Is,Rs):-
   subset_of_agents(Is,_N),
   my_maplist(m_profile(preference),Is,Rs).






%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  �I�D�̈�̃��f���x�[�X
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)3

% ----------------------------------------------------------- %
%  3. Model base of preference domains
% ----------------------------------------------------------- %

% modified: 25 Oct 2002. permit on-line simulation mode.
% modified: 16 Mar 2005. added the range, states, and agents in domain.
% modified: 24 Oct 2005. rename. stock_of/5-> modelbase/5.
% modified: 28 Oct 2005. correct & rename. alternatives_in_domain_model/2. (<-range_of...)
% modified: 9 Nov 2005. added mr0 (the pair of domain and scc), a nonimplementable two-person case.  

domain_models(Doms):-
   findall(M,modelbase(M,_,_,_,_),Ms),
   sort(Ms,Doms).

states_in_domain_model(Domain,D):-
   setof(S,
    J^P^modelbase(Domain,preference,J,S,P),
   D).

alternatives_in_domain_model(Domain,R):-
   setof(X,
    J^S^P^(
      modelbase(Domain,preference,J,S,P),
      member(X,P)
     ),
   R).

agents_in_domain_model(Domain,Is):-
   setof(J,
    P^S^modelbase(Domain,preference,J,S,P),
   Is).


% ���ӁF
%  �ȉ��̃��f���x�[�X�𗘗p����ɂ̓h���C���ݒ�
%  �R�}���h(setup_domain)���g���܂��B
%  �������R�[�h�͑�17�߂Ɉړ����܂����B
% note:
%  A command setup_domain is useful to deal with 
%  mode bases below. The codes has moved to Section 17. 


/* some ristricted domains in the literature */


% jp: a restricted domain (a voting in Jackson and Palfrey (2001))
%---------------------------------------------------------------------
% Note: since there are only 2 states, rule 3 of gM (or gMR) 
% will not be invoked if 0-integered.
% available scc, f,scc1,f1,f0,g,g0,g1,g2,g4, ...

modelbase(jp,preference,1,S,[x,z,y,w]):-member(S,[s1,s2]).
modelbase(jp,preference,2,S,[y,z,x,w]):-member(S,[s1,s2]).
modelbase(jp,preference,3,s1,[z,x,w,y]).
%modelbase(jp,preference,1,s2,[x,z,y,w]).
%modelbase(jp,preference,2,s2,[y,z,x,w]).
modelbase(jp,preference,3,s2,[z,x,y,w]).

% extended relations for the above example optionally.
modelbase(jp,difference,_,_,[s,s,s,end]).

% jp uses a standard ranking of default scc and game form

%modelbase(jp,default,scc,good,f).
%modelbase(jp,default,game_form,good,gM).

% mr0: a restricted domain (Example 1 of Moore-Repullo(1990))
%---------------------------------------------------------------------
% scc mr0 is nonimplementable two-person choice rule for this domain.  
% added: 9 Nov 2005.

modelbase(mr0,preference,1,s1,[b,a]).
modelbase(mr0,preference,2,s1,[a,b]).
modelbase(mr0,preference,2,s2,[b,a]).
modelbase(mr0,preference,1,s2,[a,b]).
modelbase(mr0,preference,1,s3,[b,a]).
modelbase(mr0,preference,2,s3,[b,a]).

modelbase(mr0,difference,_,_,[s,end]).

modelbase(mr0,default,scc,good,mr0).
modelbase(mr0,default,game_form,good,gMR2).

% mr: a restricted domain (Example 2 of Moore-Repullo(1990))
%---------------------------------------------------------------------
% scc mr is monotone for this domain, and implementable.
% other properties are rvp, not nvp, and with the "bad outcome" z.  

modelbase(mr,preference,1,S11,[a,c,d,b,z]):-member(S11,[s1,s3]).
modelbase(mr,preference,1,S12,[a,d,c,b,z]):-member(S12,[s2,s4]).
modelbase(mr,preference,2,S21,[b,c,d,a,z]):-member(S21,[s1,s4]).
modelbase(mr,preference,2,S22,[b,d,c,a,z]):-member(S22,[s2,s3]).
modelbase(mr,difference,_,_,[s,s,s,e,end]).

% mr is an only available scc in this version which fits this domain.

modelbase(mr,default,game_form,good,gTmr).
modelbase(mr,default,game_form,good,gMR2).


% md: a restricted domain (footnote 91 of Moore(1992))
%---------------------------------------------------------------------
% scc md is implementable but is not strongly monotone.
% scc: s1-> a;s2->b;s3->c.

modelbase(md,preference,1,s1,[a,d,c,b]).
modelbase(md,preference,1,s2,[d,a,b,c]).
modelbase(md,preference,1,s3,[c,a,d,b]).
modelbase(md,preference,2,S,[b,a,d,c]):-member(S,[s1,s2]).
modelbase(md,preference,2,s3,[b,c,a,d]).
modelbase(md,difference,_,_,[s,s,s,end]).

% md is an only scc which fits this domain.

modelbase(md,default,game_form,good,gMR2).

% ks: a King Solomom example in Wolinsky and Rubinstein(1994)
%---------------------------------------------------------------------

% the scc ks: scc(ks,s1,[a]).scc(ks,s2,[b]).

modelbase(ks,preference,1,s1,[a,b,d]).
modelbase(ks,preference,2,s1,[b,d,a]).
modelbase(ks,preference,1,s2,[a,d,b]).
modelbase(ks,preference,2,s2,[b,a,d]).
modelbase(ks,difference,_,_,[s,s,end]).

modelbase(ks,default,scc,good,ks).
% among available SCCs = [ks, ksnpo, kspo1, kspo2, kspo3, y2]
/*
?- set_of_scc_fit_domain(A,_,_,ks).

A = [ks, kspo1, kspo2, kspo3, y1, y2] 

Yes
*/

% ks1: another King Solomom (ibid, excercise, p.191)
%---------------------------------------------------------------------
% monotone but not Nash-implementable with scc ks.?

modelbase(ks1,preference,1,s1,[a,c,b]).
modelbase(ks1,preference,2,s1,[c,b,a]).
modelbase(ks1,preference,1,s2,[c,a,b]).
modelbase(ks1,preference,2,s2,[b,c,a]).
modelbase(ks1,difference,_,_,[s,s,end]).

modelbase(ks1,default,scc,good,ks).

% a digression:
% same allegory is popular in Japan as `O-oka sabaki`(Judgment of O-oka Echizen).

% y1: Example 2 of Yamato(1992)
%---------------------------------------------------------------------
% ex 2. with scc y1.
%scc(y1,s1,[a,c]).
%scc(y1,s2,[c]).

modelbase(y1,preference,1,s1,[a,b,c]).
modelbase(y1,preference,2,s1,[c,a,b]).
modelbase(y1,preference,3,s1,[c,a,b]).
modelbase(y1,preference,1,s2,[b,a,c]).
modelbase(y1,preference,2,s2,[c,a,b]).
modelbase(y1,preference,3,s2,[c,a,b]).
modelbase(y1,difference,_,_,[w,w,end]).

modelbase(y1,default,scc,good,y1).
modelbase(y2,default,game_form,good,gMR2).


% y2: Examples 3 of Yamato(1992)
%---------------------------------------------------------------------
% ex 3. with scc y1,y2.
%scc(y2,s1,[a,b]).
%scc(y2,s2,[a]).

modelbase(y2,preference,1,s1,[a,b,c]).
modelbase(y2,preference,2,s1,[c,b,a]).
modelbase(y2,preference,3,s1,[c,b,a]).
modelbase(y2,preference,1,s2,[a,c,b]).
modelbase(y2,preference,2,s2,[c,a,b]).
modelbase(y2,preference,3,s2,[c,a,b]).
modelbase(y2,difference,_,_,[w,w,end]).

modelbase(y2,default,scc,good,y2).
modelbase(y2,default,game_form,good,gMR2).

% suh: the example of Suh(1996), 
%---------------------------------------------------------------------
% scc suh is strongly implemetable with this domain.

modelbase(suh,preference,1,S1,[b,a,d,c,e,f]):-member(S1,[s11,s12,s13]).
modelbase(suh,preference,1,S1,[d,b,a,c,e,f]):-member(S1,[s21,s22,s23]).
modelbase(suh,preference,1,S1,[b,d,a,c,e,f]):-member(S1,[s31,s32,s33]).
modelbase(suh,preference,2,S2,[e,d,c,a,b,f]):-member(S2,[s11,s21,s31]).
modelbase(suh,preference,2,S2,[d,b,a,c,e,f]):-member(S2,[s12,s22,s32]).
modelbase(suh,preference,2,S2,[c,d,b,a,e,f]):-member(S2,[s13,s23,s33]).
modelbase(suh,difference,_,_,[w,w,w,w,w,end]).

modelbase(suh,default,scc,good,suh).
modelbase(suh,default,game_form,good,gST).

/*  approximated universal domains  */

% ud22: the (stict) universal domain for 2 outcomes and two agents
%---------------------------------------------------------------------

modelbase(ud22,preference,1,S11,[x,y]):-member(S11,[s1,s2]).
modelbase(ud22,preference,1,S12,[y,x]):-member(S12,[s3,s4]).
modelbase(ud22,preference,2,S21,[x,y]):-member(S21,[s1,s3]).
modelbase(ud22,preference,2,S22,[y,x]):-member(S22,[s2,s4]).
% extended relations for above example, optionally.
modelbase(ud22,difference,_,_,[s,end]).

modelbase(ud22,default,scc,good,udd1).
modelbase(ud22,default,scc,good,urd1).

% ud23: the (strict) universal domain for 3 outcomes and two agents
%---------------------------------------------------------------------
% note: computational complexity consideration
% probably, this is not computationary tractable in enumerating sccs.
% #(possible orderings) = (#(oucomes)!) << =2*1=2 if ud22;=6 if ud23 >>
% #(states) = #(possible orderings)^#(agents) << =2^2=4 ud22;=6^2=36 ud23 >>
% #(subsets of outcomes) = 2^#(oucomes)  <<  2^2 ud22; 2^3 ud23  >>
% #(possible sccs) = (2^#(subsets of outcomes))^#(states) << 4^4=256; 8^36 >>

% modified: 17 Mar 2005.

modelbase(ud23,preference,1,S,P1):-
   member((S1,P1),[
     (s1,[x,y,z]),(s2,[x,z,y]),
     (s3,[y,z,x]),(s4,[y,x,z]),
     (s5,[z,y,x]),(s6,[z,x,y])
   ]),
   member(S2,[1,2,3,4,5,6]),
   concat(S1,S2,S).

/*
% the old version
modelbase(ud23,preference,1,S,[x,y,z]):-
   member(S2,[1,2,3,4,5,6]),concat(s1,S2,S).
modelbase(ud23,preference,1,S,[x,z,y]):-
   member(S2,[1,2,3,4,5,6]),concat(s2,S2,S).
modelbase(ud23,preference,1,S,[y,z,x]):-
   member(S2,[1,2,3,4,5,6]),concat(s3,S2,S).
modelbase(ud23,preference,1,S,[y,x,z]):- 
   member(S2,[1,2,3,4,5,6]),concat(s4,S2,S).
modelbase(ud23,preference,1,S,[z,y,x]):-
   member(S2,[1,2,3,4,5,6]),concat(s5,S2,S).
modelbase(ud23,preference,1,S,[z,x,y]):-
   member(S2,[1,2,3,4,5,6]),concat(s6,S2,S).
*/

modelbase(ud23,preference,2,S,P2):-
   member((S2,P2),[
     (1,[x,y,z]),(2,[x,z,y]),
     (3,[y,z,x]),(4,[y,x,z]),
     (5,[z,y,x]),(6,[z,x,y])
   ]),
   member(S1,[1,2,3,4,5,6]),
   concat_v([s,S1,S2],S,3).

/*
% the old version
modelbase(ud23,preference,2,S,[x,y,z]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,1],S,3).
modelbase(ud23,preference,2,S,[x,z,y]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,2],S,3).
modelbase(ud23,preference,2,S,[y,z,x]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,3],S,3).
modelbase(ud23,preference,2,S,[y,x,z]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,4],S,3).
modelbase(ud23,preference,2,S,[z,y,x]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,5],S,3).
modelbase(ud23,preference,2,S,[z,x,y]):-
   member(S1,[1,2,3,4,5,6]),concat_v([s,S1,6],S,3).
*/

% an extended relations for above example, optionally.
modelbase(ud23,difference,_,_,[s,s,end]).


% ud32: universal domain with 3 outcomes and 2 agents
% ----------------------------------------------------------- %
% edited from: Aug 2002. modified: 25 Aug 2002.

modelbase(ud32,preference,J,S,P):-
   ud32_preference([J,S,P]).
modelbase(ud32,difference,_,_,[s,end]).

ud32_preference([J,S,P]):-
   ud32_preferences(Pud32),
   member(Ts,Pud32),
   T=[J,S,P],
   nth1(_K,Ts,T).

ud32_preferences(Pa):-
   Is =[1,2,3],
   Alt=[a,b],
   findall(P,
    ud_profile([Is,Alt],[_N,_M],P),
   Pa),
   numbervars(Pa,s,1,_E).

ud_preference([Is,Alt],[N,M],S,J,[J,S,P]):-
   length(Alt,M),
   length(Is,N),
   member(J,Is),
   ordering(P,Alt,M).

ud_profile([Is,Alt],[N,M],Profile):-
   my_maplist(ud_preference([Is,Alt],[N,M],_S),Is,Profile).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  �I�D�̎��������X�N���v�g
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)4

% ----------------------------------------------------------- %
%  4. Script for generating preferences
% ----------------------------------------------------------- %
% generate_preferences/2, gen_test_preference/5
% added: Aug 2002.
% modified: 25 Aug 2002.

generate_preferences(Is,Profs):-
   subset_of_agents(Is,_),set_of_states(Ss),
   auto_profiles(Ss,Is,Profs),
   forall(
    (nth1(K,Is,J),nth1(U,Ss,S)),
    (
     nth1(U,Profs,Pu),nth1(K,Pu,Puk),
     preference(J,S,P),
     retract(preference(J,S,P)),
     assert(preference(J,S,Puk))
    )
   ).

all_preferences(Rs,Alts,M):-
   set_of_alternatives(Alts),
   length(Alts,M),
   setof(C,
   (
   ordering(C,Alts,M),
   sort(C,Alts)
   ),Rs).

auto_preference(I,S,P):-
   agent(I),state(S),
   set_of_alternatives(Alts),
   length(Alts,M),
   ordering(P,Alts,M).

auto_profile(Is,S,Ps):-
   state(S),
   subset_of_agents(Is,N),
   all_preferences(Rs,_Alts,_M),
   bag0(Ps,Rs,N).

auto_profiles(Ss,Is,Pss):-
   subset_of_agents(Is,_),set_of_states(Ss),
   my_maplist(auto_profile(Is),Ss,Pss).


% testing the auto-generated preferences
% ----------------------------------------------------------- %
% modified: 25 Aug 2002.

gen_test_preference(Profs,Is,F,Goals,NoGoods):-
   subset_of_agents(Is,_),
   GR=[cd,cm,cm2,mm,em,mr,ir,bad,nvp,rvp,unan,po,co,dict,neli,mlib],
   subset_of(Goals,_,GR),
   subset_of(NoGoods,_,GR),
   intersection(Goals,NoGoods,Conflict),
   (Conflict=[]->true
    ;(
      wn([
        'conflicting goals',
        Conflict,
        ' please retry.'
      ]),
      fail
    )
   ),
   wn(p),
   GL =[
     condition_D([Is,_Ss,Profs]),
     condition_M(F,Is),
     condition_M2(F,Is),
     monotone(F,Is),
     ess_monotone(F,Is),
     has_MR_property(F,Is),
     test_irat_n2(F,Is),
     bad_outcome(_Bad,F,Is),
     nvp(F,Is),
     rvp(F,Is),
     unanimity(F,Is),
     has_pareto_property(F,Is),
     has_condorcet_property(F,Is),
     dictatorial(F,Is),
     neli(F,Is),
     mlib(F,Is)
   ],
   !,
   generate_preferences(Is,Profs),
  %set_of_states(Ss),prefer_profiles(Is,Ss,PP),wn(PP),
   forall(
    (
     member(Gx,Goals),nth1(Num,GR,Gx),wn([Num,Gx])
    ),
    (
     nth1(Num,GL,Gox),%wn([go,GoX]),
     Gox
    )
   ),
   forall(
    (
     member(Gx,NoGoods),nth1(Num,GR,Gx),wn([Num,Gx])
    ),
    (
     nth1(Num,GL,GoX),%wn([go_not,GoX]),
     \+ GoX
    )
   ).

   
/*
% the fragment of an earlier version.

member(cd,Goals)->condition_D(Is,Ss,Profs); true),
   scc(F),
   (member(cm,Goals)->condition_M(F,Is); true),
   (member(cm2,Goals)->condition_M2(F,Is); true),
   (member(mm,Goals)->monotone(F,Is) ; true),
   (member(em,Goals)->ess_monotone(F,Is) ; true),
   (member(mr,Goals)->has_MR_property(F,Is) ; true),
   (member(ir,Goals)->test_irat_n2(F,Is) ; true),
   %---------------------------------------------------------%
   (member(bad,Goals)->(bad_outcome(_Bad,F,Is)) ; true),
   (member(nvp,Goals)->nvp(F,Is) ; true),
   (member(rvp,Goals)->rvp(F,Is) ; true),
   (member(unan,Goals)->unanimity(F,Is) ; true),
   (member(po,Goals)->has_pareto_property(F,Is) ; true),
   (member(co,Goals)->has_condorcet_property(F,Is) ; true),
   (member(dict,Goals)->dictatorial(F,Is) ; true),
   (member(neli,Goals)->neli(F,Is) ; true),
   (member(mlib,Goals)->mlib(F,Is) ; true),
   true.
*/



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  �I�D���f���̕��́F
%�@�I�D�t�]�A��ʏW��Lcc�A����D�Ȃ�
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)5

% ----------------------------------------------------------- %
%  5. Analysis of preference models
% ----------------------------------------------------------- %
%  reversal, lower countuor set, maximal elements, condition D, etc. 

% ----------------------------------------------------------- %
% finding reversals.
% ----------------------------------------------------------- %
% edited from: Sep 2001.

% no_reversals/5, no_reversals_1/5, and no_reversals_2/5, (omitted.)
% have a common function to detect a preference reversal.

is_reversal(I,S1,S2,X,Y):-
 %  set_of_states(S),member(S1,S),member(S2,S),
 %  set_of_agents(Society),member(I,Society),
 %  not is_prefer_to(I,S1,Y,X),
   is_prefer_to(I,S1,X,Y),
   is_prefer_to(I,S2,Y,X).

reversals(I,S1,S2,X,A,Rvs):-
  set_of_alternatives(A),
  subset_of_agents(Is,_N),
  set_of_states(S),
  findall((I,X,S1,S2),
   ( 
    member(I,Is),
    member(X,A),
    member(S1,S),
    member(S2,S),
    is_reversal(I,S1,S2,X,_)
   ),
  Rvs).


% ----------------------------------------------------------- %
%   lower/upper contour set (lcc/3,ucc/3)
% ----------------------------------------------------------- %
% edited from: 18 Oct 2001. 

% lower contour set
lcc([I,S,R],A,Lcc) :-
   alternative(A),
   agent(I),
   state(S),
   preference(I,S,R),
   findall(L,
    (
     alternative(L), 
     is_prefer_to(I,S,A,L)
    ),
   Lcc0),
   sort(Lcc0,Lcc).



% the following three variations of lcc is augumented
% in 18 Aug 2002.

% upper contour set
ucc([I,S,R],A,Ucc) :-
   alternative(A),
   agent(I),
   state(S),
   preference(I,S,R),
   findall(L,
    (
     alternative(L), 
     is_prefer_to(I,S,L,A)
    ),
   Ucc0),
   sort(Ucc0,Ucc).


% ----------------------------------------------------------- %
%   strict lower/upper contour set (slcc/3, succ/3)
% ----------------------------------------------------------- %
% added: Aug 2002. 

slcc([I,S,R],A,SL) :-
   alternative(A),
   agent(I),
   state(S),
   preference(I,S,R),
   ucc([I,S,R],A,Ucc),
   set_of_alternatives(As),
   subtract(As,Ucc,SL0),
   sort(SL0,SL).

succ([I,S,R],A,SU) :-
   alternative(A),
   agent(I),
   state(S),
   preference(I,S,R),
   lcc([I,S,R],A,Lcc),
   set_of_alternatives(As),
   subtract(As,Lcc,SU0),
   sort(SU0,SU).


% ----------------------------------------------------------- %
%   maximal element
% ----------------------------------------------------------- %
% added: Aug 2002. 

maximal(A,X,[I,S,R]):-
   preference(I,S,R),
   subset_of_alternatives(X,_),X\=[],
   member(A,X),
   lcc([I,S,R],A,Lcc),
   subset(X,Lcc).

maximal_set(Y,X,[I,S,R]):-
   preference(I,S,R),
   subset_of_alternatives(X,_),X\=[],
   findall(A,maximal(A,X,[I,S,R]),Max),
   sort(Max,Y).
   


%    %%%%%%%%%%%%%%%%%%%%%%%%%
%    %%%   condition D   %%%
%    %%%%%%%%%%%%%%%%%%%%%%%%%
%
% ----------------------------------------------------------- %
%�@Condition D  :
%  checking the domain restriction whether it is near universal.
% ----------------------------------------------------------- %
% reference: Yamato(1992), p.487.
% creared: 20 Aug 2002. modified: 25 Aug 2002.
% modified: 25 Sep 2002. arity /2 --> /1

condition_D(Is,Ss,Rs):-
   ((var(Rs),agents(Is),set_of_states(Ss),prefer_profiles(Is,Ss,Rs),wn(initial));\+var(Rs)),
   subset_of_agents(Is,_),
   set_of_alternatives(As),
   forall(
    (
     nth1(K,Ss,S),   % K: the index for the state
     nth1(K,Rs,R),
     nth1(L,Is,J),   % J: the index for the agent
     nth1(L,R,RJ),
     alternative(A),
     lcc([J,S,RJ],A,Lcc),
     member(B,Lcc)%,wn([S,J,A,B])
    ),
    (
     member(S1,Ss),
     lcc([J,S1,_RJ1],B,Lcc),%wn([J,S1,B,Lcc]),
     forall((nth1(_L1,Is,J1),J1\=J),
      (
       %wn([J,S1,B,Lcc]),
       lcc([J1,S1,_RJ2],B,As)
      )
     )
    )
   ).

condition_D_debug([Is,Ss,Rs]):-
   set_of_alternatives(As),
   subset_of_agents(Is,_),
   (var(Rs)->prefer_profiles(Is,Ss,Rs);true),
   forall(
    (
     nth1(K,Ss,S),   % K: the index for the state
     nth1(K,Rs,R),
     nth1(L,Is,J),   % J: the index for the agent
     nth1(L,R,RJ),
     alternative(A),
     lcc([J,S,RJ],A,Lcc),
     member(B,Lcc),wn([S,J,A,B])
    ),
    (
     lcc([J,S1,_RJ1],B,Lcc),tab(2),wn([J,S1,B,Lcc]),
     forall((nth1(_L1,Is,J1),J1\=J),
      (
       tab(4),wn([J,S1,B,Lcc]),
       lcc([J1,S1,_RJ2],B,As)
      )
     )
    )
   ).

% ------------------------------------------------------------ %
%  Checking domain with respect to condition D
% ------------------------------------------------------------ %
% added : 8 Sep 2002.
% but pending. previously, and... I had made the another one like as this.
% modified : 25 Sep 2002.
% modified : 15 Oct 2002.
% modified : 7 Dec 2002.  check_domain /4 has separated from contract_domain /4.
% modified : 2 Nov 2005.  removal of an unnecessary horizontal line.
% modified : 7 Nov 2005.  correct. a spelling ("domain"). 


%  check domain as for the condition D
% ------------------------------------------------------------ %

check_domain(Is,Ss,Rs,yes):-
   prefer_profiles(Is,Ss,Rs),
   condition_D(Is,Ss,Rs),
   display_domain(user),
   wn('The_condition_D_has_satisfied.').

check_domain(Is,Ss,Rs,no):-
   prefer_profiles(Is,Ss,Rs),
   \+condition_D(Is,Ss,Rs),
   display_domain(user),
   wn('This_domain_does__not__satisfy_condition_D.').

%  a trial : domain contraction conform with condition D
%  contract_domain/4
% ------------------------------------------------------------ %

contract_domain(Is,Ss,Rs,dialog):-
   check_domain(Is,Ss,Rs,_YN),
   wn('Are you sure to contract it? (y/n) '),
   read(U),\+U=y.

contract_domain(Is,NewSs,Rs1,_):-
   prefer_profiles(Is,Ss,Rs),
   subset_of(Removed,_,Ss),
   \+member(Removed,[[],Ss]),
   subtract(Ss,Removed,NewSs),
   pairwise_contract_map([NewSs,Ss],[Rs1,Rs]),
   condition_D(Is,NewSs,Rs1),
   wn('---- I found a contracted domain model ! ---'),
   wn(newStates(NewSs)),wn(newDomain(Rs1)),
   wn('Are you really update the model ? (y/n) '),
   read(y),
   forall(
    (
     preference(A,B,C),\+member(B,NewSs)
    ),
     retract(preference(A,B,C))
   ),
   wn('---- updated domain model ---'),
   display_domain(user).

contract_domain(Is,Ss,Rs,_):-
   prefer_profiles(Is,Ss,Rs),
   %\+condition_D(Is,Ss,Rs),
   wn('There_is_no_more_contracted_domain_which_satisfies_condition_D.'),!.



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@�Љ�I��Ή�  (SCC)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)6

% ----------------------------------------------------------- %
%  6. SCC; social choice correspondece
%   and the monotonicity condition
% ----------------------------------------------------------- %
% edited from Sep 2001.
% modified: 16 Mar 2005.  added scc_fit_domain/4 and  
%   revised scc_defined_states/2
% modified: 28 Mar, 3 Nov 2005.  revised. scc_fit_domain/4.

% A social choice correspondece F:S-->->A is a mapping 
% from a state to a (nonempty) subset of alternatives.

% samples of SCC;

% f a non-monotonic SCC
% the example1 (Voting) of Jackson & Palfrey, p.8.

scc(f,s1,[x,z]).
scc(f,s2,[x]).

% next two facts are extended for debug.
%scc(f,s3,[x,z]).
%scc(f,s4,[x]).
%range(f,[x,z]).

% f1 a monotone, but not ess_monotone SCC
scc(f1,s1,[x]).
scc(f1,s2,[x,y]).
%range(f1,[x,y]).

% g a monotone, but not ess_monotone SCC
scc(g,s1,[x,w]).
scc(g,s2,[x]).
%range(g,[x,w]).

% g1 an ess_monotone SCC
scc(g1,s1,[x,w]).
scc(g1,s2,[x,y]).
%range(g1,[x,w,y]).

% g0 an ess_monotone SCC
scc(g0,s1,[x,y]).
scc(g0,s2,[x,y]).
%range(g0,[x,y]).


% g2 an ess_monotone SCC
scc(g2,s1,[w]).
scc(g2,s2,[y]).
%range(g2,[w,y]).

% g4 an ess_monotone SCC
scc(g4,s1,[w,x,y]).
scc(g4,s2,[x,y]).
%range(g4,[w,x,y]).

% mr0 an ess_monotone SCC from Moore and Repullo
% added: 9 Nov 2005.
scc(mr0,s1,[a,b]).
scc(mr0,s2,[a,b]).
scc(mr0,s3,[b]).
%range(mr0,[a,b]).

% mr an ess_monotone SCC from Moore and Repullo
scc(mr,s1,[c]).
scc(mr,s2,[d]).
scc(mr,s3,[c]).
scc(mr,s4,[c]).
%range(mr,[c,d]).

% mr1: a modified scc based on mr.
scc(mr1,s1,[c]).
scc(mr1,s2,[c,d]).
scc(mr1,s3,[c]).
scc(mr1,s4,[c]).

% an example in Moore(1992), footnote 91.
% scc: s1-> a;s2->b;s3->c.
scc(md,s1,[a]).
scc(md,s2,[b]).
scc(md,s3,[c]).

% suh an ess_monotone SCC from Suh(1996)
% modified: 28 Oct 2005 ( Correct. It has been not defined for s23.)

scc(suh,s11,[a,e]).
scc(suh,S2,[b]):-member(S2,[s12,s32]).
scc(suh,S3,[c]):-member(S3,[s13,s23,s33]).
scc(suh,s22,[d]).
scc(suh,s21,[d,e]).
scc(suh,s31,[e]).
%range(suh,[a,b,c,d,e]).


/*
% demo (28 Oct 2005)

?- scc_fit_domain(suh,BR,(N,D),suh).

BR = [a, b, c, d, e], [a, b, c, d, e, f]
N = [1, 2]
D = [s11, s12, s13, s21, s22, s23, s31, s32, s33] 

Yes
?- 

*/

% urd: five auto_generated SCCs for the unristricted domain 
% (its linear order part) of N=2, M=2, each of which clear 
% EM+IR+MR. i.e., is essentially monotone, is individually 
% rational, and has the Moore-Repullo property.

scc(urd0,s1,[]).
scc(urd0,s2,[]).
scc(urd0,s3,[]).
scc(urd0,s4,[]).
%range(urd0,[]).
scc(urd1,s1,[y]).
scc(urd1,s2,[y]).
scc(urd1,s3,[y]).
scc(urd1,s4,[y]).
%range(urd1,[y]).
scc(urd2,s1,[x,y]).
scc(urd2,s2,[y]).
scc(urd2,s3,[y]).
scc(urd2,s4,[y]).
%range(urd2,[x,y]).
scc(urd3,s1,[x]).
scc(urd3,s2,[x]).
scc(urd3,s3,[x]).
scc(urd3,s4,[x]).
%range(urd3,[x]).
scc(urd4,s1,[x]).
scc(urd4,s2,[x]).
scc(urd4,s3,[x]).
scc(urd4,s4,[x,y]).
%range(urd4,[x,y]).


% dictatorial sccs for ud22.
scc(udd1,s1,[x]).
scc(udd1,s2,[x]).
scc(udd1,s3,[y]).
scc(udd1,s4,[y]).
%range(udd1,[x,y]).
scc(udd2,s1,[x]).
scc(udd2,s2,[y]).
scc(udd2,s3,[x]).
scc(udd2,s4,[y]).
%range(udd2,[x,y]).

%  remaining five sccs each of which satisfies em+ir+mr. 
scc(Umd,s1,[x]):-member(Umd,[umd1,umd2,umd3,umd4,umd5]).
scc(Umd,s2,[]):-member(Umd,[umd1,umd2,umd5]).
scc(Umd,s2,A):-member([Umd,A],[[umd3,[x]],[umd4,[y]]]).
scc(Umd,s3,B):-member([Umd,B],[[umd1,[x]],[umd2,[y]]]).
scc(Umd,s3,[]):-member(Umd,[umd3,umd4,umd5]).
scc(Umd,s4,[y]):-member(Umd,[umd1,umd2,umd3,umd4,umd5]).
%range(Umd,[x,y]).



% some problematic sccs for ud22.
scc(umr1,s1,[x]).
scc(umr1,s2,[]).
scc(umr1,s3,[]).
scc(umr1,s4,[]).
%range(umr1,[x,y]).
scc(umr2,s1,[]).
scc(umr2,s2,[]).
scc(umr2,s3,[]).
scc(umr2,s4,[y]).
%range(umr2,[x,y]).
scc(umr3,s1,[x,y]).
scc(umr3,s2,[x,y]).
scc(umr3,s3,[x,y]).
scc(umr3,s4,[x,y]).
%range(umr3,[x,y]).




% pareto corr for ud22.
% also mlib, and unan (a Peleg impossibility) for ud22.
scc(par,s1,[x]).
scc(par,s2,[x,y]).
scc(par,s3,[x,y]).
scc(par,s4,[y]).
%range(par,[x,y]).

% pareto corr for ud22.
% also mlib, and unan (a Peleg impossibility).
scc(par1,s1,[x]).
scc(par1,s2,[x,y]).
scc(par1,s3,[y]).
scc(par1,s4,[y]).
%range(par1,[x,y]).

% non_pareto corr for ud22.
% mlib, and unan (a Peleg impossibility).
scc(pel,s1,[x,y]).
scc(pel,s2,[x,y]).
scc(pel,s3,[y]).
scc(pel,s4,[y]).
%range(pel1,[x,y]).

% not implementable corr for ud22.
scc(fd1,s1,[y]).
scc(fd1,s2,[x]).
scc(fd1,s3,[y]).
scc(fd1,s4,[x]).
%range(fd1,[x,y]).

% not implementable (em+ir,but not mr) corr for ud22.
scc(fr,s1,[x,y]).
scc(fr,s2,[x,y]).
scc(fr,s3,[x,y]).
scc(fr,s4,[x,y]).
%range(fr,[x,y]).

% not implementable (po+em+ir,but not mr) corr for ud22.
scc(po1,s1,[x]).
scc(po1,s2,[x]).
scc(po1,s3,[x]).
scc(po1,s4,[y]).
%range(po1,[x,y]).

% not implementable (po+em+ir,but not mr) corr for ud22.
scc(po2,s1,[x]).
scc(po2,s2,[y]).
scc(po2,s3,[y]).
scc(po2,s4,[y]).
%range(po2,[x,y]).



% King Solomon's choice function.
scc(ks,s1,[a]).
scc(ks,s2,[b]).
% King Solomon's other choice functions.(po+em+ir, not mr).
scc(kspo1,S,[a]):-member(S,[s1,s2]).
scc(kspo2,S,[b]):-member(S,[s1,s2]).
scc(kspo3,S,[a,b]):-member(S,[s1,s2]).
% King Solomon's choice function.(em+ir, not mr, not po).
scc(ksnpo,S,[d]):-member(S,[s1,s2]).




% examples 2,and 3 in Yamato(1992),pp.490-491.
% y1: the scc of example 2
scc(y1,s1,[a,c]).
scc(y1,s2,[c]).
% y2: the scc of example 3
scc(y2,s1,[a,b]).
scc(y2,s2,[a]).


% The range and domain of SCC
% ----------------------------------------------------------- %

sccs(Fs):- setof(F,S^Z^scc(F,S,Z),Fs).
scc(F):-sccs(Fs),member(F,Fs).

all_members(A,B):-setof(D,C^(member(C,A),member(D,C)),B).
range(Scc,C):- setof(Z,S^scc(Scc,S,Z),Zs),all_members(Zs,C).

scc_defined_states(Sd,F):-scc(F),setof(S,Z^scc(F,S,Z),Sd).
%scc_defined_states([],_F).  % abolish(16 Mar 2005)
scc_defined_state(S,F):-scc_defined_states(Sd,F),member(S,Sd).

/*
% The list of available sccs in the file 
% other than scc1 ( auto-generated scc).
% added:16 Mar 2005.

?- setof(F,(scc_defined_states(D,F),range(F,B)),L),
   length(D,N),nl,write((N,states:D,range:B,sccs:L)),fail.

2, states:[s1, s2], range:[x, z], sccs:[f]
2, states:[s1, s2], range:[w, x], sccs:[g]
2, states:[s1, s2], range:[x, y], sccs:[f1, g0]
2, states:[s1, s2], range:[w, y], sccs:[g2]
2, states:[s1, s2], range:[w, x, y], sccs:[g1, g4]
2, states:[s1, s2], range:[d], sccs:[ksnpo]
2, states:[s1, s2], range:[a], sccs:[kspo1]
2, states:[s1, s2], range:[b], sccs:[kspo2]
3, states:[s1, s2, s3], range:[a, b, c], sccs:[md]
4, states:[s1, s2, s3, s4], range:[c, d], sccs:[mr]
8, states:[s11, s12, s13, s21, s22, s31, s32, s33], range:[a, b, c, d, e], sccs:[suh]
4, states:[s1, s2, s3, s4], range:[y], sccs:[umr2, urd1]
4, states:[s1, s2, s3, s4], range:[x], sccs:[umr1, urd3]
4, states:[s1, s2, s3, s4], range:[x, y], sccs:[fd1, fr, par, par1, pel, po1, po2, udd1, udd2, umd1, umd2, umd3, umd4, umd5, umr3, urd2, urd4]
2, states:[s1, s2], range:[a, c], sccs:[y1]
2, states:[s1, s2], range:[a, b], sccs:[ks, kspo3, y2]

No
?- 
*/

% scc_fit_domain/4 
% ----------------------------------------------------------- %
% added: 16 Mar 2005
% modified: 28 Oct2005  revise. alternatives and states to be 
%   paired with range and agents respectively.
% modified: 3 Nov 2005  ranking using good/nogood conditions.


scc_fit_domain(Scc,(B,As),(Is,SD),Domain):-
   domain_models(DMs),
   member(Domain,DMs),
   agents_in_domain_model(Domain,Is),
   states_in_domain_model(Domain,SD),
   scc_defined_states(SF,Scc),
   SD=SF,
   alternatives_in_domain_model(Domain,As),
   range(Scc,B),
   subset(B,As).

set_of_scc_fit_domain(L,R,D,DN):-
   setof(Scc,
     B^Is^scc_fit_domain(Scc,(B,R),(Is,D),DN),
   L).


% with filter 

set_of_scc_fit_domain_with_filter(L,R,D,DN):-
   setof(Scc,
     B^Is^scc_fit_domain_with_filter(Scc,(B,R),(Is,D),DN),
   L).

scc_fit_domain_with_filter(Scc,(B,As),(Is,SD),Domain):-
   scc_fit_domain(Scc,(B,As),(Is,SD),Domain),
   clause( modelbase( Domain, default, scc, good, Scc),_).

scc_fit_domain_with_filter(Scc,(B,As),(Is,SD),Domain):-
   scc_fit_domain(Scc,(B,As),(Is,SD),Domain),
   \+ clause( modelbase( Domain, default, scc, good, Scc),_),
   \+ clause( modelbase( Domain, default, scc, nogood, Scc),_).

scc_fit_domain_with_filter(Scc,(B,As),(Is,SD),Domain):-
   scc_fit_domain(Scc,(B,As),(Is,SD),Domain),
   \+ clause( modelbase( Domain, default, scc, good, Scc),_),
   clause( modelbase( Domain, default, scc, nogood, Scc),_).

test_scc_fit_domain:-
   setof((DN,L,L1,R),
    (
     set_of_scc_fit_domain(L,R,D,DN),
     set_of_scc_fit_domain_with_filter(L1,R,D,DN)
    ),
   XL),
   length(D,N),write('-----'),wn((N-states-models:D)),
   member((DN,L,L1,R),XL),
   wn((domain:DN,range:R)),tab(1),wn(sccs:L),
   tab(1),wn(filtered:L1),
   fail;true.

% demo (3 Nov 2005)
% ----------------------------------------------------------- %
/*

?- test_scc_fit_domain.
-----3-states-models:[s1, s2, s3]
domain:md, range:[a, b, c, d]
 sccs:[md]
 filtered:[md]
-----9-states-models:[s11, s12, s13, s21, s22, s23, s31, s32, s33]
domain:suh, range:[a, b, c, d, e, f]
 sccs:[suh]
 filtered:[suh]
-----4-states-models:[s1, s2, s3, s4]
domain:mr, range:[a, b, c, d, z]
 sccs:[mr]
 filtered:[mr]
domain:ud22, range:[x, y]
 sccs:[fd1, fr, par, par1, pel, po1, po2, udd1, udd2, umd1, umd2, umd3, umd4, umd5, umr1, umr2, umr3, urd1, urd2, urd3, urd4]
 filtered:[fd1, fr, par, par1, pel, po1, po2, udd1, udd2, umd1, umd2, umd3, umd4, umd5, umr1, umr2, umr3, urd1, urd2, urd3, urd4]
-----2-states-models:[s1, s2]
domain:jp, range:[w, x, y, z]
 sccs:[f, f1, g, g0, g1, g2, g4]
 filtered:[f, f1, g, g0, g1, g2, g4]
domain:ks, range:[a, b, d]
 sccs:[ks, ksnpo, kspo1, kspo2, kspo3, y2]
 filtered:[ks, ksnpo, kspo1, kspo2, kspo3, y2]
domain:ks1, range:[a, b, c]
 sccs:[ks, kspo1, kspo2, kspo3, y1, y2]
 filtered:[ks, kspo1, kspo2, kspo3, y1, y2]
domain:y1, range:[a, b, c]
 sccs:[ks, kspo1, kspo2, kspo3, y1, y2]
 filtered:[ks, kspo1, kspo2, kspo3, y1, y2]
domain:y2, range:[a, b, c]
 sccs:[ks, kspo1, kspo2, kspo3, y1, y2]
 filtered:[ks, kspo1, kspo2, kspo3, y1, y2]

Yes
?-
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@�Љ�I��Ή��̐����X�N���v�g
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)7

% ----------------------------------------------------------- %
%  7. Script for generating SCC
% ----------------------------------------------------------- %

% The script coping with user conform:
% ----------------------------------------------------------- %
% gen_test_scc /0 added: 15 Oct 2002.
% modified: 15 Mar 2005. gen_test_scc/0 coping with user interaction.
% modified: 14 Oct 2005. added the argumet. (->gen_test_scc/1 )
% modified: 15 Oct 2005. decomposed into components.

% gen_test_scc/1.

gen_test_scc(SCC):-
   ask_user_property_list_for_scc( UserGoal, _Menu),
   ask_user_model_objects_for_scc( _, [Is,Range,Empty]),
   gen_test_scc(SCC,UserGoal,[Is,Range,Empty]),
   display_generated_scc( SCC, UserGoal).


ask_user_property_list_for_scc( User, Menu):-
   all_scc_properties_available( Menu),
   nl,write('possible conditions:'),
   nl,tab(2),write(Menu),
   nl,write('[input 1] Which conditions to be satisfied?'),
   nl,write(' Please input as a list >'),
   read( User).

ask_user_model_objects_for_scc( [A,B,E], [Is,Range,Empty]):-
   write('[input 2] Who are agents? >'),
   read(A),
   (subset_of_agents(Is,_)-> Is =A),
   write('[input 3] Restriction on range of scc (or full) >'),
   read(B),
   (subset_of_alternatives(B,_)->Range=B),
   write('[input 4] Permit empty scc ? (y/n) '),
   read(E),
   (E=y->true;Empty=nonempty).


%  common programs for test_gen_scc
% ----------------------------------------------------------- %

all_scc_properties_available( Menu):-
   Menu =[mm,em,mr,ir,bad(_),nvp,rvp,unan,po,co,dict,neli,mlib,neu].
  %Base =[_1,_2,_3,_4,_5,    _6, _7, _8,  _9,_10,_11,_12, _13, _14]

scc_properties_available( Goals, G1):-
   all_scc_properties_available( G0),
   subset(Goals, G0),
   normalize_property_list_for_scc( Goals, G0, G1).

% normalization of the list of properties requested by user.

normalize_property_list_for_scc( User, Menu, UserGoal):-
   subset(User,Menu),
   plist_projection(Project,Menu,User,_User1),
   length( Menu, N),
   length( Base, N),
   replace(Project,Menu,Base,UserGoal).

display_generated_scc( SCC, G1):-
   nl,wn('generated scc (as scc1/3):'),
   tab(2), wn(scc1(SCC)),
   tab(2), wn(satisfying(G1)).


% The intermediate level scripts:
% ----------------------------------------------------------- %
% modified: 19 Oct 2002. prerequisit for `structural' match.
% modified: 14 Oct 2005. correct. subset(earlier: subset_of).
% modified: 15 Oct 2005. revision. 
% the goal list normalization has delegated from gen_test_scc/1.

% gen_test_scc/2.  a simplified test.

gen_test_scc(SC_tuples,Goals):-
   scc_properties_available( Goals,_),
   set_of_agents(Is),
   gen_test_scc(SC_tuples,Goals,[Is,full,nonempty]).

% gen_test_scc/3.

gen_test_scc( SC_tuples,Goals,[Is,Range,Empty]):-
   scc_properties_available( Goals, G1),
   subset_of_agents( Is, _),
   generate_scc( scc1, SC_tuples, [Range,Empty]),
   tests_for_scc( scc1, Is, G1).



% The findall scripts:
% ----------------------------------------------------------- %
% added: 15 Oct 2005. 

:- dynamic  gen_test_scc_0/2, last_id_scc_0/1.

make_all_possible_sccs( Goals,[Range,Empty,Is]):-
   scc_properties_available( Goals, G1),
   subset_of_agents( Is, _),
   init_last_id_scc_0,
   initialize_scc_0_for([G1,Is,Range,Empty]),
   forall(
    (
     generate_scc(scc1,SCC,[Range,Empty]),
     tests_for_scc(scc1,Is,G1)
    ),
    (
     update_last_id_scc_0( Id),
     assert(
       gen_test_scc_0(SCC,[Id,G1,Is,Range,Empty])
     )
    )
   ),
   display_last_id_scc_0.

init_last_id_scc_0:-
   abolish(  last_id_scc_0/1),
   assert(  last_id_scc_0(0)).

update_last_id_scc_0( N1):-
   retract(  last_id_scc_0(N)),
   N1 is N + 1,
  %write([N1]),
   assert(  last_id_scc_0(N1)).

initialize_scc_0_for([G1,Is,Range,Empty]):-
   forall(
     retract(
       gen_test_scc_0(_,[_,G1,Is,Range,Empty])
     ),
     true
   ).

display_last_id_scc_0:-
   last_id_scc_0(Id),
   nl,
   write( 'last id of gen_test_scc_0':[Id]).

% save the results into a CSV file.

tell_scc_0s:-
   G = forall(
     gen_test_scc_0(SCC,[Id,G1,Is,Range,Empty]),
     (
      findall( (S->F), member( [S,F], SCC), SCC1),
      wn( [Id];SCC1;G1;Is;Range;Empty)
     )
   ),
   tell_goal( 'scc0.txt',G).


set_scc_from_scc_0( SCC, Id, Name):-
   (var( Name)-> Name=scc2;true),
   gen_test_scc_0(SCC,[Id|_]),
   forall(
     member( [S,F],SCC),
     assert( scc(Name,S,F))
   ).


%  demo
% ----------------------------------------------------------- %
/*
?- gen_test_scc(Scc,[em]).

Scc = [[s1, [z]], [s2, [z]]] ;

Scc = [[s1, [y]], [s2, [y]]] ;

Scc = [[s1, [w]], [s2, [y]]] ;

Scc = [[s1, [w, y]], [s2, [y]]] 

Yes
?- make_all_possible_sccs( [mm],[full,nonempty,[1,2,3]]).

last id of gent_test_scc_0:[33]

Yes
?- gen_test_scc_0(Scc,[Id,T|_]).

Scc = [[s1, [z]], [s2, [z]]]
Id = 1
T = [mm, em, -, -, bad(w), nvp, rvp, unan, po|...] ;

Scc = [[s1, [w, z]], [s2, [z]]]
Id = 2
T = [mm, -, -, -, -, nvp, rvp, unan, -|...] ;

Scc = [[s1, [y]], [s2, [y]]]
Id = 3
T = [mm, em, -, -, -, nvp, rvp, unan, po|...] 

Yes
?-

*/


% The core script of scc generation:
% (earlier:gen_test_sccs) renamed: 15 Oct 2005. 
% ----------------------------------------------------------- %
% added: July--Aug 2002. 
% modified: 26 Sep 2002.
% modified: 15 Oct 2005. separated the components of user interface.


generate_scc(F,Cc,[Range,Empty]):-
   member(F,[scc0,scc1,scc2]),
   set_of_states(Ss), length(Ss,K),
   scc_tuple(Cc,K,Ss,[Range,Empty]),
   clear_scc(F),   % note: this position is sensitive.
   update_scc(F,Cc).
%range(scc0,[x,y,z,w]).

scc_tuple([],0,[],[_Range,_Empty]).
scc_tuple([[S,X]|Cr],K,[S|Sc],[Range,Empty]):-
   scc_tuple(Cr,K1,Sc,[Range,Empty]),
   K is K1 + 1,
   set_of_states(Ss),reverse(Ss,Sr),nth1(K,Sr,S),
   subset_of_alternatives(X,_N1),
   (Empty=nonempty->X\=[];true),
   (Range=full->true;subset(X,Range)).

update_scc(scc1,Cc):-
   forall(member([S,X],Cc),assert(scc(scc1,S,X))).

clear_scc(scc1):-
   forall(scc(scc1,S,W),retract(scc(scc1,S,W))).


% Other property-specific scripts:
% ----------------------------------------------------------- %
%added: 23 Sep 2002.

extract_em(Pred,SCC,Conditions):-
   A=[],B=[[_,[]]],C=[em],D=[ng],
   extract_sccs(Pred,SCC,Conditions,[A,B,C,D]).
extract_sccs(Pred,SCC,Conditions,[Cond1,Cond2,Cond3,Cond4]):-
   (member([_,[]],Cond2)->Empty=nonempty;true),
   G=..[Pred,SCC,Conditions,[_Range,Empty]],
   G,
   % 1st condition: SCC keywords;
   % 2nd condition: SCC NG words;
   % 3rd condition: Conditions keywords;
   % 4th condition: Condiitons NG words.
   subset(Cond1,SCC),
   \+subset(Cond2,SCC),
   subset(Cond3,Conditions),
   \+subset(Cond4,Conditions).

gen_test_mr(SC_tuples,G3):-
   set_of_agents(Is),Range=full,Empty=nonempty,
   gen_test_mr(SC_tuples,G3,[Is,Range,Empty]).
gen_test_mr(SC_tuples,G3,[Is,Range,Empty]):-
   generate_scc(scc1,SC_tuples,[Range,Empty]),
   (has_MR_property(scc1,Is) -> G3 = mr; G3 = no).

% gen_test_neutral has added: 1 Sep 2002.
gen_test_neutral(SC_tuples,Neu):-
   set_of_agents(Is),Range=full,Empty=nonempty,
   gen_test_neutral(SC_tuples,Neu,[Is,Range,Empty]).
gen_test_neutral(SC_tuples,Neu,[Is,Range,Empty]):-
   generate_scc(scc1,SC_tuples,[Range,Empty]),
   (is_neutral(scc1,Is) -> Neu = neutral; Neu = no).

% gen_test_mju has added: 1 Sep 2002.
%  modified: 27-8 Sep 2002.
gen_test_mju(SC_tuples,[Gm1,Gm2,Gm3,Gm4]):-
   set_of_agents(Is),
   gen_test_mju(SC_tuples,[Gm1,Gm2,Gm3,Gm4],[Is,full,nonempty]).
gen_test_mju(SC_tuples,[Gm1,Gm2,Gm3,Gm4],[Is,Range,Empty]):-
   generate_scc(scc1,SC_tuples,[Range,Empty]),
   test_mju(scc1,Is,[Gm1,Gm2,Gm3,Gm4]).

% modified: 10 Nov 2002. test_mju has separated from gen_test_mju.
test_mju(Scc,Is,[Gm1,Gm2,Gm3,Gm4]):-
   (condition_mju(Scc,Is,Bx,[yes,yes],[i]) -> Gm1 = mju1; Gm1 = '-'),
   (condition_mju(Scc,Is,Bx,[yes,yes],[ii]) -> Gm2 = mju2; Gm2 = '-'),
   (condition_mju(Scc,Is,Bx,[yes,yes],[iii]) -> Gm3 = mju3; Gm3 = '-'),
   (condition_mju(Scc,Is,Bx,[yes,yes],[iv]) -> Gm4 = mju4; Gm4 = '-').


% gen_test_M has added: 2 Sep 2002.
gen_test_M(SC_tuples,[M1,M2]):-
   set_of_agents(Is),Range=full,Empty=nonempty,
   gen_test_M(SC_tuples,[M1,M2],[Is,Range,Empty]).
gen_test_M(SC_tuples,[M1,M2],[Is,Range,Empty]):-
   generate_scc(scc1,SC_tuples,[Range,Empty]),
   (condition_M(scc1,Is) -> M1 = cnd_M; M1 = no),
   (condition_M2(scc1,Is) -> M2 = cnd_M2; M2 = no).


% ----------------------------------------------------------- %
% testing the major properties for scc.
% ----------------------------------------------------------- %
% edited : Aug 2002.
% modified: 15 Oct 2002.

% each test routine has included in the section of the property resp.


tests_for_scc(F,Is,[G1,G2,G3,G4,BO,G5,G6,G7,G8,G9,G10,G11,G12,G13]):-
   scc(F),
   subset_of_agents(Is,_),
   (monotone(F,Is) -> G1 = mm; G1 = '-'),
   (ess_monotone(F,Is) -> G2 = em; G2 = '-'),
   (has_MR_property(F,Is) -> G3 = mr; G3 = '-'),
   (test_irat_n2(F,Is) -> G4 = ir; G4 = '-'),
   %---------------------------------------------------------%
   ((bad_outcome(Bad,F,Is)) ->BO = bad(Bad); BO = '-'),
   (nvp(F,Is) -> G5 = nvp; G5 = '-'),
   (rvp(F,Is) -> G6 = rvp; G6 = '-'),
   (unanimity(F,Is) -> G7 = unan; G7 = '-'),
   (has_pareto_property(F,Is) -> G8 = po; G8 = '-'),
   (has_condorcet_property(F,Is) -> G9 = co; G9 = '-'),
   (dictatorial(F,Is) -> G10 = dict; G10 = '-'),
   (neli(F,Is) -> G11 = neli; G11 = '-'),
   (mlib(F,Is) -> G12 = mlib; G12 = '-'),
   (is_neutral(scc1,Is) -> G13 = neu; G13 = '-'),
   true.

% ----------------------------------------------------------- %
%   several tests for 2-state case the properties of SCC
% ----------------------------------------------------------- %

test_urd_m2(Out):-
   Out=[Scc,[1,2],Results,Mr],
   member(Scc,[urd1,urd2,urd3,urd4]),
   test_gD(Scc,[1,2],Results,Mr).

test_impl2([A,B],[I,J],[GF,Summary]):-
   generate_scc(scc0,[A,B]),
   two_person([I,J]),
   test_impl(GF,scc0,[I,J],2,Summary).
% save_br_results(_File,_Strm)

test_null(F,[A,B],_):-
   generate_scc(F,[A,B]).

test_mrp(F,[A,B],[J,K]):-
   generate_scc(F,[A,B]),has_MR_property(F,[J,K]).

test_irat(F,[A,B],[J,K]):-
   generate_scc(F,[A,B]),test_irat_n2(F,[J,K]).

test_irmr(F,[A,B],[J,K]):-
   generate_scc(F,[A,B]),test_irat_n2(F,[J,K]),
   has_MR_property(F,[J,K]).

test_ess(F,[A,B],Is):-
   subset_of_agents(Is,_N),generate_scc(F,[A,B]),ess_monotone(F,Is).

test_ess1(F,[A,B],Is):-
   subset_of_agents(Is,_N),generate_scc(F,[A,B]),
   monotone(F,Is),\+ess_monotone(F,Is).

test_mono(F,[A,B],Is):-
   subset_of_agents(Is,_N),generate_scc(F,[A,B]), monotone(F,Is).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@SCC�ɂ‚��Ă̏�����(1)�F
% �P�����A�l�������A�u���b�N�֌W�A
% MR�����Ȃ�
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)8

% ----------------------------------------------------------- %
%  8. Conditions for SCC
% ----------------------------------------------------------- %
%  Maskin/Essential Monotonicity, Individual Rationality, Blocking, 
%  Moore-Repullo Property), etc.

% ----------------------------------------------------------- %
%   A reversion function  h:S-->A. 
% ----------------------------------------------------------- %
% edited : Sep 2001.

% ---the reversion theorem of Nash Implementation Theory-----
% Recently Palfray and Srivastava proposed the another version of Nash 
% implementability  using reversion function and provided the proofs.
% If f is  not monotone, then it is not Nash implementable. But if f is 
% IR-monotone that it is monotone under reversion function with a fixed 
% status quo, H(y,s1,h)=w and H(y,s2,h)=y , then it is IR-implementable.
%  By this reversion, a reversal for the outcome z which has excluded 
% from SCC in stae s2 has occured for agent2 with another outcome y in 
% the range of the revised SCC. 

reversion(h0,_S,_A,_A).
reversion(h1,_S,_A,w).
reversions([h0,h1]).
% And a mapping, H:AxSx[F], induced by the reversion function h is
% H(a,s,h)=a if aR[i](s)h(s)  for all i;=h(s) otherwise.

reversed_map(H,S,A,A):-
   state(S),
   alternative(A),
   reversion(H,S,A,Ch),
   forall(agent(I),
    is_prefer_to(I,S,A,Ch)
   ).   %% -> Z = A; Z = Zh.

% probably, the cut, !, is implicit in if_then, ->, has a side-effect
% to exclude backtracking other tuples for reversed_map. 

reversed_map(H,S,A,Ch):-
   state(S),alternative(A),
   reversion(H,S,A,Ch),agent(I),
   \+ is_prefer_to(I,S,A,Ch).


% ----------------------------------------------------------- %
%   Maskin monotonicity: checking via lcc correspondence.
% ----------------------------------------------------------- %
% edited: Sep 2001. modified: 18 Oct 2001.
% 
% ---the basic theorem of Nash Implementation Theory-----
% Monotonicity is necessary for Nash-implementability if N>2, and 
% is also sufficient if NVP (no veto power) condition is satisfied.
% The proof of this fact proposed by Eric Maskin in 1970's at first
% and has elaborated by Vind, Repullo, and other game theorists. 


monotone(F):-
   set_of_agents(Is),
   monotone(F,Is).

monotone(F,Is):-
   scc(F),
   subset_of_agents(Is,_N),
   % there is a reversal everywhere an outcome retracted from scc.   
   forall(
    (
     state(S),
     scc(F,S,C),
     member(A,C),
     state(S1),% S1 \= S,
     scc(F,S1,C1),
     \+ member(A,C1),%write([A,member_of,C,in,S,out_of,C1,in,S1]),
   true),
   (
    member(I,Is),
    lcc([I,S,_R],A,K1),
    lcc([I,S1,_R1],A,K2),%wn([lcc_of,I,K1,K2]),
    \+ subtract(K1,K2,[]),%wn(ok),
    true)
   ).


% ----------------------------------------------------------- %
% Strong Monotonicity (Essential Monotonicity)
% ----------------------------------------------------------- %
% added: May 2002.

% The properties of 'essentialy-monotone" sccs has explicated 
% in Danilov(1992) and the notion has cited by other papers.

% This shoud be modified so as to be under any subset of agents.
% ess-monotone scc is Nash-implementable if N>=3. Nevertheless,
% is generally not necessary for implementability, but so is when 
% universal domain or its strict part. You can use the condition-D
% by Yamato(1992) to check the domain model is safficient large so
% that ess-monotonicity become necessary condition. 



ess_monotone(F):-
   set_of_agents(Is),
   ess_monotone(F,Is).


%%% The difference between ess_monotnicity and (Maskin-)monotonicity 
%%%  is only in the part [1] and [2] instead of using lcc per se.

ess_monotone(F,Is):-
   scc(F),
   subset_of_agents(Is,_N),
   % for each dropped scc element, there is a reversal in the ess_outcomes.  
   forall(
    (
     state(S),
     scc(F,S,C),
     member(A,C),
     state(S1),% S1 \= S,
     scc(F,S1,C1),
     \+ member(A,C1)
    ),
    (
     member(I,Is),
     lcc([I,S,_],A,Lcc1),  % [1]
     ess(F,I,Lcc1,Ess),   % [2]
     lcc([I,S1,_],A,Lcc2),
     \+ subtract(Ess,Lcc2,[])
    )
  ).


%%% essential set Ess (in the term of Danilov(1992)).

ess(F,I,X,Ess):-
   agent(I),scc(F),
   subset_of_alternatives(X,_),
   findall(A,
    S^R^(
     alternative(A),
     is_essential(A,X,[I,S,R],F)
    ),
   Y),
   sort(Y,Ess).

ess_mon(F,I,X,Ess):-
   agent(I),scc(F),
   subset_of_alternatives(X,_),
   findall(A,
    S^R^(
     alternative(A),
     is_essential_mon(A,X,[I,S,R],F)
    ),
   Y),
   sort(Y,Ess).

% subset of an ess
ess_subset(F,I,X,Ess):-
   agent(I),scc(F),
   subset_of_alternatives(X,_),
   subset_of_alternatives(Ess,_),
   forall(member(A,Ess),
   is_essential(A,X,[I,_S,_R],F)).

is_essential_mon(A,X,[I,S,R],F):-
% this definition of ess is of provided monotonicity
% for unristricted domain only
   preference(I,S,R),%wn([state,S,agent,I,preference,R]),
   scc(F,S,C),
   member(A,C),
   subset_of_alternatives(X,_),
   %maximal(A,X,[I,S,R]),
   lcc([I,S,R],A,Lcc),subset(X,Lcc),
   wn([maximal,A,in,X,pref,R]),
   set_of_alternatives(As),
   forall((agent(J),J\=I),lcc([J,S,_RJ],A,As)).

is_essential(A,X,[I,S,R],F):-
%   (var(X) -> write('set X is unspecified.'),nl,fail);
   subset_of_alternatives(X,_),
   agent(I),
   state(S),
   preference(I,S,R),
   scc(F,S,C),
   member(A,C),
   lcc([I,S,R],A,Lcc),
   subset(Lcc,X).
  %  forall(member(Y,X),alternative(Y)),  % subset(X,Alternatives),
  %  forall(member(Y,Lcc),member(Y,X)).   % subset(Lcc,X),
   % ���ӁF��̕����������ƁAUnbound�ɂȂ��ā����[�v����B




% ----------------------------------------------------------- %
% blocking and individual rationality (in Danilov(1992)).
% ----------------------------------------------------------- %
% added: Jan 2002.  modified: May,July,Aug,Sep 2002.

% blocking via scc 
% def. agent I blocks set B if there is a R(I) s.t.
%    intersection(Scc([R(I),R(-I)]), B) is empty. 

% to sepcify the preference with which the agent blocks an alternative.
is_blocked_by(X,J,[S,RJ],Is,F):-
   alternative(X),
   subset_of_agents(Is,_N),
   nth1(K,Is,J),
   state(S),
   preference(J,S,RJ),
   scc(F,S,_SccVal0),
   forall(
    (
     prefer_profile(Is,S1,R1),
     nth1(K,R1,RJ)
    ),
    (
     scc(F,S1,SccVal),
     \+member(X,SccVal)
    )
   ).

is_blocked_by(X,J,Is,F):-
   scc(F),
   subset_of_agents(Is,_),
   member(J,Is),
   preference(J,S,R),
   max_blocking(Bs,[J,S,R],Is,F),
   subset_of_alternatives(X,_),
   subset(X,Bs).


% maximal blocked set
max_blocking(Bs,[J,S,R],Is,F):-
   scc(F),
   subset_of_agents(Is,_),
   member(J,Is),
   preference(J,S,R),
   findall(X,
    (
     is_blocked_by(X,J,[S,R],Is,F)%,wn([X,J])
    ),
   Bs0),
   sort(Bs0,Bs).

% unblocked pair
% added : Aug 2002.

unblocked_pair([X1,X2],[J1,J2],F):-
   unblocked(X1,J1,[J1,J2],F),
   unblocked(X2,J2,[J1,J2],F).

unblocked0(X,I,Is,F):-
   scc(F),
   subset_of_agents(Is,_N),member(I,Is),
   subset_of_alternatives(X,_M),X\=[],
   forall(member(A,X),
    \+is_blocked_by(A,I,[_S,_R],Is,F)).

unblocked(X,I,Is,F):-
   scc(F),
   subset_of_agents(Is,_N),member(I,Is),
   subset_of_alternatives(X,_M),X\=[],
   \+ is_blocked_by(X,I,Is,F).

test_subadditivity([I,J],F,Result):-
   unblocked_pair([X,Y],[I,J],F),
   intersection(X,Y,W),
   Result=[unblocked,[X,Y],intersect,W].

test_sa(S,F):-results_to_file([test_subadditivity,[1,2],F,_R],'sa.txt',S).


% ----------------------------------------------------------- %
% blocking via mechanism (beta-blocking)
% ----------------------------------------------------------- %
% added: Jan 2002.

beta_blocking(J,Is,MJ,G,E,Blocked):-
   G =.. [_GF, _P, _Scc],
   agent(J),
   subset_of_agents(Is,_N),
   message(G,Is,J,MJ,true),
   findall(B,
    (
     alternative(B),
     is_beta_blocked_by(B,J,Is,MJ,G,E))
   ,Blocked).

is_beta_blocked_by(X,J,Is,MJ,G,E):-
  % set_of_agents(Is),
   subset_of_agents(Is,N),
   member(J,Is),
  % state(S),
   E =.. [environment,[Is,_,_],[N,_,_],_],
   E,
   alternative(X),
   G =.. [GF, P, Scc],
   message(G,Is,J,MJ,true),
   \+ (
    message_profile(GF,Msg1,Scc,Is),
    nth1(J, Msg1, MJ),
    member(P,[1,2,3]),
    mechanism(G,E,Msg1,C),
    member(X,C)
   ).


% ----------------------------------------------------------- %
% individual rationality (individually rational outcomes)
% ----------------------------------------------------------- %
% added: Jan 2002.  modified: May,July,Aug, resp., in 2002.
% note: this notion based on blocking differs from the IR wrt status quo. 


i_rationals(As,S,Rn,Is,F):-
   scc(F),
   subset_of_agents(Is,_),
   prefer_profile(Is,S,Rn),
   findall(A,
    (
     alternative(A),
     forall(member(J,Is),
      (
       nth1(K,Is,J),
       nth1(K,Rn,RJ),
       is_I_rational(A,[J,S,RJ],Is,F)
      )
     )
    ),
   As1),
   sort(As1,As).


is_I_rational(A,[J,S,RJ],Is,F):-
   subset_of_agents(Is,_N),
   scc(F),
   member(J,Is),
   preference(J,S,RJ),
   alternative(A),
   lcc([J,S,RJ],A,Lcc),
   \+is_blocked_by(Lcc,J,Is,F).

% for debug.

is_I_rational(A,[J,S,RJ],Is,F,test):-
   is_I_rational(A,[J,S,RJ],Is,F).

is_I_rational(A,[J,S,RJ],Is,F,test):-
   \+is_I_rational(A,[J,S,RJ],Is,F),
   alternative(A),
   preference(J,S,RJ),
   subset_of_agents(Is,_N),
   lcc([J,S,RJ],A,Lcc),
   scc(F,S,Scc),
   wn([alt,A,blocked_by_agent,J,in_state,S]),write(':'),
   wn([with_preference,RJ,lcc_is,Lcc, and_scc_is,Scc]).


% tests for IR
% edited: 

test_irat_n2(F,[I,J]):-
  scc(F),
  two_person([I,J]),
  forall(scc_defined_state(S,F), 
   (
    test_irat_n2(F,[I,J],[S,_V,_A,yes])
   )
  ).

test_irat_n2(F,[I,J],[S,V,A,B]):-
   scc(F,S,V),
   i_rationals(A,S,_R,[I,J],F),
   subset_query(V,A,B),
   wn([state,S,scc,V,ir_set,A,'ir?',B]).

subset_query(V,A,B):-
   subset(V,A) -> B = yes; B = no.


% checking some critical statements as for MR property in Danilov(1992) 
% using unblocked_pairs.
% added: Aug 2002.
 
test_dan55(S):-
   results_to_file([test_danilov_p55,mr,_R],'mr_dan55.txt',S).

test_danilov_p55(mr,Result):-
   scc(mr,S,C),
   member(A,C),
   lcc([1,S,R1],A,L1),
   lcc([2,S,R2],A,L2),
   (is_blocked_by(L1,2,[1,2],mr)
    ->B1=lcc1_is_blocked_by_2
    ;B1=unblocked
   ),
   nl,
   (is_blocked_by(L2,1,[1,2],mr)->B2=lcc2_is_blocked_by_1;B2=unblocked),
   (is_MR_element(A,[L1,L2],[1,2],[[R1,R2],S],mr)->MR=is_mr_element;MR=no_mr),
   Result=[at,S,scc_element,A,lcc,[L1,L2],summary,[B1,B2,MR]].



% ----------------------------------------------------------- %
% Moore-Repullo property(Danilov,1992) for unrestricted domain
% with two agents.
% ----------------------------------------------------------- %
% edited from: Jan 2002.

% Condition of implementability for two-person case:�@
% Scc F is implementable
%  <-> ess(F,Is),
%    has_MR_property(F,[J1,J2],X12),
%    forall((scc(F,S,C),member(A,C)),is_I_rational(A,Is,F)).


is_MR_element(A,[X1,X2],[J1,J2],[[R1,R2],S],F):-
   alternative(A),
   scc(F,S,C),
   member(A,C),
   prefer_profile([J1,J2],S,[R1,R2]),
   lcc([J1,S,R1],A,L1),
   lcc([J2,S,R2],A,L2),L1=X1,L2=X2.

is_MR_elements(MR,[X1,X2],[J1,J2],F):-
   scc(F),
   two_person([J1,J2]),
   subset_of_alternatives(X1,_N1),
   subset_of_alternatives(X2,_N2),
   findall(A,
    (
     scc_defined_state(S,F),
     prefer_profile([J1,J2],S,R),
     is_MR_element(A,[X1,X2],[J1,J2],[R,S],F)
    ),
   MR0),sort(MR0,MR).
  % it may have sorted by setof/3 but fail under MR=[].


has_MR_property(F,[J1,J2]):-
   scc(F),
   two_person([J1,J2]),
   forall(
    unblocked_pair([X1,X2],[J1,J2],F),
    % --note---The fact of existence of an unblocked pair can be 
    %  regarded as the analog of the 'self-selection constraint'
    %  in the term of Dutta-Sen(1991). ------- %
    (
     is_MR_elements(MR,[X1,X2],[J1,J2],F),MR\=[],
     wn(['MR-elements:',MR,'for unblocked pair:',[X1,X2]])
    )
   ).

ubp_test_mrp(F,[J1,J2],Result):-
   test_mrp_for_unblocked_pair(F,[J1,J2],Result).

test_mrp_for_unblocked_pair(F,[J1,J2],Result):-
   scc(F),
   two_person([J1,J2]),
   unblocked_pair([X1,X2],[J1,J2],F),
   scc(F,S,C),
   member(A,C),
   lcc([J1,S,_R1],A,L1),wn([lcc1,L1]),
   lcc([J2,S,_R2],A,L2),wn([lcc2,L2]),
   is_MR_elements(MR,[X1,X2],[J1,J2],F),
   Result=[
     state,S,scc,C,'MRs',MR,
     unblocked_pair,[X1,X2],
     lcc,[L1,L2]
   ].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% some tests for blocking relations 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)

test_b(n,G,Is):-
   subset_of_alternatives(M,_),
   \+is_blocked_by(M,J,Is,G),
   wn([M,J,G]),
   fail.

test_b(y,G,Is):-
   subset_of_alternatives(M,_),
   is_blocked_by(M,J,[S,_R],Is,G),
   wn([M,J,S,G]),
   fail.

test_blocking(F,FileName):-
   concat('block_',F,A),
   concat(A,'.txt',FileName),
   open(FileName,write,_Strm),
   test_blocking(F,_J,_Y,_Z),fail.

test_blocking(_,FileName):-
   current_stream(FileName,write,Strm),
   close(Strm).

test_blocking(F,J,Is,Y,Z):-
   subset_of_agents(Is,_N),member(J,Is),
   max_blocking(Y,[J,S,R],Is,F),
   current_stream(_,write,Strm),
   nl(Strm),
   wn(Strm,[Y,'is blocked','by',J,'under scc',F,when,[S,R]]),
   ess(F,J,Y,Z),
   % If the Scc is ess-monotone, then ess is empty for an agent 
   % iff X is blocked by the agent. (proposition 3)
   wn(Strm,[' ess',Z]),
   forall(
    (
     state(S1),
     prefer_profile(_Is,S1,R1),
     nth1(J,R1,_RJ)
    ),
    (
     scc(F,S1,SccVal1),
     intersection(Y,SccVal1,Meet),
     % by definition the meet of scc and the blocked set is empty.
     write(Strm,' state='),write(Strm,S1),
     write(Strm,' scc='),write(Strm,SccVal1),
     write(Strm,' preference='),wn(Strm,R1),
     write(Strm,' =>intersection(scc,blocked)='),
     wn(Strm,Meet)
    )
  ),
  nl(Strm).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% tests for proposition 3 of Danilov(1992) 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_proposition(3,F,FileName):-
   concat('prop3_',F,A),
   concat(A,'.txt',FileName),
   open(FileName,write,_Strm),
   proposition(3,F,[_I,_S,_Z]),
   fail.

test_proposition(3,_,FileName):-
   current_stream(FileName,write,Strm),
   close(Strm).

proposition(3,F,[I,S,Z]):-
   scc(F,S,Scc),
   state(S),
   agent(I),
   current_stream(_,write,Strm),
   alternative(X),
   set_of_alternatives(A),
   findall(Lcc,(lcc([I,S,_R],X,Lcc)),D),
   nl(Strm),
   wn(Strm,[scc, F, agent,I,state,S,scc_val,Scc,lccs,D]),
   findall(Y,L^(
     member(L,D),
     alternative(Y),
     \+ member(Y,L)),
   Hyp),
   subtract(A,Hyp,Inf),
   intersection(Scc,Inf,Z),%Z = [],
   tab(Strm,3),write(Strm,[hyp,Hyp]),
   tab(Strm,3),write(Strm,[inf,Inf]),
   wn(Strm,['scc��inf',Z]),agents(Is),
   is_blocked_by(Inf,I,Is,F),ess(F,I,inf,Ess),
   wn(Strm,[agent,I,blocks,Inf,and_ess_is,Ess]).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@SCC�ɂ‚��Ă̏�����(2)�F
% �p���[�g�œK�A�������A�ƍفA
% NVP�A�S���v�A�ŏ����R��`�Ȃ�
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)9

% ----------------------------------------------------------- %
%  9. Further conditions for SCC
% ----------------------------------------------------------- %
% Pareto, Condorcet, Dictatorial, NVP, RVP,
% unanimity, minimal liberalism, etc.

% added:  15-18 Aug 2002 

% ----------------------------------------------------------- %
% the (weak) Pareto optimal correspondence 
% ----------------------------------------------------------- %
% w.r.t. any preference domain coded in prolog-db.
% {a|for all b in A there exists an agent i, s.t., 
% is_prefer_to(i,S,a,b)},for any state S (and preference R(S)).

has_pareto_property(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   forall(scc(F,S,C),(wpo(Cpo,Is,S),subset(C,Cpo))).

% weak pareto optimal correspondence.
wpo(Cpo,Is,S):-
   subset_of_agents(Is,_),
   state(S),
   findall(A,is_wpo(A,S,Is),Cpo0),
   sort(Cpo0,Cpo).

% partial version.
partial_wpo(Cpo,Is,S):-
   subset_of_agents(Is,_),
   subset_of_alternatives(Cpo,_),
   state(S),
   forall(member(A,Cpo),is_wpo(A,S,Is)).

% alternative A is efficient for agent J in state S.
is_wpo(A,S,Is):-
   is_weak_parete_optimal(A,S,Is).

is_weak_parete_optimal(A,S,Is):-
   subset_of_agents(Is,_),
   %preference_profile(Is,S,_P),
   state(S),
   alternative(A),
   forall(alternative(B),is_prefer_to(_J,S,A,B)).

% ----------------------------------------------------------- %
% the majority rule for strict preferences
% ----------------------------------------------------------- %

has_condorcet_property(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   forall(scc(F,S,C),(condorcet(Con,Is,S),subset(C,Con))).

condorcet(Con,Is,S):-
   subset_of_agents(Is,_),
 %  subset_of_alternatives(Con,_),
   state(S),
   findall(A,
    (
     alternative(A),
     forall(
       alternative(B),
       pairwise_majority(A,B,_Na,_Nb,S,Is)
     )
    ),
  Con0),
  sort(Con0,Con).

pairwise_majority(A,B,Na,Nb,S,Is):-
   subset_of_agents(Is,_),
   state(S),
   alternative(A),
   alternative(B),
   bagof(J,(member(J,Is),is_prefer_to(J,S,A,B)),Jas),
   bagof(J,(member(J,Is),is_prefer_to(J,S,B,A)),Jbs),
   length(Jas,Na),
   length(Jbs,Nb),
   Na >= Nb.



% ----------------------------------------------------------- %
% dictator, dictatorial scc
% ----------------------------------------------------------- %

dictatorial(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   member(J,Is),
   is_a_dictator(J,F,Is).

is_a_dictator(J,F,Is):-
   subset_of_agents(Is,_),
   agent(J),member(J,Is),
   scc(F),
   set_of_alternatives(Alts),
   forall((scc(F,S,C),member(A,C)),
     lcc([J,S,_R],A,Alts)
   ),
   forall(lcc([J,S,_R],A,Alts),
    (
     scc(F,S,C),member(A,C)
    )
   ).

% ----------------------------------------------------------- %
% NVP (no veto power) and RVP (restricted veto power)
% ----------------------------------------------------------- %
% note: rvp/2, the ristricted version of nvp in the sense 
%  that there is no_veto_power unless  the outcome 
%  is strictly worse tha any outcome in range(scc). 
% ----------------------------------------------------------- %

nvp(F,Is):- no_veto_power(F,Is,full).
nvp0(F,Is):- no_veto_power0(F,Is,full).
nvp1(F,Is):- no_veto_power1(F,Is,full).
rvp(F,Is):- no_veto_power(F,Is,ristricted).

unanimity(F,Is):-
   subset_of_agents(Is,_),
   scc(F),
   set_of_alternatives(As),
   forall(
    (
     alternative(A),
     scc_defined_state(S,F),
     findall(J,(member(J,Is),lcc([J,S,R],A,As)),Is0),
     sort(Is0,Is)
    ),
    (
     scc(F,S,C),
     wn([[unanimity,Is0,A],[scc,S,C]]),
     member(A,C),
     forall(lcc([J,S,R],A,L),
       wn([ok,[preference,J,S,R],[lcc,A,L]])
     )
    )
  ).


% agent has a power to veto the outcome under scc
%(=blocking+some_additional_power).

veto_outcome(A,J,S,Is,F):-
   subset_of_agents(Is,_),
   scc(F),
   agent(J),
   state(S),
   scc(F,S,C),
   alternative(A),
   \+ member(A,C),
   set_of_alternatives(As),
   forall((agent(K),K\=J),
     lcc([K,S,_Rk],A,As)
   ).


% nvp by using lcc:  (in order to verify the equivalence with 
% no_veto_power0/, use veto_outcome, or no_veto_power1/ with weak).

no_veto_power(F,Is,full):-
   subset_of_agents(Is,_),
   scc(F),
   set_of_alternatives(As),
   forall(
    (
     alternative(A),
     scc_defined_state(S,F),
     agent(I),member(I,Is),
     subtract(Is,[I],Is1),
     findall(J,lcc([J,S,R],A,As),Is0),
     subset(Is1,Is0)
    ),
    (
     scc(F,S,C),
     member(A,C),
     wn([[nvp,Is0,A],[scc,S,C]]),
     forall(lcc([J,S,R],A,L),
       wn([ok,[preference,J,S,R],[lcc,A,L]])
     )
    )
   ).


no_veto_power(F,Is,ristricted):-
   subset_of_agents(Is,_),
   scc(F),
   range(F,Bs),
   forall(
    (
     agent(J),
     member(J,Is),
     alternative(A),
     scc_defined_state(S,F)
    ),
    (
     \+ veto_outcome(A,J,S,Is,F);
     (
      member(B,Bs),
      \+ is_prefer_to(J,S,A,B)
     )
    )
   ).


no_veto_power0(F,Is,full):-
   subset_of_agents(Is,_),
   scc(F),
   forall(
    (
     agent(J),member(J,Is),
     alternative(A),scc_defined_state(S,F)
    ),
    (
     \+ veto_outcome(A,J,S,Is,F)
    )
   ).

% lemma
% NVP <--> no agent has veto outcome <--> all agent are weak.
% ----------------------------------------------------------- %


no_veto_power1(F,Is,full):-
   subset_of_agents(Is,_),
   scc(F),
   forall((agent(J),member(J,Is)),weak(J,Is,F)).

% lemma
% an agent is "weak" if it has no veto outcome.
% ----------------------------------------------------------- %
% note: in this case ess(F,J,X,X) always hold.

weak(J,Is,F):-
   subset_of_agents(Is,_),
   scc(F),
   agent(J),
   \+ veto_outcome(_A,J,_S,Is,F).

% lemma
% agent J is weak <--> J blocks only [].
% ----------------------------------------------------------- %

weak_b(J,Is,F):-
   subset_of_agents(Is,_),
   scc(F),
   agent(J),
   \+ (
     alternative(A),
     is_blocked_by(A,J,[_S,_R],Is,F)
   ).

r_weak(J,Is,F,_):- weak(J,Is,F).

r_weak(J,Is,F,restricted):-
   subset_of_agents(Is,_),
   scc(F),
   agent(J),member(J,Is),
   forall(
     veto_outcome(A1,J,S1,Is,F),
    (
     wn([found_veto_outcome,A1,by,J,when,S1]),
     range(F,Bs),
     member(B,Bs),
     \+ is_prefer_to(J,S1,A1,B)
     ,tab(2),wn([but_is_strongly_wrose_than,B])
    )
   ).


%lemma:
% weak-> lcc(X)=X, nvp->ess(X)=X.
% ----------------------------------------------------------- %


test_lemma_weak(J,Is,F,R):-
  member(R,[full,restricted]),wn(R),
  forall(
   (
    agent(J),member(J,Is),
    subset_of_alternatives(X,_),
    true
   ),
   (
    r_weak(J,Is,F,R)
    ->ess(F,J,X,X)
   )
  ).
   
test_lemma_nvp(F,Is,R):-
  member(R,[full,restricted]),wn(R),
  no_veto_power(F,Is,ristricted),wn(nvp),
  %
  forall(
   (
    alternative(A),
    agent(J),
    member(J,Is),
    scc_defined_state(S,F)
   ),
   (
    set_C_star(X,_,[[J,S,R],A,_Bstar],Is,F)
     ->lcc([J,S,R],A,X)
   )
  ).


tell_test_nvp(Mju):-
   subset_of(Mju,_,[i,ii,iii,iv]), 
   open('mju.txt',write,S),
   tell('mju.txt'),
   condition_mju(mr,[1,2],_B,[yes,yes],Mju),
   tell(user),wn(end),
   current_stream('mju.txt',write,S),
   close(S).


% tests for equivalence of some versions of nvp
% ----------------------------------------------------------- %

test_nvp_def:-
   forall(
    (
     member(P,[a1,a2,b1,b2]),
     member(R,[full,restricted])
    ),
    (
     wn([P,R]),
     (
      test_nvp(P,R)
      ->wn([found_diff_in,P,R]);true
     )
    )
   ),
   wn([no_difference_has_found_in_3_versions_of_no_veto_power]).

test_nvp(a1,R):-
   member(R,[full,restricted]),wn(R),
   \+ no_veto_power(F,Is,R),
   no_veto_power0(F,Is,R),
   wn([is,no_veto_power0, but_is_not, no_veto_power]).

test_nvp(a2,R):-
   member(R,[full,restricted]),wn(R),
   no_veto_power(F,Is,R),
   \+ no_veto_power0(F,Is,R),   % take a minute
   wn([is,no_veto_power, but_is_not, no_veto_power0]).

test_nvp(b1,R):-
   member(R,[full,restricted]),wn(R),
   \+ no_veto_power(F,Is,R),
   no_veto_power1(F,Is,R),
   wn([is,no_veto_power1, but_is_not, no_veto_power]).

test_nvp(b2,R):-
   member(R,[full,restricted]),wn(R),
   no_veto_power(F,Is,R),
   \+ no_veto_power1(F,Is,R),
   wn([is,no_veto_power1, but_is_not, no_veto_power1]).


%lines about 2506 (14 Mar 2005 24:00)
% ----------------------------------------------------------- %
%  bad_outcome, nonempty_lower_intersection
% ----------------------------------------------------------- %
% 18 Aug 2002.
% reference: M_R(1990), p.1090.


bad_outcome(Z,F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   alternative(Z),
   range(F,B),
   forall(
    (
     member(X,B),
     member(J,Is),
     state(S)
    ),
    (
    is_strict_prefer_to(J,S,X,Z)
    )
  ).

% note: in this version, if the scc maps into the out of 
% the set of alternatives, it is vacuously true.

bad_outcome1(Z,F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   alternative(Z),
   range(F,B),
   \+ (
     member(J,Is),
     member(X,B),
     state(S),
     is_prefer_to(J,S,Z,X)
   ).

% ----------------------------------------------------------- %
% no_empty_lower_intersection (neli) for N=2.
% ----------------------------------------------------------- %
% not exactly modeled  

neli(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   forall(
     neli(F,Is,[_,_,_,SL12]),
     SL12 \= []
   ).

neli(F,[J1,J2],[[R1,R2],[X,Y],[SL1,SL2],SL12]):-
   scc(F),
   subset_of_agents([J1,J2],_),
   scc(F,S1,C1),
   scc(F,S2,C2),
   member(X,C1),
   member(Y,C2),
   slcc([J1,S1,R1],X,SL1),
   slcc([J2,S2,R2],Y,SL2),
   intersection(SL1,SL2,SL12).  


% ----------------------------------------------------------- %
% decisiveness and minimal liberalism(ML).
% ----------------------------------------------------------- %
% 19 Aug 2002.
% reference: Peleg(1998), p.76.

is_decisive(J,for(X),over(Y),F):-
   scc(F),
   agent(J),
   alternative(X),
   alternative(Y),Y\=X,
   forall( 
    (
     preference(J,S,R),
     subset_of_alternatives(_B,_)
    ),
    forall(  
     (
      slcc([J,S,R],X,SL),
      member(Y,SL),
      scc(F,S,C),
      \+ member(X,C)
     ),
      \+ member(Y,C)
    )
  ).


decisive_pairs([J1,X,Y],[J2,Z,W],F):-
   agent(J1),
   agent(J2),
   alternative(X),
   alternative(Y),
   alternative(Z), Z\=X, 
   alternative(W), W\=Y,
   is_decisive(J1,for(X),over(Y),F),
   is_decisive(J2,for(Z),over(W),F).


% ----------------------------------------------------------- %
% Sen's weakest condition of liberalism (ML).
% ----------------------------------------------------------- %

mlib(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   subset_of([J1,J2],2,Is),
  % member(J1,Is),member(J2,Is),J2\=J1,
   decisive_pairs([J1,_X,_Y],[J2,_Z,_W],F).


% ----------------------------------------------------------- %
%  neutrality of scc wrt permutation of the alternatives
% ----------------------------------------------------------- %
%  it is always true that scc(perdeviated_preference)=permutation(scc).
% added: 1 Sep 2002.

%caution:
%notations 'A->B's below have cause precedence errors in IF-prolog.

is_neutral(F,Is):-
   scc(F),
   subset_of_agents(Is,_),
   forall(
    (
     poa(_,PoA),
     ppp(Is,PoA,Ps->Rs)
    ),
    forall(
     (
      state(S),
      prefer_profile(Is,S,Ps),
      scc(F,S,C),
      member(C0,C)
     ),
     (
      state(S1),
      prefer_profile(Is,S1,Rs),
      scc(F,S1,C1),
      member(C0->X,PoA),
      member(X,C1)
     )
    )
   ).

ppp(Is,PoA,Rtrans):-
   perdeviated_prefer_profile(Is,PoA,Rtrans).

perdeviated_prefer_profile(Is,PoA,Ps->Rs):-
   subset_of_agents(Is,_),
   set_of_alternatives(A),
   state(S),
   prefer_profile(Is,S,Ps),
   ordering(P,A,_M),
   poa(P,PoA),!,%wn(PoA),
   bagof(R,
    K^J^Q^(
     nth1(K,Is,J),
     nth1(K,Ps,Q),
     perdeviate_of_order(PoA,[Q->R])
    ),
   Rs).


% lines about 2685 (14 Mar 2005 24:00)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@SCC�ɂ‚��Ă̏�����(3)�F
% ����Mu��Mu2�A����I���ʂ̏���
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)10

% ----------------------------------------------------------- %
% 10. Eliminating the awkward outcomes: Condition Mu and Mu2
% ----------------------------------------------------------- %
% 20,23 Aug 2002.
% reference: Sjostrom(1991), p.336. Maskin and Sjostrom(2002),Suh(1996).
%

% Condition Mu, Mu2 and iterative elimination of awkward outcomes.
% with the sets B_star and C_star.


/*
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  Sjostrom's Iterative Elimination Algorithm 
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
% edited: Aug 2002. revised: 8 Nov 2005.

% an algorithm for computing the set B_star iteratively, up to 
% the convergence of the sequence {B_k}.
% (See Sjostrom(1991).)

% Def. algorithm for B[k] and B_star:
% ----------------------------------------------------------- %
% The inductive set of alternatives B[k] is defined as follows.
% B[1]:=A, the set of all alternatives. 
% B[k+1] := setof{a in B[k]| forall( agent(i), subset(B[k],Lcc(i,a,R)) },
% i.e., B[k+1] consists of elements in B[k]
% such that it is on the Scc if a permissible profile of preference R 
% B[k] is a subset of Lcc(i,R,a) for every agent i. 

% Define B[oo]:= limi_k->oo Intersection( B[k] ).
% Then B_star=B[oo] if the algorithm stops in a finite steps.


set_B_star(Bstar,Kmin,Is,F):-
   (scc(F)->true;(!,fail)),
   subset_of_agents(Is,_),
   % the first fixed point, CB, of the sequece of set operations
   set_Bk([Kmin|_],Bk-Bk,Is,F),
   Bstar=Bk,!.


set_Bk([1|[]],B0-[],Is,F):-
   (scc(F)->true;(!,fail)),
   subset_of_agents(Is,_),
   set_of_alternatives(As),
   B0=As.

set_Bk([K|[K1|H1]],Bk-Bk1,Is,F):-
   set_Bk([K1|H1],Bk1-_,Is,F),
   K is K1 + 1,
   findall(A,
    (
     member(A,Bk1),
     (
      scc_defined_state(S,F),
      scc(F,S,V),
      (
       forall(member(J,Is),maximal(A,Bk1,[J,S,_R]))
       -> member(A,V);true
      )
     )
    ),
   B0),
   sort(B0,Bk).

% Def. algorithm for C_i[k] and C_i_star:
% ----------------------------------------------------------- %
% The set of alternatives C_i[k] is defined as inductively as follows. 
% For an `a` which is on the SCC, an agent i, and a permissible R,

% C_i[1](a,R) := intersection_of( Lcc(i,R,a), B_star).
% Until C_i[k](a,R) converges, compute C_i[k+1](a,R) as the set of
% `b` in C_i[k](a,R) such that it is on the Scc for some R~, ----
% a goal coded in prolog like as `scc( SCC, state(R~), F), member(b,F).',
% ---- if C_i[k](a,R) is a subset of Lcc(i,R~,b) for agent i and 
% B_star is a subset of Lcc(j,R~,b) for every j \=i. 

% Define C_i[oo](a,R):= limi_k->oo Intersection( C[k](a,R) ).
% Then C_i_star(a,R)=C_i[oo](a,R) if the algorithm stops in a finite steps.


% the code for C_k and C_star.

set_C_star(Cstar,Kmin,[[J,S,R],A,Bstar],Is,F):-
   (scc(F)->true;(!,fail)),
   scc(F),
   subset_of_agents(Is,_),
   member(J,Is),
   preference(J,S,R),
   scc(F,S,V),
   member(A,V),
   set_Ck([Kmin|_],Ck-Ck,[[J,S,R],A,Bstar],Is,F),
  % subset_of_alternatives(Bstar,_),  <--- never before set_Ck because of using !.
  % subset_of_alternatives(Ck,_),  <--- never before set_Ck because of using !.
   Cstar=Ck,
   !.

set_Ck([1|[]],C1-[],[[J,S,R],A,Bstar],Is,F):-
   (scc(F)->true;(!,fail)),
   subset_of_agents(Is,_),%wn([F,Is]),
   member(J,Is),%wn(J),
   preference(J,S,R),%wn([J,S,R]),
   scc(F,S,V),%wn([F,S,V]),
   member(A,V),
   %wn(A),
   lcc([J,S,R],A,Lcc),%wn([A,Lcc]),
   set_B_star(Bstar,_,Is,F),%wn(Bstar),
   intersection(Lcc,Bstar,C1).

set_Ck([K|[K1|H1]],Ck-Ck1,[[J,S,R],A,Bstar],Is,F):-
   length([K|[K1|H1]],K),  % <-miso
   set_Ck([K1|H1],Ck1-_,[[J,S,R],A,Bstar],Is,F),
   K is K1 + 1,
   findall(B,
    (
     member(B,Ck1),
     (
      scc_defined_state(S,F),
      scc(F,S,V),
      (
       (
        maximal(B,Ck1,[J,S,R]),
        forall(
         (
          member(J1,Is),
          J1\=J
         ),
         maximal(B,Bstar,[J1,S,R])
        )
       )-> member(B,V)
       ;true
      )
     )
    ),
   C0),
   sort(C0,Ck).


test_Ck(K,C,A):- generate_scc(scc1,_),set_Ck([K|_],C,A,[1,2,3],scc1).
test_C_star(K,C,A):- generate_scc(scc1,_),set_C_star(C,K,A,[1,2,3],scc1).


/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%  re_definition: B / C_stars  %%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
% see Sjostrom(1991), p.335.
% the code below replicate the original definition for B_star and C_star
% these definitions for Bx and Cx are yet incomplete, til 020820. (pending)

% test routine
test_Bx1(C,Bx):-
   generate_scc(scc1,C),
   definition_of_B_star(Bx,[1,2,3],scc1).

test_Bx2(C,Bx):-
   Is=[1,2,3],
   generate_scc(scc1,C),
   set_B_star(Bx,_,Is,scc1),
   wn(['found Bx:',Bx]),
   definition_of_B_star(Bx,Is,scc1).

test_Cx1(C,Cx,A):-
   generate_scc(scc1,C),
   definition_of_C_star(Cx,A,[1,2,3],scc1).

test_Cx2(C,Cx,A):-
   Is=[1,2,3],
   generate_scc(scc1,C),
   set_C_star(Cx,_,[[J,S,R],A,Bx],Is,scc1),
   wn(['found Cx:',Cx,prof,[J,S,R],outcome,A,'Bx:',Bx]),
   definition_of_C_star(Cx,[[J,S,R],A,Bx],Is,scc1).


definition_of_B_star(B_star,Is,F):-
   subset_of_agents(Is,_),
   subset_of_alternatives(B_star,_),
   findall(B,
    (
     %condition_mju_iii in the sense of Moore-Repullo(1990)
     condition_mju(F,Is,B,[no,no],[iii])
    ),
   BA),
   all_members(BA,B_star),flatten(BA,BC),wn(BC).


 %% should be! equivalent to  set_C_star(Cstar,_K,[[J,S,R],A,Bstar],Is,F).
 %% notice: if scc satisfies nvp, C_star = Lcc.

definition_of_C_star(C_star,[[J,S,R],A,Bstar],Is,F):-
   subset_of_agents(Is,_),
   scc(F),
   (
    alternative(A),
    state(S),
    member(J,Is),
    preference(J,S,R),
    scc(F,S,C),member(A,C),  wn([[J,S,R],A])
   ),
   findall(C0,
    (
     lcc([J,S,R],A,Lcc),
     set_B_star(Bstar,_Kmin,Is,F),  % substituted for def of it. 
     intersection(Lcc,Bstar,C0),
     %condition_mju_ii in the sense of Moore-Repullo(1990)
     condition_mju_ii(F,Is,[Bstar,C0],A,[J,S,R]),wn([C0,Bstar])
    ),
   CA),
   all_members(CA,CA0),sort(CA0,C_star).


/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%   Conditions M and  M2  %%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/

% The rules below intended to model Condition mu and mu2 
% by Moore and Repullo(1990). For N=2, the equivalent
% formulation is known as Condition beta by Dutta and Sen(1991). 

% In order to compute the attainable sets in these conditions, 
% we implement a code of Sjostrom's algorithm for C star. 
% The augmented conditions called M and M2. 
% See Sjostrom(1991).


% see Sjostrom(1991), p.335.
% modified: 27 Sep 2002.

% condition_M/2 and condition_M2/2

condition_M(F,Is):-
   condition_mju(F,Is,_Bx,[yes,yes],[i]).

condition_M2(F,[J1,J2]):-
   condition_mju(F,[J1,J2],_Bx,[yes,yes],[i,iv]).


/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%   Condition ��: i,ii,iii  ��2: i�`iv %%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
% Originally by Moore-Repullo(1990) and independently Dutta-Sen(1991).
% As for the formalization here, see Sjostrom(1991), pp.334-5.
% ----------------------------------------------------------- %
% added: 21-3 Aug 2002.
% modified: 27 Sep 2002.
% modified: 10 Nov 2002.  suppressed write sentences.
% modified: 11,14 Nov 2005. revise the rule iv, 
%   and add the testing rule with debug_mju/2.


:- dynamic  debug_mju/2.

debug_mju( i, no).
debug_mju( ii, no).
debug_mju( iii, no).
debug_mju( iv, no).
%debug_mju( iv, yes).
debug_mju( cme, no).
debug_mju( iv(02), no).

ch_debug_mju( R, A->B):-
   retract( debug_mju( R, A) ),
   member( (A,B), [(no,yes),(yes,no)]),
   assert( debug_mju( R, B) ).


% ----------------------------------------------------------- %

condition_mju2(F,[J1,J2],Bx,[GoBx,GoCx]):-
   condition_mju(F,[J1,J2],Bx,[GoBx,GoCx],[i,ii,iii,iv]).

condition_mju(F,Is,Bx,[GoBx,GoCx],Mju):-
   debug_mju( i, T),
   subset_of(Mju,_,[i,ii,iii,iv]),
   scc(F),
   subset_of_agents(Is,_),
   (GoBx=yes -> set_B_star(Bx,_,Is,F);true),
   subset_of_alternatives(Bx,_),  % <-- note! it should be done after set_B_star/4.
   (T=yes->(wn([bx,Bx,mju,Mju]));true),
   forall(
    (
     alternative(A),state(S),
     collect_cx(A,S,F,Is,Bx,[GoBx,GoCx],Cxs)
    ),
    (
    % sub-conditions of mju and mju2 in Moore-Repullo(1990)
     forall(
      (
       member(M,Mju),
       member(M,[i,ii,iii])
      ),
      (
       sub_condition_of_mju(M,F,Is,Bx,[A,S,Cxs]),
       (T=yes->(tab(2),wn([ok_mju,M]));true)
      )
     )
    )
   ),
   (
    member(iv,Mju)
     ->
      (
       sub_condition_of_mju(iv,F,Is,_,_),
       (T=yes->(tab(2),wn([ok_mju,iv]));true)
      )
     ;true
   ).



% utility for condition_mju /4
% modified: 28 Sep 2002.

collect_cx(A,S,F,Is,Bx,[GoBx,GoCx],Cxs):-
   debug_mju( ii, T),
   alternative(A), scc(F,S,V),member(A,V),
   (T=yes->(tab(1),wn([A,in_scc(F,S,V)]));true),
   subset_of_agents(Is,_),
   (GoBx=yes,set_B_star(Bx,_,Is,F)),
   subset_of_alternatives(Bx,_),  % <-- it should be after set_B_star/4.
   bagof([J,A,S,Cx],
    R^Lcc^Wth^Nx^
    (
     agent(J), member(J,Is), preference(J,S,R),
     (GoCx=yes,set_C_star(Cx,Wth,[[J,S,R],A,Bx],Is,F)),
     (subset_of_alternatives(Cx,Nx)->true),
     member(A,Cx),
     lcc([J,S,R],A,Lcc),
     subset(Cx,Lcc),
     subset(Cx,Bx),
     (T=yes->
      (tab(2),wn([A,prefer(J,S,R),cx(Cx),lcc(Lcc),bx(Bx)]))
     ;true)
    ),
   Cxs).

% only for 2 person case. 
make_set_Cx_for([[J,S,R],A],Cx,Lcc,Bx,[J1,J2],F,yes):-
   member(J,[J1,J2]),
   set_C_star(Cx,_,[[J,S,R],A,Bx],[J1,J2],F),  %wn([cx,Cx,bx,Bx]),
   subset_of_alternatives(Cx,_),member(A,Cx),   %wn(A),
   lcc([J,S,R],A,Lcc),   %write([lcc,Lcc]),
   subset(Cx,Lcc),
   subset(Cx,Bx).

/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%   subsidiary conditions for �� and ��2   %%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/


% Condition mu (i), (strong) monotonicity

sub_condition_of_mju(i,F,Is,_Bx,[A,S,Cxs]):-
   debug_mju( iii, T),
   scc(F),
   subset_of_agents(Is,_),
   alternative(A),
%   subset_of_alternatives(Bx,_), 
   forall(
    (
     scc_defined_state(S1,F),
     prefer_profile(Is,S1,Rs),
     (T=yes->(tab(4),wn([profile(S1),Rs]));true),
     forall(
      (agent(J),member(J,Is)),
      (
       member([J,A,S,Cx],Cxs),  % Cx for state S, not for S1.
       maximal(A,Cx,[J,S1,_R]),
       (T=yes->
        (tab(5),wn([is_max_for_Cx(A,Cx),agent(J),state(S1)]))
       ;true)
     % ------- a substitute for maximal(A,Cx,[J,S1,_R])----------
     % preference(J,S1,R),
     % lcc([J,S1,R],A,Lcc),subset(Cx,Lcc)
     % ,tab(5),wn([A,is_maximal_for,J,in_state,S1,lcc,Lcc,wrt_Cx,Cx])
     % ---------------------------------------------------------
      )
     )
    ),
    (
     scc(F,S1,V), %tab(6),write(scc(S1,V)),
     member(A,V) %,wn(in_scc(A))
    )
   ).


% Moore-Repullo's Condition mu (ii), rvp. 

sub_condition_of_mju(ii,F,Is,Bx,[C,S,Cxs]):-
   debug_mju( ii, T),
   scc(F),
   subset_of_agents(Is,_),
   alternative(C),
   subset_of_alternatives(Bx,_), 
   forall(
    (
     scc_defined_state(S1,F),
     prefer_profile(Is,S1,Rs),
     (T=yes->(tab(4),wn([profile(S1),Rs]));true),
     member([J0,A,S,Cx],Cxs),  % state S, not S1.
     agent(J0),member(J0,Is),
     state(S1),alternative(C),
     lcc([J0,S1,_R0],C,Lcc),subset(Cx,Lcc),
     (T=yes->
      (tab(5),wn([is_max_for_Cx(A,Cx),agent(J0),state(S1)]))
     ;true),
    %-------
     subtract(Is,[J0],Is1),
     forall(
      (agent(J),member(J,Is1)),
      (
       maximal(A,Bx,[J,S1,_R]),
       (T=yes->
        (tab(5),wn([is_max_for_Bx(A,Bx),agent(J),state(S1)]))
       ;true)
      )
     )
    ),
    (
     scc(F,S1,V), %tab(6),write(scc(S1,V)),
     member(A,V)  %,wn(in_scc(A))
    )
   ).


% Moore-Repullo's Condition mu (iii), 
% (restricted) unanimity. 

sub_condition_of_mju(iii,F,Is,Bx,[C,_S,_Cxs]):-
   debug_mju(iii,T),
   scc(F),
   subset_of_agents(Is,_),
   alternative(C),
   subset_of_alternatives(Bx,_), 
   forall(
    (
     scc_defined_state(S1,F),
     prefer_profile(Is,S1,Rs),
     (T=yes->(tab(4),wn([profile(S1),Rs]));true),
    %-------
     forall(
      (agent(J),member(J,Is)),
      (
       maximal(A,Bx,[J,S1,_R]),
       (T=yes->
        (tab(5),wn([is_max_for_Bx(A,Bx),agent(J),state(S1)]))
       ;true)
      )
     )
    ),
    (
     scc(F,S1,V), %tab(6),write(scc(S1,V)),
     member(A,V)  %,wn(in_scc(A))
    )
   ).


% Condition mu (iv) in Moore and Repullo(1990),
% or equivalently, Condition beta (i) in Dutta and Sen(1991).

% the previous code in impl12.pl (restored: 16 Nov 2005 )


sub_condition_of_mju(iv,F,[J1,J2],_,_):-
   debug_mju( iv(02), yes), 
   debug_mju( iv, T), 
  % T=no,
   forall(
     (
      alternative(A),alternative(B),
      %you may not use instead 'subset_of_alt([A,B],2)'
      preference(J1,S1,R1),
      preference(J2,S2,R2),
      scc(F,S1,V1),member(A,V1),
      scc(F,S2,V2),member(B,V2),
      (T=yes->(tab(4),wn([scc_pair,[J1,S1,A],[J2,S2,B]]));true)
     ),
     (% ----- the 'self-selection constraint' in the term of Dutta-Sen(1991).
      make_set_Cx_for([[J1,S1,R1],A],Cx1,_L1,Bx,[J1,J2],F,GoCx),
      make_set_Cx_for([[J2,S2,R2],B],Cx2,_L2,Bx,[J1,J2],F,GoCx),
      intersection(Cx1,Cx2,MR),
      member(Phi,MR),
      (T=yes->(tab(5),wn([mr,Phi,in_C1xC2,MR]));true),
      forall(
        (
         lcc([J1,Sp,_R1p],Phi,Lp1),
         lcc([J2,Sp,_R2p],Phi,Lp2),
         subset(Cx1,Lp1),
         subset(Cx2,Lp2),
         (T=yes->(tab(6),write([for_lcc_pair,Lp1,Lp2]));true)
        ),
        (
         scc(F,Sp,Vp),member(Phi,Vp) %,tab(2),wn(in_scc)
        ) 
      )
     )
   ).



% modified: 11-12 Nov 2005.  revise. 
%  the rule has decomposed into the subsidiaries a, b, c.
% modified: 15 Nov 2005.  correct. 
%   added a subrule iv(d) including the cases of no-comaximal elements.
% modified: 16 Nov 2005.  restore the privious code.
%   revised subrule iv of a misspecified term Vp w.r.t. iv(d). (12:18pm)


sub_condition_of_mju(iv, F,[J1,J2],_,_):-
   debug_mju( iv(02), no), 
   forall(
    (
     sub_condition_of_mju( iv(a),F,[(J1,S1,R1),(J2,S2,R2)],[A,B],_),
     sub_condition_of_mju( iv(b),(F,Lmr,_,_),[(J1,S1,R1),(J2,S2,R2)],[A,B],Cx)
    ),
    (
     member(D,Lmr),
     forall(
      sub_condition_of_mju( iv(c),(Lmr,D),[(J1,Sp,_),(J2,Sp,_)],Cx,Lcc),
      sub_condition_of_mju( iv(d), (D,F,Sp,_Vp),_,Cx,Lcc)
     )
    )
   ).

sub_condition_of_mju( iv(a), F,[(J1,S1,R1),(J2,S2,R2)],[A,B],[V1,V2]):-
   alternative(A),
   alternative(B),
   %you may not use instead 'subset_of_alternatives([A,B],2)'
   preference(J1,S1,R1),
   preference(J2,S2,R2),
   scc(F,S1,V1),member(A,V1),
   scc(F,S2,V2),member(B,V2),
   (debug_mju(iv,yes)->(tab(4),wn([scc_pair,[J1,S1,A],[J2,S2,B]]));true).

% ----- the 'self-selection constraint' in the term of Dutta-Sen(1991).

sub_condition_of_mju( iv(b), (F,LMR,Bx,GoCx),[(J1,S1,R1),(J2,S2,R2)],[A,B],[Cx1,Cx2]):-
   make_set_Cx_for([[J1,S1,R1],A],Cx1,_L1,Bx,[J1,J2],F,GoCx),
   make_set_Cx_for([[J2,S2,R2],B],Cx2,_L2,Bx,[J1,J2],F,GoCx),
   intersection(Cx1,Cx2,LMR).

sub_condition_of_mju( iv(c), (LMR,D),[(J1,Sp,R1p),(J2,Sp,R2p)],[Cx1,Cx2],[Lp1,Lp2]):-
   (var(D)->member(D,LMR);alternative(D)),
   debug_mju(iv,T),
   (T=yes->(tab(5),wn([mr:D,in_C1xC2:LMR]));true),
   state(Sp),
   lcc([J1,Sp,R1p],D,Lp1),
   lcc([J2,Sp,R2p],D,Lp2),
   (T=yes->
    (
     tab(6),wn(['for state':Sp,'Cx pair':(Cx1,Cx2)]),
     tab(6),wn(['Lcc pair':(Lp1,Lp2)])
    )
   ;true).

sub_condition_of_mju( iv(d), (D,F,Sp,Vp),Y,[Cx1,Cx2],[Lp1,Lp2]):-
   (subset(Cx1,Lp1)-> Y1=yes; Y1=no),
   (subset(Cx2,Lp2)-> Y2=yes; Y2=no),
   Y= [Y1,Y2],
   (Y=[yes,yes]->scc(F,Sp,Vp),member(D,Vp);Vp=vacuous),
   (debug_mju(iv, yes)
     -> (Y=[yes,yes]->wn(in_scc(D));wn(vacuous(D)))
     ;  true
   ).


% a demo (16 Nov 2005)
% ----------------------------------------------------------- %
/*
?- ch_debug_mju(iv,A).

A = yes->no 

Yes
?- test_for_current_model(mr,[1,2],B).
[state, s1, scc, [c], ir_set, [c], ir?, yes]
[state, s2, scc, [d], ir_set, [c, d], ir?, yes]
[state, s3, scc, [c], ir_set, [c], ir?, yes]
[state, s4, scc, [c], ir_set, [c], ir?, yes]

other tests for this model:
[mm, em, -, ir, bad(z), -, rvp, unan, po, -, -, neli, mlib, -, mju1, mju2, mju3, mju4]

B = [mm, em, -, ir, bad(z), -, rvp, unan, po|...] 

Yes
?- ch_debug_mju(iv(02),A).

A = no->yes 

Yes
?- ch_debug_mju(iv,A).

A = yes->no 

Yes
?- test_for_current_model(mr,[1,2],B).
[state, s1, scc, [c], ir_set, [c], ir?, yes]
[state, s2, scc, [d], ir_set, [c, d], ir?, yes]
[state, s3, scc, [c], ir_set, [c], ir?, yes]
[state, s4, scc, [c], ir_set, [c], ir?, yes]

other tests for this model:
[mm, em, -, ir, bad(z), -, rvp, unan, po, -, -, neli, mlib, -, mju1, mju2, mju3, mju4]

B = [mm, em, -, ir, bad(z), -, rvp, unan, po|...] 

Yes
?- ch_debug_mju(iv(02),A).

A = no->yes 

Yes
?- 

*/



% testing violations against the rule mu(iv).
% ----------------------------------------------------------- %
% added: 11 Nov 2005 
% modified: 15 Nov 2005 (23:53pm)

test_violation_against_mju_iv( D,(F, LMR,Sp,Vp),Data):-
   Data=[[(J1,S1,R1),(J2,S2,R2)],[A,B],[Cx1,Cx2]],
   sub_condition_of_mju( iv(a),F,[(J1,S1,R1),(J2,S2,R2)],[A,B],_),
   sub_condition_of_mju( iv(b),(F,LMR,_,_),[(J1,S1,R1),(J2,S2,R2)],[A,B],[Cx1,Cx2]),
   (LMR=[] ->true;
    (
     member(D, LMR), 
     sub_condition_of_mju( iv(c),(LMR,D),[(J1,Sp,_),(J2,Sp,_)],[Cx1,Cx2],Lcc),
     \+ sub_condition_of_mju( iv(d),(D,F,Sp,Vp),_,[Cx1,Cx2],Lcc)
    )
   ).


% a demo (15 Nov 2005)
% ----------------------------------------------------------- %
/*
?- test_violation_against_mju_iv( D, (mr, MR, Sp,Scc),[Prof,AB,Cx]).

No
?- test_violation_against_mju_iv( D, (mr1, MR, Sp,Scc),[Prof,AB,Cx]).

No
?-
*/

/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %  common (cross) maximal outcome of 
   %  Moore-Repullo / Dutta-Sen mechanism  
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
% this is used in the cases of gMR2(gDS2) below.


% select_common_maximal_element_in_scc/2,/3 
% for the second rule of game form gMR2.
% ----------------------------------------------------------- %
% added: 11-13 Nov 2005. 
% modified: 14 Nov 2005.  added the debug mode. 
% modified: 15 Nov 2005.  correct. non-maximal case. (23:00 pm)


select_common_maximal_element_in_scc( (F, Lmr), Data):-
   Data=[[JSR1,JSR2],[A,B],Cx],
   sub_condition_of_mju(iv(a),F,[JSR1,JSR2],[A,B],_),
   sub_condition_of_mju(iv(b),(F,Lmr,_,_),[JSR1,JSR2],[A,B],Cx).

select_common_maximal_element_in_scc( MR, (F, Lmr), Data):-
   debug_mju( cme, no), 
   select_common_maximal_element_in_scc( (F, Lmr), Data),
   Data=[[(J1,_,_),(J2,_,_)],_,Cx],
   member( MR, Lmr),
   forall(
     sub_condition_of_mju(iv(c),(Lmr,MR),[(J1,Sp,_),(J2,Sp,_)],Cx,Lcc),
     sub_condition_of_mju(iv(d),(MR,F,Sp,_),_,Cx,Lcc)
   ).


% reproducing my earlier code with incomplete logic.


select_common_maximal_element_in_scc( M, (F, LMR), Data):-
   debug_mju( cme, yes), 
   Data=[[(J1,S1,R1),(J2,S2,R2)],[X1,X2],[Cx1,Cx2]],
   mre( M, LMR, F,[[X1,X2],[J1,J2],[S1,S2],[R1,R2]],[Cx1,Cx2],_).



% mre/5
% ----------------------------------------------------------- %
% added: 25 Aug 2002.
% modified: 27 Sep 2002.
% modified: 12 Nov 2005.  added the rule with arity /6.

% an alternative for select_common_maximal_element_in_scc/3.


mre(Y,F,[[X1,X2],[J1,J2],[S1,S2],[R1,R2]],[Cx1,Cx2],T):-
   mre(Y,_, F,[[X1,X2],[J1,J2],[S1,S2],[R1,R2]],[Cx1,Cx2],T).

mre(Y,LMR, F,[[X1,X2],[J1,J2],[S1,S2],[R1,R2]],[Cx1,Cx2],T):-
   debug_mju( iv, T), 
   %alternative(X1),
   %alternative(X2),
   (T=yes->(tab(1),wn([mre_start,[X1,X2],[J1,S1,R1],[J2,S2,R2],F]));true),
   %-----------
   preference(J1,S1,R11),
   scc(F,S1,V1),
   member(X1,V1),
   (T=yes->(tab(2),wn([[J1,S1,R11],scc,V1,X1]));true),
   %-----------
   preference(J2,S2,R21),
   scc(F,S2,V2),
   member(X2,V2),
   (T=yes->(tab(2),wn([[J2,S2,R21],scc,V2,X2]),
   %-----------
   tab(4),wn([for_scc_pair,[J1,S1,X1],[J2,S2,X2]]));true),
   set_C_star(Cx1,_,[[J1,S1,R1],X1,Bx],[J1,J2],F),
   set_C_star(Cx2,_,[[J2,S2,R2],X2,Bx],[J1,J2],F),
   intersection(Cx1,Cx2,LMR),
   (T=yes->(tab(6),wn([cx1,Cx1,cx2,Cx2,mre,LMR]));true),
   member(Y,LMR),
   alternative(Y),
   (T=yes->(tab(8),wn([mr_end,Y,'in_Cx1*Cx2']));true).



/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%   some tests for conditions �� and ��2   %%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
 

test_mju_ud(F,Is,Bx,Mju):-
   subset(Mju,[i,ii,iii]),
   generate_scc(scc1,F),condition_mju(scc1,Is,Bx,[yes,yes],Mju).

test_mju_ud(F,[J1,J2],Bx,iv):-
   generate_scc(scc1,F),
   condition_mju2(F,[J1,J2],Bx,[yes,yes]).

tell_test_mju(Mju):-
   subset_of(Mju,_,[i,ii,iii,iv]), 
   open('mju.txt',write,S),
   tell('mju.txt'),
   condition_mju(mr,[1,2],_B,[yes,yes],Mju),
   tell(user),wn(end),
   current_stream('mju.txt',write,S),
   close(S).


tell_test_mju2:-
   open('mju2.txt',write,S),
   tell('mju2.txt'),
   condition_mju2(mr,[1,2],_B,[yes,yes]),
   tell(user),wn(end),
   current_stream('mju2.txt',write,S),
   close(S).


/*
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%   awkward outcomes   %%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
% added and modified 23-4 Aug 2002.
% see Maskin and Sjostrom(2002).


is_awkward(C,[[J,S,R],A],[S1,C,Lcc1],Is,F):-
   set_of_alternatives(As),
   subset_of_agents(Is,_),
   member(J,Is),
   scc_defined_state(S,F),
   alternative(A),
   scc(F,S,V),member(A,V),
   preference(J,S,R),
   lcc([J,S,R],A,Lcc),
   alternative(C),member(C,Lcc),
   scc_defined_state(S1,F),
   scc(F,S1,V1),\+member(C,V1),
   %
   preference(J,S1,R1),
   lcc([J,S1,R1],C,Lcc1),
   subset(Lcc,Lcc1),
   wn([[scc,V,S],[agent,J,[lcc,A,Lcc]]]),
   write('->'),wn([[scc,V1,S1],[agent,J,[lcc1,C,Lcc1]]]),
   forall(
    (nth1(_K,Is,I),I\=J),
    (lcc([I,S1,_Rk],C,As))
   ).


% C_star has been excluded all higher order awkward outcomes. 
awk(W,[[J,S,R],A],Is,F):-
   alternative(A),
   state(S),
   agent(J),
   set_C_star(C,_K,[[J,S,R],A,_B],Is,F),
   lcc([J,S,R],A,L),
   (subset(C,L)->wn(ok);wn(ng)),
   subtract(L,C,W).

test_awk1(C,[[J,S,R],A],L):-
   is_awkward(C,[[J,S,R],A],B,[1,2],suh),
   \+ numbervars(B,v,0,0),
   awk(W,[[J,S,R],A],[1,2],suh),
   \+ member(C,W),
   lcc([J,S,R],A,L).

test_awk2(Cw1,Cw2,[[J,S,R],A],L,Bx,Cx,[DCk,Ck1,K1]):-
   awk(Cw1,[[J,S,R],A],[1,2],suh),
   findall(C,
     is_awkward(C,[[J,S,R],A],_,[1,2],suh),
   C2 ),
   sort(C2,Cw2),
   lcc([J,S,R],A,L),
   set_C_star(Cx,K,[[J,S,R],A,Bx],[1,2],suh),
   K1 is K -1,
   set_dCk(K1,DCk,_Ck,Ck1,[[J,S,R],A,Bx],[1,2],suh).

set_dCk(K,DCk,Ck,Ck1,[[J,S,R],A,Bstar],Is,F):-
   set_Ck([K|_],Ck-Ck1,[[J,S,R],A,Bstar],Is,F),
   subtract(Ck,Ck1,DCk).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@���i�b�V�����s�F
%�@�C�Ӓ�g�ւ̑ϐ��i�قڊ����j
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)11

% ----------------------------------------------------------- %
% 11. Strong Nash Implementation : coalition-proofness
% ----------------------------------------------------------- %
% reference: Suh(1996).

% 24 Aug 2002.
% revised: 24 Oct 2005
% revised: 2 Nov 2005.  added coalition/2. 
%   corrected the order of arguments of prefer_profile_1/3


% coalition of agents.

coalition( T):-
   subset_of_agents( T,_),
   T \=[].

% coalition restricted to a subset of agents.

coalition( T, Is):-
   (var(Is)->subset_of_agents( Is,_);true),
   coalition( T),
   subset( T, Is). 


% ----------------------------------------------------------- %
% modified: 6 Nov 2005.  moved from next section.


all_coalitions_other_than_N( LT1):-
   set_of_agents( N),
   findall( T1,
    (
     subset_of_agents(T1,_),
     T1 \=[],
     T1 \=N
    ),
   LT1).


% act on the SCC given a preference profile (and the state).

act_profile_pair_on_scc( A, (S, Rss), (F,Is)):- 
   alternative(A),
   current_model_defaults( [_,_, F,Is]),
   scc( F, S, SC),
   member( A, SC),
   prefer_profile_1( Is, S, Rss).


%  demo
% ----------------------------------------------------------- %
/*

?- act_profile_pair_on_scc( A, (S, Rss), (F,Is)).

A = x
S = s1
Rss = [ (1, [x, z, y, w]), (2, [y, z, x, w]), (3, [z, x, w, y])]
F = f
Is = [1, 2, 3] ;

A = x
S = s2
Rss = [ (1, [x, z, y, w]), (2, [y, z, x, w]), (3, [z, x, y, w])]
F = f
Is = [1, 2, 3] ;

A = z
S = s1
Rss = [ (1, [x, z, y, w]), (2, [y, z, x, w]), (3, [z, x, w, y])]
F = f
Is = [1, 2, 3] ;

No
?- 

*/

% profiles for the coalition-based modeling
% ----------------------------------------------------------- %
% modified: 5 Nov 2005. rename. theta_profile( <== t-profile)
% modified: 6 Nov 2005. correct. difference lists of Rp and Rl.
%   (wrong specification of the variables)

theta_profile( J, A, (F, Is, S,Rss)):- 
   agent(J),
   act_profile_pair_on_scc( A, (S, Rss), (F,Is)),
   trace_the_rule( theta_profile, [J,A,(F,Is,S,Rss)]). 

tuple_of_theta_profiles_1( _,_,[], [],[],[]).
tuple_of_theta_profiles_1( F,Is, Agents,Rs,Rp,Rl):-
   Agents = [J|N],
   Rs = [(A,S)|L2],
   Rp = [(A,Rss)|L1],
   Rl = [(J,A,S,Rss)|L],
   tuple_of_theta_profiles_1( F,Is, N, L2, L1,L),
   theta_profile( J, A, (F, Is, S,Rss)).

tuple_of_theta_profiles( F,Is, ASs, Rs1, Rs):- 
   set_of_agents( Is),
   tuple_of_theta_profiles_1( F,Is, Is, ASs, Rs1, Rs). 


% ----------------------------------------------------------- %
% modified: 6 Nov 2005.  moved from next section.


all_tuples_of_theta_profiles( F,N, LR1):-
   findall( (R1,R2,R3),
    (
     tuple_of_theta_profiles( F,N, R1, R2, R3)
    ),
   LR1).



%  demo
% ----------------------------------------------------------- %
% modified: 5 Nov 2005.

/*
?- [impl13b],set_model(suh,[gST,suh,[1,2]]).
***  Nash implementation theory on Prolog  ***
(...)
target domain:suh
agents:[1, 2]
alternatives:[a, b, c, d, e, f]
states:[s11, s12, s13, s21, s22, s23, s31, s32, s33]
scc:suh
range:[a, b, c, d, e]
game form:gST

     please select: use this (y),
     another recomendation (a),
     or modify by yourself (m) ?
   (y/a/m)>
|    y.

complete model update :[suh, gST, suh, [1, 2]]
check domain ? :
|    n.

the assumed equilibrium concept is:standard
if you use another model, please type c.
|    c.
 We shall analyze the set of strong Nash equilibrium.

Yes
?- theta_profile( J,A,(F,[1,2],S,_)),write([F,J,A,S]),nl,fail.
[suh, 1, a, s11]
[suh, 1, b, s12]
[suh, 1, b, s32]
[suh, 1, c, s13]
[suh, 1, c, s23]
[suh, 1, c, s33]
[suh, 1, d, s22]
[suh, 1, d, s21]
[suh, 1, e, s11]
[suh, 1, e, s21]
[suh, 1, e, s31]
[suh, 2, a, s11]
[suh, 2, b, s12]
[suh, 2, b, s32]
[suh, 2, c, s13]
[suh, 2, c, s23]
[suh, 2, c, s33]
[suh, 2, d, s22]
[suh, 2, d, s21]
[suh, 2, e, s11]
[suh, 2, e, s21]
[suh, 2, e, s31]

No
?-
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the set tau 
% for an agent j given a coalition 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% a set of agents who is not in the coalition 
% and reported same message as the agent j. 

% modified: 6 Nov 2005. correct.

tau( Tau, [(Rs2,Rs1,Rs),T,J],(F,Is)):-
   tuple_of_theta_profiles( F, Is, Rs2, Rs1, Rs), 
   member( (J,A,_S,Rss), Rs),
   subset_of_agents( T,_),
   subtract( Is, T, NT),
   NT \=[],
   findall(K,
    (
     member( K, NT),
     member( (K,A,_S,Rss), Rs)
    ),
   Tau).


/*
% demo (6 Nov 2005)

 ?- R=(a,s11),tau( Tau, [([R,R],_),T,J],(suh,[1,2])),
wn(Tau;R;T;J),fail.
[1, 2];a, s11;[];1
[1];a, s11;[2];1
[2];a, s11;[1];1
[1, 2];a, s11;[];2
[1];a, s11;[2];2
[2];a, s11;[1];2

No

*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Lower contour set for coalition
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

lcc_for_coalition(  []/Is, (S,R), A, []):-
   set_of_agents(N),
   ( var(Is)->Is =N ;subset(Is, N)),
   prefer_profile_1( Is,S, R),
   alternative(A).

lcc_for_coalition( [J|T] / Is, (S,R), A, Lcc):-
   lcc_for_coalition( T / Is, (S,R), A, Lcc1),
   % member( (J,Rj),R),
   lcc([J,S,_Rj],A,Lj),
   append( Lcc1,Lj,Lcc2),
   sort( Lcc2, Lcc).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the set b_t/3 
% given a coalition (or an emptiness)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% modified: 6 Nov 2005. b_t/5 augmented with trace_the_rule/2.


b_t( F, T, (R2,R1,R), B):-
   b_t( F, T, (R2,R1,R), _, B).

b_t( F, T, (R2,R1,R), Rule, B):-
   preliminary_for_b_t( F, N-T, (R2,R1,R)),
   rule_of_b_t( N-T, (R2,R1,R), B, Rule).

preliminary_for_b_t( F, N-T, (R2,R1,R)):-
   tuple_of_theta_profiles( F, N, R2, R1, R),
   subset_of_agents( T,_).

rule_of_b_t( N-N, _, A, rule_1):-
   set_of_alternatives( A),
   !.

rule_of_b_t( _-[], (R2,_,_), [A], rule_2):-
   sort( R2, [(A,_)]),  % totally agreed
   !.

rule_of_b_t( N-T, (R2,R1,R), B, rule_3):-
   findall( Lcc, 
     rule_3_of_b_t(
       N-T,
       (R2,R1,R),
       _,_, %(J,A,S,Rj),(Tau,NoTau),
       Lcc
     ),
   LLcc),
   flatten( LLcc, B1),
   sort( B1 ,B).

rule_3_of_b_t( N-T, (R2,R1,R), (J,A,S,Rj),(Tau,NoTau),Lcc):-
   ((var(T);var(R))
    ->preliminary_for_b_t( F, N-T, (R2,R1,R))
    ;true
   ),
   member( J, N),
   \+ member( J, T),
   tau( Tau, [(R2,R1,R),T,J],(F,N)),
   subtract( N, Tau, NoTau),
   member( (J,A,S,Rj), R),
   lcc_for_coalition( NoTau/ N, (S,Rj),A,Lcc),
   trace_the_rule( b_t_3, [N-T, R2, Tau,(J,A,S,Lcc)]).


%  demo
% ----------------------------------------------------------- %
/*
% a demo. (6 Nov 2005)

?- current_model_defaults(M).

M = [suh, gST, suh, [1,2]]

Yes
?- chmod_trace_the_rule(b_t_3,_->on).

Yes
?- T=[1],b_t( F,T, (R2,_), NR,B).
[1, 2]-[1];[ (a, s11), (a, s11)];[2];2, a, s11, [a, c, d, e, f]

T = [1]
F = suh
R2 = [ (a, s11), (a, s11)]
NR = rule_3
B = [a, c, d, e, f] ;
[1, 2]-[1];[ (b, s12), (a, s11)];[2];2, a, s11, [a, c, d, e, f]

T = [1]
F = suh
R2 = [ (b, s12), (a, s11)]
NR = rule_3
B = [a, c, d, e, f] 

Yes
?- chmod_trace_the_rule(b_t_3,_->off).

Yes
?- setof(R2,RL^b_t( suh,T, (R2,RL), NR,B),XX),
member(B,[[_]]),
nl,wn(b=B;T;NR),
forall(member(R2,XX),(tab(2),wn(R2))),fail.

b=[a];[];rule_2
  [ (a, s11), (a, s11)]

b=[b];[];rule_2
  [ (b, s12), (b, s12)]
  [ (b, s32), (b, s32)]

b=[c];[];rule_2
  [ (c, s13), (c, s13)]
  [ (c, s23), (c, s23)]
  [ (c, s33), (c, s33)]

b=[d];[];rule_2
  [ (d, s21), (d, s21)]
  [ (d, s22), (d, s22)]

b=[e];[];rule_2
  [ (e, s11), (e, s11)]
  [ (e, s21), (e, s21)]
  [ (e, s31), (e, s31)]

No
?- setof(R2,RL^b_t( suh,T, (R2,RL), NR,B),XX),
NR=rule_3,
nl,wn(b=B;T;NR),fail.

b=[a, c, d, e, f];[1];rule_3

b=[c, e, f];[1];rule_3

b=[a, b, c, d, e, f];[1];rule_3

b=[a, b, e, f];[];rule_3

b=[a, b, f];[2];rule_3

b=[a, b, c, e, f];[];rule_3

b=[a, b, c, e, f];[2];rule_3

b=[a, b, c, d, f];[2];rule_3

b=[a, b, c, d, e, f];[];rule_3

b=[a, b, c, d, e, f];[2];rule_3

b=[e, f];[1];rule_3

No
?- setof(R2,RL^b_t( suh,T, (R2,RL), NR,B),XX),T=[1],
nl,wn(b=B;T;NR),
tuple_of_theta_profiles( suh, [1,2], R2, _, _),
\+ member(R2,XX).

b=[a, c, d, e, f];[1];rule_3

R2 = [ (a, s11), (b, s12)]
RL = _G161
T = [1]
NR = rule_3
B = [a, c, d, e, f]
XX = [[ (a, s11), (a, s11)], [ (b, s12), (a, s11)], [ (b, s32), (a, s11)], [ (c, s13), (a, s11)], [ (c, s23), (a, s11)], [ (c, s33), (a, s11)], [ (d, s21), (..., ...)], [ (..., ...)|...], [...|...]|...] 

Yes
?- tell_goal('suh_test.txt',(T=[],
b_t( F,T, (R2,_), NR,B),nl,write(R2;NR;T;B),
(sort(R2,[_])->write([agree]);true),fail;true)).

F = _G163
T = _G164
R2 = _G160
NR = _G166
B = _G167 

Yes
?-

% correct as well as above. (6 Nov 2005)

suh_test.txt ====>


% file output start time , [date(2005/11/6), time(22:0:22)]

%----------  start from here ------------%

[ (a, s11), (a, s11)];rule_2;[];[a][agree]
[ (b, s12), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (b, s32), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (c, s13), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (a, s11)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (b, s12), (b, s12)];rule_2;[];[b][agree]
[ (b, s32), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (c, s13), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (b, s12)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (b, s12), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (b, s32), (b, s32)];rule_2;[];[b][agree]
[ (c, s13), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (b, s32)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (c, s13)];rule_3;[];[a, b, c, e, f]
[ (b, s12), (c, s13)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (c, s13)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (c, s13)];rule_2;[];[c][agree]
[ (c, s23), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (c, s13)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (c, s23)];rule_3;[];[a, b, c, e, f]
[ (b, s12), (c, s23)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (c, s23)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (c, s23)];rule_2;[];[c][agree]
[ (c, s33), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (c, s23)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (c, s33)];rule_3;[];[a, b, c, e, f]
[ (b, s12), (c, s33)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (c, s33)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (c, s33)];rule_2;[];[c][agree]
[ (d, s22), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (c, s33)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (b, s12), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (b, s32), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (c, s13), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (d, s22)];rule_2;[];[d][agree]
[ (d, s21), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (d, s22)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (b, s12), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (b, s32), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (c, s13), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (d, s21)];rule_2;[];[d][agree]
[ (e, s11), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (d, s21)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (e, s11)];rule_3;[];[a, b, e, f]
[ (b, s12), (e, s11)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (e, s11)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (e, s11)];rule_2;[];[e][agree]
[ (e, s21), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (e, s11)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (e, s21)];rule_3;[];[a, b, e, f]
[ (b, s12), (e, s21)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (e, s21)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (e, s21)];rule_2;[];[e][agree]
[ (e, s31), (e, s21)];rule_3;[];[a, b, c, d, e, f]
[ (a, s11), (e, s31)];rule_3;[];[a, b, e, f]
[ (b, s12), (e, s31)];rule_3;[];[a, b, c, e, f]
[ (b, s32), (e, s31)];rule_3;[];[a, b, c, e, f]
[ (c, s13), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (c, s23), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (c, s33), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (d, s22), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (d, s21), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (e, s11), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (e, s21), (e, s31)];rule_3;[];[a, b, c, d, e, f]
[ (e, s31), (e, s31)];rule_2;[];[e][agree]
%----------  end of data ------------%
% file output end time , [date(2005/11/6), time(22:0:22)]

<===  suh_test.txt

*/

% ----------------------------------------------------------- %
%   trace tool for rules (for set_C_T_with_memoing/3)
% ----------------------------------------------------------- %
% added: 6 Nov 2005.

:- dynamic  mode_of_trace_the_rule/2.

%mode_of_trace_the_rule( theta_profile, on).
%mode_of_trace_the_rule( b_t_3, on).
%mode_of_trace_the_rule( memo_CTm, on).
mode_of_trace_the_rule( _, off).

trace_the_rule( TR,_):-
   \+ mode_of_trace_the_rule( TR, on),
   !.

trace_the_rule( theta_profile, [J,A,(F,Is,S,Rss)]):-
   wn( (J;A;(F,Is,S,Rss))  ).

trace_the_rule( b_t_3, [N-T, R2, Tau,(J,A,S,Lcc)]):-
   wn( (N-T; R2; Tau;(J,A,S,Lcc))  ).

trace_the_rule( memo_CTm, DATA):-
   DATA=[
     Case,
     [X,F|_],               % Target = (Do,K,T,R,C)
     [Do, K, T/_N, (R,_)],  % XRule = [X,F,LR1,LT1]
     C
   ],
   wn( (C, X ; F ; T ; Do; K, R; Case)  ).

% status quo.

chmod_trace_the_rule( TR, on->on):-
   mode_of_trace_the_rule( TR, on).

chmod_trace_the_rule( TR, off->off):-
   \+ mode_of_trace_the_rule( TR, on).

% switch on->off

chmod_trace_the_rule( TR, on->off):-
   chmod_trace_the_rule( TR, on->on),
   retract(
     mode_of_trace_the_rule( TR, on)
   ).

% switch off->on

chmod_trace_the_rule( TR, off->on):-
   chmod_trace_the_rule( TR, off->off),
   assert(
     mode_of_trace_the_rule( TR, on)
   ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%    Condition gamma 0 and Suh's algorithm
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%(almost complete: 7 Nov 2005)

% Condition Gamma-0 (See Suh(1996)).

% The condition gamma 0 is almost intuitivel, and of course, logically,
% implied by the Suh's algorithm in the sufficiency proof of 
% the implementability theorem,  
% which constructs a collection of set C_T( Theta profiles)
% that correponds the attainable set by a coalition T of agents.


% added: 25-28 Oct 2005.  
% modified: 5-6 Nov 2005.  rename. set_C_T_m (<== collection_of_Cts)
%  revise. select_inputs_for_C_T_m_rule/4 (<=/3)
%  add. gen_test_C_T/1,/2, set_C_T_with_memoing/3, trace_the_rule/2 ( cui section), 
%  revise. individually_Ct_monotone_set/4, coalitionally_Ct_monotone_set/3.


:- dynamic  set_C_T_0/3.

/*
condition_gamma_0:-
   generate_set_C_T_m,
   \+ \+ condition_gamma_0( _, _, _, _).
*/

%  generate the collection of C_Ts with memoing
% ----------------------------------------------------------- %

initialize_set_C_T_0:-
   abolish( set_C_T_0/3).

generate_set_C_T:-
   initialize_set_C_T_0,
   set_C_T_with_memoing( _,_,_),
   fail.

generate_set_C_T_m.


%  the constructive rules of Ct(k).
% ----------------------------------------------------------- %
% See Suh(1996), p.119
% revised: 5 Nov 2005.

% the inductive rule for T = N.

set_C_T_m( [all|Rule], [con,[0], N/N, Theta], C):-
   Rule=[F,LR1,LT1],
   select_inputs_for_C_T_m_rule( F, all, N/N:LT1, Theta:LR1),
   intersection_of_all( Lcc,
    (
     act_profile_pair_on_scc( A, (S, R), (F,N)),
     lcc_for_coalition( N/N, (S,R),A,Lcc)
     %,wn((S,R,A,Lcc))
    ),
   C).
 
set_C_T_m( [all|Rule], [DO,[K|L], N/N, Theta], C):-
   Rule=[F,_LR1,_LT1],
   set_C_T_m( [all|Rule], [con, L, N/N, Theta], C0),
   length(L, K),
   individually_Ct_monotone_set( F, C0, N, C),
   ( C0=C -> !, DO=stop; DO=con).

% the inductive rule for T \= N.

set_C_T_m( [part|Rule], [con, [0], T/N, Theta], C):-
   Rule=[F,LR1,LT1],
   select_inputs_for_C_T_m_rule( F, part, T/N:LT1, Theta:LR1),
   intersection_of_all( C1,
    (
     coalition_augmented_by( T, _T1: LT1, Tu),
     limit_set_C_T_m( [_|Rule], [_, Tu/N, Theta], C1)
    ),
   Cu),
   b_t( F, T, Theta, B),
   intersection( Cu, B, C).

set_C_T_m( [part|Rule], [DO, [K|L], T/N, Theta], C):-
   Rule=[F,_LR1,LT1],
   set_C_T_m( [part|Rule], [con, L, T/N, Theta], C0),
   length(L, K),
   coalitionally_Ct_monotone_set( F, [C0,T,LT1,Theta], C),
   ( C0=C -> !, DO=stop; DO=con).


% the limit of Ct(k)s (= the set C_T(R)).
% ----------------------------------------------------------- %

set_C_T( XR, [T/N, R], C):-
   limit_set_C_T_m( XR, [_, T/N, R], C).

limit_set_C_T_m( XR, [K, T/N, R], C):-
   set_C_T_with_memoing( XR, [stop, K, T/N, R], C).



%  the generative rule with memoing.
% ----------------------------------------------------------- %

set_C_T_with_memoing( XRule, [Do, K, T/N, R], C):-
   XRule = [X,F,LR1,LT1],
   CT0 = set_C_T_0( XRule, [Do, K, T/N, R], C),
   Target = (Do,K,T,R,C),
   findall( Target, clause( CT0, true), Bag),
   select_inputs_for_C_T_m_rule( F, X, T/N:LT1, R:LR1),
   memo_CTm( Target, Bag, N, XRule).

memo_CTm( Target, Bag, N, XRule):-
   memo_CTm_if_not_yet( Case, Target, Bag, N, XRule),
   Target = (Do,K,T,R,C),
   %XRule = [X,F,LR1,LT1],
   trace_the_rule( memo_CTm,
     [Case, XRule, [Do,K,T/N,R], C]
   ).

memo_CTm_if_not_yet( case_1, Target, Bag, _,_):-
   member( Target, Bag).

memo_CTm_if_not_yet( case_2, Target, Bag, N, XRule):-
   \+ member( Target, Bag),
   Target = ( Do, K, T, R, C),
   set_C_T_m( XRule, [Do, [K|_], T/N, R], C),
   CT0 = set_C_T_0( XRule, [Do, K, T/N, R], C),
   assert( CT0),
   (Do=stop->write(['*']);true),
   !.


%  a demo (6 Nov 2005)
% ----------------------------------------------------------- %
/*
?- set_C_T_with_memoing( [X,suh|_], [Y, K, T/[1,2], (R,_)], C).

X = all
Y = con
K = [0]
T = [1, 2]
R = [ (a, s11), (a, s11)]
C = [a, b, c, d, e, f] ;

X = all
Y = con
K = [1, 0]
T = [1, 2]
R = [ (a, s11), (a, s11)]
C = [a, c, e, f] ;

X = all
Y = con
K = [2, 1, 0]
T = [1, 2]
R = [ (a, s11), (a, s11)]
C = [c, e, f] 

Yes
?- 

*/

% the subsidiary rules.
% ----------------------------------------------------------- %
% modified: 5 Nov 2005. 


select_inputs_for_C_T_m_rule( F, X, T/N:LT1, Theta:LR1):-
   \+ var( LT1), length( LT1,_),
   \+ var( LR1), length( LR1,_),
   \+ (member(Q,[F, X,T,N,Theta]),var( Q)),
   !.

select_inputs_for_C_T_m_rule( F, all, N/N:LT1, Theta:LR1):-
   given_for_set_C_T_m( F, N, LR1, LT1),
   member( Theta, LR1).

select_inputs_for_C_T_m_rule( F, part, T/N:LT1, Theta:LR1):-
   given_for_set_C_T_m( F, N, LR1, LT1),
   member( Theta, LR1),
   member( T, [[]|LT1]).


:- dynamic  given_for_set_C_T_m_0/4.

given_for_set_C_T_m( F, N, LR1,LT1):-
   current_model_defaults( [_,_, F,N]),
   Target = given_for_set_C_T_m_0( F, N, LR1,LT1),
   clause(Target, _),
   !.

given_for_set_C_T_m( F, N, LR1,LT1):-
   current_model_defaults( [_,_, F,N]),
   Target = given_for_set_C_T_m_0( F, N, LR1,LT1),
   \+ clause( Target, _),
   all_tuples_of_theta_profiles( F,N, LR1),
   all_coalitions_other_than_N( LT1),
   assert( Target),
   !.

% moved into previous section (6 Nov 2005) 
% all_tuples_of_theta_profiles/ 3 and 
% all_coalitions_other_than_N/ 1

% ----------------------------------------------------------- %
% revised: 6 Nov 2005.

coalition_augmented_by( T, T1: LT1, Tu):-
   \+ var(LT1),
   member( T1, LT1),
   subtract( T1, T, D),
   D \= [],
   append( T, T1, T2),
   sort( T2, Tu).

% intersection_of_all/3  ==> common programs section.


% ----------------------------------------------------------- %
% revised: 5-6 Nov 2005.

individually_Ct_monotone_set( F, C0, N, MC):-
   findall( A,
     individually_Ct_monotone_element( F, A:C0, _J:N ),
   Q),
   sort( Q, MC).


individually_Ct_monotone_element( F, A:C0, J:N):-
   member( A, C0),
   \+ individually_Ct_non_monotone( F, A:C0,J:N, (_,_)).

individually_Ct_non_monotone( F, A:C0, J:Is, (S,R)):-
   set_of_agents(N),
   set_of_alternatives(A0),
   (var(Is) -> Is=N ;subset(Is,N)),
   (var(C0) -> C0=A0 ;subset(C0,A0)),
   alternative(A),
   scc( F, S, C),
   \+ member( A, C),
   forall(
    (
     agent(J),
     member( J, N),
     lcc([J,S,R],A,L)
    ),
     subset( C0, L)
   ).


% ----------------------------------------------------------- %

coalitionally_Ct_monotone_set( F, [C0,T,LT1,Theta], M):-
   findall( A,
    (
     coalitionally_Ct_monotone( F, [C0, T,LT1,Theta], A)
    ),
   Q),
   sort( Q, M).

coalitionally_Ct_monotone( F, [C0,T,LT1,Theta], A):-
   member(A, C0),
   forall(
    (
     coalitionally_Ct_monotone_condition_1( [S, C0,T], A),
     coalitionally_Ct_monotone_condition_2(F, [T, LT1,Theta], A)
    ),
    (
     scc( F, S, C),
     member( A, C)
    ) 
   ).

% the preconditions for every inviduals.
 
coalitionally_Ct_monotone_condition_1( [S, C0, T], A):-
   (var(A)->alternative(A);true),
   forall(
    (
     agent(J),
     member( J, T),
     lcc([J,S,_],A,Lcc)
    ),
    (
     subset( C0, Lcc)
    )
   ).

% the preconditions for every super set coalitions 
% except for the set of all agents.

coalitionally_Ct_monotone_condition_2( F, [S, T, LT1, Theta], A):-
   (var(A)->alternative(A);true),
   forall(
    (
     coalition_augmented_by( T, T1: LT1, Tu),
     %% T1 \= N, since all_coalitions_other_than_N( LT1).
     limit_set_C_T_m( [_, F| _], [_,Tu/N, Theta], Cu),
     lcc_for_coalition( T1 /N, (S,_R), A, Lcc)
    ),
    (
     subset( Cu, Lcc)
    )
   ).



%  generate and display the collection of C_T_ms
% ----------------------------------------------------------- %


gen_test_C_T( Type, display):-
   set_of_agents(N),
   forall_do_with_displaying_id(
    (
     %R = [ (a, s11), (a, s11)],  % a debug code for suh.
     member( Type, [all,part]),
     limit_set_C_T_m( [Type,F|_],[K, T/N, (R,_)],C)
    ),
    (
     C, Type ; F ; T ; K, R
    )
   ),
   nl,wn(complete),
   !.


gen_test_C_T( Part):-
   tell_goal('lim_C.txt',gen_test_C_T( Part, display)).

gen_test_C_T( _):-
   error_handling_for_gen_test_C_T( _Strm).

error_handling_for_gen_test_C_T( B):-
   current_stream('lim_C.txt',write,B),
   close(B),
   fail.

error_handling_for_gen_test_C_T(_).


%  demo
% ----------------------------------------------------------- %
/*

?- abolish( set_C_T_0/3), 
[impl13b],set_model(suh,_,[no,yes]).
***  Nash implementation theory on Prolog  ***
(...)

target domain:suh
agents:[1, 2]
alternatives:[a, b, c, d, e, f]
states:[s11, s12, s13, s21, s22, s23, s31, s32, s33]
scc:suh
range:[a, b, c, d, e]
game form:gST

     please select: use this (y),
     another recomendation (a),
     or modify by yourself (m) ?
   (y/a/m)>
|: y

complete model update :[suh, gST, suh, [1, 2]]
the assumed equilibrium concept is:standard
 We shall analyze the set of strong Nash equilibrium.

Yes
?- gen_test_C_T(all).

Yes

lim_C.txt ====>

?-  gen_test_C_T(all,display).

[1] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (a, s11), (a, s11)]
[2] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (b, s12), (a, s11)]
[3] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (b, s32), (a, s11)]
[4] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (c, s13), (a, s11)]
[5] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (c, s23), (a, s11)]
[6] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (c, s33), (a, s11)]
[7] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (d, s22), (a, s11)]
[8] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (d, s21), (a, s11)]
[9] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (e, s11), (a, s11)]
[10] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (e, s21), (a, s11)]
(...)
[120] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (e, s21), (e, s31)]
[121] [a, b, c, d, e, f], all;suh;[1, 2];1, [ (e, s31), (e, s31)]
complete


<===  lim_C.txt


?- chmod_trace_the_rule( memo_CTm,  _->on).

Yes
?- R = [ (a, s11), (a, s11)],
set_C_T_m([part,suh|_],[D,K,T/_,(R,_)],C).
[a, b, c, d, e, f], all;suh;[1, 2];stop;1, [ (a, s11), (a, s11)];case1
[*][a, b, f], part;suh;[2];stop;1, [ (a, s11), (a, s11)];case2
[a, b, c, d, e, f], all;suh;[1, 2];stop;1, [ (a, s11), (a, s11)];case1
[*][a, c, d, e, f], part;suh;[1];stop;1, [ (a, s11), (a, s11)];case2

D = con
K = [0]
T = []
R = [ (a, s11), (a, s11)]
C = [a] 

Yes
 ?- retract(set_C_T_0([part|A],B,C)),fail.

No
?- R = [ (a, s11), (a, s11)],
set_C_T_m([part,suh|_],[D,K,[1]/_,(R,_)],C).
[a, b, c, d, e, f], all;suh;[1, 2];stop;1, [ (a, s11), (a, s11)];case_1

R = [ (a, s11), (a, s11)]
D = con
K = [0]
C = [a, c, d, e, f] ;
[a, b, c, d, e, f], all;suh;[1, 2];stop;1, [ (a, s11), (a, s11)];case_1

R = [ (a, s11), (a, s11)]
D = stop
K = [1, 0]
C = [a, c, d, e, f] ;

No
?- chmod_trace_the_rule( memo_CTm,  _->off).

Yes
?- R = [ A, A],
set_C_T_m([part,suh|_],[D,K,[]/_,(R,_)],C),
wn(D;K;R;C),fail.
con;[0];[ (a, s11), (a, s11)];[a]
[*][*]con;[0];[ (b, s12), (b, s12)];[b]
[*][*]con;[0];[ (b, s32), (b, s32)];[b]
[*][*]con;[0];[ (c, s13), (c, s13)];[c]
[*][*]con;[0];[ (c, s23), (c, s23)];[c]
[*][*]con;[0];[ (c, s33), (c, s33)];[c]
[*][*]con;[0];[ (d, s22), (d, s22)];[d]
[*][*]con;[0];[ (d, s21), (d, s21)];[d]
[*][*]con;[0];[ (e, s11), (e, s11)];[e]
[*][*]con;[0];[ (e, s21), (e, s21)];[e]
[*][*]con;[0];[ (e, s31), (e, s31)];[e]
stop;[1, 0];[ (a, s11), (a, s11)];[a]

No
?- gen_test_C_T(part).

Yes
?-

lim_C.txt ====>


% file output start time , [date(2005/11/7), time(2:10:9)]

%----------  start from here ------------%
[*]
[1] [a], part;suh;[];1, [ (a, s11), (a, s11)]
[2] [a, b, f], part;suh;[2];1, [ (a, s11), (a, s11)]
[3] [a, c, d, e, f], part;suh;[1];1, [ (a, s11), (a, s11)][*][*][*]
[4] [a, c, e, f], part;suh;[];1, [ (b, s12), (a, s11)][*]
[5] [a, b, c, e, f], part;suh;[2];1, [ (b, s12), (a, s11)][*]
[6] [a, c, d, e, f], part;suh;[1];1, [ (b, s12), (a, s11)][*][*][*]
[7] [a, c, e, f], part;suh;[];1, [ (b, s32), (a, s11)][*]
[8] [a, b, c, e, f], part;suh;[2];1, [ (b, s32), (a, s11)][*]
[9] [a, c, d, e, f], part;suh;[1];1, [ (b, s32), (a, s11)][*][*][*]
[10] [a, c, d, e, f], part;suh;[];1, [ (c, s13), (a, s11)][*]
[11] [a, b, c, d, e, f], part;suh;[2];1, [ (c, s13), (a, s11)][*]
[12] [a, c, d, e, f], part;suh;[1];1, [ (c, s13), (a, s11)][*][*][*]
(...)

[361] [e], part;suh;[];1, [ (e, s31), (e, s31)]
[362] [a, b, c, d, e, f], part;suh;[2];1, [ (e, s31), (e, s31)]
[363] [e, f], part;suh;[1];1, [ (e, s31), (e, s31)]
complete

%----------  end of data ------------%
% file output end time , [date(2005/11/7), time(2:21:37)]

<===  lim_C.txt

% cf., for model mr
% scc: 
% mr(s1) = [c]   mr(s2) = [d]   mr(s3) = [c]   mr(s4) = [c]   

?- R = [ A, A],
set_C_T_m([part,mr|_],[D,K,[]/_,(R,_)],C),
wn(D;K;R;C),fail.
con;[0];[ (c, s1), (c, s1)];[c]
con;[0];[ (c, s3), (c, s3)];[c]
con;[0];[ (c, s4), (c, s4)];[c]
con;[0];[ (d, s2), (d, s2)];[d]
stop;[1, 0];[ (c, s1), (c, s1)];[c]

No
?- M=(R,A,B,0,0),mtest(gMR2,mr,[1:M,2:M],[1,2]),
mechanism(gMR2(P,mr),[1:M,2:M],C),
prefer_profile([1,2],S,R),
wn(C;P;S;M),fail.
[c];1;s1;[[a, c, d, b, z], [b, c, d, a, z]], c, a, 0, 0
[c];1;s1;[[a, c, d, b, z], [b, c, d, a, z]], c, b, 0, 0
[c];1;s1;[[a, c, d, b, z], [b, c, d, a, z]], c, c, 0, 0
[c];1;s1;[[a, c, d, b, z], [b, c, d, a, z]], c, d, 0, 0
[c];1;s1;[[a, c, d, b, z], [b, c, d, a, z]], c, z, 0, 0
[d];1;s2;[[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0
[d];1;s2;[[a, d, c, b, z], [b, d, c, a, z]], d, b, 0, 0
[d];1;s2;[[a, d, c, b, z], [b, d, c, a, z]], d, c, 0, 0
[d];1;s2;[[a, d, c, b, z], [b, d, c, a, z]], d, d, 0, 0
[d];1;s2;[[a, d, c, b, z], [b, d, c, a, z]], d, z, 0, 0
[c];1;s3;[[a, c, d, b, z], [b, d, c, a, z]], c, a, 0, 0
[c];1;s3;[[a, c, d, b, z], [b, d, c, a, z]], c, b, 0, 0
[c];1;s3;[[a, c, d, b, z], [b, d, c, a, z]], c, c, 0, 0
[c];1;s3;[[a, c, d, b, z], [b, d, c, a, z]], c, d, 0, 0
[c];1;s3;[[a, c, d, b, z], [b, d, c, a, z]], c, z, 0, 0
[c];1;s4;[[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0
[c];1;s4;[[a, d, c, b, z], [b, c, d, a, z]], c, b, 0, 0
[c];1;s4;[[a, d, c, b, z], [b, c, d, a, z]], c, c, 0, 0
[c];1;s4;[[a, d, c, b, z], [b, c, d, a, z]], c, d, 0, 0
[c];1;s4;[[a, d, c, b, z], [b, c, d, a, z]], c, z, 0, 0

No
?-
*/


%  a test of the coincidence of set_C_T (by Suh's algorithm)
%  and set_C_star (by Sjostrom's algorithm) for singltons
% ----------------------------------------------------------- %
% added: 8 Nov 2005.

test_coincidence_of_C_T_and_C_star( mr):-
   nl,
   set_C_T([part,mr|_],[[J]/[1,2],([(A,S),(A,S)],_)],C_suh),
   set_C_star(C_str,_,[[J,S,_],A,B_str],[1,2],mr),
   set_C_T([all,mr|_],[_,([(A,S),(A,S)],_)],B_suh),
   wn((C_suh;B_suh)),
   wn((C_str;B_str:[J,A,S])),
   fail.

/*
?- test_coincidence_of_C_T_and_C_star( mr).

[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, c, s1]
[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, c, s1]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, c, s1]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, c, s1]
[a, c, z];[a, b, c, d, z]
[a, c, z];[a, b, c, d, z]:[2, c, s3]
[a, c, z];[a, b, c, d, z]
[a, c, z];[a, b, c, d, z]:[2, c, s3]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, c, s3]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, c, s3]
[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, c, s4]
[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, c, s4]
[b, c, z];[a, b, c, d, z]
[b, c, z];[a, b, c, d, z]:[1, c, s4]
[b, c, z];[a, b, c, d, z]
[b, c, z];[a, b, c, d, z]:[1, c, s4]
[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, d, s2]
[a, c, d, z];[a, b, c, d, z]
[a, c, d, z];[a, b, c, d, z]:[2, d, s2]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, d, s2]
[b, c, d, z];[a, b, c, d, z]
[b, c, d, z];[a, b, c, d, z]:[1, d, s2]

No
?- 

*/


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@���J�j�Y���̐݌v(1)�F���b�Z�[�W
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)12

% ----------------------------------------------------------- %
% 12. Designing mechanisms (1): The message space
% ----------------------------------------------------------- %
% edited from: Sep 2001.
% modified: 30 Oct 2005. moved. mechanism/4 => section 13.

% A mechanism, (M,g), consists of a message space, M=M[1]x...xM[n],
% that is a Cartesian product of n individual message space, one for
% each agent, and an outcome function, g:M-->A. 


   %%%%%%%%%%%%%%%%%%%%%%%%
   %    message spaces    %
   %%%%%%%%%%%%%%%%%%%%%%%%


% ----------------------------------------------------------- %
%  generic message profiles with N agents
% ----------------------------------------------------------- %
% modified: 4 Dec 2002. bugfix. mtest_z0 for gMR and gMR2 with 0 arguments.
% modified: 2 Jan 2003. mtest /5
% modified: 14 Mar 2005. 
% modified: 30 Oct 2005. mtest/4 and mtest_z0/4 have moved to section 13.
% modified: 2 Nov 2005. added mtest_truthfully/5 and mtest_z0_truthfully/5.


% the integrated rule.

mtest(GF,Scc,Msg,Is):-
   message_profile(GF,Scc,Msg,Is).

% a variant of zero setting for the integers.

mtest_z0(GF, Scc,Msg,Is):-
   message_profile_with_zeros(GF, Scc,Msg,Is).


% state dependent (truthful) reports. (added: 2 Nov 2005)

mtest_truthfully( S,GF, Scc,Msg,Is):-
   Mode=..[truthfully,_],
   message_profile_with_mode(Mode,S,GF,Scc,Msg,Is).

mtest_z0_truthfully( S, GF, Scc,Msg,Is):-
   Mode=..[truthfully,0],
   message_profile_with_mode(Mode,S,GF,Scc,Msg,Is).


% When the integer roulette is used, the outcome should be 
% computed by using message_profile/4 (=mtest/4),
% instead of message_profile_with_zeros/4 (=mtest_z0/4),
% and the truthful messages can be tested by using 
% message_profile_with_mode/6 (<== mtest_truthfully/5,
% or mtest_z0_truthfully/4). 


% the synonyms :
%  mtest/4 (<== message_profile/4)
%  mtest_z0/4 (<==message_profile_with_zeros/4)
%  mtest_truthfully/5 (<==a variant of message_profile_with_mode/6)
%  mtest_z0_truthfully/5 (<==a variant of message_profile_with_mode/6)



% ----------------------------------------------------------- %
%  mechanism-specific message spaces 
% ----------------------------------------------------------- %
% edited from: Sep 2001.
% modified: 24 Aug 2002. by using maplist.
% modified: 29 Dec 2002. abolished maplists.
% modified: 14 Mar 2005. rename. message_profile/4 (was: mtest/4) 
% modified: 30 Oct 2005. added the message space for gST and gMM,
%  revised message/6 with agent indices,
%  and so message_profile/4, message_profile_with_mode/6.
% modified: 9 Nov 2005. abolish some redundant model specific 
%  message_profile/4s and replicate them by message_profile_0/4s. 


%  strategies for each player:
%  message/5 into which several game forms integrated 
% ----------------------------------------------------------- %
% modified: 31 Oct 2005. added for gDict, gD, gST.
% modified: 9 Nov 2005. added for gTmr.

message( gDict(_,Scc),[I,J],K,X,true):-
   range(Scc,B),
   member(K,[I,J]),
   alternative(X),
   member( X, B).

message( gD(_,Scc),[I,J],K,(X,Z),true):-
   scc(Scc),
   member(K,[I,J]),
   subset_of_alternatives(X,_),
   member(Z,[0,1]).

message( gST(_,Scc),[I,J],K,X,true):-
   scc(Scc),
   member(K,[I,J]),
   member( X, [m(1),m(2),m(3),m(4)]).

message( gTmr(_,Scc),[I,J],K,X,true):-
   scc(Scc),
   member(K,[I,J]),
   member( X, [m(1),m(2)]).


message( gM(_,F),Is,I,M,C):- maskin_msg(gM(_,F),Is,I,M,C).
message( gMM(_,F),Is,I,M,true):- reduced_msg(gMM(_,F),Is,I,M).
message( gMR(_,F),Is,I,M,_):- mr_msg(Is,F,I,M).
message( gMR2(_,F),Is,I,M,_):- mr2_msg(Is,F,I,M).


%%%%%%%%%%%%%
%  for N=2
%%%%%%%%%%%%%


% *** exceptional message profiles (9 Nov 2005) *****
% Once upon a time message_profile/4 for the some specific models.
% The sake of understanding of the reader. 


%  message profiles for gTmr which is 
%  a model specific tabular mechanism for the model mr. 
% ----------------------------------------------------------- %
% mr �h���C�����r�b�b�A gTmr���J�j�Y���̃��b�Z�[�W���: 2 person�A �\�`��
% See Moore and Repullo(1991), p.1095.
% added: 9 Nov 2005.


message_profile_0(gTmr,Scc,[J1:X,J2:Y],[J1,J2]):-
   scc(Scc),
   two_person([J1,J2]),
   member( X, [m(1),m(2)]),
   member( Y, [m(1),m(2)]).


%  message profiles for gST which is 
%  a model specific tabular mechanism for the model suh. 
% ----------------------------------------------------------- %
% ���f��suh�A���J�j�Y��gST �̃��b�Z�[�W���: 2 person�A �\�`��
% See Suh(1996), p.113.
% added: 29 Oct 2005.

message_profile_0(gST,Suh,[J1:X,J2:Y],[J1,J2]):-
   scc(Suh),
   two_person([J1,J2]),
   member( X, [m(1),m(2),m(3),m(4)]),
   member( Y, [m(1),m(2),m(3),m(4)]).


% the message profiles for gD, the Danilov mechanism. 
% ----------------------------------------------------------- %
% gD �̃��b�Z�[�W��Ԃ�Alt�̕����W��
% any subset of outcomes, including [].

% modified: 31 Oct 2005. revise. agent index for message profile.

message_profile_0(gD,Scc,Msg,[J1,J2]):-
   scc(Scc),
   two_person([J1,J2]),
   Msg = [J1:(X1,Z1),J2:(X2,Z2)],
   subset_of_alternatives(X1,_),   member(Z1,[0,1]),
   subset_of_alternatives(X2,_),  member(Z2,[0,1]).


% message profiles for gDict, a simple dictatorial mechanism. 
% ----------------------------------------------------------- %

% gDict �̃��b�Z�[�W���: ��ֈďW��
% any outcomes, not including [].
% added: 22 Sep 2002.
% modified: 14-15 Mar 2005.  truthful-mode as well as of zero-integers.
% modified: 31 Oct 2005. revise. agent index for message profile.


message_profile_0(gDict,Scc,Msg,[J1,J2]):-
   scc(Scc),
   range(Scc,B),
   two_person([J1,J2]),
   Msg = [J1:X1,J2:X2],
   alternative(X1),
   alternative(X2),
   subset([X1,X2],B).

message_profile_0(gDict,Scc,Msg,Js):-
   scc(Scc),
   range(Scc,B),
   subset_of_agents(Js,N),N>2,
   bag0(Msg,B,N).



%%%%%%%%%%%%%%%%%
%  for 2 or more
%%%%%%%%%%%%%%%%%

% ----------------------------------------------------------- %
%  constructing message profile
%  for mechanisms gM, gMR, gMR2, and gMM
% ----------------------------------------------------------- %
% modified: 24 Aug 2002. it is useless now.
% modified: 29 Dec 2002. to include gMR, gMR2.
% modified: 30 Oct 2005. added gMM.
%  renamed message_profile_1/5 (was: messages/5).
%  added agent index for each message in the profile.
% modified: 9 Nov 2005. revise. message_profile_1/5 based integration.


message_profile(GF, Scc, Msg, Is):-
   game_forms( GF, _),
   \+ exception_for_message_profile( GF),
   message_profile_1( GF, Scc,Msg,Is,Is).

message_profile(GF, Scc, Msg, Is):-
   exception_for_message_profile( GF),
   message_profile_0( GF, Scc,Msg,Is).

exception_for_message_profile( GF):-
   member(GF, []).   % no exceptions

%% replicate (mimic) an earlier code than 9 Nov 2005: 
%% member(GF, [gDict, gST, gD, gTmr]). 

% the recursive construction. (permit partial pofile)

message_profile_1( _, Scc, [],[],Is):-
   scc( Scc),
   subset_of_agents( Is,_N),
   !.

message_profile_1(GF, Scc, [I:M|Msg],[I|Is],Agents):-
   message_profile_1(GF, Scc,Msg,Is,Agents),
   G=..[GF,_,Scc],
   message(G,Agents,I,M,true).



% canonical message for mechanism gM
% ----------------------------------------------------------- %
% modified: 10 Nov 2002. bugfix. The condition in the line [*].
% NOTE: It was assumed that in seminal paper Maskin(1977).


maskin_msg(gM(_,F),Is,I,(Rs,A,Z),Consistency):-
   environment([Is,_Ss,_As],[N,_K,_L],_Rks),
   % subset_of_agents(Is,N),
   member(I,Is),
   scc(F),
   (
    Consistency = true
    ->
     (
      state(S),
      prefer_profile(Is,S,Rs)
      % scc(F,S,V),member(A,V)  % [*] 
     )
    ;  prefer_profile(Is,Rs)
   ),
   alternative(A),
   asc_nnseq(Aseq,N),
   member(Z,Aseq).


% gMM : the cyclic announcement of strategies
% reporting clockwise neighbour preferences
% reduces the dimension of message space
% ----------------------------------------------------------- %
% See Saijo(1988).
% added: 30 Oct 2005. 

reduced_msg( gMM(_,F),Is,I,(Rs,A,Z)):-
   environment([Is,_Ss,_As],[N,_K,_L],_Rks),
   % subset_of_agents(Is,N),
   member(I,Is),
   scc(F),
   state(S),
   reduced_profile( I/Is, S, Rs),
   alternative(A),
   asc_nnseq(Aseq,N),
   member(Z,Aseq).

reduced_profile( I/Is, State, Rs):-
   prefer_profile_1( Is, State, Rs1),
   clockwise_neighbour( I, _, J, Is),
   member((I,R1),Rs1),
   member((J,R2),Rs1),
   Rs =[(I,R1),(J,R2)].

clockwise_neighbour( I, '<',J, Is):-
   append( _, [ I, J|_], Is).

clockwise_neighbour( I, '>', J, Is):-
   Is = [ J|_],
   last( I, Is).


% Moore-Repullo strategies for mechanism gMR and gMR2
% ----------------------------------------------------------- %


mr_msg(Is,F,J,M):-
   M=(R,A,B,Z),
   subset_of_agents(Is,N),
   member(J,Is),
   scc_defined_state(S,F),
   %  <-- if you restrict agent-set, shoudn't use "state(S)" instead.
   prefer_profile(Is,S,R),
   scc(F,S,V),
   alternative(A),member(A,V),
   alternative(B),
   asc_nnseq(Aseq,N),
   member(Z,Aseq).

mr2_msg([J1,J2],F,J,M2):-
   mr_msg([J1,J2],F,J,M),
   M=(R,A,B,Z),
   M2=(R,A,B,Z,Obj),
   member(Obj,[0,1]).  % Obj: the objection flag.


messages0(G,Is,I,Ms,(Con,Show)):-
   subset_of_agents(Is,_N),
   member(I,Is),
   member(Con,[true,_]), 
   member(Show,[yes,_]), 
   findall(M,message(G,_,I,M,Con),Ms),
   (Show = yes -> writeMessages(Ms,I);true).

writeMessages(Ms,I):-
   length(Ms,L),
   tab(10),write('There are '),
   write(L),write(' strategies for agent '),
   write(I),write('.'), nl,
   prompt(_,' Display those variables? (y/n) '),
   read(Y),
   (Y == 'y' -> true; fail).



% ----------------------------------------------------------- %
% truth-telling strategy
% ----------------------------------------------------------- %

% modified: 30 Dec 2002, 2 Jan 2003.
% modified: 7 Jan 2003. modified and reused this code in test_nash.
% modified: 14-15 Mar 2005. added check_truth_telling/4 but not used.
% modified: 30 Oct 2005. added. gMM.
% modified: 31 Oct 2005. revise. agent index for message profile.

check_truth_telling(truthful,Is, S,Msg):-
   subset_of_agents(Is,N),
   length(Msg,N),
   state(S), 
   prefer_profile(Is,S,R),
   forall(member(X,Msg),X=_J:(R,_,_)),
   nl, write('--> truth telling.').

check_truth_telling(TM,_,_,_):-
   sim_mode(TM),
   TM \= truthful.

% check_truth_telling/7 is used in message_profile_with_mode above.

check_truth_telling(_TMode,gDict,_Scc,_Is, _S,_M).

check_truth_telling(truthful,GF,Scc,Is, S,Msg):-
   member(GF,[gM,gMM,gMR,gMR2]),
   subset_of_agents(Is,N),
   length(Msg,N),
   state(S), 
   prefer_profile(Is,S,R),
   scc(Scc,S,V),
   %member(A,V),
   %alternative(A),
   forall(member(_:X,Msg),A^(X=(R,A,_),member(A,V))).
   %write('--> truth telling.').


check_truth_telling(truthful,gD,Scc,Is,_S,[_:(X1,0),_:(X2,0)]):-
   subset_of_agents(Is,2),
   unblocked_pair([X1,X2],Is,Scc).

check_truth_telling(M,GF,_,_,_,_):-
   member(GF,[gM,gMM,gMR,gMR2,gD]),
   sim_mode(M),
   M \= truthful.


%  Several testing tools for mechanisms locally
% ----------------------------------------------------------- %
% (the followings are currently not used.)

ctt(M,GF,Scc,Is, S,Msg):-
   check_truth_telling(M,GF,Scc,Is, S,Msg).


% modified: 24 Aug 2002. 4 Sep 2002.
ttm(gM,Scc,Msg,Is,S):-
   scc(Scc),
   subset_of_agents(Is,N),
   state(S),
   tt_gM_profile(Scc,Is,S,Msg),
   length(Msg,N).

% the following is questionable.
ttm(gD,Scc,Msg,[J1,J2],S):-
   scc(Scc),
   state(S),
   two_person([J1,J2]),
   Msg = [(X1,Z1),(X2,Z2)],
   subset_of_alternatives(X1,_), X1\=[],   member(Z1,[0,1]),
   subset_of_alternatives(X2,_), X2\=[],   member(Z2,[0,1]),
   \+is_blocked_by(X2,J1,[J1,J2],Scc),
   \+is_blocked_by(X1,J2,[J1,J2],Scc),!.



%%% a sole testing for the mechanism gM, N>=3.

test_gM(Scc,P,M,C,Is):-
   E = environment([Is,_Ss,_As],[N,_K,_L],_Rs),
   subset_of_agents(Is,N),
   E,
   message_profile(gM,Scc, M,Is),
   mechanism(gM(P,Scc),E,M,[C]).


%%% sole testings for the mechanism gD, N=2.

test_gD(Scc,Is,[P,C,M]):-
   E = environment([Is,_Ss,_As],[2,_K,_L],_Rs),
   E,
   message_profile(gD, Scc,M,Is),
   mechanism(gD(P,Scc),E,M,[C]).

test_gD(F,[I,J],[P,Out,C,[M1,M2],[Block1,Block2],[Ess1,Ess2]],MR):-
   E = environment([[I,J],_Ss,_As],[2,_K,_L],_Rs),
   E,
   M = [M1,M2],
   M = [(X1,_Z1),(X2,_Z2)],
   message_profile(gD, F,M,[I,J]),
   (is_blocked_by(X2,1,[I,J],F)->Block1=block;Block1=unblock),
   (is_blocked_by(X1,2,[I,J],F)->Block2=block;Block2=unblock),
   ess(F,1,X1,Ess1),ess(F,2,X2,Ess2),
   is_MR_elements(MR,[X2,X1],[I,J],F),
 %   wn([block_1_2,Block1,Block2,m,M]),
   (mechanism(gD(P,F),E,M,[C])->Out=gD_ok;Out=not_found).


%%% sole testings for the mechanism gMR.

test_gMR(Scc,Is,[P,C,M]):-
   E = environment([Is,_Ss,_As],[_N,_K,_L],_Rs),
   E,
   message_profile(gMR, Scc,M,Is),
   mechanism(gMR(P,Scc),E,M,[C]).

test_gMR2(Scc,Is,[P,C,M]):-
   E = environment([Is,_Ss,_As],[2,_K,_L],_Rs),
   E,
   message_profile(gMR2, Scc,M,Is),wn([new_message,M]),
   mechanism(gMR2(P,Scc),E,M,[C]).


% ----------------------------------------------------------- %
% message profiles which has fixed all-0-integer game 
% ----------------------------------------------------------- %
% modified: 27 Nov 2002. 
% modified: 14 Mar 2005. synonym. messages_with_zeros/4 (mtest_z0/4)
% modified: 30 Oct 2005. added gMM.
%  rename. message_profile_with_zeros/4 (<=messages_with_zeros/4)
% modified: 31 Oct 2005. revise. agent index for message profile.


message_profile_with_zeros(GF, Scc,Msg,Is):-
   message_profile(GF,Scc,Msg,Is),
   message_profile_with_zeros(GF, Scc,Msg,Is,Is).

message_profile_with_zeros(GF,Scc,[],[],Is):-
   mechanisms(Mxs),
   member(GF,Mxs),
   scc(Scc),
   subset_of_agents(Is,_N),!.

message_profile_with_zeros(GF, Scc,[M|Msg],[I|Is],Agents):-
   (member(GF,[gM,gMM]) -> M = I:(_,_,0); true),
   (member(GF,[gMR]) -> M = I:(_,_,_,0); true),
   (member(GF,[gMR2]) -> M = I:(_,_,_,0,_); true),
   (member(GF,[gD]) -> M = I:(_,0); true),
   message_profile_with_zeros(GF, Scc, Msg,Is,Agents),
   agent(I), \+member(I,Is).

% a part of earlier code. 

%message_profile_with_zeros(gD,F,Msg,Is):-
%   Msg = [(_X1,0),(_X2,0)],
%   message_profile(gD,F, Msg,Is).


% ----------------------------------------------------------- %
%  extended message space:
%  message_profile_with_mode/6
% ----------------------------------------------------------- %
% modified: 29-31 Oct 2005. added gST and gMM.
% modified: 9 Nov 2005. added gTmr.


% Mode-irrelevant mechanisms

message_profile_with_mode(Mode,S,GF,Scc,Msg,Is):-
   member(GF, [gST, gMM, gTmr]),
   sim_mode(MX),
   Mode=..[MX,0],
   state(S), 
   message_profile( GF,Scc,Msg,Is).

% Mode-relevant mechanisms

message_profile_with_mode(Mode,S,GF,Scc,Msg,Is):-
   \+ member(GF, [gST, gMM, gTmr]),
   sim_mode(MX),
   Mode=..[MX,0],
   message_profile_with_zeros(GF,Scc,Msg,Is),
   %check_truth_telling(MX, Is, S,Msg).
   check_truth_telling(MX,GF,Scc, Is, S,Msg).

% modified: 13 Nov 2005. correct. ( var(Z0)->.. <= Z0=\=0).


message_profile_with_mode(Mode,S,GF,Scc,Msg,Is):-
   \+ member(GF, [gST, gMM, gTmr]),
   sim_mode(MX),
   Mode=..[MX,Z0],
   (var( Z0)->true; Z0\=0),
   % Z0=\=0,
   message_profile(GF,Scc,Msg,Is),
   %check_truth_telling(MX, Is, S,Msg).
   check_truth_telling(MX,GF,Scc, Is, S,Msg).



% ----------------------------------------------------------- %
% setting the integer elements for profile 
% ----------------------------------------------------------- %
% a utility for extracting integer elements from message profile
% modified: 6 Sep 2002.
% modified: 12 Nov 2002.  
% modified: 29 Dec 2002. lpomeq/6

lpom(O,Msg,[GF,Scc,Is],Zs):-
   last_part_of_message_profile(O,Msg,[GF,Scc,Is],Is,Zs).

lpom(O,Msg,[GF,Scc,Is],I,Zk):-
   last_part_of_message_profile(O,Msg,[GF,Scc,Is],I,Zk).

% abolished: 15 Oct 2002
%last_part_of_message_profile(Msg,[GF,Scc,Is],Is,Zs):-
%   maplist(last_part_of_message_profile(Msg,[GF,Scc,Is]),Is,Zs).

% edited: 6 Sep 2002
last_part_of_message_profile(_,_,_,[],[]).
last_part_of_message_profile(O,Msg,[GF,Scc,Is],[J|Js],[Z|Zs]):-
   last_part_of_message_profile(O,Msg,[GF,Scc,Is],J,Z),
   last_part_of_message_profile(O,Msg,[GF,Scc,Is],Js,Zs).

% edited: 15 Oct 2002. 4 Dec 2002.
% modified: 5 Jan 2003.
% modified: 30 Oct 2005. added gMM. extended with agent index

last_part_of_message_profile(O,Msg,[GF,_Scc,Is],I,Zk):-
   %message_profile(GF,Scc,Msg,Is),
   subset_of_agents(Is,N),
   (O=set-> ( asc_nnseq(Aseq,N), member(Zk,Aseq));true),
   nth1(K,Is,I),%wn([K,I]),
   member([GF,M],
    [
     [gM,I:(_R,_X,Zk)],
     [gMM,I:(_R,_X,Zk)],
     [gD,I:(_X,Zk)],
     [gMR,I:(_R,_X,_Y,Zk)],
     [gMR2,I:(_R,_X,_Y,Zk,_)]
    ]
   ),
   nth1(K,Msg,M).

% moved from best_response. (29 Dec) 
deviate_lpom_set(Isz,Msg,Mz,[GF,Scc,Is]):-
   lpom(set,Msg,[GF,Scc,Is],Z1),
   lpom(set,Mz,[GF,Scc,Is],Z2),
   forall(member(K,Isz),
    (
     nth1(Nk,Is,K),
     nth1(Nk,Z1,Zk),
     nth1(Nk,Z2,Zk)
    )
   ).

% added: 29 Dec 2002.
lpomeq(GF,P,_Scc,_Is,Msg,Mz):-
   (
    (
     member(GF, [gMR,gMR2]),
     P = 1
    )
     ->
      (
       lpom(set,Msg,[GF,Scc,Is],Z),
       lpom(set,Mz,[GF,Scc,Is],Z)
      )
   ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@���J�j�Y���̐݌v(2)�F�Q�[���t�H�[��
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)13

% ----------------------------------------------------------- %
% 13. Designing mechanisms (2): The game forms
% ----------------------------------------------------------- %

% the mechanisms available.

%  mechanisms([gM,gMM,gMR,gMR2,gD,gDict,gST]).

mechanisms(M):-
    findall( GF, game_forms(GF,_), M).


% generic mechanism:
% mechanism/3, and mechanism/4
% ----------------------------------------------------------- %
% unified: 17 Aug, 2002
% modified: 3 Dec 2002. change the order of setup in the top.
% modified: 5 Dec 2002. abolish setup in mechanism /4.
% modified: 8 Jan 2003. extended to generate outputs if unbounded input arguments and to neglect if the fact mechanism /3 exists.
% modified: 13 Mar 2005. removed an execess mtest/4 from mechanism/3.
% modified: 14 Mar 2005. added restrict_on_forms/2 ro mechanism/4.
% modified: 29 Oct 2005. mechanism/1 redefined using game_forms/2.  
% modified: 30 Mar 2005. separate. if_unspecified/2 (corr. 14 Oct).
%  separate. suspend_rule_if_fact_exists/1.

% mechanism(
%    GameForm(rule,scc),
%   %Environments,
%    MessageSpace,
%    Outcomes
% ).

mechanism(G,M,C):-
   suspend_rule_if_fact_exists( mechanism/3),
   ask_user_if_not_specified_on(mechanism,G),
   G=..[_GF,_,Scc],
   ask_user_if_not_specified_on(scc,Scc),
   mechanism(G,_E,M,C).

mechanism(G,E,Msg,Z):-
   %check_setup(G,Scc,E),
   E =.. [environment,[Is,_,_],_,_],
   E, 
   G =.. [GF,P,Scc],
   if_unspecified( Msg,
      message_profile( GF, Scc,Msg,Is)
   ),
   restrict_on_forms( GF, P),
   game_form(G,E,Msg,Z),
   !.


%  restrictions on the access to rules 
% ----------------------------------------------------------- %
%  modified: 13 Nov 2005. revise. gMR2

restrict_on_forms(GF,P):-
   mechanisms(Mxs),
   member(GF,Mxs),
   (member(GF, [gM,gMR]) -> member(P,[1,2,3]);true),
  % As for gM, P=3 (integer-game) may be excluded for simplicity, 
  % This is not exact, but it never brings about NE. 
   (member(GF,[gD]) -> (member(P,[1,2,3]),N = 2);true),
  % gMR2 has the 5th and 6th rules of modulo(integer) game.
   (member(GF,[gMR2]) -> (member(P,[1,2,3,4,5,6]),N = 2);true).


%  if_unspecified/2 and
%  suspend_rule_if_fact_exists/1 :
%  do if unspecified / exists fact clause 
% ----------------------------------------------------------- %
% added: 30 Oct 2005.
%  (Both to be moved into common programs section)

if_unspecified( X, _):-
   \+ var(X),
   !.

if_unspecified(X, Goal):-
   var(X),
   Goal.

suspend_rule_if_fact_exists( Rule/Arity):-
   integer(Arity),
   length(Body,Arity),
   Fact=.. [Rule|Body],
   \+ clause( Fact,true),
   !.

lift_suspend(Rule/Arity):-
   integer(Arity),
   length(Body,Arity),
   Fact=.. [Rule|Body],
   forall(
     clause( Fact,true),
     retract( Fact:-true)
   ).

:-   dynamic test_suspend/1.

test_suspend( hello).
test_suspend(A):-
   R=test_suspend,
   suspend_rule_if_fact_exists( R/1),
   A= no_facts.
test_suspend(A):-
   R=test_suspend,
   lift_suspend( R/1),
   A= lift.

/*
?- test_suspend(I).

I = hello ;

I = lift ;

No
?- test_suspend(I).

I = no_facts ;

I = lift ;

No
?- 
*/



% check setup for mechanism
% ----------------------------------------------------------- %
% not used

check_setup(G,Scc,E):-
   scc(Scc),
   mechanisms(GFs),
   member(GF,GFs),
   game_forms(GF,Ps),
   member(P,Ps),
   G =.. [GF,P,Scc],
   subset_of_agents(Is,N),
   set_of_states(Ss),
   set_of_alternatives(As),
   E=environment([Is,Ss,As],[N,_K,_L],_Rs),
   E.

check_gD_outcomes(P,C,Scc,[M,M1],[Z,Z1],[B,B1]):-
   mechanism(gD(P,Scc),[_:(M,Z),_:(M1,Z1)],C),
   (is_blocked_by(M,1,[1,2],mr)->B=yes;B=no),
   (is_blocked_by(M1,2,[1,2],mr)->B1=yes;B1=no).

chk_gD_r2(C1,Scc,[M,M1],[Z,Z1],Jd):-
   check_gD_outcomes(gD,_P,C,Scc,[M,M1],[Z,Z1],Y),
   (
    member(Y,[[yes,yes],[no,no]])
     ->fail
     ;
      (
       (Y=[no,yes]->Jd=2;true),
       (Y=[yes,no]->Jd=1;true),
       wn([[(M,Z),(M1,Z1)],Y,C]),
       !,
       game_form(gD(2,Scc),_,[_:(M,Z),_:(M1,Z1)],C1)
      )
   ).


%  dictatorship   (almost same as maximal )
% ----------------------------------------------------------- %
% edited : 29 Aug 2002. separated from gD and roulette/3.
% modified: 7 Sep 2002. bugfix. gD with pre-verified messages.   

% dictatorship(J,S,X,D)
  % J: dictator
  % S: state
  % X: range of choice
  % D: choiced outcome


dictatorship(J,S,X,D):-
   agent(J),
   subset_of_alternatives(X,_),
   true_state(T),
   (state(T)
    -> S=T
    ; state(S),
   %wn(['warnig: state',S, 'is not the updated state.']),
    true
   ),
   maximal(D,X,[J,S,_RJ]).

% alternative version

dictatorship_0(J,S,X,C):-
   agent(J),
   subset_of_alternatives(X,_),
   member(C,X),
   preference(J,S,_W),
   subset_of_alternatives(X,_),
   \+ (
     member(Other,X),
     is_prefer_to(J,S,Other,C),
     \+ is_prefer_to(J,S,C,Other)
   ).


%  roulette :
%  game of modulo N to determine the dictator
% ----------------------------------------------------------- %
% added: Aug 2002.
% modified: 4 Sep 2002. separate from gD. 
% modified: 6 Sep 2002.


% for 2-person

roulette(Dictator,[Z1,Z2],[J1,J2]):-
   subset_of_agents([J1,J2],2),
   member(Z1,[0,1]),
   member(Z2,[0,1]),
   SumZ is Z1 +  Z2,
   K is SumZ mod 2 + 1,
   nth1(K,[J1,J2],Dictator).%wn(Dictator),read(Y),
   %wn([roulette,dict,Dictator]).


% for n-person

roulette(Dictator,Zs,Is):-
   subset_of_agents(Is,N),
   N >2,
   subset_of_agents(Is,N),
   asc_nnseq( Numbers, N),
   bag0(Zs,Numbers,N),
   sum(Zs,SumZ),%wn(SumZ),
   K is SumZ mod N + 1,%wn(K),
   nth1(K,Is,Dictator).


%%%%%%%%%%%%%%%%%%%%%%%%
%     Game  Forms      %
%%%%%%%%%%%%%%%%%%%%%%%%

% modified: 29-30 Sep 2001. gM: the canonical mechanism. A most earlier version only for 3 players.
% modified: 23-24 Jan 2002. gD: the Danilov mechanism for two-person linear domain.
% modified: 1-5 May 2002, Aug 2002. gMR2: the Moore-Repullo mechanism for two-person.
% modified: 30 Oct 2005. gST: a domain specific tabular mechanism for the model suh.
%   and gMM: the reduced mesages space for the canonical mechanism gM.
% modified: 9 Nov 2005. a domain specific tabular mechanism gTmr for the model mr.


/*  available game forms in this system */

game_forms(gDict,[_D]).
game_forms(gM,[1,2,3]).
game_forms(gMM,[1,2,3]). % added: 30 Oct 2005
game_forms(gMR,[1,2,3]).
game_forms(gD,[1,2,3]).
game_forms(gST,[_]).  % 29 Oct 2005.
game_forms(gTmr,[1,2,3,4]).  % 9 Nov 2005.
game_forms(gMR2,[1,2,3,4,5,6]).

/*  unused
game_forms(GF,Ps):-
   mechanisms(GFs),
   member(GF,GFs),
   setof(P,
    M^(
     G=..[GF,P,_Scc]
     clause(game_form(G,_,M,_),_),
    ),
   Ps).
*/


%%%%%  NOTE (9 Nov 2005): If you would like to add a new rule
%%%%%  please add one also to the default ranking of game forms  
%%%%%  stipulated in the domain model management tools section 17,
%%%%%  as well as  you can set the domain specific priority, for any
%%%%%  already available model, in the modelbase section. 
%%%%%  Here the current copy of one of the clauses from section 17.
%%%%%  Furthermore, you must entry your model for message_profile_with_mode/6
%%%%%  in mechansim section whether the model is truthful/integer-mode-relevant 
%%%%%  or not.

/*
ranked_default_of_game_forms( Is, N, GF):- 
   length(Is,N),
   member((N,GF),
    [
     (2,gD),(2,gMR2),(2,gST),(2, gTmr),
     (N1,gM),(N1,gMM),(N1,gMR),(N,gDict)
    ]
   ),
   (var(N1)->true ; N1 >2). 
*/


   %�@N�G�[�W�F���g�̏ꍇ
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %% the Mechanism part for N-person cases:  %%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% ----------------------------------------------------------- %
%   gDict, a very simple dictatorial mechanism. 
% ----------------------------------------------------------- %
% added: 22 Sep 2002.
% modified: 31 Oct 2005. utilized agent index. 

% the game form of gDict 


game_form(gDict(Dict,_Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[N,_,_],_),
   length(Is,N),
   length(Msg,N),
   member(Dict:C,Msg).


% ----------------------------------------------------------- %
%  canonical mechanism modified by using Ess of Lcc
% ----------------------------------------------------------- %
% The Maskin-Vind mechanism.
% reference: Maskin(1999,1985), Danilov(1992), Yamato(1992), Saijo(1988).

% the development of this code for mechanism gM:
% added: an earlier version only for 3 players has created 29-30 Sep 2001.  
% modified: Feb 2002,May 2002, and by using ess, Aug 2002.
% modified: 3 Sep 2002. Abolish the pattern match of the exceptional rule 3.
% modified: 10 Nov 2002. To use lcc instead of ess if empty.
% modified: 26 Nov 2002. Undo above irrelevant modification.
% modified: 10 Dec 2002. Correct the check for in-scc on agreed outcome and the position 
% of cut in P=1,2. This error might have occurred during above modifications.
% modified: 29 Dec 2002.  A bug in the third gameform that allows multiple application 
% for the same message profile has fixed.
% modified: 30-31 Oct 2005.  revise. utilize agent index in Msgs. removal of nth1/3 and counter/3.

% (Maskin-Vind's canonical mechanism)
% the game forms and outcome function of the Maskin mechanism
%�@�@�@���i�i�����A�����Az���j�����m�j�������A
% �������A���͑I�D�v���t�B�[���A���͑�ֈāA���͐����Ƃ��A
% �܂����̑I�o�͈ȉ��̃��[���P�`�R�ɂ����������̂Ƃ���B


% the rule 1 of mechanism gM
% ----------------------------------------------------------- %
% the case of agreement.

% ���[���P�F�@����z���̕����������S����v�Ȃ�A����ł����B
%�i�����A�����j���i���A���j�A�������i���A���j ==>�@�����P.


% the case for N persons.

game_form(gM(1,Scc),E,Msg,[C]):-
   E = environment([Is,_Ss,_As],[N,_K,_L],_Rs),
   length(Msg,N),
   %=========================================
   % total agreement except for integers
   %=========================================
   setof((Rx,X),
    Z^J^member(J:(Rx,X,Z),Msg),
   [(R,C)]),
   %=========================================
   % SCC conforming for agreed outcome
   %=========================================
   prefer_profile(Is,S,R),
   scc(Scc,S,Obj),
   member(C,Obj),
   !.


% the case for N=3.(an earlier code)

/*
game_form(gM(1,Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[3,_,_],_),
   Msg = [1:(R,C,_Z1),2:(R,C,_Z2),3:(R,C,_Z3)],
   prefer_profile(Is,S,R),
   scc(Scc,S,Obj),
   member(C,Obj),
   !.
*/

% the rule 2 of gM. 
% ----------------------------------------------------------- %
% the part time dictatorship.

% modified: 27 Nov 2002. bugfix. rule 2.
% modified: 4 Dec 2002. revise & simplify. rule2 so that C2 in scc.
% modified: 10 Dec 2002. bugfix. removal of scc-range constraint.
%  revise. the pattern match by bagof and subtract.
% modified: 6,8 Jan 2003. to modify the above logic of pattern match. 
% modified: 31 Oct 2005.  totally revised by utilizing agent index
%  including removal of several nth1/3s and counter/3.

% ���[���Q�F�@�l���������Ĉ�v���ĕ\�������v���t�B�[�����ƈĂ�
% ��SCC���݂����Ƃ��A���ɂ����邊�̍D�݂�[��]�ł́A�����g���\��
% ����Ă��������ɏ���Ȃ��Ƃ��A ������; ����ȊO�͔C�ӂ̂������B

  % Agreement on, R2J, the preference profile and C, 
  % the social choice object except for, J, 
  % a single deviator who has a distinctive opinion.

%�i�����A�����j���i���A���j�A�������i���A���j ��i���m�|�o���p
%  ==>������ if ������lcc( ��, ��[��]);�@otherwise any i���m-{j}. 

% note:
% ������lcc( ��, ��[��]) <==>  ���i���A��[��]�j����.


game_form(gM(2,Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[N,_,_],_Rs),
   length(Msg,N),
   %=========================================
   % select a deviator
   %=========================================
   member(Deviator:Mdev,Msg),
   Mdev = (R1,C1,_Z1),
   %=========================================
   % agreement except for a single deviator
   %=========================================
   setof((R,X),
    Z^J^(
     member(J:(R,X,Z),Msg),
     J \= Deviator
    ),
   [(R2,C2)]),
   (R2,C2) \= (R1,C1),
   %=========================================
   % SCC conforming for agreed outcome
   %=========================================
   prefer_profile(Is,S,R2),
   scc(Scc,S,Obj),
   alternative(C2),
   member(C2,Obj),
   %=========================================
   % assuming agreed preference  
   % let deviator as a dictator if foolish
   %=========================================
   nth1(K,Is,Deviator),
   nth1(K,R2,R2J),
   preference(J,S,R2J),
   lcc([J,S,R2J],C2,Lcc),
   ess(Scc,J,Lcc,Ess),
   (member(C1,Ess)-> C = C1; C = C2).

/*

% a part of an earlier code.
 
game_form(gM(2,Scc),E,Msg,[C]):-%wn(rule2),
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),
  % extended for N >= 3. if N=3,
   (Msg = [(R1,C1,Z1),(R2,C2,Z2),(R2,C2,Z3)] -> (K is 1,true);
   Msg = [(R2,C2,Z1),(R1,C1,Z2),(R2,C2,Z3)] -> (K is 2,true);
   Msg = [(R2,C2,Z1),(R2,C2,Z2),(R1,C1,Z3)] -> (K is 3,true)),
   nth1(K,Is,J),
   (...)
   %range(Scc,Range),member(C,Range).
*/

% the rule 3 of gM
% ----------------------------------------------------------- %
% the modulo game.

% modified: 26 Nov 2002. a bug which occurred 9-12 Nov fixed.
% modified: 29 Dec 2002. to prohibit non-exclusive application.
% modified: 2,4 Jan 2003. bugfix. to re-activte roulette by using lpom.


% ���[���R�F�@��̂Q���[��������ɂ��Y�����Ȃ� ==> 
%�@�@�@�����̑��a�̂��̏�]�����������i�������A���j�{�P�B


game_form(gM(3,Scc),E,Msg,[C]):-%wn(rule3),
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),
   \+ game_form(gM(1,Scc),E,Msg,_),
   \+ game_form(gM(2,Scc),E,Msg,_),
   lpom(refer,Msg,[gM,Scc,Is],Zs),
   length(Zs,N),
   %=========================================
   % dictator is a winner in the modulo game
   %=========================================
   roulette(Jd,Zs,Is), %wn(stop(Jd,Msg)),   
   member((Jd,(_R,C,_Z)), Msg),
   !.

/*
% fragment of an earlier version.

   %setof((R,X,0),Z^member((R,X,Z),Msg),Mx),%wn([m,Mx]),read(y),
   %length(Mx,Lm), Lm > 2, %wn(rule(3,Msg)),
   %Msg = [(_,_C1,Z1),(_,_C2,Z2),(_,_C3,Z3)],
   %SumZ is (Z1 + Z2 + Z3),
   %K is SumZ mod 3 + 1,
   %Zs=[Z1,Z2,Z3],

*/

%%%% end of rules.



% ----------------------------------------------------------- %
% The reduced message mechanism for three or more agents 
% ----------------------------------------------------------- %
% reference: Saijo(1988).
% added: 30-31 Oct  2005.

% rule 1 of the mechanism gMM
% ----------------------------------------------------------- %

game_form( gMM(1,Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[N,_,_],_),
   length( Msg,N),
   % total agreement except for integers
   %=========================================
   game_form( gMM,agreement(Is,S,_),Msg,[C]),
   scc(Scc,S,Obj),
   alternative(C),
   member(C,Obj),
   !.

% subrule:
% agreement in coalition

game_form( gMM, agreement(Is,S,R),Msg,[C]):-
   setof( X, J^Rj^Z^member(J:(Rj,X,Z),Msg), [C]),
   findall( Rjk,
    (
     member( J, Is),
     member( J:(Rj,X,Z), Msg),
     member( (_K, Rjk), Rj)
    ),
   R0),
   sort( R0,R),
   prefer_profile(Is,S,R).



% rule 2 of gMM 
% ----------------------------------------------------------- %

game_form( gMM(2,Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),
   %=========================================
   % select a deviator and the neighbour
   %=========================================
   list_projection( Pjt,Msg,[Deviator:(R1,C1,_Z1)]),
   clockwise_neighbour(Neighbour,_,Deviator,Is),
   %=========================================
   % agreement except for a deviator
   %=========================================
   c_list_projection( Pjt,Msg,MsgC),
   c_list_projection( Pjt,Is,IsC),
   game_form( gMM,agreement(IsC,S,R2),MsgC,[C2]),
   member( Neighbour:(R2,C2,_), Msg),
   member( Deviator:Rd2, R2),
   member( Deviator:Rd1, R1),
   (Rd2,C2) \= (Rd1,C1),
   %=========================================
   % SCC conforming for agreed outcome
   %=========================================
   prefer_profile(Is,S,R2),
   scc(Scc,S,Obj),
   alternative(C2),
   member(C2,Obj),
   %=========================================
   % assuming agreed preference  
   % let deviator as a dictator if foolish
   %=========================================
   nth1(K,Is,Deviator),
   nth1(K,R2,R2J),
   preference(J,S,R2J),
   lcc([J,S,R2J],C2,Lcc),
   ess(Scc,J,Lcc,Ess),
   (member(C1,Ess)-> C = C1; C = C2).


% rule 3 of gMM
% ----------------------------------------------------------- %

game_form(gMM(3,Scc),E,Msg,[C]):-%wn(rule3),
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),
   \+ game_form(gMM(1,Scc),E,Msg,_),
   \+ game_form(gMM(2,Scc),E,Msg,_),
   lpom(refer,Msg,[gMM,Scc,Is],Zs),
   length(Zs,N),
   % dictator is a winner in the modulo game
   %=========================================
   roulette(Jd,Zs,Is), %wn(stop(Jd,Msg)),   
   member((Jd,(_R,C,_Z)), Msg),
   !.


/*
   %�@�Q�G�[�W�F���g�Ȃ����m�l�̏ꍇ
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %% the Mechanism for 2 (or more) person cases  %%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/

% ----------------------------------------------------------- %
%   gTmr the model specific tabular mechanism for Example 2 of 
%   Moore and Rpullo(1991) which implements the scc mr
% ----------------------------------------------------------- %
% added: 9 Nov 2005.
% See Moore and Repullo(1991), p.1095, footnote 19.

game_form( gTmr(1, mr),_,[_:m(1),_:m(1)],[c]).
game_form( gTmr(2, mr),_,[_:m(1),_:m(2)],[d]).
game_form( gTmr(3, mr),_,[_:m(2),_:m(1)],[z]).
game_form( gTmr(4, mr),_,[_:m(2),_:m(2)],[c]).


%  demo
% ----------------------------------------------------------- %
/*
?- mtest(gTmr,mr,M,[1,2]),
mechanism(gTmr(P,mr),M,C).

M = [1:m(1), 2:m(1)]
P = 1
C = [c] ;

M = [1:m(1), 2:m(2)]
P = 2
C = [d] ;

M = [1:m(2), 2:m(1)]
P = 3
C = [z] ;

M = [1:m(2), 2:m(2)]
P = 4
C = [c] ;

No
?- 
*/

% ----------------------------------------------------------- %
%   An automated mechanism design for gTmr
% ----------------------------------------------------------- %
% added: 9 Nov 2005.  (under construction)


% diagonal (agreement) cases.
/*
game_form( gTmr(1, mr),_,[_:m(X),_:m(X)],[C]):-
   (X=1 ->C=c ;true),  % for states s1, s3, s4
   (X=2 ->C=d ;true).  % for state s2

game_form( gTmr(2, mr),_,[_:m(X),_:m(Y)],[C]):-
   member( X, [1,2]),
   member( Y, [1,2]),
   Y \= X,
   game_form( gTmr(1, mr),_,[_:m(X),_:m(X)],[C1]),
   game_form( gTmr(1, mr),_,[_:m(Y),_:m(Y)],[C2]),
   member((X,S1),[(1,s1),(2,s2),(1,s3),(1,s4)]),
   member((Y,S2),[(1,s1),(2,s2),(1,s3),(1,s4)]),
   lcc( [1,S1,_], C1, L1), 
   lcc( [2,S2,_], C2, L2),
   intersection( L1, L2, L),
   subtract( L, [C1,C2], L0),
   member( C, L0),
   !.
*/

% ----------------------------------------------------------- %
%   gST the model specific tabular mechanism for the example
%  in Suh(1996) which strongly implements the scc suh 
% ----------------------------------------------------------- %
% added: 29 Oct 2005.
% modified: 31 Oct 2005.
% modified: 3 Nov 2005. correct. for rule 2, (3,2,c)=>(3,2,d).

% diagonal (agreement) cases.
 
game_form( gST((1), suh),_,[_:m(X),_:m(X)],[C]):-
   (X=1 ->C=a ;true),
   (X=2 ->C=b ;true),
   (X=3 ->C=c ;true),
   (X=4 ->C=e ;true).

% non-diagonal (disagreement) cases.

game_form( gST((2), suh),_,[_:m(X),_:m(Y)],[C]):-
   member( (X,Y,C),[(1,4,f),(4,1,f),(2,3,c),(3,2,d)]).

game_form( gST((3), suh),_,[_:m(X),_:m(Y)],[f]):-
   member( A, [1,4]),
   member( B, [2,3]),
   member( (X,Y), [(A,B),(B,A)]).

 % member( (X,Y),[(1,2),(1,3),(2,1),(2,4),(3,1),(3,4),(4,2,(4,3)]).

 

% ----------------------------------------------------------- %
% Danilov's mechanism gD
% assuming (linear) unristricted domain.
% ----------------------------------------------------------- %
% modified: 4 Sep 2002. the code for dictatorship has separated from roulette.
% modified: 7 Sep 2002. 
% modified: 31 Oct 2005. revised message space with agent indices.


%  case 1 of mechanism gD
% ----------------------------------------------------------- %
% Case 1: �P��X2���u���b�N�����A2��X1���u���b�N���Ȃ��Ƃ�
% ���[���b�g(modulo game)�ɂ����MR(F;X2,X1)��[]���猋�ʂ�I�ԁB


game_form(gD(1,Scc),E,Msg,[C]):-%wn([r1]),
   E = environment([[J1,J2],_Ss,_As],[2,_K,_L],_Rs),
   two_person([J1,J2]),
   message_profile(gD, Scc,Msg,[J1,J2]),
   Msg=[J1:(X1,Z1),J2:(X2,Z2)],
   \+is_blocked_by(X2,J1,[J1,J2],Scc),
   \+is_blocked_by(X1,J2,[J1,J2],Scc),!,
   %intersection(X1,X2,Y1),
   /*  caution: the MR set is of the pair [X2,X1]. */
   is_MR_elements(Y,[X2,X1],[J1,J2],Scc),%wn([mr,Y]),
   roulette(Jd,[Z1,Z2],[J1,J2]),%wn([dict,Jd]),
   member(C,Y),%wn([member,C]),
   dictatorship(Jd,_S,Y,C).

%  case 2 of gD
% ----------------------------------------------------------- %

% Case 2:�@i��Xj���u���b�N���Aj��Xi���u���b�N���Ȃ��Ƃ�
%�@Ess(F;i,Xi)��[]�Ɋ܂܂�錋�ʂɂ‚���j�̓ƍق�F�߂�B


game_form(gD(2,Scc),E,Msg,[C]):-%write([r2]),
   E = environment([[J1,J2],_Ss,_As],[2,_K,_L],_Rs),
   %E,
   two_person([J1,J2]),
   message_profile(gD, Scc,Msg,[J1,J2]),
   Msg=[J1:(X1,_),J2:(X2,_)],
   %wn([X1,X2,[J1,J2]]),
   (
    (
     is_blocked_by(X2,J1,[J1,J2],Scc),
     \+ is_blocked_by(X1,J2,[J1,J2],Scc),
     X0=X1, J0=J2
    )
    ;(
     \+is_blocked_by(X2,J1,[J1,J2],Scc),
     is_blocked_by(X1,J2,[J1,J2],Scc),
     X0=X2, J0=J1
    )
   ),
   !,
   ess(Scc,J0,X0,Ess0),%wn([J0,X0,Ess0]),
   member(C,Ess0),
   dictatorship(J0,_S,Ess0,C).
%, wn([dict,J0,scc,Scc,X0,ess,Ess0,[S,C]]).


%  case 3 of gD
% ----------------------------------------------------------- %

% Case 3:�@�P��X2���u���b�N���A2��X1���u���b�N����Ƃ�
%�@�@�@���[���b�g(modulo game)�ɂ����IM(F)���猋�ʂ�I�ԁB


game_form(gD(3,Scc),E,Msg,[C]):-%wn([r3]),
   E = environment([[J1,J2],_Ss,_As],[2,_K,_L],_Rs),
   two_person([J1,J2]),
   message_profile(gD, Scc,Msg,[J1,J2]),
   Msg=[J1:(X1,Z1),J2:(X2,Z2)],
   is_blocked_by(X2,J1,[J1,J2],Scc),
   is_blocked_by(X1,J2,[J1,J2],Scc),
   !,
   %wn(Msg),read(Y),
   range(Scc,Range),
   roulette(Jd,[Z1,Z2],[J1,J2]),
   member(C,Range),
   dictatorship(Jd,_S,Range,C).



% ----------------------------------------------------------- %
% the mechanisms of Moore-Repullo, Dutta-Sen 
% augmented by Sjostrom's algorithm
% ----------------------------------------------------------- %
% the game forms for the mechanism gMR,gMR2.
% reference: see the proof of Moore-Repullo(1990). 
% See also Yamato(1992) as for the cases N>=3.
% edited 9, 26 Aug 2002.modified: 2 Sep 2002.
% modified: 7 Nov 2005.  revise. extended and refined as gMR.

% The message of the i-th agent is (Rs[j],A[j],B[j],Z[j]),
% which is almost same as Dutta-Sen(1991) for N=2.   
% In Dutta-Sen mechanism "the objection flag" is used, instead of B[j].
% As noted in their footnote 3, the this additional element in
% the message space is needed only to device a concise proof 
% of the implementability theorem.

% Z, the integer part of Moore-Repullo's message is able to 
% interpreted as is decomposed into Bz * Zr, where Bz is 0 or 1,
% and we regard each nonzero Bz as an appealing objection by that agent.
% Zr is an integer that will be used if the integer game has invoked.

% ----------------------------------------------------------- %
% Moore-Repullo mechanism gMR for N>=3
% ----------------------------------------------------------- %
% modified: 6,8 Jan 2003. rule 2
% modified: 7 Nov 2005.  rule 2
% modified: 30 Dec 2002, 2,4,7 Jan 2003. rule 3


%  case 1 of the Moore-Repullo mechanism gMR for N>=3
% ----------------------------------------------------------- %

game_form(gMR(1,_Scc),E,Msg,[C]):-
   E = environment([_Is,_Ss,_As],[N,_K,_L],_Rs),
   length(Msg,N),N>2,
   setof((R,X),Y^Z^member((R,X,Y,Z),Msg),[(_,C)]),
   !.


%  case 2 of gMR  for N>=3
% ----------------------------------------------------------- %
% the case (2) in the MR's proof for N-person, N>=3. 


game_form(gMR(2,Scc),E,Msg,[C]):-
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),N>2,
   %=========================================
   % select a deviator
   %=========================================
   member(Deviator:Mdev,Msg),
   Mdev = (R1,A1,B1,_O1),
   %=========================================
   % agreement except for a single deviator
   %=========================================
   setof((R,X,Y),
    Z^J^(
     member(J:(R,X,Y,Z),Msg),
     J \= Deviator
    ),
   [(R2,A2,B2)]),
   (R2,A2,B2) \= (R1,A1,B1),
   %=========================================
   % SCC conforming for agreed outcome
   %=========================================
   preference(J,S,RJ),  % estimated state from agreed profile.
   prefer_profile(Is,S,R),
   scc(Scc,S,Obj),
   member(A,Obj),
   %!,
   %=========================================
   % assuming agreed preference  
   % let deviator as a dictator if foolish
   %=========================================
   set_C_star(Cx1,_,[[J,S,RJ],A,_Bx],Is,Scc),
   (member(B1,Cx1)-> C = B1; C = A).



%  case 3 of gMR   for N >= 3
% ----------------------------------------------------------- %
% the case (3) in the MR's proof for N-person, N>=3. 

game_form(gMR(3,Scc),E,Msg,[C]):-%wn(rule3),
   E = environment([Is,_,_],[N,_,_],_),
   length(Msg,N),
   \+ game_form(gMR(1,Scc),E,Msg,_),
   \+ game_form(gMR(2,Scc),E,Msg,_),
   lpom(refer,Msg,[gMR,Scc,Is],Zs),
   length(Zs,N),
   %=========================================
   % dictator is a winner in the modulo game
   %=========================================
   roulette(Jd,Zs,Is), %wn(stop(Jd,Msg)),   
   member((Jd,(_R,C,_Z)), Msg),
   !.



% ----------------------------------------------------------- %
% Moore-Repullo mechanism gMR2 for N=2
% ----------------------------------------------------------- %
% edited 9, 26 Aug 2002.
% modified: 3 Sep 2002.
% modified: 7 Nov 2005. decompose. rules into the parts.
%   revise. to use agent indices for the message space.
% modified: 12-3 Nov 2005. revised the subrules under the name of gDS. 

% the rule P=1
% ----------------------------------------------------------- %
% cases of agreement.

game_form(gMR2(1,_Scc),E,Msg,[C]):-
   E = environment([[J1,J2],_,_],[2,_,_],_),
   Msg=[J1:M1,J2:M2],
   game_form( gMR2, subrules, Rmr,on),
   game_form( Rmr, agree,[M1,M2],[C]),
   !.

% the rules P= 2 to  6
% ----------------------------------------------------------- %
% modified: 12-13 Nov 2005.  (17:56pm)

% cases of disagreement.

game_form(gMR2(P,Scc),E,Msg,[C]):-
   E = environment([[J1,J2],_,_],[2,_,_],_),
   Msg=[J1:M1,J2:M2],
   M1 = (R1,A1, BZO1),%   M1 = (R1,A1, B1,Z1,O1),
   M2 = (R2,A2, BZO2),%   M2 = (R2,A2, B2,Z2,O2), 
   [R1,A1] \= [R2,A2],
   % ------------------------ %
   member(P,[2,3,4,5,6]),
   game_form( gMR2, subrules, Rmr,on),
   game_form( Rmr, disagree(P,Scc,Msg),[BZO1,BZO2],C),
   !.


%  subrules for gMR2  
% ----------------------------------------------------------- %
% modified: 12-13 Nov 2005.  (22:12 pm)

%:- dynamic    game_form/4.

game_form( gMR2, subrules, gMR2, on).
game_form( gMR2, subrules, gDS2, off).

game_form( gMR2, subrules, switch, R->R1):-
   retract( game_form( gMR2, subrules, R, on)),
   retract( game_form( gMR2, subrules, R1, off)),
   assert( game_form( gMR2, subrules, R, off)),
   assert( game_form( gMR2, subrules, R1, on)).


%%%%%%%%%
% gMR2
%%%%%%%%%
% Objection flag, O in a message (_,_,_,O), 
% whereas Moore and Repullo(1990), p.1098, did not used it,
% we would like to use it on behalf of integers if Z1+Z2<=1.


game_form(gMR2,agree,[(R,C,_,_,_),(R,C,_,_,_)],[C]).

game_form(gMR2,disagree(2, Scc, Msg),[(_,_,0),(_,_,0)],CM):-
   alternative( CM),
   game_form(gMR2,cm_element(Scc,CM),Msg, _),
   !.

game_form(gMR2,disagree(3, Scc, Msg),[(B1,_,1),(_,_,0)],C):-
   alternative( CM),
   game_form(gMR2,cm_element(Scc,CM),Msg,[Cx1,_]),
   (member(B1,Cx1)-> C = B1; C = CM),
   !.

game_form(gMR2,disagree(4, Scc, Msg), [(_,_,0),(B2,_,1)],C):-
   alternative( CM),
   game_form(gMR2,cm_element(Scc,CM),Msg,[_,Cx2]),
   (member(B2,Cx2)-> C = B2; C = CM),
   !.

game_form(gMR2,disagree(P,_,_),[(B1,Z1,1),(B2,Z2,1)],C):-
   %member(Z1,[0,1]),
   %member(Z2,[0,1]),
   Sum is Z1 + Z2,
   Mod is Sum mod 2,
   member((Mod,P,C),[(0,5,B1),(1,6,B2)]).


% NOTE: We use a modulo game in the subrules P5 and P6
% code, because shouting games in the mechanism of Moore & Repullo(1990)
% (or Dutta and Sen(1991)) are not tractable computationally at least 
% by using naive enumerative program above.


%%%%%%%%%
% gDS2
%%%%%%%%%
% Objection flag is used but not wishful outcome, B in (_,_,B,_,_),
% expicitly in Dutta and Sen(1991), p.124.
% modified: 12-13 Nov 2005.  (19:59 pm)

game_form(gDS2,agree,[(R,C,_,_,0),(R,C,_,_,0)],[C]).

game_form(gDS2,disagree(2,Scc,Msg),[(_,_,0),(_,_,0)],CM):-
   alternative( CM),
   game_form(gDS2,cm_element(Scc,CM),Msg, _),
   !.

game_form(gDS2,disagree(3,Scc,Msg),[(B1,_,1),(_,_,0)],B1):-
   alternative( CM),
   game_form(gDS2,cm_element(Scc,CM),Msg,[Cx1,_]),
   member(B1,Cx1).

game_form(gDS2,disagree(4,Scc,Msg), [(_,_,0),(B2,_,1)],B2):-
   alternative( CM),
   game_form(gDS2,cm_element(Scc,CM),Msg,[_,Cx2]),
   member(B2,Cx2).

game_form(gDS2,disagree(P,Scc,M),[(B1,Z1,1),(B2,Z2,1)],C):-
   game_form(gMR2,disagree(P,Scc,M),[(B1,Z1,1),(B2,Z2,1)],C).


% NOTE: A parttime dictator of the rule 3 or 4 must choose his/her 
% favorite outcome from attainable set under opponent`s  insisted 
% pair of preference and alternative.
% See a usage of select_common_maximal_element_in_scc/3 below. 


%  computing the common maximal element
% ----------------------------------------------------------- %
% modified: 11-13 Nov 2005.  (13 Nov 20:15 pm)
% modified: 16 Nov 2005.  (01:55 am)

game_form( gMR2,cm_element(Scc,CM),[J1:M1,J2:M2],Cx):-
   game_form( gDS2,cm_element(Scc,CM),[J1:M1,J2:M2],Cx).

game_form( gDS2,cm_element(Scc,CM),[J1:M1,J2:M2],Cx):-
   M1 = (R1,A1,_),
   M2 = (R2,A2,_), 
  %prefer_profile([J1,J2],S1,R1),
  %prefer_profile([J1,J2],S2,R2),
   R1 = [_R11,R12], 
   R2 = [R21,_R22],
   Data=[[(J1,_S2,R21),(J2,_S1,R12)],[A2,A1],Cx],
   select_common_maximal_element_in_scc( CM, (Scc,_), Data).

game_form(gMR2,all_cm_element(Scc,SCM),[J1:M1,J2:M2],LCM):-
   game_form(gDS2,all_cm_element(Scc,SCM),[J1:M1,J2:M2],LCM).

game_form(gDS2,all_cm_element(Scc,SCM),[J1:M1,J2:M2],LCM):-
   findall((C,Cx1),
    (
     alternative( C),
     game_form(gDS2,cm_element(Scc,C),[J1:M1,J2:M2],Cx1)
    ),
   LCM0),
   sort(LCM0,LCM),
   findall( C, member( (C,_), LCM), SCM0),
   sort(SCM0,SCM).


% earlier code (replicated as a subrule)
% which did not check the outcome in scc.

/*

game_form(gMR2,cm_element(Scc,CM),[J1:M1,J2:M2],Cx):-
   M1 = (R1,A,_),
   M2 = (R2,B,_), 
   %prefer_profile([J1,J2],S1,R1),
   %prefer_profile([J1,J2],S2,R2),
   R1 = [_R11,R12], 
   R2 = [R21,_R22],
   AJSR = [ [A2,A1],[J1,J2],[S2,S1],[R21,R12] ],
   mre(CM,Scc,AJSR,Cx,_).

*/


%  test_nash_gMR2/3  
% ----------------------------------------------------------- %
% added: 12 Nov 2005.

test_m_gMR2((P,C),[S1,S2],Ms):-
   prefer_profile([1,2],S1,R1),
   prefer_profile([1,2],S2,R2),
   Ms=[1:M1,2:M2], M1=(R1,_),M2=(R2,_),
   mtest(gMR2,mr,Ms,[1,2]),
   mechanism(gMR2(P,mr),Ms,[C]).

test_nash_gMR2((P,C,S,Z,R),[S1,S2],Ms):-
   test_m_gMR2((P,C),[S1,S2],Ms),
   nash(Z,C,S,Ms,gMR2(P,mr),[1,2],R).


%  some rules to debug gMR2 
% ----------------------------------------------------------- %
% added: 14 Nov 2005.

debug_test_nash_1114((Mode,GF,[C,S],[P,F,H],Msg,Is),Result):-
   current_model_defaults([_,GF,F,Is]),
   Mode=full(0),H=h0,
   debug_msg_1114([C,S,P],Msg),
   test_nash(Mode,GF,[C,S],[P,F,H],Msg,Is,Result).

debug_msg_1114([C,S,P],Msg):-
   (S,C,P)=(s2,c,2),
   M = [[a, c, d, b, z], [b, d, c, a, z]],
   M1 = [[a, d, c, b, z], [b, c, d, a, z]],
   Msg=[1:(M,c,a,0,0),2:(M1,c,a,0,0)].

% The anomal equilibrium are no longer occurs after the bugfix 16 Nov 2005. 

debug_nash_1114([C,S,P],[Z,Msg,R]):-
   debug_msg_1114([C,S,P],Msg),
   nash(Z,C,S,Msg,gMR2(P,mr),[1,2],R).


/*

?- debug_msg_1114([C,S,P1],M),
coalitionally_deviated_message_profile(gMR2,mr,Group,[1,2],M,Mz),
mechanism(gMR2(P,mr),_,Mz,[d]).

C = c
S = s2
P1 = 2
M = [1: ([[a, c, d, b, z], [b, d, c, a|...]], c, a, 0, 0), 2: ([[a, d, c, b|...], [b, c, d|...]], c, a, 0, 0)]
Group = [1, 2]
Mz = [1: ([[a, d, c, b, z], [b, d, c, a|...]], d, a, 0, 0), 2: ([[a, c, d, b|...], [b, c, d|...]], c, a, 0, 0)]
P = 2 ;

C = c
S = s2
P1 = 2
M = [1: ([[a, c, d, b, z], [b, d, c, a|...]], c, a, 0, 0), 2: ([[a, d, c, b|...], [b, c, d|...]], c, a, 0, 0)]
Group = [1, 2]
Mz = [1: ([[a, d, c, b, z], [b, d, c, a|...]], d, a, 0, 1), 2: ([[a, c, d, b|...], [b, c, d|...]], c, a, 0, 0)]
P = 3 

Yes
?- debug_msg_1114([C,S,P1],M),
coalitionally_deviated_message_profile(gMR2,mr,[Deviant],[1,2],M,Mz),
mechanism(gMR2(P,mr),_,Mz,[d]).

No
?- 

*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  recording process of bugfix 
%  (12-16 Nov 2005)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Dealing with a known problem of earlier versions (see below).
%  My code for Condition mu(iv) was wrong.

%  I must apologize to the readers/users for long time to fix it. 


% demo ( a bug in earlier versions than impl12)
% ----------------------------------------------------------- %
% A case below for model mr (scc:mr, preference domain:mr) 
% shows a bug in earlier versions of this system,
% because mr conforms the condition mu 2, and also my privious code. 

% (Whereas a tabular mechanism gTmr can implement mr and  
% mr1 such that for s2, mr1(s2)=[c,d], instead of mr(s2)=[d]).

% My code of the second rule of gMR2 has been wrong.
% mre/5 does not always the selected outcome in the scc.

% See also section 10 for that condition.

/*
?- prefer_profile([1,2],s3,M),
prefer_profile([1,2],s4,M1),
Ms=[1:(M,c,a,0,0),2:(M1,c,a,0,0)],   % for new version impl13b.pl 
%Ms=[(M,c,a,0,0),(M1,c,a,0,0)],   % for earlier versions
nash(c,s2,Ms,gMR2(2,mr),h0,_,[1,2],yes).


For state s2, outcome c  [out, mr], rule 2  
and message profile: 
 1: ([[a, c, d, b, z], [b, d, c, a, z]], c, a, 0, 0)
 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, z],Lcc=[b, c, z] 
 
 agents=[2],Pzs=[1, 2, 4],Czs=[a, c, z],Lcc=[a, c, z] 
 
best response groups:
[[1], [2]]

This action profile is a  Nash equilibrium.

M = [[a, c, d, b, z], [b, d, c, a, z]]
M1 = [[a, d, c, b, z], [b, c, d, a, z]]
Ms = [1: ([[a, c, d, b, z], [b, d, c, a|...]], c, a, 0, 0), 2: ([[a, d, c, b|...], [b, c, d|...]], c, a, 0, 0)] 

Yes
?-

*/

%%%%%%%%%%%%%%%%%%%%
% The resolution
%%%%%%%%%%%%%%%%%%%%


% demo (16 Nov 2005 02:10 pm)
% ----------------------------------------------------------- %
/*
?- ch_debug_mju(iv,A).

A = no->yes 

Yes
?- debug_msg_1114(CSP,[M,M1]),
 game_form(gMR2,cm_element(mr,D),[M,M1],Cx).
    [scc_pair, [1, s4, c], [2, s3, c]]
     [mr:c, in_C1xC2:[c, z]]
      [for state:s1, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, c, d, z], [a, c, d, z])]
in_scc(c)
      [for state:s2, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, c, z], [a, c, z])]
     [mr:z, in_C1xC2:[c, z]]
      [for state:s1, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, z], [a, z])]
vacuous(z)
      [for state:s2, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, z], [a, z])]
vacuous(z)
      [for state:s3, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, z], [a, z])]
vacuous(z)
      [for state:s4, Cx pair: ([b, c, z], [a, c, z])]
      [Lcc pair: ([b, z], [a, z])]
vacuous(z)

CSP = [c, s2, 2]
M = 1: ([[a, c, d, b, z], [b, d, c, a, z]], c, a, 0, 0)
M1 = 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)
D = z
Cx = [[b, c, z], [a, c, z]] ;

No
?- ch_debug_mju(cme,A).

A = no->yes 

?- ch_debug_mju(iv,A).

A = yes->no 

Yes
?- debug_msg_1114(CSP,[M,M1]),
 game_form(gMR2,cm_element(mr,D),[M,M1],Cx).

CSP = [c, s2, 2]
M = 1: ([[a, c, d, b, z], [b, d, c, a, z]], c, a, 0, 0)
M1 = 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)
D = c
Cx = [[b, c, z], [a, c, z]] ;

CSP = [c, s2, 2]
M = 1: ([[a, c, d, b, z], [b, d, c, a, z]], c, a, 0, 0)
M1 = 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)
D = z
Cx = [[b, c, z], [a, c, z]] ;

No
?- test_nash_gMR2((2,c,s2,Z,R),[s3,s4],[1:(M,c,a,0,0),2:(M1,c,a,0,0)]).

No
?- test_m_gMR2((P,c),[s3,s4],[M,M1]).

P = 3
M = 1: ([[a, c, d, b, z], [b, d, c, a, z]], c, c, 0, 1)
M1 = 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0) 

Yes
?- 
*/


%%%%%%%%%
% memo
%%%%%%%%%

% Before resolved as above, I had revised the rules for gMR2 
% so that the user of mechanism gMR2 can select which subrules 
% of Moore and Repullo or of Dutta and Sen.
% 13 Nov 2005. 22:18pm
% modified: 15 Nov 2005. 02:25am

/*

?- game_form( gMR2,subrules,Rule,on).

Rule = gMR2 

Yes
?- game_form( gMR2,subrules,switch,Rule).

Rule = gMR2->gDS2 

Yes
 
% Another issue. (14 Nov 2005  01:18 am)
% The order of generating messages is critical, especially
% for the computational efficiency of test_impl.
% After a revision of test_nash/7 with a priority based generate and check rule,
% I met an another problem (also a bug) as follows.
% This trouble has already fixed.
 
?- test_nash(full(0),gMR2,[c,s2],[P,mr,h0],[M,M1],[1,2],Result).

No
?- 
*/

% Yet another.

%  In a stage of bugfix, I revised select_common_maximal_element_in_scc 
%  (instead of mre) and the rules of gMR2, so it truthfully implements mr.
%  However, the following results occurred.

% Answer to above quiz:
%  The rule 6 has been invalidated. correct `restrict_on_forms/2.'

/*

% an output of test_impl (13 Nov 2005) ==>

checking the off-SCC patterns:
[s1, a][s1, b][s1, d][s1, z][s2, a][s2, b][s2, c][s2, z][s3, a][s3, b][s3, d][s3, z][s4, a][s4, b][s4, d][s4, z]

For state s2,outcome=c  [out, mr], rule=1
message profile is
 1: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 1)
 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, z],Lcc=[b, c, z] 
 
 agents=[2],Pzs=[1, 3, 5],Czs=[a, c],Lcc=[a, c, z] 
 
best response groups:
[[1], [2]]

This action profile is a  Nash equilibrium.

For state s4,outcome=d  [out, mr], rule=1
message profile is
 1: ([[a, d, c, b, z], [b, d, c, a, z]], d, z, 0, 1)
 2: ([[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, d, z],Lcc=[b, c, d, z] 
 
 agents=[2],Pzs=[1, 3, 5],Czs=[d, z],Lcc=[a, d, z] 
 
best response groups:
[[1], [2]]

This action profile is a  Nash equilibrium.

%<===

?- br_result([yes,s2,c,[1],gMR2,P,mr,[1,2],[M,M1],Pz,Cz,Lc]),
br_result([yes,s2,c,[2],gMR2,P,mr,[1,2],[M,M1],Pz1,Cz1,Lc1]).

P = 1
M = 1: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 1)
M1 = 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)
Pz = [1, 2, 3]
Cz = [b, c, z]
Lc = [b, c, z]
Pz1 = [1, 3, 5]
Cz1 = [a, c]
Lc1 = [a, c, z] ;

No
?- Msg=[1:(M,c,a,0,0),2:(M1,c,a,0,0)],
test_nash_gMR2((1,c,s2,Z,R),[s4,s4],Msg).

For state s2, outcome c  [out, mr], rule 1  
and message profile: 
 1: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)
 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, z],Lcc=[b, c, z] 
 
 agents=[2],Pzs=[1, 2, 4],Czs=[a, c, d, z],Lcc=[a, c, z]  
best response groups:
[[1]]

Z = out
R = no
Msg = [1: ([[a, d, c, b, z], [b, c, d, a|...]], c, a, 0, 0), 2: ([[a, d, c, b|...], [b, c, d|...]], c, a, 0, 0)]
M = [[a, d, c, b, z], [b, c, d, a, z]]
M1 = [[a, d, c, b, z], [b, c, d, a, z]] 

Yes
?- Msg=[1:(M,c,a,0,1),2:(M1,c,a,0,0)],
test_nash_gMR2((1,c,s2,Z,R),[s4,s4],Msg).

For state s2, outcome c  [out, mr], rule 1  
and message profile: 
 1: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 1)
 2: ([[a, d, c, b, z], [b, c, d, a, z]], c, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, z],Lcc=[b, c, z] 
 
 agents=[2],Pzs=[1, 3, 5],Czs=[a, c],Lcc=[a, c, z] 
 
best response groups:
[[1], [2]]

This action profile is a  Nash equilibrium.

Z = out
R = yes
Msg = [1: ([[a, d, c, b, z], [b, c, d, a|...]], c, a, 0, 1), 2: ([[a, d, c, b|...], [b, c, d|...]], c, a, 0, 0)]
M = [[a, d, c, b, z], [b, c, d, a, z]]
M1 = [[a, d, c, b, z], [b, c, d, a, z]] 

Yes
?- Msg=[1:(R,c,a,0,0),2:M1],test_m_gMR2((P,d),[s4,S],Msg).

Msg = [1: ([[a, d, c, b, z], [b, c, d, a|...]], c, a, 0, 0), 2: ([[a, c, d, b|...], [b, c, d|...]], c, a, 0, 0)]
R = [[a, d, c, b, z], [b, c, d, a, z]]
M1 = [[a, c, d, b, z], [b, c, d, a, z]], c, a, 0, 0
P = 2
S = s1 

Yes
?- Msg=[1:(R,c,a,0,1),2:M1],test_m_gMR2((5,C),[s4,S],Msg).

Msg = [1: ([[a, d, c, b, z], [b, c, d, a|...]], c, a, 0, 1), 2: ([[a, c, d, b|...], [b, c, d|...]], c, a, 0, 1)]
R = [[a, d, c, b, z], [b, c, d, a, z]]
M1 = [[a, c, d, b, z], [b, c, d, a, z]], c, a, 0, 1
C = a
S = s1 

Yes
?- 

*/


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@�i�b�V���ύt
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)14

% ----------------------------------------------------------- %
% 14. Nash equilibrium
% ----------------------------------------------------------- %
% edited from: Sep--Oct 2001.

%  Nash equilibrium for N players 
%  using the mechanism gM, gMR (N>=3) or gD, gMR2 (N=2):

%  The best response for the agent is an action that his/her 
% lower contour set (LCC) includes the disposable outcomes 
% (Czs) by means of his/her unilateral choice under the 
% rules P of the given mechanism against a 
% fixed profile of actions other than the agent.

% ----------------------------------------------------------- %
%  Checking best response via Lcc
% ----------------------------------------------------------- %
% modified: 31 Aug 2002; 4 & 29 Dec 2002; 2-7 Jan 2003.
% modified: 14-15 Jan 2005
% modified: 1-2 Nov 2005 revised & decomposed best_response/0,5.
%  into the subsidiary rules as follows;
%  select_candidate_message_profile/2,
%  attainable_outcomes_by_deviators/6,
%  analyze_deviators_gain/3,
%  do_and_write_br/3,
%  so as to generalized into strong Nash strategies.



% for standard Nash strategies

best_response_1([Scc,E,Is],[GF,P,S,C,Msg],I,[Pzs,Czs,Lcc],Br):-
   best_response([Scc,E,Is],[GF,P,S,C,Msg],[I],[Pzs,Czs,Lcc],Br).

% generalized for strong Nash strategies

best_response([Scc,E,Is],[GF,P,S,C,Msg],Group,[Pzs,Czs,Lcc],Br):-
   coalition( Group),
   select_candidate_message_profile(Msg,[GF,P,Scc,Is,E]),
   G=..[GF,P,Scc],
   mechanism(G,Msg,[C]),  % mechanism/3 per se is not generative.
   findall((P1,Cz),
    (
     attainable_outcomes_by_deviation((GF,Scc,Is),Group,Msg,_,P1,Cz)
    ),
   PCzs),
   analyze_deviators_gain( PCzs,[Pzs,Czs,Lcc],[Group,S,C],Gain),
   (Gain =[]-> Br = yes; Br = no).


% a cui

best_response:-
   wn('query: best_response([Scc,E,Is],[GF,P,S,C,Msg],I,[Pzs,Czs,Lcc],Br)'),
   current_model_defaults([Domain,GF,Scc,Is]),
   wn(('assuming domain': Domain,'with Scc'=Scc,'GF'=GF,'Is'=Is)),
   do_and_write_br( [GF,Scc,Is],_,_),
   wn( ' more? (y) '),
   read(n).

do_and_write_br( [GF,Scc,Is],PSCM,[I,Data,Br]):-
   PSCM=[P,S,C,M],
   Target=best_response([Scc,_,Is],[GF|PSCM],I,Data,Br),
   Target,
   scc( Scc,S,A),
   nl, write( ('for state S'=S,'outcome C'=C,'rule P'=P, scc(S)=A)), 
   write_nash(I,Data,Br),
   forall(member(X,['messages:'|M]),(write(X),nl)).


% subsidiary rules of best_response/ 5
% ----------------------------------------------------------- %

select_candidate_message_profile(Msg,[GF,P,Scc,Is,E]):-
   E = environment([Is,_Ss,_As],[_N,_K,_L],_Rs),
   E,
   scc(Scc),
   (var(Msg)->mtest(GF,Scc,Msg,Is);true),
   game_forms(GF,Ps),
   member(P,Ps).

attainable_outcomes_by_deviation((GF,Scc,Is),[I],Msg,Mz,P1,Cz):-
   unilaterally_deviated_message_profile(GF,Scc,I,Is,Msg,Mz),
   member(I,Is),
   game_forms(GF,Ps),
   member(P1,Ps), 
   G1 =.. [GF,P1,Scc],
   mechanism(G1,Mz,[Cz]).

attainable_outcomes_by_deviation((GF,Scc,Is),Group,Msg,Mz,P1,Cz):-
   coalitionally_deviated_message_profile(GF,Scc,Group,Is,Msg,Mz),
   game_forms(GF,Ps),
   member(P1,Ps), 
   G1 =.. [GF,P1,Scc],
   mechanism(G1,Mz,[Cz]).

analyze_deviators_gain( PCzs1, [Pzs,Czs,Lcc],[Group,S,C],Gain):-
   sort(PCzs1,PCzs),
   %------------------------------
   % the set of applied rules 
   %------------------------------
   findall(P1,Cz^(member((P1,Cz),PCzs)),Pzs1),
   sort(Pzs1,Pzs),
   %------------------------------
   % the set of outcomes of the rules 
   %------------------------------
   findall(Cz,P1^(member((P1,Cz),PCzs)),Czs1),
   sort(Czs1,Czs),
   %------------------------------
   sure_gain_of_manipulation( Czs, Group, (S,C,Lcc),Gain).  

sure_gain_of_manipulation( Czs, [J], (S,C,Lcc),Gain):-
   mode_of_nash( standard, on),
   lcc([J,S,_R],C,Lcc),
   subtract( Czs,Lcc,Gain).

sure_gain_of_manipulation( Czs, Group, (S,C,Lcc),Gain):-
   mode_of_nash( strong, on),
   coalition( Group),
   set_of_agents(Is),
   lcc_for_coalition( Group / Is, (S,_R), C, Lcc),
   subtract( Czs,Lcc,Gain).

% write_best_response/2 (not used)

write_best_response(Br_Members0,Br_Results):-
    forall(member(I,Br_Members0),
       (member([I,Pzs,Czs,Lcc,Br],Br_Results),
       write_nash(I,[Pzs,Czs,Lcc],Br))),!.



% ----------------------------------------------------------- %
%  Message profile with a unilateral/ coalitional deviation
% ----------------------------------------------------------- %
% modified: 03 Sep, 10 Dec 2002.
% modified: 14 Mar 2005. renamed (was: mutate/6).
% modified: 31 Oct-1 Nov 2005. decompose deviate/6 into parts.
%   by means of agent indices reduced redundancy.
% modified: 1-2 Nov 2005. coalitionally_deviated_message_profile/6.


% synonyms

deviate(GF,Scc,J,Is,Msg,Mz,unilateral):-
   agent(J),
   unilaterally_deviated_message_profile(GF,Scc,J,Is,Msg,Mz).

deviate(GF,Scc,Group,Is,Msg,Mz,coalitional):-
   coalition( Group),
   coalitionlly_deviated_message_profile(GF,Scc,Group,Is,Msg,Mz).

% for standard NE

unilaterally_deviated_message_profile(GF,Scc,J,Is,Msg,Mz):-
   (var(Is)->subset_of_agents(Is,_);true),
   message_profile(GF, Scc,Msg,Is),
   message_from_single_deviator(Pjt,[GF,Scc,J,Is],Msg,MzJ),
   replace(Pjt,Mz,Msg,Mz),
   list_projection(Pjt,Mz,[J:MzJ]).

% for strong NE

coalitionally_deviated_message_profile(_,_,[],_,Msg,Msg).
coalitionally_deviated_message_profile(GF,Scc,[J|Group],Is,Msg,Mz):-
   coalitionally_deviated_message_profile(GF,Scc,Group,Is,Msg,Mz1),
   unilaterally_deviated_message_profile(GF,Scc,J,Is,Mz1,Mz).

message_from_single_deviator(Pjt,[GF,Scc,J,Is],Msg,MzJ):-
   list_projection(Pjt,Is,[J]),
   member((J:MJ),Msg),
   G=..[GF,_,Scc],
   message(G,Is,J,MzJ,true),
   MzJ \= MJ.


% another code for unilateral deviator J.  
%( currently this code not used anywhere else) 

deviate_via_mechanism(GF,Scc,J,Is,[P,P1],[C,C1],[M,M1]):-
   G=..[GF,P,Scc],
   %game_forms(GF,Ps),
   alternative(C),
   mechanism(G,M,[C]),
   member(J,Is),
   deviate(GF,Scc,J,Is,M,M1),
   G1=..[GF,P1,Scc],
   alternative(C1),
   mechanism(G1,M1,[C1]);
   (mechanism(G1,M1,non),C1=n).



% ----------------------------------------------------------- %
% The nash equilibrium :
% checking best response strategy profiles 
% ----------------------------------------------------------- %

% modified: 31 Aug; 6,20 Sep; 10 Nov 2002; 4, 30 Dec 2002.
% modified: 2 Jan 2003.  the arity Mode and so nash /9 has abolished.
% modified: 8 Jan 2003.  to succeed even if mechanism not specified.
% modified: 13-16 Mar 2005. restore. output stream which was abolished. 
%  decomposition. nash_outcome/7 <== nash/7. moved the position both
%  of an equation for G and of a game_forms/2 in nash_outcome/7
%  so that a (SCC,GF) pair would be specified before a mechanism/3.
% modified: 31 Oct 2005.  restore position of the equation for G.
% modified: 1-2 Nov 2005.  revised by select_candidate_message_profile/2.


% Def.(h-Nash equilibrium by Palfrey and Srivastava(2001))
%  An action profile m is an h-Nash equilibrium of a mechanism
%  (M,g) at s if H(g(m),s,h)R[i](s)H(g(m^[i],m-[i]),s,h)
%  for all i, m^[i] in M[i].

% Def.(Nash equilibrium) h-Nash equilibrium when h is identity.
% That is there is no individual agent who can benefited 
% from any unilateral deviation of the equilibrium message.
 
% Def.(Strong Nash equilibrium) No coalition of agents where 
% every member of the coalition can be benefited from the 
% coalitionally deviated message profile restricted to that coalition.


% nash_outcome/6 
% ----------------------------------------------------------- %
% set of best response strategy profiles

nash_outcome(Z,C,S,Msg,G,Is,BrMembers):-
   G=..[GF,P,Scc],
   select_candidate_message_profile(Msg,[GF,P,Scc,Is,E]),
   scc(Scc,S,X),
   alternative(C),
   (member(C,X)->Z=in;Z=out),
   mechanism(G,Msg,[C]),
   check_br_of_profile(Is,E,[GF,P,Scc,S,C,Msg]),
   collect_br_members([S,C,GF,P,Scc,Is,Msg],BrMembers).


% computing best response profiles
% ----------------------------------------------------------- %
% modified: 20 Sep 2002.
% modified:30 Dec 2002, 2 Jan 2002.
% modified: 13-16 Mar 2005.  revised as well as best_response/5.
% modified: 2 Nov 2005. revise with best_response_1/5,
%   permissible_group_for_nash/3, and mode_of_nash/2.


% (part 1) the ex ante analysis processor with memoing

check_br_of_profile(Is,E,[GF,P,Scc,S,C,Msg]):-
   BrRecord = [Br,S,C,Group,GF,P,Scc,Is,Msg,Pzs,Czs,Lcc],
   forall( permissible_group_for_nash(Group, Is, _),
     (
      clause( br_result(BrRecord), _)
       ->true
       ;(
         best_response(
           [Scc,E,Is],[GF,P,S,C,Msg],Group,[Pzs,Czs,Lcc],Br
         ),
         assert(br_result(BrRecord))
       )
     )
   ).

% (part 2) the ex post analysis processor

collect_br_members([S,C,GF,P,Scc,Is,Msg],BRM):-
   findall(Group,
    (
     BrRecord0 = [yes,S,C,Group,GF,P,Scc,Is,Msg,_Pzs,_Czs,_Lcc],
     br_result(BrRecord0)
    ),
   BRM0),
   sort( BRM0,BRM).


% permissible_group_for_nash/3
% ----------------------------------------------------------- %
% added: 2 Nov 2005

%  The subsidiary rule of check_br_of_profile/3 that select 
%  a subset of agents for which (individually/ coalitionaly)
%  rationality will be checked


permissible_group_for_nash( [I], Is, standard):-
   mode_of_nash( standard, on),
   member( I, Is).

permissible_group_for_nash( Group, Is, strong):-
   mode_of_nash( strong, on),
   coalition( Group, Is).

all_permissible_groups( All, Is, Nash):-
   findall( Group,
     permissible_group_for_nash( Group, Is, Nash),
   Bll),
   sort(Bll,All).

all_permissible_groups( All, Is):-
   mode_of_nash( Nash, on),
   all_permissible_groups( All, Is, Nash).

all_permissible_groups( All):-
   set_of_agents( Is),
   all_permissible_groups( All, Is).


%  the backgound parameter switcher to select
%  a concept of equilibrium strategy
% ----------------------------------------------------------- %
% added: 2 Nov 2005

:- dynamic  mode_of_nash/2.

% default mode.

mode_of_nash( standard, on).
mode_of_nash( strong, off).

% a cui for changing the mode

change_mode_of_nash( A->B):-
   mode_of_nash( B, off),
   retract( mode_of_nash( A, on)),
   retract( mode_of_nash( B, off)),
   assert( mode_of_nash( A, off)),
   assert( mode_of_nash( B, on)).



% the local testing 
% ----------------------------------------------------------- %
% modified: 7 Jan 2003.

br(IN,M,[S,O],G,J,Is,[Pzs,Czs,Lcc]):-
   (
    (scc(Scc,S,In_Scc),member(O,In_Scc))
    -> IN = in
    ; IN = out
   ),
   br_result([yes,S,O,J,GF,P,Scc,Is,M,Pzs,Czs,Lcc]),
   G=..[GF,P,Scc].


nec(NC):- setof(B,A^P^ne(A,B,[1,2,3],gM(P,f)),NC).

ne(M,[S,O],Is,G):-
   br(IN,M,[S,O],G,J,Is,_L0),
   forall(
     member(J,Is),
     L^br(IN,M,[S,O],G,J,Is,L)
   ).

%  another ex post analyisis and 
%  display tools for br results (ex post)
% ----------------------------------------------------------- %

% modified: 30 Dec 2002, 2 Jan 2002. 
% modified: 13-15 Mar 2005.
% modified: 2 Nov 2005. revision using all_permissible_groups/2.



display_br_results([S,C,GF,P,Scc,Is,Msg],BrMembers):-
   write_message(S,C,P,Msg,Scc),
   forall(
    (
     BrRecord0 = [Br,S,C,I,GF,P,Scc,Is,Msg,Pzs,Czs,Lcc],
     br_result(BrRecord0)
    ),
    write_nash(I,[Pzs,Czs,Lcc],Br)
   ),
   all_permissible_groups( All, Is),
   write_nash_equilibrium(BrMembers,All).



% ----------------------------------------------------------- %
% write_messages/5,6 and so on
% ----------------------------------------------------------- %
% modified: 7 Jan 2003. to be compatible with swi-prolog 5.
% modified: 13 Mar 2005. cut and fail if unbound input variables.
% modified: 14-16 Mar 2005. restore. output stream (abolish)
% modified: 31 Oct 2005. revise. layout with agent index for message profile.
% modified: 2 Nov 2005. revise. check the exsistence of impl_stream/3 by clause/2 .


write_message(S,C,P,Msg,Scc):-
    nl,
    write('For state '),write(S),
    write(', outcome '),write(C),
    ((scc(Scc,S,V),member(C,V))->Flag=in;Flag=out),
    tab(2),write([Flag,Scc]),
    write(', rule '),write(P),wn('  '),
    wn('and message profile: '),!,
    forall(member(M,Msg), (tab(1),wn(M))),
    write_stream_if_open( message, [S,C,P,Msg,Scc]).

write_message(Strm,S,C,P,Msg,Scc):-
  %  current_stream(_File,write,Strm),
  %  write(Strm,'Checking best response outcomes.'),
    nl(Strm),
    write(Strm,'For state '),write(Strm,S),
    write(Strm,',outcome='),write(Strm,C),
    ((scc(Scc,S,V),member(C,V))->Flag=in;Flag=out),
    tab(Strm,2),write(Strm,[Flag,Scc]),
    write(Strm,', rule='),write(Strm,P),nl(Strm),
    write(Strm,'message profile is'),nl(Strm),
    forall(member(M,Msg), 
      (tab(Strm,1),write(Strm,M),nl(Strm))
    ).

% write_nash/4,5
% ----------------------------------------------------------- %

write_nash(I,[Pzs,Czs,Lcc],Result):-
    nl,
    write(' agents='),write(I),
    write(',Pzs='),write(Pzs),
    write(',Czs='),write(Czs),
    write(',Lcc='),write(Lcc),
    ( Result=yes
      -> write(' 
 ')
      ;  write('  ')
    ),
    write_stream_if_open( nash, [I,[Pzs,Czs,Lcc],Result]),
    !.

write_nash(Strm, I,[Pzs,Czs,Lcc],Result):-   
  %  current_stream(_File,write,Strm),
    nl(Strm),
    write(Strm,' agents='),write(Strm,I),
    write(Strm,',Pzs='),write(Strm,Pzs),
    write(Strm,',Czs='),write(Strm,Czs),
    write(Strm,',Lcc='),write(Strm,Lcc),
    ( Result=yes -> write(Strm,' 
 ');
       write(Strm,'  ')),!.

% write_nash_equilibrium/2,3
% ----------------------------------------------------------- %
% modified: 2 Nov 2005. rearranged by using write_stream_if_open/2
% modified: 3 Nov 2005. bugfix. the cases of not best response.
%   decompose write_nash_equilibrium/2, and /3 into the subsidiary rules.


write_nash_equilibrium( Br_Members, All):-
   write_nash_equilibrium_step_1( Br_Members),
   write_nash_equilibrium_step_2( Br_Members, All).

write_nash_equilibrium_step_1( Br_Members):-
   nl,
   wn('best response groups:'),
   wn(Br_Members),
   write_stream_if_open( nash_equilibrium(1), [Br_Members]).

write_nash_equilibrium_step_2( Br_Members, All):-
   % all_permissible_groups(All),
   Br_Members = All,
   nl,
   write( 'This action profile is a '),
   mode_of_nash( Concept, on),
   (Concept=standard->true;write(Concept)),
   wn(' Nash equilibrium.'),
   write_stream_if_open( nash_equilibrium(2), [Br_Members,All]),
   !.

write_nash_equilibrium_step_2(_,_).

write_nash_equilibrium( Strm, Br_Members,All):-
   write_nash_equilibrium_step_1( Strm, Br_Members),
   write_nash_equilibrium_step_2( Strm, Br_Members, All).

write_nash_equilibrium_step_1( Strm, Br_Members):-
   nl(Strm),
   wn(Strm,'best response groups:'),
   wn(Strm,Br_Members).

write_nash_equilibrium_step_2( Strm, Br_Members, All):-
   Br_Members = All,
   nl( Strm),
   write(Strm, 'This action profile is a '),
   mode_of_nash( Concept, on),
   (Concept=standard->true;write(Strm, Concept)),
   wn( Strm, ' Nash equilibrium.'),
   !.

write_nash_equilibrium_step_2( _,_,_).

%  write_stream_if_open/2
% ----------------------------------------------------------- %
% added: 2 Nov 2005. separated from these above.

write_stream_if_open( message, [S,C,P,Msg,Scc]):-
   clause(impl_stream(_File,write,Strm),true),
   write_message(Strm,S,C,P,Msg,Scc),
   !.

write_stream_if_open( nash, [I,[Pzs,Czs,Lcc],Result]):-
   clause(impl_stream(_File,write,Strm),true),
   write_nash(Strm, I,[Pzs,Czs,Lcc],Result),
   !.

write_stream_if_open( nash_equilibrium(1), [Br_Members]):-
   clause(impl_stream(_File,write,Strm),true),
   write_nash_equilibrium_step_1(Strm,Br_Members),
   !.

write_stream_if_open( nash_equilibrium(2), [Br_Members,Is]):-
   clause(impl_stream(_File,write,Strm),true),
   write_nash_equilibrium_step_2(Strm,Br_Members,Is),
   !.


% surpress error message 

%write_stream_if_open( _, _):-
%   wn(' no output file stream has opened.').

write_stream_if_open( _, _).


% A tesings for Nash equilibria with gM under domain jp 
% ----------------------------------------------------------- %
% nec /1, ne /4, br /6 added: 25 Oct 2002.

% modified: 13-15 Mar 2005.
% modified: 14-15 Oct 2005.

test_ne(mes(B),alt(C),state(S),game(gM,f,P),nash(R)):- 
   %message_profile(gM,f,B,[1,2,3]),
   %mechanism(gM(P,f),B,[C]),
   nash(C,S,B,gM(P,f),h0,_,[1,2,3],R).

test_ne:-
   wn('test_ne(_,_,_,game(gM,f,_),_)'),
   %write('ok?(y/n) '),read(y),
   test_ne(mes(_B),alt(_C),state(_S),game(gM,f,_P),nash(_R)),
   /*
   wn('Now finding a Nash equilibrium. wait.'),
   tab(3),wn('mes(B):B='),
   forall(member(D,B),(tab(5),wn(D))),
   tab(3),write(alt(C)),
   tab(1),write(state(S)),
   tab(1),write(game(gM,f,P)),
   tab(1),wn(nash(R)),
   */
   write('find another?(y/n) '),
   (read(y)->fail;true).


% ----------------------------------------------------------- %
%  Script for testing Nash equilibria with mode options :
%  the zero-integers and the truthfulness  
% ----------------------------------------------------------- %


%  nash/7, /8 versions based on nash_outcome/6 
% ----------------------------------------------------------- %

% a version with display

nash(Z,C,S,Msg,G,Is,Result):-
   all_permissible_groups( All, Is),
   nash_outcome(Z,C,S,Msg,G,Is,BrMembers),
   ( BrMembers=All -> Result=yes ; Result=no),
   G =.. [GF,P,Scc],
   display_br_results([S,C,GF,P,Scc,Is,Msg],BrMembers).

% a version with the reversion function. 

nash(C,S,Msg,G,H,E,Is,Result):-
   E = environment([Is,_,_],[_N,_,_],_),
   E,
   reversions(V),
   member(H,V),
   nash(_,C,S,Msg,G,Is,Result).


% just give a suggestion

nash:-
   wn('nash(Z,C,S,Msg,G,Is,Result)'),
   wn('nash_outcome(Z,C,S,Msg,G,Is,BrMembers)').


%   demo (14 Nov 2005)
% ----------------------------------------------------------- %
/*

?- nash(d,s2,[M,M1],gMR2(P,mr),h0,_,[1,2],Result).

For state s2, outcome d  [in, mr], rule 1  
and message profile: 
 1: ([[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0)
 2: ([[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0)

 agents=[1],Pzs=[1, 2, 3],Czs=[b, c, d, z],Lcc=[b, c, d, z] 
 
 agents=[2],Pzs=[1, 2, 4],Czs=[a, c, d, z],Lcc=[a, c, d, z] 
 
best response groups:
[[1], [2]]

This action profile is a  Nash equilibrium.

M = 1: ([[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0)
M1 = 2: ([[a, d, c, b, z], [b, d, c, a, z]], d, a, 0, 0)
P = 1
Result = yes 

Yes
?- 

*/


% test_nash/7
% ----------------------------------------------------------- %
% added: 30 Dec 2002.
% modified: 31 Aug, xx Oct, 27 Nov, 29 Dec 2002--4 Jan 2003.
%  revise. test_nash /0 refers the predifined environment and  
%  the mechanism /3, as for Is, GF, and Scc.
% modified: 30 Dec 2002. add. check_truth_telling/?.
% modified: 1-8 Jan 2002. revise. mtest with a truth-telling option. 
% modified: 13 Mar 2005. bugfix. a problem when unbound. 
%  test_nash/0, a cui, moved into section 16.
% modified: 14-16 Mar 2005. removed display part into nash/7,8.
%  and truth-telling mode has incorporated into message_profile.
% modified: 14 Nov 2005.  spped up by priority_mode_for_test_nash/2
%  and skip_duplicate_messages/3.



sim_mode(Mode):-
   member(Mode,[full,truthful]).


test_nash(Mode,GF,[C,S],[P,Scc,H],Msg,Is,Result):-
   E = environment([Is,_,_],[_N,_,_],_),
   E,
   state(S),
   reversion(H,S,_,_),
   % reversion/4 in current version is the identity (h0). 
   scc(Scc),
   priority_mode_for_test_nash( Mode,Mode1),
   message_profile_with_mode( Mode1,S,GF,Scc, Msg,Is),
   skip_duplicate_messages( Mode,Mode1,[S,GF,Scc, Msg,Is]),
   G =.. [GF,P,Scc],
   nash(C,S,Msg,G,H,E,Is,Result).


test_nash(_Mode,GF,[C,S],[P,Scc,_H],null,_Is,null):-
   G =.. [GF,P,Scc],
   wn(['no message to yield',C,by,G,state,S]).


% added: 14 Nov 2005 (0:43am)
% modified: 14 Nov 2005 (9:00 am)


priority_mode_for_test_nash(Mode,Mode1):-
   member((Mode,Mode1),[(_,truthful(Z)),(full(Z),full(Z)),(part(Z),part(Z))]),
   member(Z,[0,_]).

skip_duplicate_messages(truthful(_),_,_):-!.
skip_duplicate_messages(_,truthful(_),_):-!.
skip_duplicate_messages( Mode, Mode,[S,GF,Scc, Msg,Is]):-
   member( Mode,[full(Z),part(Z)]),
   Z==0,
   \+ message_profile_with_mode(truthful(Z),S,GF,Scc, Msg,Is),
   !.
skip_duplicate_messages( Mode, Mode,S,GF,Scc, Msg,Is):-
   member( Mode,[full(Z),part(Z)]),
   lpom( 0,Msg,[GF,Scc,Is],Is,Zs),
   \+ sort(Zs,[0]),
   \+ message_profile_with_mode(truthful(Z),S,GF,Scc, Msg,Is).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%�@�i�b�V�����s�̎����X�N���v�g
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)15

% ----------------------------------------------------------- %
% 15. Tesing implementability in Nash equilibrium
% ----------------------------------------------------------- %
% edited from: Dec 2001.
% modified: 10 Nov 2002.
% modified: 1-2 Jan 2002.  time stamp, Mode. 
% modified: 15-16 Mar 2005.  separated into the steps. 
% modified: 7 Nov 2005.  revise. test_for_model/3.


% A SCC F is h-Nash implementable if 
% there exists a mechanism, (M,g), such that, for all s: 
% (1) For each a in F(s) there exists an h-Nash equilibrium, m in M, 
% such that H(g(m),s,h)=a.
% (2) If m in M is an h-Nash equilibrium at s, then H(g(m),s,h) in F(s).



% the simulation of Nash implementation with output file. 
% ----------------------------------------------------------- %

% test_impl/0  ---> moved into section 16


% test_impl/5

test_impl(GF,Scc,Is,Mode,Summary):-
   impl_step_0(_,[Scc,Is],Mode),
   impl_step_1(_,[GF,Scc,Is,Mode],Strm),
   impl_step_2(_,[GF,Scc,Is,Strm],Stat1),
   impl_step_3(_,[GF,Scc,Is,Mode,Strm],Stat2),
   impl_step_4(_,[Strm,Stat1,Stat2],Summary),
   impl_step_5(_).

impl_step_0('origin',[Scc,Is],Mode):-
   trim_stacks,
   Mode=..[Mod1,_],
   sim_mode(Mod1),
   (\+ scc(Scc,_,_)->(wn('no such Scc.'),fail)
    ;true
   ),
   subset_of_agents(Is,N),
   \+ member(N, [0,1]).

impl_step_1('outbreak',[GF,Scc,Is,Mode],Strm):-
   open_output_file(Strm,Scc),
   write(Strm,test_impl(GF,Scc,Is,Mode,'_summary')),
   nl(Strm),
   % to check the online / batch mode of mechanism/3.
   G=..[GF,_P,Scc],
   (\+ clause(mechanism(G,_,_),true)
    ->true
    ;(
      write(Strm,'mechanism/3 loaded from a file.'),
      nl(Strm)
    )
   ).

impl_step_2('charge',[GF,Scc,Is,Strm],Stat1):-
   write(Strm,'start ---------------------'),
   tstamp(Strm),
   init_summary(Scc),
   clear_br_results,
   display_scc(Strm,Scc,Is,GF),
   display_domain(Strm),
   test_for_model(Strm,Scc,Is),
   collect_statistics(Stat1).

impl_step_3('execution',[GF,Scc,Is,Mode,Strm],Stat2):-
   init_state,
   H = h0,
   check_on_scc(GF,Is,Scc,H,Mode,Strm),
   check_off_scc(GF,Is,Scc,H,Mode,Strm),
   write(Strm,'end <-----------------------'),
   tstamp(Strm),
   collect_statistics(Stat2).

impl_step_4('autopsy',[Strm,Stat1,Stat2],Summary):-
   init_state,
   write_summary(Strm,Summary),
   write_statistics(Strm,Stat1,Stat2),
   close_output_file(Strm).

impl_step_5('reassure'):-
   write('save br_results? (y/n) '),
   read(Save),
   (Save = y
    -> save_br_results(_BFile,_BStrm)
    ;true
   ),
   wn('end'),
   trim_stacks.

impl_step_5('reassure').
%  terminate safety even if it had failed.


true_state(init).

init_state:-
   abolish(true_state,1),
   assert(true_state(init)).

update_state(S):-
   state(S),
   abolish(true_state,1),
   assert(true_state(S)),
   wn(['--------  the state',S,' has updated ---------- ']).


% modified: 7 Jan 2003. to be compatible with swi-prolog 5.
open_output_file(Strm,Scc):-
   scc(Scc,_,_),
   wn('create output file for this Scc.'),
   concat('imp_',Scc,File1),
   concat(File1,'.txt',File),
   open(File,write,Strm),
   abolish(impl_stream,3),
   assert(impl_stream(File,write,Strm)).

impl_stream(dummy,write,_):- fail.

close_output_file(Strm):-
   close(Strm),
   abolish(impl_stream,3).


check_on_scc(GF,Is,F,H,Mode,Strm):-
   % check the outcomes on the domain of the scc.
   % By this part, you can verify the completeness of the mechanism.
   wn('checking the on-SCC patterns:'),
   wn(Strm,'checking the on-SCC patterns:'),
   findall((S,O),
     (
      state(S),alternative(O),
      scc(F,S,D),member(O,D)
     ),
   ONp),
   sort(ONp,ON),
   forall(member((S,O),ON),
    (write([S,O]),  write(Strm,[S,O]))
   ),
   nl,  nl(Strm),!,
   forall(member((S,O),ON),
    (
     (
      update_state(S),   % update_state should be done before mechanism.
      restrict_on_forms(GF,P),
      test_nash(Mode,GF,[O,S],[P,F,H],_Msg,Is,yes)
       ->Yes=nash_yes
       ;Yes=nash_no
     ),
     update_summary([S,O,Yes,scc_in])
    )
   ),
   nl,  nl(Strm),
   !.

check_off_scc(GF,Is,F,H,Mode,Strm):-
   % check the outcomes off the domain of the scc.
   % By this part, you can verify the soundness of the mechanism.
   wn('checking the off-SCC patterns:'),
   wn(Strm,'checking the off-SCC patterns:'),
   findall((S,O),
    D^(
     state(S),
     alternative(O),
     scc(F,S,D),
     \+ member(O,D)
    ),
   OFFp),
   sort(OFFp,OFF),
   forall(member((S,O),OFF),
    (
     write([S,O]),  write(Strm,[S,O])
    )
   ),
   nl,  nl(Strm),
   !,
   forall( member((S,O),OFF),
    (
     (
      update_state(S),   % update_state should be done before mechanism.
      restrict_on_forms(GF,P),
      test_nash(Mode,GF,[O,S],[P,F,H],_M,Is,yes)
       ->No=nash_yes
       ;No=nash_no
     ),
     update_summary([S,O,No,scc_out])
    )
   ),
   nl,  nl(Strm),
   !.


% modified: 14 Oct 2005. a irrelevant messege line has removed.
% modified: 2 Nov 2005. hear Scc if unspecified (by hear/2).
% modified: 7 Nov 2005. separate. standard_check_for_scc/1, /2.
%  disp_mr_ir/2 surpressed.


display_scc(Scc,Is,GF):-
   hear( scc, Scc), 
   nl,wn(' **** the model specification ****** '),
   nl,write('the members of this society: '),wn(Is),
   nl,write('game form: '),wn(GF),
   nl,wn('scc: '),
   forall(scc(Scc,S,D),
    (
     write(Scc),write('('),write(S),write(')'),
     write(' = '), write(D),tab(3)
    )
   ),
   nl,
   standard_check_for_scc([Scc,Is,GF]),
   !.

standard_check_for_scc([Scc,Is,GF]):-
   (
    monotone(Scc,Is)->wn('is Maskin-monotone.')
    ; wn('is not Maskin-monotone.')
   ),
   (
    ess_monotone(Scc,Is)->wn('is Essentially-monotone.')
    ; wn('is not Essentially-monotone.')
   ),
   (
    member(GF,[gD,gMR2,gDict])->true  %disp_mr_ir(Scc,Is)
    ;true
   ).


display_scc(Strm,Scc,Is,GF):-
   display_scc(Scc,Is,GF),
   current_stream(_File,write,Strm),
   nl(Strm),
   wn(Strm,' **** the model specification ****** '),
   nl(Strm),
   write(Strm,'game form: '),wn(Strm,GF),
   write(Strm,'members of society: '),
   write(Strm,Is),nl(Strm),
   nl(Strm),write(Strm,'Scc: '),nl(Strm),
   forall(scc(Scc,S,D),
    (
     write(Strm,Scc),write(Strm,'('),
     write(Strm,S),write(Strm,')'),
     write(Strm,' = '), write(Strm,D),tab(Strm,3)
    )
   ),
   nl(Strm),
   standard_check_for_scc(Strm, [Scc,Is,GF]),
   !.

standard_check_for_scc(Strm, [Scc,Is,GF]):-
   (
    monotone(Scc,Is)->wn(Strm,'is Maskin-monotone.')
    ; wn(Strm,'is not Maskin-monotone.')
   ),
   (
    ess_monotone(Scc,Is)->wn(Strm,'is Essentially-monotone.')
    ; wn(Strm,'is not Essentially-monotone.')
   ),
   (
    member(GF,[gD,gMR2,gDict])->true %disp_mr_ir(Strm,Scc,Is)
    ; true
   ).

disp_mr_ir(Scc,[I,J]):-
   (
    has_MR_property(Scc,[I,J])->wn('has Moore-Repullo property.')
    ; wn('does not have Moore-Repullo property.')
   ),
   (
    test_irat_n2(Scc,[I,J])->wn('is individually-rational.')
    ; wn('is not individually-rational.')
   ),
   wn(end),
   true.

disp_mr_ir(Strm,Scc,[I,J]):-
   (
    has_MR_property(Scc,[I,J])
    -> wn(Strm,'has Moore-Repullo property.')
    ; wn(Strm,'does not have Moore-Repullo property.')
   ),
   (
    test_irat_n2(Scc,[I,J])
    -> wn(Strm,'is individually-rational.')
    ; wn(Strm,'is not individually-rational.')
   ).


% display_domain is decribed in the preference part.
% modified: 7 Nov 2005. revise. tests_for_model/3 by adding 
%  a test_for_current_model/3 for standard current stream.

test_for_current_model(Scc,Is,G):-
   tests_for_scc(Scc,Is,G0),
   test_mju(Scc,Is,Gm),
   append(G0,Gm,G),
   nl,
   wn('other tests for this model:'),
   wn(G).

test_for_model(Strm,Scc,Is):-
   test_for_current_model(Scc,Is,G),
   (
    var(Strm)->true
    ;(
      nl(Strm),
      wn(Strm,'other tests for this model'),
      wn(Strm,G)
    )
  ).


init_summary(F):-
   abolish(summary,1),
   assert(summary([])),
   forall(
    (state(S),alternative(O),scc(F,S,D),member(O,D)),
    (
     update_summary([S,O,default,scc_in])
    )
   ),
   nl,
   forall(
    (state(S),alternative(O),scc(F,S,D),\+member(O,D)),
    (
     update_summary([S,O,default,scc_out])
    )
   ).

update_summary([S,O,Result,InScc]):-
   summary(Summary0),
   subtract(Summary0,[[S,O,default,InScc]],Summary2),
   append(Summary2,[[S,O,Result,InScc]],Summary3),
   sort(Summary3,Summary1), 
   retract(summary(Summary0)),
   assert(summary(Summary1)).

% modified: 10 Nov 2002. The stream to be unified with Strm.

write_summary(Strm,Summary):-
   summary(Summary),
   current_stream(_File,write,Strm),
   nl(Strm),
   wn('Summary Results'),
   wn(Strm,'Summary Result'),
   forall(member([S,O,Result,InScc],Summary),
    (
     write([S,O,Result,InScc]),nl,
     write(Strm,[S,O,Result,InScc]),nl(Strm)
    )
   ),
   nl,
   wn('completed.').

stat_keys(a,[cputime,inferences,heapused,
      localused,globalused,trailused]).

stat_keys(b,[atoms,functors,predicates,modules,codes]).

stat_keys(Keys):-
   stat_keys(a,KeysA),
   stat_keys(b,KeysB),
   append(KeysA,KeysB,Keys),!.

collect_statistics(Stat):-
   stat_keys(Keys),
   bagof(Value,
    Key^(
     member(Key,Keys),
     statistics(Key,Value)
    ),
   Stat),
   !.

write_statistics(Strm,Stat1,Stat2):-
  %  stat_keys(a,KeysA),
  %  stat_keys(b,KeysB),
   stat_keys(Keys),
   current_stream(_File,write,Strm),
   nl(Strm),
   wn(Strm,'Statistics'),
   forall(member(Value1,Stat1),
    (
     nth1(Nth,Stat1,Value1),
     nth1(Nth,Stat2,Value2),
     nth1(Nth,Keys,Key),
     write(Strm,Key),
     write(Strm,'= '),
     %(member(Key,KeysA)->(ValueD is Value2 - Value1;ValueD is 0)),
     ValueD is Value2 - Value1,
     wn(Strm,[ValueD, 'increased from',Value1])
    )
   ),
  !.


% ----------------------------------------------------------- %
%  save results of best response test to file 
% ----------------------------------------------------------- %
% br_result([Br,S,C,I,GF,P,Scc,Is,Msg,Pzs,Czs,Lcc])

% modified: 7 Jan 2003. to be compatible with swi-prolog 5.

br_result(dummy).

br_stream(dummy,_):- fail.

save_br_results(File,Strm):-
   br_result(BR),nth1(5,BR,GF),nth1(7,BR,Scc),
   wn('..saving to file :'),
   % modified: 27 Nov 2002.
   (br_stream(_File0,write,Strm)->close(Strm);true),
   % listing(br_result),
   open_br_file(Scc,GF,File,Strm),
   abolish(br_stream,2),
   assert(br_stream(File,Strm)),
   write_br_results(File,Strm).

open_br_file(Scc,GF,File,Strm):-
   scc(Scc,_,_),
   concat('br',Scc,FN1),
   concat(FN1,'_',FN2),
   concat(FN2,GF,FN3),
   concat(FN3,'.txt',File),
   open(File,write,Strm).

open_br_file(Scc,_GF,_File,_Strm):-
   \+ scc(Scc,_,_),
   wn('no such Scc.').

% modified: 10 Nov 2002.
% modified: 7 Jan 2003.

write_br_results(File,Strm):-
   current_stream(File,write,Strm),
   %wn(Strm,':- dynamic br_result/1.'),
   br_result(BR),
   %nth1(2,BR,S),nth1(3,BR,C),nth1(7,BR,Scc),
   %((scc(Scc,S,In_Scc),member(C,In_Scc))-> IN = in; IN = out),
   %write(Strm,br(IN,BR)),wn(Strm,'.'),
   write(Strm,br_result(BR)),wn(Strm,'.'),
   fail.

write_br_results(File,Strm):-
   current_stream(File,write,Strm),
   close(Strm),
   abolish(br_stream,2),
   wn('no more br_result in this DB. '),
   clear_br_results.

% modified: 1 Sep 2002.
clear_br_results:-
   write('clear br_result records?(y/n) '),
   read(U),
   (U=y 
    ->(
     abolish(br_result,1),
     assert(br_result(dummy))
    );
   true).




%%%%%  several tests for constructing nash equilibrium messege
% added: Aug 2002.
 
test_abn(M,D,P,[Pzs,Czs,Lcc,Br]):-
   D=[([x],0),([x,y],0)],
   test_nash(full,gD,[x,s2],[1,udd1,h0],D,[1,2],_F),
   best_response([udd1,_E,[1,2]],[gD,P,s2,x,D],2,[Pzs,Czs,Lcc],Br),
   deviate(gD,udd1,2,[1,2],D,M), 
   test_gD(udd1,[1,2],[2,y,M]).

test_abn1(F):-
   D=[([x,y],0),([x,y],0)],
   test_nash(full,gD,[y,s4],[1,umd5,h0],D,[1,2],F).



/*
% iteratively remove non best responses. edited: 8 Sep 2002.
% this code is pending.

irmv_nbr(GF,Scc,Is):-
   iterative_removal_of_nbr(GF,Scc,Is).
iterative_removal_of_nbr(GF,Scc,Is):-
   G=..[GF,_P,Scc],
   (mechanism(G,_,_)->true;(wn('no verified messages.'),fail)),
   forall(
    (
     mechanism(G,M,Z),wn([G,M,Z])
    ),
    (
     (
      member(C,Z),%wn([C]),
      alternative(C),
      state(S),%wn([S]),
      agent(I),%wn([I]),
      member(I,Is),
      best_response([Scc,_E,Is],[GF,P,S,C,M],I,Results,Br),
      wn([state(S),agent(I),br,Results,Br]),Br=no
     )
     ->
     (
      retract(mechanism(G,M,Z)),
      wn(this_message_has_removed_from_db)
     )
     ;true
    )
   ).

*/




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  ���[�U�C���^�t�F�[�X
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)16

% ----------------------------------------------------------- %
% 16. Command Line User Interfaces 
% ----------------------------------------------------------- %
% The `impl-specific cui's.

% added: 25 Oct 2002.
% modified: 10 Nov 2002.
% modified: 27 Nov 2002. 
%  as for wsid(3), to check mechanism/3 instead of environment/3.
% modified: 8 Jan 2003.
%  rename of wsid_history/1 and to declare dynamic.
% modified: 16-17 Mar 2005  wsid_read and several bugfixs.



% wsid/0, the Main Menu
% ----------------------------------------------------------- %

update_wsid(N):-
   retract(wsid_history(H)),
   assert(wsid_history([N|H])).

wsid_read(Y,B,G):- 
   read(Y),
   (Y=b->wsid(B);G).

wsid:-!,
   abolish(wsid_history/1),
   assert(wsid_history([0])),
   nl,
   wn('%   1. modeling for preference and mechanism.'),
   wn('%   2. modeling for scc.'),
   wn('%   3. simulate mechanism.'),
   wn('%   4. end this menu.'),
   write('input number>'),
   read(Y),
   (member(Y,[1,2,3,4])->wsid(Y);wsid).

wsid(0):-wsid.

wsid(4):-!,fail. 

wsid(3):-
   update_wsid(3),
   (
    clause(mechanism(_,_,_),_)->true
    ;(
      write('Please setup your domain and mechanism at first'),
      nl,
      wsid
    )
   ),
   write('----- simulating nash equilibrium ------'),
   nl,
   M=[[0,test_ne],[1,test_nash],[2,test_impl]],
   write('please selct a number from: '),
   nl,write(M),
   wsid_read(U,0,(member([U,A],M)->A;true)),
   !.

wsid(2):-
   update_wsid(2),
   write('----- auto generating and testing for sccs ------'),
   nl,
   write('Sorry, if you want to stop this, CTRL+C,a.'),
   nl,
   gen_test_scc(_),
   !.

wsid(1):-
   update_wsid(1),
   wn('%   1. see current preference domain.'),
   wn('%   2. setup preference domain and mechanism.'),
   wn('%   3. modeling new scc by self.'),
   wn('%   4. previous menu.'),
   write('input number>'),
   wsid_read(Y,0,
     (member(Y,[1,2,3,4])->wsid([1,Y]);wsid(1))
   ),
   !.

wsid([1,4]):- wsid,!. 

wsid([1,1]):-
   update_wsid([1,1]),
  %Goal=display_domain(user),
   Goal=display_current_model,
   Goal,
   wsid,
   !.

wsid([1,2]):-
   update_wsid([1,2]),
   domain_models(Ds),
   Goal=setup_domain(U),
   %hear(domain,D),
   write('available domain models. please select from the above.'),
   nl,write(Ds),nl,
   write('input domain name>'),
   wsid_read(U,1,
    (
     (member(U,Ds) -> Goal)
      ; (U = end -> true)
      ; (
        write('no such model.'),
        write(' please select from the list'),
        nl,wsid([1,2])
      )
    )
   ),
   wsid,
   !.

wsid([1,3]):-
   update_wsid([1,3]),
   write('Edit your file.'),
   nl,
   !,fail.

explain_me:-
   nl,
   wn('%   1. Basic Model for Preference and Scc '),
   nl,
   %write('read this section?(y/n) '),
   read(U1),
   (U1=y
    ->(
   wn('% This program simulates Nash Implementation Theory on Prolog machine.'),
   wn('% I have developed and tested on this program using SWI-Prolog version 1.9.0.'),
   wn('% The most basic data is preference/3, the model of rational preference orderings of each agent under each state, and scc/3, the model of social choice correspondences.'),
   wn('% Also, prefer_to/4 and its varsions represent the binary relations for pairwise comparison of outcomes.'),
   wn('% Several examples of preference domain model has cited from books in our reference list, including some vary small unrestricted domains, ud22, ud 23, ud33.'),
   wn('%  To see Sccs available, enter sccs(F). '),
   wn('%  Especifically, mr, the scc for N=2 which is an implementable example as insisted in Moore-Repullo(1990).')
    );
   true),
   nl,
   wn('%   2. Simulating Nash Implementation '),
   nl,
   write('read this section?(y/n) '),
   read(U2),
   (U2=y
    ->(
   wn('% Up to now, the available mechanisms in this system are gM(Maskin-Vind), gD(Daniov), gMR and gMR2(Moore-Repullo,Dutta-Sen) only. '),
   wn('% You have need to prepare the preference model in this file and reload it, and then to specify Scc before simulation below. '),
   wn('% To test Nash-implementability via simulation, type after prompt "?- " as follows. '),
   wn('%   test_impl(gM,F,_Is,full(_),O) and return key if 3-person case, '),
   wn('%   test_impl(gD,F,[I,J],full(_),O) and return key if 2-person case, '),
   wn('%  where you must specify F, the variable for SCC. '),
   tab(4),wn(' *** Tools for Simulation and Its Results  ****'),
   wn('%  The output file will created automatically, as for test_impl/5.'),
   wn('%  And you may print any goal by using results_to_file/3 in this source program. '),
   wn('%  If you want to output file the results for any goal, it may useful by using results_to_file/3, or tell_test/1 for any goal.')
    );
   true),
   nl,
   wn('%   3. Testing for Scc and Domain '),
   nl,
   write('read this section?(y/n) '),
   read(U3),
   (U3=y
    ->(
   wn('%  Insted of verifying Nash implementability by simulation,  you may test for the representative properties for sccs, such as monotonicity, nvp, unanimity, pareto optimality, essential monootnicity, individulal rationality, MR property, condition mju and so on, and for domain models such as condititon D. '),
   wn('%  To test the scc for its properties, use tests_for_scc/3.'),
   wn('%   tests_for_scc(F,[I,J],Properties) and return key if 2-person case, '),
   wn('%  To test the domain model for its properties, use tests_preference/5.'),
   wn('%   test_preference(Profs,F,[J,K],[G1,G2,G3,...],[NG3,NG4,...])  %')
    );
   true),
   nl,
   wn('%   4. Generating-and-Testing Automatically '),
   nl,
   write('read this section?(y/n) '),
   read(U4),
   (U4=y
    ->(
   wn('%  You can generate all sccs and enumeratively test, by gen_test_scc/3.'),
   wn('%  And you can generate sccs with any desirable set of properties on the fixed domain model, by gen_test_scc/3.'),
   wn('%  You can model or generate any possible, but unristricted up to now, preference domain by using gen_test_preference/6 with any desirable set of properties on the fixed scc of which you have need to specify it.')
    );
   true),
   nl,
   wn('%   Reference '),
   nl,
   write('display reference list?(y/n) '),
   read(U5),
   (U5=y
    ->reference_list
    ;
   true),
   !.



%  display the reference list 
% ----------------------------------------------------------- %
% edited: 30 Aug 2002.
% modified: 13 Mar 2005.
 
reference_list:-
   write('short or long? (s/l/v(very short))'),
   read(U),
   reference_list(U).

reference_list(U):-
   member(U,[s,l,v]),
   forall(
     ref(
       Sig,
       Author,
       Year,
       Title,
       JournalOrBook,
       VolNoPage,
       Commnent
     ),
    (
     Short = [Author,Year,Title],
     Add = [JournalOrBook,VolNoPage,Commnent],
     append(Short,Add,Long),
     ( U = v -> vshort_refer(Sig,Short)
      ; U = s -> short_refer(Sig,Short)
      ; long_refer(Sig,Long)
     )
    )
   ),
   nl,
   wn('% ------------------------------------------------------------ %'),
   wn('You may refer any reference specified by [Sig] ,the brief name,'),
   wn('which is appear in the left upper corner.'),
   wn('In order to redisplay the specific one, or to cite in your code, type: '),
   wn('  short_refer(Sig, X) or long_refer(Sig, X).'),nl.

vshort_refer(Sig,[Author,Year,Title]):-
   ref(Sig,Author,Year,Title,_J,_P,_C),
   write([Sig]),tab(3),
   write(Author),
   write('('),
   write(Year),
   wn('). ').

short_refer(Sig,[Author,Year,Title]):-
   ref(Sig,Author,Year,Title,_J,_P,_C),
   wn([Sig]),tab(3),
   write(Author),
   write('('),
   write(Year),
   write('). '),
   wn(Title).

long_refer(Sig,[A,Y,T,JournalOrBook,VolNoPage,Commnent]):-
   ref(Sig,A,Y,T,JournalOrBook,VolNoPage,Commnent),
   short_refer(Sig,[A,Y,T]),
   write(JournalOrBook),
   wn(VolNoPage),
   ((var(Commnent);Comment='')->true;wn(Comment)).


% ----------------------------------------------------------- %
%  CUI scripts for test_nash/7 (in section 15)
% ----------------------------------------------------------- %

% modified: 29,30 Dec 2002. 2-3,8 Jan 202.
% modified: 14 Mar 2005. allowed clause/2 for current_model_defaults/1 as a rule.
% modified: 15 Mar 2005. separated into the subordinate steps.


% to permit a change of the default model parms and env.
% a local utility read_alt, hear_sim_parms, and update_current_model_defaults has added.


test_nash:- test_nash(yes).

test_nash(R):-
   test_nash_step_1(_),
   test_nash_step_2(_,[Y,GF,Scc,Is]),
   test_nash_step_3(_,[Y,GF,Scc],[Mode,Zero]),
   test_nash_step_4(_,[GF,Scc,Is,Mode,Zero]),
   test_nash_step_5(_,[GF,Scc,Is,Mode,Zero],R).

test_nash_step_1('show the goal in general form'):-
   wn(' goal format: '),
   wn('  test_nash(Mode,GF,[C,S],[P,Scc,H],Msg,Is,Result)'),
   wn('-----------------------------------------------------').

test_nash_step_2('check model',[Y,GF,Scc,Is]):-
   clause(current_model_defaults(_),_)
   ->(current_model_defaults([_,GF,Scc,Is]),Y=yes)
   ;(
     write('The model has not yet built.'),
     hear(domain,D),
     setup_domain(D),
     nl,write(' Please retry test_nash again.'),
     Y=no
   ).

test_nash_step_3('check message space',[yes,GF,Scc],[Mode,Zero]):-
   G=..[GF,_,Scc],
   (
    clause(mechanism(G,_,_),true)
     ->(Mode=full,Zero=0)
     ;(Mode=truthful,Zero=0)
   ).

test_nash_step_4('suggest user a goal',[GF,Scc,Is,Mode,Zero]):-
   wn('I guess your goal may be ...'),
   tab(3),
   write('test_nash('),write(Mode),write('('),
   write(Zero),write('),'),
   write(GF),write(',[C,S],[P,'),
   write(Scc),write(', h0],Msg,'),
   write(Is),wn(', yes).'),
   wn(' -----------------------').

test_nash_step_5('conform user and execute',X,R):-
   test_nash_substep_5_1('conform user',[],U),
   test_nash_substep_5_2(_,[U|X],D,R),
   test_nash_substep_5_3('execute',D,R).


test_nash_substep_5_1('conform user',[],U):-
   wn(' do this? (y/n) '),
   read(U).

test_nash_substep_5_2('acknowledged as it is',[y|X],D,R):-
   X=[GF,Scc,Is,Mode,Zero],
   D= [Mode,Zero,GF,_C,_S,_P,Scc,Is,R],
   R=yes.

test_nash_substep_5_2('respecify model',[U|X],D1,Result):-
   U\=y,
   X=[GF,Scc,Is,Mode,Zero],
   _X1=[GF1,Scc1,Is1,Mode1,Zero1],
   D= [Mode,Zero,GF,_C,_S,_P,Scc,Is,_Result0],
   D1= [Mode1,Zero1,GF1,_C1,_S1,_P1,Scc1,Is1,Result],
   Op= [yes,yes,yes,yes,yes,yes,yes,yes,yes],
   hear_sim_parms(D,D1,Op),
   current_model_defaults([DN,_,_,_]),
   update_current_model_defaults([DN,GF1,Scc1,Is1]).

test_nash_substep_5_3('execute',D,Result):-
   D= [Mode,Zero,GF,C,S,P,Scc,Is,Result],
   Mode0=..[Mode,Zero],
   Goal=test_nash(Mode0,GF,[C,S],[P,Scc,h0],Msg,Is, Result),
   Goal,
   wn([mes,Msg,[C,S],yield,[rule,P,scc,Scc]]),
   do_and_update_goal(Goal).
 

do_and_update_goal(Goal):-
   Goal,
   abolish(last_goal,1),
   assert(last_goal(Goal)).

last_goal(non).



% ----------------------------------------------------------- %
%  CUI scripts for test_impl/0  
% ----------------------------------------------------------- %

% modified: 29,30 Dec 2002. 2-4,8 Jan 2003.
% modified: 14 Mar 2005. allowed clause/2 for current_model_defaults/1 as a rule.
% modified: 15-17 Mar 2005. separated into the subordinate steps.
% modified: 31 Oct 2005. bugfix. removed a do_and_update_goal/1 
%  duplicated  in test_impl_step_4/4.


test_impl:-
   test_impl_step_1(_check_model,[GF,Scc,Is]),
   test_impl_step_2(_check_mesages,[GF,Scc],[Mode,Zero]),
   test_impl_step_3(_conform_user,[GF,Scc,Is,Mode,Zero],[U,V0]),
   test_impl_step_4(_do_or_ask,[GF,Scc,Is,Mode,Zero],[U,V0],V),
   test_impl_step_5(_execute,V).

test_impl_step_1('check model',[GF,Scc,Is]):-
   clause(current_model_defaults(_),_)
   ->current_model_defaults([_DN,GF,Scc,Is])
   ;(
     write('The model has not yet built.'),
     hear(domain,D),
     setup_domain(D),
     nl,write(' Please retry test_nash again.'),
     fail
   ).

test_impl_step_2('check mesages',[GF,Scc],[Mode,Zero]):-
   G=..[GF,_,Scc],
   (clause(mechanism(G,_,_),true)
    -> (Mode=full, Zero=0)
    ; (Mode=truthful,Zero=0)
   ).

test_impl_step_3('conform user',[GF,Scc,Is,Mode,Zero],[U,V]):-
   wn(' goal format:'),
   wn('  test_impl(GF,Scc,Is,Mode,Summary)'),
   wn('----------------------------------------------'),
   Mode0=..[Mode,Zero],
   V=test_impl(GF,Scc,Is,Mode0,_Summary),
   write('I guess that your goal may be..'),nl,
   write( V),nl,
   write('go ahead ? (y/n) '),
   read(U).

test_impl_step_4('pass the goal',_,[y,V],V).

test_impl_step_4('reconstruct goal',Basis,[U,_],V1):-
   U \= y,
   Basis= [GF,Scc,Is,Mode,Zero],
   write('Please specify the model: '),
   (
     Defaults = [Mode,Zero,GF,_,_,_P,Scc,Is,_],
     Users = [Mode1,Zero1,GF1,_,_,_P1,Scc1,Is1,_],
     Choices = [yes,yes,yes,no,no,no,yes,yes,no],
     hear_sim_parms(Defaults,Users,Choices),
     Mode2=..[Mode1,Zero1],
     V1=test_impl(GF1,Scc1,Is1,Mode2,_Summary)
   ).

test_impl_step_5('execute after',V):-
   do_and_update_goal(V).


% User conform (for test_impl/0)
% ----------------------------------------------------------- %

hear_sim_parms(Defaults,Users,Choices):-
   Choices = [X1,X2,X3,X4,X5,X6,X7,X8,X9],
   Defaults = [Mode,Zero,GF,C,S,P,Scc,Is,Result],
   Users = [Mode1,Zero1,GF1,C1,S1,P1,Scc1,Is1,Result1],
   nl,
   write('(If goes as it is, type `default` instead.)'),
   nl,
   %--------------------------------------------------------
   (X1=yes->
    (
     write('truncate if not best response? (full/truthful)'),
     read_alt(Mode,Mode1,choice(Mode1,sim_mode(Mode1)))
    )
   ;true),
   (X2=yes->(write('all zero?(0/Var)'),read_alt(Zero,Zero1,[0,var(1)]));true),
   (X3=yes->(write('mechanism? '),mechanisms(GFs),read_alt(GF,GF1,GFs));true),
   (X4=yes->(write('outcome? '),set_of_alternatives(As),read_alt(C,C1,As));true),
   (X5=yes->(write('state? '),set_of_states(Ss),read_alt(S,S1,Ss));true),
   (X6=yes->(write('rule? '),game_forms(GF,Ps),read_alt(P,P1,Ps));true),
   (X7=yes->(write('scc? '),sccs(Sccs),read_alt(Scc,Scc1,Sccs));true),
   (X8=yes->(write('agents? '),read_alt(Is,Is1,choice(Is,subset_of_agents(Is,_))));true),
   (X9=yes->(write('nash? (yes/no/V) '),read_alt(Result,Result1,[yes,no,var(2)]));true),
   %--------------------------------------------------------
   write([Mode,Zero,GF,C,S,P,Scc,Is,Result]),nl,
   write([Mode1,Zero1,GF1,C1,S1,P1,Scc1,Is1,Result1]),
   nl.

% read_alt/3 for hear_sim_parms/3.

read_alt(Default,Y,choice(Y,X)):-
   read(User),
   % caution: read must  be separated from below.
   (
    (var(User), Y = Default)
    ;(User = default, Y = Default)
    ;(X, Y = User)
    ;(
      write('not regular input. please re-enter. '),
      read_alt(Default,Y,choice(Y,X))
    )
   ). 

read_alt(Default,Y,Menu):-
   read(User),
   % caution: read must  be separated from below.
   (
    (var(User), member(var(_),Menu))
    ;(User = default, Y = Default)
    ;(member(Y,Menu), Y = User)
    ;(
      write('please select from : '),
      write(Menu),
      read_alt(Default,Y,Menu)
    )
   ). 



% ----------------------------------------------------------- %
%  Rather general purpose CUI commands  
% ----------------------------------------------------------- %
% modified: 31 Oct 2005. separated from CUI for test_ipl.
%  added ask_user_which_or_permit_default/3.


% hear/2: User conforming on model objects
% ----------------------------------------------------------- %
% modified: 25 Oct 2002. 
% added hear/2 
% modified: 27 Nov 2002. do not hear if bound.
% modified: 31 Oct 2005. restrict above to the first prompt.


% hear(_,Hear):- \+var(Hear).

hear(domain,D):- \+ var(D), domain_models(Ds),member(D,Ds).
hear(domain,D):- var(D), write('domain? '), read(U),
   domain_models(Ds),
   (member(U,Ds)->D=U
    ;(
     write('no such domain prepared. please select from '),
     write(Ds),nl,
     hear(domain,D)
    )
   ).

hear(game_form,GF):- \+ var(GF), mechanisms(MC), member(GF,MC).
hear(game_form,GF):- var(GF), write('game_form? '),read(U),
   mechanisms(MC),
   (member(U,MC)->GF=U
    ;(
      write('no such mechanism. please select from '),
      write(MC),nl,
      hear(game_form,GF)
    )
   ).

hear(scc,Scc):- \+ var(Scc), scc(Scc).
hear(scc,Scc):- var(Scc), write('scc? '),read(U),
   (scc(U)->Scc=U
    ;(
      write('no such scc. please select from '),
      sccs(SCCs),write(SCCs),nl,
      hear(scc,Scc)
    )
   ).

hear(agents,Is):- \+ var(Is), subset_of_agents(Is,_).
hear(agents,Is):- var(Is), write('agents? '), read(U),
   (subset_of_agents(U,_)->Is=U
    ;(
      write('its not an appropriate set of agents. please type '),
      nl,
      write(' a subsequence of '),
      set_of_agents(Js),write(Js),nl, 
      write(' or you may re-setup the domain.'),nl,
      hear(agents,Is)
    )
   ).

% Another user conform (for mechanism/3, test_impl/0)
% ----------------------------------------------------------- %

ask_user_if_not_specified_on(_,G):-
   \+ var(G).

ask_user_if_not_specified_on(domain,D):-
   var(D),
   wn('domain must be specified.'),
   hear(domain,D).

ask_user_if_not_specified_on(mechanism,G):-
   var(G),
   ask_user_if_not_specified_on('game form',GF),
   G =.. [GF,_P,_].

ask_user_if_not_specified_on('game form',GF):-
   var(GF),
   wn('game form must be specified.'),
   hear(game_form,GF).

ask_user_if_not_specified_on(scc,Scc):-
   var(Scc),
   wn('social choice correspondence must be specified.'),
   hear(scc,Scc).

ask_user_if_not_specified_on(agents,Is):-
   var(Is),
   wn('set of agents must be specified.'),
   hear(agents,Is).


% User conform with default values 
% for user_completion_of_model/3 a subsidiary rule of 
% user_update_domain_defaults/1 in section 17
% ----------------------------------------------------------- %
% added: 31 Oct 2005.

ask_user_which_or_permit_default(X,Default,User):-
   write( X),
   write( '?'),
   read( User),
   (var(User)-> User=Default; hear(X,User)),
   !.

ask_user_which_or_permit_default(X,_,_):-
   nl,
   write( ('warning! I cannot fit your', X)),
   nl,
   write( ('to this domain. Please ascertain it. ')). 



%  user conform 
%---------------------------------------------------%
% added: 28 Oct 2005 (from menu.pl)
% modified: 16 Nov 2005. moved from common programs section.


do_by_user_conform(if(USER),then(ACT1),else(ACT2)):-
   (var(USER)->read(USER);true),
   (
    member(USER,
      [y,'Y',yes,'Yes','YES',ok,'OK',go]
    )
     -> ACT1  ;  ACT2
   ).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  �h���C���̐ݒ�:
%�@���f���x�[�X�Ǘ��c�[��
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)17

% ----------------------------------------------------------- %
% 17. Getting started with domain:
%   The modelbase management tools
% ----------------------------------------------------------- %



% The choice menu for preference domains in section 3.
% ----------------------------------------------------------- %
% modified: 7 Dec 2002. a test of the domain via condition_D has added.
% modified: 15 Mar 2005.  arranged into a tree-formed menu.
% modified: 14 Oct 2005.  correct. the setps 3-4 and separated set_model.
% modified: 28 Oct 2005.  correct. setup_model, user_update_domain_defaults
% modified: 4 Nov 2005.  revise. setup_domain with  set_mode_of_nash/1.
% modified: 5 Nov 2005.  revise set_model/3 and add the user comfrom (domain and  mode_of_nash).
% modified: 14 Nov 2005.  revise setup_domain3, /1.


set_model:- hear(domain,D), set_model(D).
setup_domain:- hear(domain,D), setup_domain(D).

set_model(Domain):-
   set_model(Domain,_).

set_model(Domain,[GF,Scc,Is]):-
   set_model(Domain,[GF,Scc,Is],[yes,yes]).

set_model(Domain,[GF,Scc,Is],[Chk_D,Chk_Nash]):-
   setup_domain_step_1(_preliminary),
   setup_domain_step_2(_update,Domain),
   setup_domain_step_3(_makeup,[Domain,GF,Scc,Is],Chk_D),
   set_mode_of_nash(_,Chk_Nash).


setup_domain(Domain,[GF,Scc,Is],[Chk_D,Chk_Nash]):-
   set_model(Domain,[GF,Scc,Is],[Chk_D,Chk_Nash]),
   setup_domain_step_4(_finalize,[GF,Scc,Is]).

setup_domain(Domain):-
   set_model(Domain),
   current_model_defaults([Domain,GF,Scc,Is]),
   setup_domain_step_4(_finalize,[GF,Scc,Is]).


setup_domain_step_1('preliminary'):-
   assert(preference(dummy,0,0)),
   assert(difference(dummy,0,0)),
   abolish(preference,3),
   abolish(difference,3).

setup_domain_step_2('update preferences',Goal):-
   domain_models(Doms),
   member(Goal,Doms),
   forall(
    (
     member(Pred,[preference,difference]),
     apply(modelbase,[Goal,Pred,J,S,O])
    ),
    (
     Domain=..[Pred,J,S,O],
     assert(Domain)
    )
   ).

setup_domain_step_3('makeup domain model', DModel, Chk_D):-
   DModel = [_Domain,_GF,_Scc,_Is],
   user_update_domain_defaults( DModel),
   setup_domain_step_3_expost_check( Chk_D),
   nl.

setup_domain_step_3_expost_check( Chk_D):-
   Chk_D==no,
   !.

setup_domain_step_3_expost_check( Chk_D):-
   Chk_D==yes,
   display_current_model,
   !.

setup_domain_step_3_expost_check( _):-
   nl,wn( 'check domain ? :'),
   read(U),
   (U=y->
      setup_domain_step_3_expost_check( yes)
   ;true).

setup_domain_step_4('finalize (online)',[GF,Scc,Is]):-
   write(' Use online mode of mechanism ? (y/n) '),
   read(y),
   update_messages([GF,Scc,Is,_E],online),
   !.

setup_domain_step_4('finalize (file)',[GF,Scc,Is]):-
   write(' Are you ready to update the message file? (y/n) '),
   read(y),
   update_messages([GF,Scc,Is,_E],file),
   wn(' (In order to import the messages do `[messages].`)').


set_mode_of_nash(M->M1, Chk_Nash):-
   mode_of_nash( M, on),
   wn( 'the assumed equilibrium concept is':M),
   set_mode_of_nash_user_conform(M->M1, Chk_Nash).

set_mode_of_nash_user_conform(_, Chk_Nash):-
   Chk_Nash==no,
   !.

set_mode_of_nash_user_conform(M->M1, Chk_Nash):-
   Chk_Nash==yes,
   change_mode_of_nash( M->M1),
   (M1=standard->TM1='';TM1=M1),
   write( ' We shall analyze the set of '),
   write( TM1), wn( ' Nash equilibrium.'),
   !.

set_mode_of_nash_user_conform(M->M1, _):-
   wn( 'if you use another model, please type c.'),
   (read( c)
    ->
     set_mode_of_nash_user_conform(M->M1, yes)
    ; true
   ).
    


% updating domain other than preferences
% the intermediate level user interfece
% ----------------------------------------------------------- %
% This code also dealings with the default model objects
% of the mechanism and the social choice settings, i.e.,
% game form, scc, agents, and preferences. 
% (This code was originally used in test_nash locally.)

% added: 27 Nov 2002. separated from update_messages.
% modified: 29 Dec 2002. assert the default model params.
% modified: 15-16 Mar 2005. renamed and revised (was: update_env, user_update_env) 
% modified: 14 Oct 2005. surpress messages if user specified the model detail.  
% modified: 28-31 Oct 2005. revised the logic of `soft defaults' totally. 
%   revise & rename. conform_with_default_model/2(<= conform_and_set_default_model/4)
%   added select_domain_with_defaults/3, and domain_with_ranked_defaults/3,
%   ranked_default_of_game_forms/3, and  user_completion_of_model/3 (<=/1 ).
% modified: 3 Nov 2005. revise. user_update_domain_defaults/2.
%   added ranked_default_of_game_forms/4 (<=3) augmented with the domain argument.
% modified: 4 Nov 2005.  rename. user_update_domain_defaults/1<==user_update_current_model/ 1.


user_update_domain_defaults(User_Model):-
   User_Model = [Domain,GF,Scc,Is],
   select_domain_with_defaults( Domain,[Is|_],[Scc,GF]),
   conform_with_default_model( User_Model,User_Model1),
   update_current_model_defaults( User_Model1),
   nl,
   write('complete model update ':User_Model1).


select_domain_with_defaults( Domain,[Is1,As,Ss],[Scc1,GF1]):-
   \+ domain_with_ranked_defaults(
     Domain,[Is1,As,Ss],[Scc1,_B,GF1]
   ),
   nl,
   write( 'warning!: No model in this domain ':Domain). 

select_domain_with_defaults( Domain,[Is1,As,Ss],[Scc1,GF1]):-
   domain_with_ranked_defaults(
     Domain,[Is1,As,Ss],[Scc1,B,GF1]
   ),
   % Default_Model = [GF1,Scc1,Is1],
   D1=[
     'target domain':Domain,
     agents: Is1,
     alternatives: As,
     states: Ss
   ],
   forall_nl_and_write(D1),
   D2=[
     scc: Scc1,
     range: B,
     'game form': GF1
   ],
   forall_nl_and_write(D2),
   nl.

domain_with_ranked_defaults( Domain,[Is,As,Ss],[Scc,Range,GF]):-
   %agents_in_domain_model(Domain,Is),
   %stats_in_domain_model(Domain,Ss),
   %alternatives_in_domain_model(Domain,As),
   scc_fit_domain_with_filter(Scc,(Range,As),(Is,Ss),Domain),
   ranked_default_of_game_forms( Domain, Is, _N, GF).

ranked_default_of_game_forms( Domain, Is, N, GF):- 
   clause(
     modelbase( Domain, default, game_form, good, GF),_
   ),
   ranked_default_of_game_forms( Is, N, GF). 

ranked_default_of_game_forms( Domain, Is, N, GF):- 
   ranked_default_of_game_forms( Is, N, GF),
   \+ clause(
     modelbase( Domain, default, game_form, nogood, GF),_
   ).

ranked_default_of_game_forms( Is, N, GF):- 
   length(Is,N),
   member((N,GF),
    [
     (2,gD),(2,gMR2),(2,gST),(2,gTmr),
     (N1,gM),(N1,gMM),(N1,gMR),(N,gDict)
    ]
   ),
   (var(N1)->true ; N1 >2). 

conform_with_default_model( _, User):-
   is_there_unspecified( no, User),
   !.

conform_with_default_model( DM, UM):-
   prompt_conform_with_default_model(Choice),
   user_completion_of_model( Choice, DM, UM).

% is_there_unspecified/2 ==> common programs section.

prompt_conform_with_default_model(Choice):-
   wn('
     please select: use this (y),
     another recomendation (a),
     or modify by yourself (m) ?
   (y/a/m)>'),
   read( Choice ).


% the case of completion/modification by the user 

user_completion_of_model( a, _, _):-
   !,
   fail.

user_completion_of_model( Y, DM, DM):-
   member( Y, [y,yes,'Y','Yes','YES']),
   !.

user_completion_of_model( Y, Base, User):-
   \+ member( Y, [y,a]),
   Base= [ Domain, GF0, Scc0, Is],
   wn('Please specify your model objects, or an unbound `_D` for default.'),
   %ask_user_which_or_permit_default( domain, Domain0, Domain),
    ask_user_which_or_permit_default( scc, Scc0, Scc),
    ask_user_which_or_permit_default( game_form, GF0, GF),
   %ask_user_which_or_permit_default( agents, Is0, Is),
   % the domain and agents can not be changed at this command level.
   User= [ Domain, GF, Scc, Is].

% ask_user_which_or_permit_default/3 ==> cui section. 


%  Updating domain and display
% ----------------------------------------------------------- %
% added: 8 Jan 2003.
% modified: 14,16 Mar 2005.
% modified: 14,28 Oct 2005.  revised. set_of_agents_0/1 and so on.
% modified: 1 Nov 2005.  decomposition. display_current_model/1.
% modified: 3 Nov 2005.  revise. do abolish & assert at first. 


% default current model.

current_model_defaults([jp,gM,f,[1,2,3]]).



update_current_model_defaults(Model):-
   Model=[_DN,_GF,_Scc,Is],
   abolish(current_model_defaults,1),
   assert(current_model_defaults(Model)),
   reset_other_model_objects,
  % E=environment([Is,Ss,As],[N,K,M],Pref),
   gen_environment(Is,_E).

% NOTE.
% this code enforces both literally the defaults and envirnment
% without inconsistency checking against the given domain. 
% The checking rule, by means of select_domain_with_defaults/3,
% is incorporated in user_update_domain_defaults/2 above.


reset_other_model_objects:-
   abolish( set_of_agents_0/1),
   abolish( set_of_states_0/1),
   abolish( set_of_alternatives_0/1),
   all_agents( N),
   all_states( S),
   all_alternatives( O),
   assert( set_of_agents_0( N)),
   assert( set_of_states_0( S)),
   assert( set_of_alternatives_0( O)).


% generating environments
% ----------------------------------------------------------- %
% modified: 14,28 Oct 2005.  correct. gen_environment/3.
% modified: 4 Nov 2005.  moved from social choice section (+)1.

gen_environment([Is,Ss,As],[N,K,L],Rs):-!,
   subset_of_agents(Is,N),
   set_of_states(Ss), length(Ss,K),
   set_of_alternatives(As), length(As,L),
   prefer_profiles(Is,Ss,Rs).

gen_environment(Is,E):-
   gen_environment([Is,Ss,As],[N,K,L],Rs),
   abolish( environment/3),
   assert( environment([Is,Ss,As],[N,K,L],Rs)),
   E = ([Is,Ss,As],[N,K,L],Rs).


% display of current model.
% ----------------------------------------------------------- %
% modified: 7 Nov 2005. ../4 by adding a test_for_current_model/3.

display_current_model:-
   display_current_model( _).

display_current_model( [Domain, GF, Scc, Is]):-
   current_model_defaults( [Domain, GF, Scc, Is]),
   nl,wn( 'domain model': Domain),
   display_scc( Scc, Is, GF).

display_current_model( [Domain, GF, Scc, Is],G):-
   display_current_model( [Domain, GF, Scc, Is]),
   test_for_current_model(Scc,Is,G).

display_domain:- display_domain(_).

display_domain(Strm):-
   nl,wn('preference domain: '),
   wn([agent,state,preference,difference]),
   forall(
    (
     preference(Agent,State,Order),
     difference(Agent,State,Diff)
    ),
    (
     tab(3),
     wn([Agent,State,Order,Diff])
    )
   ),
   nl,
   (
    (var(Strm);Strm=user)
     ->true;
     (
      nl(Strm),
      wn(Strm,'preferene domain: '),
      wn(Strm,[agent,state,preference,difference]),
      forall(
       (
        preference(Agent,State,Order),
        difference(Agent,State,Diff)
       ),
       (
        tab(Strm,3),
        wn(Strm,[Agent,State,Order,Diff])
       )
      ),
      nl(Strm)
     )
   ).



% Fasten the message processing using mechanism/3
% ----------------------------------------------------------- %
% modified: 29-31 Dec 2002.  
%   reduce by 0 is re-enabled. delayed integer have prohibited.
% modified: 15 Nov 2005.  
%   update_messages/0 which refers the current model defaults.

update_messages:-
   current_model_defaults([_,GF,Scc,Is]),
   update_messages([GF,Scc,Is,_E],file).

update_messages([GF,Scc,Is,E],file):-
   abolish(mechanism,3),
   %R = n,  % if not use reduce.
   write('reduced test by 0-integers? (y/n) '),read(R),
   D = y,  % if not use delay.
   %(R=y->D=y;
   %  (write('delayed resolution for integers? (y/n) '),read(D))
   %),
   verify_messages(GF,Scc,Is,E,R,D),
   [messages],
   wn('messages imported').

% modified: 3 Dec 2002.
% modified: 29-31 Dec 2002.
% modified: 2 Jan 2003.

update_messages([_GF,_Scc,_Is,E],online):-
   abolish(mechanism,3),
   %retractall((mechanism(G0,M0,C0):-mechanism(G0,_E0,M0,C0))),
   %G =..[_GF1,_P,_Scc1],  % Scc is unbound
   assert(
    (
     mechanism(G,M,C):-
      (
       E=environment(_,_,_),
       mechanism(G,E,M,C)
      )
      % ,lpom(set,M,[GF1,Scc1,Is],_Z),!
    )
   ).



%  verify all messages (called from setup_domain) 
% ----------------------------------------------------------- %
% modified: 25 Oct 2002. 
% added hear/2.

verify_messages:-
   wn('verify_messages(GF,Scc,Is,E,Reduce0,Delay0)').

verify_messages(GF,Scc,Is,E,Reduce0,Delay0):-
   mechanisms(GFs),
   member(GF,GFs),
   scc(Scc),
   subset_of_agents(Is,N),
   E = environment([Is,_,_],[N,_,_],_),
   E,
   wn(ok),
   !,
   open('messages.pl',write,Strm),
   wn('creating a file of the mechanism.'),
   write('�t�@�C���ɏ��o���Ă��܂��B'),nl,
   Goal=[GF,Scc, M,Is],
   (Reduce0=y->Mtest=..[mtest_z0|Goal];Mtest=..[mtest|Goal]),
   (Delay0=n->Lpom=..[lpom,set,M,[GF,Scc,Is],_Zs];Lpom=true),
   (GF=gD->State=..[update_state,_S];State=true),
   forall(
    ( 
     Mtest, Lpom, State
    ),
    (
     G=..[GF,P,Scc],
     (mechanism(G,E,M,C)->true
      ;(P=nul,C=non)
     ),
     %wn([M,G,C]),read(y),
     write(Strm,mechanism(G,M,C)),wn(Strm,'.')
    )
   ),
   close(Strm).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  ���ʃv���O����
%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)18

% ----------------------------------------------------------- %
% 18. Common programms 
% ----------------------------------------------------------- %

% some display command for list 
% ----------------------------------------------------------- %

wn(X):-write(X),nl.
wn(Strm,X):-write(Strm,X),nl(Strm).
forall_write(C):- forall(member(X,C),(write(X))).
forall_nl_and_write(C):- forall(member(X,C),(nl,write(X))).


% verify unspecified.
% added: 28 Oct 2005.
 
is_there_unspecified( No, User):- 
   \+ ( member(X,User),var(X)),
   !,
   No=no.

is_there_unspecified( yes, _).



% list operations : as if the objects of set theory 
% ----------------------------------------------------------- %

% intersection_of_all/3  ==> common programs.
% ----------------------------------------------------------- %
% added: 25 Oct 2005

intersection_of_all( A, B, C):-
   findall( A, B, X),
   intersection_of_lists( X, C).

% intersection_of_list/2 (cited from set.pl)

intersection_of_lists([],_).
intersection_of_lists([X|H],Z):-
   intersection_of_lists(H,Y),
   intersection(X,Y,Z).


% a sequence of binary choice for a list:
%--------------------------------------------------
% projection(3rd ar) of vector(2nd ar) using a sequence of digits(1st ar). 
% you must specify the second ('a base set') argument.
% this predicate is important so that it is used in subset_of /3.

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


% complementary list projection
%--------------------------------------------------
% added: 31 Oct 2005. (from set.pl) 

c_list_projection([],[],[]).
c_list_projection([X|Y],[_|B],C):-
   c_list_projection(Y,B,C),
   X = 1.
c_list_projection([X|Y],[A|B],[A|C]):-
   c_list_projection(Y,B,C),
   X = 0.


% added: 15 Oct 2002. 

plist_projection(P,A,[],[]):-
   list_projection(P,A,[]).
plist_projection(P,A,C,C1):-
   list_projection(P,A,C1),
   C1\=[],
   permutation_of(C1,C,_N).



% count frequency of occurence of the specified value of variable, M.
% ----------------------------------------------------------- %
% note: Both of M and L have to be specified.

counter(N,M,L):-
   length(L,_),
   findall(M,member(M,L),Mx),
   length(Mx,N).

% equality for pair of set
% ----------------------------------------------------------- %
% an old version.
seteq(X,Y,L):-
   length(X,L),
   length(Y,L),
   forall(member(Z,X),member(Z,Y)),
   forall(member(Z,Y),member(Z,X)).
% edited: 15 Nov 2002.
seteq(X,Y):-
   sort(X,Sort),
   sort(Y,Sort).

% subset_of/3 : useful for subset-enumeration 
% ----------------------------------------------------------- %
subset_of(A,N,As):-
   length(As,L),
   length(D,L),
   list_projection(D,As,B),
   length(B,N),
   sort(B,A).

%subset_of(A,N,As):-multiple_subset_of(A,N,As).

% subset allowing multiple membership 
% ----------------------------------------------------------- %
multiple_subset_of([],0,_):-!.
multiple_subset_of([X|A],N,As):-
   length([X|A],N),
   multiple_subset_of(A,N1,As),
   member(X,As),
   N is N1 + 1.



% set of all subsets 
% ----------------------------------------------------------- %
powerset_of(X,A):-
   length(A,_),
   findall(Y,N^subset_of(Y,N,A),X1),
   sort(X1,X),!. 

% descending/ascending natural number sequence less than N.
% ----------------------------------------------------------- %
desc_nnseq([],N):-N<0,!.
desc_nnseq([0],1).
desc_nnseq([A|Q],N):-
   A is N - 1,
   length(Q,A),
   desc_nnseq(Q,A).
asc_nnseq(Aseq,N):-desc_nnseq(Dseq,N),sort(Dseq,Aseq).


% bag0/3 : allow multiplicity
% ----------------------------------------------------------- %
bag0([],_A,0).
bag0([C|B],A,N):-length([C|B],N),bag0(B,A,_N1),%N is N1 + 1,
  member(C,A).

% bag1/3 : do not allow multiplicity
% ----------------------------------------------------------- %
% modified: 15 Oct 2002. bag fixed for unboundness.

bag1([],_A,0).
bag1([C|B],A,N1):-
  \+var(A),
  length(A,L),
  asc_nnseq(Q,L),
  member(N,Q),
  length(B,N),bag1(B,A,N),N1 is N + 1,
  member(C,A),\+member(C,B).

% ordering/3
% ----------------------------------------------------------- %
ordering(A,B,C):-bag1(A,B,C).


% permutation.
% ----------------------------------------------------------- %
% modified: 1 Sep 2002. to be used in is_neutral/2. 
% modified: 15 Oct 2002. add a non-variable constraint for the base set A. 

% permutation of alternatives.
poa(P,APs):-
   set_of_alternatives(A),
   permutation_of(A,P,APs).

permutation_of(A,P,APs):-
   \+var(A),
   length(A,M),
   ordering(P,A,M),
   asc_nnseq(Qm,M),
   my_maplist(nth_of_permutation(A,P),Qm,APs).

%caution:
%notations 'A->B's below have cause precedence errors in IF-prolog.

nth_poa(P,K,Ak->Pk):-
   set_of_alternatives(A),
   nth_of_permutation(A,P,K,Ak->Pk).
nth_of_permutation(A,P,K,Ak->Pk):-
   length(A,M),
   ordering(P,A,M),
   nth0(K,A,Ak),
   nth0(K,P,Pk).

perdeviate_of_order(PoA,[Q->R]):-
   poa(_P,PoA),
   set_of_alternatives(A),
   length(A,M),
   ordering(Q,A,M),%wn(Q),
   ordering(R,A,M),%wn(R),
   permutation(Q,PoA,R).

permutation([],[],[]).
permutation(Q,[A->P|PoA1],R):-
   subtract(Q,[A],Q1),nth1(K,Q,A),
   subtract(R,[P],R1),nth1(K,R,P),
   permutation(Q1,PoA1,R1).


% projection operator via index set. (an exchange economy?)
% choice1 from base1 :: choice2 from base2.
% modified : 15 Oct 2002. to be order-neutral (pending:-)
% 
pcm([Choice1,Base1],[Choice2,Base2]):-
   pairwise_contract_map([Choice1,Base1],[Choice2,Base2]).


pairwise_contract_map([Choice1,Base1],[Choice2,Base2]):-
  %  length(Base1,N2),
  %  length(Base2,N2),
   subset_of(Choice1,N1,Base1),
   subset_of(Choice2,N1,Base2),
   list_projection(Project,Base1,Choice1),
   list_projection(Project,Base2,Choice2).

% ppcm /2 using plist_projection 
% added: 15 Oct 2002.
ppcm([Choice1,Base1],[Choice2,Base2]):-
   subset_of(C1,N1,Base1),
   subset_of(C2,N1,Base2),
   plist_projection(Project,Base1,Choice1,C1),
   plist_projection(Project,Base2,Choice2,C2).


% replace(Project,Goal,Base,Goal1):-
% ----------------------------------------------------------- %
% added: 15 Oct 2002.
  % a sequence of replacement of a subset of elements in Goal 
  % which specified by a list, Project, 0-1^n, over Base 
  % a list of length n, which brings about Goal1.
  % X=1 --> preserve the original. X=0 --> do replace.
replace([],[],[],[]).
replace([X|A],[_|B],[Z|C],[Z|D]):-
   X = 0,
   replace(A,B,C,D).
replace([X|A],[Y|B],[_|C],[Y|D]):-
   X = 1,
   replace(A,B,C,D).


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

% �S�[���̏d���x�𒲂ׂ�B
% ----------------------------------------------------------- %
sea_multiple(Goal,Cond,N,M):-
  Clause=..Goal,
  findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M).

% concatenate for list elements 
% ----------------------------------------------------------- %
concat_v([],'',0).
%concat_v([b,c],Z,2):-length([c],1),concat_v([c],c,1),concat(b,c,Z).
%concat_v([a,b,c],Z,3):-length([a,c],2),concat_v([b,c],bc,2),concat(a,bc,Z).
concat_v([X|Y],Z,L):-concat_v(Y,Z1,L1),length(Y,L1),L is L1 + 1, concat(X,Z1,Z).

% �������X�g�i�Q�l�j
% concat_dl(A-B,B-C,A-C).


% Some swi-prolog predicates replicated
% ----------------------------------------------------------- %
% Other than ISO-prolog predicates append/3, union/3, subset/2, 
% intersection/3, findall/3, setof/3, bagof/3, and so on, 
% I used several incorporated predicates of SWI-prolog, 
% for example, nth1/3,nth0/3, (my_)maplist, and numbervars. Some
% of them can be replicated as shown below. It is not easy as for 
% numbervars, a foreign predicate, but 
% I used it to generate ud32, a domain model.  


/* nth0 and nth1 of SWI-prolog. if you need to write, use this.

nth1(A, B, C) :-
     integer(A), !,
     D is A - 1,
     nth0_1(D, B, C).
nth1(A, B, C) :-
     var(A),
     nth0_2(D, B, C),
     A is D + 1.
nth0(A, B, C) :-
     integer(A), !,
     nth0_1(A, B, C).
nth0(A, B, C) :-
     var(A), !,
     nth0_2(A, B, C).
nth0_1(0, [A|B], A) :- !.
nth0_1(A, [B|C], D) :-
     E is A - 1,
     nth0(E, C, D).
nth0_2(0, [A|B], A).
nth0_2(A, [B|C], D) :-
     nth0_2(E, C, D),
     succ(E, A).
*/

%--
/* apply /2  */

my_apply(A,B):-C=..[A|B],C.

/*  maplist/3, select/3, and  sublist/ 3  */ 

my_maplist(_A, [], []).
my_maplist(A, [B|C], [D|E]) :-
     apply(A, [B,D]),
     my_maplist(A, C, E).

my_select([A|B], A, B).
my_select([A|B], C, [A|D]) :-
     my_select(B, C, D).

my_sublist(_A, [], []) :- !.
my_sublist(A, [B|C], D) :-
     apply(A, [B]), !,
     D = [B|E],
     my_sublist(A, C, E).
my_sublist(A, [_B|C], D) :-
     my_sublist(A, C, D).



% Cf., some basic results for If-Then sentences in prolog. 

/*

?- X=(a:-(d,e;f,g)),
X=(a:-((d,e);f,g)),
X=(a:-((d,e);(f,g))).

X = a:-d, e;f, g 

Yes
?- X=(a:-(d,e;f,g)),
Y=(a:-(d,(e;f,g))),
Z=(a:-(d,(e;f),g)),
W=(a:-((d,e;f),g)).

X = a:-d, e;f, g
Y = a:-d, (e;f, g)
Z = a:-d, (e;f), g
W = a:- (d, e;f), g 

Yes
?-
*/



% ----------------------------------------------------------- %
% Tools for saving experimetal data to external files 
% ----------------------------------------------------------- %
% modified: 23 Sep 2002.
% modified: 28 Sep 2002. augmented with tell_test.
% modified: 18 Oct 2002. to_file, an alias.

to_file:-
   results_to_file.

results_to_file:-
   tab(5),write(' input your goal'),read(U1),
   tab(5),write(' output file'),read(U2),
   concat(U2,'.txt',File),
   U1=..Goal,
   tab(5),write(' tell file ? (y/n) '),read(U3),
   (U3=y->Tell=tell;Tell=no),
   results_to_file(Goal,Tell,File,_S).

to_file(_Goal,_,File,S):-
   results_to_file(_Goal,_,File,S).

results_to_file(_Goal,_,File,S):-
   \+ current_stream(File,write,S),
   write('Now opening output file:'),wn(File),
   wn('Please type semicron ; after prompt'),
   open(File,write,S).
  %fail.

results_to_file(_Goal,tell,_File,_):-
   \+ current_stream('res_tell.txt',write,Strm),
   open('res_tell.txt',write,Strm),
   tell('res_tell.txt'),
   fail.

results_to_file(Goal,_Both,File,S):-
   current_stream(File,write,S),
   %Goal=[_G,_A,_B,_Is],
   Goal1=..Goal,
   Goal1,
   wn(Goal1),
   write(S,Goal1),write(S,'.'),nl(S),
   fail.

results_to_file(_Goal,tell,_File,_):-
   current_stream('res_tell.txt',write,Strm),
   close(Strm),
   tell(user),
   fail.

results_to_file(_Goal,_Both,File,S):-
   current_stream(File,write,S),
   write(S,end_of_run),nl(S),
   write('Now closing output file:'),wn(File),
   wn('Please type enter key after prompt'),
   close(S).


% using tell/1 in order to change the standard output to file.

% revised: 15 Oct 2005.  using tell_goal/2 of menu.pl

tell_test(Goal):-
   tell_goal('tell.txt',Goal).

tell_goal(File,G):-
   forall(
     current_stream(File,write,S),
     close(S)
   ),
   tell_goal_0(File,G),
   fail.

tell_goal(File,_):-
   forall(
     current_stream(File,write,S),
     close(S)
   ).

tell_goal_0(File,G):-
   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).


% ���s�����̎擾

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

% tstamp/1
% added: 1 Jan 2003. 

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


% tstamp/2
% added: 24 Oct 2005.  cited from menu.pl

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.



% ----------------------------------------------------------- %
% save all predicate symbols in the system 
% ----------------------------------------------------------- %
% added: 24 Sep 2002.

tell_all_pred:-
   tell_test(
     forall(impl_pred(P),
      (
       P=..[X|Z],
       %current_functor(X,Y)
       length(Z,L),
       write(X),
       write(' / '),
       write(L),nl
      )
    )
  ).

impl_pred(P):-
   predicate_property(
     P,
     file(
       '/c:/decision/pl/bin/impl09.pl'
      )
   ).

% ----------------------------------------------------------- %
% display all successful goals (with the count).
% ----------------------------------------------------------- %
% added: 27 Oct 2005.
% cited from: menu.pl 

display_goals(G):-
   (\+ var(G)->true;G=empty),
   forall(G,(nl,write(G))).
display_goals(_).
display_goals(G,C):-
   (\+ var(G)->true;G=empty),
   (\+ var(C)->true;C=true),
   forall((G,C),(nl,write(G))).
display_goals(_,_).
display_goals(G,C,N):-
   (\+ var(G)->true;G=empty),
   (\+ var(C)->true;C=true),
   findall(G,(G,C),L),
   length(L,N),
   display_goals(G,member(G,L)),
   nl,
   write('the number of goals='),
   write(N).


% ----------------------------------------------------------- %
% a display of counter for iterated goals.
% ----------------------------------------------------------- %
% added: 27 Oct 2005.
% cited from: menu.pl 

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

% ----------------------------------------------------------- %
% an alternative for display_goals/1,2,3 
% ----------------------------------------------------------- %
% added: 27 Oct 2005

forall_do_with_displaying_id( G,M):-
   init_count_of_display,
   forall( G,
    (
     update_and_display_counter,
     tab(1),
     write(M)
    )
   ).



% ----------------------------------------------------------- %
% stop watch
% ----------------------------------------------------------- %
% added: 27 Oct 2005.
% cited from: menu.pl 

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.

% + MaxIteration

stopwatch_of_iterated_goals(Goal,TD,MaxIteration,Display):-
   number(MaxIteration),
   MaxIteration > 0,
   init_count_of_display,
   rule_of_display_number_in_stopwatch(Display,JOB),
   stopwatch(
     forall(
      (
       Goal, %write(Goal),
       update_count_of_display(K),
       (K>MaxIteration->!,fail;true)
      ),
       JOB
     ),
     TD
   ).

rule_of_display_number_in_stopwatch(no,true):-
   !.

rule_of_display_number_in_stopwatch(yes,display_counter).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% History of development and revision
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)19

develop_history(H):-H=['
','% the history of development:
','% created: 20-21 Sep 2001  a naive code for "checking monotonicity" for SCCs.
','% modified: 28-30 Sep   "canonical(Maskin-Vind) mechanism, rule 1."
','% modified: 3-4 Oct  "For n=3, rules 1,2,3 have almost done."
','% modified: 5-8 Oct (impl_0.pl:v.0) "Nash strategy" for players, and gM rules.
','% modified: 10-11 Oct  revision. "br_defeasible/5" and "nash/5".
','% modified: 12-13 Oct  revision. "br_defeasible/6","deviate/5" 
','% modified: 14 Oct  (impl.pl:v.1) extended with "best_response/5"and  "nash/5".
','% modified: 18 Oct  added "lcc/3", revised "monotone/1".
','% modified: 19 Oct  added. "ess/4","is_essential/4","ess_monotone/1" and "nash/5" has modified.
','% modified: 19-26 Dec (v.2) totally debugged including "nash/5".
','% modified: 27-31 Dec (v.3) "test_impl" and several to write stream.
','% modified: 1-4,17-20 Jan 2002  blocking, test_block, test_proposition.
','% modified: 20-22 Jan 2002 (v.4b) beta_blocking. individual rationality.
','% modified: 23-28 Jan 2002  (v.4-) 2-person case: MR-property, prefer_profile.
','% modified: 29-31 Jan 2002  2-person case: Danilov mechanism gD.
','% modified: 1-3 Feb 2002  gM, test_impl, test_nash, gD, ess, blocking.
','% modified: 4-7 Feb 2002  game_forms and mechanism for gD.
','% modified: not yet 18- Feb 2002  nash, test_impl for gD.
','% modified: 27-30 Apr 2002  mechanism, nash, test_impl for gM and for gD.
','% modified: 1-9 May 2002 (v.5 & v.5b, a folk)  totally revised. gM, gD, N-person nash, test_impl and so on. 
','% modified: 16 May 2002  simple mechanism for nash equilibrium test.
','% modified: 23 Jul 2002  is_blocked_by/6, blockings/4,is_I_rational/4.
','% modified: 24 Jul 2002  (v.6) file renamed as "impl06.pl" 
','% modified: 25-28 Jul 2002  is_I_rational/4, i_rationals/5, is_MR...
','% modified: 29 Jul--1 Aug 2002 (v.7) new test routines for scc0, auto-generated, including results_to_file/3
','% ( Afterwards many `v.8dd`s or `v.9dd`s were created.)
','% modified: 1-7 Aug 2002  Moore-Repullo example, difference/3, prefer_to/4, and related parts.
','% modified: 9-10 Aug 2002   Moore-Repullo mechanism,test_dan55/1,test_sa/1.
','% modified: 11-13 Aug 2002  gen_test_scc for a simple universal domain, ud22,partially, m=3.
','% modified: 15 Aug 2002  Pareto property, dictator, NVP, unanimity
','% modified: 17-9 Aug 2002  unified mechanism, restricted VP, bad_outcome, neli(nonempty_lower_intersection),
','  minimal liberalism, ud32, an approximated universal domain, added the dictatorial sccs in ud22 and tested.
','% modified: 20-23 Aug 2002  condition_D by Yamato(1992), difference/3 and strict_prefer_to/4, B_k/star,
','  C_k/star,conditions mju/mju2, M/M2, by Sjostrom. I started Suh`s storong implementation but only partially.
','% modified: 24-26 Aug 2002  gMR and gMR2, the Moore-Repullo-Dutta-Sen mechanism.
','  Modified several test routines,  tell_test, mtest, auto_preference, gen_test_preference.
','% modified: 27-28 Aug 2002  the several bugs fixed. gD message has to include the empty set.
','  The remaining five implementable sccs umd1--5 in ud22 has added and M2 tested.
','  The impossibility result of N=2 has verified for simple domain model ud22 where without nul outcome scc. 
','% modified: 29 Aug 2002  As for the game forms of gD and test_nash, best_reponse, deviate (allowing equality)
','  have bugfixed respectively. And the roulette, previously its choice range of using dictatorship has wrong,
','  has corrected and separated from these forms. I also fixed that findall, insted of setof, used in
','  check_on_scc, check_off_scc, in order to pass, without fail, the check for the empty set.
','% modified 30-31 Aug 2002  the part of roulette and dictatorship in gD and nash and test_nash has bugfixed.
','  setup_domain/1 as auto setup for preference domain. reference_list/0 as auto display for the reference. 
','  New testing method for mechanism outcomes stored into a file, via verify_messages/4, and nash and test_nash
','  has modified to use this message file in order for some computational efficiency. %
','% modified 1-2 Sep 2002 (v.8) In advance of version 9 some routines for permutation of outcomes and scc neutrality/2.
','  gen_test_neutral and gen_test_condMju have added and the rules 2-6 of gMR2 has modified.  %
','% modified 3-7 Sep 2002. (v.903, 5 Sep) test routines for nash outcomes which includes test_nash, nash, bset_response 
','  and the message profile routines for each of mechanisms have edited. I intend that the system to be 
','  decomposed into 8 modules, but it is postponed. gD has a bug in dictatorship with pre-verified messages.
','  Because of the hidden true state, message verification was incomplete. %
','% modified 8-24 Sep 2002  Three papers with regarding this experimental system has been written by me,
','  two-long, one-short. (And now I am intending one more important.) During authorizing them, I noticed 
','  a bug and it has fixed. The message profiles for Maskin mechanism, have the gen_test_scc /3 to save
','  its results as the clauses, and added some routines such that extract_em /3, extract_sccs /4, and
','  tell_all_pred /0 for the convienience of the analysis. %
','% modified 25 Sep 2002  contract_domain /3, related to condition_D /2, has modified.
','  It is now possible to auto-generate a domain that satifies condition D by means of
','  contracting the subset of states from any domain. %
','% modified 26-8 Sep 2002  The predicates that related to condition_mju, condition_M, 
','  their subconditions, including anew collect_cx /7, and that related gen_sccs have modified.  %
','% modified 1-24 Oct 2002  a command user interface wsid has added. Several predicates related to 
','  gen_sccs have modified so that they have an arity 0 version as the command line interface.
','  A bug of gM as for non-0-integer messages, by using lpom. Just detected and tried to fix. %
','% modified 25 Oct 2002  toplevel menu wsid / 0 a cui and of setup_domain /1 have modified.
','  hear /2 has added to the latter so that the online-mode of simulated mechanisms to be permitted.
','  And so verify_message_file has renemed and dichotomized into verify_messages(file) and 
','  verify_messages(online). test_ne /0,5, nec /1, ne /4, and br /6 have added. %
','% modified 10 Nov 2002  wsid / 0 has minorlly modified. A bug of mechanism simulation has fixed.
','  gen_test_mju has modified and test_mju has separated from it.
','  display_scc has extended by including condition mju.
','  Tentative comments in condition mju has suppressed. %
','% modified 10-12 Nov 2002 The online mode mechanism /3 has modified with a cut operator.
','  lpom / 4 has extended so that you may select to set integer or only to extract the integer part
','  of a message profile optionally. %
','% modified 18 Nov 2002 (v.10) just a version of 28 Sep but for a modified code of seteq/2.
','% modified 26 Nov 2002 Updated version impl11.pl because of this month.
','  Although most part are same as imple10.pl but for bugfixed in verify_messages,
','  a missing argument in the strucure of lpom, and some minor bugs in game_forms of
','  rule 2 and rule 3 of gM. However, lpom has not yet been enabled.%
','% modified 27 Nov 2002 bugfix in mtest_z0 of gMR and gMR2, a missing bit argument after 0.
','  The expost integer-setting added in the 2nd rule of game_form of gMR2.
','  And update_current_model/1 has separated from update_messages. %
','% modified 2-5 Dec 2002 bugfix about online-mode, including game_form(gM(2)),
','  mechanism /4, best_response /5 and update_messages /3 for online mode. %
','% modified 8-10 Dec 2002. bugfix on the rule 1 and 2 of game_form gM. %
','% modified 29 Dec 2002. (v.11a) bugfix, and recovery on the rule 3 in gM and mr_message.
','  The work has done rather late in the day.
','  The mode options (delay and reduce) for message spaces in setup_domain (verify_messages) has abolished.
','  Instead, the online mode has modified to do the role partially. 
','  The prerequisite parameters for model analysis as a current_model will be passed to test_nash and
','  test_impl in the background. By means of this, unintentional loop when user types a mismatch
','  against the context params can be avoided.
','  So I devised a little intelligence to communicate with user.
','  And in the online mode, a user freely secifies
','  mechanism /3 temporally independently from the default stipulated as setup_domain. %
','% modified 30-31 (v.11) Dec 2002 bugfix in game_form 3 of gMR.
','  Truth-telling mode in test_nash, and test_impl, etc. has added. %
','% modified 1-3 Jan 2003  Some simplifications in best_response, nash, test_nash, test_impl and etc,
','  including that the mode part has abolished, in order to get rid of instability in mechanism simulations.
','  A time stamp has added but not appropriately operate in version 1.9.0. %
','% modified 4-5 Jan 2003. bugfix. lpom/4 and the rule 3 of gM (and gMR) of integer part and the position
','  of a cut operator. A simplification of best_response.  %
','% modified 6-7 Jan 2003. bugfix. A delicate backtrak problem of mechanism /3 in best_response,
','  which has at first fixed 3 Dec 2002.  A debug for the rule 2 of gM. And with a debug of
','  check_truth_telling, the inappropriate use of mtest, in test_nash, to generate truthful messages
','  which yield the scc outcomes for each state has modified. %
','% modified: 8(10) Jan 2003 (v.12). the system to be compatible partly with swi-prolog 5.0.9.
','  bugfix in the rule 2 of gM and gMR. bugfix. mechanism/3, which was not allowed by
','  privious modification in last September, to be free to generate outputs by mtest. %
','% modified: 21 Feb-24, 4 May 2003(v.12a). non-code modifications (?) %
','% modified: 13-17 Mar 2005. (v.13) A refinement for the comments and user commands. %
','% modified: 14-15 Oct 2005. (v.13a) Revision. setup_domain, test_ne, gen_test_scc, wasid, 
','  and the rules for preference profiles. %
','% modified: 24-30 Oct 2005. (v.13b) Under construction. correct this section. 
','  modified the title of contents, additionally the preface section. revised set_model,
','  renamed modelbase/5(<-stock_of), started revising strong implementation with domain suh.
','% modified: 31 Oct 2005. revised basic format of generic message space with agent indices.
','  so revised mechanism sections and added two message spaces gST and gMM. 
','  revised several CUI rules in user_update_domain_defaults/1, hear/2, and so on. %
','% modified: 1-2 Nov 2005. revised best_response/0,5 deviate/7 in Nash equilibrium section augmented  with 
','  additional subrules. added mode_of_nash/1 a flip-flop which switches strong (<-> standard) Nash equilibrium.  
','% modified: 3 Nov 2005. revised scc_fit_domain/4 and modelbase/5 by means of which the default scc
','   and game form are set during user_update_domain_defaults/1 (or set_mode/1) 
','% modified: 4 Nov 2005. rename. current_model_defaults/1<==current_model/1 and the update rule.
','   rename. user_update_domain_defaults/1<==user_update_current_model/ 1.
','% modified: 5-7 Nov 2005. revise. the algorithm of Suh(1996), set_C_T_m and the related rules.
','   revise. Moore-Repullo mechanism gMR and gMR2, the game_form/4 with the message space.
','% modified: 8 Nov 2005. add. test for set_C_T and set_C_star for domain mr.
','% modified: 9 Nov 2005. added mr0 (the pair of domain and scc), a nonimplementable two-person case.  
','   added a tabular mechanism gTmr which implements the model mr. revised message_profile/4.
','% modified: 10-13 Nov 2005. added mr1 a modified scc from mr. decomposed the rule mju(iv) into the parts. 
','   bugfix. the second rule of gMR2, but not yet resolved until 22:20pm. 
','   bugfix(restore). the third and forth gMR2 with exchanging the attainable sets Cx1 and Cx2. 
','   bugfix. message_profile_with_mode/6. the judgment of non-0-settings.
','% modified: 14 Nov 2005. revised test_nash/7. improved the computational efficiency. 
','% modified: 15 Nov 2005. revised the rules for condition mu (iv) including
','   sub_condition_of_mju/5 and select_common_maximal_element_in_scc/3.
','   added update_message/0. revised mu (iv).
','% end of editorial history.
'].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  References  
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)20

ref(head,'reference:').
ref(d(92),
  'V. Danilov',
  1992,
  'Implementation via Nash equilibria.',
  ' Econometrica',
  ' 60(1):43-56.',_).
ref(ds(91),
  'B. Dutta and A. Sen',
  1991,
  'A necessary and sufficient condition for two-person Nash implementation.',
  'Review of Economic Studies',
  '58:121-8.',_).
ref(jp(01),
  'M.O. Jackson and T.R. Palfrey',
  2001,
  'Voluntary implementation.',
  'Journal of Economic Theory',
  '98:1-25.',
  'Especially, the example 1 (Voting) in Jackson and Palfrey (2001).'
).
ref(m(99),
  'E. Maskin',
  1999,
  'Nash equilibrium and welfare optimality.',
  'Review of Economic Studies',
  '66:23-38.',_).
ref(ms(02),
  'E. Maskin and T. Sjostrom',
  2002,
  'Implementation theory.',
  'In K. Arrow, A. Sen, and K. Suzumura (eds.), Handbook of Social Choice and Welfare, Vol. 1, North-Holland',
  'pp.237-288.',_).
ref(mat(02),
  'H. Matsushima',
  1988,
  'A new approach to the implementation problem.',
  'Journal of Economic Theory',
  '45:128-44.',_).
ref(m(93),
  'J. Moore',
  1993,
  'Implementation, contracts, and renegotiation in environments with complete information.',
  'In J.-J. Laffont (ed.), Advances in Economic Theory, Cambridge University Press.',
  'pp.182-282.',_).
ref(mr(90),
  'J. Moore and R. Repullo',
  1990,
  'Nash implementation: A full charaterization.',
  'Econometrica',
  '58(5):1083-99.',_).
ref(sj(91),
  'T. Sjostrom',
  1991,
  'On the necessary and sufficient conditions for Nash implementation.',
  'Social Choice and Welfare',
  '8:333-40.',_).
ref(y(92),
  'T. Yamato',
  1992,
  'On Nash implementation of social choice correspondences.',
  'Games and Economic Behavior',
  '4:484-92.',_).
ref(p(98),
  'B. Peleg',
  1998,
  'Effective functions, game forms, games, and rights.',
  'Social Choice and Welfare',
  '15:67-80.',_).
ref(saijo(88),
  'T. Saijo',
  1988,
  'Strategy space reduction in Maskins theorem: Sufficient conditions for Nash implementation.',
  'Econometrica',
  '56(3):693-700.',_).
ref(suh(96),
  'S.-C. Suh',
  1996,
  'An algorithm for checking strong Nash implementability.',
  'Journal of Mathematical Economics',
  '25:109-22.',_).
ref(indo(02),
  'K. Indo',
  2002,
  'Implementing Nash implementation theory on prolog: a logic programming approach.',
  'mimeo',
  'http//www.us.kanto-gakuen/indo/wp/myecon02.ps',_).
ref(indo(03),
  'K. Indo',
  2003,
  'Simulation of Nash implementation by prolog.',
  'The Research Bulletin of Economics, Kanto Gakuen University',
  '30(1):57-87.(Japanese)',_).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Startup 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(+)21

% modified: 14 Oct 2005.

welcome:-
   ttl( HL),
   forall_write( HL),
  % contents,
  % develop_history,
  % reference_list,
   nl.

contents:- contents(C), forall_write(C).
contents_jp:- contents_jp(C), forall_write(C).
develop_history:-develop_history(C),forall_write(C).

:- welcome.

%  end of the program
% ----------------------------------------------------------- %

return to front page.