Looking at the harmonic series

Ivan Cnop
Vrije universiteit Brussel
icnop@vub.ac.be

Stacking cards

Drawing a stack of rectangles

Clear[a, s, h]

\(Show[{	Graphics[{GrayLevel[0.9], Rectangle[{\(-1\), 0}, {1, 0.5}]}], 

        		Graphics[{GrayLevel[0.1], Rectangle[{\(-2\), \(-2\)}, {0, 0}]}]}]
      \)

coordleft = 
      Table[{-1 + Sum[1/j, {j, n}], 50 - 0.5 n}, {n, 100}];

coordright = 
      Table[{Sum[1/j, {j, n}], 50 - 0.5 (n + 1)}, {n, 100}];

rechthoeken = 
      Table[Rectangle[coordleft[[k]], coordright[[k]]], {k, 
          Length[coordleft]}];

Show[Graphics[rechthoeken]]

Computing the overhang

Clear[a, s]

If     (n-1)     cards are placed on the edge of the    n-th   so that they just don't fall , the   n-th   card has to be moved back towards the table over a distance  x  to keep the stack in balance:

a[n_] := a[n] = 
        First[Solve[(n - 1) x + (x/2) == ((2 - x)/2), x]]

x /. a[n]

x /. a[20]

Summing a finite number of terms in the harmonic series

s[0] = 0;
s[n_Integer] := s[
          n] = (∑_(j = 1)^n)(x /. a[j])

s[0]

s[3]

Clear[h]

h[n_] := Table[{N[s[j]], n - j}, {j, 0, n}]

ListPlot[h[100]]

Clear[points]

points[n_] := 
      Transpose[{Table[{N[s[j]], n - j}, {j, 0, n}], 
          Table[{N[s[j]] + 2, n - j}, {j, 0, n}]}]

TableForm[points[4]]

Clear[cards]

cards[n_] := Map[Line, points[n], {1}]

TableForm[cards[4]]

Compare with the logarithm

Plots

stack = cards[800];
drawing = Graphics[stack]

Show[drawing]

ListPlot[Table[{Log[n] + 1, 800 - n}, {n, 1000}], 
      PlotRange -> {{0, 8}, {0, 800}}, Ticks -> None]

Show[GraphicsArray[{drawing, %}]]

Computing differences

ListPlot[Table[HarmonicNumber[n] - Log[n], {n, 1000}]]

If more time is available, we can look how slowly this value goes to a classic limit

N[EulerGamma, 20]

ListPlot[
      Table[{n, N[HarmonicNumber[n] - Log[n]]}, {n, 100, 20000, 100}],  
      PlotRange -> { .5772,  .5773}]

ListPlot[
      Table[{n, N[HarmonicNumber[n] - Log[n]]}, {n, 1000, 200000, 1000}],  
      PlotRange -> { .5772,  .5773}]