You selected sp06d.pl
% programming social choice in logic: preference aggregation,
% domain restriction, simple game, effectivity function
%--------------------------------------------------------------
% Kenryo INDO (kindo at kanto hyphen gakuen dot ac dot jp)
% 2006.8.9-20 (sp06.pl) basic modeling of preference and swf
% 2006.8.20-21 (sp06b.pl) q-trans valued SWF/SDF
% 2006.8.28-9.5 (sp06b1.pl) liberal paradox and d-implicature
% 2006.9.6-7 (sp06b2.pl) simple games and effectivity functions
% 2006.10.9-15, 17-24 (sp06c.pl) improved version with core and stability
% 2006.10.24-11.6,9 (sp06d.pl) 3-person 3-alternative cases
% 2006.12.27 correct is_essential_game, inspect_sg, verify_win.
%--------------------------------------------------------------
% setting up the agent society:
% alternatives, agents, coalitions, and preference relations
%--------------------------------------------------------------
:- dynamic agent/1, coalition/1, alt/1.
% agents (individuals) and coalitions
agent(1:taro).
agent(2:hanako).
agent(3:jiro).
coalition([1]).
coalition([2]).
coalition([3]).
coalition([1,2]).
coalition([1,3]).
coalition([2,3]).
coalition([1,2,3]).
% three alternatives
alt(1:x).
alt(2:y).
alt(3:z).
% the pairs
pair_alt([J,K]:[X,Y]):- alt(J:X), alt(K:Y).
d_pair_alt([J,K]:[X,Y]):- pair_alt([J,K]:[X,Y]), J < K.
% model of a generalized preference relation
% (q-transitive orderings)
gen_r(B,C,[M,Q,T],R):-
findall((X,Y), d_pair_alt(_:[X,Y]), W),
r(B,C,R,W),
is_q_trans(R,Q),
is_complete(R,T),
is_consistent(R,M).
% (depreciated)
gen_consistent_r(B,C,R):-
gen_r(B,C,[M,_,_],R),
M=consistent.
% binary /preference relations
select_r_relation('+',(X,Y),S,[(X,Y)|S]).
select_r_relation('0',(X,Y),S,[(X,Y),(Y,X)|S]).
select_r_relation('-',(X,Y),S,[(Y,X)|S]).
r([],[],[],[]).
r([A|B],[(X,Y):A|C],R,[(X,Y)|H]):-
r(B,C,S,H),
select_r_relation(A,(X,Y),S,R).
% NOTICE!!
% In this program, we have assumed the cases of
% reflexiveness r(A,A) to be true, but implicitly
% in the last argument of r/4, r_x/5 and r_0/5.
% preference relations based on binary relations where
% the second argument in r/2 (<-- the fourth argument in r/4 ).
r((X,X),R):-
\+ var(R),
alt(_:X).
r((X,Y),R):-
\+ var(R),
member((X,Y),R).
% strict relations
p((X,Y),R):-
r((X,Y),R),
\+ r((Y,X),R).
% indifference
i((X,Y),R):-
r((X,Y),R),
r((Y,X),R).
% unanimity quasi ordering for two person
q((X,Y),(S,T)):-
r((X,Y),S),
r((X,Y),T).
% properties of binary relations
%--------------------------------------------------------------
% completeness
is_complete(R):-
forall( d_pair_alt(_:[X,Y]),
(
r((X,Y),R)
;r((Y,X),R)
)).
is_complete(R,C):-
is_complete(R)->C=complete;C=incomplete.
% transitivity
is_not_transitive(R,[A,B,C]):-
r((A,B),R),
r((B,C),R),
C \= A, % implict case: C=A
\+ r((A,C),R).
is_transitive(R):-
\+ var(R),
\+ is_not_transitive(R,_).
whether_is_transitive(R,T):-
is_transitive(R)->T=trans;T=not(trans).
% negative transitivity based weak order
is_NOT_negatively_transitive(R,[A,B,C]):-
alt(_:A),
alt(_:B),
alt(_:C),
\+ p((A,B),R),
\+ p((B,C),R),
p((A,C),R).
is_negatively_transitive(R):-
\+ var(R),
\+ is_NOT_negatively_transitive(R,_).
whether_is_negatively_transitive(R,T):-
is_negatively_transitive(R)->T=trans;T=not(trans).
is_NOT_anti_symmetric(R,[A,B]):-
alt(_:A),
alt(_:B),
p((A,B),R),
p((B,A),R).
% Note: our modeling vacuously satisfies anti-symmetry.
is_anti_symmetric(R):-
\+ var(R),
\+ is_NOT_anti_symmetric(R,_).
is_weak_order(R):-
is_negatively_transitive(R,_),
is_anti_symmetric(R,_).
/*
?- gen_consistent_r(A,B,E),is_negatively_transitive(E),
%is_anti_symmetric(E),
nl,write(A:B),fail.
[+, +, +]:[ (x, y): +, (x, z): +, (y, z): +]
[0, +, +]:[ (x, y):0, (x, z): +, (y, z): +]
[-, +, +]:[ (x, y): -, (x, z): +, (y, z): +]
[-, 0, +]:[ (x, y): -, (x, z):0, (y, z): +]
[-, -, +]:[ (x, y): -, (x, z): -, (y, z): +]
[+, +, 0]:[ (x, y): +, (x, z): +, (y, z):0]
[0, 0, 0]:[ (x, y):0, (x, z):0, (y, z):0]
[-, -, 0]:[ (x, y): -, (x, z): -, (y, z):0]
[+, +, -]:[ (x, y): +, (x, z): +, (y, z): -]
[+, 0, -]:[ (x, y): +, (x, z):0, (y, z): -]
[+, -, -]:[ (x, y): +, (x, z): -, (y, z): -]
[0, -, -]:[ (x, y):0, (x, z): -, (y, z): -]
[-, -, -]:[ (x, y): -, (x, z): -, (y, z): -]
No
?- r_0(K,A,B,_,E),is_negatively_transitive(E),
%is_anti_symmetric(E),
nl,write(A:B),fail.
[+, +, +]:[1]:[ (x, y): +, (x, z): +, (y, z): +]
[0, +, +]:[2]:[ (x, y):0, (x, z): +, (y, z): +]
[-, +, +]:[3]:[ (x, y): -, (x, z): +, (y, z): +]
[-, 0, +]:[6]:[ (x, y): -, (x, z):0, (y, z): +]
[-, -, +]:[9]:[ (x, y): -, (x, z): -, (y, z): +]
[+, +, 0]:[10]:[ (x, y): +, (x, z): +, (y, z):0]
[0, 0, 0]:[14]:[ (x, y):0, (x, z):0, (y, z):0]
[-, -, 0]:[18]:[ (x, y): -, (x, z): -, (y, z):0]
[+, +, -]:[19]:[ (x, y): +, (x, z): +, (y, z): -]
[+, 0, -]:[22]:[ (x, y): +, (x, z):0, (y, z): -]
[+, -, -]:[25]:[ (x, y): +, (x, z): -, (y, z): -]
[0, -, -]:[26]:[ (x, y):0, (x, z): -, (y, z): -]
[-, -, -]:[27]:[ (x, y): -, (x, z): -, (y, z): -]
No
*/
% alternative code for n.t.
% Note: It extracts the weak/strict order if we interpret
% 'either or' logically as 'disjunctive'/'exclusive or.'
is_not_negatively_transitive(R,[A,B,C]):-
alt(_:A),
alt(_:B),
alt(_:C),
p((A,B),R),
% \+ p((A,C),R), \+ p((C,B),R).
\+ either_or( p((A,C),R), p((C,B),R)).
either_or( F, G):- F, \+ G.
either_or( F, G):- \+ F, G.
is_negatively_transitive_1(R):-
\+ var(R),
\+ is_not_negatively_transitive(R,_).
/*
?- r_0(K,A,B,_,E),is_negatively_transitive_1(E),
nl,write(A:B),fail.
[0, +, +]:[ (x, y):0, (x, z): +, (y, z): +]
[-, 0, +]:[ (x, y): -, (x, z):0, (y, z): +]
[+, +, 0]:[ (x, y): +, (x, z): +, (y, z):0]
[0, 0, 0]:[ (x, y):0, (x, z):0, (y, z):0]
[-, -, 0]:[ (x, y): -, (x, z): -, (y, z):0]
[+, 0, -]:[ (x, y): +, (x, z):0, (y, z): -]
[0, -, -]:[ (x, y):0, (x, z): -, (y, z): -]
No
?- r_0(K,A,B,_,E),is_negatively_transitive_1(E),
nl,write([K]:A),fail.
[2]:[0, +, +]
[6]:[-, 0, +]
[10]:[+, +, 0]
[14]:[0, 0, 0]
[18]:[-, -, 0]
[22]:[+, 0, -]
[26]:[0, -, -]
No
?- r_0(K,A,B,_,E),is_negatively_transitive(E),
\+ is_negatively_transitive_1(E),nl,write([K]:A),fail.
[1]:[+, +, +]
[3]:[-, +, +]
[9]:[-, -, +]
[19]:[+, +, -]
[25]:[+, -, -]
[27]:[-, -, -]
No
?-
*/
% quasi-transitivity
is_not_q_trans(R,[A,B,C]):-
p((A,B),R),
p((B,C),R),
\+ p((A,C),R).
is_q_trans(R):-
\+ var(R),
\+ is_not_q_trans(R,_).
is_q_trans(R,T):-
is_q_trans(R)->T=q-trans;T=not(q-trans).
% maximality
has_a_maximal_choice(Z,R):-
alt(_:Z),
forall((alt(_:Y),Y\=Z),r((Z,Y),R)).
is_consistent(R,C):-
(\+ \+ has_a_maximal_choice(_,R)
->C=consistent
;C=inconsistent
).
% acyclic
has_a_cycle(R,C):-
\+ var(R),
cyclic_triple(C),
subset(C,R).
is_acyclic(R):-
\+ var(R),
\+ has_a_cycle(R,_).
cyclic_triple([(X,Y),(Y,Z),(Z,X)]).
cyclic_triple([(X,Y),(Z,X),(Y,Z)]).
/*
?- r_0(K,A,_,_,R),has_a_cycle(R,C),
nl,write([K]:A:C),fail.
[4]:[+, 0, +]:[ (x, y), (y, z), (z, x)]
[4]:[+, 0, +]:[ (x, y), (z, x), (y, z)]
[7]:[+, -, +]:[ (x, y), (y, z), (z, x)]
[7]:[+, -, +]:[ (x, y), (z, x), (y, z)]
[12]:[-, +, 0]:[ (y, x), (x, z), (z, y)]
[12]:[-, +, 0]:[ (y, x), (z, y), (x, z)]
[13]:[+, 0, 0]:[ (x, y), (y, z), (z, x)]
[13]:[+, 0, 0]:[ (x, y), (z, x), (y, z)]
[15]:[-, 0, 0]:[ (y, x), (x, z), (z, y)]
[15]:[-, 0, 0]:[ (y, x), (z, y), (x, z)]
[16]:[+, -, 0]:[ (x, y), (y, z), (z, x)]
[16]:[+, -, 0]:[ (x, y), (z, x), (y, z)]
[21]:[-, +, -]:[ (y, x), (x, z), (z, y)]
[21]:[-, +, -]:[ (y, x), (z, y), (x, z)]
[24]:[-, 0, -]:[ (y, x), (x, z), (z, y)]
[24]:[-, 0, -]:[ (y, x), (z, y), (x, z)]
No
?-
*/
% condition PI, IP, II, and PP:
% See Sen(1982), p.119, for the definition, and the theorems I.
condition_PI(S):-
\+ var(S),
\+ violates_condition_PI(S,_).
violates_condition_PI(S,(X,Y,Z)):-
p((X,Y),S),
i((Y,Z),S),
\+ p((X,Z),S).
% IP <==> PI
condition_IP(S):-
\+ var(S),
\+ violates_condition_IP(S,_).
violates_condition_IP(S,(X,Y,Z)):-
i((X,Y),S),
p((Y,Z),S),
\+ p((X,Z),S).
% PI==>II
condition_II(S):-
\+ var(S),
\+ violates_condition_II(S,_).
violates_condition_II(S,(X,Y,Z)):-
i((X,Y),S),
i((Y,Z),S),
\+ i((X,Z),S).
% PP <==> quasi-transitivity
% PP & II ==> PI
% PP & PI ==> transitivity
condition_PP(S):-
\+ var(S),
\+ violates_condition_PP(S,_).
violates_condition_PP(S,(X,Y,Z)):-
p((X,Y),S),
p((Y,Z),S),
\+ p((X,Z),S).
/*
% verifying the strict preference relations in consistent orderings.
?- gen_consistent_r(A,B,D),write(A),
forall(p(Z,D),write([Z])),nl,fail.
[+, +, +][ (x, y)][ (x, z)][ (y, z)]
[0, +, +][ (x, z)][ (y, z)]
[-, +, +][ (y, x)][ (x, z)][ (y, z)]
[+, 0, +][ (x, y)][ (y, z)]
[0, 0, +][ (y, z)]
[-, 0, +][ (y, x)][ (y, z)]
[0, -, +][ (z, x)][ (y, z)]
[-, -, +][ (y, x)][ (z, x)][ (y, z)]
[+, +, 0][ (x, y)][ (x, z)]
[0, +, 0][ (x, z)]
[-, +, 0][ (y, x)][ (x, z)]
[+, 0, 0][ (x, y)]
[-, 0, 0][ (y, x)]
[+, -, 0][ (x, y)][ (z, x)]
[0, -, 0][ (z, x)]
[-, -, 0][ (y, x)][ (z, x)]
[+, +, -][ (x, y)][ (x, z)][ (z, y)]
[0, +, -][ (x, z)][ (z, y)]
[+, 0, -][ (x, y)][ (z, y)]
[0, 0, -][ (z, y)]
[-, 0, -][ (y, x)][ (z, y)]
[+, -, -][ (x, y)][ (z, x)][ (z, y)]
[0, -, -][ (z, x)][ (z, y)]
[-, -, -][ (y, x)][ (z, x)][ (z, y)]
No
?-
*/
% making ( quasi-transitive) preference relations
%--------------------------------------------------------------
:- dynamic r_x/5, r_0/5, last_id_r_x/1, type_of_r_x/1.
last_id_r_x(0).
preference_type(consistent,'there exists a maximal choice').
preference_type(acyclic,'there exists a maximal choice').
preference_type(complete,'all complete binary relations').
preference_type(q-trans,'quasi-transitive orderings').
preference_type(weak,'weak preference relations').
preference_type(strict,'strict preference relations').
gen_r_x( T):-
init_r_x_preferences,
gen_r_x_firstly_as_complete_orderings,
extract_r_x_of_ordering_type( T),
gen_r_x_completion_message(T).
init_r_x_preferences:-
abolish( r_x/5),
abolish( last_id_r_x/1),
assert( last_id_r_x(0)).
gen_r_x_firstly_as_complete_orderings:-
forall(
gen_r(B,C,Q,R),
assert_r_x(B,C,Q,R)
),
backup_r_x_to_r_0.
extract_r_x_of_ordering_type( T):-
preference_type(T,_),
make_preference(T).
gen_r_x_completion_message(T):-
last_id_r_x(K),
nl,write(K),tab(1),write(T),
write(' orderings have been recovered in r_0/5.').
assert_r_x(B,C,Q,R):-
update_last_id_r_x(N),
assert(r_x(N,B,C,Q,R)).
update_last_id_r_x(N):-
retract(last_id_r_x(K)),
N is K +1,
assert(last_id_r_x(N)).
backup_r_x_to_r_0:-
abolish( r_0/5),
forall(
r_x(A,B,C,D,E),
assert(r_0(A,B,C,D,E))
).
% strict preference orderings
s(1,['+','+','+']).
s(2,['+','+','-']).
%s(c1,['+','-','+']).
s(3,['-','+','+']).
s(5,['+','-','-']).
%s(c2,['-','+','-']).
s(4,['-','-','+']).
s(6,['-','-','-']).
% additional weak preference orderings (transitive)
w(7,['0','+','+']).
w(8,['+','+','0']).
w(9,['+','0','-']).
w(10,['0','-','-']).
w(11,['-','-','0']).
w(12,['-','0','+']).
w(13,['0','0','0']).
/*
?- [sp06b1].
---orderings:[1][2][3][4][5][6][8][9][10][11][12][13][14][15][16][17][18][19][20][22][23][24][25][26][27]
25 orderings has updated in r_x/5.
25 consistent orderings have been recovered in r_0/5.
% sp06b1 compiled 0.01 sec, 11,160 bytes
Yes
% I think that we ought to verify a claim:
% An ordering is not quasi-transitive IF no maximal choices.
?- r_0(_,A,_,[_,Q,_],D),nl,write(A:Q),
has_a_maximal_choice(Z,D),write([Z]),fail.
[+, +, +]:q-trans[x]
[0, +, +]:q-trans[x][y]
[-, +, +]:q-trans[y]
[+, 0, +]:not(q-trans)[x]
[0, 0, +]:q-trans[x][y]
[-, 0, +]:q-trans[y]
[+, -, +]:not(q-trans)
[0, -, +]:not(q-trans)[y]
[-, -, +]:q-trans[y]
[+, +, 0]:q-trans[x]
[0, +, 0]:q-trans[x][y]
[-, +, 0]:not(q-trans)[y]
[+, 0, 0]:q-trans[x][z]
[0, 0, 0]:q-trans[x][y][z]
[-, 0, 0]:q-trans[y][z]
[+, -, 0]:not(q-trans)[z]
[0, -, 0]:q-trans[y][z]
[-, -, 0]:q-trans[y][z]
[+, +, -]:q-trans[x]
[0, +, -]:not(q-trans)[x]
[-, +, -]:not(q-trans)
[+, 0, -]:q-trans[x][z]
[0, 0, -]:q-trans[x][z]
[-, 0, -]:not(q-trans)[z]
[+, -, -]:q-trans[z]
[0, -, -]:q-trans[z]
[-, -, -]:q-trans[z]
No
?-
% And, incidentally, we also verify the cycles.
?- r_0(_,A,_,[_,Q,_],D),nl,write(A:Q),
has_a_cycle(D,C),write(C),fail.
[+, +, +]:q-trans
[0, +, +]:q-trans
[-, +, +]:q-trans
[+, 0, +]:not(q-trans)[ (x, y), (y, z), (z, x)][ (x, y), (z, x), (y, z)]
[0, 0, +]:q-trans
[-, 0, +]:q-trans
[+, -, +]:not(q-trans)[ (x, y), (y, z), (z, x)][ (x, y), (z, x), (y, z)]
[0, -, +]:not(q-trans)
[-, -, +]:q-trans
[+, +, 0]:q-trans
[0, +, 0]:q-trans
[-, +, 0]:not(q-trans)[ (y, x), (x, z), (z, y)][ (y, x), (z, y), (x, z)]
[+, 0, 0]:q-trans[ (x, y), (y, z), (z, x)][ (x, y), (z, x), (y, z)]
[0, 0, 0]:q-trans
[-, 0, 0]:q-trans[ (y, x), (x, z), (z, y)][ (y, x), (z, y), (x, z)]
[+, -, 0]:not(q-trans)[ (x, y), (y, z), (z, x)][ (x, y), (z, x), (y, z)]
[0, -, 0]:q-trans
[-, -, 0]:q-trans
[+, +, -]:q-trans
[0, +, -]:not(q-trans)
[-, +, -]:not(q-trans)[ (y, x), (x, z), (z, y)][ (y, x), (z, y), (x, z)]
[+, 0, -]:q-trans
[0, 0, -]:q-trans
[-, 0, -]:not(q-trans)[ (y, x), (x, z), (z, y)][ (y, x), (z, y), (x, z)]
[+, -, -]:q-trans
[0, -, -]:q-trans
[-, -, -]:q-trans
No
?-
?- r_0(A,B,C,D,E),nl,is_negatively_transitive(E),
write([A]),fail.
[2][4][5][6][7][8][10][11][12][13][14][15][16][17][18][20][21][22][23][24][26]
No
?- r_0(A,B,C,D,E),nl,is_transitive(E),
write([A]),fail.
[1][2][3][6][9][10][14][18][19][22][25][26][27]
No
?- make_preference(weak).
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?-
?- make_preference(q-trans).
---orderings:[1][2][3][5][6][9][10][11][13][14][15][17][18][19][22][23][25][26][27]
19 orderings has updated in r_x/5.
Yes
?- r_x(K,B,_,_,R),\+ (w(_,B);length(R,3)),nl,write(K;B;R),fail.
5;[0, 0, +];[ (x, y), (y, x), (x, z), (z, x), (y, z)]
11;[0, +, 0];[ (x, y), (y, x), (x, z), (y, z), (z, y)]
13;[+, 0, 0];[ (x, y), (x, z), (z, x), (y, z), (z, y)]
15;[-, 0, 0];[ (y, x), (x, z), (z, x), (y, z), (z, y)]
17;[0, -, 0];[ (x, y), (y, x), (z, x), (y, z), (z, y)]
23;[0, 0, -];[ (x, y), (y, x), (x, z), (z, x), (z, y)]
No
?-
*/
% switching strict/weak/quasi-transitive preference models
%--------------------------------------------------------------
% profile (pair) of rankings
pair_r_x((J,K):(A,B):(R,Q)):-
r_x(J,A,_,_,R),
r_x(K,B,_,_,Q).
d_pair_r_x((J,K):(A,B):(R,Q)):-
pair_r_x((J,K):(A,B):(R,Q)),
J < K.
is_consistent_r_x(A):-
r_x(_,A,_,_,D),
\+ no_maximal_choices(D).
% type of ordering (or preference) relations
r_x_preference_scheme(consistent,A,r_0(_,A,_,[consistent,_,_],_)).
r_x_preference_scheme(acyclic,A,r_0(_,A,_,[consistent,_,_],_)).
r_x_preference_scheme(complete,_,true).
r_x_preference_scheme(q-trans,A,r_0(_,A,_,[_,q-trans,_],_)).
r_x_preference_scheme(weak,A,(s(_,A);w(_,A))).
r_x_preference_scheme(strict,A,s(_,A)).
% :- dynamic r_0/5.
strict_ordering:-
make_preference(strict).
weak_ordering:-
make_preference(weak).
quasi_ordering:-
make_preference(q-trans).
linear_ordering:- strict_ordering.
strict_preference:- strict_ordering.
weak_preference:- weak_ordering.
quasi_transitive_preference:- quasi_ordering.
consistent_orderings:-
make_preference(consistent).
acyclic_orderings:-
make_preference(consistent).
complete_orderings:-
make_preference(complete).
make_preference(Type):-
r_x_preference_scheme(Type,A,Model),
abolish( type_of_r_x/1),
assert( type_of_r_x( Type)),
init_r_x_preferences,
nl,
write('---orderings:'),
forall(
(
r_0(K,A,B,C,D),
Model,
write([K])
),
(
assert(r_x(K,A,B,C,D)),
update_last_id_r_x(_)
)
),
last_id_r_x(N),
nl, write(N),
write(' orderings has updated in r_x/5.').
show_r_x:-
forall(
r_x(K,A,B,_,_),
(nl,write([K]:A:B))
).
% an initial process
:- gen_r_x(consistent).
/*
?- [sp06].
---orderings:[1][2][3][4][5][6][8][9][10][11][12][13][14][15][16][17][18][19][20][22][23][24][25][26][27]
25 orderings has updated in r_x/5.
25 consistent orderings have been recovered in r_0/5.
% sp06 compiled 0.00 sec, -200 bytes
Yes
?- make_preference(q-trans).
---orderings:[1][2][3][5][6][9][10][11][13][14][15][17][18][19][22][23][25][26][27]
19 orderings has updated in r_x/5.
Yes
?- weak_preference. % or {make_preference(weak),or gen_r_x(weak)}
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- strict_preference.
---orderings:[1][3][9][19][25][27]
have been added to preference model space as r_0/5.
Yes
?- show_r_x.
[1]:[+, +, +]:[ (x, y): +, (x, z): +, (y, z): +]
[3]:[-, +, +]:[ (x, y): -, (x, z): +, (y, z): +]
[9]:[-, -, +]:[ (x, y): -, (x, z): -, (y, z): +]
[19]:[+, +, -]:[ (x, y): +, (x, z): +, (y, z): -]
[25]:[+, -, -]:[ (x, y): +, (x, z): -, (y, z): -]
[27]:[-, -, -]:[ (x, y): -, (x, z): -, (y, z): -]
Yes
?-
% verify the strict preference relations (i.e., strong orderings)
?- r_0(K,A,_,_,X),\+ i(_,X),is_transitive(X),nl,write([K]:A:X),fail.
[1]:[+, +, +]:[ (x, y), (x, z), (y, z)]
[3]:[-, +, +]:[ (y, x), (x, z), (y, z)]
[9]:[-, -, +]:[ (y, x), (z, x), (y, z)]
[19]:[+, +, -]:[ (x, y), (x, z), (z, y)]
[25]:[+, -, -]:[ (x, y), (z, x), (z, y)]
[27]:[-, -, -]:[ (y, x), (z, x), (z, y)]
No
?-
% verify the weak preference relations (i.e., orderings)
?- r_x(K,A,_,_,X),\+ is_transitive(X),nl,write([K]:A:X),
is_not_transitive(X,Y),write(Y),fail.
No
?- r_0(K,A,_,_,X),\+ is_transitive(X),nl,write([K]:A:X),
is_not_transitive(X,Y),write(Y),fail.
[4]:[+, 0, +]:[ (x, y), (x, z), (z, x), (y, z)][z, x, y][y, z, x]
[5]:[0, 0, +]:[ (x, y), (y, x), (x, z), (z, x), (y, z)][z, x, y]
[7]:[+, -, +]:[ (x, y), (z, x), (y, z)][x, y, z][z, x, y][y, z, x]
[8]:[0, -, +]:[ (x, y), (y, x), (z, x), (y, z)][x, y, z][z, x, y]
[11]:[0, +, 0]:[ (x, y), (y, x), (x, z), (y, z), (z, y)][z, y, x]
[12]:[-, +, 0]:[ (y, x), (x, z), (y, z), (z, y)][x, z, y][z, y, x]
[13]:[+, 0, 0]:[ (x, y), (x, z), (z, x), (y, z), (z, y)][y, z, x]
[15]:[-, 0, 0]:[ (y, x), (x, z), (z, x), (y, z), (z, y)][x, z, y]
[16]:[+, -, 0]:[ (x, y), (z, x), (y, z), (z, y)][x, y, z][y, z, x]
[17]:[0, -, 0]:[ (x, y), (y, x), (z, x), (y, z), (z, y)][x, y, z]
[20]:[0, +, -]:[ (x, y), (y, x), (x, z), (z, y)][y, x, z][z, y, x]
[21]:[-, +, -]:[ (y, x), (x, z), (z, y)][y, x, z][x, z, y][z, y, x]
[23]:[0, 0, -]:[ (x, y), (y, x), (x, z), (z, x), (z, y)][y, x, z]
[24]:[-, 0, -]:[ (y, x), (x, z), (z, x), (z, y)][y, x, z][x, z, y]
No
?-
*/
% redefine preference relations
%--------------------------------------------------------------
r_x((X,X),R):-
alt(_:X),
r_x(_,R,_,_,_).
r_x((X,Y),R):-
r_x(_,R,_,_,Rb),
member((X,Y),Rb).
% strict relations
p_x((X,Y),R):-
r_x((X,Y),R),
\+ r_x((Y,X),R).
% indifference
i_x((X,Y),R):-
r_x((X,Y),R),
r_x((Y,X),R).
% unanimity quasi-ordering for two person
q_x((X,Y),(T,U)):-
r_x((X,Y),T),
r_x((X,Y),U).
q1_x((X,Y),(T,U)):-
p_x((X,Y),T),
p_x((X,Y),U).
% maximal element for r_x/5
is_maximal_x(R,X):-
alt(_:X),
\+ p_x((_,X),R).
% maximal element for r_0/5
is_maximal_under_ordering(R,X):-
r_0(_,R,_,_,B),
has_a_maximal_choice(X,B).
% analyzing binary patterns ( to be used in iia and pareto)
match_b_pair((X,Y),(T,U),(Tb,Ub)):-
bin_r_x((X,Y),T,Tb),
bin_r_x((X,Y),U,Ub).
bin_r_x((X,Y),R,Rxy):-
d_pair_alt(_:[X,Y]),
r_x(_,R,B,_,_),
member((X,Y):Rxy,B).
/*
% a demo
?- [sp06b1],strict_preference,
abolish(swf_0/3),abolish(chk_swf_0/3).
(...)
Yes
?- r_0(A,B,C,[inconsistent|D],E).
A = 7
B = [+, -, +]
C = [ (x, y): +, (x, z): -, (y, z): +]
D = [not(q-trans), complete]
E = [ (x, y), (z, x), (y, z)] ;
A = 21
B = [-, +, -]
C = [ (x, y): -, (x, z): +, (y, z): -]
D = [not(q-trans), complete]
E = [ (y, x), (x, z), (z, y)] ;
No
?-
*/
%--------------------------------------------------------------
% social welfare/ decision function (swf/sdf)
%--------------------------------------------------------------
all_d_pair_alt(L):-
findall((X,Y),d_pair_alt(_:[X,Y]),L).
all_pair_r_x(D):-
findall(A, pair_r_x(A:_:_), D).
% generating Arrow's swf (1):
% recursive construction of swf accumulating the binary patterns
%--------------------------------------------------------------
% added: 3 Sep 2006. a revised, and simplified code for Arrovean SWF.
:- dynamic permissible_swf_0/3.
init_permissible_swf_0:-
abolish( permissible_swf_0/3),
forall(
(
d_pair_alt(_:[X,Y]),
pair_r_x(_:P:_),
member(Z,['+','-','0'])
),
assert(permissible_swf_0((X,Y),P->Z,yes))
).
% initialize permissible swf
:- init_permissible_swf_0.
restrict_permissible_swf_0(pareto):-
permissible_swf_0((X,Y),(T,U)->S,yes),
violates_pareto_condition((X,Y),(T,U)->S,_,weak),
retract(permissible_swf_0((X,Y),(T,U)->S,yes)),
assert(permissible_swf_0((X,Y),(T,U)->S,no(p))),
fail.
restrict_permissible_swf_0(D_pattern):-
d_rule(D_pattern, Pair,Constraint,[J,(X,Y),(T,U)->S]),
Pair,
agent(J:_),
permissible_swf_0((X,Y),(T,U)->S,yes),
Constraint,
retract(permissible_swf_0((X,Y),(T,U)->S,yes)),
assert(permissible_swf_0((X,Y),(T,U)->S,no(d,J))),
fail.
restrict_permissible_swf_0(_).
d_rule(
decisive(J,(X,Y)),
true,
\+ is_decisive_at((X,Y),(T,U)->S,J),
[J,(X,Y),(T,U)->S]
).
d_rule(
decisive_at(PN:P,J,(X,Y)),
(pair_r_x(PN:P:_),P=(T,U)),
\+ is_decisive_at((X,Y),(T,U)->S,J),
[J,(X,Y),(T,U)->S]
).
d_rule(
decisive_at(PN:P,J,(X,Y),S),
(pair_r_x(PN:P:_),P=(T,U)),
\+ is_hemi_decisive_at((X,Y),(T,U)->S,J),
[J,(X,Y),(T,U)->S]
).
is_hemi_decisive_at((X,Y),(T,_)->'+',1):-
p((X,Y),T).
is_hemi_decisive_at((X,Y),(_,U)->'+',2):-
p((X,Y),U).
is_hemi_decisive_at((X,Y),(T,_)->'-',1):-
p((Y,X),T).
is_hemi_decisive_at((X,Y),(_,U)->'-',2):-
p((Y,X),U).
% SWF without enforcing the Pareto condition
a_swf(F,H):-
all_pair_r_x(D),
a_swf_r_1(D,F,H1),
sort(H1,H).
a_swf_r_1([],[],[]).
a_swf_r_1([(I,J)|D],[P->S|F],H1):-
pair_r_x((I,J):P:_),
a_swf_r_1(D,F,H0),
a_swf_at_profile(P->S,H),
accumulate_binary_patterns_and_check_iia(H0,H,H1).
accumulate_binary_patterns_and_check_iia(H0,H,H1):-
\+ violates_iia_in_accumulated_binary_patterns(H0,H),
accumulate_binary_patterns(H0,H,H1).
violates_iia_in_accumulated_binary_patterns(H0,H):-
member(XY:P->S,H0),
member(XY:P->T,H),
S \= T.
accumulate_binary_patterns(H0,H,H1):-
union(H0,H,H1).
a_swf_at_profile(P->S,H):-
all_d_pair_alt(L),
pair_r_x(_:P:_),
a_swf_r_2(L,P,S,H),
% is_transitive(S).
verify_swf_range_for(S,on).
% to change swf value type: switch_swf_range_type(M->O).
a_swf_r_2([],_,[],[]).
a_swf_r_2([(X,Y)|B],P,[S|G],[(X,Y):Pb->S|H]):-
a_swf_r_2(B,P,G,H),
permissible_swf_0((X,Y),P->S,yes),
match_b_pair((X,Y),P,Pb).
% to show the swf in table style -> show_a_swf/1,2
/*
?- a_swf(A,B),nl,nl,show_a_swf(A),nl,
bagof(P->S,member(X:P->S,B),L),nl,write(X:L),fail.
a_swf_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 3, 9, 19, 25, 27]
[-, +, +]=3:[1, 3, 9, 19, 25, 27]
[-, -, +]=9:[1, 3, 9, 19, 25, 27]
[+, +, -]=19:[1, 3, 9, 19, 25, 27]
[+, -, -]=25:[1, 3, 9, 19, 25, 27]
[-, -, -]=27:[1, 3, 9, 19, 25, 27]
(x, y):[ (+, + -> +), (+, - -> -), (-, + -> +), (-, - -> -)]
(x, z):[ (+, + -> +), (+, - -> -), (-, + -> +), (-, - -> -)]
(y, z):[ (+, + -> +), (+, - -> -), (-, + -> +), (-, - -> -)]
a_swf_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 1, 1, 1, 1, 1]
[-, +, +]=3:[3, 3, 3, 3, 3, 3]
[-, -, +]=9:[9, 9, 9, 9, 9, 9]
[+, +, -]=19:[19, 19, 19, 19, 19, 19]
[+, -, -]=25:[25, 25, 25, 25, 25, 25]
[-, -, -]=27:[27, 27, 27, 27, 27, 27]
(x, y):[ (+, + -> +), (+, - -> +), (-, + -> -), (-, - -> -)]
(x, z):[ (+, + -> +), (+, - -> +), (-, + -> -), (-, - -> -)]
(y, z):[ (+, + -> +), (+, - -> +), (-, + -> -), (-, - -> -)]
No
*/
% a code for testing the effect of gifting individual the right
% (decisiveness) and the demo
%--------------------------------------------------------------
d_test(J,P,XY,D_rule):-
agent(J:_),pair_r_x(P:_),P\=(Q,Q),
findall(XY,
(
d_test_generate_data(XY,D_rule),
\+ there_are_distinct_pair_of_swf(_,_)
),
W),
nl,write(P:J:W),fail.
there_are_distinct_pair_of_swf(A,C):-
a_swf(A,_B),
a_swf(C,_D),
A\=C.
d_test_generate_data(XY,D_rule):-
d_pair_alt(_:[X,Y]), XY=(X,Y),
init_permissible_swf_0,
restrict_permissible_swf_0(pareto),
restrict_permissible_swf_0(D_rule).
show_d_excluded_swf_0:-
setof(A:S,permissible_swf_0(A,B->S,no(d,_J)),L),
nl,write(B->L),fail.
show_d_excluded_swf_0.
test_swf_1:-
test_swf_1(strict).
test_swf_1(O):-
% [sp06b1],
[sp06d],
make_preference(O),
init_permissible_swf_0,
restrict_permissible_swf_0(pareto).
/*
?- test_swf_1.
---orderings:[1][2][3][4][5][6][8][9][10][11][12][13][14][15][16][17][18][19][20][22][23][24][25][26][27]
25 orderings has updated in r_x/5.
25 consistent orderings have been recovered in r_0/5.
% Redefined active procedure test_swf_1/0
% sp06b1 compiled 0.00 sec, 9,296 bytes
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- restrict_permissible_swf_0(decisive(1,(x,y))).
Yes
?- a_swf(A,B),nl,show_a_swf(A), fail.
a_swf_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 1, 1, 1, 1, 1]
[-, +, +]=3:[3, 3, 3, 3, 3, 3]
[-, -, +]=9:[9, 9, 9, 9, 9, 9]
[+, +, -]=19:[19, 19, 19, 19, 19, 19]
[+, -, -]=25:[25, 25, 25, 25, 25, 25]
[-, -, -]=27:[27, 27, 27, 27, 27, 27]
No
?- setof(A:S,permissible_swf_0(A,B->S,no(d,J)),L),nl,write(B->L),fail.
[+, +, +], [-, +, +]->[ (x, y): -, (x, y):0]
[+, +, +], [-, -, +]->[ (x, y): -, (x, y):0]
[+, +, +], [-, -, -]->[ (x, y): -, (x, y):0]
[-, +, +], [+, +, +]->[ (x, y): +, (x, y):0]
[-, +, +], [+, +, -]->[ (x, y): +, (x, y):0]
[-, +, +], [+, -, -]->[ (x, y): +, (x, y):0]
[-, -, +], [+, +, +]->[ (x, y): +, (x, y):0]
[-, -, +], [+, +, -]->[ (x, y): +, (x, y):0]
[-, -, +], [+, -, -]->[ (x, y): +, (x, y):0]
[+, +, -], [-, +, +]->[ (x, y): -, (x, y):0]
[+, +, -], [-, -, +]->[ (x, y): -, (x, y):0]
[+, +, -], [-, -, -]->[ (x, y): -, (x, y):0]
[+, -, -], [-, +, +]->[ (x, y): -, (x, y):0]
[+, -, -], [-, -, +]->[ (x, y): -, (x, y):0]
[+, -, -], [-, -, -]->[ (x, y): -, (x, y):0]
[-, -, -], [+, +, +]->[ (x, y): +, (x, y):0]
[-, -, -], [+, +, -]->[ (x, y): +, (x, y):0]
[-, -, -], [+, -, -]->[ (x, y): +, (x, y):0]
No
?- restrict_permissible_swf_0(decisive_at((1,9):_,1,(x,y))).
Yes
?- a_swf(A,B),nl,show_a_swf(A),fail.
a_swf_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 1, 1, 1, 1, 1]
[-, +, +]=3:[3, 3, 3, 3, 3, 3]
[-, -, +]=9:[9, 9, 9, 9, 9, 9]
[+, +, -]=19:[19, 19, 19, 19, 19, 19]
[+, -, -]=25:[25, 25, 25, 25, 25, 25]
[-, -, -]=27:[27, 27, 27, 27, 27, 27]
No
?- setof(A:S,permissible_swf_0(A,B->S,no(d,J)),L),nl,write(B->L),fail.
[+, +, +], [-, -, +]->[ (x, y): -, (x, y):0]
No
?-
% Show all distinct alt-pairs (and profiles) for which
% giving the decisiveness for/against x/y to the first agent 1
% locally at a profile of individual preferences makes no
% choice of the society to avoid dictatorial SWF.
?- J=1, D_rule=decisive_at(P:_,J,XY),d_test(J,P,XY,D_rule).
(1, 3):1:[ (x, y)]
(1, 9):1:[ (x, y), (x, z)]
(1, 19):1:[ (y, z)]
(1, 25):1:[ (x, z), (y, z)]
(1, 27):1:[ (x, y), (x, z), (y, z)]
(3, 1):1:[ (x, y)]
(3, 9):1:[ (x, z)]
(3, 19):1:[ (x, y), (y, z)]
(3, 25):1:[ (x, y), (x, z), (y, z)]
(3, 27):1:[ (x, z), (y, z)]
(9, 1):1:[ (x, y), (x, z)]
(9, 3):1:[ (x, z)]
(9, 19):1:[ (x, y), (x, z), (y, z)]
(9, 25):1:[ (x, y), (y, z)]
(9, 27):1:[ (y, z)]
(19, 1):1:[ (y, z)]
(19, 3):1:[ (x, y), (y, z)]
(19, 9):1:[ (x, y), (x, z), (y, z)]
(19, 25):1:[ (x, z)]
(19, 27):1:[ (x, y), (x, z)]
(25, 1):1:[ (x, z), (y, z)]
(25, 3):1:[ (x, y), (x, z), (y, z)]
(25, 9):1:[ (x, y), (y, z)]
(25, 19):1:[ (x, z)]
(25, 27):1:[ (x, y)]
(27, 1):1:[ (x, y), (x, z), (y, z)]
(27, 3):1:[ (x, z), (y, z)]
(27, 9):1:[ (y, z)]
(27, 19):1:[ (x, y), (x, z)]
(27, 25):1:[ (x, y)]
No
?- J=1, D_rule=decisive_at(P:_,J,XY,'+'),d_test(J,P,XY,D_rule).
(1, 3):1:[ (x, y), (x, z), (y, z)]
(1, 9):1:[ (x, y), (x, z), (y, z)]
(1, 19):1:[ (x, y), (x, z), (y, z)]
(1, 25):1:[ (x, y), (x, z), (y, z)]
(1, 27):1:[ (x, y), (x, z), (y, z)]
(3, 1):1:[ (x, y), (x, z), (y, z)]
(3, 9):1:[ (x, z), (y, z)]
(3, 19):1:[ (x, y), (x, z), (y, z)]
(3, 25):1:[ (x, y), (x, z), (y, z)]
(3, 27):1:[ (x, z), (y, z)]
(9, 1):1:[ (x, y), (x, z), (y, z)]
(9, 3):1:[ (x, z), (y, z)]
(9, 19):1:[ (x, y), (x, z), (y, z)]
(9, 25):1:[ (x, y), (y, z)]
(9, 27):1:[ (y, z)]
(19, 1):1:[ (x, y), (x, z), (y, z)]
(19, 3):1:[ (x, y), (x, z), (y, z)]
(19, 9):1:[ (x, y), (x, z), (y, z)]
(19, 25):1:[ (x, y), (x, z)]
(19, 27):1:[ (x, y), (x, z)]
(25, 1):1:[ (x, y), (x, z), (y, z)]
(25, 3):1:[ (x, y), (x, z), (y, z)]
(25, 9):1:[ (x, y), (y, z)]
(25, 19):1:[ (x, y), (x, z)]
(25, 27):1:[ (x, y)]
(27, 1):1:[ (x, y), (x, z), (y, z)]
(27, 3):1:[ (x, z), (y, z)]
(27, 9):1:[ (y, z)]
(27, 19):1:[ (x, y), (x, z)]
(27, 25):1:[ (x, y)]
No
?- J=1, D_rule=decisive_at(P:_,J,XY,'-'),d_test(J,P,XY,D_rule).
(1, 3):1:[ (x, y)]
(1, 9):1:[ (x, y), (x, z)]
(1, 19):1:[ (y, z)]
(1, 25):1:[ (x, z), (y, z)]
(1, 27):1:[ (x, y), (x, z), (y, z)]
(3, 1):1:[ (x, y)]
(3, 9):1:[ (x, y), (x, z)]
(3, 19):1:[ (x, y), (y, z)]
(3, 25):1:[ (x, y), (x, z), (y, z)]
(3, 27):1:[ (x, y), (x, z), (y, z)]
(9, 1):1:[ (x, y), (x, z)]
(9, 3):1:[ (x, y), (x, z)]
(9, 19):1:[ (x, y), (x, z), (y, z)]
(9, 25):1:[ (x, y), (x, z), (y, z)]
(9, 27):1:[ (x, y), (x, z), (y, z)]
(19, 1):1:[ (y, z)]
(19, 3):1:[ (x, y), (y, z)]
(19, 9):1:[ (x, y), (x, z), (y, z)]
(19, 25):1:[ (x, z), (y, z)]
(19, 27):1:[ (x, y), (x, z), (y, z)]
(25, 1):1:[ (x, z), (y, z)]
(25, 3):1:[ (x, y), (x, z), (y, z)]
(25, 9):1:[ (x, y), (x, z), (y, z)]
(25, 19):1:[ (x, z), (y, z)]
(25, 27):1:[ (x, y), (x, z), (y, z)]
(27, 1):1:[ (x, y), (x, z), (y, z)]
(27, 3):1:[ (x, y), (x, z), (y, z)]
(27, 9):1:[ (x, y), (x, z), (y, z)]
(27, 19):1:[ (x, y), (x, z), (y, z)]
(27, 25):1:[ (x, y), (x, z), (y, z)]
No
?-
*/
% generating Arrow's swf (2):
% the binary decomposition
%--------------------------------------------------------------
init_swf(C,L,D):-
(var(C)->C=[i,p];true),
available_conditions_for_swf(AC),
subset(C,AC),
abolish( tentative_swf_0/2),
all_d_pair_alt(L),
all_pair_r_x(D).
available_conditions_for_swf([
t(_), % order type of the SWF range
c,i,p,ps, pL,d(_), % standard conditions
nd ,dz(_), % no dictator / decisiveness
l(_,_),l(_,_),l(_,_),lg(_), % liberalism
% NOTE: a goal subset([a(1),a(2)],[a(_)]) fails.
pv(_), npv % pivotality
]).
:- dynamic swf_0/3,tentative_swf_0/2.
:- dynamic chk_swf_0/3.
b_swf(F):-
b_swf(_,F).
b_swf(C,F):-
init_swf(C,L,D),
abolish(chk_swf_0/2),
b_swf_r(1,C,L,F,D,H),
%
assert(chk_swf_0(C, F,H)),
% chk_1_for_each_profile_swf_value(F,_),
% chk_2_for_each_profile_swf_value(F,H),
% chk_3_for_each_profile_swf_value(_,H),
save_and_clear_working_swf(C,F,H).
% user can modify the profile list optionally with a priority list
% (used for a debug )
b_swf_with_sort_option(C,F,O):-
init_swf(C,L,D0),
rearrange_profile_list(D0,O,D),
abolish(chk_swf_0/2),
b_swf_r(1,C,L,F,D,H),
%
assert(chk_swf_0(C, F,H)),
save_and_clear_working_swf(C,F,H).
rearrange_profile_list(D0,fast(O),D):-
subset(O,D0),
subtract(D0,O,D1),
reverse(O,O1),
append(D1,O1,D).
rearrange_profile_list(D0,sol(O),O):-
subset(O,D0).
% setting swf value with restrictions and recovering social order
%--------------------------------------------------------------
:- dynamic swf_range_type/2.
swf_range_type(current_domain,on).
swf_range_type(complete,off).
swf_range_type(consistent,off).
swf_range_type(q-trans,off).
switch_swf_range_type(_->O):-
\+ var(O),
swf_range_type(O,on).
switch_swf_range_type(M->O):-
swf_range_type(M,on),
swf_range_type(O,off),
commit_swap_swf_range_type(M->O).
commit_swap_swf_range_type(M->O):-
retract(swf_range_type(M,on)),
retract(swf_range_type(O,off)),
assert(swf_range_type(M,off)),
assert(swf_range_type(O,on)).
/*
% a demo
?- switch_swf_range_type(M->O).
M = q-trans
O = consistent
Yes
?- switch_debug_point(K, A->B).
K = 1
A = on
B = off
Yes
?-
*/
verify_swf_range_for(S,on):-
swf_range_type(O,on),
O \= current_domain,
!,
(O=complete->T=[_,_,complete];true),
(O=q-trans->T=[_,q-trans,_];true),
(O=consistent->T=[consistent,_,_];true),
r_0(_,S,_,T,_).
verify_swf_range_for(S,on):-
r_x(_,S,_,_,_).
is_swf_value_at_profile((X,Y),(T,U)->S,F):-
collect_binary_relations_in_swf_at((X,Y),F,(T,U)->S),
verify_swf_range_for(S,on).
collect_binary_relations_in_swf_at((X,Y),F,(T,U)->S):-
bagof(Sb,
(X^Y^G^
member((X,Y):G,F),
binary_relation_in_swf_at((X,Y),F,(T,U)->Sb)
),
S).
binary_relation_in_swf_at((X,Y),G,(T,U)->Sb):-
d_pair_alt(_:[X,Y]),
\+ member((X,Y):_,G),
member((T,U)->Sb,G).
% checking social orders
%--------------------------------------------------------------
% We can abuse is_swf_value_at_profile/3
% as an ex post analysis if an unbound alt pair (X,Y).
chk_1_for_each_profile_swf_value(F,[]):-
forall(
pair_r_x(_:(T,U):_),
is_swf_value_at_profile(_,(T,U)->_,F)
).
chk_2_for_each_profile_swf_value(F,H):-
(var(H)->collect_for_each_profile_swf_value(F,H);true),
\+ (
pair_r_x(_:(T,U):_),
\+ member( (T,U)->_, H)
).
collect_for_each_profile_swf_value(F,H):-
findall((T,U)->S,
(
pair_r_x(_:(T,U):_),
is_swf_value_at_profile(_,(T,U)->S,F)
),
H).
% for binary-global constraint for swf
chk_3_for_each_profile_swf_value(O,H):-
\+ var(H),
set_swf_order_type_if_it_differs(O),
\+ (
member( _->S, H),
\+ verify_swf_range_for(S,on)
).
set_swf_order_type_if_it_differs(O):-
swf_range_type(O,on),
!.
set_swf_order_type_if_it_differs(O):-
swf_range_type(M,on),
M \= O,
swf_range_type(O,off),
switch_swf_range_type(M->O).
% recursive satisfaction for the SWF-constraints
%--------------------------------------------------------------
% (It may be seen as the cumulative constraint solver)
b_swf_r(0,_,[],[],_,[]).
b_swf_r(I,C,[(X,Y)|B],[(X,Y):S|F],D,H):-
b_swf_r(0,C,B,F,D,P), %write(go),read(y),
gen_consistent_swf(C,(X,Y),D,S,P,H),
chk_global_constraints_for_xy(I,C,(X,Y),S,H),
debug_point(1,b_swf_r(C,(X,Y),D,S)).
:- dynamic parm_debug_point/2.
parm_debug_point(1, off).
switch_debug_point(K, A->B):-
member((A,B),[(on,off),(off,on)]),
retract(parm_debug_point(K, A)),
assert(parm_debug_point(K, B)).
debug_point(N,_):-
\+ parm_debug_point(N, on),
!.
debug_point(_,b_swf_r(C,(X,Y),_D,S)):-
nl,write(gen_consistent_swf(C)),show_swf((X,Y),S),
forall(is_decisive_swf((X,Y),S,J),write(d(J))),read(y).
gen_consistent_swf(_,_,[],[],P,P).
gen_consistent_swf(C,(X,Y),[(J,K)|L],[(T,U)->S|F],P,P2):-
gen_consistent_swf(C,(X,Y),L,F,P,P1),
is_consistent_b_swf(C,(X,Y),(J,K):(T,U)->S,F),
augmented_swf_with_new_binary_judge((T,U),S,P1,P2).
%assert_tentative_swf((X,Y):(T,U)->S, F).
augmented_swf_with_new_binary_judge(TU,S,P,[(TU->[S|B])|Q]):-
member(TU->_,P),
!,
subtract(P,[TU->B],Q).
augmented_swf_with_new_binary_judge(TU,S,P,[(TU->[S])|P]):-
(var(P)->P=[];true).
% verify respectively for each constraints
% (two-step constraint solver for each profile)
is_consistent_b_swf(C,(X,Y),(J,K):(T,U)->S,F):-
assign_swf_value_at_profile((X,Y),(J,K):(T,U)->S),
verify_each_conditions(C, (X,Y),(T,U)->S,F).
assign_swf_value_at_profile(_,(J,K):(T,U)->S):-
pair_r_x((J,K):(T,U):_),
B=['+','0','-'],
member(S,B).
% (step 1) accumulate local constraints at each profile
% by skipping global constraints
% (binary decomposition version)
verify_each_conditions([], _,_,_).
verify_each_conditions([E|C],(X,Y), (T,U)->Sb,F):-
\+ constraint(E,global,_),
check_consistency(E, (X,Y),(T,U)->Sb,F),
verify_each_conditions(C, (X,Y),(T,U)->Sb,F).
verify_each_conditions([E|C], (X,Y),(T,U)->Sb,F):-
constraint(E,global,_),
verify_each_conditions(C, (X,Y),(T,U)->Sb,F).
% (step 2) ex post analysis for globlal constraints
chk_global_constraints_for_xy(I,C,(X,Y),F,H):-
(member(t(O),C)->true;true),
(I=1->is_transitive_swf(O,F,H);true),
(member(c,C)->is_cs_swf((X,Y),F);true),
% (member(lg((X,Y),J),C)->is_liberal_swf((X,Y),F,J);true),
(member(nd,C)->(\+ is_dictatorial_swf((X,Y),F,_));true).
% (member(pv(J),C)->(is_pivotal_at((X,Y),_,F,J,_));true).
% managing constraints for swf
%--------------------------------------------------------------
% global/local constraints dictionary
constraint(t(_), global,last_binary). % order type of the SWF range
constraint(c, global,binary).
constraint(d1(_),global,intra_pair).
constraint(nd, global,binary).
constraint(pv(_),global,intra_pair).
% all other constraints are local.
% the checking sheets for local constraints
%--------------------------------------------------------------
% iia condition
check_consistency(i,(X,Y),(T,U)->S, F):-
is_iia_consistent_at((X,Y),(T,U)->S,F).
% pareto condition for linear ordering
check_consistency(pL,(X,Y),(T,U)->S, _):-
is_pareto_consistent_L_at((X,Y),(T,U)->S).
% pareto condition
check_consistency(p,(X,Y),(T,U)->S, _):-
is_pareto_consistent_at((X,Y),(T,U)->S).
% strict pareto condition
check_consistency(ps,(X,Y),(T,U)->S, _):-
is_strictly_pareto_consistent_at((X,Y),(T,U)->S).
% decisiveness for group
check_consistency(dz(V),(X,Y),(T,U)->S, _):-
is_decisive_for_xy_at((X,Y),(T,U)->S,V).
% decisiveness for group
check_consistency(dz(V),(X,Y),(T,U)->S, _):-
is_decisive_set_for_xy_at((X,Y),(T,U)->S,V).
% dictator-ship
check_consistency(d(J),(X,Y),(T,U)->S,_):-
is_decisive_at((X,Y),(T,U)->S,J).
% no pivotal voter constraint
check_consistency(np,(X,Y),(T,U)->S, F):-
is_no_pivotal_voters_at((X,Y),(T,U)->S,F).
% liberalism (decisiveness restricted for a pair )
check_consistency(l(J,(X,Y)),(X,Y),(T,U)->S,_):-
!,
is_decisive_at((X,Y),(T,U)->S,J).
check_consistency(l(J,(Y,X)),(X,Y),(T,U)->S,_):-
!,
is_decisive_at((X,Y),(T,U)->S,J).
check_consistency(l(_,_),_,_,_).
% the constraints for SWF
%--------------------------------------------------------------
% checking for social order legitimacy (global, last-binary)
is_transitive_swf(O,_,H):-
chk_3_for_each_profile_swf_value(O,H).
% citizen's sovereignty, or nonimposition
% ( global constraint)
is_cs_swf((X,Y),F):-
\+ violates_citizens_sovereignty(swf, (X,Y),F).
violates_citizens_sovereignty(swf, (X,Y),F):-
d_pair_alt(_:[X,Y]),
findall(B, member(_->B,F), P),
sort(P,P1),
(P1=['+']; P1=['-']).
% IIA condition
is_iia_consistent_at((X,Y),(T,U)->Sb,F):-
match_b_pair((X,Y),(T,U),(Tb,Ub)),
\+ violates_iia_condition(F,(X,Y),(Tb,Ub)->Sb).
violates_iia_condition(F,(X,Y),(Tb,Ub)->Sb):-
member((T1,U1)->S1,F),
match_b_pair((X,Y),(T1,U1),(Tb,Ub)),
S1 \= Sb.
% Pareto Condition ( local constraint)
% pareto condition for linear ordering
is_pareto_consistent_L_at((X,Y),(T,U)->S):-
\+ violates_pareto_condition_L((X,Y),(T,U)->S,_).
violates_pareto_condition_L((X,Y),(T,U)->S,B):-
match_b_pair((X,Y),(T,U),(B,B)),
S \= B.
% (weak /strict) pareto condition
is_pareto_consistent_at((X,Y),(T,U)->S):-
\+ violates_pareto_condition((X,Y),(T,U)->S,_,weak).
is_strictly_pareto_consistent_at((X,Y),(T,U)->S):-
\+ violates_pareto_condition((X,Y),(T,U)->S,_,strict).
violates_pareto_condition((X,Y),(T,U)->S,A,_):-
match_b_pair((X,Y),(T,U),(A,A)),
A \= '0',
S \= A.
violates_pareto_condition((X,Y),(T,U)->S,A,strict):-
match_b_pair((X,Y),(T,U),P),
member(P,[(A,'0'),('0',A)]),
member(A,['+','-']),
S \= A.
% decisiveness for subsets
% V=[1,2] => Pareto
% V=[I] => Dictatorial
is_decisive_set_for_xy_at((X,Y),(T,U)->Sb,V):-
match_b_pair((X,Y),(T,U),(Tb,Ub)),
coalition(V),
\+ (
member(Z,['+','0','-']),
forall(
member(J,V),
member((J,Z),[(1,Tb),(2,Ub)])
),
Sb \= Z,
Z \= '0'
).
% dictator-ship/decisiveness for individuals
% (global)
is_dictatorial_swf(F,J):-
agent(J:_),
forall(
d_pair_alt(_:[X,Y]),
(
member((X,Y):G,F),
is_decisive_swf((X,Y),G,J)
)
).
% (binary, global)
is_decisive_swf((X,Y),F,J):-
d_pair_alt(_:[X,Y]),
member((X,Y):G,F),
agent(J:_),
\+ (
member((T,U)->S,G),
\+ is_decisive_at((X,Y),(T,U)->S,J)
).
% (binary, local)
is_decisive_at((X,Y),(T,U)->Sb,J):-
agent(J:_),
member((J,Z),[(1,Tb),(2,Ub)]),
\+ (
% member(Z,['+','0','-']),
match_b_pair((X,Y),(T,U),(Tb,Ub)),
Sb \= Z,
Z \= '0'
).
% pivotality and local dictatorship at profile
% (global) under construction
is_locally_dictatorial_swf(F,J):-
agent(J:_),
forall(
d_pair_alt(_:[X,Y]),
is_pivotal_at((X,Y),_,F,J,_)
).
% (existentially local= global)
is_pivotal_at((X,Y),(T,U)->S,F,J,Wb):-
member((X,Y):G,F),
binary_relation_in_swf_at((X,Y),G,(T,U)->S),
agent(J:_),
is_unilaterally_change_at((X,Y),G,(T,U)->S,_->Wb,J),
Wb \= '0'.
is_unilaterally_change_at((X,Y),G,(T,U)->S,O->Wb,J):-
agent(J:_),
member((J,O,Ob),[
(1,(W,U),(Wb,Ub)),
(2,(T,W),(Tb,Wb))
]),
match_b_pair((X,Y),(T,U),(Tb,Ub)),
match_b_pair((X,Y),O,Ob),
Wb \= S,
Wb \= '0',
member(O->Wb,G).
% local
is_no_pivotal_voters_at((X,Y),(T,U)->S,F):-
\+ is_pivotal_at((X,Y),(T,U)->S,F,_,_).
/*
?- make_preference(strict).
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- b_swf([d(I)],F),show_swf(F),write(d(I)),
findall((J:(X,Y):W),is_pivotal_at((X,Y),(T,U)->S,F,J,W),L1),
sort(L1,L),nl,member(P,L),nl,write(pivotal:P),fail.
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[-, -, -, -, -, -]
[-, -, +]:9:[-, -, -, -, -, -]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[-, -, -, -, -, -]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[-, -, -, -, -, -]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[-, -, -, -, -, -]
[-, -, -]:27:[-, -, -, -, -, -]
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[-, -, -, -, -, -]
[+, -, -]:25:[-, -, -, -, -, -]
[-, -, -]:27:[-, -, -, -, -, -]d(1)
pivotal:1: (x, y): +
pivotal:1: (x, y): -
pivotal:1: (x, z): +
pivotal:1: (x, z): -
pivotal:1: (y, z): +
pivotal:1: (y, z): -
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, -, -, +, +, -]
[-, +, +]:3:[+, -, -, +, +, -]
[-, -, +]:9:[+, -, -, +, +, -]
[+, +, -]:19:[+, -, -, +, +, -]
[+, -, -]:25:[+, -, -, +, +, -]
[-, -, -]:27:[+, -, -, +, +, -]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, -, +, -, -]
[-, +, +]:3:[+, +, -, +, -, -]
[-, -, +]:9:[+, +, -, +, -, -]
[+, +, -]:19:[+, +, -, +, -, -]
[+, -, -]:25:[+, +, -, +, -, -]
[-, -, -]:27:[+, +, -, +, -, -]
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, -, -, -]
[-, +, +]:3:[+, +, +, -, -, -]
[-, -, +]:9:[+, +, +, -, -, -]
[+, +, -]:19:[+, +, +, -, -, -]
[+, -, -]:25:[+, +, +, -, -, -]
[-, -, -]:27:[+, +, +, -, -, -]d(2)
pivotal:2: (x, y): +
pivotal:2: (x, y): -
pivotal:2: (x, z): +
pivotal:2: (x, z): -
pivotal:2: (y, z): +
pivotal:2: (y, z): -
No
?-
*/
% tools of handling the experimental data
%--------------------------------------------------------------
exchange_pair_if_transposed((W,V),(X,Y)):-
\+ (var(W);var(V)),
d_pair_alt(_:[W,V]),
(X,Y)=(W,V).
exchange_pair_if_transposed((W,V),(X,Y)):-
\+ (var(W);var(V)),
d_pair_alt(_:[V,W]),
(X,Y)=(V,W).
% handling misspecification of the pair
% in local constraint chacking ( for liberalism)
assume_default_pair_if_unspecified((W,V)):-
\+ (var(W);var(V)),
!.
assume_default_pair_if_unspecified((x,y)):-
nl,
M=' the pair unspecified. I assume (x,y).',
write(M).
% assert tentative swf if not yet
assert_tentative_swf(A,F):-
clause( tentative_swf_0(A, F),_),
!.
assert_tentative_swf(A,F):-
assert( tentative_swf_0(A, F),_).
save_and_clear_working_swf(C,F,H):-
clause( swf_0(C,F,H),_),
abolish(tentative_swf_0/2),
!.
save_and_clear_working_swf(C,F,H):-
assert( swf_0(C,F,H)),
abolish(tentative_swf_0/2),
!.
% simple swf display in table-style
show_p_swf(_):-
a_swf_header(H),
write('a_swf_#cols':H),
fail.
show_p_swf(H):-
bagof(S,Q^
member((P,Q)->S,H),
L),
r_x(J,P,_,_,_),
nl,
write(P=J:L),
fail.
show_p_swf(_).
% swf display in table-style
show_a_swf(_):-
a_swf_header(H),
write('a_swf_#cols':H),
fail.
show_a_swf(H):-
bagof(K,Q^S^
a_swf_cell(H,(P,Q)->S,K),
L),
r_x(J,P,_,_,_),
nl,
write(P=J:L),
fail.
show_a_swf(_).
a_swf_header(H):-
findall(K,r_x(K,_,_,_,_),H).
a_swf_cell(H,(P,Q)->S,K):-
member((P,Q)->S,H),
r_0(K,S,_,_,_).
show_a_swf((X,Y),F):-
d_pair_alt(_:[X,Y]),
show_a_swf_xy((X,Y),F).
show_a_swf_xy((X,Y),_):-
a_swf_header((X,Y),H),
write('swf':(X,Y)),nl,
write(' cols':H),
fail.
show_a_swf_xy((X,Y),H):-
bagof(K,Q^S^
a_swf_cell((X,Y),H,(P,Q)->S,K),
L),
r_x(J,P,B,_,_),
member((X,Y):W,B),
nl,
write([W]:J:L),
fail.
show_a_swf_xy(_,_).
a_swf_header((X,Y),H):-
d_pair_alt(_:[X,Y]),
findall(W,
(
r_x(_,_,B,_,_),
member((X,Y):W,B)
),
H).
a_swf_cell((X,Y),H,(P,Q)->S,V):-
d_pair_alt(_:[X,Y]),
member((P,Q)->S,H),
r_0(_,S,B,_,_),
member((X,Y):V,B).
show_swf(H):-
var( H),
!,
write('please specify swf.').
show_swf(F):-
\+ var( F),
forall(
(
d_pair_alt(_:[X,Y])
),
show_swf((X,Y),F)
).
show_swf((X,Y),G):-
% d_pair_alt(_:[X,Y]),
member((X,Y):F,G),
show_swf_label_for((X,Y)),
forall(
(
b_swf_row(P,L,F)
),
(
r_x(K,P,_,_,_),
nl,write(P:K:L)
)
).
show_swf_label_for((X,Y)):-
nl,
findall(B,
(
r_x(_,_,S,_,_),
member((X,Y):B,S)
),
H),
nl,
write(pair:(X,Y):H),
nl,
write_line_15(2).
write_line_15(K):-
L='---------------',
length(A,K),
forall(member(L,A),write(L)).
b_swf_row(P,L,F):-
bagof(Sb,
(Q^
member((P,Q)->Sb,F)
),
L
).
% swf in table-style 2 shown by the numbers of order
show_a_swf_0(C,F):-
clause(swf_0(C,F,H0),_),
(H0=[]->collect_for_each_profile_swf_value(F,H);H=H0),
forall(
a_swf_row(P,L,H),
(r_x(K,P,_,_,_),nl,write(P:K:L))
).
a_swf_row(P,L,F):-
bagof(K,
(Q^S^G^H^X^W^Z^
pair_r_x(W:(P,Q):Z),
(member((P,Q)->S,F)->r_0(K,S,X,G,H);K='#')
),
L
).
% show the maximal elements
show_swf_0_max(C,F):-
clause(swf_0(C,F,H0),_),
(H0=[]->chk_2_for_each_profile_swf_value(F,H);H=H0),
forall(
a_swf_max_row(P,L,H),
(r_x(K,P,_,_,_),nl,write(P:K:L))
).
a_swf_max_row(P,L,F):-
bagof(M,
(Q^S^
member((P,Q)->S,F),
collect_maximals(S,M)
),
L
).
collect_maximals(S,M):-
findall(X,is_maximal_under_ordering(S,X),M1),
sort(M1,M).
collect_maximals_another_one(S,M):-
findall(X,is_maximal_under_ordering(S,X),M1),
subtract([x,y,z],M1,D),
(
M1 =[X] -> ('+',X)=M1;
M1 =[_,_] -> (D=[Y],M=('-',Y));
M =('+','*')
).
% demo
%--------------------------------------------------------------
/*
?- [sp06b1].
---orderings:[1][2][3][4][5][6][8][9][10][11][12][13][14][15][16][17][18][19][20][22][23][24][25][26][27]
25 orderings has updated in r_x/5.
25 consistent orderings have been recovered in r_0/5.
% sp06b1 compiled 0.00 sec, 9,344 bytes
Yes
?- strict_preference.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- [menu].
% menu compiled 0.00 sec, 18,784 bytes
Yes
?- stopwatch(b_swf([p,i],F),T),show_swf(F),fail.
% time elapsed (sec): 41.14
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, -, -, +, +, -]
[-, +, +]:3:[+, -, -, +, +, -]
[-, -, +]:9:[+, -, -, +, +, -]
[+, +, -]:19:[+, -, -, +, +, -]
[+, -, -]:25:[+, -, -, +, +, -]
[-, -, -]:27:[+, -, -, +, +, -]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, -, +, -, -]
[-, +, +]:3:[+, +, -, +, -, -]
[-, -, +]:9:[+, +, -, +, -, -]
[+, +, -]:19:[+, +, -, +, -, -]
[+, -, -]:25:[+, +, -, +, -, -]
[-, -, -]:27:[+, +, -, +, -, -]
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, -, -, -]
[-, +, +]:3:[+, +, +, -, -, -]
[-, -, +]:9:[+, +, +, -, -, -]
[+, +, -]:19:[+, +, +, -, -, -]
[+, -, -]:25:[+, +, +, -, -, -]
[-, -, -]:27:[+, +, +, -, -, -]
% time elapsed (sec): 124.671
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[-, -, -, -, -, -]
[-, -, +]:9:[-, -, -, -, -, -]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[-, -, -, -, -, -]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[-, -, -, -, -, -]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[-, -, -, -, -, -]
[-, -, -]:27:[-, -, -, -, -, -]
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[-, -, -, -, -, -]
[+, -, -]:25:[-, -, -, -, -, -]
[-, -, -]:27:[-, -, -, -, -, -]
No
?-
% compared with swf06.pl
?- make_preference(strict).
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- stopwatch(a_swf([p,i],F),T),show_swf(F),fail.
% time elapsed (sec): 0.0150001
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27]
% time elapsed (sec): 0.172
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27]
No
?- swf_0(A,B,C),show_swf(B),nl,fail.
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27]
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27]
No
?-
% When the range of social choice is relaxed to
% quasi-transitive order (q-trans) or consistent order,
% ----thereby SDF (Sen, 1982) we adopt instead of SWF (Arrow, 1963),
% nondictatorial rules are readily obtained.
?- abolish(swf_0/3).
Yes
?- switch_swf_range_type(_->q-trans).
Yes
?- b_swf([p,i],F),fail.
No
?- show_a_swf_0([p,i],F),nl,fail.
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27]
[+, +, +]:1:[1, 2, 5, 10, 13, 14]
[-, +, +]:3:[2, 3, 6, 11, 14, 15]
[-, -, +]:9:[5, 6, 9, 14, 17, 18]
[+, +, -]:19:[10, 11, 14, 19, 22, 23]
[+, -, -]:25:[13, 14, 17, 22, 25, 26]
[-, -, -]:27:[14, 15, 18, 23, 26, 27]
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27]
No
?- show_swf_0_max([p,i],F),nl,member(P:G,F),
is_decisive_swf(P,F,J),write(d(P:J)),nl,fail.
[+, +, +]:1:[[x], [y], [y], [x], [z], [z]]
[-, +, +]:3:[[x], [y], [y], [x], [z], [z]]
[-, -, +]:9:[[x], [y], [y], [x], [z], [z]]
[+, +, -]:19:[[x], [y], [y], [x], [z], [z]]
[+, -, -]:25:[[x], [y], [y], [x], [z], [z]]
[-, -, -]:27:[[x], [y], [y], [x], [z], [z]]
d((x, y):2)
d((x, z):2)
d((y, z):2)
[+, +, +]:1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]:3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]:9:[[x, y], [y], [y], [x, y, z], [y, z], [y, z]]
[+, +, -]:19:[[x], [x, y], [x, y, z], [x], [x, z], [x, z]]
[+, -, -]:25:[[x, z], [x, y, z], [y, z], [x, z], [z], [z]]
[-, -, -]:27:[[x, y, z], [y, z], [y, z], [x, z], [z], [z]]
[+, +, +]:1:[[x], [x], [x], [x], [x], [x]]
[-, +, +]:3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]:9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]:19:[[x], [x], [x], [x], [x], [x]]
[+, -, -]:25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]:27:[[z], [z], [z], [z], [z], [z]]
d((x, y):1)
d((x, z):1)
d((y, z):1)
No
% range of swf = complete
?- b_swf([l(1,(x,z))],F),!,member(P:_G,F),show_swf(P,F),
is_decisive_swf(P,F,J),write(d(J,P)),nl,fail.
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[+, +, +, +, +, +]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[-, -, -, -, -, -]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[-, -, -, -, -, -]
[-, -, -]:27:[-, -, -, -, -, -]d(1, (x, z))
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[+, +, +, +, +, +]
No
?- b_swf([l(2,(y,z))],F),!,member(P:_G,F),show_swf(P,F),
is_decisive_swf(P,F,J),write(d(J,P)),nl,fail.
pair: (x, y):[+, -, -, +, +, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[+, +, +, +, +, +]
pair: (x, z):[+, +, -, +, -, -]
------------------------------
[+, +, +]:1:[+, +, +, +, +, +]
[-, +, +]:3:[+, +, +, +, +, +]
[-, -, +]:9:[+, +, +, +, +, +]
[+, +, -]:19:[+, +, +, +, +, +]
[+, -, -]:25:[+, +, +, +, +, +]
[-, -, -]:27:[+, +, +, +, +, +]
pair: (y, z):[+, +, +, -, -, -]
------------------------------
[+, +, +]:1:[+, +, +, -, -, -]
[-, +, +]:3:[+, +, +, -, -, -]
[-, -, +]:9:[+, +, +, -, -, -]
[+, +, -]:19:[+, +, +, -, -, -]
[+, -, -]:25:[+, +, +, -, -, -]
[-, -, -]:27:[+, +, +, -, -, -]d(2, (y, z))
No
?- b_swf([l(1,(x,z)),l(2,(y,z))],G),!,member(P:H,G),
show_swf(P,G),is_decisive_swf(P,G,J),write(d(J,P)),nl,fail.
No
?-
% we have seen a liberal paradox without the condition P.
*/
% Other testings related to the Liberal Paradox
%--------------------------------------------------------------
% 31 Aug-2 Sep 2006
/*
?- abolish(swf_0/3).
Yes
?- b_swf([l(2,(x,y)),i,l(1,(x,z))],F),show_swf(F).
No
?- b_swf([l(2,(x,y)),p,l(1,(x,z))],F),show_swf(F).
Action (h for help) ? abort
% Execution Aborted
?- b_swf([l(2,(x,y)),l(1,(y,z))],F),show_swf(F).
Action (h for help) ? abort
% Execution Aborted
?- b_swf([l(2,(x,y)),i,l(1,(y,z))],F),show_swf(F).
No
?- abolish(swf_0/3).
Yes
?- b_swf([l(I,(x,y)),l(K,(x,z)),l(J,(y,z))],F),show_a_swf_0(C,F),
write('[I,J,K]='),write([I,K,J]),nl,write('---'),fail.
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27][I,J,K]=[1, 1, 1]
---
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27][I,J,K]=[2, 2, 2]
---
No
?-
?- switch_swf_range_type(M->O).
M = current_domain
O = complete
Yes
?- abolish(swf_0/3),
b_swf([l(I,(x,y)),l(K,(x,z)),l(J,(y,z))],F),show_a_swf_0(C,F),
write('[I,J,K]='),write([I,K,J]),nl,write('---'),fail.
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27][I,J,K]=[1, 1, 1]
---
[+, +, +]:1:[1, 3, 3, 1, 1, 3]
[-, +, +]:3:[1, 3, 3, 1, 1, 3]
[-, -, +]:9:[7, 9, 9, 7, 7, 9]
[+, +, -]:19:[19, 21, 21, 19, 19, 21]
[+, -, -]:25:[25, 27, 27, 25, 25, 27]
[-, -, -]:27:[25, 27, 27, 25, 25, 27][I,J,K]=[2, 1, 1]
---
[+, +, +]:1:[1, 1, 7, 1, 7, 7]
[-, +, +]:3:[3, 3, 9, 3, 9, 9]
[-, -, +]:9:[3, 3, 9, 3, 9, 9]
[+, +, -]:19:[19, 19, 25, 19, 25, 25]
[+, -, -]:25:[19, 19, 25, 19, 25, 25]
[-, -, -]:27:[21, 21, 27, 21, 27, 27][I,J,K]=[1, 2, 1]
---
[+, +, +]:1:[1, 3, 9, 1, 7, 9]
[-, +, +]:3:[1, 3, 9, 1, 7, 9]
[-, -, +]:9:[1, 3, 9, 1, 7, 9]
[+, +, -]:19:[19, 21, 27, 19, 25, 27]
[+, -, -]:25:[19, 21, 27, 19, 25, 27]
[-, -, -]:27:[19, 21, 27, 19, 25, 27][I,J,K]=[2, 2, 1]
---
[+, +, +]:1:[1, 1, 1, 19, 19, 19]
[-, +, +]:3:[3, 3, 3, 21, 21, 21]
[-, -, +]:9:[9, 9, 9, 27, 27, 27]
[+, +, -]:19:[1, 1, 1, 19, 19, 19]
[+, -, -]:25:[7, 7, 7, 25, 25, 25]
[-, -, -]:27:[9, 9, 9, 27, 27, 27][I,J,K]=[1, 1, 2]
---
[+, +, +]:1:[1, 1, 1, 19, 19, 19]
[-, +, +]:3:[3, 3, 3, 21, 21, 21]
[-, -, +]:9:[9, 9, 9, 27, 27, 27]
[+, +, -]:19:[1, 1, 1, 19, 19, 19]
[+, -, -]:25:[7, 7, 7, 25, 25, 25]
[-, -, -]:27:[9, 9, 9, 27, 27, 27][I,J,K]=[1, 1, 2]
---
[+, +, +]:1:[1, 3, 3, 19, 19, 21]
[-, +, +]:3:[1, 3, 3, 19, 19, 21]
[-, -, +]:9:[7, 9, 9, 25, 25, 27]
[+, +, -]:19:[1, 3, 3, 19, 19, 21]
[+, -, -]:25:[7, 9, 9, 25, 25, 27]
[-, -, -]:27:[7, 9, 9, 25, 25, 27][I,J,K]=[2, 1, 2]
---
[+, +, +]:1:[1, 1, 7, 19, 25, 25]
[-, +, +]:3:[3, 3, 9, 21, 27, 27]
[-, -, +]:9:[3, 3, 9, 21, 27, 27]
[+, +, -]:19:[1, 1, 7, 19, 25, 25]
[+, -, -]:25:[1, 1, 7, 19, 25, 25]
[-, -, -]:27:[3, 3, 9, 21, 27, 27][I,J,K]=[1, 2, 2]
---
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27][I,J,K]=[2, 2, 2]
---
No
?- switch_swf_range_type(M->O).
M = complete
O = consistent
Yes
?- abolish(swf_0/3),
b_swf([l(I,(x,y)),l(K,(x,z)),l(J,(y,z))],F),show_a_swf_0(C,F),
write('[I,J,K]='),write([I,K,J]),nl,write('---'),fail.
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27][I,J,K]=[1, 1, 1]
---
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27][I,J,K]=[2, 2, 2]
---
No
?- switch_swf_range_type(M->O).
M = consistent
O = q-trans
Yes
?- abolish(swf_0/3),
b_swf([l(I,(x,y)),l(K,(x,z)),l(J,(y,z))],F),show_a_swf_0(C,F),
write('[I,J,K]='),write([I,K,J]),nl,write('---'),fail.
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27][I,J,K]=[1, 1, 1]
---
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27][I,J,K]=[2, 2, 2]
---
No
?- switch_swf_range_type(M->O).
M = q-trans
O = current_domain
Yes
?- abolish(swf_0/3).
Yes
?- b_swf([p,i,l(I,(x,y)),l(J,(y,z))],F),show_a_swf_0(C,F),
write('[I,J]='),write([I,J]),nl,write('---'),fail.
[+, +, +]:1:[1, 1, 1, 1, 1, 1]
[-, +, +]:3:[3, 3, 3, 3, 3, 3]
[-, -, +]:9:[9, 9, 9, 9, 9, 9]
[+, +, -]:19:[19, 19, 19, 19, 19, 19]
[+, -, -]:25:[25, 25, 25, 25, 25, 25]
[-, -, -]:27:[27, 27, 27, 27, 27, 27][I,J]=[1, 1]
---
[+, +, +]:1:[1, 3, 9, 19, 25, 27]
[-, +, +]:3:[1, 3, 9, 19, 25, 27]
[-, -, +]:9:[1, 3, 9, 19, 25, 27]
[+, +, -]:19:[1, 3, 9, 19, 25, 27]
[+, -, -]:25:[1, 3, 9, 19, 25, 27]
[-, -, -]:27:[1, 3, 9, 19, 25, 27][I,J]=[2, 2]
---
No
?- switch_swf_range_type(_->consistent).
Yes
?- b_swf([p,i,l(I,(x,y)),l(J,(y,z))],F),write('[I,J]='),
write([I,J]),nl,fail.
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
No
?- switch_swf_range_type(M->q-trans).
M = consistent
Yes
?- b_swf([i,l(I,(x,y)),l(J,(y,z))],F),write('[I,J]='),
write([I,J]),nl,fail.
[I,J]=[1, 1]
[I,J]=[2, 2]
No
?- switch_swf_range_type(_->consistent).
Yes
?- b_swf([i,l(I,(x,y)),l(J,(y,z))],F),write('[I,J]='),
write([I,J]),nl,fail.
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[2, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[1, 1]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[1, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
[I,J]=[2, 2]
No
?- abolish(swf_0/3),
b_swf([i,l(I,(x,y)),l(J,(y,z))],F),I\=J,show_a_swf_0(_,F),
write([I,J]),nl,fail.
[+, +, +]:1:[4, 6, 6, 4, 4, 6]
[-, +, +]:3:[4, 6, 6, 4, 4, 6]
[-, -, +]:9:[4, 6, 6, 4, 4, 6]
[+, +, -]:19:[22, 24, 24, 22, 22, 24]
[+, -, -]:25:[22, 24, 24, 22, 22, 24]
[-, -, -]:27:[22, 24, 24, 22, 22, 24][2, 1]
[+, +, +]:1:[4, 4, 4, 22, 22, 22]
[-, +, +]:3:[6, 6, 6, 24, 24, 24]
[-, -, +]:9:[6, 6, 6, 24, 24, 24]
[+, +, -]:19:[4, 4, 4, 22, 22, 22]
[+, -, -]:25:[4, 4, 4, 22, 22, 22]
[-, -, -]:27:[6, 6, 6, 24, 24, 24][1, 2]
No
?-
% The following summarizes above result.
% OBSERVATION: There are two liberalism obeying consistent-valued SWF,
% with IIA and WITHOUT P,
% in the linear order domain of 2-person and 3-alternative.
?- switch_swf_range_type(_->consistent).
Yes
?- r_x(A,B,C,D,E),r((x,y),E),r((y,z),E),write([A]),fail.
[1]
No
?- r_x(A,B,C,D,E),r((z,x),E),r((y,z),E),write([A]),fail.
[9]
No
?- abolish(swf_0/3),abolish(chk_swf_0/3).
Yes
?- b_swf([p,l(I,(x,y)),l(J,(z,x))],F,sol([(1,9)])),show_a_swf_0(_,F),
write('[I,J]='),write([I,J]),nl,fail.
[+, +, +]:1:[#, #, 1, #, #, #]
[-, +, +]:3:[#, #, #, #, #, #]
[-, -, +]:9:[#, #, #, #, #, #]
[+, +, -]:19:[#, #, #, #, #, #]
[+, -, -]:25:[#, #, #, #, #, #]
[-, -, -]:27:[#, #, #, #, #, #][I,J]=[1, 1]
[+, +, +]:1:[#, #, 3, #, #, #]
[-, +, +]:3:[#, #, #, #, #, #]
[-, -, +]:9:[#, #, #, #, #, #]
[+, +, -]:19:[#, #, #, #, #, #]
[+, -, -]:25:[#, #, #, #, #, #]
[-, -, -]:27:[#, #, #, #, #, #][I,J]=[2, 1]
[+, +, +]:1:[#, #, 9, #, #, #]
[-, +, +]:3:[#, #, #, #, #, #]
[-, -, +]:9:[#, #, #, #, #, #]
[+, +, -]:19:[#, #, #, #, #, #]
[+, -, -]:25:[#, #, #, #, #, #]
[-, -, -]:27:[#, #, #, #, #, #][I,J]=[2, 2]
No
?- member(A,[1,3,9]),r_0(A,B,C,D,E).
A = 1
B = [+, +, +]
C = [ (x, y): +, (x, z): +, (y, z): +]
D = [consistent, q-trans, complete]
E = [ (x, y), (x, z), (y, z)] ;
A = 3
B = [-, +, +]
C = [ (x, y): -, (x, z): +, (y, z): +]
D = [consistent, q-trans, complete]
E = [ (y, x), (x, z), (y, z)] ;
A = 9
B = [-, -, +]
C = [ (x, y): -, (x, z): -, (y, z): +]
D = [consistent, q-trans, complete]
E = [ (y, x), (z, x), (y, z)] ;
No
?- abolish(swf_0/3),abolish(chk_swf_0/3).
Yes
?- b_swf([p,l(1,(x,y)),l(2,(z,x))],F,sol([(1,9)])),fail.
No
?-
% The above reproduced the proof of the impossibility of
% a Paretian liberal, i.e., the liberal paradox, by A. Sen(1970).
% Further inspection for all bottlenecks.
?- pair_r_x(P:_),d_pair_alt(_:[A,B]),d_pair_alt(_:[C,D]),[A,B]\=[C,D],
\+ b_swf([p,l(1,(A,B)),l(2,(C,D))],F,sol([P])),write('[A,B]='),
write([A,B]),write(' [C,D]='),write([C,D]),write(' P='),write(P),nl,fail.
[A,B]=[x, y] [C,D]=[x, z] P=1, 9
[A,B]=[y, z] [C,D]=[x, z] P=1, 25
[A,B]=[x, y] [C,D]=[y, z] P=3, 19
[A,B]=[x, z] [C,D]=[y, z] P=3, 27
[A,B]=[x, z] [C,D]=[x, y] P=9, 1
[A,B]=[y, z] [C,D]=[x, y] P=9, 25
[A,B]=[y, z] [C,D]=[x, y] P=19, 3
[A,B]=[x, z] [C,D]=[x, y] P=19, 27
[A,B]=[x, z] [C,D]=[y, z] P=25, 1
[A,B]=[x, y] [C,D]=[y, z] P=25, 9
[A,B]=[y, z] [C,D]=[x, z] P=27, 3
[A,B]=[x, y] [C,D]=[x, z] P=27, 19
No
?-
*/
% betweenness and single-peakedness of preference domain
%--------------------------------------------------------------
% 31 Aug 2006
y_is_between_x_and_z([X,Y,Z],R):-
p((X,Y),R),
p((Y,Z),R).
y_is_between_x_and_z([X,Y,Z],R):-
p((Z,Y),R),
p((Y,X),R).
:- dynamic spd_0/3.
is_single_peaked((K,S),B,D):-
abolish( spd_0/3),
findall(R,r_x(_,_,_,_,R),L),
is_strict_order(K,_,S),
gen_single_peaked_domain(S,L,B,D),
assert_spd_if_not_exist((K,S),B,D).
is_strict_order(K,R,E):-
s(_,R),
r_0(K,R,_,_,E).
gen_single_peaked_domain(_,[],[],[]).
gen_single_peaked_domain(S,[_|L],B,D):-
gen_single_peaked_domain(S,L,B,D).
gen_single_peaked_domain(S,[R|L],[K|B],[A|D]):-
gen_single_peaked_domain(S,L,B,D),
r_0(K,A,_,_,R),
\+ violates_single_peakedness(S,R,_).
violates_single_peakedness(S,R,[X,Y,Z]):-
y_is_between_x_and_z([X,Y,Z],S),
r((X,Y),R),
\+ p((Y,Z),R).
assert_spd_if_not_exist((K,S),B,D):-
clause( spd_0((K,S),B,D),_),
!.
assert_spd_if_not_exist((K,S),B,D):-
assert( spd_0((K,S),B,D)).
max_spd_0((K,S),B,D,N):-
spd_0((K,S),B,D),
length(B,N),
\+ (
spd_0(_,B1,_),
length(B1,N1),
N1>N
).
show_max_spd_0:-
max_spd_0((K,_),B,_,N),
nl,
write(('strict order'=[K],'domain':B,'len'=N)),
fail.
show_max_spd_0.
% demo
/*
?- r_0(A,B,C,D,E),\+ y_is_between_x_and_z(XYZ,E),nl,write([A]:B:C),fail.
[2]:[0, +, +]:[ (x, y):0, (x, z): +, (y, z): +]
[5]:[0, 0, +]:[ (x, y):0, (x, z):0, (y, z): +]
[6]:[-, 0, +]:[ (x, y): -, (x, z):0, (y, z): +]
[10]:[+, +, 0]:[ (x, y): +, (x, z): +, (y, z):0]
[11]:[0, +, 0]:[ (x, y):0, (x, z): +, (y, z):0]
[13]:[+, 0, 0]:[ (x, y): +, (x, z):0, (y, z):0]
[14]:[0, 0, 0]:[ (x, y):0, (x, z):0, (y, z):0]
[15]:[-, 0, 0]:[ (x, y): -, (x, z):0, (y, z):0]
[17]:[0, -, 0]:[ (x, y):0, (x, z): -, (y, z):0]
[18]:[-, -, 0]:[ (x, y): -, (x, z): -, (y, z):0]
[22]:[+, 0, -]:[ (x, y): +, (x, z):0, (y, z): -]
[23]:[0, 0, -]:[ (x, y):0, (x, z):0, (y, z): -]
[26]:[0, -, -]:[ (x, y):0, (x, z): -, (y, z): -]
No
?- strict_preference.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- r_x(A,B,C,D,E),y_is_between_x_and_z(XYZ,E),nl,write([A]:B:C;XYZ),fail.
[1]:[+, +, +]:[ (x, y): +, (x, z): +, (y, z): +];[x, y, z]
[1]:[+, +, +]:[ (x, y): +, (x, z): +, (y, z): +];[z, y, x]
[3]:[-, +, +]:[ (x, y): -, (x, z): +, (y, z): +];[y, x, z]
[3]:[-, +, +]:[ (x, y): -, (x, z): +, (y, z): +];[z, x, y]
[9]:[-, -, +]:[ (x, y): -, (x, z): -, (y, z): +];[y, z, x]
[9]:[-, -, +]:[ (x, y): -, (x, z): -, (y, z): +];[x, z, y]
[19]:[+, +, -]:[ (x, y): +, (x, z): +, (y, z): -];[x, z, y]
[19]:[+, +, -]:[ (x, y): +, (x, z): +, (y, z): -];[y, z, x]
[25]:[+, -, -]:[ (x, y): +, (x, z): -, (y, z): -];[z, x, y]
[25]:[+, -, -]:[ (x, y): +, (x, z): -, (y, z): -];[y, x, z]
[27]:[-, -, -]:[ (x, y): -, (x, z): -, (y, z): -];[z, y, x]
[27]:[-, -, -]:[ (x, y): -, (x, z): -, (y, z): -];[x, y, z]
No
?- is_single_peaked(_,_,_),fail.
No
?- show_max_spd_0.
strict order=[1], domain:[1, 3, 9, 27], len=4
strict order=[19], domain:[9, 19, 25, 27], len=4
strict order=[3], domain:[1, 3, 19, 25], len=4
strict order=[25], domain:[1, 3, 19, 25], len=4
strict order=[9], domain:[9, 19, 25, 27], len=4
strict order=[27], domain:[1, 3, 9, 27], len=4
No
?- weak_preference.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- is_single_peaked(_,_,_),fail.
No
?- show_max_spd_0.
strict order=[1], domain:[1, 2, 3, 6, 9, 18, 27], len=7
strict order=[19], domain:[9, 18, 19, 22, 25, 26, 27], len=7
strict order=[3], domain:[1, 2, 3, 10, 19, 22, 25], len=7
strict order=[25], domain:[1, 2, 3, 10, 19, 22, 25], len=7
strict order=[9], domain:[9, 18, 19, 22, 25, 26, 27], len=7
strict order=[27], domain:[1, 2, 3, 6, 9, 18, 27], len=7
No
?-
*/
%--------------------------------------------------------------
% other domain restrictions
%--------------------------------------------------------------
% 30 Oct - 1 Nov 2006
triple([X,Y,Z]):-
alt(_:X),
alt(_:Y),
alt(_:Z).
distinct_triple([X,Y,Z]):-
d_triple([X,Y,Z]).
d_triple([X,Y,Z]):-
triple([X,Y,Z]),
sort([X,Y,Z],[_,_,_]).
d_ordered_triple([X,Y,Z]):-
d_o_triple([X,Y,Z]).
d_o_triple([X,Y,Z]):-
triple([X,Y,Z]),
sort([X,Y,Z],[X,Y,Z]).
is_concerned_for(XYZ,K,R):-
(var(XYZ)->d_triple(XYZ);true),
r_0(K,R,_,_,B),
\+ is_not_concerned_for(XYZ,K,R,B).
is_not_concerned_for([X,Y,Z],K,R,B):-
(var(B)->r_0(K,R,_,_,B);true),
((var(X);var(Y);var(Z))->d_triple([X,Y,Z]);true),
i((X,Y),B),
i((X,Z),B),
i((Y,Z),B).
/*
?- is_not_concerned_for(XYZ,K,R,_),nl,write(XYZ;K;R),fail.
[x, y, z];14;[0, 0, 0]
[x, z, y];14;[0, 0, 0]
[y, x, z];14;[0, 0, 0]
[y, z, x];14;[0, 0, 0]
[z, x, y];14;[0, 0, 0]
[z, y, x];14;[0, 0, 0]
No
?-
*/
% value restriction (exclusion constraints)
%--------------------------------------------------------------
% See Sen(1969), Inada(1969)
filter_domain_value(S,W,XYZ,RL):-
d_triple(XYZ),
value_type_in_triple( S),
alt(_:W),
setof( K,
A^B^C^D^(
r_0(K,A,B,C,D),
is_concerned_for(XYZ,K,A),
value( S,W,XYZ,D)
),
RL).
filter_domain_value_r_x(S,W,XYZ,RL):-
filter_domain_value(S,W,XYZ,RL0),
setof( K,
A^B^C^D^(
r_x(K,A,B,C,D),
member(K,RL0)
),
RL).
% value restricted domain w.r.t. current domain
virtual_domain_of_value_restricted(NS,W,XYZ,RLv):-
filter_domain_value(NS,W,XYZ,RL),
findall(K,
(
r_x(K,_,_,_,_),
\+ member(K,RL)
),
RLv).
make_domain_value_restricted(NS,W,XYZ,RL):-
virtual_domain_of_value_restricted(NS,W,XYZ,RL),
abolish(r_x/5),
forall(
(
r_0(K,A,B,C,D),
member(K,RL)
),
assert(r_x(K,A,B,C,D))
).
value_type_in_triple( worst).
value_type_in_triple( best).
value_type_in_triple( medium).
value( worst,W,[X,Y,Z],R):-
d_triple([X,Y,Z]),
member(W,[X,Y,Z]),
r((X,W),R),
r((Y,W),R),
r((Z,W),R).
value( best,W,[X,Y,Z],R):-
d_triple([X,Y,Z]),
member(W,[X,Y,Z]),
r((W,X),R),
r((W,Y),R),
r((W,Z),R).
value( medium,W,[X,Y,Z],R):-
d_triple([X,Y,Z]),
member(W,[X,Y,Z]),
subtract([X,Y,Z],[W],[A,B]),
r_0(_,_,_,_,R),
(
(\+ p((W,A),R), \+ p((B,W),R))
;
(\+ p((W,B),R), \+ p((A,W),R))
).
% incorrect 1
% \+ value( best,W,[X,Y,Z],R),
% \+ value( worst,W,[X,Y,Z],R).
% incorrect 2
% \+ \+ (member(H,[X,Y,Z]), p((W,H),R)),
% \+ \+ (member(H,[X,Y,Z]), p((H,W),R)).
% a demo (30 Oct -- 1 Nov 2006)
%--------------------------------------------------------------
/*
?- linear_ordering.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- filter_domain_value_r_x(S,W,XYZ,RL),XYZ=[x,y,z],
nl,write(S:W:RL;XYZ),fail.
worst:x:[9, 27]
worst:y:[19, 25]
worst:z:[1, 3]
best:x:[1, 19]
best:y:[3, 9]
best:z:[25, 27]
medium:x:[3, 25]
medium:y:[1, 27]
medium:z:[9, 19]
No
?- virtual_domain_of_value_restricted(S,W,XYZ,RL),XYZ=[x,y,z],
nl,write(S:W:XYZ;RL),fail.
not(worst):x:[x, y, z];[1, 3, 19, 25]
not(worst):y:[x, y, z];[1, 3, 9, 27]
not(worst):z:[x, y, z];[9, 19, 25, 27]
not(best):x:[x, y, z];[3, 9, 25, 27]
not(best):y:[x, y, z];[1, 19, 25, 27]
not(best):z:[x, y, z];[1, 3, 9, 19]
not(medium):x:[x, y, z];[1, 9, 19, 27]
not(medium):y:[x, y, z];[3, 9, 19, 25]
not(medium):z:[x, y, z];[1, 3, 25, 27]
No
?- weak_preference.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- r_x(K,A,_,_,R),nl,write([K]:A),XYZ=[x,y,z],
setof(W,value( S,W,XYZ,R),L),tab(1),write(S:L),fail.
[1]:[+, +, +] worst:[z] best:[x] medium:[y]
[2]:[0, +, +] worst:[z] best:[x, y] medium:[x, y]
[3]:[-, +, +] worst:[z] best:[y] medium:[x]
[6]:[-, 0, +] worst:[x, z] best:[y] medium:[x, z]
[9]:[-, -, +] worst:[x] best:[y] medium:[z]
[10]:[+, +, 0] worst:[y, z] best:[x] medium:[y, z]
[14]:[0, 0, 0] worst:[x, y, z] best:[x, y, z] medium:[x, y, z]
[18]:[-, -, 0] worst:[x] best:[y, z] medium:[y, z]
[19]:[+, +, -] worst:[y] best:[x] medium:[z]
[22]:[+, 0, -] worst:[y] best:[x, z] medium:[x, z]
[25]:[+, -, -] worst:[y] best:[z] medium:[x]
[26]:[0, -, -] worst:[x, y] best:[z] medium:[x, y]
[27]:[-, -, -] worst:[x] best:[z] medium:[y]
No
?- filter_domain_value_r_x(S,W,XYZ,RL),XYZ=[x,y,z],
nl,write(S:W:RL),fail.
worst:x:[6, 9, 18, 26, 27]
worst:y:[10, 19, 22, 25, 26]
worst:z:[1, 2, 3, 6, 10]
best:x:[1, 2, 10, 19, 22]
best:y:[2, 3, 6, 9, 18]
best:z:[18, 22, 25, 26, 27]
medium:x:[2, 3, 6, 22, 25, 26]
medium:y:[1, 2, 10, 18, 26, 27]
medium:z:[6, 9, 10, 18, 19, 22]
No
?- virtual_domain_of_value_restricted(S,W,XYZ,RL),XYZ=[x,y,z],
nl,write(S:W:XYZ;RL),fail.
worst:x:[x, y, z];[1, 2, 3, 10, 14, 19, 22, 25]
worst:y:[x, y, z];[1, 2, 3, 6, 9, 14, 18, 27]
worst:z:[x, y, z];[9, 14, 18, 19, 22, 25, 26, 27]
best:x:[x, y, z];[3, 6, 9, 14, 18, 25, 26, 27]
best:y:[x, y, z];[1, 10, 14, 19, 22, 25, 26, 27]
best:z:[x, y, z];[1, 2, 3, 6, 9, 10, 14, 19]
medium:x:[x, y, z];[1, 9, 10, 14, 18, 19, 27]
medium:y:[x, y, z];[3, 6, 9, 14, 19, 22, 25]
medium:z:[x, y, z];[1, 2, 3, 14, 25, 26, 27]
No
?- make_domain_value_restricted(S,W,XYZ,RL),XYZ=[x,y,z],
nl,write(S:W:RL),fail.
worst:x:[1, 2, 3, 10, 14, 19, 22, 25]
worst:y:[1, 2, 3, 14]
worst:z:[14]
best:x:[14]
best:y:[14]
best:z:[14]
medium:x:[14]
medium:y:[14]
medium:z:[14]
No
?- weak_ordering.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?-
*/
% cyclical indifference
%--------------------------------------------------------------
% See Salles(1975)
% And see also Gaertner(2002), p.44.
filter_for_cyclical_indifferent(pattern(J),XYZ,RL):-
d_triple(XYZ),
member(J,[1,2]),
findall(K,
(
r_0(K,R,_,_,_),
cyclical_indifference(pattern(J,_),R,XYZ)
),
RL),
RL \= [].
% cyclical independence domain w.r.t. current domain
virtual_domain_of_cyclical_indifference(pattern(J),XYZ,RLv):-
filter_for_cyclical_indifferent(pattern(J),XYZ,RL),
findall(K,
(
member(K,RL),
r_x(K,_,_,_,_)
),
RLv).
:- dynamic r_x_reserved/5.
reserve_r_x:-
abolish(r_x_reserved/5),
r_x(K,A,B,C,D),
assert(r_x_reserved(K,A,B,C,D)),
fail.
reserve_r_x.
make_domain_cyclical_indifferent(pattern(J),XYZ,RL):-
filter_for_cyclical_indifferent(pattern(J),XYZ,RL),
reserve_r_x,
forall(r_x(K,R,A,B,C),
(
\+ member(K,RL),
retract(r_x(K,R,A,B,C))
)
).
cyclical_indifference(pattern(J),XYZ):-
d_triple(XYZ),
member(J,[1,2]),
\+ \+ (
r_x(_,R,_,_,_),
cyclical_indifference(pattern(J,_),R,XYZ)
),
\+ (
r_x(_,R,_,_,_),
\+ cyclical_indifference(pattern(J,_),R,XYZ)
).
cyclical_indifference(pattern(1,a),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
i((X,Y),Rb),
p((Y,Z),Rb).
cyclical_indifference(pattern(1,b),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
i((Y,Z),Rb),
p((Z,X),Rb).
cyclical_indifference(pattern(1,c),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
i((Z,X),Rb),
p((X,Y),Rb).
cyclical_indifference(pattern(2,a),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
p((X,Y),Rb),
i((Y,Z),Rb).
cyclical_indifference(pattern(2,b),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
p((Y,Z),Rb),
i((Z,X),Rb).
cyclical_indifference(pattern(2,c),R,[X,Y,Z]):-
r_0(_,R,_,_,Rb),
p((Z,X),Rb),
i((X,Y),Rb).
% a demo (30 Oct -- 1 Nov 2006)
%--------------------------------------------------------------
/*
?- weak_preference.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
% generating without commit to r_x/5
?- filter_for_cyclical_indifferent(pattern(1),XYZ,RL),XYZ=[x,y,z].
XYZ = [x, y, z]
RL = [2, 4, 5, 8, 13, 16, 17, 18, 22]
Yes
?- filter_for_cyclical_indifferent(pattern(2),XYZ,RL),XYZ=[x,y,z].
XYZ = [x, y, z]
RL = [4, 5, 6, 8, 10, 13, 16, 17, 26]
Yes
?- virtual_domain_of_cyclical_indifference(pattern(1),XYZ,RL),XYZ=[x,y,z].
XYZ = [x, y, z]
RL = [2, 18, 22]
Yes
?- virtual_domain_of_cyclical_indifference(pattern(2),XYZ,RL),XYZ=[x,y,z].
XYZ = [x, y, z]
RL = [6, 10, 26]
Yes
?-
% commit to r_x/5
?- make_domain_cyclical_indifferent(pattern(J),XYZ,RL),XYZ=[x,y,z].
J = 1
XYZ = [x, y, z]
RL = [2, 4, 5, 8, 13, 16, 17, 18, 22] ;
J = 2
XYZ = [x, y, z]
RL = [4, 5, 6, 8, 10, 13, 16, 17, 26] ;
No
?-
*/
% dichotonomous preference
%--------------------------------------------------------------
% See Inada(1969), see also Salles(1976).
dichotonomous_preference:-
\+ is_total_indifferent_pair_in_triple(_,_,_).
is_indifferent_for_pair_in_triple(K,R,(X,Y)):-
d_pair_alt(_:[X,Y]),
r_0(K,R,_,_,B),
i((X,Y),B).
is_total_indifferent_pair_in_triple((X,Y),RP,XYZ):-
d_triple(XYZ),
member(X,XYZ),
member(Y,XYZ),
X \= Y,
find_profile_in_r_i_if_unspecified(RP),
RP=(_:R1,_:R2,_:R3),
\+ (
member(K,[R1,R2,R3]),
is_indifferent_for_pair_in_tripler_x(K,_,(X,Y))
).
/*
?- setof(K,R^is_indifferent_for_pair_in_triple(K,R,XY),L),nl,write(XY:L),fail.
(x, y):[2, 5, 8, 11, 14, 17, 20, 23, 26]
(x, z):[4, 5, 6, 13, 14, 15, 22, 23, 24]
(y, z):[10, 11, 12, 13, 14, 15, 16, 17, 18]
No
?-
*/
% individual admissible domain
%--------------------------------------------------------------
:- dynamic r_i/2.
make_individually_admissible_domain(N,RP,CON):-
set_of_agents(N),
findall(K, r_x(K,_,_,_,_), L),
profile_of_admissible_domain(CON,N,L,RP),
abolish( r_i/2),
forall(member((J:R),RP),assert(r_i(J,R))).
profile_of_admissible_domain(_,[],_,[]).
profile_of_admissible_domain(free,[J|N],L,[J:R|P]):-
profile_of_admissible_domain(free,N,L,P),
list_projection(_,L,R),
R \= [].
profile_of_admissible_domain(vr(S,W,T),[J|N],L,[J:R|P]):-
profile_of_admissible_domain(vr(S,W,T),N,L,P),
virtual_domain_of_value_restricted(S,W,T,RL),
list_projection(_,RL,R),
R \= [].
% psedo-value restriction without the agreement requirement.
profile_of_admissible_domain(vr,[J|N],L,[J:R|P]):-
profile_of_admissible_domain(vr,N,L,P),
virtual_domain_of_value_restricted(_,_,_,RL),
list_projection(_,RL,R),
R \= [].
profile_of_admissible_domain(dp((X,Y)),[J|N],L,[J:R|P]):-
profile_of_admissible_domain(dp((X,Y)),N,L,P),
d_pair_alt(_:[X,Y]),
findall(K,
(
r_x(K,_,_,_,_),
is_indifferent_for_pair_in_triple(K,_,(X,Y))
),
R),
R \= [].
profile_of_admissible_domain(ci,[J|N],L,[J:R|P]):-
profile_of_admissible_domain(ci,N,L,P),
virtual_domain_of_cyclical_indifference(_,_,CIL),
list_projection(_,CIL,R),
R \= [].
% demo (31 Oct-- 3 Nov 2006)
%--------------------------------------------------------------
/*
?- weak_ordering.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- make_individually_admissible_domain(N,RP,free).
N = [1, 2, 3]
RP = [1:[27], 2:[27], 3:[27]] ;
N = [1, 2, 3]
RP = [1:[26], 2:[27], 3:[27]] ;
N = [1, 2, 3]
RP = [1:[26, 27], 2:[27], 3:[27]]
Yes
?- make_individually_admissible_domain([1,2,3],RP,dp(XY)).
RP = [1:[2, 14, 26], 2:[2, 14, 26], 3:[2, 14, 26]]
XY = x, y ;
RP = [1:[6, 14, 22], 2:[6, 14, 22], 3:[6, 14, 22]]
XY = x, z ;
RP = [1:[10, 14, 18], 2:[10, 14, 18], 3:[10, 14, 18]]
XY = y, z ;
No
?- make_individually_admissible_domain([1,2,3],RP,dp(XY)),
\+ (virtual_domain_of_value_restricted(S,W,XYZ,Rvr),
member(_:R,RP),subset(R,Rvr)).
No
?- make_individually_admissible_domain([1,2,3],RP,dp(XY)),
virtual_domain_of_value_restricted(S,W,XYZ,Rvr),
forall(member(_:R,RP),subset(R,Rvr)),nl,write(dp_domain:XY:RP),nl,tab(1),write(subsumed_in_vr_domain:(S,W):Rvr),fail.
dp_domain: (x, y):[1:[2, 14, 26], 2:[2, 14, 26], 3:[2, 14, 26]]
subsumed_in_vr_domain: (medium, z):[1, 2, 3, 14, 25, 26, 27]
dp_domain: (x, z):[1:[6, 14, 22], 2:[6, 14, 22], 3:[6, 14, 22]]
subsumed_in_vr_domain: (medium, y):[3, 6, 9, 14, 19, 22, 25]
dp_domain: (y, z):[1:[10, 14, 18], 2:[10, 14, 18], 3:[10, 14, 18]]
subsumed_in_vr_domain: (medium, x):[1, 9, 10, 14, 18, 19, 27]
No
?- make_individually_admissible_domain(N,RP,vr(S,W,T)).
N = [1, 2, 3]
RP = [1:[25], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[22], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[22, 25], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z]
Yes
?- make_individually_admissible_domain(N,RP,ci).
N = [1, 2, 3]
RP = [1:[22], 2:[22], 3:[22]] ;
N = [1, 2, 3]
RP = [1:[18], 2:[22], 3:[22]] ;
N = [1, 2, 3]
RP = [1:[18, 22], 2:[22], 3:[22]]
Yes
?- make_individually_admissible_domain(N,RP,vr(S,W,T)),
make_individually_admissible_domain(N,RP,ci).
N = [1, 2, 3]
RP = [1:[22], 2:[22], 3:[22]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[10], 2:[22], 3:[22]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[2], 2:[22], 3:[22]]
S = worst
W = x
T = [x, y, z]
Yes
?- make_individually_admissible_domain(N,RP,vr(S,W,T)),
\+ make_individually_admissible_domain(N,RP,ci).
N = [1, 2, 3]
RP = [1:[25], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[22], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[22, 25], 2:[25], 3:[25]]
S = worst
W = x
T = [x, y, z]
Yes
?- make_individually_admissible_domain(N,RP,ci),
\+ make_individually_admissible_domain(N,RP,vr(_,_,_)).
N = [1, 2, 3]
RP = [1:[2, 18], 2:[22], 3:[22]] ;
N = [1, 2, 3]
RP = [1:[2, 18, 22], 2:[22], 3:[22]] ;
N = [1, 2, 3]
RP = [1:[6, 26], 2:[22], 3:[22]]
Yes
?-
*/
% cyclical dependence
%--------------------------------------------------------------
% See Salles(1976).
% And see also Gaertner(2002), p.44.
% the inspection for, r_1/2, current individually admmissible domain.
% three-person cyclical dependece condition.
cyclical_dependence:-
\+ is_not_cyclical_dependence(_,_,_).
is_not_cyclical_dependence(Case,[I:R1,J:R2,K:R3],[X,Y,Z]):-
find_profile_in_r_i_if_unspecified([I:R1,J:R2,K:R3]),
% sort([I,J,K],[_,_,_]),
violates_cyclical_dependence(Case,[I:R1,J:R2,K:R3],[X,Y,Z]).
find_profile_in_r_i_if_unspecified([I:R1,J:R2,K:R3]):-
\+ (member(A,[I,J,K,R1,R2,R3]),var(A)),
!.
find_profile_in_r_i_if_unspecified([I:R1,J:R2,K:R3]):-
triple_in_r_i([I:R1,J:R2,K:R3]).
triple_in_r_i([I:R1,J:R2,K:R3]):-
r_i(I,R1),
r_i(J,R2),
r_i(K,R3).
% the verification based on, r_x/5, current common universal domain.
violates_cyclical_dependence((I,K1,K23),[1:R1,2:R2,3:R3],[X,Y,Z]):-
exists_a_linear_ordering_in_triple(R1,K1,[X,Y,Z]),
case_violates_cyclical_dependence((I,K23),[R2,R3],[X,Y,Z]).
case_violates_cyclical_dependence((1,K2,K3),[R2,R3],[X,Y,Z]):-
exists_a_linear_ordering_in_triple(R2,K2,[Y,Z,X]),
exists_an_weak_ordering_in_triple(R3,K3,[Z,X,Y]),
is_concerned_for([X,Y,Z],K3,_).
case_violates_cyclical_dependence((2,K2,K3),[R2,R3],[X,Y,Z]):-
exists_an_weak_ordering_in_triple(R2,K2,[Y,Z,X]),
is_concerned_for([X,Y,Z],K2,_),
exists_a_linear_ordering_in_triple(R3,K3,[Z,X,Y]).
case_violates_cyclical_dependence((3,K2,K3),[R2,R3],[X,Y,Z]):-
exists_a_strict_then_indifferent(R2,K2,[Y,Z,X]),
exists_an_indifferent_then_strict(R3,K3,[Z,X,Y]).
exists_a_linear_ordering_in_triple(RL,K,XYZ):-
exists_an_ordering_in_triple(RL,K,Rb,XYZ),
is_a_linear_ordering_in_triple(Rb,XYZ).
exists_an_weak_ordering_in_triple(RL,K,XYZ):-
exists_an_ordering_in_triple(RL,K,Rb,XYZ),
is_an_weak_ordering_in_triple(Rb,XYZ).
exists_a_strict_then_indifferent(RL,K,XYZ):-
exists_an_ordering_in_triple(RL,K,Rb,XYZ),
is_a_strict_then_indifferent(Rb,XYZ).
exists_an_indifferent_then_strict(RL,K,XYZ):-
exists_an_ordering_in_triple(RL,K,Rb,XYZ),
is_an_indifferent_then_strict(Rb,XYZ).
exists_an_ordering_in_triple(RL,K,Rb,XYZ):-
\+ var(RL),
(var(XYZ)->triple(XYZ);true),
member(K,RL),
r_x(K,_,_,_,Rb).
% if a list of preference orderings RL is unboud
% then we assume a singlton
% sacrificing the theoretical correctness for the complexity.
exists_an_ordering_in_triple(RL,K,Rb,XYZ):-
var(RL),
(var(XYZ)->triple(XYZ);true),
RL=[K],
r_x(K,_,_,_,Rb).
is_a_linear_ordering_in_triple(Rb,[X,Y,Z]):-
p((X,Y),Rb),
p((Y,Z),Rb).
is_an_weak_ordering_in_triple(Rb,[X,Y,Z]):-
r((X,Y),Rb),
r((Y,Z),Rb).
is_a_strict_then_indifferent(Rb,[X,Y,Z]):-
p((X,Y),Rb),
i((Y,Z),Rb).
is_an_indifferent_then_strict(Rb,[X,Y,Z]):-
i((X,Y),Rb),
p((Y,Z),Rb).
% a demo (1-3,5 Nov 2006)
%--------------------------------------------------------------
/*
?- strict_preference.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- violates_cyclical_dependence((I,K,K1,K2),R123,XYZ),
nl,write((I,K,K1,K2);R123;XYZ),fail.
1, 1, 9, 25;[1:[1], 2:[9], 3:[25]];[x, y, z]
2, 1, 9, 25;[1:[1], 2:[9], 3:[25]];[x, y, z]
1, 3, 19, 27;[1:[3], 2:[19], 3:[27]];[y, x, z]
2, 3, 19, 27;[1:[3], 2:[19], 3:[27]];[y, x, z]
1, 9, 25, 1;[1:[9], 2:[25], 3:[1]];[y, z, x]
2, 9, 25, 1;[1:[9], 2:[25], 3:[1]];[y, z, x]
1, 19, 27, 3;[1:[19], 2:[27], 3:[3]];[x, z, y]
2, 19, 27, 3;[1:[19], 2:[27], 3:[3]];[x, z, y]
1, 25, 1, 9;[1:[25], 2:[1], 3:[9]];[z, x, y]
2, 25, 1, 9;[1:[25], 2:[1], 3:[9]];[z, x, y]
1, 27, 3, 19;[1:[27], 2:[3], 3:[19]];[z, y, x]
2, 27, 3, 19;[1:[27], 2:[3], 3:[19]];[z, y, x]
No
?-
*/
% a prirty print
table_of_violations_against_cyclical_dependence:-
nl,
write(case),tab(3),write(r1(list)),tab(5),write(r1),
tab(5),write(r2),tab(5),write(r3),
nl,
write('------------------------------------'),
setof(K2,R123^
violates_cyclical_dependence((I,K,K1,K2),R123,XYZ),
L),
nl,
tab(3),write(I),tab(3),write(XYZ),tab(4),write(K),
tab(4),write(K1),tab(3),write(L),
fail.
table_of_violations_against_cyclical_dependence.
/*
% a prirty print
?- table_of_violations_against_cyclical_dependence.
case r1(list) r1 r2 r3
------------------------------------
1 [x, y, z] 1 9 [25]
2 [x, y, z] 1 9 [25]
1 [y, x, z] 3 19 [27]
2 [y, x, z] 3 19 [27]
1 [y, z, x] 9 25 [1]
2 [y, z, x] 9 25 [1]
1 [x, z, y] 19 27 [3]
2 [x, z, y] 19 27 [3]
1 [z, x, y] 25 1 [9]
2 [z, x, y] 25 1 [9]
1 [z, y, x] 27 3 [19]
2 [z, y, x] 27 3 [19]
Yes
?- member(K,[1,9,25]),r_0(K,A,B,_,_),nl,write([K]:A;B),fail.
[1]:[+, +, +];[ (x, y): +, (x, z): +, (y, z): +]
[9]:[-, -, +];[ (x, y): -, (x, z): -, (y, z): +]
[25]:[+, -, -];[ (x, y): +, (x, z): -, (y, z): -]
No
?- member(K,[3,19,27]),r_0(K,A,B,_,_),nl,write([K]:A;B),fail.
[3]:[-, +, +];[ (x, y): -, (x, z): +, (y, z): +]
[19]:[+, +, -];[ (x, y): +, (x, z): +, (y, z): -]
[27]:[-, -, -];[ (x, y): -, (x, z): -, (y, z): -]
No
?-
?- weak_preference.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- case_violates_cyclical_dependence((3,K2,K3),[R2,R3],[X,Y,Z]).
K2 = 1
K3 = 3
R2 = [1]
R3 = [3]
X = y
Y = x
Z = y
Yes
?- violates_cyclical_dependence(IK,R123,XYZ).
IK = 1, 1, 9, 22
R123 = [1:[1], 2:[9], 3:[22]]
XYZ = [x, y, z]
Yes
?- member(K,[1,9,22]),r_0(K,A,B,_,_),nl,write([K]:A;B),fail.
[1]:[+, +, +];[ (x, y): +, (x, z): +, (y, z): +]
[9]:[-, -, +];[ (x, y): -, (x, z): -, (y, z): +]
[22]:[+, 0, -];[ (x, y): +, (x, z):0, (y, z): -]
No
?-
% The reader is referred to the corresponding result in Salles(1976), p.312.
?- violates_cyclical_dependence((I,K,K1,K2),R123,XYZ),
sort([K,K1,K2],[K,K1,K2]),nl,write(case(I):[K,K1,K2];XYZ),fail.
case(1):[1, 9, 22];[x, y, z]
case(1):[1, 9, 25];[x, y, z]
case(1):[1, 9, 26];[x, y, z]
case(2):[1, 6, 25];[x, y, z]
case(2):[1, 9, 25];[x, y, z]
case(2):[1, 18, 25];[x, y, z]
case(3):[1, 6, 22];[x, y, z]
case(1):[3, 19, 26];[y, x, z]
case(1):[3, 19, 27];[y, x, z]
case(2):[3, 10, 27];[y, x, z]
case(2):[3, 19, 27];[y, x, z]
case(2):[3, 22, 27];[y, x, z]
case(3):[3, 10, 18];[y, x, z]
No
?- setof(K2,R123^
violates_cyclical_dependence((I,K,K1,K2),R123,XYZ),
L),
nl,write((I,K,K1);L;XYZ),fail.
1, 1, 9;[22, 25, 26];[x, y, z]
2, 1, 6;[25];[x, y, z]
2, 1, 9;[25];[x, y, z]
2, 1, 18;[25];[x, y, z]
3, 1, 6;[22];[x, y, z]
1, 3, 19;[18, 26, 27];[y, x, z]
2, 3, 10;[27];[y, x, z]
2, 3, 19;[27];[y, x, z]
2, 3, 22;[27];[y, x, z]
3, 3, 10;[18];[y, x, z]
1, 9, 25;[1, 2, 10];[y, z, x]
2, 9, 22;[1];[y, z, x]
2, 9, 25;[1];[y, z, x]
2, 9, 26;[1];[y, z, x]
3, 9, 26;[2];[y, z, x]
1, 19, 27;[2, 3, 6];[x, z, y]
2, 19, 18;[3];[x, z, y]
2, 19, 26;[3];[x, z, y]
2, 19, 27;[3];[x, z, y]
3, 19, 26;[2];[x, z, y]
1, 25, 1;[6, 9, 18];[z, x, y]
2, 25, 1;[9];[z, x, y]
2, 25, 2;[9];[z, x, y]
2, 25, 10;[9];[z, x, y]
3, 25, 10;[18];[z, x, y]
1, 27, 3;[10, 19, 22];[z, y, x]
2, 27, 2;[19];[z, y, x]
2, 27, 3;[19];[z, y, x]
2, 27, 6;[19];[z, y, x]
3, 27, 6;[22];[z, y, x]
No
?-
% a prity print
?- table_of_violations_against_cyclical_dependence.
case r1(list) r1 r2 r3
------------------------------------
1 [x, y, z] 1 9 [22, 25, 26]
2 [x, y, z] 1 6 [25]
2 [x, y, z] 1 9 [25]
2 [x, y, z] 1 18 [25]
3 [x, y, z] 1 6 [22]
1 [y, x, z] 3 19 [18, 26, 27]
2 [y, x, z] 3 10 [27]
2 [y, x, z] 3 19 [27]
2 [y, x, z] 3 22 [27]
3 [y, x, z] 3 10 [18]
1 [y, z, x] 9 25 [1, 2, 10]
2 [y, z, x] 9 22 [1]
2 [y, z, x] 9 25 [1]
2 [y, z, x] 9 26 [1]
3 [y, z, x] 9 26 [2]
1 [x, z, y] 19 27 [2, 3, 6]
2 [x, z, y] 19 18 [3]
2 [x, z, y] 19 26 [3]
2 [x, z, y] 19 27 [3]
3 [x, z, y] 19 26 [2]
1 [z, x, y] 25 1 [6, 9, 18]
2 [z, x, y] 25 1 [9]
2 [z, x, y] 25 2 [9]
2 [z, x, y] 25 10 [9]
3 [z, x, y] 25 10 [18]
1 [z, y, x] 27 3 [10, 19, 22]
2 [z, y, x] 27 2 [19]
2 [z, y, x] 27 3 [19]
2 [z, y, x] 27 6 [19]
3 [z, y, x] 27 6 [22]
Yes
?-
*/
% Table 1. the correspondent number of the ordering.
% Salles(1976) 1 2 3 4 5 6 7 8 9 10 11 12 13
% ours 1 10 2 9 6 18 25 26 22 19 27 3 14
is_order_number_in_Salles(K,A,Ours):-
r_0(K,A,_,_,_),
nth1(K,[1,10,2,9,6,18,25,26,22,19,27,3,14],Ours).
setof_violations_against_cd_in_Salles_numbering((I,S,S1),L1,XYZ)
:-
setof(K2,R123^violates_cyclical_dependence((I,K,K1,K2),R123,XYZ),L),
is_order_number_in_Salles(S,_,K),
is_order_number_in_Salles(S1,_,K1),findall(S2,(member(K2,L),
is_order_number_in_Salles(S2,_,K2)),L1).
/*
?- setof_violations_against_cd_in_Salles_numbering((I,S,S1),L1,XYZ),
nl,write((I,S,S1);L1;XYZ),fail.
1, 1, 4;[9, 7, 8];[x, y, z]
2, 1, 5;[7];[x, y, z]
2, 1, 4;[7];[x, y, z]
2, 1, 6;[7];[x, y, z]
3, 1, 5;[9];[x, y, z]
1, 12, 10;[6, 8, 11];[y, x, z]
2, 12, 2;[11];[y, x, z]
2, 12, 10;[11];[y, x, z]
2, 12, 9;[11];[y, x, z]
3, 12, 2;[6];[y, x, z]
1, 4, 7;[1, 3, 2];[y, z, x]
2, 4, 9;[1];[y, z, x]
2, 4, 7;[1];[y, z, x]
2, 4, 8;[1];[y, z, x]
3, 4, 8;[3];[y, z, x]
1, 10, 11;[3, 12, 5];[x, z, y]
2, 10, 6;[12];[x, z, y]
2, 10, 8;[12];[x, z, y]
2, 10, 11;[12];[x, z, y]
3, 10, 8;[3];[x, z, y]
1, 7, 1;[5, 4, 6];[z, x, y]
2, 7, 1;[4];[z, x, y]
2, 7, 3;[4];[z, x, y]
2, 7, 2;[4];[z, x, y]
3, 7, 2;[6];[z, x, y]
1, 11, 12;[2, 10, 9];[z, y, x]
2, 11, 3;[10];[z, y, x]
2, 11, 12;[10];[z, y, x]
2, 11, 5;[10];[z, y, x]
3, 11, 5;[9];[z, y, x]
Yes
?-
*/
% a prirty print
table_of_violations_against_cd_in_Salles_numbering
:-
nl,
writef('%5r%10r%7r%7r%7r', [case, r1(list),r1,r2,r3]),
nl,
% write(case),tab(3),write(r1(list)),tab(5),write(r1),
% tab(5),write(r2),tab(5),write(r3),
% nl,
writef('%r', ['_', 41]),
nl,
setof_violations_against_cd_in_Salles_numbering((I,K,K1),L,XYZ),
nl,
writef('%5c%10r%7r%7r', [I, XYZ,K,K1]),
tab(3),
write(L),
% tab(3),write(I),tab(3),write(XYZ),tab(4),write(K),
% tab(4),write(K1),tab(3),write(L),
fail.
table_of_violations_against_cd_in_Salles_numbering.
/*
?- table_of_violations_against_cd_in_Salles_numbering.
case r1(list) r1 r2 r3
_________________________________________
1 [x, y, z] 1 4 [9, 7, 8]
2 [x, y, z] 1 5 [7]
2 [x, y, z] 1 4 [7]
2 [x, y, z] 1 6 [7]
3 [x, y, z] 1 5 [9]
1 [y, x, z] 12 10 [6, 8, 11]
2 [y, x, z] 12 2 [11]
2 [y, x, z] 12 10 [11]
2 [y, x, z] 12 9 [11]
3 [y, x, z] 12 2 [6]
1 [y, z, x] 4 7 [1, 3, 2]
2 [y, z, x] 4 9 [1]
2 [y, z, x] 4 7 [1]
2 [y, z, x] 4 8 [1]
3 [y, z, x] 4 8 [3]
1 [x, z, y] 10 11 [3, 12, 5]
2 [x, z, y] 10 6 [12]
2 [x, z, y] 10 8 [12]
2 [x, z, y] 10 11 [12]
3 [x, z, y] 10 8 [3]
1 [z, x, y] 7 1 [5, 4, 6]
2 [z, x, y] 7 1 [4]
2 [z, x, y] 7 3 [4]
2 [z, x, y] 7 2 [4]
3 [z, x, y] 7 2 [6]
1 [z, y, x] 11 12 [2, 10, 9]
2 [z, y, x] 11 3 [10]
2 [z, y, x] 11 12 [10]
2 [z, y, x] 11 5 [10]
3 [z, y, x] 11 5 [9]
Yes
?-
*/
% Relations between several types of restriction.
/*
?- violates_cyclical_dependence(IK,R123,XYZ),
make_individually_admissible_domain(N,R123,ci).
No
?- violates_cyclical_dependence(IK,R123,XYZ),
make_individually_admissible_domain(N,R123,vr(S,W,T)).
No
?- violates_cyclical_dependence(IK,R123,XYZ),
make_individually_admissible_domain(N,R123,dp(XY)).
No
?- violates_cyclical_dependence(IK,R123,XYZ),
make_individually_admissible_domain(N,R123,free).
IK = 1, 1, 9, 22
R123 = [1:[1], 2:[9], 3:[22]]
XYZ = [x, y, z]
N = [1, 2, 3]
Yes
?-
?- make_individually_admissible_domain([1,2,3],RP,dp(XY)),
is_not_cyclical_dependence(Case,RP,XYZ).
No
?- make_individually_admissible_domain([1,2,3],RP,dp(XY)),
\+ make_individually_admissible_domain([1,2,3],RP,vr(S,W,T)).
No
?- make_individually_admissible_domain(N,RP,vr),
is_not_cyclical_dependence(Case,RP,XYZ).
N = [1, 2, 3]
RP = [1:[1], 2:[18], 3:[25]]
Case = 2, 1, 18, 25
XYZ = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[1, 25], 2:[18], 3:[25]]
Case = 2, 1, 18, 25
XYZ = [x, y, z] ;
N = [1, 2, 3]
RP = [1:[1, 22], 2:[18], 3:[25]]
Case = 2, 1, 18, 25
XYZ = [x, y, z]
Yes
?- member(K,[1,18,22,25]),r_0(K,A,B,_,_),nl,write([K]:A;B),fail.
[1]:[+, +, +];[ (x, y): +, (x, z): +, (y, z): +]
[18]:[-, -, 0];[ (x, y): -, (x, z): -, (y, z):0]
[22]:[+, 0, -];[ (x, y): +, (x, z):0, (y, z): -]
[25]:[+, -, -];[ (x, y): +, (x, z): -, (y, z): -]
No
?-
% A violation against the CD condition is a sort of latin square.
% But the verification takes several hours.
?- make_individually_admissible_domain(N,RP,vr(S,W,T)),
is_not_cyclical_dependence(Case,RL,XYZ).
No
% a shorter verification as for cyclical independence.
?- make_individually_admissible_domain(N,RP,ci),
is_not_cyclical_dependence(Case,RP,XYZ).
No
?-
*/
%--------------------------------------------------------------
% simple games (or committees) and the stability of the core
%--------------------------------------------------------------
% 7 Sep, 9-14 (and thereafter) Oct 2006
agent(A,B):-agent(A:B).
alt(A,B):-alt(A:B).
all_alternatives(A):-
findall( X, alt(_:X), A).
all_agents(N):-
findall( J, agent(J:_), N).
all_coalitions(L):-
findall( C, coalition(C), L).
% simple game and the winning coalitions
%--------------------------------------------------------------
% A simple game specifies a distribution of powers for
% the coalitions.
% A simple game can models a constitution, a committee,
% a voting procedure
% (a voting system, a voting scheme),..., etc.,
% A simple game can be seen as an effectivity function
% (the detail postponed to later part)
% which assigns the almighty to each winning coalition.
:- dynamic win/2.
/*
% example 1
win( [], no).
win( [1], yes).
win( [2], no).
win( [1,2], yes).
*/
% example 2
win( [], no).
win( [1], yes).
win( [2], no).
win( [3], no).
win( [1,2], yes).
win( [1,3], no).
win( [2,3], no).
win( [1,2,3], yes).
% is winning = is effective for any pair of alternatives
winning(C):- win(C, yes), (coalition(C);C=[]).
loosing(C):- win(C, no), (coalition(C);C=[]).
all_winning_coalitions(W):-
findall( C, winning(C), W).
all_loosing_coalitions(L):-
findall( C, loosing(C), L).
simple_game(N, W):-
all_agents(N),
all_winning_coalitions(W).
% the properties of simple games
%--------------------------------------------------------------
is_monotonic_simple_game:-
\+ is_not_monotonic_simple_game(_).
is_not_monotonic_simple_game((C,D)):-
winning(C),
coalition(D),
subset(C,D),
\+ winning(D).
is_proper_simple_game:-
\+ is_not_proper_simple_game(_).
is_not_proper_simple_game((W,C)):-
complement_of_winning(C,W),
winning(C).
% alternative (see Shapley(1962))
improper_simple_game(C):-
winning(C),
complement_of_winning(C,_).
is_strong_simple_game:-
\+ is_not_strong_simple_game(_).
is_not_strong_simple_game((L,C)):-
complement_of_loosing(C,L),
\+ winning(C).
% or (see Shapley(1962))
violates_strong_simple_game(C):-
blocking(C).
is_weak_simple_game:-
\+ \+ is_a_veto_player(_).
is_a_vetoer(J):-
agent(J:_),
forall( winning(C), member(J,C)).
% essentiality and dictator game (see Shapley(1962))
% revised: 27 Dec 2006
% THEOREM (Shapley,1952)
% No essential game is both and strong.
is_essential_game:-
\+ is_inessential_game(_).
is_inessential_game(J):-
winning([J]),
\+ (coalition(C),member(J,C), \+ winning(C)),
\+ (winning(C),\+ member(J,C)).
is_srong_and_weak_game:-
is_strong_simple_game,
is_weak_simple_game.
% demo for a simple game (example 1)
/*
?- is_a_vetoer(J).
J = 1 ;
No
?- is_weak_simple_game.
Yes
?- is_strong_simple_game.
Yes
?- is_proper_simple_game.
Yes
?-
*/
% the inspecter for the basic properties
%--------------------------------------------------------------
% revised: 27 Dec 2006
inspect_properties_of_simple_game([M,P,S,W,E]):-
inspect_sg(is_monotonic,M),
inspect_sg(is_proper,P),
inspect_sg(is_strong,S),
inspect_sg(is_weak,W),
inspect_sg(is_essential,E).
inspect_sg(is_monotonic,Y):-
is_not_monotonic_simple_game(Vio),
!,
Y=no(Vio).
inspect_sg(is_monotonic,yes).
inspect_sg(is_proper,Y):-
is_not_proper_simple_game(Vio),
!,
Y=no(Vio).
inspect_sg(is_proper,yes).
inspect_sg(is_strong,Y):-
is_not_strong_simple_game(Vio),
!,
Y=no(Vio).
inspect_sg(is_strong,yes).
inspect_sg(is_weak,Y):-
setof(J,is_a_vetoer(J), Vetoers),
!,
Y=yes( Vetoers).
inspect_sg(is_weak,no).
inspect_sg(is_essential,Y):-
is_inessential_game(Dictator),
!,
Y=no( Dictator).
inspect_sg(is_essential,yes).
% demo for a simple game (example 2)
/*
?- inspect_properties_of_simple_game([M,P,S,W,E]).
M = no(([1], [1, 3]))
P = yes
S = no(([2], [1, 3]))
W = yes([1])
E = yes
Yes
?- verify_win.
game:[[1], [1, 2], [1, 2, 3]]
is proper
is weak with veto players:[1]
is essential
Yes
?- dual_win(W->L).
W = [[1], [1, 2], [1, 2, 3]]
L = [[1, 2, 3], [1, 3], [1, 2], [2], [1]]
Yes
?- inspect_properties_of_simple_game([M,P,S,W]).
M = no(([2], [2, 3]))
P = no(([2], [1, 3]))
S = yes
W = no
E = yes
Yes
?- dual_win(W->L).
W = [[1], [1, 2], [1, 2, 3], [2], [1, 3]]
L = [[1, 2, 3], [1, 2], [1]]
Yes
?-
*/
% the total inspect tool for simple games
%--------------------------------------------------------------
show_win:-
findall(C,win(C,yes),W),
nl,
write(game:W).
verify_win(U):-
inspect_properties_of_simple_game(U).
verify_win:-
show_win,
verify_win([M,P,S,W,E]),
verify_win_message_profile([M,P,S,W,E]).
verify_win_message_profile([M,P,S,W,E]):-
(M=yes->(nl,write('is monotonic'));true),
(P=yes->(nl,write('is proper'));true),
(S=yes->(nl,write('is strong'));true),
verify_win_messege(is_weak,W),
verify_win_messege(is_essential,E).
verify_win_messege(is_weak,no):-
nl,write('is not weak'),
!.
verify_win_messege(is_weak,yes(Vetoers)):-
nl,write( 'is weak with veto players':Vetoers).
verify_win_messege(is_essential,yes):-
nl,write('is essential'),
!.
verify_win_messege(is_essential,no(J)):-
nl,write('is inessential with a dictator':J),
!.
% generating simple games
%--------------------------------------------------------------
:- dynamic win_0/2.
% keeping/recoverying the initial game before/after iteration.
reserve_win:-
abolish(win_0/2),
forall(win(C,Y),assert(win_0(C,Y))).
restore_win:-
forall(win_0(C,Y),assert(win(C,Y))).
% generating the simple games
gen_win(W):- gen_win(W,_).
gen_win(W,P):-
all_coalitions(L),
initialize_wins(W,L,W1),
gen_win_1(W1,L,P),
non_emptiness_of_win(W1).
initialize_wins(W,L,W1):-
(var(W)->W1=W;sort_by_list(W,L,W1)),
abolish(win/2),
forall(member(C,[[]|L]),assert(win(C,no))).
non_emptiness_of_win(W):-W \= [].
gen_win_1([],[],[]).
gen_win_1([C|W],[C|L],[1|P]):-
gen_win_1(W,L,P),
update_win(C,_->yes).
gen_win_1(W,[C|L],[0|P]):-
gen_win_1(W,L,P),
update_win(C,_->no).
update_win(C,A->B):-
retract(win(C,A)),
assert(win(C,B)).
% demo (revised: 27 Dec 2006)
/*
?- set_model(2-person,3-alternative).
Yes
?- gen_win(_),verify_win,fail.
game:[[1, 2], [1], [2]]
is monotonic
is strong
is not weak
is essential
game:[[1], [2]]
is not weak
is essential
game:[[1, 2], [2]]
is monotonic
is proper
is strong
is weak with veto players:[2]
is inessential with a dictator:2
game:[[2]]
is proper
is weak with veto players:[2]
is essential
game:[[1, 2], [1]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
game:[[1]]
is proper
is weak with veto players:[1]
is essential
game:[[1, 2]]
is monotonic
is proper
is weak with veto players:[1, 2]
is essential
No
?-
*/
% N=[1,2,3] the society of taro-hanako-jiro case.
/*
?- set_model(2-person,3-alternative).
Yes
?- gen_win(W),verify_win([yes,yes,yes|I]),nl,verify_win,
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),fail.
game:[[1, 2, 3], [1, 3], [1, 2], [1]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[1, 2, 3], [2, 3], [1, 2], [2]]
is monotonic
is proper
is strong
is weak with veto players:[2]
is inessential with a dictator:2
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[1, 2, 3], [2, 3], [1, 3], [3]]
is monotonic
is proper
is strong
is weak with veto players:[3]
is inessential with a dictator:3
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is strong
is not weak
is essential
core stability:[fail, fail]
eff:[true, true, fail, true, true, fail]
No
?-
% proper but not strong games
?- gen_win(W),verify_win([yes,yes,no(T)|I]),nl,verify_win,nl,write('is not strong':T),
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),fail.
game:[[1, 2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[1]
is essential
is not strong: ([2, 3], [1])
core stability:[true, fail]
eff:[true, true, fail, true, fail, fail]
game:[[1, 2, 3], [2, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[2]
is essential
is not strong: ([1, 3], [2])
core stability:[true, fail]
eff:[true, true, fail, true, fail, fail]
game:[[1, 2, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[1, 2]
is essential
is not strong: ([2, 3], [1])
core stability:[true, fail]
eff:[true, true, fail, true, fail, true]
game:[[1, 2, 3], [2, 3], [1, 3]]
is monotonic
is proper
is weak with veto players:[3]
is essential
is not strong: ([1, 2], [3])
core stability:[true, fail]
eff:[true, true, fail, true, fail, fail]
game:[[1, 2, 3], [1, 3]]
is monotonic
is proper
is weak with veto players:[1, 3]
is essential
is not strong: ([2, 3], [1])
core stability:[true, fail]
eff:[true, true, fail, true, fail, true]
game:[[1, 2, 3], [2, 3]]
is monotonic
is proper
is weak with veto players:[2, 3]
is essential
is not strong: ([1, 3], [2])
core stability:[true, fail]
eff:[true, true, fail, true, fail, true]
game:[[1, 2, 3]]
is monotonic
is proper
is weak with veto players:[1, 2, 3]
is essential
is not strong: ([2, 3], [1])
core stability:[true, fail]
eff:[true, true, fail, true, fail, true]
No
?-
% strong but improper games
?- gen_win(W),verify_win([yes,no(T),yes|I]),nl,verify_win,nl,write('is not strong':T),
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),fail.
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [3], [2], [1]]
is monotonic
is strong
is not weak
is essential
is not strong: ([2, 3], [1])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [2], [1]]
is monotonic
is strong
is not weak
is essential
is not strong: ([2, 3], [1])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [3], [1]]
is monotonic
is strong
is not weak
is essential
is not strong: ([2, 3], [1])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [1]]
is monotonic
is strong
is not weak
is essential
is not strong: ([2, 3], [1])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [3], [2]]
is monotonic
is strong
is not weak
is essential
is not strong: ([1, 3], [2])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [2]]
is monotonic
is strong
is not weak
is essential
is not strong: ([1, 3], [2])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [3]]
is monotonic
is strong
is not weak
is essential
is not strong: ([1, 2], [3])
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
No
?-
*/
% a demo: reproducing the Condorcet paradox using simple games
%--------------------------------------------------------------
% added: 2 Nov 2006
/*
?- weak_ordering.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- W=[[1, 2, 3], [2, 3], [1, 3], [1, 2]],gen_win(W).
W = [[1, 2, 3], [2, 3], [1, 3], [1, 2]]
Yes
?- core([],(R1,R2,R3)),
findall(K,(member(R,[R1,R2,R3]),r_x(K,R,_,_,_)),KN),
nl,write((R1,R2,R3):KN),fail.
([+, -, -], [-, -, +], [+, +, +]):[25, 9, 1]
([-, -, +], [+, -, -], [+, +, +]):[9, 25, 1]
([-, -, -], [+, +, -], [-, +, +]):[27, 19, 3]
([+, +, -], [-, -, -], [-, +, +]):[19, 27, 3]
([+, -, -], [+, +, +], [-, -, +]):[25, 1, 9]
([+, +, +], [+, -, -], [-, -, +]):[1, 25, 9]
([-, -, -], [-, +, +], [+, +, -]):[27, 3, 19]
([-, +, +], [-, -, -], [+, +, -]):[3, 27, 19]
([-, -, +], [+, +, +], [+, -, -]):[9, 1, 25]
([+, +, +], [-, -, +], [+, -, -]):[1, 9, 25]
([+, +, -], [-, +, +], [-, -, -]):[19, 3, 27]
([-, +, +], [+, +, -], [-, -, -]):[3, 19, 27]
No
?- member(K,[1,9,25]),r_x(K,_,R,_,_),nl,write([K];R),fail.
[1];[ (x, y): +, (x, z): +, (y, z): +]
[9];[ (x, y): -, (x, z): -, (y, z): +]
[25];[ (x, y): +, (x, z): -, (y, z): -]
No
?- member(K,[3,19,27]),r_x(K,_,R,_,_),nl,write([K];R),fail.
[3];[ (x, y): -, (x, z): +, (y, z): +]
[19];[ (x, y): +, (x, z): +, (y, z): -]
[27];[ (x, y): -, (x, z): -, (y, z): -]
No
?-
*/
% minimal winning coalition and dummy agent
%--------------------------------------------------------------
minimal_winning(C):-
win(C,yes),
\+ (
coalition(D,_),
subset(D,C),
\+ win(D,yes)
).
dummy_agent(J):-
agent(J:_),
\+ (
minimal_winning(C),
member(J,C)
).
% duality (see Shapley(1962))
%--------------------------------------------------------------
dual_simple_game(N, L):-
all_agents(N),
all_loosing_coalitions(L).
complement_of_winning(C,W):-
winning(W),
complementary_pair_of_group(C,W,_). %, C\=[].
complement_of_loosing(C,L):-
loosing(L),
complementary_pair_of_group(C,L,_). %, C\=[].
% blocking relation (see Shapley(1962)
%--------------------------------------------------------------
% blocking coalitions by Shapley(1962)
blocking(B):-
complement_of_loosing(B,_),
loosing(B),
B \=[].
minimal_blocking(B):-
blocking(B),
\+ (
coalition(D,_),
subset(D,B),
\+ blocking(D)
).
% blocking coalitions by Peleg(2002)
blocking(peleg02,B):-
complement_of_loosing(B,_),
B \=[].
minimal_blocking(peleg,B):-
blocking(peleg,B),
\+ (
coalition(D,_),
subset(D,B),
\+ blocking(peleg,D)
).
% meager coalitions by Peleg(2002)
meager(peleg02,M):-
coalition(M,_),
minimal_blocking(peleg02,M).
meager(peleg02,M):-
coalition(M,_),
\+ blocking(peleg02,M).
% demo
/*
?- blocking(S).
No
?- minimal_winning(S).
S = [1] ;
No
?- dummy_agent(J).
J = 2 ;
No
?- gen_win(W),nl,write(game:W),
blocking(B),nl,tab(1),write(blocking:B),fail.
game:[[1], [2], [1, 2]]
game:[[1], [2]]
blocking:[1, 2]
game:[[1], [1, 2]]
game:[[1]]
blocking:[1, 2]
game:[[2], [1, 2]]
game:[[2]]
blocking:[1, 2]
game:[[1, 2]]
blocking:[1]
blocking:[2]
No
?- gen_win(W),nl,write(game:W),
blocking(peleg02,B),nl,tab(1),write(blocking:B),fail.
game:[[1], [2], [1, 2]]
blocking:[1, 2]
game:[[1], [2]]
blocking:[1, 2]
game:[[1], [1, 2]]
blocking:[1, 2]
blocking:[1]
game:[[1]]
blocking:[1, 2]
blocking:[1]
game:[[2], [1, 2]]
blocking:[1, 2]
blocking:[2]
game:[[2]]
blocking:[1, 2]
blocking:[2]
game:[[1, 2]]
blocking:[1, 2]
blocking:[1]
blocking:[2]
No
?- gen_win(W),nl,write(game:W),
meager(peleg02,M),nl,tab(1),write(meager:M),fail.
game:[[1], [2], [1, 2]]
meager:[2]
meager:[1]
game:[[1], [2]]
meager:[2]
meager:[1]
game:[[1], [1, 2]]
meager:[2]
game:[[1]]
meager:[2]
game:[[2], [1, 2]]
meager:[1]
game:[[2]]
meager:[1]
game:[[1, 2]]
No
?-
*/
% blocking relations by Danilov and Sotskov(2002)
%--------------------------------------------------------------
coalition_blocks_alternatives(S,[]):-
coalition(S,_).
coalition_blocks_alternatives(S,X):-
winning(S),
event(X,_),
X \=[].
% blocking <--> effectivity
% coalition S blocks X iff S enforces its complement.
coalition_enforces_alternatives(S,X):-
coalition_blocks_alternatives(S,Y),
complementary_pair_of_event(X,Y,_).
% demo
/*
?- blocking(S).
No
?- minimal_winning(S).
S = [1] ;
No
?- dummy_agent(J).
J = 2 ;
No
?- coalition_blocks_alternatives(S,X),nl,write(S:blocks:X),fail.
[2]:blocks:[]
[1]:blocks:[]
[1, 2]:blocks:[]
[1]:blocks:[z]
[1]:blocks:[y]
[1]:blocks:[y, z]
[1]:blocks:[x]
[1]:blocks:[x, z]
[1]:blocks:[x, y]
[1]:blocks:[x, y, z]
[1, 2]:blocks:[z]
[1, 2]:blocks:[y]
[1, 2]:blocks:[y, z]
[1, 2]:blocks:[x]
[1, 2]:blocks:[x, z]
[1, 2]:blocks:[x, y]
[1, 2]:blocks:[x, y, z]
No
?- coalition_enforces_alternatives(S,X),nl,write(S:enforces:X),fail.
[2]:enforces:[x, y, z]
[1]:enforces:[x, y, z]
[1, 2]:enforces:[x, y, z]
[1]:enforces:[x, y]
[1]:enforces:[x, z]
[1]:enforces:[x]
[1]:enforces:[y, z]
[1]:enforces:[y]
[1]:enforces:[z]
[1]:enforces:[]
[1, 2]:enforces:[x, y]
[1, 2]:enforces:[x, z]
[1, 2]:enforces:[x]
[1, 2]:enforces:[y, z]
[1, 2]:enforces:[y]
[1, 2]:enforces:[z]
[1, 2]:enforces:[]
No
?-
*/
% dualizing the simple game
%--------------------------------------------------------------
dual_win(W->Lc):-
all_winning_coalitions(W),
findall(C, complement_of_loosing(C,_),Lc),
forall(
win(C,Y),
update_win( C, Y, W->Lc,_)
).
update_win( C, yes, _->Lc, purge):-
\+ member(C,Lc),
swap_win(C,yes->no),
!.
update_win( _, yes, _, through).
update_win( C, no, _->Lc,assimilate):-
member(C,Lc),
swap_win(C,no->yes),
!.
update_win( _, no, _,through).
swap_win(C,yes->no):-
retract(win(C,yes)),
assert(win(C,no)).
swap_win(C,no->yes):-
retract(win(C,no)),
assert(win(C,yes)).
% switching on-off-type background model parameter
%--------------------------------------------------------------
switch_win(C,M->O):-
coalition(C),
member( (yes,no), [(M,O),(O,M)]),
remove_mode_parameter(win, C,M),
add_mode_parameter(win, C,O).
remove_mode_parameter(Prm, M,ON):-
A=..[Prm,M,ON],
retract(A).
add_mode_parameter(Prm, M,ON):-
A=..[Prm,M,ON],
assert(A).
% for slight more general use
switch_model_parameter(Prm,_->O):-
\+ var(O),
G=..[Prm,O,on],
G.
switch_model_parameter(Prm, M->O):-
On=..[Prm,M,on],
On,
Off=..[Prm,O,off],
Off,
commit_swap_model_parameter(Prm, M->O).
commit_swap_mode_parameter(Prm, M->O):-
remove_mode_parameter(Prm, M,on),
remove_mode_parameter(Prm, O,off),
add_mode_parameter(Prm, M,off),
add_mode_parameter(Prm, O,on).
%--------------------------------------------------------------
% simple games for preference aggregation
%--------------------------------------------------------------
%:- make_preference(q-trans).
:- strict_preference.
% preference relation
%--------------------------------------------------------------
preference_profile(RN):-
preference_profile(_,RN).
preference_profile(JRN,RN):-
all_agents(N),
n_person_preference_profile(N,JRN,RN).
coalitional_preference_profile(S,JRN,RN):-
coalition(S,_),
n_person_preference_profile(S,JRN,RN).
n_person_preference_profile([],[],_).
n_person_preference_profile([J|N],[J:P|T],O):-
n_person_preference_profile(N,T,U),
(var(U)->O=P;O=(P,U)),
r_x(_,P,_,_,_).
% displaying a profile in the numbers
profile_in_numbers(R,[K]):-
R \= (_,_),
r_0(K,R,_,_,_).
profile_in_numbers((R,RN),[K|NR]):-
profile_in_numbers(RN,NR),
r_0(K,R,_,_,_).
% unanimity-based coalition formation
%--------------------------------------------------------------
unanimity_in_coalition_for_xy(strict,S, RN,(X,Y)):-
coalition(S,_),
preference_profile(JRN,RN),
pair_alt(_:[X,Y]),
\+ (
member(J:Rj,JRN),
member(J,S),
\+ p_x((X,Y),Rj)
).
unanimity_in_coalition_for_xy(weak,S, RN,(X,Y)):-
coalition(S,_),
preference_profile(JRN,RN),
pair_alt(_:[X,Y]),
\+ (
member(J:Rj,JRN),
member(J,S),
\+ r_x((X,Y),Rj)
).
% Above two are equivalent either if the ordering is linear or
% if the simple game is proper and strong (See Gaertner, p.40).
% demo
/*
?- unanimity_in_coalition_for_xy(S, RN,XY).
S = [2]
RN = [+, +, +], [+, +, +]
XY = x, y
Yes
?-
*/
%--------------------------------------------------------------
% the cores of a simple game / effectivity function
%--------------------------------------------------------------
% the core <--d the set of undominated outcomes based on unanimity.
% Also see the section of effectivity function
:- dynamic mode_effectivity/2.
mode_effectivity( win, on).
mode_effectivity( eff, off).
%mode_effectivity( win, off).
%mode_effectivity( eff, on).
swap_mode_effectivity(A->B):-
switch_mode_effectivity(A->B).
enforce_mode_effectivity(B):-
mode_effectivity(B,off),
switch_mode_effectivity(_->B),
!.
enforce_mode_effectivity(B):-
mode_effectivity(B,on).
switch_mode_effectivity(A->B):-
retract( mode_effectivity( A, on)),
retract( mode_effectivity( B, off)),
assert( mode_effectivity( A, off)),
assert( mode_effectivity( B, on)).
% dominance (or blocking) relations and cores
% of a simple game / effectivity function
%--------------------------------------------------------------
x_dominates_y_via(win, (X,Y),C,RN):-
win(C,yes),
unanimity_in_coalition_for_xy(strict,C,RN,(X,Y)).
x_dominates_y_via(eff, (B,Y),C,RN):-
eff(C,B),
B \=[],
alt(_:Y),
\+ member(Y,B),
(var(RN)->preference_profile( RN);true),
forall(
member(X,B),
unanimity_in_coalition_for_xy(weak,C,RN,(X,Y))
% unanimity_in_coalition_for_xy(strict,C,RN,(X,Y))
).
x_dominates_y_via((X,Y),C,RN):-
mode_effectivity( T, on),
x_dominates_y_via(T, (X,Y),C,RN).
x_dominates_y((X,Y),RN):-
mode_effectivity( win, on),
pair_alt(_:[X,Y]),
(var(RN)->preference_profile( RN);true),
\+ \+ x_dominates_y_via(win,(X,Y),_,RN).
x_dominates_y((B,Y),RN):-
mode_effectivity( eff, on),
event(B,_),
alt(_:Y),
(var(RN)->preference_profile( RN);true),
\+ \+ x_dominates_y_via(eff,(B,Y),_,RN).
% undominates/2
% sensitive to the background mode effectiveness parameter
undominated_alt(Y,RN):-
alt(_:Y),
preference_profile(RN),
\+ x_dominates_y((_,Y),RN).
% The cores
%--------------------------------------------------------------
core(C, RN):-
preference_profile( RN),
findall( X, undominated_alt(X, RN), C).
core(weak, C, RN):-
core(C, RN).
core(strong, C, RN):-
strong_core(C, RN).
% The strong cores
%--------------------------------------------------------------
% See Abdou and Keiding, p.65, and also Demange, p.1064.
strong_core(C, RN):-
core(D, RN),
(
forall(
is_an_outside_alternativer_against_set(Y,D),
condition_of_strongly_stable_core(_,(Y,D,RN))
)
->C=D
; C=[]
).
is_an_outside_alternativer_against_set(Y,D):-
alt(_:Y),
\+ member(Y, D).
condition_of_strongly_stable_core((S,B,X),(Y,D,RN)):-
is_a_coalition_which_blocks_alternative(S,B,Y,RN),
coalition_unanimously_prefers_a_core_element(X,S,B,Y,D,RN).
is_a_coalition_which_blocks_alternative(S,B,Y,RN):-
x_dominates_y_via((B,Y),S,RN).
coalition_unanimously_prefers_a_core_element(X,_,B,_,D,_):-
member(X,D),
member(X,B).
%coalition_unanimously_prefers_a_core_element(X,S,B,Y,D,RN):-
% member(X,D),
% unanimity_in_coalition_for_xy(weak,S,RN,(X,Y)).
% demo
/*
?- make_preference(strict).
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- set_model(2-person,3-alternative).
Yes
?- switch_mode_effectivity(A).
A = eff->win
Yes
?- verify_win.
game:[[1], [1, 2]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
Yes
?- member(Q,[+,-]),P=[+,+,+],R=[+,+],Prf=(P,[Q|R]),
nl,write(profile:Prf),x_dominates_y_via((X,Y),C,Prf),
nl,write(dom(X,Y);via(C)),fail.
profile: ([+, +, +], [+, +, +])
dom(x, y);via([1])
dom(x, z);via([1])
dom(y, z);via([1])
dom(x, y);via([1, 2])
dom(x, z);via([1, 2])
dom(y, z);via([1, 2])
profile: ([+, +, +], [-, +, +])
dom(x, y);via([1])
dom(x, z);via([1])
dom(y, z);via([1])
dom(x, z);via([1, 2])
dom(y, z);via([1, 2])
No
?- member(Q,[+,-]),P=[+,+,+],R=[+,+],Prf=(P,[Q|R]),
nl,write(profile:Prf),x_dominates_y((X,Y),Prf),
nl,write(dom(X,Y)),fail.
profile: ([+, +, +], [+, +, +])
dom(x, y)
dom(x, z)
dom(y, z)
profile: ([+, +, +], [-, +, +])
dom(x, y)
dom(x, z)
dom(y, z)
No
?- member(Q,[+,-]),P=[+,+,+],R=[+,+],Prf=(P,[Q|R]),
nl,write(profile:Prf),undominated_alt(Y,Prf),
nl,write(undominated(Y)),fail.
profile: ([+, +, +], [+, +, +])
undominated(x)
profile: ([+, +, +], [-, +, +])
undominated(x)
No
?- member(Q,[+,-]),P=[+,+,+],R=[+,+],Prf=(P,[Q|R]),
nl,write(profile:Prf),core(C,Prf),
nl,write(core(C)),fail.
profile: ([+, +, +], [+, +, +])
core([x])
profile: ([+, +, +], [-, +, +])
core([x])
No
?- preference_profile(RN),nl,write(profile:RN),
core(C,RN),write('->':core=C),fail.
profile: ([+, +, +], [+, +, +])(->):core=[x]
profile: ([-, +, +], [+, +, +])(->):core=[y]
profile: ([-, -, +], [+, +, +])(->):core=[y]
profile: ([+, +, -], [+, +, +])(->):core=[x]
profile: ([+, -, -], [+, +, +])(->):core=[z]
profile: ([-, -, -], [+, +, +])(->):core=[z]
profile: ([+, +, +], [-, +, +])(->):core=[x]
profile: ([-, +, +], [-, +, +])(->):core=[y]
profile: ([-, -, +], [-, +, +])(->):core=[y]
profile: ([+, +, -], [-, +, +])(->):core=[x]
profile: ([+, -, -], [-, +, +])(->):core=[z]
profile: ([-, -, -], [-, +, +])(->):core=[z]
profile: ([+, +, +], [-, -, +])(->):core=[x]
profile: ([-, +, +], [-, -, +])(->):core=[y]
profile: ([-, -, +], [-, -, +])(->):core=[y]
profile: ([+, +, -], [-, -, +])(->):core=[x]
profile: ([+, -, -], [-, -, +])(->):core=[z]
profile: ([-, -, -], [-, -, +])(->):core=[z]
profile: ([+, +, +], [+, +, -])(->):core=[x]
profile: ([-, +, +], [+, +, -])(->):core=[y]
profile: ([-, -, +], [+, +, -])(->):core=[y]
profile: ([+, +, -], [+, +, -])(->):core=[x]
profile: ([+, -, -], [+, +, -])(->):core=[z]
profile: ([-, -, -], [+, +, -])(->):core=[z]
profile: ([+, +, +], [+, -, -])(->):core=[x]
profile: ([-, +, +], [+, -, -])(->):core=[y]
profile: ([-, -, +], [+, -, -])(->):core=[y]
profile: ([+, +, -], [+, -, -])(->):core=[x]
profile: ([+, -, -], [+, -, -])(->):core=[z]
profile: ([-, -, -], [+, -, -])(->):core=[z]
profile: ([+, +, +], [-, -, -])(->):core=[x]
profile: ([-, +, +], [-, -, -])(->):core=[y]
profile: ([-, -, +], [-, -, -])(->):core=[y]
profile: ([+, +, -], [-, -, -])(->):core=[x]
profile: ([+, -, -], [-, -, -])(->):core=[z]
profile: ([-, -, -], [-, -, -])(->):core=[z]
No
?-
*/
%--------------------------------------------------------------
% the necessary and sufficient condition of
% stablity of the cores
% for simple games / effectivity functions
%--------------------------------------------------------------
% a simpl game is stable <==def.
% For every profile, there is nonempty core of the game.
% the NAKAMURA NUMBER v(G) (or rank)
%--------------------------------------------------------------
% The minimal number of winning coalitions with empty intersection.
% Nakamura(1979)'s theorem.
% Let M the number (cardinality) of alternatives.
% (1) a simple game G is stable iff condition (NN>M) is true.
% (2) the dominance relation is acyclic for any profile iff NN>M.
is_Nakamura_number(999,'weak'):-
\+ win_coalitions_with_empty_intersection(W,W,_,_),
!.
is_Nakamura_number(K,Sw):-
min_cardinality_of_win_coalitions_with_empty_intersection(K,Sw).
min_cardinality_of_win_coalitions_with_empty_intersection(K,Sw):-
win_coalitions_with_empty_intersection(Sw,K),
\+ (
win_coalitions_with_empty_intersection(_,L),
L < K
),
!.
win_coalitions_with_empty_intersection(S,K):-
win_coalitions_with_empty_intersection(S,_,_,K).
win_coalitions_with_empty_intersection(S,W,P,K):-
all_winning_coalitions(W),
wins_intersection(S,W,P,[],K),
S\=[].
wins_intersection([],[],[],N,0):-all_agents(N).
wins_intersection(S,[_|W],[0|P],V,K):-
wins_intersection(S,W,P,V,K).
wins_intersection([C|S],[C|W],[1|P],V,K):-
wins_intersection(S,W,P,V0,K0),
intersection(V0,C,V),
K is K0 +1.
min_cardinality_of_win_coalitions_with_empty_intersection_1(K/M,Sw):-
max_cardinality_of_win_coalitions_with_nonempty_intersection(L/M,Tw),
K is M - L,
complementary_pair_of_group(Sw,Tw,_).
is_dual_Nakamura_number(K,V,Sw):-
max_cardinality_of_win_coalitions_with_nonempty_intersection(K,V,Sw).
max_cardinality_of_win_coalitions_with_nonempty_intersection(K,V,Sw):-
win_coalitions_with_nonempty_intersection(Sw,V,K),
\+ (
win_coalitions_with_nonempty_intersection(_,_,L),
L > K
),
!.
win_coalitions_with_nonempty_intersection(S,V,K):-
win_coalitions_with_nonempty_intersection(S,_,_,V,K).
win_coalitions_with_nonempty_intersection(S,W,P,V,K):-
all_winning_coalitions(W),
wins_intersection(S,W,P,V,K),
V\=[].
is_acyclic_dom_relation( M[E]),fail.
[[1], [1, 2]]->[3<999]
[[1]]->[3<999]
[[2], [1, 2]]->[3<999]
[[2]]->[3<999]
[[1, 2]]->[3<999]
No
?- gen_win(W),is_Nakamura_number(A,C),nl,write((rank=A,game:W)),
preference_profile(SW),core([],SW->O).
rank=2, game:[[1], [2], [1, 2]]
rank=2, game:[[1], [2]]
rank=999, game:[[1], [1, 2]]
rank=999, game:[[1]]
rank=999, game:[[2], [1, 2]]
rank=999, game:[[2]]
rank=999, game:[[1, 2]]
No
?-
*/
% N=[1,2,3] the taro-hanako-jiro society case.
/*
?- gen_win(W),is_Nakamura_number(NN,C), NN\=999,
verify_win([yes,yes|I]),verify_win,
nl,write(game:W),(tab(1),write(rank:NN;C)),fail.
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is strong
is not weak
is essential
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]] rank:3;[[2, 3], [1, 3], [1, 2]]
No
?- setof(C,RN^core(C,RN),L),nl,write(L),fail.
[[x, y, z]]
No
?- gen_win(W),is_Nakamura_number(NN,C), NN\=999,NN>=3,
verify_win,nl,write(game:W),(tab(1),write(rank:NN;C)).
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is strong
is not weak
is essential
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]] rank:3;[[2, 3], [1, 3], [1, 2]]
W = [[1, 2], [1, 3], [2, 3], [1, 2, 3]]
NN = 3
C = [[2, 3], [1, 3], [1, 2]] ;
game:[[2, 3], [1, 3], [1, 2]]
is proper
is not weak
is essential
game:[[1, 2], [1, 3], [2, 3]] rank:3;[[2, 3], [1, 3], [1, 2]]
W = [[1, 2], [1, 3], [2, 3]]
NN = 3
C = [[2, 3], [1, 3], [1, 2]] ;
No
?- setof(C,RN^core(C,RN),L),nl,write(L),fail.
[[x, y, z]]
No
?-
*/
% core correspondence and generating stable simple games
%--------------------------------------------------------------
core_correspondence(ARN,D):-
core_correspondence(weak,ARN,D).
core_correspondence(T,ARN,D):-
findall(P,preference_profile(P),ARN),
make_core_correspondence(T,ARN,D).
make_core_correspondence(_,[],[]).
make_core_correspondence(T,[RN|B],[RN->C|D]):-
make_core_correspondence(T,B,D),
core(T,C,RN).
make_core_correspondence(_,[],[]).
make_core_correspondence(T,[RN|B],[RN->C|D]):-
make_core_correspondence(T,B,D),
core(T,C,RN).
show_scc(_):-
cores_header(H),
write('cores_#cols':H),
fail.
show_scc(H):-
bagof(K,Q^S^
cores_cell(H,(P,Q)->S,K),
L),
r_x(J,P,_,_,_),
nl,
write(P=J:L),
fail.
show_scc(_).
cores_header(H):-
findall(K,r_x(K,_,_,_,_),H).
cores_cell(H,(P,Q)->S,K):-
member((P,Q)->S,H),
K=S.
% Direct computation of
% stability of simple game / effectivity function
%-------------------------------------------------
is_stable_core:- \+ empty_core(_).
empty_core(R):- core(C,R), C=[].
/*
?- switch_mode_effectivity(A).
A = eff->win
Yes
?- verify_win.
game:[[1], [1, 2]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
Yes
?- core_correspondence(_,B),show_scc(B),!,fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [x], [x], [x], [x]]
[-, +, +]=3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]=9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]=19:[[x], [x], [x], [x], [x], [x]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]
No
?- gen_win(W),core_correspondence(_,B),\+ \+ member(_->[],B),
write(game:W),nl,show_scc(B),nl,fail.
game:[[1], [2], [1, 2]]
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [], [], [x], [], []]
[-, +, +]=3:[[], [y], [y], [], [], []]
[-, -, +]=9:[[], [y], [y], [], [], []]
[+, +, -]=19:[[x], [], [], [x], [], []]
[+, -, -]=25:[[], [], [], [], [z], [z]]
[-, -, -]=27:[[], [], [], [], [z], [z]]
game:[[1], [2]]
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [], [], [x], [], []]
[-, +, +]=3:[[], [y], [y], [], [], []]
[-, -, +]=9:[[], [y], [y], [], [], []]
[+, +, -]=19:[[x], [], [], [x], [], []]
[+, -, -]=25:[[], [], [], [], [z], [z]]
[-, -, -]=27:[[], [], [], [], [z], [z]]
No
?- switch_mode_effectivity(A).
A = win->eff
Yes
?- member(Q,[+,-]),P=[+,+,+],R=[+,+],Prf=(P,[Q|R]),
nl,write(profile:Prf),x_dominates_y_via((X,Y),C,Prf),
nl,write(dom(X,Y);via(C)),fail.
profile: ([+, +, +], [+, +, +])
dom([x], y);via([1])
dom([x], z);via([1])
dom([y], z);via([1])
dom([x, y], z);via([1])
dom([y], z);via([1, 2])
dom([x], y);via([1, 2])
dom([x], z);via([1, 2])
dom([x, y], z);via([1, 2])
profile: ([+, +, +], [-, +, +])
dom([x], y);via([1])
dom([x], z);via([1])
dom([y], z);via([1])
dom([x, y], z);via([1])
dom([y], z);via([1, 2])
dom([x], z);via([1, 2])
dom([x, y], z);via([1, 2])
No
?
*/
%--------------------------------------------------------------
% cycle of dominance relations (i.e., emptyness of core)
%--------------------------------------------------------------
% 27-29 Oct 2006
cycle_of_dominance(W,X0,RN):-
% preference_profile(RN),
chain_of_dominance(W,(X,X0,RN)),
(mode_effectivity( eff,on)->member(X0,X);X=X0).
chain_of_dominance(W,XRN):-
all_coalitions(L),
chain_of_dominance(L,W,XRN),
W \=[].
chain_of_dominance([],[],(X0,X0,_)).
chain_of_dominance(L,W,(Y,X0,RN)):-
L \=[],
subtract(L,[_],L1),
chain_of_dominance(L1,W,(Y,X0,RN)).
chain_of_dominance(L,[(X,S,Y)|W],(X,X0,RN)):-
L \=[],
subtract(L,[S],L1),
chain_of_dominance(L1,W,(Y0,X0,RN)),
x_dominates_y_via((X,Y),S,RN),
(mode_effectivity( eff,on)->member(Y,Y0);Y=Y0).
/*
?- enforce_mode_effectivity(A).
A = win
Yes
?- verify_win.
game:[[1], [1, 2], [1, 2, 3]]
is proper
is weak with veto players:[1]
is essential
Yes
?- cycle_of_dominance(L,W,ZXRN).
No
?- gen_win(_),verify_win,
cycle_of_dominance(L,W,ZXRN).
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2], [3], [2], [1]]
is monotonic
is strong
is not weak
is essential
L = [ (z, [1, 2], x), (x, [1, 3], y), (y, [2, 3], z)]
W = z
ZXRN = [+, -, -], [-, -, +], [+, +, +]
Yes
?- set_model(2-person,3-alternative).
Yes
?- gen_win(_),verify_win,
cycle_of_dominance(L,W,ZXRN).
game:[[1, 2], [1], [2]]
is monotonic
is strong
is not weak
is essential
L = [ (x, [2], y), (y, [1], x)]
W = x
ZXRN = [-, +, +], [+, +, +]
Yes
?-
?- gen_win(_),nl,verify_win,
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),
setof(RN,cycle_of_dominance(Cycle,X,RN),L),nl,write(X:Cycle),
length(L,K),(K>=10->(findall(R,(preference_profile(R),\+ member(R,L)),L1),nl,write('except for:'));L1=L),forall(member(C,L1),(nl,write(C))),fail.
game:[[1, 2], [1], [2]]
is monotonic
is strong
is not weak
is essential
core stability:[fail, fail]
eff:[true, true, fail, fail, true, fail]
y:[ (y, [2], z), (z, [1], y)]
[+, +, -], [+, +, +]
[+, +, -], [-, +, +]
[+, +, -], [-, -, +]
[+, -, -], [+, +, +]
[+, -, -], [-, +, +]
[+, -, -], [-, -, +]
[-, -, -], [+, +, +]
[-, -, -], [-, +, +]
[-, -, -], [-, -, +]
x:[ (x, [2], z), (z, [1], x)]
[+, -, -], [+, +, +]
[+, -, -], [+, +, -]
[+, -, -], [-, +, +]
[-, -, +], [+, +, +]
[-, -, +], [+, +, -]
[-, -, +], [-, +, +]
[-, -, -], [+, +, +]
[-, -, -], [+, +, -]
[-, -, -], [-, +, +]
x:[ (x, [2], y), (y, [1], x)]
[-, +, +], [+, +, +]
[-, +, +], [+, +, -]
[-, +, +], [+, -, -]
[-, -, +], [+, +, +]
[-, -, +], [+, +, -]
[-, -, +], [+, -, -]
[-, -, -], [+, +, +]
[-, -, -], [+, +, -]
[-, -, -], [+, -, -]
z:[ (z, [2], y), (y, [1], z)]
[+, +, +], [+, +, -]
[+, +, +], [+, -, -]
[+, +, +], [-, -, -]
[-, +, +], [+, +, -]
[-, +, +], [+, -, -]
[-, +, +], [-, -, -]
[-, -, +], [+, +, -]
[-, -, +], [+, -, -]
[-, -, +], [-, -, -]
z:[ (z, [2], x), (x, [1], z)]
[+, +, +], [+, -, -]
[+, +, +], [-, -, +]
[+, +, +], [-, -, -]
[+, +, -], [+, -, -]
[+, +, -], [-, -, +]
[+, +, -], [-, -, -]
[-, +, +], [+, -, -]
[-, +, +], [-, -, +]
[-, +, +], [-, -, -]
y:[ (y, [2], x), (x, [1], y)]
[+, +, +], [-, +, +]
[+, +, +], [-, -, +]
[+, +, +], [-, -, -]
[+, +, -], [-, +, +]
[+, +, -], [-, -, +]
[+, +, -], [-, -, -]
[+, -, -], [-, +, +]
[+, -, -], [-, -, +]
[+, -, -], [-, -, -]
y:[ (y, [2], z), (z, [1], x), (x, [1, 2], y)]
[+, -, -], [+, +, +]
x:[ (x, [2], z), (z, [1], y), (y, [1, 2], x)]
[-, -, -], [-, +, +]
z:[ (z, [2], x), (x, [1], y), (y, [1, 2], z)]
[+, +, +], [-, -, +]
z:[ (z, [2], y), (y, [1], x), (x, [1, 2], z)]
[-, +, +], [+, +, -]
x:[ (x, [2], y), (y, [1], z), (z, [1, 2], x)]
[-, -, +], [+, -, -]
y:[ (y, [2], x), (x, [1], z), (z, [1, 2], y)]
[+, +, -], [-, -, -]
game:[[1], [2]]
is not weak
is essential
core stability:[fail, fail]
eff:[fail, fail, fail, fail, fail, fail]
y:[ (y, [2], z), (z, [1], y)]
[+, +, -], [+, +, +]
[+, +, -], [-, +, +]
[+, +, -], [-, -, +]
[+, -, -], [+, +, +]
[+, -, -], [-, +, +]
[+, -, -], [-, -, +]
[-, -, -], [+, +, +]
[-, -, -], [-, +, +]
[-, -, -], [-, -, +]
x:[ (x, [2], z), (z, [1], x)]
[+, -, -], [+, +, +]
[+, -, -], [+, +, -]
[+, -, -], [-, +, +]
[-, -, +], [+, +, +]
[-, -, +], [+, +, -]
[-, -, +], [-, +, +]
[-, -, -], [+, +, +]
[-, -, -], [+, +, -]
[-, -, -], [-, +, +]
x:[ (x, [2], y), (y, [1], x)]
[-, +, +], [+, +, +]
[-, +, +], [+, +, -]
[-, +, +], [+, -, -]
[-, -, +], [+, +, +]
[-, -, +], [+, +, -]
[-, -, +], [+, -, -]
[-, -, -], [+, +, +]
[-, -, -], [+, +, -]
[-, -, -], [+, -, -]
z:[ (z, [2], y), (y, [1], z)]
[+, +, +], [+, +, -]
[+, +, +], [+, -, -]
[+, +, +], [-, -, -]
[-, +, +], [+, +, -]
[-, +, +], [+, -, -]
[-, +, +], [-, -, -]
[-, -, +], [+, +, -]
[-, -, +], [+, -, -]
[-, -, +], [-, -, -]
z:[ (z, [2], x), (x, [1], z)]
[+, +, +], [+, -, -]
[+, +, +], [-, -, +]
[+, +, +], [-, -, -]
[+, +, -], [+, -, -]
[+, +, -], [-, -, +]
[+, +, -], [-, -, -]
[-, +, +], [+, -, -]
[-, +, +], [-, -, +]
[-, +, +], [-, -, -]
y:[ (y, [2], x), (x, [1], y)]
y:[ (y, [2], x), (x, [1], y)]
[+, +, +], [-, +, +]
[+, +, +], [-, -, +]
[+, +, +], [-, -, -]
[+, +, -], [-, +, +]
[+, +, -], [-, -, +]
[+, +, -], [-, -, -]
[+, -, -], [-, +, +]
[+, -, -], [-, -, +]
[+, -, -], [-, -, -]
game:[[1, 2], [2]]
is monotonic
is proper
is strong
is weak with veto players:[2]
is inessential with a dictator:2
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[2]]
is proper
is weak with veto players:[2]
is essential
core stability:[true, fail]
eff:[fail, fail, fail, true, fail, true]
game:[[1, 2], [1]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
core stability:[true, fail]
eff:[fail, fail, fail, true, fail, true]
game:[[1]]
is proper
is weak with veto players:[1]
is essential
core stability:[true, fail]
eff:[fail, fail, fail, true, fail, true]
game:[[1, 2]]
is monotonic
is proper
is weak with veto players:[1, 2]
is essential
core stability:[true, fail]
eff:[true, true, fail, true, fail, true]
No
?-
?- set_model(3-person,3-alternative).
Yes
?- gen_win(W),verify_win([yes,yes,yes|T]),nl,nl,write(game:W),nl,write(T),
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),
setof(RN,cycle_of_dominance(Cycle,X,RN),L),nl,write(X:Cycle),
length(L,K),(K>=10->(findall(R,(preference_profile(R),
\+ member(R,L)),L1),nl,write('except for:'));L1=L),
forall(member(C,L1),(nl,write(C))),fail.
game:[[3], [2, 3], [1, 3], [1, 2, 3]]
[yes([3]), no]
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[2], [2, 3], [1, 2], [1, 2, 3]]
[yes([2]), no]
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[2, 3], [1, 3], [1, 2], [1, 2, 3]]
[no, yes]
core stability:[fail, fail]
eff:[true, true, fail, true, true, fail]
x:[ (x, [2, 3], y), (y, [1, 3], z), (z, [1, 2], x)]
[-, -, +], [+, -, -], [+, +, +]
y:[ (y, [2, 3], x), (x, [1, 3], z), (z, [1, 2], y)]
[+, +, -], [-, -, -], [-, +, +]
y:[ (y, [2, 3], z), (z, [1, 3], x), (x, [1, 2], y)]
[+, -, -], [+, +, +], [-, -, +]
x:[ (x, [2, 3], z), (z, [1, 3], y), (y, [1, 2], x)]
[-, -, -], [-, +, +], [+, +, -]
z:[ (z, [2, 3], x), (x, [1, 3], y), (y, [1, 2], z)]
[+, +, +], [-, -, +], [+, -, -]
z:[ (z, [2, 3], y), (y, [1, 3], x), (x, [1, 2], z)]
[-, +, +], [+, +, -], [-, -, -]
game:[[1], [1, 3], [1, 2], [1, 2, 3]]
[yes([1]), no]
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
No
?-
?- make_preference(weak).
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- set_model(2-person,3-alternative).
Yes
?- gen_win(W),verify_win([yes,yes,yes|T]),nl,nl,write(game:W),nl,write(T),
verify_eff(S,EF),nl,write('core stability':S),nl,write(eff:EF),
setof(RN,cycle_of_dominance(Cycle,X,RN),L),nl,write(X:Cycle),
length(L,K),(K>=10->(findall(R,(preference_profile(R),
\+ member(R,L)),L1),nl,write('except for:'));L1=L),
forall(member(C,L1),(nl,write(C))),fail.
game:[[2], [1, 2]]
[yes([2]), no]
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
game:[[1], [1, 2]]
[yes([1]), no]
core stability:[true, fail]
eff:[true, true, fail, true, true, true]
No
?-
*/
%--------------------------------------------------------------
% aggregated group ordering (SWO)
%--------------------------------------------------------------
% revised: 6 Nov 2006
aggregated_preference(AO,RN->RS):-
all_agents(N),
n_person_preference_profile([s|N],AO,(RS,RN)).
aggregated_preference(V,[s:RS|AO],RN->RS):-
all_agents(N),
n_person_preference_profile(N,AO,RN),
r_0(_,RS,_,V0,B),
filter_for_aggregated_preference(V,RS,V0,B).
filter_for_aggregated_preference(V,R,V0,B):-
((var(R);var(V0))->r_0(_,R,_,V0,B);true),
member(A,V),
member(A,[trans,weak]),
V0=[consistent,_,complete],
is_transitive(B).
filter_for_aggregated_preference(V,_,V0,B):-
((var(R);var(V0))->r_0(_,R,_,V0,B);true),
member(A,V),
member(A,[strict,linear]),
V0=[consistent,_,complete],
is_transitive(B),
is_anti_symmetric(B).
% dominance (unanimity) based social preference relation
%--------------------------------------------------------------
% added: 5 -6 Nov 2006
% comparison with r_0
:- dynamic mode_unanimity/2.
mode_unanimity(A):- mode_unanimity(A,on).
mode_unanimity(1,on).
mode_unanimity(2,off).
change_mode_unanimity(A->B):-
var(B),
retract( mode_unanimity(A,on)),
retract( mode_unanimity(B,off)),
assert( mode_unanimity(B,on)),
assert( mode_unanimity(A,off)).
change_mode_unanimity(A->B):-
\+ var(B),
mode_unanimity(A,off),
mode_unanimity(B,on).
change_mode_unanimity(A->B):-
\+ var(B),
mode_unanimity(B,off),
change_mode_unanimity(A->_).
inspect_unanimity_based_preference(K,R,RN,D,P):-
mode_unanimity(1,on),
(var(RN)->preference_profile(RN);true),
findall((X,Y),x_dominates_y((X,Y), RN),D),
r_0(K,R,_,_,B),
findall((X,Y), p((X,Y),B), P).
inspect_unanimity_based_preference(K,R,RN,D,B):-
mode_unanimity(2,on),
(var(RN)->preference_profile(RN);true),
findall((X,Y),
(
pair_alt(_:[X,Y]),X\=Y,
\+ x_dominates_y((Y,X), RN)
),
D),
r_0(K,R,_,_,B).
is_unanimity_based_preference(K,R,RN):-
inspect_unanimity_based_preference(K,R,RN,D,P),
subset(D,P),
subset(P,D).
is_unanimity_based_preference(K,R,RN,Y):-
preference_profile(RN),
(is_unanimity_based_preference(K,R,RN)
->Y=true
;(Y=fail,K=0,R='***')
).
unanimity_based_preference_profile(SOC,SOC1,COL):-
findall(K:R:RN,
(
is_unanimity_based_preference(K,R,RN,_)
),
COL),
findall(RN->R,
member(K:R:RN, COL),
SOC),
findall(RN->K,
member(K:R:RN, COL),
SOC1).
% demo for 3-person 3-alternative simple games.
%--------------------------------------------------------------
/*
?- linear_ordering.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- show_model.
agents:[1, 2, 3]
alternatives:[x, y, z]
coalitions:[[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]]
Yes
?- verify_win.
game:[[1], [1, 2], [1, 2, 3]]
is proper
is weak with veto players:[1]
is essential
Yes
?-
*/
% mode 1 : unanimity dominance -> strict SWO
% mode 2 : unanimity undominance -> weak SWO
/*
?- mode_unanimity(A).
A = 1
Yes
?- is_unanimity_based_preference(K,R,RN,Y),RN=(A,B,C),
r_0(I,A,_,_,_),r_0(J,B,_,_,_),r_0(H,C,_,_,_),J=1,H=1,
nl,write((I,J,H)=RN;K=R),fail.
(1, 1, 1)= ([+, +, +], [+, +, +], [+, +, +]);1=[+, +, +]
(3, 1, 1)= ([-, +, +], [+, +, +], [+, +, +]);3=[-, +, +]
(9, 1, 1)= ([-, -, +], [+, +, +], [+, +, +]);9=[-, -, +]
(19, 1, 1)= ([+, +, -], [+, +, +], [+, +, +]);19=[+, +, -]
(25, 1, 1)= ([+, -, -], [+, +, +], [+, +, +]);25=[+, -, -]
(27, 1, 1)= ([-, -, -], [+, +, +], [+, +, +]);27=[-, -, -]
No
% There are some games without/with incomplete relations
?- gen_win(W),
\+ (is_unanimity_based_preference(_,_,_,Y),Y\=true).
W = [[1], [1, 2], [1, 3], [1, 2, 3]]
Y= _G162
Yes
?- gen_win(W),
is_unanimity_based_preference(K,R,RN,Y),Y\=true,nl,write(game:W).
game:[[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]]
W = [[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2|...]]
K = 0
R = ***
RN = [-, +, +], [+, +, +], [+, +, +]
Y = fail
Yes
?- W=[[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]],
gen_win(W), inspect_unanimity_based_preference(K,R,RN,D,P),
r_0(K,_,_,_,B),member((X,Y),D),member((Y,X),D).
W = [[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2|...]]
K = 1
R = [+, +, +]
RN = [-, +, +], [+, +, +], [+, +, +]
D = [ (x, y), (x, z), (y, x), (y, z)]
P = [ (x, y), (x, z), (y, z)]
B = [ (x, y), (x, z), (y, z)]
X = x
Y = y
Yes
?-
% There are some games without/with intransitive relations
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),r_0(K,_,_,_,B),
\+ is_transitive(B)),nl,write(game:W).
game:[[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]]
W = [[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2|...]]
K = _G159
R = _G160
RN = _G161
Y = _G162
B = _G168
Yes
?-
% It will take some minutes for next run.
?- gen_win(W),
is_unanimity_based_preference(K,R,RN,Y),r_0(K,_,_,_,B),
\+ is_transitive(B),nl,write(game:W).
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]]
W = [[1, 2], [1, 3], [2, 3], [1, 2, 3]]
K = 7
R = [+, -, +]
RN = [+, -, -], [-, -, +], [+, +, +]
Y = true
B = [ (x, y), (z, x), (y, z)]
Yes
?- gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
r_0(K,_,_,_,B),\+ is_transitive(B)),nl,write(game:W),fail.
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]]
game:[[1, 2], [1, 3], [2, 3]]
game:[[1, 2], [1, 3], [1, 2, 3]]
game:[[1, 2], [1, 3]]
game:[[1, 2], [2, 3], [1, 2, 3]]
game:[[1, 2], [2, 3]]
game:[[1, 2], [1, 2, 3]]
game:[[1, 2]]
game:[[1, 3], [2, 3], [1, 2, 3]]
game:[[1, 3], [2, 3]]
game:[[1, 3], [1, 2, 3]]
game:[[1, 3]]
game:[[2, 3], [1, 2, 3]]
game:[[2, 3]]
game:[[1, 2, 3]]
No
?- gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
r_0(K,_,_,_,B),\+ is_q_trans(B)),nl,write(game:W),fail.
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]]
game:[[1, 2], [1, 3], [2, 3]]
game:[[1, 2], [1, 3], [1, 2, 3]]
game:[[1, 2], [1, 3]]
game:[[1, 2], [2, 3], [1, 2, 3]]
game:[[1, 2], [2, 3]]
game:[[1, 3], [2, 3], [1, 2, 3]]
game:[[1, 3], [2, 3]]
No
?-
*/
% NOTE:
% Above result will be reproduced by changing mode_unanimity/2.
game_of_intransitive(1:[[1, 2], [1, 3], [2, 3], [1, 2, 3]]).
game_of_intransitive(2:[[1, 2], [1, 3], [2, 3]]).
game_of_intransitive(3:[[1, 2], [1, 3], [1, 2, 3]]).
game_of_intransitive(4:[[1, 2], [1, 3]]).
game_of_intransitive(5:[[1, 2], [2, 3], [1, 2, 3]]).
game_of_intransitive(6:[[1, 2], [2, 3]]).
game_of_intransitive(7:[[1, 2], [1, 2, 3]]).
game_of_intransitive(8:[[1, 2]]).
game_of_intransitive(9:[[1, 3], [2, 3], [1, 2, 3]]).
game_of_intransitive(10:[[1, 3], [2, 3]]).
game_of_intransitive(11:[[1, 3], [1, 2, 3]]).
game_of_intransitive(12:[[1, 3]]).
game_of_intransitive(13:[[2, 3], [1, 2, 3]]).
game_of_intransitive(14:[[2, 3]]).
game_of_intransitive(15:[[1, 2, 3]]).
% inspecting further above games of involving the intransitivity.
/*
?- game_of_intransitive(J:W),gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true).
No
?- game_of_intransitive(J:W),gen_win(W),verify_win,fail.
game:[[1, 2, 3], [2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is strong
is not weak
is essential
game:[[2, 3], [1, 3], [1, 2]]
is proper
is not weak
is essential
game:[[1, 2, 3], [1, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[1]
is essential
game:[[1, 3], [1, 2]]
is proper
is weak with veto players:[1]
is essential
game:[[1, 2, 3], [2, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[2]
is essential
game:[[2, 3], [1, 2]]
is proper
is weak with veto players:[2]
is essential
game:[[1, 2, 3], [1, 2]]
is monotonic
is proper
is weak with veto players:[1, 2]
is essential
game:[[1, 2]]
is proper
is weak with veto players:[1, 2]
is essential
game:[[1, 2, 3], [2, 3], [1, 3]]
is monotonic
is proper
is weak with veto players:[3]
is essential
game:[[2, 3], [1, 3]]
is proper
is weak with veto players:[3]
is essential
game:[[1, 2, 3], [1, 3]]
is monotonic
is proper
is weak with veto players:[1, 3]
is essential
game:[[1, 3]]
is proper
is weak with veto players:[1, 3]
is essential
game:[[1, 2, 3], [2, 3]]
is monotonic
is proper
is weak with veto players:[2, 3]
is essential
game:[[2, 3]]
is proper
is weak with veto players:[2, 3]
is essential
game:[[1, 2, 3]]
is monotonic
is proper
is weak with veto players:[1, 2, 3]
is essential
No
?-
*/
% there are no games without singlton where unanimity forms tansitivity
/*
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y=true,r_0(K,_,_,_,B),
\+ is_transitive(B)),\+ member([_],W),nl,write(game:W),fail.
No
?-
*/
% Some proper games have no quasi-transitive orderings.
% revised: 9 Nov 2006
% modified the display format and added the violated cases.
/*
?- gen_win(W),verify_win([yes,yes,_,V|_]),
\+ (is_unanimity_based_preference(K,R,RN,Y),
(Y\=true ;\+ r_0(K,R,_,[_,q-trans,_],_))),
nl,write(W), tab(1), write(vetoers=V),fail.
[[1], [1, 2], [1, 3], [1, 2, 3]] vetoers=yes([1])
[[2], [1, 2], [2, 3], [1, 2, 3]] vetoers=yes([2])
[[3], [1, 3], [2, 3], [1, 2, 3]] vetoers=yes([3])
[[1, 2], [1, 2, 3]] vetoers=yes([1, 2])
[[1, 3], [1, 2, 3]] vetoers=yes([1, 3])
[[2, 3], [1, 2, 3]] vetoers=yes([2, 3])
[[1, 2, 3]] vetoers=yes([1, 2, 3])
No
?- gen_win(W),verify_win([yes,yes,_,V|_]),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_)), nl,write(W), tab(1), write(vetoers=V),fail.
[[1, 2], [1, 3], [2, 3], [1, 2, 3]] vetoers=no
[[1, 2], [1, 3], [1, 2, 3]] vetoers=yes([1])
[[1, 2], [2, 3], [1, 2, 3]] vetoers=yes([2])
[[1, 3], [2, 3], [1, 2, 3]] vetoers=yes([3])
No
?-
*/
% voter's paradox and latin squares (Condorcet cycles)
% and violations against quasi-transitivity in majority decisions.
% 9-10 Nov 2006
/*
?- r_0(7,R,A,B,C).
R = [+, -, +]
A = [ (x, y): +, (x, z): -, (y, z): +]
B = [inconsistent, not(q-trans), complete]
C = [ (x, y), (z, x), (y, z)]
Yes
?- W = [[1, 2], [1, 3], [2, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
r_0(K,[+,-,+],_,_,B),
profile_in_numbers(RN,NR),nl,write(K:R;NR:RN),fail.
7:[+, -, +];[25, 9, 1]: ([+, -, -], [-, -, +], [+, +, +])
7:[+, -, +];[9, 25, 1]: ([-, -, +], [+, -, -], [+, +, +])
7:[+, -, +];[25, 1, 9]: ([+, -, -], [+, +, +], [-, -, +])
7:[+, -, +];[1, 25, 9]: ([+, +, +], [+, -, -], [-, -, +])
7:[+, -, +];[9, 1, 25]: ([-, -, +], [+, +, +], [+, -, -])
7:[+, -, +];[1, 9, 25]: ([+, +, +], [-, -, +], [+, -, -])
No
?- r_0(K,[+,'0',+],A,B,C).
K = 4
A = [ (x, y): +, (x, z):'0', (y, z): +]
B = [consistent, not(q-trans), complete]
C = [ (x, y), (x, z), (z, x), (y, z)]
Yes
?- W = [[1, 2], [1, 3], [2, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
r_0(K,[+,'0',+],_,_,B),
profile_in_numbers(RN,NR),nl,write(K:R;NR:RN),fail.
4:[+, 0, +];[22, 6, 1]: ([+, 0, -], [-, 0, +], [+, +, +])
4:[+, 0, +];[25, 6, 1]: ([+, -, -], [-, 0, +], [+, +, +])
4:[+, 0, +];[22, 9, 1]: ([+, 0, -], [-, -, +], [+, +, +])
4:[+, 0, +];[6, 22, 1]: ([-, 0, +], [+, 0, -], [+, +, +])
4:[+, 0, +];[9, 22, 1]: ([-, -, +], [+, 0, -], [+, +, +])
4:[+, 0, +];[6, 25, 1]: ([-, 0, +], [+, -, -], [+, +, +])
4:[+, 0, +];[22, 1, 6]: ([+, 0, -], [+, +, +], [-, 0, +])
4:[+, 0, +];[25, 1, 6]: ([+, -, -], [+, +, +], [-, 0, +])
4:[+, 0, +];[1, 22, 6]: ([+, +, +], [+, 0, -], [-, 0, +])
4:[+, 0, +];[1, 25, 6]: ([+, +, +], [+, -, -], [-, 0, +])
4:[+, 0, +];[22, 1, 9]: ([+, 0, -], [+, +, +], [-, -, +])
4:[+, 0, +];[1, 22, 9]: ([+, +, +], [+, 0, -], [-, -, +])
4:[+, 0, +];[6, 1, 22]: ([-, 0, +], [+, +, +], [+, 0, -])
4:[+, 0, +];[9, 1, 22]: ([-, -, +], [+, +, +], [+, 0, -])
4:[+, 0, +];[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -])
4:[+, 0, +];[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -])
4:[+, 0, +];[6, 1, 25]: ([-, 0, +], [+, +, +], [+, -, -])
4:[+, 0, +];[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -])
No
?- findall(NR,(is_unanimity_based_preference(K,R,RN,Y),
r_0(K,[+,'0',+],_,_,B),profile_in_numbers(RN,NR1),
sort(NR1,NR)),L1),sort(L1,L),nl,write(L).
[[1, 6, 22], [1, 6, 25], [1, 9, 22]]
Yes
?- preference_profile(RN),profile_in_numbers(RN,NR),
member(NR,[[1,9,25],[1,6,22],[1,6,25],[1,9,22]]),
nl,write(NR:RN),fail.
[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -])
[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -])
[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -])
[1, 9, 25]: ([+, +, +], [-, -, +], [+, -, -])
No
?-
*/
% inspecting the approchability to the latin squares (majority)
/*
?- W=[[1, 2], [1, 3], [2, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),profile_in_numbers(RN,NR),
NR=[A,B,C],findall(1,(A=1;B=9;C=25),L),L=[_],nl,write(K:R;NR:RN;Y),fail.
4:[+, 0, +];[22, 9, 1]: ([+, 0, -], [-, -, +], [+, +, +]);true
7:[+, -, +];[25, 9, 1]: ([+, -, -], [-, -, +], [+, +, +]);true
8:[0, -, +];[26, 9, 1]: ([0, -, -], [-, -, +], [+, +, +]);true
8:[0, -, +];[25, 9, 2]: ([+, -, -], [-, -, +], [0, +, +]);true
8:[0, -, +];[26, 9, 2]: ([0, -, -], [-, -, +], [0, +, +]);true
4:[+, 0, +];[1, 22, 6]: ([+, +, +], [+, 0, -], [-, 0, +]);true
4:[+, 0, +];[1, 25, 6]: ([+, +, +], [+, -, -], [-, 0, +]);true
4:[+, 0, +];[1, 22, 9]: ([+, +, +], [+, 0, -], [-, -, +]);true
7:[+, -, +];[1, 25, 9]: ([+, +, +], [+, -, -], [-, -, +]);true
8:[0, -, +];[1, 26, 9]: ([+, +, +], [0, -, -], [-, -, +]);true
16:[+, -, 0];[25, 9, 10]: ([+, -, -], [-, -, +], [+, +, 0]);true
16:[+, -, 0];[1, 25, 18]: ([+, +, +], [+, -, -], [-, -, 0]);true
4:[+, 0, +];[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -]);true
4:[+, 0, +];[6, 1, 25]: ([-, 0, +], [+, +, +], [+, -, -]);true
7:[+, -, +];[9, 1, 25]: ([-, -, +], [+, +, +], [+, -, -]);true
16:[+, -, 0];[18, 1, 25]: ([-, -, 0], [+, +, +], [+, -, -]);true
8:[0, -, +];[9, 2, 25]: ([-, -, +], [0, +, +], [+, -, -]);true
16:[+, -, 0];[9, 10, 25]: ([-, -, +], [+, +, 0], [+, -, -]);true
16:[+, -, 0];[18, 10, 25]: ([-, -, 0], [+, +, 0], [+, -, -]);true
8:[0, -, +];[2, 9, 26]: ([0, +, +], [-, -, +], [0, -, -]);true
No
?- W=[[1, 2], [1, 3], [2, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),profile_in_numbers(RN,NR),
NR=[A,B,C],findall(1,(A=1;B=9;C=25),L),L=[_,_],nl,write(K:R;NR:RN;Y),fail.
4:[+, 0, +];[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -]);true
4:[+, 0, +];[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -]);true
8:[0, -, +];[2, 9, 25]: ([0, +, +], [-, -, +], [+, -, -]);true
16:[+, -, 0];[10, 9, 25]: ([+, +, 0], [-, -, +], [+, -, -]);true
16:[+, -, 0];[1, 18, 25]: ([+, +, +], [-, -, 0], [+, -, -]);true
8:[0, -, +];[1, 9, 26]: ([+, +, +], [-, -, +], [0, -, -]);true
No
?-
*/
% violations for quasi-transitive social decision
% under (instable) simple majority rule and cases of
% (stable) single vetoer who is not a dictator.
/*
?- linear_ordering.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- W=[[1, 2], [1, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),
profile_in_numbers(RN,NR),nl,write(K:R;NR:RN;Y),fail.
16:[+, -, 0];[25, 9, 1]: ([+, -, -], [-, -, +], [+, +, +]);true
8:[0, -, +];[9, 25, 1]: ([-, -, +], [+, -, -], [+, +, +]);true
24:[-, 0, -];[27, 19, 3]: ([-, -, -], [+, +, -], [-, +, +]);true
20:[0, +, -];[19, 27, 3]: ([+, +, -], [-, -, -], [-, +, +]);true
16:[+, -, 0];[25, 1, 9]: ([+, -, -], [+, +, +], [-, -, +]);true
4:[+, 0, +];[1, 25, 9]: ([+, +, +], [+, -, -], [-, -, +]);true
24:[-, 0, -];[27, 3, 19]: ([-, -, -], [-, +, +], [+, +, -]);true
12:[-, +, 0];[3, 27, 19]: ([-, +, +], [-, -, -], [+, +, -]);true
8:[0, -, +];[9, 1, 25]: ([-, -, +], [+, +, +], [+, -, -]);true
4:[+, 0, +];[1, 9, 25]: ([+, +, +], [-, -, +], [+, -, -]);true
20:[0, +, -];[19, 3, 27]: ([+, +, -], [-, +, +], [-, -, -]);true
12:[-, +, 0];[3, 19, 27]: ([-, +, +], [+, +, -], [-, -, -]);true
No
?- weak_ordering.
---orderings:[1][2][3][6][9][10][14][18][19][22][25][26][27]
13 orderings has updated in r_x/5.
Yes
?- W=[[1, 2], [1, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),
profile_in_numbers(RN,NR),sort(NR,NR),nl,write(K:R;NR:RN;Y),fail.
12:[-, +, 0];[3, 10, 18]: ([-, +, +], [+, +, 0], [-, -, 0]);true
12:[-, +, 0];[3, 18, 19]: ([-, +, +], [-, -, 0], [+, +, -]);true
4:[+, 0, +];[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -]);true
4:[+, 0, +];[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -]);true
4:[+, 0, +];[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -]);true
4:[+, 0, +];[1, 9, 25]: ([+, +, +], [-, -, +], [+, -, -]);true
12:[-, +, 0];[3, 10, 27]: ([-, +, +], [+, +, 0], [-, -, -]);true
12:[-, +, 0];[3, 19, 27]: ([-, +, +], [+, +, -], [-, -, -]);true
No
?-
% NOTE:
% Above sorted profile can not generate correctly the whole patterns
% because of asymmetry of the winning coalitions.
?- W=[[1, 2], [1, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),
profile_in_numbers(RN,NR),nl,write(K:R;NR:RN;Y),fail.
16:[+, -, 0];[25, 9, 1]: ([+, -, -], [-, -, +], [+, +, +]);true
16:[+, -, 0];[25, 18, 1]: ([+, -, -], [-, -, 0], [+, +, +]);true
8:[0, -, +];[9, 25, 1]: ([-, -, +], [+, -, -], [+, +, +]);true
8:[0, -, +];[9, 26, 1]: ([-, -, +], [0, -, -], [+, +, +]);true
8:[0, -, +];[9, 25, 2]: ([-, -, +], [+, -, -], [0, +, +]);true
8:[0, -, +];[9, 26, 2]: ([-, -, +], [0, -, -], [0, +, +]);true
20:[0, +, -];[19, 26, 2]: ([+, +, -], [0, -, -], [0, +, +]);true
20:[0, +, -];[19, 27, 2]: ([+, +, -], [-, -, -], [0, +, +]);true
24:[-, 0, -];[27, 19, 3]: ([-, -, -], [+, +, -], [-, +, +]);true
24:[-, 0, -];[27, 22, 3]: ([-, -, -], [+, 0, -], [-, +, +]);true
20:[0, +, -];[19, 26, 3]: ([+, +, -], [0, -, -], [-, +, +]);true
20:[0, +, -];[19, 27, 3]: ([+, +, -], [-, -, -], [-, +, +]);true
24:[-, 0, -];[27, 19, 6]: ([-, -, -], [+, +, -], [-, 0, +]);true
4:[+, 0, +];[1, 22, 6]: ([+, +, +], [+, 0, -], [-, 0, +]);true
24:[-, 0, -];[27, 22, 6]: ([-, -, -], [+, 0, -], [-, 0, +]);true
4:[+, 0, +];[1, 25, 6]: ([+, +, +], [+, -, -], [-, 0, +]);true
16:[+, -, 0];[25, 1, 9]: ([+, -, -], [+, +, +], [-, -, +]);true
16:[+, -, 0];[25, 10, 9]: ([+, -, -], [+, +, 0], [-, -, +]);true
4:[+, 0, +];[1, 22, 9]: ([+, +, +], [+, 0, -], [-, -, +]);true
4:[+, 0, +];[1, 25, 9]: ([+, +, +], [+, -, -], [-, -, +]);true
16:[+, -, 0];[25, 9, 10]: ([+, -, -], [-, -, +], [+, +, 0]);true
12:[-, +, 0];[3, 18, 10]: ([-, +, +], [-, -, 0], [+, +, 0]);true
16:[+, -, 0];[25, 18, 10]: ([+, -, -], [-, -, 0], [+, +, 0]);true
12:[-, +, 0];[3, 27, 10]: ([-, +, +], [-, -, -], [+, +, 0]);true
16:[+, -, 0];[25, 1, 18]: ([+, -, -], [+, +, +], [-, -, 0]);true
12:[-, +, 0];[3, 10, 18]: ([-, +, +], [+, +, 0], [-, -, 0]);true
16:[+, -, 0];[25, 10, 18]: ([+, -, -], [+, +, 0], [-, -, 0]);true
12:[-, +, 0];[3, 19, 18]: ([-, +, +], [+, +, -], [-, -, 0]);true
24:[-, 0, -];[27, 3, 19]: ([-, -, -], [-, +, +], [+, +, -]);true
24:[-, 0, -];[27, 6, 19]: ([-, -, -], [-, 0, +], [+, +, -]);true
12:[-, +, 0];[3, 18, 19]: ([-, +, +], [-, -, 0], [+, +, -]);true
12:[-, +, 0];[3, 27, 19]: ([-, +, +], [-, -, -], [+, +, -]);true
24:[-, 0, -];[27, 3, 22]: ([-, -, -], [-, +, +], [+, 0, -]);true
4:[+, 0, +];[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -]);true
24:[-, 0, -];[27, 6, 22]: ([-, -, -], [-, 0, +], [+, 0, -]);true
4:[+, 0, +];[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -]);true
8:[0, -, +];[9, 1, 25]: ([-, -, +], [+, +, +], [+, -, -]);true
8:[0, -, +];[9, 2, 25]: ([-, -, +], [0, +, +], [+, -, -]);true
4:[+, 0, +];[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -]);true
4:[+, 0, +];[1, 9, 25]: ([+, +, +], [-, -, +], [+, -, -]);true
8:[0, -, +];[9, 1, 26]: ([-, -, +], [+, +, +], [0, -, -]);true
8:[0, -, +];[9, 2, 26]: ([-, -, +], [0, +, +], [0, -, -]);true
20:[0, +, -];[19, 2, 26]: ([+, +, -], [0, +, +], [0, -, -]);true
20:[0, +, -];[19, 3, 26]: ([+, +, -], [-, +, +], [0, -, -]);true
20:[0, +, -];[19, 2, 27]: ([+, +, -], [0, +, +], [-, -, -]);true
20:[0, +, -];[19, 3, 27]: ([+, +, -], [-, +, +], [-, -, -]);true
12:[-, +, 0];[3, 10, 27]: ([-, +, +], [+, +, 0], [-, -, -]);true
12:[-, +, 0];[3, 19, 27]: ([-, +, +], [+, +, -], [-, -, -]);true
No
?-
*/
% inspecting the approchability to the latin squares (single vetoer)
/*
?- W=[[1, 2], [1, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),profile_in_numbers(RN,NR),
NR=[A,B,C],findall(1,(A=1;B=9;C=25),L),L=[_],nl,write(K:R;NR:RN;Y),fail.
16:[+, -, 0];[25, 9, 1]: ([+, -, -], [-, -, +], [+, +, +]);true
4:[+, 0, +];[1, 22, 6]: ([+, +, +], [+, 0, -], [-, 0, +]);true
4:[+, 0, +];[1, 25, 6]: ([+, +, +], [+, -, -], [-, 0, +]);true
4:[+, 0, +];[1, 22, 9]: ([+, +, +], [+, 0, -], [-, -, +]);true
4:[+, 0, +];[1, 25, 9]: ([+, +, +], [+, -, -], [-, -, +]);true
16:[+, -, 0];[25, 9, 10]: ([+, -, -], [-, -, +], [+, +, 0]);true
4:[+, 0, +];[1, 6, 22]: ([+, +, +], [-, 0, +], [+, 0, -]);true
8:[0, -, +];[9, 1, 25]: ([-, -, +], [+, +, +], [+, -, -]);true
8:[0, -, +];[9, 2, 25]: ([-, -, +], [0, +, +], [+, -, -]);true
No
?- W=[[1, 2], [1, 3], [1, 2, 3]],
gen_win(W),is_unanimity_based_preference(K,R,RN,Y),
\+ r_0(K,R,_,[_,q-trans,_],_),profile_in_numbers(RN,NR),
NR=[A,B,C],findall(1,(A=1;B=9;C=25),L),L=[_,_],nl,write(K:R;NR:RN;Y),fail.
4:[+, 0, +];[1, 9, 22]: ([+, +, +], [-, -, +], [+, 0, -]);true
4:[+, 0, +];[1, 6, 25]: ([+, +, +], [-, 0, +], [+, -, -]);true
No
?-
*/
% mode 2: unanimity undominance -> weak SWO.
/*
?- change_mode_unanimity(A).
A = 1->2
Yes
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),
(Y\=true;(r_0(K,_,_,_,B),\+ is_transitive(B)))),nl,write(game:W),fail.
game:[[1], [1, 2], [1, 3], [1, 2, 3]]
game:[[1], [1, 2], [1, 3]]
game:[[1], [1, 2], [1, 2, 3]]
game:[[1], [1, 2]]
game:[[1], [1, 3], [1, 2, 3]]
game:[[1], [1, 3]]
game:[[1], [1, 2, 3]]
game:[[1]]
game:[[2], [1, 2], [2, 3], [1, 2, 3]]
game:[[2], [1, 2], [2, 3]]
game:[[2], [1, 2], [1, 2, 3]]
game:[[2], [1, 2]]
game:[[2], [2, 3], [1, 2, 3]]
game:[[2], [2, 3]]
game:[[2], [1, 2, 3]]
game:[[2]]
game:[[3], [1, 3], [2, 3], [1, 2, 3]]
game:[[3], [1, 3], [2, 3]]
game:[[3], [1, 3], [1, 2, 3]]
game:[[3], [1, 3]]
game:[[3], [2, 3], [1, 2, 3]]
game:[[3], [2, 3]]
game:[[3], [1, 2, 3]]
game:[[3]]
No
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
(r_0(K,_,_,_,B),\+ is_transitive(B))),nl,write(game:W),fail.
game:[[1, 2], [1, 3], [2, 3], [1, 2, 3]]
game:[[1, 2], [1, 3], [2, 3]]
game:[[1, 2], [1, 3], [1, 2, 3]]
game:[[1, 2], [1, 3]]
game:[[1, 2], [2, 3], [1, 2, 3]]
game:[[1, 2], [2, 3]]
game:[[1, 2], [1, 2, 3]]
game:[[1, 2]]
game:[[1, 3], [2, 3], [1, 2, 3]]
game:[[1, 3], [2, 3]]
game:[[1, 3], [1, 2, 3]]
game:[[1, 3]]
game:[[2, 3], [1, 2, 3]]
game:[[2, 3]]
game:[[1, 2, 3]]
No
?-
% NOTE:
% Above result will be reproduced by changing mode_unanimity/2.
*/
% demo for 2-person 3-alternative simple games.
%--------------------------------------------------------------
% mode 1 : unanimity dominance -> strict SWO
% mode 2 : unanimity undominance -> weak SWO
/*
% mode 1 : unanimity dominance -> strict SWO
?- linear_ordering.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
Yes
?- set_model(A,B).
A = 2-person
B = 3-alternative
Yes
?- gen_win(W),nl,write(W),fail.
[[2], [1], [1, 2]]
[[2], [1]]
[[2], [1, 2]]
[[2]]
[[1], [1, 2]]
[[1]]
[[1, 2]]
No
?- nl,r_0(K,_,_,_,B),\+ is_transitive(B),write([K]),fail.
[4][5][7][8][11][12][13][15][16][17][20][21][23][24]
No
?- gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
r_0(K,_,_,_,B),\+ is_transitive(B)),nl,write(game:W),fail.
game:[[1, 2]]
No
?- gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
Y\=true),nl,write(game:W),fail.
game:[[2], [1], [1, 2]]
game:[[2], [1]]
No
?- gen_win(W),
\+ \+ (is_unanimity_based_preference(K,R,RN,true),
\+ r_0(K,_,_,[consistent|_],_)),nl,write(game:W),fail.
No
?- gen_win(W),nl,verify_win,is_Nakamura_number(S,_),
nl,write(nakamura_num:S),nl,write('unanimity-based preferences:'),
nl,unanimity_based_preference_profile(_,SOC,COL),show_scc(SOC),fail.
game:[[1, 2], [1], [2]]
is monotonic
is strong
is not weak
is essential
nakamura_num:2
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 0, 0, 0, 0, 0]
[-, +, +]=3:[0, 3, 0, 0, 0, 0]
[-, -, +]=9:[0, 0, 9, 0, 0, 0]
[+, +, -]=19:[0, 0, 0, 19, 0, 0]
[+, -, -]=25:[0, 0, 0, 0, 25, 0]
[-, -, -]=27:[0, 0, 0, 0, 0, 27]
game:[[1], [2]]
is not weak
is essential
nakamura_num:2
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 0, 0, 0, 0, 0]
[-, +, +]=3:[0, 3, 0, 0, 0, 0]
[-, -, +]=9:[0, 0, 9, 0, 0, 0]
[+, +, -]=19:[0, 0, 0, 19, 0, 0]
[+, -, -]=25:[0, 0, 0, 0, 25, 0]
[-, -, -]=27:[0, 0, 0, 0, 0, 27]
game:[[1, 2], [2]]
is monotonic
is proper
is strong
is weak with veto players:[2]
is inessential with a dictator:2
nakamura_num:999
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 3, 9, 19, 25, 27]
[-, +, +]=3:[1, 3, 9, 19, 25, 27]
[-, -, +]=9:[1, 3, 9, 19, 25, 27]
[+, +, -]=19:[1, 3, 9, 19, 25, 27]
[+, -, -]=25:[1, 3, 9, 19, 25, 27]
[-, -, -]=27:[1, 3, 9, 19, 25, 27]
game:[[2]]
is proper
is weak with veto players:[2]
is essential
nakamura_num:999
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 3, 9, 19, 25, 27]
[-, +, +]=3:[1, 3, 9, 19, 25, 27]
[-, -, +]=9:[1, 3, 9, 19, 25, 27]
[+, +, -]=19:[1, 3, 9, 19, 25, 27]
[+, -, -]=25:[1, 3, 9, 19, 25, 27]
[-, -, -]=27:[1, 3, 9, 19, 25, 27]
game:[[1, 2], [1]]
is monotonic
is proper
is strong
is weak with veto players:[1]
is inessential with a dictator:1
nakamura_num:999
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 1, 1, 1, 1, 1]
[-, +, +]=3:[3, 3, 3, 3, 3, 3]
[-, -, +]=9:[9, 9, 9, 9, 9, 9]
[+, +, -]=19:[19, 19, 19, 19, 19, 19]
[+, -, -]=25:[25, 25, 25, 25, 25, 25]
[-, -, -]=27:[27, 27, 27, 27, 27, 27]
game:[[1]]
is proper
is weak with veto players:[1]
is essential
nakamura_num:999
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 1, 1, 1, 1, 1]
[-, +, +]=3:[3, 3, 3, 3, 3, 3]
[-, -, +]=9:[9, 9, 9, 9, 9, 9]
[+, +, -]=19:[19, 19, 19, 19, 19, 19]
[+, -, -]=25:[25, 25, 25, 25, 25, 25]
[-, -, -]=27:[27, 27, 27, 27, 27, 27]
game:[[1, 2]]
is monotonic
is proper
is weak with veto players:[1, 2]
is essential
nakamura_num:999
unanimity-based preferences:
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[1, 2, 5, 10, 13, 14]
[-, +, +]=3:[2, 3, 6, 11, 14, 15]
[-, -, +]=9:[5, 6, 9, 14, 17, 18]
[+, +, -]=19:[10, 11, 14, 19, 22, 23]
[+, -, -]=25:[13, 14, 17, 22, 25, 26]
[-, -, -]=27:[14, 15, 18, 23, 26, 27]
No
?-
*/
% changing mode
/*
?- change_mode_unanimity(A).
A = 1->2
Yes
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y),
(r_0(K,_,_,_,B),\+ is_transitive(B))),nl,write(game:W),fail.
game:[[2], [1, 2]]
game:[[2]]
game:[[1], [1, 2]]
game:[[1]]
No
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
(r_0(K,_,_,_,B),\+ is_transitive(B))),nl,write(game:W),fail.
game:[[1, 2]]
No
?- change_mode_unanimity(A).
A = 2->1
Yes
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true),
\+ \+ (is_unanimity_based_preference(K,R,RN,Y),
(r_0(K,_,_,_,B),\+ is_transitive(B))),nl,write(game:W),fail.
game:[[1, 2]]
No
?- gen_win(W),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y\=true),
\+ (is_unanimity_based_preference(K,R,RN,Y),Y),
(r_0(K,_,_,_,B),\+ is_transitive(B))),nl,write(game:W),fail.
game:[[2], [1, 2]]
game:[[2]]
game:[[1], [1, 2]]
game:[[1]]
No
?-
*/
%(+EF)
%--------------------------------------------------------------
% Effectivity functions
%--------------------------------------------------------------
% effectivity:
% A coalition S can enforces the outcome within X
% a subset of alternatives.
% An effectivity function EF: coalitions(N)->family of subsets(A)
% assigns each coalition a collection of possible states
% (a family of subsets of alternatives).
% An effectivity function can model finer coalitional power structure
% than simple games.
% Effectivity function was introduced by Moulin and Peleg (1982).
% An effectivity function can be thought as a
% `(characteristic) game form' because of
% its independence from preference profile of individuals,
% so we can linked a collection of possible games into
% it and make sense of implementation of the effective functiuon
% in strong Nash equilibrium.
% An EF is implementable [*1] by the associated game form G
% iff it is stable and maximal [*2].
%----
% [*1] In the sense of Definition 5.1 of Moulin and Peleg (1982))
% [*2] The maximal EF is of analogous notion to the strong simple game.)
% effectivity function
%--------------------------------------------------------------
:- dynamic eff/2.
set_eff(M):-
eff_model_base(M,E),
abolish(eff/2),
forall(member(eff(A,B),E),assert(eff(A,B))).
% example eff(1): a reproduction of foregoing exaampl of
% a dictatorial simple game
eff( [1], [x]).
eff( [1], [y]).
eff( [1], [z]).
eff( [1], [x,y]).
eff( [1], [x,z]).
eff( [1], [y,z]).
eff( S, [x,y,z]):- group(S,_).
eff( [1,2], E):- event(E,_),E\=[],E\=[x,y,z].
eff_model_base(1,[
eff( [1], [x]),
eff( [1], [y]),
eff( [1], [z]),
eff( [1], [x,y]),
eff( [1], [x,z]),
eff( [1], [y,z]),
(eff( S, [x,y,z]):- group(S,_)),
(eff( [1,2], E):- event(E,_),E\=[],E\=[x,y,z])
]).
% example eff(2)
eff_model_base(2,[
eff( [1], [x]),
%eff( [1], [z]),
eff( [1], [x,z]),
eff( [1], [y,z]),
eff( [1], [y]),
eff( [2], [z]),
eff( [2], [x,y]),
(eff( S, [x,y,z]):- group(S,_)),
(eff( [1,2], E):- event(E,_),E\=[],E\=[x,y,z])
]).
% example eff(3) a convex EF in Demange(1987) p.1066
eff_model_base(3,[
eff( [1], [x]),
eff( [1], [z]),
eff( [1], [x,z]),
eff( [1], [y,z]),
eff( [1], [y]),
eff( [2], [z]),
eff( [2], [x,y]),
(eff( S, [x,y,z]):- group(S,_)),
(eff( [1,2], E):- event(E,_),E\=[],E\=[x,y,z])
]).
% core correspondence
% for example 1 (a dictatorial EF)
/*
?- core_correspondence(A,B),show_scc(B),!,fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [x], [x], [x], [x]]
[-, +, +]=3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]=9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]=19:[[x], [x], [x], [x], [x], [x]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]
No
?- core_correspondence(T,A,B),nl,show_scc(B),write(type=T),fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [x], [x], [x], [x]]
[-, +, +]=3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]=9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]=19:[[x], [x], [x], [x], [x], [x]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=weak
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [x], [x], [x], [x]]
[-, +, +]=3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]=9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]=19:[[x], [x], [x], [x], [x], [x]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=strong
No
?-
*/
% core correspondence
% for example 2 (a nondictatorial EF)
/*
?- core_correspondence(T,A,B),nl,show_scc(B),write(type=T),fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [], [x], [], []]
[-, +, +]=3:[[y], [y], [y], [], [], []]
[-, -, +]=9:[[y], [y], [y], [], [], []]
[+, +, -]=19:[[x], [x], [], [x], [], []]
[+, -, -]=25:[[x], [x], [z], [x, z], [z], [z]]
[-, -, -]=27:[[y], [y], [y, z], [z], [z], [z]]type=weak
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [], [x], [], []]
[-, +, +]=3:[[y], [y], [y], [], [], []]
[-, -, +]=9:[[y], [y], [y], [], [], []]
[+, +, -]=19:[[x], [x], [], [x], [], []]
[+, -, -]=25:[[x], [x], [z], [x, z], [z], [z]]
[-, -, -]=27:[[y], [y], [y, z], [z], [z], [z]]type=strong
No
?-
*/
:- dynamic eff_0/2.
eff_0([],[]).
reserve_eff:-
abolish(eff_0/2),
forall(eff(C,E),assert(eff_0(C,E))).
%:- reserve_eff.
is_consistent_with_model(G,E):-
(coalition(G);G=[]),
event(E,_).
% effectivity function based on current model
effectivity_function(G, E):-
mode_effectivity(eff,on),
eff(G,E),
is_consistent_with_model(G,E).
% effectivity function based on current simple game
effectivity_function(G, E):-
mode_effectivity(win,on),
win(G,yes),
event(E,_),
E \= [],
is_consistent_with_model(G,E).
effectivity_function(G, E):-
mode_effectivity(win,on),
win(G,no),
set_of_states(E).
% verification of claims :
% sg is proper-> ef is superadditive and
% sg is strong-> ef is maximal
% (See Moulin and Peleg(1982) p.127, example 3.3)
% Above claims are true if monotone.
/*
?- switch_mode_effectivity(A).
A = eff->win
Yes
?- gen_win(W),nl,write(W),
verify_win([Monotone,Proper,Strong,Weak,E]),tab(1),write('is monotonic?':Monotone),
verify_eff([Stable,S_Stable],[EF,SuAdd,SbAdd,Regular,Maximal,Convex]),
nl,write('sg is proper':Proper + 'ef is superadditive':SuAdd),
nl,write('sg is strong':Strong + 'ef is maximal':Maximal),nl,fail.
[[1], [2], [1, 2]] is monotonic? :yes
sg is proper:no(([2], [1]))+ef is superadditive:true
sg is strong:yes+ef is maximal:true
[[1], [2]] is monotonic? :no(([2], [1, 2]))
sg is proper:no(([2], [1]))+ef is superadditive:fail
sg is strong:no(([], [1, 2]))+ef is maximal:fail
[[1], [1, 2]] is monotonic? :yes
sg is proper:yes+ef is superadditive:true
sg is strong:yes+ef is maximal:true
[[1]] is monotonic? :no(([1], [1, 2]))
sg is proper:yes+ef is superadditive:fail
sg is strong:no(([], [1, 2]))+ef is maximal:fail
[[2], [1, 2]] is monotonic? :yes
sg is proper:yes+ef is superadditive:true
sg is strong:yes+ef is maximal:true
[[2]] is monotonic? :no(([2], [1, 2]))
sg is proper:yes+ef is superadditive:fail
sg is strong:no(([], [1, 2]))+ef is maximal:fail
[[1, 2]] is monotonic? :yes
sg is proper:yes+ef is superadditive:true
sg is strong:no(([2], [1]))+ef is maximal:fail
No
?-
*/
% n=3, m=3
% sg is proper-> ef is superadditive and
% sg is strong-> ef is maximal
/*
?- switch_mode_effectivity(A).
A = eff->win
Yes
?- gen_win(W),nl,write(W),
verify_win([Monotone,Proper,Strong,Weak,E]),tab(1),write('is monotonic?':Monotone),
verify_eff([Stable,S_Stable],[EF,SuAdd,SbAdd,Regular,Maximal,Convex]),
nl,write('sg is proper':Proper + 'ef is superadditive':SuAdd),
nl,write('sg is strong':Strong + 'ef is maximal':Maximal),nl,!,fail.
[[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]] is monotonic? :yes
sg is proper:no(([2, 3], [1]))+ef is superadditive:true
sg is strong:yes+ef is maximal:true
No
?- gen_win(W),nl,write(W),
verify_win([Monotone,Proper,Strong,Weak,E]),Monotone=yes,
verify_eff([Stable,S_Stable],[EF,SuAdd,SbAdd,Regular,Maximal,Convex]),
((Proper,SuAdd)=(yes,fail);(Strong,Maximal)=(yes,fail)),nl,write(W).
No
?-
*/
% another run of the verification
%verify_win([Monotone,Proper,Strong,Weak,E]),
%verify_eff([Stable,S_Stable],[EF,SuAdd,SbAdd,Regular,Maximal,Convex]),
/*
?- switch_mode_effectivity(A).
A = eff->win
Yes
?- gen_win(A),verify_win(W),verify_eff(S,V).
A = [[1], [2], [1, 2]]
W = [yes, no(([2], [1])), yes, no, yes]
S = [true, true]
V = [true, true, fail, fail, true, fail] ;
A = [[1], [2]]
W = [no(([2], [1, 2])), no(([2], [1])), no(([], [1, 2])), no, yes]
S = [true, true]
V = [fail, fail, fail, fail, fail, fail] ;
A = [[1], [1, 2]]
W = [yes, yes, yes, no, yes]
S = [true, true]
V = [true, true, fail, true, true, true] ;
A = [[1]]
W = [no(([1], [1, 2])), yes, no(([], [1, 2])), no, yes]
S = [true, true]
V = [fail, fail, fail, true, fail, true] ;
A = [[2], [1, 2]]
W = [yes, yes, yes, no, yes]
S = [true, true]
V = [true, true, fail, true, true, true] ;
A = [[2]]
W = [no(([2], [1, 2])), yes, no(([], [1, 2])), no, yes]
S = [true, true]
V = [fail, fail, fail, true, fail, true] ;
A = [[1, 2]]
W = [yes, yes, no(([2], [1])), no, yes]
S = [true, true]
V = [true, true, fail, true, fail, true] ;
No
?-
*/
% effectiveness and blocking relation (See Danilov and Sotskov, p.30)
%--------------------------------------------------------------
% One may say that a blocking is to a effectivity
% what a loosing coalition to a winning coalition in a simple game,
% rather than the notion of blocking in simple games.
coalition_is_effective_for(C, E):-
coalition(C,_),
effectivity_function(C, E).
coalition_is_effective_against(C, B):-
coalition(C,_),
blocking_relation(C, _,B).
coalition_blocks_set(C, B):-
blocking_relation(C, _, B).
blocking_relation(C, E, B):-
effectivity_function(C, E),
complementary_pair_of_event(B,E,_).
coalition_rejects_x(S, A, RS):-
coalition(S,_),
alt(_:A),
lower_contour_of_coalitional_preference_wrt(S,A,RS,L),
coalition_blocks_set(S, L).
% the lower contour set (see Danilov and Sotskov, p.11, p.13)
lower_contour_of_preference_wrt(A,R,L):-
r_x(_,R,_,_,_),
alt(_:A),
findall(B, r_x((A,B),R),L).
lower_contour_of_coalitional_preference_wrt(S,A,RS,L):-
coalitional_preference_profile(S,RS,_),
alt(_:A),
findall(B, (member(_:R,RS),r_x((A,B),R)),L).
% conditions for effectivity function
%-------------------------------------------------
condition_of_effectivity_function:-
condition_of_effectivity_function_1,
condition_of_effectivity_function_2,
condition_of_effectivity_function_3.
condition_of_effectivity_function_1:-
\+ effectivity_function([], _).
% It would be appropriate to use the following when we interpret
% that the set A as the all possible states
% and the effectivity function restricts on the possible states.
% See Peleg(1998).
condition_of_effectivity_function_1:-
set_of_states(A),
effectivity_function([], A).
% a group as the whole has every rights
condition_of_effectivity_function_2:-
\+ whole_group_is_not_effective_for(_).
% there_is_event_for_which_whole_group_is_not_effective
whole_group_is_not_effective_for(E):-
set_of_agents(N),
event(E,_),
E \= [],
\+ effectivity_function(N, E).
condition_of_effectivity_function_3:-
\+ some_nonnull_group_is_effective_for_a_missing_state(_).
some_nonnull_group_is_effective_for_a_missing_state(G):-
effectivity_function(G, []),
G \=[].
% monotonicity w.r.t. alternatives
%-------------------------------------------------
monotonicity_wrt_alternatives:-
\+ is_not_monotonic_wrt_alternatives(_,_).
is_not_monotonic_wrt_alternatives(G,[X,Y]):-
effectivity_function(G, X),
super_event(Y, X,_,_),
\+ effectivity_function(G, Y).
% monotonicity w.r.t. coalitions
%-------------------------------------------------
monotonicity_wrt_coalitions:-
\+ is_not_monotonic_wrt_coalitions(_,_).
is_not_monotonic_wrt_coalitions([G1,G2],X):-
effectivity_function(G1, X),
sub_group(G1,G2,_,_),
\+ effectivity_function(G2, X).
% demo
/*
% n=2
?- gen_eff(A),is_not_monotonic_wrt_alternatives(G,X).
A = [ ([[1], [1, 2]]->[z]), ([[1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1|...]]->[x, y]), ([[...]|...]->[x|...])]
G = [1]
X = [[z], [y, z]]
Yes
?- gen_eff(A),
is_not_monotonic_wrt_coalitions(G,X).
No
?
*/
% The stability of effectivity function
%-------------------------------------------------
% The effectivity functions associated with the game form
% (i.e., the original EF).
% With the (admissible) family of preference profiles,
% the stability of an effectivity function is defined as
% the exsistence of nonempty core for every profile.
% On the other hand, the notions of dominance, the core, and the
% stability depend on the coalitional preference profiles.
% Theorem (Moulin and Peleg, 1982).
% Any additive EF is stable.
% Theorem (Keiding, 1985).
% An effectivity function is stable iff acyclic.
% Theorem (Peleg, 1984).
% Any effectivity function is stable if convex.
% note. It is not true if EF([]) includes A.
% Theorem (Demange, 1987).
% Any effectivity function is strongly stable if convex.
% note. It is not true if EF([]) includes A.
% (excerpts from Abdou and Keiding(1991), chapter 3. See also Keiding(1985))
% For finite set of alternatives,
% stable -> no upper cycles (3.1 Proposition)
% stable & maximal -> superadditive (3.2 Corollary)(**)
% stable -> no lower cycles (3.3 Proposition)
% stable & maximal -> convex (3.5 Theorem) (**)
% convex & monotonic -> the quotient EF is convex (3.6 Lemma)
% convex & maximal -> stable (3.9 Corollary) (*)
% convex -> (strongly) stable (4.3(4.6) Theorem) (*)
% (*) It is not true if EF([]) includes A.
% (**) It is true even if EF([]) includes A.
% superadditivity of effectivity function
%-------------------------------------------------
superadditivity_condition:-
\+ is_not_superadditive_effectivity_function(_,_).
is_not_superadditive_effectivity_function([G1,G2,U],[X,Y,Z]):-
group( G1,_),
group( G2,_),
intersection(G1,G2,[]),
effectivity_function(G1, X),
effectivity_function(G2, Y),
is_intersection_of_two_events(X,Y,Z),
Z\=[],
is_union_of_two_groups(G1,G2,U),
\+ effectivity_function(U, Z).
% subadditivity of effectivity function
%-------------------------------------------------
subadditivity_condition:-
\+ is_not_subadditive_effectivity_function(_,_).
is_not_subadditive_effectivity_function([G1,G2,U],[X,Y,Z]):-
group( G1,_),
group( G2,_),
is_intersection_of_two_groups(G1,G2,Z),
effectivity_function(G1, X),
effectivity_function(G2, Y),
intersection(X,Y,[]),
is_union_of_two_events(X,Y,U),
\+ effectivity_function(U, Z).
% maximality of effectivity function
%-------------------------------------------------
maximality_condition:-
\+ is_not_maximal_effectivity_function(_,_).
is_not_maximal_effectivity_function(Z:(G,B),Z:(H,C)):-
group( G,_),
event(B,_),
\+ effectivity_function(G, B),
complementary_pair_of_group(G,H,_),
\+ (
effectivity_function(H, C),
intersection(B,C,[])
),
Z=is_not_effective_for.
% regularity of effectivity function
%-------------------------------------------------
regularity_condition:-
\+ is_not_regular_effectivity_function(_,_).
is_not_regular_effectivity_function(Z:(G,B),Z:(H,C)):-
effectivity_function(G, B),
complementary_pair_of_group(G,H,_),
effectivity_function(H, C),
intersection(B,C,[]),
Z=is_effective_for.
% convexity of effectivity function
%-------------------------------------------------
convexity_condition:-
\+ is_not_convex_effectivity_function(_,_,_,_).
%is_not_convex_effectivity_function((G1,X1),(G2,X2),(U,Z),not_super_additive):-
% is_not_superadditive_effectivity_function([G1,G2,U],[X1,X2,Z]).
is_not_convex_effectivity_function((G1,X1),(G2,X2),(Ug,Mx),(Mg,Ux)):-
effectivity_function(G1, X1),
effectivity_function(G2, X2),
is_intersection_of_two_events(X1,X2,Mx),
is_intersection_of_two_groups(G1,G2,Mg),
is_union_of_two_events(X1,X2,Ux),
is_union_of_two_groups(G1,G2,Ug),
\+ effectivity_function(Ug, Mx),
\+ effectivity_function(Mg, Ux).
% an EF is convex -> is superadditive & monotonic.
% Strong stability
%-------------------------------------------------
% EF is strongly stable if any alternative outside the core
% is blocked by a coalition all of whose members prefer an
% alternative of the core to it. (Demange, 1987 p.1064)
is_strongly_stable_core:- \+ empty_strong_core(_).
empty_strong_core(R):- strong_core(C,R), C=[].
% THEOREM (Demange 1987)
% strongly stable EF -> coalitionally nonmanipulable
/*
?- switch_mode_effectivity(A).
A = win -> eff
Yes
?- gen_eff(G),verify_eff([true,true],[true,true|V]),
core_correspondence(strong,A,B),show_scc(B),!,fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]=3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]=9:[[x, y], [y], [y], [x, y, z], [y, z], [y, z]]
[+, +, -]=19:[[x], [x, y], [x, y, z], [x], [x, z], [x, z]]
[+, -, -]=25:[[x, z], [x, y, z], [y, z], [x, z], [z], [z]]
[-, -, -]=27:[[x, y, z], [y, z], [y, z], [x, z], [z], [z]]
No
?- gen_eff(EF),verify_eff(S,[true|V]),
core(weak,C,R),
core(strong,C1,R),C \=C1.
No
?- gen_eff(EF),verify_eff(S,[true|V]),
core(weak,C,R),block_element_for_outside_alternative(X,Y,G, C,R).
EF = [ ([[]]->[]), ([[1, 2]]->[z]), ([[1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1|...]]->[x, z]), ([[...|...]]->[x|...]), ([...|...]->[...|...])]
S = [true, true]
V = [true, fail, fail, fail, fail]
C = [x]
R = [+, +, +], [+, +, +]
X = y
Y = x
G = [2]
Yes
?-
*/
% generating a case of eff which is stable but not strongly stable.
/*
?- filter_chk_eff((A,_,_),[eff,s]),gen_eff(A),core(C,R),\+ strong_core(C,R).
A = [ ([[1], [1, 2]]->[z]), ([[1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1|...]]->[x, y]), ([[]|...]->[x|...])]
C = [y]
R = [-, -, +], [+, +, +]
Yes
?- forall(core_correspondence(T,_,B),(nl,show_scc(B),write(type=T))).
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]=3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]=9:[[y], [y], [y], [y, z], [y, z], [y, z]]
[+, +, -]=19:[[x], [x], [x, z], [x], [x, z], [x, z]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=weak
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]=3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]=9:[[], [y], [y], [y, z], [y, z], [y, z]]
[+, +, -]=19:[[x], [], [x, z], [x], [x, z], [x, z]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=strong
T = _G157
B = _G159
Yes
?-
*/
% veryfying properties of effectivity function
%--------------------------------------------------------------
verify_eff:-
verify_eff_1,
verify_eff_0.
verify_eff_0:-
verify_eff_2,
verify_eff_3.
verify_eff_1:-
group(G,_),nl,write(group:G),
tab(1),write(is_effective_for),
effectivity_function(G, X),
nl,tab(1),write(X),fail.
verify_eff_1.
verify_eff_2:-
verify_eff_2([C1,C2,C3,C4,C5,C6]),
(C1=true->(nl,write('is EF'));true),
(C2=true->(nl,write('is superadditive'));true),
(C3=true->(nl,write('is subadditive'));true),
(C4=true->(nl,write('is regular'));true),
(C5=true->(nl,write('is maximal'));true),
(C6=true->(nl,write('is convex'));true).
verify_eff_3:-
verify_eff_3([S,S1]),
(S=true->(nl,write('is stable'));true),
(S1=true->(nl,write('is strongly stable'));true).
verify_eff_2([C1,C2,C3,C4,C5,C6]):-
(condition_of_effectivity_function->C1=true;C1=fail),
(superadditivity_condition->C2=true;C2=fail),
(subadditivity_condition->C3=true;C3=fail),
(regularity_condition->C4=true;C4=fail),
(maximality_condition->C5=true;C5=fail),
(convexity_condition->C6=true;C6=fail).
verify_eff_3([S,S1]):-
(is_stable_core->S=true;S=fail),
(is_strongly_stable_core->S1=true;S1=fail).
verify_eff(V):-
verify_eff_2(V).
verify_eff(S,V):-
verify_eff_2(V),
verify_eff_3(S).
verify_eff_4([Ma,Mc]):-
(monotonicity_wrt_alternatives->Ma=true;Ma=fail),
(monotonicity_wrt_coalitions->Mc=true;Mc=fail).
/*
?- verify_eff.
group:[] is_effective_for
group:[2] is_effective_for
group:[1] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
group:[1, 2] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
is superadditive
is convex
Yes
?- switch_mode_effectivity(A).
A = win->eff
Yes
?- verify_eff.
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[z]
[x, y]
[x, y, z]
group:[1] is_effective_for
[x]
[x, z]
[y, z]
[y]
[x, y, z]
group:[1, 2] is_effective_for
[x, y, z]
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
is EF
is superadditive
is maximal
Yes
?-
*/
%--------------------------------------------------------------
% generating effectivity functions
%--------------------------------------------------------------
:- dynamic mode_obeying_condition_2/1.
mode_obeying_condition_2(yes).
switch_mode_obeying_condition_2(Y->N):-
member((Y,N),[(yes,no),(no,yes)]),
retract(mode_obeying_condition_2(Y)),
assert(mode_obeying_condition_2(N)).
enforce_mode_obeying_condition_2(T->T):-
clause(mode_obeying_condition_2(T),_).
enforce_mode_obeying_condition_2(Y->N):-
member((Y,N),[(yes,no),(no,yes)]),
retract(mode_obeying_condition_2(Y)),
assert(mode_obeying_condition_2(N)).
warn_user_if_model_misspecified(EF,ok):-
\+ (
member(Cs->E,EF),
member(C,Cs),
\+ coalition(C)
),
\+ (
member(Cs->E,EF),
member(A,E),
\+ alt(_:A)
),
!.
warn_user_if_model_misspecified(_,ng):-
nl,
write('Please update your model by using set_model/2 in advance.'),
nl,
write('Ctrl and a to abort.'),
read(abort).
% adjusting without warning the user
there_is_unspecified_coalition(C,EF):-
member(Cs->_,EF),
member(C,Cs),
\+ (coalition(C);C=[]).
there_is_unspecified_alternative(A,EF):-
member(_->E,EF),
member(A,E),
\+ alt(_:A).
is_maximal_coalition(C,N,EF):-
member(Cs->_,EF),
member(C,Cs),
length(C,N),
\+ (
member(Cs1->_,EF),
member(C1,Cs1),
length(C1,K),
K > N
).
is_maximal_event(E,M,EF):-
member(_->E,EF),
length(E,M),
\+ (
member(_->F,EF),
length(F,K1),
K1 > M
).
adjust_model_if_conflict(EF,ok):-
\+ there_is_unspecified_coalition(_,EF),
\+ there_is_unspecified_alternative(_,EF),
!.
adjust_model_if_conflict(EF,ng):-
is_maximal_coalition(_,N,EF),
is_maximal_event(_,M,EF),
set_model(N-person, M-alternative),
inform_user_after_model_adjustment(N,M),
!.
inform_user_after_model_adjustment(N,M):-
nl,
write('Updated model by using set_model':(N,M)).
gen_eff(EF):-
var(EF),
enforce_mode_effectivity(eff),
gen_eff(EF,_).
gen_eff(EF):-
\+ var(EF),
enforce_mode_effectivity(eff),
enforce_mode_obeying_condition_2(T->no),
(gen_eff(EF,_)->true;
warn_user_if_model_misspecified(EF,_)
% adjust_model_if_conflict(EF,_)
),
enforce_mode_obeying_condition_2(no->T).
% EF: effectivity function, ES: effectivity sets
gen_eff(EF,ES):-
set_of_coalitions(L),
set_of_events(PA),
subtract(PA,[[]],PoA),
set_of_states(A),
set_of_agents(N),
gen_eff_1(PoA,(A,N,L),ES,EF),
non_emptiness_of_eff(EF),
update_eff(EF).
non_emptiness_of_eff(W):-W \= [].
% assigning the winners (i.e., the effective set) for each event.
gen_eff_1([],_,[],[]).
gen_eff_1([E|PA],(A,N,L),[Win|ES],[Win->E|EF]):-
gen_eff_1(PA,(A,N,L),ES,EF),
assign_effective_set_for_event(E,Win,(A,N,L)).
% embedding the condition 1 of eff
assign_effective_set_for_event(A,L,(A,_,L)).
% the following rule is optional only for 2-persons cases.
assign_effective_set_for_event(A,[[]|L],(A,_,L)):-
set_of_agents(N),
length(N,2).
% embedding the condition 2 of eff
assign_effective_set_for_event(E,Win,(A,_,L)):-
\+ clause( mode_obeying_condition_2(yes),_),
\+ member(E,[[],A]),
list_projection(_,L,Win).
assign_effective_set_for_event(E,Win,(A,N,L)):-
clause( mode_obeying_condition_2(yes),_),
\+ member(E,[[],A]),
effective_set_obeying_condition_2_of_eff(Win,(N,L)).
effective_set_obeying_condition_2_of_eff(Win,(N,L)):-
subtract(L,[N],L1),
list_projection(_,L1,Win1),
append(Win1,[N],Win).
update_eff(EF):-
abolish(eff/2),
member(Win->E,EF),
update_eff_for_event(Win->E),
fail.
update_eff(_).
update_eff_for_event(Win->E):-
member(C,Win),
assert(eff(C,E)),
fail.
update_eff_for_event(_,_).
% counting effectivity functions
%--------------------------------------------------------------
:- dynamic id_eff/1.
count_eff((A,S,V),L,I):-
var(L), var(A), var(S), var(V),
count_eff((A,S,V),[],I),
!.
count_eff((A,S,V),L,I):-
\+ var(L), var(A), var(S), var(V),
chk_list_eff((S,V),L),
count_eff((A,S,V),_,I),
!.
count_eff((A,S,V),L,I):-
var(L),
abolish(id_eff/1),
assert(id_eff(0)),
chk_eff(A,S,V),
retract(id_eff(I)),
J is I + 1,
assert(id_eff(J)),
fail.
count_eff((_,S,V),L,I):-
chk_list_eff((S,V),L),
id_eff(I),
nl,
write(I).
chk_list_eff((S,V),L):-
var(L),(\+ var(V); \+ var(S)),
length(V,6),length(S,2),
append(V,S,U),
findall(Q,
(
nth1(K,U,T),
(T==true -> Q =P; T==fail->Q= -P; true),
chk_property_eff(K,_,P)
),
L).
chk_list_eff((S,V),L):-
\+ var(L), var(V), var(S),
findall(K:T,
(
chk_property_eff(K,N,Q),
itemize_chk_list_eff(L,_P,[K,N,Q],T)
),
U),
findall(T,(member(K:T,U),K>6),S),
findall(T,(member(K:T,U),K=<6),V).
itemize_chk_list_eff(L,P,KNQ,true):-
member(P,L),
member(P,KNQ),
!.
itemize_chk_list_eff(L,P,KNQ,fail):-
member(-P,L),
member(P,KNQ),
!.
itemize_chk_list_eff(_,_,_,_).
chk_property_eff(1,eff,effectivity_function).
chk_property_eff(2,sup,superadditive).
chk_property_eff(3,sub,subadditive).
chk_property_eff(4,rg,regular).
chk_property_eff(5,mx,maximal).
chk_property_eff(6,cv,convex).
chk_property_eff(7,s,stable).
chk_property_eff(8,ss,strongly_stable).
%chk_property_eff(9,ma,alternative-monotone).
%chk_property_eff(10,mp,player-monotone).
filter_chk_eff((A,S,V),L):-
chk_list_eff((S,V),L),
chk_eff(A,S,V).
% generating all effectivity functions and record as chk_eff/3
%--------------------------------------------------------------
if_mode_effectivity_win_switch:-
mode_effectivity(win,on),
switch_mode_effectivity(win->eff),
nl,
write('mode of analysis has changed: win->eff'),
!.
if_mode_effectivity_win_switch.
generate_and_record_chk_eff(S,V):-
gen_eff(A),
verify_eff(S,V),
assert(chk_eff(A,S,V)).
create_all_chk_eff(_,_):-
if_mode_effectivity_win_switch,
abolish(chk_eff/3),
fail.
create_all_chk_eff(S,V):-
generate_and_record_chk_eff(S,V),
fail.
create_all_chk_effs(_,_):-
nl,
write('complete').
create_all_chk_effs:-
create_all_chk_eff(_,_).
count_all_chk_effs(I):-
abolish(id_eff/1),
assert(id_eff(0)),
clause(chk_eff(_A,_,_B),true),
retract(id_eff(I)),
J is I + 1,
assert(id_eff(J)),
fail.
count_all_chk_effs(I):-
id_eff(I).
% demo
% generating and counting effectivity functions
%--------------------------------------------------------------
/*
?- gen_eff(A),verify_eff.
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[x, y, z]
group:[1] is_effective_for
[x, y, z]
group:[1, 2] is_effective_for
[x, y, z]
is superadditive
is subadditive
is regular
is convex
is stable
is strongly stable
A = [ ([]->[]), ([]->[z]), ([]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x|...]), ([...|...]->[...|...])] ;
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[x, y, z]
group:[1] is_effective_for
[x, y, z]
group:[1, 2] is_effective_for
[x, y, z]
is superadditive
is subadditive
is regular
is convex
is stable
is strongly stable
A = [ ([[x, y, z]]->[]), ([]->[z]), ([]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x|...]), ([...|...]->[...|...])] ;
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[x, y, z]
group:[1] is_effective_for
[x, y, z]
group:[1, 2] is_effective_for
[z]
[x, y, z]
is superadditive
is subadditive
is regular
is convex
is stable
is strongly stable
A = [ ([]->[]), ([[1, 2]]->[z]), ([]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x|...]), ([...|...]->[...|...])]
Yes
?- create_all_chk_effs.
Yes
?- count_all_chk_effs(I).
I = 524288
Yes
?- chk_property_eff(K,N,Q),nl,write([K]:Q;N),count_eff(U,[Q],I),fail.
[1]:effectivity_function;eff
8192
[2]:superadditive;sup
26484
[3]:subadditive;sub
3712
[4]:regular;rg
53248
[5]:maximal;mx
729
[6]:convex;cv
10790
[7]:stable;s
53248
[8]:strongly_stable;ss
34144
No
?- chk_property_eff(K,N,Q),nl,write([K]:eff+Q;N),count_eff(U,[eff,Q],I),fail.
[1]:eff+effectivity_function;eff
8192
[2]:eff+superadditive;sup
8192
[3]:eff+subadditive;sub
0
[4]:eff+regular;rg
832
[5]:eff+maximal;mx
729
[6]:eff+convex;cv
365
[7]:eff+stable;s
832
[8]:eff+strongly_stable;ss
310
No
?-
?- abolish(id_eff/1),assert(id_eff(0)),
chk_eff(A,[true,true,_,_,true,_]),% superadditive & maximal
retract(id_eff(I)),J is I + 1, assert(id_eff(J)),fail.
No
?- id_eff(I).
I = 729
Yes
?- count_eff(U,[eff,sup,mx],I).
729
U = _G251, [_G399, _G393], [true, true, _G450, _G444, true, _G432]
I = 729
Yes
?- count_eff(U,[eff,sup,cv],I).
365
U = _G254, [_G402, _G396], [true, true, _G453, _G447, _G441, true]
I = 365
Yes
?- count_eff(U,[eff,sup,-cv],I).
7827
U = _G258, [_G406, _G400], [true, true, _G457, _G451, _G445, fail]
I = 7827
Yes
?- count_eff(U,[eff,sup,mx,cv],I).
65
U = _G260, [_G408, _G402], [true, true, _G459, _G453, true, true]
I = 65
Yes
?-
*/
% Checking the Nakamura numbers
%--------------------------------------------------------------
/*
?- gen_eff(EF),verify_eff([true,_,_,_,true,_]),
is_Nakamura_number(NN,C), N\=999,
nl,write(eff:EF),(tab(1),write(rank:NN;C)).
No
?- gen_eff(EF),verify_eff([true,_,_,_,true,_]),
is_Nakamura_number(NN,C),
nl,write(eff:EF),(tab(1),write(rank:NN;C)).
eff:[ ([[]]->[]), ([[2], [1], [1, 2]]->[z]), ([[2], [1], [1, 2]]->[y]), ([[2], [1], [1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1, 2]]->[x, y]), ([[], [2], [1], [1, 2]]->[x, y, z])] rank:999;weak
EF = [ ([[]]->[]), ([[2], [1], [1, 2]]->[z]), ([[2], [1], [1, 2]]->[y]), ([[2], [1], [1|...]]->[y, z]), ([[1, 2]]->[x]), ([[1|...]]->[x, z]), ([[...|...]]->[x|...]), ([...|...]->[...|...])]
NN = 999
C = weak ;
eff:[ ([[]]->[]), ([[2], [1], [1, 2]]->[z]), ([[2], [1], [1, 2]]->[y]), ([[1], [1, 2]]->[y, z]), ([[1], [1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1, 2]]->[x, y]), ([[], [2], [1], [1, 2]]->[x, y, z])] rank:999;weak
EF = [ ([[]]->[]), ([[2], [1], [1, 2]]->[z]), ([[2], [1], [1, 2]]->[y]), ([[1], [1, 2]]->[y, z]), ([[1], [1|...]]->[x]), ([[1|...]]->[x, z]), ([[...|...]]->[x|...]), ([...|...]->[...|...])]
NN = 999
C = weak
Yes
?- gen_eff(EF),verify_eff([true,true|V]),
is_Nakamura_number(NN,C),
C\=weak, nl,write(eff:EF),(tab(1),write(rank:NN;C)).
No
?- gen_eff(EF),verify_eff([true|V]),
is_Nakamura_number(NN,C),
C\=weak, nl,write(eff:EF),(tab(1),write(rank:NN;C)).
No
?
*/
% a case of stable but not strongly stable effectivity function.
%--------------------------------------------------------------
/*
?- filter_chk_eff((A,_,_),[eff,s,-ss]),gen_eff(A),
findall(R,(core(C,R),\+ strong_core(C,R),nl,write(R)),L),
forall(core_correspondence(T,_,B),(nl,show_scc(B),write(type=T))).
[-, -, +], [+, +, +]
[+, +, -], [-, +, +]
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]=3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]=9:[[y], [y], [y], [y, z], [y, z], [y, z]]
[+, +, -]=19:[[x], [x], [x, z], [x], [x, z], [x, z]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=weak
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x, y], [x, y], [x], [x, z], [x, y, z]]
[-, +, +]=3:[[x, y], [y], [y], [x, y], [x, y, z], [y, z]]
[-, -, +]=9:[[], [y], [y], [y, z], [y, z], [y, z]]
[+, +, -]=19:[[x], [], [x, z], [x], [x, z], [x, z]]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]type=strong
A = [ ([[1], [1, 2]]->[z]), ([[1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1|...]]->[x, y]), ([[]|...]->[x|...])]
R = _G180
C = _G179
L = [ ([-, -, +], [+, +, +]), ([+, +, -], [-, +, +])]
T = _G202
B = _G204
Yes
?-
*/
% verification: convex (and maximal) ->stable?
%--------------------------------------------------------------
/*
?- count_eff(U,[eff,mx,cv,-s],I).
47
U = _G264, [fail, _G406], [true, _G469, _G463, _G457, true, true]
I = 47
Yes
?- count_eff(U,[eff,cv,-s],I).
107
U = _G258, [fail, _G400], [true, _G463, _G457, _G451, _G445, true]
I = 107
Yes
?- filter_chk_eff((A,_,_),[eff,mx,cv,-s]),gen_eff(A),verify_eff.
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[y, z]
[x, y, z]
group:[1] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
group:[1, 2] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
is EF
is superadditive
is maximal
is convex
A = [ ([[1], [1, 2]]->[z]), ([[1], [1, 2]]->[y]), ([[2], [1], [1, 2]]->[y, z]), ([[1], [1, 2]]->[x]), ([[1], [1|...]]->[x, z]), ([[1], [...|...]]->[x, y]), ([[]|...]->[x|...])]
Yes
?- filter_chk_eff((A,_,_),[eff,cv,-s]),member(F->[x,y,z],A),
member([],F).
A = [ ([[1, 2]]->[z]), ([[1, 2]]->[y]), ([[2], [1, 2]]->[y, z]), ([[1], [1, 2]]->[x]), ([[1], [1|...]]->[x, z]), ([[1], [...|...]]->[x, y]), ([[]|...]->[x|...])]
F = [[], [2], [1], [1, 2]]
Yes
?- filter_chk_eff((A,_,_),[eff,cv,-s]),member(F->[x,y,z],A),
\+ member([],F).
No
?-
*/
% verification: convex ->strongly stable?
%--------------------------------------------------------------
/*
?- count_eff(U,[eff,mx,cv,-ss],I),
count_eff(U1,[eff,cv,-ss],I1),fail.
47
107
No
?- filter_chk_eff((A,_,_),[eff,cv,-ss]),member(F->[x,y,z],A),
\+ member([],F).
No
?-
*/
% A comparison : generating directly without chk_eff/3
%--------------------------------------------------------------
% Previously, without the filteration tool same thing as above
% can be done by the following.
/*
?- gen_eff(A),
verify_eff([Stable,S_Stable],[EF,SuAdd,SbAdd,Regular,true,true]),
Stable\=true.
A = [ ([[1], [1, 2]]->[z]), ([[1], [1, 2]]->[y]), ([[2], [1], [1, 2]]->[y, z]), ([[1], [1, 2]]->[x]), ([[1], [1|...]]->[x, z]), ([[1], [...|...]]->[x, y]), ([[]|...]->[x|...])]
Stable = fail
S_Stable = fail
EF = true
SuAdd = true
SbAdd = fail
Regular = fail
Yes
?- verify_eff.
group:[] is_effective_for
[x, y, z]
group:[2] is_effective_for
[y, z]
[x, y, z]
group:[1] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
group:[1, 2] is_effective_for
[z]
[y]
[y, z]
[x]
[x, z]
[x, y]
[x, y, z]
is EF
is superadditive
is maximal
is convex
Yes
?- core_correspondence(strong,A,B),show_scc(B),!,fail.
cores_#cols:[1, 3, 9, 19, 25, 27]
[+, +, +]=1:[[x], [x], [], [x], [x], []]
[-, +, +]=3:[[y], [y], [y], [y], [y], [y]]
[-, -, +]=9:[[y], [y], [y], [y], [y], [y]]
[+, +, -]=19:[[x], [x], [], [x], [x], []]
[+, -, -]=25:[[z], [z], [z], [z], [z], [z]]
[-, -, -]=27:[[z], [z], [z], [z], [z], [z]]
No
?-
*/
%--------------------------------------------------------------
% Computing Cycles of effectivity function
%--------------------------------------------------------------
% strong cycle
%--------------------------------------------------------------
% See Keiding(1985).
% minimal case of length 2
pre_strong_cycle_of_eff_0([S1,S2],[B1,B2],M):-
effectivity_function(S1,B1),
effectivity_function(S2,B2),
intersection(S1,S2,M),
intersection(B1,B2,[]).
strong_cycle_of_eff_0([S1,S2],[B1,B2],[S1:B1,S2:B2]):-
pre_strong_cycle_of_eff_0([S1,S2],[B1,B2],[]).
/*
?- pre_strong_cycle_of_eff_0(C,K,[]).
No
?- chk_eff(A,[fail|B],C),(Cycle).
gen_eff(A),verify_eff(S,V).
A = [ ([[2]]->[z]), ([[1]]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x, y]), ([[]|...]->[x|...])]
B = [fail]
C = [fail, fail, fail, fail, fail, fail]
S = [fail, fail]
V = [fail, fail, fail, fail, fail, fail]
Yes
?- pre_strong_cycle_of_eff_0(C,K,[]).
C = [[2], [1]]
K = [[z], [y]] ;
C = [[1], [2]]
K = [[y], [z]] ;
No
?-
*/
strong_cycle_of_eff(T,U):-
all_coalitions(L),
pre_strong_cycle_of_eff(L,T,U,[]).
pre_strong_cycle_of_eff([_,_],T,U,M):-
pre_strong_cycle_of_eff_0(T,U,M).
pre_strong_cycle_of_eff(L,T,W,M):-
L=[_,_,_|_],
subtract(L,[_],L1),
pre_strong_cycle_of_eff(L1,T,W,M).
pre_strong_cycle_of_eff(L,[S|T],[S:B|W],M):-
L=[_,_,_|_],
subtract(L,[_],L1),
pre_strong_cycle_of_eff(L1,T,W,M1),
M1 \= [],
effectivity_function(S,B),
pairwaise_disjoint_effective_sets(B,W),
cumulatively_nonempty_intersected_coalitions(S,M1,M).
pairwaise_disjoint_effective_sets(B,W):-
forall(member(_:B1,W),intersection(B,B1,[])).
cumulatively_nonempty_intersected_coalitions(S,M1,M):-
M1 \= start,
M1 \= [],
intersection(S,M1,M),
M \= [].
/*
?- set_model(2-A,3-N).
A = person
N = alternative
Yes
?- chk_eff(A,[fail|B],C),
gen_eff(A),verify_eff(S,V).
A = [ ([[2]]->[z]), ([[1]]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x, y]), ([[]|...]->[x|...])]
B = [fail]
C = [fail, fail, fail, fail, fail, fail]
S = [fail, fail]
V = [fail, fail, fail, fail, fail, fail]
Yes
?- strong_cycle_of_eff(C,K).
C = [[2], [1]]
K = [[z], [y]] ;
C = [[1], [2]]
K = [[y], [z]] ;
No
?-
?- set_model(3-A,3-N).
A = person
N = alternative
Yes
?- gen_eff(A),verify_eff([fail|S],V).
A = [ ([[3], [1, 2, 3]]->[z]), ([[1, 2], [1, 2, 3]]->[y]), ([[1, 2, 3]]->[y, z]), ([[1, 2, 3]]->[x]), ([[1, 2|...]]->[x, z]), ([[1|...]]->[x, y]), ([[...]|...]->[x|...])]
S = [fail]
V = [true, fail, fail, fail, fail, fail]
Yes
?- strong_cycle_of_eff(C,K).
C = [[3], [1, 2]]
K = [[z], [y]] ;
C = [[1, 2], [3]]
K = [[y], [z]] ;
No
?-
*/
% cycle
%--------------------------------------------------------------
% See Keiding(1985) and Abou and Keiding(1991) p.69
% cycle of length 2
cycle_of_eff_0([S1,S2],[B1,B2],[C1,C2]):-
pre_cycle_of_eff_0([S1,S2],[B1,B2],[C1,C2],(_,_,[],_)).
pre_cycle_of_eff_0([S1,S2],[B1,B2],[C1,C2],(C1,U,Z,I,[M],B2)):-
effectivity_function(S1,B1),
is_cumulatively_disjoint_eff((S1,B1),[S2],[B2]),
is_effective_against(C1,_,B1),
is_effective_against(C2,_,B2),
is_union_of_two_events(C1,C2,U),
is_intersection_of_two_events(C1,C2,I),
complementary_pair_of_event(Z,U,_),
intersection(C1,B2,M),
if_cumulatively_no_cycle_eff_then(M,[S1,S2],(C1,B2)).
is_cumulatively_disjoint_eff(_,[],[]).
is_cumulatively_disjoint_eff((S1,B1),[S|T],[B|U]):-
is_cumulatively_disjoint_eff((S,B),T,U),
effectivity_function(S,B),
intersection(S1,S,[]),
intersection(B1,B,[]).
is_effective_against(C,A,B):-
complementary_pair_of_event(B,A,_),
super_event(A,C,_,_).
if_cumulatively_no_cycle_eff_then([],_,_):-!.
if_cumulatively_no_cycle_eff_then(M1,[S1,S2],_):-
M1 \=[],
intersection(S1,S2,[]),
!.
if_cumulatively_no_cycle_eff_then(M1,_,(C,B1)):-
M1 \=[],
intersection(C,B1,[]).
% cycle of length K
cycle_of_eff(T,U,W):-
cycle_of_eff(T,U,W,_).
cycle_of_eff(T,U,W,M):-
all_coalitions(L),
pre_cycle_of_eff(L,T,U,W,M),
M=(_,_,[],_).
pre_cycle_of_eff([_,_],T,U,W,M):-
pre_cycle_of_eff_0(T,U,W,M).
pre_cycle_of_eff(L,T,U,W,M):-
L=[_,_,_|_],
subtract(L,[_],L1),
pre_cycle_of_eff(L1,T,U,W,M).
pre_cycle_of_eff(L,[S|T],[B|U],[C|W],(C,U,Z,I,[M|P],Bk0)):-
L=[_,_,_|_],
subtract(L,[_],L1),
pre_cycle_of_eff(L1,T,U,W,(C1,U1,_,I1,P,Bk0)),
effectivity_function(S,B),
is_cumulatively_disjoint_eff((S,B),T,U),
is_effective_against(C,_,B),
is_union_of_two_events(C,U1,U),
complementary_pair_of_event(Z,U,_),
is_intersection_of_two_events(S,I1,I),
intersection(C1,B,M),
if_cumulatively_no_cycle_eff_then(M,[S|T],(C,Bk0)).
% demo
% checking the cycles and strong cycles (24,30-31 Oct 2006)
%--------------------------------------------------------------
/*
?- [sp06d].
---orderings:[1][2][3][4][5][6][8][9][10][11][12][13][14][15][16][17][18][19][20][22][23][24][25][26][27]
25 orderings has updated in r_x/5.
25 consistent orderings have been recovered in r_0/5.
---orderings:[1][3][9][19][25][27]
6 orderings has updated in r_x/5.
% sp06d compiled 0.05 sec, 1,464 bytes
Yes
?- switch_mode_effectivity(A).
A = win -> eff
Yes
?- set_model(2-person,3-alternative).
Yes
?- ['chk_eff_0.txt'].
% chk_eff_0.txt compiled 27.39 sec, 443,023,620 bytes
Yes
?- chk_eff(A,[fail|B],C),
gen_eff(A),verify_eff(S,V).
A = [ ([[2]]->[z]), ([[1]]->[y]), ([]->[y, z]), ([]->[x]), ([]->[x, z]), ([]->[x, y]), ([[]|...]->[x|...])]
B = [fail]
C = [fail, fail, fail, fail, fail, fail]
S = [fail, fail]
V = [fail, fail, fail, fail, fail, fail]
Yes
?- cycle_of_eff_0(S,B,C),nl,write(S;B;C),fail.
[[2], [1]];[[z], [y]];[[y], [x, z]]
[[2], [1]];[[z], [y]];[[x, y], [z]]
[[2], [1]];[[z], [y]];[[x, y], [x, z]]
[[1], [2]];[[y], [z]];[[z], [x, y]]
[[1], [2]];[[y], [z]];[[x, z], [y]]
[[1], [2]];[[y], [z]];[[x, z], [x, y]]
No
?- strong_cycle_of_eff_0(S,B,C),nl,write(S;B;C),fail.
[[2], [1]];[[z], [y]];[[2]:[z], [1]:[y]]
[[1], [2]];[[y], [z]];[[1]:[y], [2]:[z]]
No
?- strong_cycle_of_eff(S,B),nl,write(S;B),fail.
[[2], [1]];[[z], [y]]
[[1], [2]];[[y], [z]]
No
?- filter_chk_eff((A,B,C),[eff,s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),verify_eff_3(S).
A = [ ([[1, 2]]->[z]), ([[1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1|...]]->[x, y]), ([[...]|...]->[x|...])]
B = [true, true]
C = [true, true, fail, true, fail, true]
F = [[2], [1], [1, 2]]
S = [true, true]
Yes
?- cycle_of_eff(S,B,C),nl,write(S;B;C),fail.
No
?- strong_cycle_of_eff_0(S,B,C),nl,write(S;B;C),fail.
No
?- filter_chk_eff((A,B,C),[eff,-s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),verify_eff_3(S).
A = [ ([[2], [1, 2]]->[z]), ([[1], [1, 2]]->[y]), ([[1, 2]]->[y, z]), ([[1, 2]]->[x]), ([[1, 2]]->[x, z]), ([[1|...]]->[x, y]), ([[...]|...]->[x|...])]
B = [fail, fail]
C = [true, true, fail, fail, fail, fail]
F = [[2], [1], [1, 2]]
S = [fail, fail]
Yes
?- strong_cycle_of_eff_0(S,B,C),nl,write(S;B;C),fail.
[[2], [1]];[[z], [y]];[[2]:[z], [1]:[y]]
[[1], [2]];[[y], [z]];[[1]:[y], [2]:[z]]
No
?- cycle_of_eff(S,B,C),nl,write(S;B;C),fail.
[[2], [1]];[[z], [y]];[[y], [x, z]]
[[2], [1]];[[z], [y]];[[x, y], [z]]
[[2], [1]];[[z], [y]];[[x, y], [x, z]]
[[1], [2]];[[y], [z]];[[z], [x, y]]
[[1], [2]];[[y], [z]];[[x, z], [y]]
[[1], [2]];[[y], [z]];[[x, z], [x, y]]
No
?- filter_chk_eff((A,B,C),[eff,-s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),
\+ cycle_of_eff_0(SL,BL,CL).
No
?- filter_chk_eff((A,B,C),[eff,s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),
\+ \+ strong_cycle_of_eff_0(SL,BL,CL).
No
?- filter_chk_eff((A,B,C),[eff,s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),
\+ \+ cycle_of_eff_0(SL,BL,CL).
No
?-
% linear ordering ->
%(there is a cycle <-> therer is a strong cycle)
?- filter_chk_eff((A,B,C),[eff,-s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),
cycle_of_eff_0(SL,BL,M),\+ strong_cycle_of_eff(SL,BL).
No
?- filter_chk_eff((A,B,C),[eff,-s]),member(F->[x,y,z],A),
\+ member([],F),gen_eff(A),
strong_cycle_of_eff(SL,BL),
\+ cycle_of_eff_0(SL,BL,M).
No
?-
*/
%-------------------------------------------------
% common part of coalitional structure
%-------------------------------------------------
% excerpt from right1.pl (8 Oct 2006)
% negligence for this program sp06c.pl
state(W,A):-alt(A:W).
% all components and the subsets(bundles), the super subsets
%-------------------------------------------------
members_of_society( N):- set_of_agents(N).
set_of_agents(N):- findall( J, agent(J,_),N).
set_of_rights(R):- findall( X, right(X,_),R).
set_of_states(S):- findall( W, state(W,_),S).
set_of_alternatives(S):- set_of_states(S).
set_of_coalitions(Cx):- findall( C, coalition(C,_),Cx).
set_of_events(Ex):- findall( E, event(E,_),Ex).
% group/subgroup formation
%-------------------------------------------------
group(G,P):-
members_of_society( N),
list_projection(P,N,G).
coalition(G,P):-
group(G,P),
G \= [].
sub_group(S, G, P,Q):-
group(G,Q),
list_projection(P,G,S).
is_union_of_two_groups(G1,G2,U):-
group(G1,P),
group(G2,Q),
union_of_projection_pair(P,Q,R),
group(U,R).
is_intersection_of_two_groups(G1,G2,M):-
group(G1,_),
group(G2,_),
intersection(G1,G2,M).
complementary_pair_of_group(S,SC,P):-
set_of_agents( N),
dual_list_projection(P,N,SC,S).
% bundle of rights
%-------------------------------------------------
bundle_of_rights(B,P):-
set_of_rights( R),
list_projection(P,R,B).
% super(sub)bundle of rights
super_bundle_of_rights(B,C, P,Q):-
bundle_of_rights(B,P),
list_projection(Q,B,C).
all_super_bundle_of_rights(B,Z):-
bundle_of_rights(B,_),
findall(C,super_bundle_of_rights(C,B,_,_),Z).
% event: subset of states
%-------------------------------------------------
event(E,P):-
set_of_states( S),
list_projection(P,S,E).
super_event(E,F, P,Q):-
event(E,P),
list_projection(Q,E,F).
all_non_empty_events(Z):-
findall(E,event(E,_),Y),
subtract(Y,[],Z).
all_super_events(F,Z):-
event(F,_),
findall(E,super_event(E,F,_,_),Z).
is_union_of_two_events(E1,E2,U):-
event(E1,P),
event(E2,Q),
union_of_projection_pair(P,Q,R),
event(U,R).
is_intersection_of_two_events(E1,E2,M):-
event(E1,_),
event(E2,_),
intersection(E1,E2,M).
complementary_pair_of_event(E,EC,P):-
set_of_states( S),
dual_list_projection(P,S,EC,E).
% cumulative union of event list
%-------------------------------------------------
cumulative_union_of_events(A,[A]).
cumulative_union_of_events(U,[A|B]):-
cumulative_union_of_events(U1,B),
is_union_of_two_events(U1,A,U).
% select subset of the list elements
%-------------------------------------------------
list_projection([],[],[]).
list_projection([X|Y],[_|B],C):-
list_projection(Y,B,C),
X = 0.
list_projection([X|Y],[A|B],[A|C]):-
list_projection(Y,B,C),
X = 1.
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.
dual_list_projection([],[],[],[]).
dual_list_projection([X|Y],[S|B],[S|D],C):-
dual_list_projection(Y,B,D,C),
X = 0.
dual_list_projection([X|Y],[A|B],D,[A|C]):-
dual_list_projection(Y,B,D,C),
X = 1.
union_of_projection_pair([],[],[]).
union_of_projection_pair([A|B],[C|D],[1|F]):-
union_of_projection_pair(B,D,F),
\+ \+ member(1,[A,C]).
union_of_projection_pair([A|B],[C|D],[0|F]):-
union_of_projection_pair(B,D,F),
\+ member(1,[A,C]).
% sort_by_list( Object, +List, Result).
sort_by_list(_,[],[]).
sort_by_list(L,[X|O],R):-
\+ var(O),
\+ var(L),
(\+ member(X,L)->R=R1; R=[X|R1]),
subtract(L,[X],L1),
sort_by_list(L1,O,R1).
sort_by_list(L,O,R):-
\+ var(O),
var(L),
(\+ var(R)->subset(R,O);true),
sort_by_list(R,O,R).
%--------------------------------------------------------------
% model base management:
% setting the agents, the coalitions (structure), the alternatives
%--------------------------------------------------------------
current_model(agents:N,alternatives:A):-
set_of_agents(N),
set_of_alternatives(A).
show_model:-
show_model(N,A,B),
nl,
write(agents:N),
nl,
write(alternatives:A),
nl,
write(coalitions:B).
show_model(N,A,B):-
current_model(agents:N,alternatives:A),
findall( C, coalition(C), B).
set_model(N-person,M-alternative):-
set_model_agent(N),
set_model_coalition,
set_model_alternative(M).
set_model_agent(N):-
(N=2->NL=[taro,hanako];true),
(N=3->NL=[taro,hanako,jiro];true),
set_model_component(agent/1,N,NL).
set_model_alternative(3):-
(N=3->NL=[x,y,z];true),
(N=4->NL=[x,y,z,w];true),
set_model_component(alternative/1,N,NL).
set_model_component(Component/Arity,N,Names):-
integer(N),
length(L,N),
length(Names,N),
findall([K:SN],
(
nth1(K,L,component(K)),
nth1(K,Names,SN)
),
P),
abolish(Component/Arity),
length(Q,Arity),
G=..[Component|Q],
forall(member(Q,P),assert(G)).
set_model_coalition:-
set_of_coalitions(L),
abolish(coalition/1),
forall(member(C,L),assert(coalition(C))).
/*
?- set_model(2-person,3-alternative).
Yes
?- show_model(N,A,B).
N = [1, 2]
A = [x, y, z]
B = [[2], [1], [1, 2]]
Yes
?- set_model(3-person,3-alternative).
Yes
?- show_model(N,A,B).
N = [1, 2, 3]
A = [x, y, z]
B = [[3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2|...]]
Yes
?-
*/
% strucure
%--------------------------------------------------------------
make_structure(P,L,B):-
set_of_coalitions(L),
sort_descending_wrt_size(L,_,R),
make_structure_1(P,R,B).
make_structure_1([],[],[]).
make_structure_1([1|P],[_:C|L],[C|B]):-
make_structure_1(P,L,B),
\+ (
member(D,B),
is_intersection_of_two_groups(C,D,M),
(\+ member(M,B), M\=[])
).
make_structure_1([0|P],[_|L],B):-
make_structure_1(P,L,B).
sort_descending_wrt_size(L,M,R):-
findall( K:X,
(
member(X,L),
length(X,K)
),
M),
sort(M,M1),
reverse(M1,R).
/*
?- make_structure(P,L,B).
P = [1, 1, 1, 1, 1, 1, 1]
L = [[3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2|...]]
B = [[1, 2, 3], [2, 3], [1, 3], [1, 2], [3], [2], [1]] ;
P = [1, 1, 1, 0, 1, 1, 1]
L = [[3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2|...]]
B = [[1, 2, 3], [2, 3], [1, 3], [3], [2], [1]] ;
P = [1, 1, 1, 0, 1, 1, 0]
L = [[3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2|...]]
B = [[1, 2, 3], [2, 3], [1, 3], [3], [2]]
Yes
?-
*/
%--------------------------------------------------------------
% postscripts (rules under construction)
%--------------------------------------------------------------
% group qualification
%--------------------------------------------------------------
:- dynamic qualified_group/2.
qualified_group(club1,[1]).
qualified_group(gen(C),C):-
coalition(C).
select_subgroups([],[]).
select_subgroups([_|W],C):-
select_subgroups(W,C).
select_subgroups([T|W],[T|C]):-
select_subgroups(W,C).
is_a_veto_player_of_qualification(J,Membership):-
qualified_group(Membership,D),
agent(J:_),
\+ (
win(C,yes),
member(J,D),
\+ member(J,C)
).
no_veto_player_of_qualification(Membership):-
qualified_group(Membership,_),
\+ is_a_veto_player_of_qualification(_,Membership).
/*
% demo
?- is_a_veto_player_of_qualification(J,Membership),
nl,write(J:Membership),fail.
1:club1
1:gen([])
2:gen([])
1:gen([[1, 2]])
2:gen([[1, 2]])
1:gen([[1]])
2:gen([[1]])
1:gen([[1], [1, 2]])
2:gen([[1], [1, 2]])
No
?-
*/
% model of majority voting
%--------------------------------------------------------------
:- dynamic num_voters/2.
num_voters( pref:1, 1).
num_voters( pref:3, 1).
num_voters( pref:9, 1).
num_voters( pref:19, 1).
num_voters( pref:25, 1).
num_voters( pref:27, 1).
num_voters_prefer_x_to_y( pref:K, (X,Y), N):-
num_voters( pref:K, N),
r_0(K,S,_,_,_),
r_x((X,Y),S).
total_num_voters_in_r_x( (X,Y), N):-
pair_alt(_:[X,Y]),
findall(K,num_voters_prefer_x_to_y( _, (X,Y),K),L),
sum_in_list(L,N).
sum_in_list([],0).
sum_in_list([K|L],N):-
sum_in_list(L,N0),
N is N0 + K.
/*
% demo
?- total_num_voters_in_r_x( (X,Y), N),nl,write((X,Y):N),fail.
(x, x):0
(x, y):3
(x, z):3
(y, x):3
(y, y):0
(y, z):3
(z, x):3
(z, y):3
(z, z):0
No
?-
*/
:- reserve_eff.
/*
As for prolog, for example, see [Starling 94] or [Clocksin 03].
As for classical theories of social choice, see [Arrow 63], [Sen 82], [Gaertner 01], and [Arrow 02], and
especially for impossibility/dictatorial theorems, [Arrow 63], [Gibbard 73], and [Satterthwaite 75].
As for domain restriction see [Gaertner 01], [Blair 83], [Kalai 77], and
especially for value restrictions, see [Sen 82], [Sen 69] and [Inada 69].
As for simple games and their stability, see [Gaertner 01], [Moulin 88], [Demange 87], [Keiding 85], [Salles 76] and [Nakamura 79].
As for effectivity functions, see [Abdou 91], [Moulin 82], and [Danilov 02].
See also [Peleg 02], [Peleg 98].
% References
[Abdou 91] Abdou, K. and Keiding, H.: Effectivity Functions in Social Choice, Kluwer Academic Press (1991)
[Arrow 63] Arrow, K.: Social Choice and Individual Values, Yale University Press (1963)
[Arrow 02] Arrow, K., Sen, A., and Suzumura, K.: Handbook of Social Choice and Walfare, Vol. 1, Elsevier (2002)
[Blair 83] Blair, D. and Muller, E.: Essential aggregation procedure on restricted domains of preferences.
Journal of Economic Theory, Vol. 30, pp.34-53 (1983)
[Clocksin 03] Clocksin, W. F. and Mellish, C. S.: Programming in Prolog: Using the ISO Standard, 5th edition, Springer (2003)
[Danilov 02] Danilov, V. I. and Sotskov, A. I.: Social Choice Mechanisms, Springer (2002)
[Demange 87] Demange, G.: "Nonmanipulable cores," Econometrica, Vol. 55, No. 5, pp. 1057-1074 (1987)
[Gaertner 01] Gaertner,W.: Domain Conditions in Social Choice Theory, Cambridge University Press (2001)
[Gibbard 73] Gibbard, A.: "Manipulation of voting schemes: A general result,"
Econometrica, Vol. 41, pp. 587-602 (1973)
[Kalai 77] Kalai, E. and Muller, E.: "Characterization of domains admitting nondictatorial social welfare functions and nonmanipulable voting procedures,"
Journal of Economic Theory, Vol. 16, pp. 457-469 (1977)
[Keiding 85] Keiding, H.: Necessary and sufficient conditions for stability of effectivity functions.
International Journal of Game Theory, Vol. 14, No. 2: 99-101 (1985)
[Inada 69] Inada, K.: On the simple majority decision rule,
Econometrica, Vol. 36, pp. 490-506 (1969)
[Moulin 82] Moulin, H. and Peleg, B: Cores of effectivity functions and implementation theory,
Journal of Mathematical Economics, Vol. 10, pp. 115-145 (1988)
[Moulin 88] Moulin, H.: Axioms of Cooperative Decision Making, Cambridge Univesity Press (1988)
[Muller 77] Muller, E. and Satterthwaite, M. A.: "The equivalence of strong positive association and strategy-proofness,"
Journal of Economic Theory, Vol. 14, pp. 412-418 (1977)
[Nakamura 79] Nakamura, K.: The vetoers in a simple game with ordinal preferences.
International Journal of Game Theory, Vol. 8: 55-61 (1979)
[Peleg 98] Peleg, B.: Effectivity functions, game forms, games, and rights.
Social Choice and Welfare 15: 67-80 (1998).
[Peleg 02] Peleg, B.: Game-theoretic analysis of voting in committees,
In K. J. Arrow et al. (eds,), Handbook of Social Choice and Welfare, Vol. 1, pp. 395-423.
[Salles 75] Salles, M.: "General possibility theorem on group decision rules with Pareto-transitivity,"
Journal of Economc Theory, Vol. 11, pp. 110-118 (1975)
[Salles 76] Salles, M.: "Characterization of transitive individual preferences for quasi-transitive collective preference under simple games,"
International Economc Review, Vol. 17, pp. 308-318 (1976)
[Satterthwaite 75] Satterthwaite, M. A.: "Strategy-proofness and Arrow's conditions: Existence and correspondence theorems for voting procedures and social welfare functions,"
Journal of Economic Theory, Vol. 10, pp. 187-217 (1975)
[Sen 82] Sen, A.: Choice, Welfare and Measurement, MIT Press (1982)
[Sen 69] Sen, A. and Pattanaik, P. K.: "Necessary and sufficient condition for rational choice under majority decision,"
Journal of Economic Theory, Vol. 1, pp. 178-202 (1969)
[Shapley 62] Shapley, L. S.: "Simple games: an outline of the descriptive theor,"
Behavioral Science, Vol. 67, pp. 59-66 (1962)
[Starling 94] Starling, L. and Shapiro, E.: The Art of Prolog: Advanced Programming, 2nd edition, MIT Press (1994)
[Wilson 72] Wilson, R.: "Social choice theory without the Pareto principle,"
Journal of Economic Theory, Vol. 5: pp. 478-486 (1972)
*/
% eoc
return to front page.