Code

SetDirectory["/Users/cook/Common/Coding/Puzzles/RotorRouter"]

/Users/cook/Common/Coding/Puzzles/RotorRouter

RotorRouter[n_] := (Run["./rotorpic "<>ToString[n] <>" > fromRP.m"] ; thepic = Get["fromRP.m"] ; Dimensions[thepic])

RotorRouter[{x_, y_}, marblelist_] := ({x, y} >>"fromMMA.m" ; (#>>>&q ... ic -file fromMMA.m > fromRP.m"] ; thepic = Get["fromRP.m"] ; Dimensions[thepic])

Thicken[w_][g_] := g/.Line[{a_, b_}] Block[{p = (a - b) . {{0, 1}, {-1, 0}}, q}, q = p/(p . p)^(1/2)/2 ; Polygon[{a + w q, b + w q, b - w q, a - w q}]]

Perimeter[m_] := Join[Line[{#, # - {1, 0}}] &/@Reverse/@Position[Partition[m, {2, 1}, {1,  ... &/@Reverse/@Position[Partition[m, {1, 2}, {1, 1}], {{a_, b_}}/;a b0∧a + b>0]]

RowBox[{ShowPic[extra_, scale_:1], :=, RowBox[{Show, [, RowBox[{Graphics[Raster[thepic, ColorF ... ize, , RowBox[{1, +, RowBox[{1.05,  , scale,  , Reverse[Dimensions[thepic]]}]}]}]}], ]}]}]

RotMat[θ_] := {{Cos[θ], Sin[θ]}, {-Sin[θ], Cos[θ]}}

The First Few Steps

Do[RotorRouter[{10, 10}, {{{5, 5}, i}}] ; ShowPic[{}, 20], {i, 17}]

[Graphics:HTMLFiles/index_27.gif]

This is your chance to learn what the colors mean and verify your understanding of the process.  Double click on the picture to animate it (be careful not to drag the first frame out of alignment as you do so).  During animation, the keys 1-9 control the speed of the animation, and you can use the up/down arrow keys to step through it.  Among the brackets to the right of the graphic, the "down harpoon" one is the indicator that the graphic can be animated -- any graphic with a down harpoon can be animated by double clicking the graphic.

The Next 2  10^5 Steps

RowBox[{Do, [, RowBox[{RowBox[{RotorRouter[{510, 510}, {{{255, 255}, 100i (i + 1)/2}}], ;, Row ... {ImageSize, , RowBox[{1, +, RowBox[{510, *, 1.05, {1, 1}}]}]}]}], ]}]}], ,, {i, 63}}], ]}]

[Graphics:HTMLFiles/index_93.gif]

What is a Circle?

Block[{r = 10, cc, bc, rot, perim, plist}, cc = r + {.5, .5} ; bc = {r + 1, r} ; plist = {{cc, ...  bc) . RotMat[θ] + bc&, perim, {3}]//Thicken[.3]}, 10], {θ, 0, 2π, π/30}]]

[Graphics:HTMLFiles/index_155.gif]

The white dot marks the cell where the marbles are dropped, and the block dot marks the center of rotation of the boundary.  The black dot is at the lower right corner of the cell with the white dot.  "Down" and "to the right" are the first two directions used by every router.  In general, the accuracy of the circle is such that you can determine its center to within a quarter cell just by visual inspection of the rotating boundary.  The center is empirically always half a cell to the lower right from the center of the initial conditions (we always use "down" and "to the right" as the first two directions for every rotor).

Block[{r = 60, cc, bc, rot, perim, plist}, cc = r + {.5, .5} ; bc = {r + 1, r} ; plist = {{cc, ... - bc) . RotMat[θ] + bc&, perim, {3}]//Thicken[.3]}, 3], {θ, 0, 2π, π/30}]]

[Graphics:HTMLFiles/index_218.gif]


Created by Mathematica  (September 20, 2004)