/************************************************************ domain restrictions for social choice problems program: drsc06.pl language: prolog date: 2006.12.25-26,27,31, 2007.1.1,5 creator: Kenryo INDO ************************************************************/ % load common admissible domain manager if r_admission/1 does not exist. :- (\+ clause(r_admission(_),_)->([dcdi06],init_me);true). %------------- % generate individual admissible domain dr_type(free:'arbitrary'). dr_type(free(_,_):'oligatory-avoidance'). dr_type(len(_):'arbitrary with specified length'). dr_type(sp(_):'single-peakedness'). dr_type(vr(_):'value restriction'). dr_type(er(_):'extremal restriction'). dr_type(la(_):'limited agreement'). dr_type(dp(_):'dichotonomous preference'). dr_type(ci(_):'cyclical indifference'). % added: 31 Dec 2006 % arbitrary admissible domain with oligatory-avoidance list pair (O,A) ur_domain_r(_,[],[]). ur_domain_r((O,A),[R|L],D):- ur_domain_r((O,A),L,D),\+ oof(R,O). ur_domain_r((O,A),[R|L],[R|D]):- ur_domain_r((O,A),L,D),r(R),\+ oof(R,A). % ur_domain(S,L,D):- ur_domain_r(S,L,D),D\=[]. % axiom_of_domain(free(O,A),R,_):- all_r(L),ur_domain((O,A),L,R). axiom_of_domain(free,R,_):- all_r(L),ur_domain(([],[]),L,R). axiom_of_domain(len(N),R,_):- all_r(L),select_n(R,L,N). axiom_of_domain(sp(X),R,_):- sp_domain(X,R). axiom_of_domain(vr(T),R,_):- vr_domain(T,R). axiom_of_domain(er(T),R,_):- er_domain(T,R). axiom_of_domain(la(T),R,_):- la_domain(T,R). axiom_of_domain(dp(T),R,_):- dp_domain(T,R). axiom_of_domain(ci(T),R,_):- ci_domain(T,R). axiom_of_domain(cd(T),R,P):- cd_domain(T,R,P). % axiom_of_domain(msp(X),R,_):- max_sp_domain(X,R). axiom_of_domain(mvr(T),R,_):- max_vr_domain(T,R). axiom_of_domain(mer(T),R,_):- max_er_domain(T,R). axiom_of_domain(mla(T),R,_):- max_la_domain(T,R). axiom_of_domain(mdp(T),R,_):- max_dp_domain(T,R). axiom_of_domain(mci(T),R,_):- max_ci_domain(T,R). axiom_of_domain(mcd(N),R,P):- max_cd_domain(N,R,P). % % Note: % This construction depends common admissible domain (r_admission/1) mia_domain(L,Y):- make_individually_admissible_domain(L,Y). make_individually_admissible_domain(L,CON):- agents(N),make_ia_domain(N,L,CON), update_all_r_j_admissions(L). update_all_r_j_admissions(L):- forall(member((J:Lj),L), update_r_j_admission(J,Lj)). % make_ia_domain([],[],_). make_ia_domain([J|N],[J:R|P],X):- make_ia_domain(N,P,X),axiom_of_domain(X,R,P). make_ia_domain([J|N],[J:R|P],[J:X|CON]):- make_ia_domain(N,P,CON),axiom_of_domain(X,R,P). % maximal domains max_sp_domain(S,D):- sp_domain(S,D),\+ (sp_domain(S,E),E\=D,subset(D,E)). max_vr_domain(S,D):- vr_domain(S,D),\+ (vr_domain(S,E),E\=D,subset(D,E)). max_dp_domain(S,D):- dp_domain(S,D),\+ (dp_domain(S,E),E\=D,subset(D,E)). max_er_domain(S,D):- er_domain(S,D),\+ (er_domain(S,E),E\=D,subset(D,E)). max_la_domain(S,D):- la_domain(S,D),\+ (la_domain(S,E),E\=D,subset(D,E)). max_ci_domain(S,D):- ci_domain(S,D),\+ (ci_domain(S,E),E\=D,subset(D,E)). %max_cd_domain(S,D,P):- cd_domain(S,D,P),\+ (cd_domain(_,E,P),E\=D,subset(D,E)). display_ia_domain_profile(B,X):- nl,findall(J:S,(oof(J:L,B),name_domain(S,L)),D),write(X:D). % demo /* ?- mia_domain(B,msp(X)),display_ia_domain_profile(B,X),fail. [+, +, +]:[1:ACIN, 2:ACIN] [-, +, +]:[1:ACTZ, 2:ACTZ] [-, -, +]:[1:ITZN, 2:ITZN] [+, +, -]:[1:ITZN, 2:ITZN] [+, -, -]:[1:ACTZ, 2:ACTZ] [-, -, -]:[1:ACIN, 2:ACIN] No ?- mia_domain(B,[1:mvr(medium:-X),2:mvr(medium:-Y)]), display_ia_domain_profile(B,(X,Y)),fail. (a, a):[1:AITN, 2:AITN] (b, a):[1:CITZ, 2:AITN] (c, a):[1:ACZN, 2:AITN] (a, b):[1:AITN, 2:CITZ] (b, b):[1:CITZ, 2:CITZ] (c, b):[1:ACZN, 2:CITZ] (a, c):[1:AITN, 2:ACZN] (b, c):[1:CITZ, 2:ACZN] (c, c):[1:ACZN, 2:ACZN] No ?- chdom(A). A = l:linear->t:transitive Yes ?- mia_domain(B,mci(X)),display_ia_domain_profile(B,X),fail. ((a, b, c):1):[1:BSW, 2:BSW] ((a, b, c):2):[1:FJn, 2:FJn] ((a, c, b):1):[1:BSW, 2:BSW] ((a, c, b):2):[1:FJn, 2:FJn] ((b, a, c):1):[1:BSW, 2:BSW] ((b, a, c):2):[1:FJn, 2:FJn] ((b, c, a):1):[1:BSW, 2:BSW] ((b, c, a):2):[1:FJn, 2:FJn] ((c, a, b):1):[1:BSW, 2:BSW] ((c, a, b):2):[1:FJn, 2:FJn] ((c, b, a):1):[1:BSW, 2:BSW] ((c, b, a):2):[1:FJn, 2:FJn] No ?- mia_domain(B,cd(X)),X>=8,display_ia_domain_profile(B,X),fail. 8:[1:ABCFIJOT, 2:ABCFIJOT] 8:[1:ABCFIOSN, 2:ABCFIJOT] 8:[1:ABCFOSnN, 2:ABCFIJOT] 8:[1:ABCJOTWZ, 2:ABCFIJOT] 8:[1:ABCJOWZn, 2:ABCFIJOT] 8:[1:ABFIJOST, 2:ABCFIJOT] 8:[1:ABFIJOSN, 2:ABCFIJOT] 8:[1:ABFJOSnN, 2:ABCFIJOT] 8:[1:ABJOSWnN, 2:ABCFIJOT] 8:[1:ABJOWZnN, 2:ABCFIJOT] 8:[1:AJOSTWnN, 2:ABCFIJOT] 8:[1:AJOTWZnN, 2:ABCFIJOT] 8:[1:BCFIJOTW, 2:ABCFIJOT] 8:[1:BCFJOTWZ, 2:ABCFIJOT] 8:[1:BCFJOWZn, 2:ABCFIJOT] 8:[1:BCFOSWZn, 2:ABCFIJOT] 8:[1:BCFOSZnN, 2:ABCFIJOT] 8:[1:BFIJOSTW, 2:ABCFIJOT] 8:[1:CFIOSWZn, 2:ABCFIJOT] 8:[1:CFIOSZnN, 2:ABCFIJOT] 8:[1:FIJOSTWn, 2:ABCFIJOT] 8:[1:FIOSTWZn, 2:ABCFIJOT] 8:[1:IJOSTWnN, 2:ABCFIJOT] .... Action (h for help) ? abort % Execution Aborted ?- ?- */ %%% restrictions for each domain %%%% %------------- % betweenness and single-peakedness (See Arrow, p.77) r_between((X,Y,Z),R):- l(R),p((X,Y),R),p((Y,Z),R). r_between((Z,Y,X),R):- l(R),p((X,Y),R),p((Y,Z),R). nsp(S,R,(X,Y,Z)):- r_between((X,Y,Z),S),r((X,Y),R),\+ p((Y,Z),R). % single-peaked domain sp_domain_r(_,[],[]). sp_domain_r(S,[_|L],D):- sp_domain_r(S,L,D). sp_domain_r(S,[R|L],[R|D]):- sp_domain_r(S,L,D),r(R),\+ nsp(S,R,_). % sp_domain(S,D):- var(D),all_r(L),l(S),sp_domain_r(S,L,D),D\=[]. sp_domain(S,D):- \+ var(D), l(S), \+ (oof(R,D),nsp(S,R)). % demo /* ?- max_sp_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),tab(1), findall(A,(oof(R,L),worst(A,R)),B),write(worst:B),fail. [+, +, +]:[[+, +, +], [-, +, +], [-, -, +], [-, -, -]]:ACIN worst:[c, c, a, a] [-, +, +]:[[+, +, +], [-, +, +], [+, +, -], [+, -, -]]:ACTZ worst:[c, c, b, b] [-, -, +]:[[-, -, +], [+, +, -], [+, -, -], [-, -, -]]:ITZN worst:[a, b, b, a] [+, +, -]:[[-, -, +], [+, +, -], [+, -, -], [-, -, -]]:ITZN worst:[a, b, b, a] [+, -, -]:[[+, +, +], [-, +, +], [+, +, -], [+, -, -]]:ACTZ worst:[c, c, b, b] [-, -, -]:[[+, +, +], [-, +, +], [-, -, +], [-, -, -]]:ACIN worst:[c, c, a, a] No ?- */ %------------- % value restriction (See Sen(1982), Inada(1969)) value_type( worst). value_type( best). value_type( medium). value(T:W,(X,Y,Z),R):- value_type(T),dot((X,Y,Z)),r(R), V=..[T,W,[X,Y,Z],R], V. /* ?- A=(a,b,c),value(medium:W,A,R),nl,write(W:A:R),fail. b: (a, b, c):[+, +, +] a: (a, b, c):[-, +, +] c: (a, b, c):[-, -, +] c: (a, b, c):[+, +, -] a: (a, b, c):[+, -, -] b: (a, b, c):[-, -, -] No ?- */ concerned(XYZ,R):- dot(XYZ),r(R),\+ unconcerned(XYZ,R). unconcerned((X,Y,Z),R):- i((X,Y),R),i((X,Z),R),i((Y,Z),R). nvr(T:-W,R,XYZ):- concerned(XYZ,R),value(T:W,XYZ,R). vr_domain_r(_,[],[]). vr_domain_r(S,[_|L],D):- vr_domain_r(S,L,D). vr_domain_r(S,[R|L],[R|D]):- vr_domain_r(S,L,D),r(R),\+ nvr(S,R,_). % vr_domain(T:-W,D):- var(D),value_type(T),x(W),all_r(L),vr_domain_r(T:-W,L,D),D\=[]. vr_domain(T:-W,D):- \+ var(D),value_type(T),x(W),\+ (oof(R,D),nvr(T:-W,R,_)). % demo demo_vr_domain:-L=[' ','?- max_vr_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),fail. ','(worst:-a):[[+, +, +], [-, +, +], [+, +, -], [+, -, -]]:ACTZ ','(worst:-b):[[+, +, +], [-, +, +], [-, -, +], [-, -, -]]:ACIN ','(worst:-c):[[-, -, +], [+, +, -], [+, -, -], [-, -, -]]:ITZN ','(best:-a):[[-, +, +], [-, -, +], [+, -, -], [-, -, -]]:CIZN ','(best:-b):[[+, +, +], [+, +, -], [+, -, -], [-, -, -]]:ATZN ','(best:-c):[[+, +, +], [-, +, +], [-, -, +], [+, +, -]]:ACIT ','(medium:-a):[[+, +, +], [-, -, +], [+, +, -], [-, -, -]]:AITN ','(medium:-b):[[-, +, +], [-, -, +], [+, +, -], [+, -, -]]:CITZ ','(medium:-c):[[+, +, +], [-, +, +], [+, -, -], [-, -, -]]:ACZN ',' ','No ','?- '], member(X,L),write(X),fail;true. %------------- % dichotonomous preference (See Inada(1969), Salles(1976)). d_pair_in_triple((X,Y),(Z,W,V)):- dot((Z,W,V)),T=[Z,W,V],sort(T,T),dop((X,Y)),subset([X,Y],T),X@t:transitive Yes ?- max_dp_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),fail. ((a, b): (a, b, c)):[[0, +, +], [0, 0, 0], [0, -, -]]:BOn ((a, b): (a, b, c)):[[0, +, +], [0, 0, 0], [0, -, -]]:BOn ((a, c): (a, b, c)):[[-, 0, +], [0, 0, 0], [+, 0, -]]:FOW ((a, c): (a, b, c)):[[-, 0, +], [0, 0, 0], [+, 0, -]]:FOW ((a, c): (a, b, c)):[[-, 0, +], [0, 0, 0], [+, 0, -]]:FOW ((a, c): (a, b, c)):[[-, 0, +], [0, 0, 0], [+, 0, -]]:FOW ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS ((b, c): (a, b, c)):[[+, +, 0], [0, 0, 0], [-, -, 0]]:JOS No ?- */ %------------- % extremal restriction and limited agreement (See Sen(1982), Inada(1969)) ner(S,R,(A,B,C)):- S\=[],p((A,B),R),p((B,C),R). chk_er((A,B,C),Q):- dot((A,B,C)),p((C,A),Q),\+ (p((C,B),Q),p((B,A),Q)). er_domain_r([],[],[]). er_domain_r(S,[_|L],D):- er_domain_r(S,L,D). er_domain_r(S,[R|L],[R|D]):- er_domain_r(S,L,D),r(R),\+ chk_er(_,R),\+ ner(S,R,_). er_domain_r([R|S],[R|L],[R|D]):- er_domain_r(S,L,D),r(R),\+ \+ chk_er(_,R),\+ ner(S,R,_). % er_domain(S,D):- var(D),all_r(L),er_domain_r(S,L,D),D\=[]. la_domain_r(_,[],[]). la_domain_r(S,[_|L],D):- la_domain_r(S,L,D). la_domain_r(S,[R|L],[R|D]):- la_domain_r(S,L,D),r(R),r(S,R). % la_domain(S,D):- var(D),dop(S),all_r(L),la_domain_r(S,L,D),D\=[]. la_domain(S,D):- \+ var(D),dop(S),\+ (oof(R,D),\+ r(S,R)). % demo /* ?- chdom(A). A = t:transitive->l:linear Yes ?- max_er_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),fail. [[-, -, -]]:[[-, -, -]]:N [[+, -, -]]:[[+, -, -]]:Z [[+, +, -]]:[[+, +, -]]:T [[-, -, +]]:[[-, -, +]]:I [[-, +, +]]:[[-, +, +]]:C [[+, +, +]]:[[+, +, +]]:A No ?- max_la_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),fail. (a, b):[[+, +, +], [+, +, -], [+, -, -]]:ATZ (a, c):[[+, +, +], [-, +, +], [+, +, -]]:ACT (b, c):[[+, +, +], [-, +, +], [-, -, +]]:ACI (b, a):[[-, +, +], [-, -, +], [-, -, -]]:CIN (c, a):[[-, -, +], [+, -, -], [-, -, -]]:IZN (c, b):[[+, +, -], [+, -, -], [-, -, -]]:TZN No ?- */ %------------- % cyclical indifference (See Salles(1975), and Gaertner(2002), p.44) ci_latin_square((1,a),R,(X,Y,Z)):- i((X,Y),R),p((Y,Z),R). ci_latin_square((1,b),R,(Z,X,Y)):- i((X,Y),R),p((Y,Z),R). ci_latin_square((1,c),R,(Y,Z,X)):- i((X,Y),R),p((Y,Z),R). ci_latin_square((2,a),R,(X,Y,Z)):- p((X,Y),R),i((Y,Z),R). ci_latin_square((2,b),R,(Z,X,Y)):- p((X,Y),R),i((Y,Z),R). ci_latin_square((2,c),R,(Y,Z,X)):- p((X,Y),R),i((Y,Z),R). nci(XYZ:J,R):- \+ (r(R),ci_latin_square((J,_),R,XYZ)). nci(XYZ:J,R):- r(R),\+ ci_latin_square((J,_),R,XYZ). ci_domain_r(_,[],[]). ci_domain_r(S,[_|L],D):- ci_domain_r(S,L,D). ci_domain_r(S,[R|L],[R|D]):- ci_domain_r(S,L,D),r(R),\+ nci(S,R). % ci_domain(T:J,D):- var(D),dot(T),member(J,[1,2]),all_r(L),ci_domain_r(T:J,L,D),D\=[]. ci_domain(T:J,D):- \+ var(D),dot(T),member(J,[1,2]),\+ (oof(R,D),nci(T:J,R)). % demo /* ?- chdom(A). A = l:linear->t:transitive Yes ?- max_ci_domain(S,L),name_domain(Y,L),nl,write(S:L:Y),fail. ((a, b, c):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((a, b, c):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn ((a, c, b):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((a, c, b):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn ((b, a, c):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((b, a, c):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn ((b, c, a):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((b, c, a):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn ((c, a, b):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((c, a, b):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn ((c, b, a):1):[[0, +, +], [-, -, 0], [+, 0, -]]:BSW ((c, b, a):2):[[-, 0, +], [+, +, 0], [0, -, -]]:FJn No ?- */ %------------- % cyclical dependence (See Salles(1976), and Gaertner(2002), p.44) cd_domain(N,R,P):- (var(P)->P=[];true), r_admission(A),select_n(R,A,N),cd_domain([R|P]). cd_domain(D):- \+ var(D),\+ violtes_cd_domain(D). cd_domain:- \+ ( r_j_admission(_,L1),oof(R1,L1), r_j_admission(_,L2),oof(R2,L2), r_j_admission(_,L3),oof(R3,L3), ncd(_,[R1,R2,R3],_)). violtes_cd_domain(D):- ncd(_,[R1,R2,R3],_), oof(L1,D),oof(R1,L1), oof(L2,D),oof(R2,L2), oof(L3,D),oof(R3,L3). % ncd(Case,[R1,R2,R3],T):- dot(T), r(R1),ncd_pattern([p,p],R1,T), r(R2), r(R3),ncd_case(Case,[R2,R3],T). ncd_case(1,[R2,R3],(X,Y,Z)):- ncd_pattern([p,p],R2,(Y,Z,X)), ncd_pattern([r,r],R3,(Z,X,Y)),concerned((X,Y,Z),R3). ncd_case(2,[R2,R3],(X,Y,Z)):- ncd_pattern([r,r],R2,(Y,Z,X)),concerned((X,Y,Z),R2), ncd_pattern([p,p],R3,(Z,X,Y)). ncd_case(3,[R2,R3],(X,Y,Z)):- ncd_pattern([p,i],R2,(Y,Z,X)), ncd_pattern([i,p],R3,(Z,X,Y)). ncd_pattern([p,p],R,(X,Y,Z)):- p((X,Y),R),p((Y,Z),R). ncd_pattern([r,r],R,(X,Y,Z)):- r((X,Y),R),r((Y,Z),R). ncd_pattern([p,i],R,(X,Y,Z)):- p((X,Y),R),i((Y,Z),R). ncd_pattern([i,p],R,(X,Y,Z)):- i((X,Y),R),p((Y,Z),R). % demo /* ?- ncd(Q,W,T),nl,write(case:Q:W=''),display_domain(W),write('':T),fail. case:1:[[+, +, +], [-, -, +], [+, -, -]]=AIZ: (a, b, c) case:2:[[+, +, +], [-, -, +], [+, -, -]]=AIZ: (a, b, c) case:1:[[+, +, -], [-, -, -], [-, +, +]]=TNC: (a, c, b) case:2:[[+, +, -], [-, -, -], [-, +, +]]=TNC: (a, c, b) case:1:[[-, +, +], [+, +, -], [-, -, -]]=CTN: (b, a, c) case:2:[[-, +, +], [+, +, -], [-, -, -]]=CTN: (b, a, c) case:1:[[-, -, +], [+, -, -], [+, +, +]]=IZA: (b, c, a) case:2:[[-, -, +], [+, -, -], [+, +, +]]=IZA: (b, c, a) case:1:[[+, -, -], [+, +, +], [-, -, +]]=ZAI: (c, a, b) case:2:[[+, -, -], [+, +, +], [-, -, +]]=ZAI: (c, a, b) case:1:[[-, -, -], [-, +, +], [+, +, -]]=NCT: (c, b, a) case:2:[[-, -, -], [-, +, +], [+, +, -]]=NCT: (c, b, a) No ?- chdom(A). A = l:linear->t:transitive Yes ?- cd_domain(S,L,P),length(L,N),N>=8,name_domain(Y,L),nl,write(S:Y),fail. 8:ABCFIJOT 8:ABCFIOSN 8:ABCFOSnN 8:ABCJOTWZ 8:ABCJOWZn 8:ABFIJOST 8:ABFIJOSN 8:ABFJOSnN 8:ABJOSWnN 8:ABJOWZnN 8:AJOSTWnN 8:AJOTWZnN 8:BCFIJOTW 8:BCFJOTWZ 8:BCFJOWZn 8:BCFOSWZn 8:BCFOSZnN 8:BFIJOSTW 8:CFIOSWZn 8:CFIOSZnN 8:FIJOSTWn 8:FIOSTWZn 8:IJOSTWnN 8:IOSTWZnN ?- */ % a prirty print table_of_violations_against_cyclical_dependence:- table_ncd. table_ncd:- nl,writef('%5r%10r%7r%7r%7r', [case, triple,r1,r2,r3]), nl,writef('%r', ['_', 41]), setof(K2, R123^(ncd(I,R123,XYZ),numbering_domain([K,K1,K2],R123)),L), nl,writef('%5c%10r%7r%7r', [I, XYZ,K,K1]),tab(3),write(L), fail. table_ncd:- nl,writef('%r', ['_', 41]). /* ?- table_ncd. case triple r1 r2 r3 _________________________________________ 1 a, b, c 1 9 [25] 2 a, b, c 1 9 [25] 1 a, c, b 19 27 [3] 2 a, c, b 19 27 [3] 1 b, a, c 3 19 [27] 2 b, a, c 3 19 [27] 1 b, c, a 9 25 [1] 2 b, c, a 9 25 [1] 1 c, a, b 25 1 [9] 2 c, a, b 25 1 [9] 1 c, b, a 27 3 [19] 2 c, b, a 27 3 [19] _________________________________________ Yes ?- chdom(A). A = l:linear->t:transitive Yes ?- table_ncd. case triple r1 r2 r3 _________________________________________ 3 a, b, c 1 6 [22] 2 a, b, c 1 6 [25] 2 a, b, c 1 9 [25] 1 a, b, c 1 9 [22, 25, 26] 2 a, b, c 1 18 [25] 2 a, c, b 19 18 [3] 3 a, c, b 19 26 [2] 2 a, c, b 19 26 [3] 2 a, c, b 19 27 [3] 1 a, c, b 19 27 [2, 3, 6] 3 b, a, c 3 10 [18] 2 b, a, c 3 10 [27] 1 b, a, c 3 19 [18, 26, 27] 2 b, a, c 3 19 [27] 2 b, a, c 3 22 [27] 2 b, c, a 9 22 [1] 2 b, c, a 9 25 [1] 1 b, c, a 9 25 [1, 2, 10] 2 b, c, a 9 26 [1] 3 b, c, a 9 26 [2] 2 c, a, b 25 1 [9] 1 c, a, b 25 1 [6, 9, 18] 2 c, a, b 25 2 [9] 2 c, a, b 25 10 [9] 3 c, a, b 25 10 [18] 2 c, b, a 27 2 [19] 2 c, b, a 27 3 [19] 1 c, b, a 27 3 [10, 19, 22] 2 c, b, a 27 6 [19] 3 c, b, a 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 number_in_Salles(K,A,Ours):- id_r(K:A,_,_), nth1(K,[1,10,2,9,6,18,25,26,22,19,27,3,14],Ours). setof_ncd_in_Salles_numbering((I,S,S1),L1,XYZ):- setof(K2, R123^(ncd(I,R123,XYZ),numbering_domain([K,K1,K2],R123)),L), number_in_Salles(S,_,K),number_in_Salles(S1,_,K1), findall(S2,(member(K2,L),number_in_Salles(S2,_,K2)),L1). % a prirty print table_of_violations_against_cd_in_Salles_numbering:- table_ncd_Salles. table_ncd_Salles:- nl,writef('%5r%10r%7r%7r%7r', [case, r1(list),r1,r2,r3]), nl,writef('%r', ['_', 41]), setof_ncd_in_Salles_numbering((I,K,K1),L,XYZ), nl,writef('%5c%10r%7r%7r', [I, XYZ,K,K1]),tab(3),write(L), fail. table_ncd_Salles:- nl,writef('%r', ['_', 41]). /* ?- table_ncd_Salles. case r1(list) r1 r2 r3 _________________________________________ 3 a, b, c 1 5 [9] 2 a, b, c 1 5 [7] 2 a, b, c 1 4 [7] 1 a, b, c 1 4 [9, 7, 8] 2 a, b, c 1 6 [7] 2 a, c, b 10 6 [12] 3 a, c, b 10 8 [3] 2 a, c, b 10 8 [12] 2 a, c, b 10 11 [12] 1 a, c, b 10 11 [3, 12, 5] 3 b, a, c 12 2 [6] 2 b, a, c 12 2 [11] 1 b, a, c 12 10 [6, 8, 11] 2 b, a, c 12 10 [11] 2 b, a, c 12 9 [11] 2 b, c, a 4 9 [1] 2 b, c, a 4 7 [1] 1 b, c, a 4 7 [1, 3, 2] 2 b, c, a 4 8 [1] 3 b, c, a 4 8 [3] 2 c, a, b 7 1 [4] 1 c, a, b 7 1 [5, 4, 6] 2 c, a, b 7 3 [4] 2 c, a, b 7 2 [4] 3 c, a, b 7 2 [6] 2 c, b, a 11 3 [10] 2 c, b, a 11 12 [10] 1 c, b, a 11 12 [2, 10, 9] 2 c, b, a 11 5 [10] 3 c, b, a 11 5 [9] _________________________________________ Yes ?- */ %-----------end