1:- module(hcycle, []).    2
    3:- use_module(zdd('zdd-array')).    4:- use_module(zdd(zdd)).    5:- use_module(pac(op)).    6:- use_module(zdd('frontier-vector')).    7
    8% ?- rect_hamilton(rect(5,5), Cs), card(Cs, C).
    9%@ merge completed
   10%@ Cs = 152632,
   11%@ C = 1072.
   12% ?- rect_hamilton(rect(6,6), Cs), card(Cs, C).
   13%@ merge completed
   14%@ Cs = C, C = 0.
   15% ?- rect_hamilton(rect(7,7), Cs), card(Cs, C).
   16%@ C = 4638576.
   17
   18% ?- N=7,
   19%	call_with_time_limit(3600, forall( (between(1,N,I), between(I, N,J)),
   20%			 (	rect_hamilton(rect(I,J), Cs),
   21%				card(Cs, C),
   22%				writeln(rect(I,J)=C)
   23%				))).
   24
   25rect_hamilton(Rect, Cs):- rect_links(Rect, Links),
   26						  use_memo(hamilton(Links, Cs)).
   27
   28hamilton(Links, Cs):- prepare_udg(Links),
   29					  get_key(dom, D),
   30					  length(D, N),
   31					  udg_path(1-N, Cs0),
   32					  self_disjoint_merge(Cs0, Cs1),
   33					  writeln("merge completed"),
   34					  hamilton_filter(D, Cs1, Cs).
   35%
   36self_disjoint_merge(X, Y):- zdd_disjoint_merge(X, X, Y).
   37
   38
   39% Experimental.
   40% Qustion: Is a single undirected link a cycle ?
   41% Take much time.  Need to take time.
   42cycles(Links, FCs):- prepare_udg(Links),
   43		get_key(dom, D),
   44		length(D, N),
   45		findall(I-J, (between(1, N, I), I0 is I+1,
   46					  between(I0, N, J)
   47					 ),
   48				Pairs),
   49		maplist(udg_path, Pairs, FPaths),
   50		maplist(self_disjoint_merge, FPaths, FMs),
   51		zdd_join_list(FMs, FCs).
   52
   53% ?- rect_cycles(rect(3,0), R), card(R, C).
   54% ?- rect_cycles(rect(1,1), R), card(R, C).
   55% ?- rect_cycles(rect(2,1), R), card(R, C).
   56% ?- rect_cycles(rect(3,3), R), card(R, C).
   57% ?- rect_cycles(rect(5,5), R), card(R, C).  % take some minutes
   58%@ R = 43266701,
   59%@ C = 11903735.
   60
   61rect_cycles(Rect, FCs):- rect_links(Rect, Links),
   62						 cycles(Links, FCs)