The project is originally based on a puzzle proposed by EIORU at http://www.ptt.cc/bbs/puzzle/M.1342451949.A.00F.html (若您懂得讀中文 / if anyone happen to read Chinese^^) last July.
The descriptions, simply put, are as follows:
- Initially on a x-y plane at the origin there's a vertical stem, length = 1.
- The stem grow two twigs. One to the east and the other to the west. the twigs are of 45° polar angle, length = $\sqrt{2}$. Now the tree looks like an "Y".
- All twigs then grow vertical stems on their tip, length = 1.
/ The stems on eastward twigs lead to a east/west forking of twigs.
/ The stems on westward twigs lead to a north/south forking of twigs.
The growing iteration continues such that:
/ The stem on a northward twig grow like a westward twig.
/ The stem on a southward twig grow like a eastward twig.
/ Whenever two twigs converge at some location, a fruit is formed and no further growing takes place.
Q1: How many iterations does it take that >100 fruits are on the tree?
Q2: What's the total length of stems and twigs at Q1's iteration?
This "EIORU tree", is equivalent to a square 2-D automata, and the rules are easily translated to automata rules (for conciseness I'll skip listing them :P)
I wrote some Mathematica code to visualize such structure. The code works out, however is rather inefficient. If you find it interesting please advise me ways to efficientize it, thanks!
Clear[tree]; tree[vertical][0] = {{0, 0} -> "W"}; tree[vertical][n_] /; n>0 :=
tree[vertical][n] = (tree[diagonal][n] = Sort[tree[vertical][n - 1] /. rule1])
//. {p___, q_Rule, r___, s_Rule, t___} /; q[[1]] == s[[1]] :> {p, q[[1]] -> "Q", t}
(*iterate level by level. my method of removing Q=fruit from the next level is clumsy*)
rule1 = {
(*W*)({x_, y_} -> "W"):> Sequence[{x, y + 1} -> "W", {x, y - 1} -> "S"],
(*A*)({x_, y_} -> "A"):> Sequence[{x, y + 1} -> "W", {x, y - 1} -> "S"],
(*S*)({x_, y_} -> "S"):> Sequence[{x - 1, y} -> "A", {x + 1, y} -> "D"],
(*D*)({x_, y_} -> "D"):> Sequence[{x - 1, y} -> "A", {x + 1, y} -> "D"],
(*Q*)({_, _} -> "Q") -> Sequence[]};
(*I used rules to implement bifurcation*)
(*I used WASD in place of NWSE to make typing code easier. The resulting structure
may only differ in their chirality, but in spirit the same.*)
(*converting level i of tree - tree[i] into graphics*)
Clear[convert];
convert[i_]:= Join[{Hue[Mod[i, 10]/10]},
tree[diagonal][i] /. x:{_Integer, _} :> Append[x, 2 i - 1] /. rule2,
tree[vertical][i] /. x:{_Integer, _} :> Append[x, 2 i - 1] /. rule3]
(*rule2 is about diagonal lines representing twigs*)
rule2 = {
(*W*)({x_, y_, z_} -> "W") :> Line[{{x, y, z}, {x, y - 1, z - 1}}],
(*A*)({x_, y_, z_} -> "A") :> Line[{{x, y, z}, {x + 1, y, z - 1}}],
(*S*)({x_, y_, z_} -> "S") :> Line[{{x, y, z}, {x, y + 1, z - 1}}],
(*D*)({x_, y_, z_} -> "D") :> Line[{{x, y, z}, {x - 1, y, z - 1}}]};
(*rule3 is about stems and fruit*)
rule3 = {
(*Q*)({x_, y_, z_} -> "Q") :> {color = Black, PointSize[0.03], Point[{x, y, z}]},
(*stems*)({x_, y_, z_} -> Except["Q"]) :> Line[{{x, y, z}, {x, y, z + 1}}]};
It take about 5+ minutes to iterate up to 50 times. (pattern matching being potentially exponential time?!)
tree[vertical][50(**)]
Each level graphed separately
Table[Graphics3D[convert[i], ViewPoint -> Top, BoxStyle -> Dashed], {i, 1, 50(**)}]
Altogether a rather intricate structure
Graphics3D[Flatten@Table[convert[i], {i, 1, 50(**)}] /.
PointSize[_] -> PointSize[0], ViewPoint -> Top, BoxStyle -> Dashed]
Easy to enumerate fruits (or twigs, omitted here)
Accumulate@Table[Count[tree[vertical][i], "Q", Infinity], {i, 1, 50}]
r___in your fruit checking rule should do the trick. Once sorted, the same coordinates should be adjacent in the list. No need to check every possible pair. – wxffles Jan 28 at 22:16