Hamiltonian Cycle of a Graph

/*
 * Hamiltonian Cycle:
 *   A graph consists of a set of vertices and a set of edges, where an edge
 *   is a pair of distinct vertices.
 *   Two vertices of a graph are adjacent if there is an edge from the first
 *   to the second.
 *   A path is a sequence of vertices, each adjacent to the next.
 *   A cycle is a path containing at least three vertices such that the last
 *   vertex is adjacent to the first.
 *   A Hamiltonian cycle of a graph is a cycle containing all the vertices 
 *   of the graph.
 */

/* ham_cyc(Graph, HamiltonianCycle) is true if HamiltonianCycle is a         */
/*   Hamiltonian cycle of the undirected Graph. Due to the heuristics used,  */
/*   for some graphs it may be necessary to perform several runs in order to */
/*   obtain a solution. And perhaps for some graphs, a solution will never   */
/*   be obtained.                                                            */
/* e.g. ham_cyc([g(1,[4,5,6]),g(2,[3,6]),g(3,[2,4,6]),g(4,[1,3,5]),          */
/*               g(5,[1,4]),g(6,[1,2,3])], [5,4,3,2,6,1]).                   */
ham_cyc(Graph, _):-
  member(g(_,[]), Graph), !,
  write(`Graph contains a degree-0 vertex`), nl,
  fail.
ham_cyc(Graph, _):-
  member(g(_,[_]), Graph), !,
  write(`Graph contains a degree-1 vertex`), nl,
  fail.
ham_cyc(Graph, HamiltonianCycle):-
  length(Graph, Order),
  rand_int(1, Order, Index),
  nth(Graph, Index, g(Vertex,Neighbours)),        % Start at a random vertex
  Order1 is Order - 1,
  ham_cyc_1(Order1, Graph, Neighbours, [], [Vertex], HamiltonianCycle).

ham_cyc_1(0, _, Neighbours, _, HamCyc, HamCyc):-  % The path is complete
  last(HamCyc, FirstVertex),
  member(FirstVertex, Neighbours), !.             % The path is a cycle
ham_cyc_1(I, Graph, Neighbours, _, Path, HamCyc):-
  I > 0, I1 is I - 1,                             % The path is not complete
  extend_path(Neighbours, Graph, Path, Path1),    % Try to extend the path
  Path1=[EndPoint|_],
  member(g(EndPoint,Neighbours1), Graph), !,
  ham_cyc_1(I1, Graph, Neighbours1, [], Path1, HamCyc).  
ham_cyc_1(I, Graph, Neighbours, _, Path, HamCyc):-
  I > 0, I1 is I - 1,                             % The path is not complete
  last(Path, FirstVertex),
  member(FirstVertex, Neighbours),                % The path is a cycle
  extend_cycle(Path, Graph, Path1),               % Try to extend the cycle
  Path1=[EndPoint|_],
  member(g(EndPoint,Neighbours1), Graph), !,
  ham_cyc_1(I1, Graph, Neighbours1, [], Path1, HamCyc).
ham_cyc_1(I, Graph, Ns, EPs, Path, HamCyc):-      % Complete or not complete,
  rotate_path(Ns, I, Graph, EPs, Path, HamCyc).   %   try to rotate the path

/* extend_path(Ns, Graph, Path, ExtendedPath) is true if Ns are the          */
/*   neighbours of the endpoint of Path, and ExtendedPath is the result of   */
/*   extending Path at either end with a vertex from the Graph.              */
extend_path(Ns, _, Path, [Neighbour|Path]):-   % Try to extend from endpoint
  first_non_member(Ns, Path, Neighbour), !.
extend_path(_, Graph, Path, [Neighbour|ReversedPath]):-
  reverse(Path, ReversedPath),                 % Reverse the path and try again
  ReversedPath=[Vertex|_],
  member(g(Vertex,Ns), Graph), !,
  first_non_member(Ns, ReversedPath, Neighbour).
  
/* first_non_member(Neighbours, Path, Neighbour) is true if Neighbour is     */
/*   the first element of Neighbours which is not a member of the Path.      */
first_non_member([Neighbour|_], Path, Neighbour):-
  \+ member(Neighbour, Path), !.
first_non_member([_|Neighbours], Path, Neighbour):-
  first_non_member(Neighbours, Path, Neighbour).

/* extend_cycle(Cycle, Graph, ExtendedPath) is true if ExtendedPath is the   */
/*   result of applying "cycle extension" to the Cycle in the Graph.         */
extend_cycle(Cycle, Graph, ExtendedPath):-
  extend_cycle_1(Cycle, Graph, Cycle, ExtendedPath).

extend_cycle_1([Vertex|_], Graph, Cycle, ExtendedPath):-
  member(g(Vertex,Neighbours), Graph),
  first_non_member(Neighbours, Cycle, NewEndPoint), !,
  before_and_after(Cycle, Vertex, Path1, Path2),
  append([NewEndPoint|Path2], Path1, ExtendedPath).
extend_cycle_1([_|Vertices], Graph, Cycle, ExtendedPath):-
  extend_cycle_1(Vertices, Graph, Cycle, ExtendedPath).

/* before_and_after(Cycle, V, Path1, Path2) is true if Path1 contains the    */
/*   elements preceding V in Cycle, and Path2 contains the remaining         */
/*   elements.                                                               */
before_and_after([V|Cycle], V, [], [V|Cycle]):-!.
before_and_after([P|Cycle], V, [P|Path1], Path2):-
  before_and_after(Cycle, V, Path1, Path2).

/* rotate_path(Ns, I, Graph, EPs, Path, HamCyc) is true if Ns are the        */
/*   neighbours of the endpoint of the Path, I is the number of vertices to  */
/*   be added to the Path, EPs are the previous endpoints generated by       */
/*   rotation for this path length, and HamCyc is a Hamiltonian cycle of the */
/*   Graph.                                                                  */
rotate_path([N|_], I, Graph, EPs, Path, HamCyc):-
  rotate(Path, N, [], Path1),
  Path1=[Vertex|_],
  \+ member(Vertex, EPs),
  member(g(Vertex,Neighbours), Graph),
  ham_cyc_1(I, Graph, Neighbours, [Vertex|EPs], Path1, HamCyc), !.
rotate_path([_|Ns], I, Graph, EPs, Path, HamCyc):-
  rotate_path(Ns, I, Graph, EPs, Path, HamCyc).

/* rotate(Ps, X, [], Qs) is true if Qs is the same as Ps except that the     */
/*   elements preceding X are reversed.                                      */
/* e.g. rotate([1,2,3,4,5,6,7], 5, [], [4,3,2,1,5,6,7]).                     */
rotate([X|Xs], X, Qs0, Qs):-!,
  append(Qs0, [X|Xs], Qs).
rotate([P|Ps], X, Qs0, Qs):-
  rotate(Ps, X, [P|Qs0], Qs).

/*
 * Library predicates
 */

/* append(Xs, Ys, Zs) is true if Zs is the result of appending the list Xs   */
/*   to the list Ys.                                                         */
%append([], Ys, Ys).
%append([X|Xs], Ys, [X|Zs]):-append(Xs, Ys, Zs).

/* last(Xs, X) is true if X is the last element of the list Xs.              */
last([X], X):-!.
last([_|Xs], X):-last(Xs, X).

/* length(Xs, L) is true if L is the number of elements in the list Xs.      */
%length(Xs, L):-length_1(Xs, 0, L).

/* length_1(Xs, L0, L) is true if L is equal to L0 plus the number of        */
/*   elements in the list Xs.                                                */
%length_1([], L, L).
%length_1([_|Xs], L0, L):-L1 is L0 + 1, length_1(Xs, L1, L).

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

/* nth(+Xs, ?N, ?X) is true if X is the N-th (base 1) element of the list Xs.*/
nth(Xs, N, X):-nth_1(Xs, X, 1, N).

nth_1([X|_], X, I, I):-!.
nth_1([_|Xs], X, I0, I):-
  I1 is I0 + 1,
  nth_1(Xs, X, I1, I).

/* rand_int(I, J, K) is true if K is a pseudo-random integer in the range    */
/*   I..J.                                                                   */
rand_int(I, J, K):-K is int(rand(J - I + 1)) + I.

/* 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).

/*
 * Test predicates
 */
  
/* Create a random graph with I vertices each with, on average, J            */
/*   neighbouring vertices, and find a Hamiltonian cycle if there is one.    */
/* e.g. go_ran(100, 10, X, Y).                                               */
go_ran(I, J, Graph, HamCyc):-
  rand_graph(I, J, Graph),
  ham_cyc(Graph, HamCyc).

/* rand_graph(I, J, Graph) is true if Graph is a random graph of I vertices, */
/*   each with an average of J neighbours.                                   */
rand_graph(I, J, Graph):-
  I > J,
  J > 0,
  initialize_graph(I, Graph0), % Create vertices with no neighbours
  N is I * J // 2,
  update_graph(N, I, Graph0, Graph). % Add N neighbours to the graph
  
initialize_graph(0, []):-!.
initialize_graph(I, [g(I,[])|Graph]):-
  I1 is I - 1,
  initialize_graph(I1, Graph).

update_graph(0, _, Graph, Graph):-!.
update_graph(N, I, Graph0, Graph):-
  rand_int(1, I, A),
  rand_int(1, I, B),
  A \= B, 
  remove(g(A, Vs), Graph0, Graph1),
  \+ member(B, Vs),
  remove(g(B, Ws), Graph1, Graph2), !,
  N1 is N - 1,
  update_graph(N1, I, [g(A,[B|Vs]),g(B,[A|Ws])|Graph2], Graph).
update_graph(N, I, Graph0, Graph):-
  update_graph(N, I, Graph0, Graph).

/* remove(X, Ys, Zs) is true if Zs is the result of removing one             */
/*   occurrence of the element X from the list Ys.                           */
%remove(X, [X|Ys], Ys).
%remove(X, [Y|Ys], [Y|Zs]):-remove(X, Ys, Zs).

LPA Index     Home Page

Valid HTML 4.01 Strict