%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module(uf_opt,[bench/0,main/0]).

:- use_module(library(chr)).

handler uf_opt.

constraints 
	node/2, 
	union/2, 
	find/2,
	link/2,
	root/2,
	make/1
	.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

make(A) <=> root(A,0).

union(A,B) <=> find(A,X), find(B,Y), link(X,Y).

find(A,X), node(A,B) <=> find(B,X), node(A,X).  
root(B,_) \  find(B,X) <=> X=B.      % found

link(A,A) <=> true.  
link(A,B), root(A,NA), root(B,NB) <=> NA>=NB | 
                            node(B,A), NA1 is max(NA,NB+1), root(A,NA1).
link(B,A), root(A,NA), root(B,NB) <=> NA>=NB |
                            node(B,A), NA1 is max(NA,NB+1), root(A,NA1).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

bench :- (main;main;main;main),fail.

main :-
	main(1000).

main(N) :-
	bench(N,N).

bench(N,M) :-
	make_atoms(N,Atoms),
	specialunion(Atoms,Unions),
	statistics(runtime,[T1|_]),
	exists_list(Atoms),
	union_list(Unions),
	statistics(runtime,[T2|_]),
	Time is T2 - T1,
	write(bench(uf_opt,N,Time,0,sicstus)), write('.'),nl.

specialunion(A,B) :-
       specialunion(A,[],B) .

specialunion(A,B,C) :-
       ( A == [] ->
            ( B = [ _ , _ | _ ] ->
                 specialunion(B,[],C)
            ;
                 C = []
            )
       ; A = [D] ->
            specialunion([D|B],[],C)
       ; A = [D,E|F] ->
            C = [D - E|G],
            specialunion(F,[D|B],G)
       ) .

exists_list([]).
exists_list([X|Xs]) :-
	make(X),
	exists_list(Xs).

union_list([]).
union_list([X-Y|Xs]) :-
	union(X, Y),
	union_list(Xs).


make_atoms(N,L) :-
	( N > 0 ->
		make_atom(N,Atom),
		L = [Atom|T],
		M is N - 1,
		make_atoms(M,T)
	;
		L = []
	).


make_atom(N,Atom) :-
	name(N,Codes),
	atom_codes(AtomN,Codes),
	atom_concat(atom,AtomN,Atom).
