- Congratulations! This post is now Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!

wow! very nice! How did you find these grids? randomly?

Simultaneous updating seems a bit neater than alternating... I'll play around a bit more later. Great job.

O btw, rather than Cos[...], Sin[...] to get polar points I would recommend using either CirclePoints or AngleVector or even FromPolarCoordinates.

The superlong cycle wasn't minimal, so there was an unintended solution, as found by Reddit user mkglass. FindShortestPath works better for these.

Here's a greatly improved puzzle.

The vector file:

bg = {{{1, 0}, {-1, 0}, {0, -1}, {0, -1}, {-1, 0}}, {{-1, 0}, {0, -1}, {-1, 0}, {-1, -1}, {1, 0}}, {{-1, 0}, {0, 1}, {-1, 0}, {1, 1}, {-1, 1}}, {{0, -1}, {0, 1}, {0, 1}, {-1, 0}, {0, -1}}, {{0, 1}, {-1, 0}, {0, -1}, {0, -1}, {-1, 0}}};

Code for the 94-move solution.

positions = Tuples[Range[5], {4}];
grids = {bg, bg};
connects = Join[Flatten[Table[Select[# \[DirectedEdge] # + Join[{0, 0}, grids[[1, j, k]]] & /@ Select[positions, Take[#, 2] == {j, k} &], Max[#[[2]]] <= 5 && Min[#[[2]]] >= 1 &],{j, 1, 5}, {k, 1, 5}], 3],
   Flatten[Table[Select[# \[DirectedEdge] # + Join[grids[[2, j, k]], {0, 0}] & /@ Select[positions, Drop[#, 2] == {j, k} &], Max[#[[2]]] <= 5 && Min[#[[2]]] >= 1 &],{j, 1, 5}, {k, 1, 5}], 3]];
pat = FindShortestPath[Graph[connects], {2, 3, 3, 3}, {3, 3, 3, 3}] 

The solution looks like the following: