If you start at the center and move the coins in an alternating way you get:

ClearAll[MoveMe, MoveMeFromStart]
VisualizeBG[bg_List] := Graphics[MapIndexed[Arrow[{#2 - #1, #2 + #1}] &, 0.25 bg, {2}]]
MoveMe[p1 : {x1_, y1_}, p2 : {x2_, y2_}, bg_] := Module[{newp2, mov}, (* note that the first (p1) determines position, and moves p2, outputs {p2,p1} note: REVERSED! *)
  mov = Extract[bg, p1];
  newp2 = p2 + mov;
  newp2 = MapThread[Mod[#1, #2, 1] &, {newp2, Dimensions[bg, 2]}]; (* periodic boundaries *)
  {newp2, p1}
  ]
MoveMeFromStart[bg_] := Module[{center, pos},
  center = Floor[(Dimensions[bg, 2] + 1)/2]; (* position of center *)
  pos = NestWhileList[
  MoveMe[Sequence @@ #, bg] &, {center, center}, # =!= {center, center} &, {2, 1}]; (* start from center, wait until at center again *)
  pos[[;; ;; 2]] = RotateLeft /@ pos[[;; ;; 2]]; (* flip the reverse ones\[Ellipsis] *)
  Transpose[pos]
]
MoveMeFromStartLen[bg_] := Length[First[MoveMeFromStart[bg]]] - 1

bg = {{{1, 0}, {-1, -1}, {1, 0}, {-1, 0}, {0, 1}}, {{0, 1}, {-1, 
     0}, {-1, 1}, {1, 0}, {1, -1}}, {{-1, -1}, {1, 0}, {0, 
     1}, {-1, -1}, {1, -1}}, {{0, -1}, {0, 1}, {1, 1}, {1, 
     0}, {1, -1}}, {{0, -1}, {-1, 0}, {1, -1}, {0, -1}, {-1, 1}}};
VisualizeBG[bg]
MoveMeFromStartLen[bg]

it takes 202 steps to return back to the center.

We can also find a random grid of arrow and find the length now quite easily, we do so until we find a grid with the longest route to return to the center:

Dynamic[i]
Dynamic[best[[2]]]
best={{},-1};
dimensions={5,5};
directions=Select[Tuples[Range[-1,1],2],Norm[#]>0&];
Do[
    newbg=RandomChoice[directions,dimensions];
    len=MoveMeFromStartLen[newbg];
    If[len>best[[2]],best={newbg,len}];
    If[len==(Times@@dimensions)^2,Break[]]
,
    {i,30000}
]

Now plot the best solution (625 steps):

VisualizeBG[best[[1]]]

For a 3x3 grid we can also see what the loop-length are by calculating many grids and plotting a histogram of the lengths:

Dynamic[i]
dimensions={3,3};
directions=Select[Tuples[Range[-1,1],2],Norm[#]>0&];
lens=Table[
    newbg=RandomChoice[directions,dimensions];
    MoveMeFromStartLen[newbg]
,
    {i,200000}
];
Histogram[lens, {1}, AspectRatio -> 1/5, ImageSize -> 1000]

81 (the maximum) happens relatively a lot.

We can do the same for 5x5 grids:

showing a rather flat distribution! This code also supports rectangular grids. So feel free to play around with it.

One could also do the same in 3D (or even nD), and in 2D with hexagonal tiles, or with more coins...

Hi Ed,

Wow I'm surprised about your find of such long cycles. I'm also slightly confused about the rules, so I just made up my own similar game.

I'm using a simplified alphabet of move right and move down, so that all boards can be encoded binary. Furthermore, I am using simultaneous update, rather than turn-sequential. Also, I'm assuming the gameboard has the topology of a torus.

The code is not that different from the symplectic integrator I have mentioned in other threads:

UpdateState[GameBoard_, state_, n_] := Mod[Plus[state, {
GameBoard[[ Sequence @@ state[[2]] ]], 
GameBoard[[ Sequence @@ state[[1]] ]]
} /. {0 -> {1, 0}, 1 -> {0, 1}}], n] /. {0 -> n}

AllGameBoards[n_] := Partition[#, n] & /@ Tuples[{0, 1}, n^2]

AllStates[n_] := Flatten[Outer[{{#1, #2}, {#3, #4}} &, Range[n], Range[n], Range[n], Range[n]], 3]

GameGraph[board_] := With[{n = Length[board]},
MapThread[DirectedEdge, {Range[(n^2)^2],
Position[AllStates[n], UpdateState[board, #, n]][[1, 1]] & /@ 
AllStates[n]}]]

and a few extra functions to filter gameboards:

Reflections[GameBoard_, null_] := {GameBoard, Reverse /@ GameBoard}

Rotations[GameBoard_, null_] := 
NestList[Reverse[Transpose[#]] &, GameBoard, 3]

TorusX[GameBoard_, n_] := 
Function[{a}, RotateRight[#, a] & /@ GameBoard] /@ Range[n]

TorusY[GameBoard_, n_] := 
Function[{a}, 
Transpose[RotateRight[#, a] & /@ Transpose[GameBoard]]] /@ Range[n]

Inversions[GameBoard_, n_] := {Mod[GameBoard + 1, 2], GameBoard}

AllTransforms[GameBoard_, n_] := 
Fold[Union@
Flatten[Function[{a}, #2[a, n]] /@ #1, 
1] &, {GameBoard}, {Reflections, Rotations, TorusX, TorusY, Inversions}   ]

SymFilter[AllBoards_, n_] :=
DeleteDuplicates[AllBoards,
SameQ[AllTransforms[#1, n], AllTransforms[#2, n]] &]

Then we can look through all games for cycles

SomeGameBoards[n_] := SymFilter[AllGameBoards[n], n]
AbsoluteTiming[
GB2 = SomeGameBoards[2];
]

AbsoluteTiming[
GB3 = SomeGameBoards[3];
]
Grid[Transpose[{Graph[GameGraph[#], ImageSize -> 100], 
ArrayPlot[#, ImageSize -> 75]} & /@ GB2]]

Column[{Grid[
Transpose[{Graph[GameGraph[#], ImageSize -> 100], 
ArrayPlot[#, ImageSize -> 75]} & /@ GB3[[1 ;; 7]]]],
Grid[Transpose[{Graph[GameGraph[#], ImageSize -> 100], 
ArrayPlot[#, ImageSize -> 75]} & /@ GB3[[8 ;; 13]]]]}]

We can also plot random games:

Column[{Graph[GameGraph[#], ImageSize -> 800], ArrayPlot[#]}, 
Center] &@Partition[RandomInteger[{0, 1}, 5^2], 5] 

Or count the cycles:

CycleLengths[Game_] := 
 Length /@ (FindCycle[Graph[GameGraph[Game]], Infinity, All])

(1/2) CycleLengths /@ GB2
(1/3) CycleLengths /@ GB3

And finally we can do some inductive reasoning. It appears that all cycles on NxN board are multiples of N, and that all graphs have some relatively small cycles. Though I can't say what will happen on a large board, random searching didn't return anything too interesting.

A negative result for my constraint system, but also an interesting start to exploring some fundamental questions for this type of dynamical system: how is output affected by:

• turn / sequential updating VS. simultaneous updating ?
• Alphabet: (up,right) VS. (N,S,E,W) VS. (N,NE,E,SE,S,SW,W,NW) ?