Drawing a square root spiral

Question

Here is a start. I'm looking for a nice way to draw it.

Graphics[{EdgeForm[Black], White, 
  Polygon @ {{0, 0}, {-1, 0}, 
    Sqrt[2] {Cos[#], Sin[#]} &[Pi - (ArcCot[1])]}, 
  Polygon @ {{0, 0}, Sqrt[2] {Cos[#], Sin[#]} &[Pi - (ArcCot[1])], 
    Sqrt[3] {Cos[#], Sin[#]} &[Pi - (ArcCot[1] + ArcCot[Sqrt[2]])]}, 
  Polygon @ {{0, 0}, 
    Sqrt[3] {Cos[#], Sin[#]} &[Pi - (ArcCot[1] + ArcCot[Sqrt[2]])], 
    Sqrt[4] {Cos[#], Sin[#]} &[
     Pi - (ArcCot[1] + ArcCot[Sqrt[2]] + ArcCot[Sqrt[3]])]}}]

Answer 1

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]}]

Answer 2

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[1], 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}];

Answer 3

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[#[[1]], 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]

Answer 4

Another natural solution is to use AnglePath.

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

Verify:

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

(* {1, Sqrt[2], Sqrt[3], 2, Sqrt[5], Sqrt[6], Sqrt[7], 2 Sqrt[2], 3, 
    Sqrt[10], Sqrt[11], 2 Sqrt[3], Sqrt[13], Sqrt[14], Sqrt[15]} *)

Answer 5

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}]]

Answer 6

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}]