% 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