Book Stacking Problem

Author

Eric W. Weisstein
June 12, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/BookStackingProblem.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/BookStackingProblem.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Original book stacking graphics by
Robert Dickau

Code

Overhang[n_]:=Ceiling[FindRoot[HarmonicNumber[k]/2==n,{k,10}][[1,2]]]

Overhang

(1/2)Sum[(1/k),{k,n}]

HarmonicNumber/@Range[10]/2

<<Utilities`Plot`

IntegerListPlot[HarmonicNumber/@Range[25]/2,AxesLabel->TraditionalForm/@{n,(Subscript[d, n])}]

Books Needed to Get an Overhang of n Books

Overhang/@Range[10]

Cards

With[{d=.025,n=52},
Show[Graphics[MapIndexed[Line[-{{#1-1,d#2[[1]]},{#1,d#2[[1]]}}]&,HarmonicNumber[Range[n]]]],
AspectRatio->Automatic
]
]

((HarmonicNumber[51])/2)

N[((HarmonicNumber[51])/2),20]

Books

This could be cleaed up a bit...

(*****************************)
(*This portion by R.Dickau*)
(*****************************)

H[n_]:=HarmonicNumber[n]

(*each book has length 2 here,which I correct for in the label of the graph--so sue me*)
book[{x_,y_}]:=Line[{{x-1,y},{x-1,y+1/10},{x+1,y+1/10},{x+1,y},{x-1,y}}]

(*roughly speaking, I stack the books from the top down,and treat the table as book n+1, after Graham-Knuth-Patashnik...*)

BookStackPlot[n_Integer?Positive,opts___Rule]:=Show[Graphics[{{GrayLevel[0.75],Rectangle[{-H[n]-3/2,0},{1-H[n],-1/3}]},{Table[book[{-H[k-1],(n-k)/10}],{k,n}]},{Arrow[{1-H[n]/3,-1/6},{1,-1/6}],Arrow[{1-2H[n]/3,-1/6},{1-H[n],-1/6}]},Text[H[n]/2,{1-H[n]/2,-1/6}]}],AspectRatio->Automatic,PlotRange->All,opts]

(*same as before,except with Cuboid instead of Line and Rectangle... change the middle values in each triplet in book3D if you want the books to be wider or narrower...*)

book3D[{x_,y_}]:=Cuboid[{x-1,0,y},{x+1,1,y+1/10}]

(*stackPlot3D accepts graphics options,so you change viewpoints,etc.*)

BookStackPlot3D[n_Integer?Positive,opts___Rule]:=Show[Graphics3D[{{Table[book3D[{-H[k-1],(n-k)/10}],{k,n}]},{Cuboid[{-H[n]-3/2,-1,0},{1-H[n],2,-1/3}]}}],AspectRatio->Automatic,PlotRange->All,Boxed->False,opts]

(*****************************)
(*End Robert Dickau's code*)
(*****************************)

BookStackPlotPair[n_Integer?Positive]:={BookStackPlot[n,DisplayFunction->Identity],BookStackPlot3D[n,ViewPoint->{-0.011,-3.176,1.168},DisplayFunction->Identity]}

Show[GraphicsArray[Table[BookStackPlotPair[n],{n,4}]],DisplayFunction->$DisplayFunction]