Mathematica 615530字节
这将构造一个数字网格,将其转换为图形,然后在输入的两个数字之间找到最短路径。
松散
numberSpiral
来自Mathworld Prime Spiral。它创建一个n n n Ulam Spiral(不突出质数)。
findPath
将数字网格转换为图形。边缘是数字网格上的有效皇后移动。
numberSpiral[n_Integer?OddQ]:=
Module[{a,i=(n+1)/2,j=(n+1)/2,cnt=1,dir=0,len,parity,vec={{1,0},{0,-1},{-1,0},{0,1}}},a=Table[j+n(i-1),{i,n},{j,n}];Do[Do[Do[a[[j,i]]=cnt++;{i,j}+=vec[[dir+1]],{k,len}];dir=Mod[dir+1,4],{parity,0,1}],{len,n-1}];a];
findPath[v1_, v2_] :=
Module[{f, z, k},
(*f creates edges between each number and its neighboring squares *)
f[sp_,n_]:=n<->#&/@(sp[[Sequence@@#]]&/@(Position[sp,n][[1]]/.{r_,c_}:>Cases[{{r-1,c},{r+1,c},{r,c-1},{r,c+1},{r-1,c-1},{r-1,c+1},{r+1,c+1}, {r+1,c-1}},{x_,y_}/; 0<x<k&&0<y<k]));k=If[EvenQ[
z=\[LeftCeiling]Sqrt[Sort[{v1, v2}][[-1]]]\[RightCeiling]],z+1,z];
FindShortestPath[Graph[Sort/@Flatten[f[ns=numberSpiral[k],#]&/@Range[k^2]] //Union],v1,v2]]
例子
findPath[4,5]
findPath[13,22]
findPath[16,25]
numberSpiral[5]//Grid
{4,5}
{13,3,1,7,22}
{16,4,1,9,25}
从80到1的最短路径包含5个顶点,而不是6个顶点。
findPath[80,1]
numberSpiral[9]//Grid
{80,48,24,8,1}
打高尔夫球
u=Module;
w@n_:=u[{a,i=(n+1)/2,j=(n+1)/2,c=1,d=0,l,p,v={{1,0},{0,-1},{-1,0},{0,1}}},
a=Table[j+n(i-1),{i,n},{j,n}];
Do[Do[Do[a[[j,i]]=c++;{i,j}+=v[[d+1]],{k,l}];d=Mod[d+1,4],{p,0,1}],{l,n-1}];a];
h[v1_,v2_]:=u[{f,z},
s_~f~n_:=n<->#&/@(s[[Sequence@@#]]&/@(Position[s,n][[1]]/.{r_,c_}:>
Cases[{{r-1,c},{r+1,c},{r,c-1},{r,c+1},{r-1,c-1},{r-1,c+1},{r+1,c+1},{r+1,c-1}},{x_,y_}/;0<x<k&&0<y<k]));
k=If[EvenQ[z=\[LeftCeiling]Sqrt[Sort[{v1,v2}][[-1]]]\[RightCeiling]],z+1,z];
FindShortestPath[g=Graph[Sort/@Flatten[f[ns=w@k,#]&/@Union@Range[k^2]]],v1,v2]]