This post was inspired by the following discussion thread  https://mapleprimes.com/questions/242266-Count-The-Number-Of-Paths , which considered the problem of finding all Hamiltonian paths on an integer lattice in R^2 that connect two distinct vertices. The  AllPaths  procedure solves a more general problem: it finds all self-disjoint paths connecting two distinct vertices not only in the plane  R^2  but also in space  R^3 . Of course, it also finds all Hamiltonian paths or allows one to determine their absence. The procedure does not use commands from GraphTheory package (only direct manipulation of sets and lists).
Required parameters of the procedure: is a set or list of lattice vertices specified by their coordinates, Start and Finish are the initial and final vertices. Optional parameter R (defaults it's NULL  if all paths are searched) and any symbol (if only Hamiltonian paths are searched). S can be either a rectangular integer lattice or a union of several such lattices.

Code of the procedure:

restart;
AllPaths:=proc(S::{set(list),listlist},Start::list,Finish::list,R::symbol:=NULL)
local N:=nops(S), S1:=convert(S, set), L, n, m, k, i, j, s, p, q, P, a, b, c;

L:={[Start]};
for n from 2 to N do

if R=NULL then

P:='P';
m:=nops(L);
for k from 1 to m do
if nops(Start)=2 then
i,j:=L[k][-1][];
s:={[i-1,j],[i,j+1],[i+1,j],[i,j-1]} else
a,b,c:=L[k][-1][];
s:={[a-1,b,c],[a,b+1,c],[a+1,b,c],[a,b-1,c],[a,b,c-1],[a,b,c+1]} fi; 
s:=`intersect`(s,S1) minus convert(L[k],set);
if s={} and L[k][-1]=Finish then P[k]:=L[k] else
if s={} and L[k][-1]<>Finish then P[k]:=NULL else
P[k]:=`if`(L[k][-1]=Finish,L[k],seq([L[k][],s[i]],i=1..nops(s)))  fi; fi;
od;
L:=convert(P,set) else

P:='P';
m:=nops(L);
for k from 1 to m do
if nops(Start)=2 then
i,j:=L[k][-1][];
s:={[i-1,j],[i,j+1],[i+1,j],[i,j-1]} else
a,b,c:=L[k][-1][];
s:={[a-1,b,c],[a,b+1,c],[a+1,b,c],[a,b-1,c],[a,b,c-1],[a,b,c+1]} fi;
s:=`intersect`(s,S1) minus convert(L[k],set);
if n<N then 
if s={} or L[k][-1]=Finish then P[k]:=NULL else
P[k]:=seq([L[k][],s[i]],i=1..nops(s)) fi else
P[k]:=seq([L[k][],s[i]],i=1..nops(s)); fi;
od;
L:=convert(P,set)

fi; od;

L;
end proc:


Examples of use.

In the first example from the post above, we find the number of Hamiltonian paths in 

L:=CodeTools:-Usage(AllPaths({seq(seq([i,j], i=1..11), j=1..3)}, [2,2], [10,2], 'H')):
nops(L);

   

In this same example, we find the number of all paths from A to B and the possible lengths of these paths.

L:=CodeTools:-Usage(AllPaths({seq(seq([i,j], i=1..11), j=1..3)}, [2,2], [10,2])):
nops(L);
map(t->nops(t), L);
L1:=select(t->nops(t)=%[-1], L):
nops(L1);

  

In the following example, we find the number of all paths, as well as the number of Hamiltonian paths, and animate these paths (total 24 one's).

S:={seq(seq([i,j],i=1..5),j=1..3)} union {seq(seq([i,j],i=4..7),j=3..5)}: A:=[1,1]: B:=[7,5]:
P:=plots:-display(plots:-pointplot(S, symbol=solidcircle, color=blue, symbolsize=15, view=[0..7.5,0..6.5], size=[600,500], scaling=constrained), plots:-textplot([[A[],"A"],[B[],"B"]], font=[times,bold,22], align=[left,above])):
L:=AllPaths(S,A,B):
nops(L);
map(t->nops(t), L);
L1:=select(t->nops(t)=%[-1], L):
nops(L1);
plots:-animate((plots:-display)@(plottools:-curve),[L1[round(a)], color=red, thickness=4], a=1..%, frames=180, background=P, size=[700,500], paraminfo=false);

                                      

                   

In the final example, we search for Hamiltonian paths in a lattice defined on the surface of a cube. Imagine a cube made of wires, and an ant must crawl along these wires from point  A(0,0,0)  to point B(2,2,2) , visiting all nodes of this lattice. Is this possible? We see that it is not. The length of the maximum path is 25, and this lattice has 26 vertices. An animation of one of the maximum paths is provided.

                           

S:={seq(seq(seq([i,j,k],i=0..2),j=0..2),k=0..2)} minus {[1,1,1]}: A:=[0,0,0]: B:=[2,2,2]:
P:=plots:-display(plots:-pointplot3d(S, symbol=solidcircle, color=blue, symbolsize=20, scaling=constrained), plots:-textplot3d([[A[],"A"],[B[],"B"]], font=[times,bold,22], align=[left,above]), plottools:-curve([[2,0,1],[2,2,1],[0,2,1],[0,0,1],[2,0,1]], color=black,thickness=0),plottools:-curve([[1,0,2],[1,0,0],[1,2,0],[1,2,2],[1,0,2]], color=black, thickness=0),plottools:-curve([[2,1,0],[0,1,0],[0,1,2],[2,1,2],[2,1,0]], color=black,thickness=0), tickmarks=[3,3,3]):
L:=AllPaths(S,A,B):
nops(L);
map(t->nops(t), L);
L1:=select(t->nops(t)=%[-1], L):
nops(L1);
plots:-animate((plots:-display)@(plottools:-curve),[L1[-1][1..round(a)], color=red, thickness=4], a=1..25, frames=240, background=P, paraminfo=false, axes=box, labels=[x,y,z]);

       

                              

We can see from this animation that the path does not pass through the vertex (0, 2, 2) .

Paths.mw


Please Wait...