1/*
    2unionfind_opt.pl: Union find (optimised)
    3(C) Thom.Fruehwirth at uni-ulm.de, 2005/01/25
    4(C) Tom.Schrijvers at cs.kuleuven.be, 2005/01/25
    5This program is distributed under the terms of the GNU General Public License:
    6http://www.gnu.org/licenses/gpl.html
    7
    8%% DESCRIPTION
    9Optimised union-find implementation.#
   10A new set can be created, sets can be united, and the representative for a set
   11can be searched.
   12
   13%% HOW TO USE
   14The following operations are supported:                                     #
   15  *make(A)*:    create a new set with single element A                      #
   16  *find(A,B)*:  B is representative of the set containing A                 #
   17  *union(A,B)*: join the two sets containing A and B                        #
   18  *link(A,B)*:  join the two sets represented by A and B (internal)         
   19
   20Data is represented as:                                                     #
   21  *root(A,N)*:  A is the representative of a set (root of tree with depth N)#
   22  *A ~> B*:     A and B are in the same set (edge indirectly pointing to root)
   23
   24%% SEE ALSO
   25T Schrijvers, T Fruehwirth. Optimal union-find in Constraint Handling Rules. 
   26Theory and Practice of Logic Programming, 2006.
   27
   28%% SAMPLE QUERIES
   29Q: make(a), make(b), make(c), make(d), make(e), union(a,b), union(c,d), 
   30    union(e,c).
   31A: root(a,1), root(c,1), b~>a, d~>c, e~>c.
   32
   33Q: make(a), make(b), make(c), make(d), make(e), union(a,b), union(c,d), 
   34    union(e,c), find(b,X), find(d,Y).
   35A: X=a, Y=c, root(a,1), root(c,1), b~>a, d~>c, e~>c.
   36*/
   37
   38:- module(unionfind, [make/1,union/2,find/2]).   39:- use_module(library(chr)).   40
   41:- op(700, xfx, '~>').   42
   43:- chr_constraint
   44    make(+element),
   45    find(?element,?element),
   46    union(+element,+element),
   47    (?element) ~> (+element),
   48    link(+element,?element),
   49    root(+element,?natural).
   50
   51%:- chr_type element == dense_int.          % efficient: arrays
   52:- chr_type element == int.                % less efficient: hashtables
   53
   54
   55make     @ make(A) <=> root(A,0).
   56
   57union    @ union(A,B) <=> find(A,X), find(B,Y), link(X,Y).
   58
   59findNode @ A ~> B, find(A,X) <=> find(B,X), A ~> X.
   60findRoot @ root(B,_) \ find(B,X) <=> X=B.
   61
   62linkEq   @ link(A,A) <=> true.  
   63linkLeft @ link(A,B), root(A,NA), root(B,NB) <=> NA>=NB | 
   64                B ~> A, NA1 is max(NA,NB+1), root(A,NA1).
   65linkRight