Drawing a square root spiral Here is a start. I'm looking for a nice way to draw it.

Graphics[{EdgeForm[Black], White,
Polygon @ {{0, 0}, {-1, 0},
Sqrt {Cos[#], Sin[#]} &[Pi - (ArcCot)]},
Polygon @ {{0, 0}, Sqrt {Cos[#], Sin[#]} &[Pi - (ArcCot)],
Sqrt {Cos[#], Sin[#]} &[Pi - (ArcCot + ArcCot[Sqrt])]},
Polygon @ {{0, 0},
Sqrt {Cos[#], Sin[#]} &[Pi - (ArcCot + ArcCot[Sqrt])],
Sqrt {Cos[#], Sin[#]} &[
Pi - (ArcCot + ArcCot[Sqrt] + ArcCot[Sqrt])]}}]
• Something like this: ParametricPlot[Sqrt[t] {Cos[t], Sin[t]}, {t, 1, 10}]? – rm -rf Nov 30 '14 at 15:39
• related: 40283 – Kuba Nov 30 '14 at 15:51

With labels

k = 1; angles = NestList[# - ArcTan[1./Sqrt[k++]] &, Pi, 15];

pts = Table[Sqrt[n]*
{Cos[angles[[n]]], Sin[angles[[n]]]},
{n, 15}];

Graphics[{
Line[pts],
Line[{{0, 0}, #}] & /@ pts,
k = 2; Text["1", Sqrt[k++] {Cos[#], Sin[#]}] & /@
Mean /@ Most@Partition[angles, 2, 1],
k = 1; Text[ToString[Sqrt[ToString[k]], TraditionalForm],
.6 Sqrt[k++] {Cos[#], Sin[#]}] & /@
Mean /@ Partition[angles, 2, 1]}] • That is a beautiful result! +1 – Andy Ross Dec 1 '14 at 5:03
• This is actually the most correct and "right on the money" answer to the question, but the other answer adds its own qualities, and (deservedly) attracts more attention... – Adrian Dec 1 '14 at 6:26

One way to approach is to calculate the basic triangle (with sides of lengths Sqrt[n], Sqrt[n+1] and 1) and then rotate it the correct amount so that they all fit together.

sumAng[n_] := Sum[ArcTan[1/Sqrt[i]], {i, 1, n}];
poly[n_] := {{0, 0}, {Sqrt[n + 1], 0}, {Sqrt[n + 1], 1}};
Graphics[Table[Rotate[{Opacity, Hue[RandomReal[]], Polygon[poly[i]]},
sumAng[i], {0, 0}], {i, 0, 10}]] Lowering the opacity (to 0.5) and increasing the number of triangles (to 40) yields: and here are 100 terms plotted with a slightly more organized Hue function:

Graphics[Table[Rotate[{Opacity[0.5], Hue[i/40], Polygon[poly[i]]},
sumAng[i], {0, 0}], {i, 0, 100}]] And here's what happens when you get the angles wrong: (this version effectively uses sumAng[n_] := RandomReal[{0, 2 n}];) If you prefer more orderly disorganization,

sumAng[n_] := Sum[ArcTan[1/Sqrt[i] + i], {i, 1, n}]; • Work of art! Truly outstanding solution for color! As if it was from a book on usage of colors in data visualization by Tufte or similar... Also, is there any chance you post the code for the case "angles gone wrong"? – Adrian Dec 1 '14 at 6:20
• @Adrian -- I've updated with a couple of variations (and code). – bill s Dec 1 '14 at 14:01

I've decided to be a bit ornery and render the spiral of Theodorus in an anticlockwise fashion for this answer, for reasons I'll explain later.

The following is similar to what Michael did in his answer to a related question:

polys = NestList[With[{hyp = Delete[#[], 2]},
Polygon[Append[hyp, Last[hyp] - Normalize[Cross[Subtract @@ hyp]]]]] &,
Polygon[N[{{0, 0}, {1, 0}, {1, 1}}, 20]], 15];

Graphics[{Directive[EdgeForm[Black], FaceForm[None]], polys}] If labels are wanted,

Graphics[{Directive[EdgeForm[Black], FaceForm[None]], polys,
polys /. Polygon[pts_] :> Text["1", 1.1 Mean[Rest[pts]]],
Append[MapIndexed[Text[DisplayForm[SqrtBox[ToString[First[#2]]]],
Mean[First[#1]]] &, polys],
Text[DisplayForm[SqrtBox["17"]], Mean[Delete[polys[[-1, 1]], 2]],
{-3, -1}]]}] Extra credit

(You don't need to read the rest if you're not interested in special functions.)

Philip Davis, in his book, considered the problem of continuously interpolating the points of the spiral of Theodorus, when treated as points in the complex plane. (This is similar to the problem of continuously interpolating $n!$, for which the gamma function $\Gamma(z+1)$ is a particular solution.) With some help from Walter Gautschi, he was able to derive the required function $T(\alpha)$. Here is a Mathematica implementation:

TheodorusT[α_?NumericQ] := 1 /; α == 0;

TheodorusT[α_?NumericQ] := With[{β = FractionalPart[α]}, If[β == 0, 1, TheodorusT[β]]
Product[1 + I/Sqrt[β + j], {j, 1, IntegerPart[α]}]] /;
α >= 1 && Precision[α] < ∞

TheodorusT[α_?NumericQ] := With[{f = Sqrt[1 + α]}, f/(I + f) TheodorusT[1 + α]] /;
-1 <= α < 0 && Precision[α] < ∞;

TheodorusT[α_?NumericQ] := With[{f = Sqrt[-α - 1]}, (f + I)/(f - I) TheodorusT[-α - 2]] /;
α < -1 && Precision[α] < ∞;

TheodorusT[α_?NumericQ] :=
Sqrt[1 + α] Exp[I NIntegrate[DawsonF[Sqrt[t]]/(Exp[t] - 1) (1 - Exp[-α t])/t, {t, 0, ∞},
Method -> "DoubleExponential",
WorkingPrecision -> Precision[α]]/Sqrt[π]] /;
0 < α < 1 && Precision[α] < ∞

Here's a plot:

ParametricPlot[Through[{Re, Im}[TheodorusT[α]]], {α, -1, 19}, Axes -> None, Frame -> True] Display with the discrete version:

Show[%, Graphics[{Directive[EdgeForm[Black], FaceForm[None]], polys}]] Finally, here's the extended spiral:

ParametricPlot[Through[{Re, Im}[TheodorusT[α]]], {α, -18, 19}, Axes -> None, Frame -> True] Another natural solution is to use AnglePath.

pts = AnglePath[{-1, 0}, Prepend[-ArcTan[1./Sqrt[Range]], Pi/2.]];
Graphics[{Line[pts], Line[{{0, 0}, #}] & /@ pts}] Verify:

Sqrt[Rationalize[Plus @@@ (pts^2)]]

(* {1, Sqrt, Sqrt, 2, Sqrt, Sqrt, Sqrt, 2 Sqrt, 3,
Sqrt, Sqrt, 2 Sqrt, Sqrt, Sqrt, Sqrt} *)
Clear["`*"];
ang[n_] := Sum[ArcCot@Sqrt@i, {i, n}];
p[n_] := Sqrt[n + 1] {Cos@ang[n], Sin@ang[n]}
poly[n_] := {{0, 0}, p[n], p[n + 1]};
Graphics[Table[{Hue[i/16], EdgeForm@Hue[i/16], Polygon@poly[i]}, {i, 0, 15}]] point = AnglePath[{1, 0},
Prepend[ArcTan /@ (1/Sqrt[Range[1, 16]]), 90 \[Degree]]];
Graphics[{Line@point[[;; -2]], Line[{{0, 0}, #} & /@ point[[;; -2]]],
Table[Text[Sqrt[ToString@i],
5/7 point[[i]] + 0.15 (point[[i + 1]] - point[[i]])], {i, 17}]},
PlotRange -> {-4.2, 2}] 