Graceful Tree Labelling using Simulated Annealing

This code requires the Simulated Annealing package.

/* 
 * Graceful Tree Labelling using Simulated Annealing
 *
 * The labelling of a tree of N nodes is an assignment of the numbers 0 to N-1
 * to its nodes. A labelling is graceful if the N-1 differences of the adjacent
 * labels are distinct.
 *
 * Ringel-Kotzig Conjecture: Every tree admits a graceful labelling.
 */

graceful(N, Edges0):-
  nodes(Edges0, [], Nodes),
  edges(Edges0, Nodes, Edges),
  retractall(size(_)),
  retractall(the_nodes(_)),
  retractall(the_edges(_)),
  asserta(size(N)),
  asserta(the_nodes(Nodes)),
  asserta(the_edges(Edges)),
  anneal.

/* perturb(Xs, Ys) is true if the list Xs is a permutation of the integers   */
/*   0 to Size-1, and Ys is the same as Xs except that two pseudo-randomly   */
/*   selected elements have been exchanged.                                  */
perturb(Xs, Ys):-
  size(Size),
  random(Size, I),
  repeat,
    random(Size, J),
  I =\= J, !,
  subst(Xs, I, -1, Xs1),
  subst(Xs1, J, I, Xs2),
  subst(Xs2, -1, J, Ys).

/* subst(Ls, X, Y, Ms) is true if the list Ms is the same as the list Ls     */
/*   except that the first occurrence of the element X is replaced by Y.     */
subst([X|Ls], X, Y, Ms):-!, Ms=[Y|Ls].
subst([L|Ls], X, Y, [L|Ms]):-subst(Ls, X, Y, Ms).

% Given the alphabetic edges generates the alphabetic nodes
nodes([], Nodes0, Nodes):-
  reverse(Nodes0, Nodes).
nodes([[A,B]|Xss], Nodes0, Nodes):-
  \+ member(A, Nodes0),
  \+member(B, Nodes0), !,
  nodes(Xss, [B,A|Nodes0], Nodes).
nodes([[A,_]|Xss], Nodes0, Nodes):-
  \+ member(A, Nodes0), !,
  nodes(Xss, [A|Nodes0], Nodes).
nodes([[_,B]|Xss], Nodes0, Nodes):-
  \+ member(B, Nodes0), !,
  nodes(Xss, [B|Nodes0], Nodes).
nodes([[_,_]|Xss], Nodes0, Nodes):-
  nodes(Xss, Nodes0, Nodes).

% Given the alphabetic edges and the alphabetic nodes generates the numeric
%   edges
edges([], _, []).
edges([[A,B]|Xss], Nodes, [[I,J]|Edges]):-
  nth(Nodes, I, A),
  nth(Nodes, J, B), !,
  edges(Xss, Nodes, Edges).

% The energy is N-1-(the number of distinct differences of adjacent labels)
energy(Labels, Energy):-
  the_edges(Edges),
  size(N), !,
  N1 is N - 1,
  energy_1(Edges, Labels, [], N1, Energy).

energy_1([], _, _, Energy, Energy).
energy_1([[I,J]|Edges], Labels, Xs, Energy0, Energy):-
  nth(Labels, I, K),
  nth(Labels, J, L),
  X is abs(K - L),
  \+ member(X, Xs), !,
  Energy1 is Energy0 - 1,
  energy_1(Edges, Labels, [X|Xs], Energy1, Energy).
energy_1([_|Edges], Labels, Xs, Energy0, Energy):-
  energy_1(Edges, Labels, Xs, Energy0, Energy).

output(optimal, Labels, 0):-
  % Solution found
  the_nodes(Nodes), !,
  output_1(Nodes, Labels).
output(iterations, _, _):-
  write(`Solution not found - all iterations performed`), nl.
output(nochanges, _, _):-
  write(`Solution not found - no changes made at a given temperature`), nl.
  
output_1([], []):-nl.
output_1([Node|Nodes], [Label|Labels]):-  
  write(Node), write('='), write(Label), write(' '),
  output_1(Nodes, Labels).
  
/* nth(+Xs, ?N, ?X) is true if X is the N-th (base 0) element of the list Xs.*/
nth(Xs, N, X):-nth_1(Xs, X, 0, N).

nth_1([X|_], X, N, N).
nth_1([_|Xs], X, N0, N):-
  N1 is N0 + 1,
  nth_1(Xs, X, N1, N).

/* member(X, Ys) is true if the element X is contained in the list Ys.       */
% member(X, [X|_]).
% member(X, [_|Ys]):-member(X, Ys).

/* reverse(Xs, Ys) is true if Ys is the result of reversing the order of the */
/*   elements in the list Xs.                                                */
%reverse(Xs, Ys):-reverse_1(Xs, [], Ys).

%reverse_1([], As, As).
%reverse_1([X|Xs], As, Ys):-reverse_1(Xs, [X|As], Ys).

/*
 * Sample data
 */

% Gives, for example:
% a=5 b=0 d=4 g=1 c=2 e=6 f=3
% Gives, for example:
% a=2 b=7 c=13 g=1 h=10 i=9 d=3 e=0 f=4 k=5 q=12 m=6 n=8 p=11
go_14:-
  Edges=[[a,b],[a,c],[a,g],[a,h],[a,i],[c,d],[c,e],[c,f],[d,k],[e,q],[q,m],
         [q,n],[n,p]],
  graceful(14, Edges).

% Gives, for example:
% a=19 b=11 c=0 d=4 e=8 f=18 g=9 h=16 i=17 j=12 k=13 l=1 m=15 n=10 o=14 p=7
%   q=6 r=5 s=2 t=3 
go_20:-
  Edges=[[a,b],[a,c],[b,d],[b,e],[c,f],[c,g],[c,h],[d,i],[e,j],[f,k],[f,l],
         [g,m],[g,n],[h,o],[i,p],[i,q],[i,r],[i,s],[i,t]],
  graceful(20, Edges).

LPA Index     Home Page

Valid HTML 4.01 Strict