On a strange pattern of triangular numbers in Ulam's spiral
Not very efficient, but you may find it useful for some experiments. I perused the code from the link you provided (kuba's), although there are better alternatives in the answers.
ClearAll[spiral, genTri, mp];
spiral[n_?OddQ] := Nest[
With[{d = Length@#, l = #[[-1, -1]]},
Composition[
Insert[#, l + 3 d + 2 + Range[d + 2], -1] &,
Insert[#\[Transpose], l + 2 d + 1 + Range[d + 1], 1]\[Transpose] &,
Insert[#, l + d + Range[d + 1, 1, -1], 1] &,
Insert[#\[Transpose], l + Range[d, 1, -1], -1]\[Transpose] &
][#]] &,
{{1}},
(n - 1)/2];
genTri[n_] := genTri[n] = IntegerQ[(-1 + Sqrt[1 + 8 #])/2] & /@ Range@n
mp[n_] := mp[n] = Image[Unitize[spiral[n] /.
Thread[Flatten@Position[genTri[n^2], True] -> 0]]]
(* up to 36 10^4 *)
Erosion[mp[601], 1]
There they are, your 17 arms
(* up to 10^6 *)
Erosion[mp[1001], 1]
For the "stability" of the number of arms a reasonable condition (rule of dumb thumb) is that the density of triangular numbers remain almost constant in each "layer" of the spiral, so you are not "creating" or destroying arms. And that is what effectively seems to happen:
r[n_] := Range[(2 n + 1)^2 + 1, (2 n + 3)^2]
f[n_] := Count[IntegerQ[(-1 + Sqrt[1 + 8 #])/2] & /@ r[n], True]
ListLinePlot[f /@ Range[200]]
I have no explanation on why the number of arms is 17, though.
Here's another perspective for you.
cf[x_] :=
ColorData[{"DeepSeaColors", {2, 0}}][Mod[Sqrt[8 x + 1] + 1, 2]];
Graphics[{PointSize[Small], cf[#], Point[ulamCoords[#]]} & /@
Range[1024], Background -> Black]
This color function allows us to (visually) trace "triangularity level curves" of a sort, where the brightest points are triangular numbers and other points are colored according to their near-triangularity.
Seen this way, we might insist that a three-armed interpretation is more "natural" and that the seventeen arms are just a convenient artifact. On the other hand -- as you might guess from my username and profile picture -- I am a staunch supporter of the number seventeen in all its appearances and it would be a real shame to deprive it any due glory.
Edit: another picture
Show[
Graphics[{PointSize[Small], cf[#], Point[ulamCoords[#]]} & /@ Range[10^4]],
Graphics[{PointSize[Medium], Red, Point[ulamCoords[#]]} & /@ Table[k (k + 1)/2, {k, 1, 140}]],
Background -> Black]
This one goes up to 10^4, with triangulars overlaid in red.
Edit 2: Full disclosure Here's the implementation I wrote up for number -> Ulam coordinates:
ulamCoords[x_] :=
With[{s = Ceiling[Sqrt[x]]},
Piecewise[
{
{{-(1/2) (s - 1), s^2 - 1/2 (s - 1) - x},
Mod[s, 2] == 1 && s^2 - s + 1 <= x <= s^2},
{{s^2 - 3/2 (s - 1) - x, 1/2 (s - 1)},
Mod[s, 2] == 1 && s^2 - 2 (s + 1) <= x <= s^2 - s + 1},
{{s/2, -(s^2 - 1/2 (s - 2) - x)},
Mod[s, 2] == 0 && 1 - s + s^2 <= x <= s^2},
{{-(s^2 - 3/2 s + 1 - x), -(s/2)},
Mod[s, 2] == 0 && s^2 - 2 (s + 1) <= x <= s^2 - s + 1}
}
]
]
I've added the precise code needed to generate each picture above.