You selected drsc06.pl
/************************************************************
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
return to front page.