Switching Gears: From Lee Naish to Peter Deutsch

General
1

I hope @kuniaki.mukai will like this post. Now that
we are past this generic type of compare/3, where
rep/2 is some representation:

rep_compare(C, X, Y) :-
    rep(X, A),
    rep(Y, B),
    compare(C, A, B).

We can now switch gears, and leave naish/2 behind
us, and turn to Deutsch-Schorr-Waite marking algorithm,
that can give us as well a numbering of cycle nodes:

deutsch(X, Y) :-
   deutsch(X, Y, [], _).

deutsch(X, V, S, S) :- compound(X),
   member(v(Z,T,Y,W), S), X == Z, !,
   (var(T) -> V = Y; V = T),
   W = 1.
deutsch(X, Y, S, T) :- compound(X), !,
   length(S, N),
   X =.. [F|L],
   foldl(deutsch, L, R, [v(X,V,'$IDX'(N),W)|S], T),
   Y =.. [F|R],
   (var(W) -> V = Y; V = '$IDX'(N)).
deutsch(X, X, S, S).

The Schorr-Waite graph marking algorithm appeared first in
about 1968; it is also attributed to Peter Deutsch. So I am
calling the above predicate deutsch/2 because it is a shorter

name then schorr_waite/2 or deutsch_schorr_waite/3.
What can it do? Well it detects sharing and is thus more
resilient to examples such as hydra/2.

Naish has no sharing detection:

?- X = f(g(h(Z))), Y = k(X,X), naish(Y, T).
T = k(f(g(h(Z))), f(g(h(Z)))).

?- X = f(g(h(X))), Y = k(X,X), naish(Y, T).
T = k(f(g(h('$IDX'(1)))), f(g(h('$IDX'(1))))).

Deutsch has sharing detection:

?- X = f(g(h(Z))), Y = k(X,X), deutsch(Y, T).
T = k(f(g(h(Z))), f(g(h(Z)))).

?- X = f(g(h(X))), Y = k(X,X), deutsch(Y, T).
T = k(f(g(h('$IDX'(1)))), '$IDX'(1)).

You can also inspect the results with '$factorize_term'/3,
to see sharing that is not shown in the top-level. This
gives yet another compare/3 which is a total order

and which is conservative and can deal with sharing,
when combined with the SWI-Prolog compare/3 in
a rep_compare/3. But still expensive, not for practical

use, only for educational use.

2

But the above is difficult to understand, since compare/3
is a black box. Nobody looks at the C source code.
But we can make compare/3 also a white box:

?- member(N,[5,10,15]), time(testx6(N)), fail; true.
% 426 inferences, 0.000 CPU in 0.000 seconds (0% CPU, Infinite Lips)
% 1,301 inferences, 0.000 CPU in 0.000 seconds (0% CPU, Infinite Lips)
% 2,626 inferences, 0.000 CPU in 0.000 seconds (0% CPU, Infinite Lips)
true.

The test case was:

order_compare(C, X, Y) :-
   deutsch(X, A),
   deutsch(Y, B),
   order(C, A, B).

testx6(N) :- hydrax(N,Z,X), hydrax(N,Z,Y), order_compare(_, X, Y).

And this is the Union Find algorithm, from Hopcroft and Karp (1971)
as used in various places inside SWI-Prolog, using additional memory
pointers in the functor. Here done in 100% Prolog using same_term/2:

order(C, X, Y) :-
   sys_order(X, Y, C, [], _).

sys_order(X, Y, C, L, R) :- compound(X), compound(Y), !,
   sys_union_find(X, L, Z),
   sys_union_find(Y, L, T),
   (same_term(Z, T) ->
        C = (=), L = R;
    functor(Z, F, N), functor(T, G, M),
    compare(D, N/F, M/G), D \== (=) ->
        C = D, L = R;
    Z =.. [_|P], T =.. [_|Q],
    sys_order_list(P, Q, C, [Z-T|L], R)).
sys_order(X, Y, C, L, L) :- compare(C, X, Y).

sys_order_list([], [], =, L, L).
sys_order_list([X|P], [Y|Q], C, L, R) :-
   sys_order(X, Y, D, L, H),
   (D \== (=) -> C = D, H = R;
      sys_order_list(P, Q, C, H, R)).

sys_union_find(X, L, T) :-
   member(Y-Z, L),
   same_term(X, Y), !,
   sys_union_find(Z, L, T).
sys_union_find(X, _, X).