prolog source code

You selected metric_d.pl

% metric_d.pl
% preference evolution and the minimal distances by dodgeson
% date: 2007.6.30-7.2,4-6
% revised: 2007.8.25-27 (excerpt of the basic part of metric01b.pl)

% reference
% Gaertner, W. (2006). 
% A Primer in Social Choice Theory, Oxford Univrsity Press.

% preliminary: empty cores in simple games
%--------------------------------------------------------------

:- [sged06,power].
:- ['mylib/math1.pl'].

% :- [mylib/menu].


:- chdom(_->l:L), nl,write('default domain':L),nl,nl.

:- make_n_agents(3).


% make monotone proper strong game with an empty core.

mps_game_with_ec(W):-
   gen_win(W,[monotonic:yes,proper:yes,strong:yes]),
   \+ \+ core([],_).

mps_game_with_ec:-
   mps_game_with_ec(_),verify_win.

latin_square(1,[[+, +, +], [+, -, -], [-, -, +]]).
latin_square(2,[[+, +, -], [-, +, +], [-, -, -]]).

/*

?- display_domain.

current domain: ACITZN
[base domain=l:linear]

Yes
?- mode_dominance(A,on).

A = win(strict) 

Yes
?- mps_game_with_ec(_),inspect_empty_core,nl,fail.

game:[[1, 2, 3], [1, 2], [1, 3], [2, 3]]
 + :[monotonic, proper, strong, not weak, essential]
 - :[]
[[+, -, -], [-, -, +], [+, +, +]]: =>ZIA
[[-, -, +], [+, -, -], [+, +, +]]: =>IZA
[[-, -, -], [+, +, -], [-, +, +]]: =>NTC
[[+, +, -], [-, -, -], [-, +, +]]: =>TNC
[[+, -, -], [+, +, +], [-, -, +]]: =>ZAI
[[+, +, +], [+, -, -], [-, -, +]]: =>AZI
[[-, -, -], [-, +, +], [+, +, -]]: =>NCT
[[-, +, +], [-, -, -], [+, +, -]]: =>CNT
[[-, -, +], [+, +, +], [+, -, -]]: =>IAZ
[[+, +, +], [-, -, +], [+, -, -]]: =>AIZ
[[+, +, -], [-, +, +], [-, -, -]]: =>TCN
[[-, +, +], [+, +, -], [-, -, -]]: =>CTN

No

% Observe that the only simple majority game is a
% unique monotone proper strong game which has empty core. 

?- mps_game_with_ec(_), inspect_all_empty_core_sorted(L).

game:[[1, 2, 3], [1, 2], [1, 3], [2, 3]]
 + :[monotonic, proper, strong, not weak, essential]
 - :[]

W = [[1, 2, 3], [1, 2], [1, 3], [2, 3]]
L = [[[+, +, +], [+, -, -], [-, -, +]], [[+, +, -], [-, +, +], [-, -, -]]] ;

No

% Observe that the empty core are arozen from Latin squares. 

?- latin_square(K,L),name_domain(N,L).

K = 1
L = [[+, +, +], [+, -, -], [-, -, +]]
N = 'AZI' ;

K = 2
L = [[+, +, -], [-, +, +], [-, -, -]]
N = 'TCN' ;

No

?- rr(R),name_domain('ZIA',R),majority(R->M),r(M,A,B),cycle(B).

R = [[+, -, -], [-, -, +], [+, +, +]]
M = [+, -, +]
A = [ (a, b): +, (a, c): -, (b, c): +]
B = [a>b, c>a, b>c] 

Yes
?-
 
*/


% The system assumes majority decision, for n=3, size-two 
% winning coalitions, as the default.
% However, it can be replaced with any power distribution,
% i.e., a simple game,
% so that the metrics may be changing over the time.

:- mps_game_with_ec.


% transition rules for individual preferences
%--------------------------------------------------------------

:- dynamic permit_reversal/2.

permit_reversal(+,-).
permit_reversal(-,+).
permit_reversal(0,+).
permit_reversal(0,-).
permit_reversal(+,0).
permit_reversal(-,0).

malleable(P->Q,J,XY):-
   malleable(P->Q,J,XY,_).

malleable(P->Q,J,XY,Pj->Qj):-
   (var(P)-> rr(P);true),
   udrr(P,Q,_,(J,Pj,_)),
   r_j(J,Q,Qj),
%   uniquely_reverse_an_ordered_pair(XY,Pj,Qj),
   swap_direction_of_pair(XY,Pj,Qj),
   verify_permissible_reversal(XY,Pj,Qj).

verify_permissible_reversal(XY,P,Q):-
   r(P,A,_),
   r(Q,B,_),
   member(XY:S,A),member(XY:T,B),
   permit_reversal(S,T).


/*

?- malleable(P->Q,J,XY),name_domain(N,P),name_domain(M,Q).

P = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, +, +], [+, +, +], [+, +, +]]
J = 1
XY = a, b
N = 'AAA'
M = 'CAA' ;

P = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, +, -], [+, +, +], [+, +, +]]
J = 1
XY = b, c
N = 'AAA'
M = 'TAA' 

Yes

*/

% preference reversal (1): for each ordered pair
% only single step reversal is allowed 
% (It is very slow and may cause intransitivty.)
%--------------------------------------------------------------

uniquely_reverse_an_ordered_pair((X,Y),P,Q):-
   dop((X,Y)),
   r((X,Y),P),o(Q),
   \+ r((X,Y),Q),
   otherwise_equivalent((X,Y),P,Q).

uniquely_reverse_an_ordered_pair((X,Y),P,Q):-
   dop((X,Y)),
   \+ r((X,Y),P),o(Q),
   r((X,Y),Q),
   otherwise_equivalent((X,Y),P,Q).

otherwise_equivalent((X,Y),P,Q):-
   \+ (dop(W),W\=(X,Y),r(W,P),\+ r(W,Q)),
   \+ (dop(W),W\=(X,Y),\+ r(W,P),r(W,Q)).

asymmetric_difference(A,B,D1,D2):-
   subtract(A,B,D1),
   subtract(B,A,D2).

/*

?- all_dop(A).

A = [ (a, b), (a, c), (b, c), (b, a), (c, a), (c, b)] 

Yes
?- domain_type(A).

A = l:linear ;

No
?- uniquely_reverse_an_ordered_pair((a,b),[A,+,+],Q).

A = 0
Q = [-, +, +] ;

No
?- uniquely_reverse_an_ordered_pair((b,a),[A,+,+],Q).

A = 0
Q = [+, +, +] ;

No
?- uniquely_reverse_an_ordered_pair((a,b),[+,+,+],Q).

No

% direted pair (a,b) can not be reversed at a ranking [+,+,+]
% because of the linear domain.

?- r(P),uniquely_reverse_an_ordered_pair(XY,P,Q),
asymmetric_difference(P,Q,D,E),nl,write(P->Q:XY;D;E),fail.

[+, +, +]->[0, +, +]: (b, a);[];[0]
[+, +, +]->[+, 0, +]: (c, a);[];[0]
[+, +, +]->[+, +, 0]: (c, b);[];[0]
[-, +, +]->[0, +, +]: (a, b);[-];[0]
[-, +, +]->[-, 0, +]: (c, a);[];[0]
[-, +, +]->[-, +, 0]: (c, b);[];[0]
[-, -, +]->[0, -, +]: (a, b);[];[0]
[-, -, +]->[-, 0, +]: (a, c);[];[0]
[-, -, +]->[-, -, 0]: (c, b);[+];[0]
[+, +, -]->[+, +, 0]: (b, c);[-];[0]
[+, +, -]->[0, +, -]: (b, a);[];[0]
[+, +, -]->[+, 0, -]: (c, a);[];[0]
[+, -, -]->[+, 0, -]: (a, c);[];[0]
[+, -, -]->[+, -, 0]: (b, c);[];[0]
[+, -, -]->[0, -, -]: (b, a);[+];[0]
[-, -, -]->[0, -, -]: (a, b);[];[0]
[-, -, -]->[-, 0, -]: (a, c);[];[0]
[-, -, -]->[-, -, 0]: (b, c);[];[0]

No
?- 
*/

% preference reversal (2):
% symmetrically reverse the direction for each pair.
%--------------------------------------------------------------

swap_direction_of_pair(XY,P,Q):-
   \+ domain_type(_:linear),
   d_pair(XY),
   has_a_single_difference(P,Q,XY).

swap_direction_of_pair(XY,P,Q):-
   d_pair(XY),
   has_a_symmetric_difference(P,Q,XY).

has_a_single_difference(P,Q,(X,Y)):-
   r(P,_,A),r(Q,_,B),
   asymmetric_difference(A,B,D1,D2),
   member((D1,D2),[([D],[]),([],[D])]),
   member(D,[X>Y,Y>X]).

has_a_symmetric_difference(P,Q,(X,Y)):-
   r(P,_,A),r(Q,_,B),
   asymmetric_difference(A,B,D1,D2),
   member((D1,D2),[
     ([X>Y],[Y>X]),
     ([Y>X],[X>Y])
   ]).

is_upper_diagonal([A,B,C]):- A@=q:Q))),nl,fail.

p:[+, +, +] 
a, b->q:[-, +, +] 
a, c->q:[+, -, +] 
b, c->q:[+, +, -]

p:[+, +, -] 
a, b->q:[-, +, -] 
a, c->q:[+, -, -] 
b, c->q:[+, +, +]

p:[+, -, -] 
a, b->q:[-, -, -] 
a, c->q:[+, +, -] 
b, c->q:[+, -, +]

p:[-, -, -] 
a, b->q:[+, -, -] 
a, c->q:[-, +, -] 
b, c->q:[-, -, +]

No

% for (weak) orderings 

?- chdom(_->t:L).

L = transitive 

Yes
?- r(P),is_upper_diagonal(P),write(P),fail.
[+, +, +][0, +, +][0, 0, 0][+, +, -][+, -, -][0, -, -][-, -, -]

No
?- r(P),l(P),is_upper_diagonal(P),nl,write(p:P),
forall(swap_direction_of_pair(XY,P,Q),(tab(1),nl,write(XY->q:Q))),nl,fail.

p:[+, +, +] 
a, b->q:[0, +, +] 
a, b->q:[-, +, +] 
a, c->q:[+, 0, +] 
a, c->q:[+, -, +] 
b, c->q:[+, +, 0] 
b, c->q:[+, +, -]

p:[+, +, -] 
a, b->q:[0, +, -] 
a, b->q:[-, +, -] 
a, c->q:[+, 0, -] 
a, c->q:[+, -, -] 
b, c->q:[+, +, +] 
b, c->q:[+, +, 0]

p:[+, -, -] 
a, b->q:[0, -, -] 
a, b->q:[-, -, -] 
a, c->q:[+, +, -] 
a, c->q:[+, 0, -] 
b, c->q:[+, -, +] 
b, c->q:[+, -, 0]

p:[-, -, -] 
a, b->q:[+, -, -] 
a, b->q:[0, -, -] 
a, c->q:[-, +, -] 
a, c->q:[-, 0, -] 
b, c->q:[-, -, +] 
b, c->q:[-, -, 0]

No
?- r(P),\+ l(P),is_upper_diagonal(P),nl,write(p:P),
forall(swap_direction_of_pair(XY,P,Q),(tab(1),nl,write(XY->q:Q))),nl,fail.

p:[0, +, +] 
a, b->q:[+, +, +] 
a, b->q:[-, +, +] 
a, c->q:[0, 0, +] 
b, c->q:[0, +, 0] 
a, c->q:[0, -, +] 
b, c->q:[0, +, -]

p:[0, 0, 0] 
a, b->q:[+, 0, 0] 
a, b->q:[-, 0, 0] 
a, c->q:[0, +, 0] 
a, c->q:[0, -, 0] 
b, c->q:[0, 0, +] 
b, c->q:[0, 0, -]

p:[0, -, -] 
a, b->q:[+, -, -] 
a, b->q:[-, -, -] 
a, c->q:[0, 0, -] 
b, c->q:[0, -, 0] 
a, c->q:[0, +, -] 
b, c->q:[0, -, +]

No
?- Q = [[-, -, -], [0, 0, 0], [+, +, +]],
 rr(Q),malleable(Q->R,J,XY),nl,write(R;J;XY),fail.

[[0, -, -], [0, 0, 0], [+, +, +]];1;a, b
[[-, -, 0], [0, 0, 0], [+, +, +]];1;b, c
[[+, -, -], [0, 0, 0], [+, +, +]];1;a, b
[[-, -, +], [0, 0, 0], [+, +, +]];1;b, c
[[-, -, -], [0, 0, 0], [0, +, +]];3;a, b
[[-, -, -], [0, 0, 0], [+, +, 0]];3;b, c
[[-, -, -], [0, 0, 0], [-, +, +]];3;a, b
[[-, -, -], [0, 0, 0], [+, +, -]];3;b, c

No
?- P = [0,0,0],
 swap_direction_of_pair(XY,P,Q),r(Q),write(Q),fail.

No

% for quasi-transitive orderings 

?- chdom(_->q:P).

P = quasi-transitive 

Yes
?- P = [0,0,0],
 swap_direction_of_pair(XY,P,Q),r(Q),write(Q),fail.
[+, 0, 0][-, 0, 0][0, +, 0][0, -, 0][0, 0, +][0, 0, -]

No

*/


% minimal revision of core
% and coalitional manipulation
%--------------------------------------------------------------

:- dynamic minimal_revision_rr/4.

minimal_revision(X,K,A:R->B:Q,C->D,H):-
   x(X),core(C,R),\+ member(X,C),
   minimal_revision_1(X,K,A:R->B:Q,C->D,H).

minimal_revision_1(X,K,A:R->Q,B:C->D,(V,U)):-
   affect_core(rr(A),R->Q,K,V,U,C->D),
   (var(X)->(x(X),\+ member(X,C));true),
   member(X,D),
   name_domain(B,Q),
   !.

/*

?- R='AAA':_,minimal_revision(X,K,R->Q,CD,H).

R = 'AAA':[[+, +, +], [+, +, +], [+, +, +]]
X = b
K = 2
Q = 'CCA':[[-, +, +], [-, +, +], [+, +, +]]
CD = [a]->[b]
H = [2, 1], [ (a, b), (a, b)] ;

R = 'AAA':[[+, +, +], [+, +, +], [+, +, +]]
X = c
K = 4
Q = 'ZZA':[[+, -, -], [+, -, -], [+, +, +]]
CD = [a]->[c]
H = [2, 2, 1, 1], [ (a, c), (b, c), (a, c), (b, c)] 

Yes
?- 

*/


% the dodgeson's rule
%--------------------------------------------------------------

% dodgeson's distance for a given alternative 
% and a profile = the minimal number of reversals 
% in order to the alternative to be a Condorcet winner 
% of majority decision.


dodgeson_rule_bin((X,Y),R,[(K,K1),(Q,Q1),(Z,Z1)]):-
   d_pair((W,V)),((X,Y)=(W,V);(X,Y)=(V,W)),
   distance(dodgeson(min,K,X),R->Q,_,Z),
   distance(dodgeson(min,K1,Y),R->Q1,_,Z1).

dodgeson_rule_sgn('+',(K,K1)):- K < K1,!.
dodgeson_rule_sgn('-',(K,K1)):- K > K1,!.
dodgeson_rule_sgn(0,_).  % [*]

% [*] Note that in gprf06.pl, 0s, not '0's,  by means of which
% I intend to denote indifference relations, are used.  

/*
?- rr(R),x(X),\+ distance(dodgeson(min,K,X),R->Q,_,Z).

No
*/

dodgeson_rule(R->D):-
   rr(R),
   findall(S,
    (
     d_pair(XY),
     dodgeson_rule_bin(XY,R,[KK|_]),
     dodgeson_rule_sgn(S,KK)
    ),
   D).

dodgeson_rule(R->D,B):-
   dodgeson_rule(R->D),
   r(D,_,B).

% another constructon of the aggregation rule

dodgeson_rule_1(R->B):-
   rr(R),
   findall(X>Y,
    (
     dodgeson_rule_bin((X,Y),R,[(K,K1)|_]),
     K =< K1
    ),
   B).

dodgeson_rule_1(R->D,B):-
   dodgeson_rule_1(R->B),
   r(D,_,B).

% synonym

dodgeson_rule(D,B,R):- dodgeson_rule(R->D,B).

dodgeson_rule_1(D,B,R):- dodgeson_rule_1(R->D,B).

r_dodgeson(D,R):- dodgeson_rule(R->D).

r_dodgeson_1(D,R):- dodgeson_rule_1(R->D,_).


/*
?- rr(R),is_upper_diagonal(R),x(X),
\+ distance(dodgeson(min,K,X),R->Q,_,Z),nl,write(R;X),fail.

No
?- dodgeson_rule(RD,B,R).

RD = [+, +, +]
B = [a>b, a>c, b>c]
R = [[+, +, +], [+, +, +], [+, +, +]] ;

RD = [+, +, +]
B = [a>b, a>c, b>c]
R = [[-, +, +], [+, +, +], [+, +, +]] ;

RD = [+, +, +]
B = [a>b, a>c, b>c]
R = [[-, -, +], [+, +, +], [+, +, +]] ;

RD = [+, +, +]
B = [a>b, a>c, b>c]
R = [[+, +, -], [+, +, +], [+, +, +]] 

Yes
?- r(RD),\+ (rr(R),dodgeson_rule(RD,B,R)),nl,write(RD),fail.

No
?- 


?- rr(R),is_upper_diagonal(R),\+ dodgeson_rule(RD,B,R),
name_domain(A,R),nl,write(R;A),fail.

No
?- rr(R),is_upper_diagonal(R),
\+ (dodgeson_rule(R->D,B),dodgeson_rule_1(R->D,B)),
name_domain(A,R),nl,write(R;A),fail.

No

% comparison to the simple majority rule

?- rr(Q),is_upper_diagonal(Q),
r_dodgeson(RD,Q),name_domain(A,Q),majority(Q->M),
RD\=M,nl,write(A:Q;d:RD;m:M),fail.

TTC:[[+, +, -], [+, +, -], [-, +, +]];d:[+, +, 0];m:[+, +, -]
AII:[[+, +, +], [-, -, +], [-, -, +]];d:[-, 0, +];m:[-, -, +]
AZI:[[+, +, +], [+, -, -], [-, -, +]];d:[0, 0, 0];m:[+, -, +]
ZZI:[[+, -, -], [+, -, -], [-, -, +]];d:[0, -, -];m:[+, -, -]
AAZ:[[+, +, +], [+, +, +], [+, -, -]];d:[+, +, 0];m:[+, +, +]
CCN:[[-, +, +], [-, +, +], [-, -, -]];d:[-, 0, +];m:[-, +, +]
TCN:[[+, +, -], [-, +, +], [-, -, -]];d:[0, 0, 0];m:[-, +, -]
TNN:[[+, +, -], [-, -, -], [-, -, -]];d:[0, -, -];m:[-, -, -]

No
?- rr(Q),is_upper_diagonal(Q),
r_dodgeson(D,Q),majority(Q->M),D\=M,
name_domain(A,Q),nl,write((profile:A,majorty:M,dodgeson:D)),fail.

profile:TTC, majorty:[+, +, -], dodgeson:[+, +, 0]
profile:AII, majorty:[-, -, +], dodgeson:[-, 0, +]
profile:AZI, majorty:[+, -, +], dodgeson:[0, 0, 0]
profile:ZZI, majorty:[+, -, -], dodgeson:[0, -, -]
profile:AAZ, majorty:[+, +, +], dodgeson:[+, +, 0]
profile:CCN, majorty:[-, +, +], dodgeson:[-, 0, +]
profile:TCN, majorty:[-, +, -], dodgeson:[0, 0, 0]
profile:TNN, majorty:[-, -, -], dodgeson:[0, -, -]

No

% Observe that at several profiles it differs from each other 
% but the winner always is same.

?- r_dodgeson(D,Q),majority(Q->M),best(B,D),best(W,M),B\=W.

No
?- 

*/

% evolving profiles and cores :
% simulating sequentially coalitional manipulability
%--------------------------------------------------------------

trial_step(K):- time_perspective([_|H]),member(K,H).
time_perspective([0,1,2,3,4,5,6,7,8,9]).

rr_evolve(step(0),R->R,[C],[],[],[]):-rr(R),core(C,R).
rr_evolve(step(K),R->Q,[C|F],[(J,XY,Q)|H],[J|V],[XY|U]):- 
   trial_step(K),
   K0 is K- 1, length(H,K0),
   rr_evolve(step(K0),R->S,F,H,V,U),
   malleable(S->Q,J,XY),
   core(C,Q).

/*
?- latin_square(1,R),rr_evolve(step(1),R->Q,F,_,V,U).

R = [[+, +, +], [+, -, -], [-, -, +]]
Q = [[-, +, +], [+, -, -], [-, -, +]]
F = [[b], []]
V = [1]
U = [ (a, b)] ;

R = [[+, +, +], [+, -, -], [-, -, +]]
Q = [[+, +, -], [+, -, -], [-, -, +]]
F = [[c], []]
V = [1]
U = [ (b, c)] ;


Yes
?- latin_square(2,R),rr_evolve(step(1),R->Q,F,_,V,U).

R = [[+, +, -], [-, +, +], [-, -, -]]
Q = [[+, +, +], [-, +, +], [-, -, -]]
F = [[b], []]
V = [1]
U = [ (b, c)] ;

R = [[+, +, -], [-, +, +], [-, -, -]]
Q = [[+, -, -], [-, +, +], [-, -, -]]
F = [[c], []]
V = [1]
U = [ (a, c)] 

Yes
?- 
*/

test_rr_evolve(N:R,M:Q,K,L):-
   (var(N)->true;(is_upper_diagonal(R),name_domain(N,R))),
   findall(K:N->M;C->D;V;U,(
     rr(R),is_upper_diagonal(R),name_domain(N,R),
     rr_evolve(step(K),R->Q,[D|_],_,V,U),core(C,R),C\=D,
     name_domain(M,Q)
   ),L).

test_rr_evolve(N:R,M:Q,K):-
   test_rr_evolve(N:R,M:Q,K,L),
   setof(K:N->M;D;V;U,member(K:N->M;C->D;V;U,L),L1),
   member(K:N->M;D;V;U,L1),nl,write(step(K):N->M;C->D;V;U),
   fail.
test_rr_evolve(_,_,_).

/*
?- latin_square(1,R),test_rr_evolve(_:R,_,1).

step(1):AZI->ANI;[]->[b];[2];[ (a, b)]
step(1):AZI->ATI;[]->[a];[2];[ (a, c)]
step(1):AZI->AZC;[]->[a];[3];[ (a, c)]
step(1):AZI->AZN;[]->[c];[3];[ (b, c)]
step(1):AZI->CZI;[]->[b];[1];[ (a, b)]
step(1):AZI->TZI;[]->[c];[1];[ (b, c)]

R = [[+, +, +], [+, -, -], [-, -, +]]

Yes
?- test_rr_evolve('ATI':R,_,2).

step(2):ATI->ACI;[a]->[b];[2, 2];[ (a, b), (b, c)]
step(2):ATI->ANI;[a]->[b];[2, 2];[ (a, b), (a, c)]
step(2):ATI->AZN;[a]->[c];[2, 3];[ (a, c), (b, c)]
step(2):ATI->AZN;[a]->[c];[3, 2];[ (b, c), (a, c)]
step(2):ATI->CAI;[a]->[b];[1, 2];[ (a, b), (b, c)]
step(2):ATI->CAI;[a]->[b];[2, 1];[ (b, c), (a, b)]
step(2):ATI->CTC;[a]->[b];[1, 3];[ (a, b), (a, c)]
step(2):ATI->CTC;[a]->[b];[3, 1];[ (a, c), (a, b)]
step(2):ATI->CTN;[a]->[];[1, 3];[ (a, b), (b, c)]
step(2):ATI->CTN;[a]->[];[3, 1];[ (b, c), (a, b)]
step(2):ATI->CZI;[a]->[b];[1, 2];[ (a, b), (a, c)]
step(2):ATI->CZI;[a]->[b];[2, 1];[ (a, c), (a, b)]
step(2):ATI->ITI;[a]->[b];[1, 1];[ (a, c), (a, b)]
step(2):ATI->TZI;[a]->[c];[1, 2];[ (b, c), (a, c)]
step(2):ATI->TZI;[a]->[c];[2, 1];[ (a, c), (b, c)]
step(2):ATI->ZTI;[a]->[c];[1, 1];[ (a, c), (b, c)]

R = _G158 

Yes
?- 
*/

% metric on a basis of the Dodgeson rule.
%--------------------------------------------------------------

% metric on a basis of arbitrary profile.

distance(dodgeson(0),R->R,[],[C]):-
   rr(R), core(C,R).

distance(dodgeson(K),R->Q,[(J,XY,Q0)|H],[C|Z]):-
   trial_step(K),
   K0 is K- 1, length(H,K0),
   distance(dodgeson(K0),R->Q0,H,Z), malleable(Q0->Q,J,XY),
   \+ member((_,_,Q),H),
   core(C,Q),
   C\=[].
%   \+ latin_square(_,Q),  % the effect is same as C\=[] if linear domain
%   \+ member(C,Z),    % no change in output but profile growing


% metric on a basis of Latin square.

distance(latin(J,K0),R->Q0,H,Z):-
   latin_square(J,R),
   distance(dodgeson(K0),R->Q0,H,Z).

/*
?- distance(dodgeson(K),R->Q,H,C).

K = 0
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, +, +], [+, +, +], [+, +, +]]
H = []
C = [[a]] 

Yes
?- distance(dodgeson(1),R->Q,H,C).

R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, +, +], [+, +, +], [+, +, +]]
H = [ (1, (a, b), [[+, +, +], [+, +, +], [+, +, +]])]
C = [[a], [a]] 

Yes
?- distance(dodgeson(2),R->Q,H,C).

R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, -, +], [+, +, +], [+, +, +]]
H = [ (1, (a, c), [[-, +, +], [+, +, +], [+, +, +]]), (1, (a, b), [[+, +, +], [+, +, +], [+, +|...]])]
C = [[a], [a], [a]] 

Yes
?- distance(latin(1, 1),R->Q,H,C).

R = [[+, +, +], [+, -, -], [-, -, +]]
Q = [[-, +, +], [+, -, -], [-, -, +]]
H = [ (1, (a, b), [[+, +, +], [+, -, -], [-, -, +]])]
C = [[b], []] 

Yes
?- distance(latin(1, 2),R->Q,H,C).

R = [[+, +, +], [+, -, -], [-, -, +]]
Q = [[-, -, +], [+, -, -], [-, -, +]]
H = [ (1, (a, c), [[-, +, +], [+, -, -], [-, -, +]]), (1, (a, b), [[+, +, +], [+, -, -], [-, -|...]])]
C = [[b], [b], []] 

Yes
?- distance(latin(1, 3),R->Q,H,C).

R = [[+, +, +], [+, -, -], [-, -, +]]
Q = [[-, -, -], [+, -, -], [-, -, +]]
H = [ (1, (b, c), [[-, -, +], [+, -, -], [-, -, +]]), (1, (a, c), [[-, +, +], [+, -, -], [-, -|...]]), (1, (a, b), [[+, +, +], [+, -|...], [-|...]])]
C = [[c], [b], [b], []] 

Yes
?- 
*/

% the metric of dodgeson's minimal distance
%--------------------------------------------------------------

distance(dodgeson(min,K,X),R->Q,H,[C|Z]):-
   rr(R),x(X),
%   core(B,R),\+member(X,B),
   distance(dodgeson(K,X),R->Q,H,[C|Z]).

distance(dodgeson(K,X),R->Q,H,[C|Z]):-
   distance(dodgeson(K),R->Q,H,[C|Z]),
   member(X,C),
   !.

/*

?- distance(dodgeson(min,K,X),R->Q,H,[C|Z]).

K = 0
X = a
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, +, +], [+, +, +], [+, +, +]]
H = []
C = [a]
Z = [] 

Yes
?- distance(dodgeson(min,K,X),R->Q,H,[C|Z]),K>0.

K = 2
X = b
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[-, +, +], [-, +, +], [+, +, +]]
H = [ (2, (a, b), [[-, +, +], [+, +, +], [+, +, +]]), (1, (a, b), [[+, +, +], [+, +, +], [+, +|...]])]
C = [b]
Z = [[a], [a]] ;

K = 4
X = c
R = [[+, +, +], [+, +, +], [+, +, +]]
Q = [[+, -, -], [+, -, -], [+, +, +]]
H = [ (2, (a, c), [[+, -, -], [+, +, -], [+, +, +]]), (2, (b, c), [[+, -, -], [+, +, +], [+, +|...]]), (1, (a, c), [[+, +, -], [+, +|...], [+|...]]), (1, (b, c), [[+, +|...], [+|...], [...|...]])]
C = [c]
Z = [[a], [a], [a], [a]] 

Yes
?- name_domain('AZI',R),distance(dodgeson(min,K,X),R->Q,H,CZ).

R = [[+, +, +], [+, -, -], [-, -, +]]
K = 1
X = a
Q = [[+, +, +], [+, +, +], [-, -, +]]
H = [ (2, (a, b), [[+, +, +], [+, -, -], [-, -, +]])]
CZ = [[a], []] ;

R = [[+, +, +], [+, -, -], [-, -, +]]
K = 1
X = b
Q = [[-, +, +], [+, -, -], [-, -, +]]
H = [ (1, (a, b), [[+, +, +], [+, -, -], [-, -, +]])]
CZ = [[b], []] ;

R = [[+, +, +], [+, -, -], [-, -, +]]
K = 1
X = c
Q = [[+, +, -], [+, -, -], [-, -, +]]
H = [ (1, (a, b), [[+, +, +], [+, -, -], [-, -, +]])]
CZ = [[c], []] ;

No

% Observe that the metric is defined for each profile and alternative.

?- rr(R),\+ distance(dodgeson(min,K,X),R->Q,H,[C|Z]).

No
?- rr(R),x(X),\+ distance(dodgeson(min,K,X),R->Q,H,[C|Z]).

No
?-  
*/



% end
return to front page.