Manipulate[ (*by Nasser M. Abbasi 6/30/14*) tick; Module[{perc, torque, g = 9.81, I0, w = 2.0 Pi*spin, delTheta = 2.0 Pi/10, u}, torque = g*r2; I0 = r1^2; perc = torque/(I0*w); thick = 0.07 r1; spins = Table[{{r2, 0, 0}, {r2, r1 Cos[x], r1 Sin[x]}}, {x, 0., 2 Pi, 2 Pi/n}]; topSpins = Table[{{0, 0, 2}, {0.4 Cos[x], 0.4 Sin[x], 2}}, {x, 0., 2 Pi, 2 Pi/10}]; wheel = Table[{r2, r1 Cos[u], r1 Sin[u]}, {u, 0., 2 Pi, 2 Pi/40}]; topWheel = Table[{0.4 Cos[u], 0.4 Sin[u], 2}, {u, 0., 2 Pi, 2 Pi/40}]; g = Grid[{ {Grid[{ {"wheel angle", "precession angle", "wheel spin (hz)", "Precession spin (hz)"}, { padIt2[currentSpinAngle*180/Pi, {4, 3}], padIt2[currentPercAngle*180/Pi, {4, 3}], padIt1[w/(2 Pi), {5, 4}], padIt1[perc/(2 Pi), {5, 4}] } }, Alignment -> Center, Frame -> All, Spacings -> {.5, .7}] }, {Graphics3D[ Rotate[GraphicsGroup[ { Rotate[GraphicsGroup[ {{Green, Tube[wheel, thick]}, {Red, Cylinder[{{r2 - thick, 0, 0}, {r2 + thick, 0, 0}}, thick]},(*disk in middle of wheeel*) Tube[#, thick/3] & /@ spins(*rods*) }], currentSpinAngle, {1, 0, 0} ], {Arrowheads[Small], Arrow[{{r2, 0, 0}, {r2, If[clockWise, -1, 1] 1.5 r1, 0}}]},(*torque*) Text[Style["torque", Bold, 10], {r2, If[clockWise, -1, 1] 1.5 r1 + If[clockWise, -1, 1]*0.3 r1, 0}], {Arrowheads[Small], Arrow[{{0, 0, 0}, {If[clockWise, -r1, r2 + r1], 0, 0}}]},(*angular momentum*) Text[Style["H", Bold, 10], {If[clockWise, -1.1 r1, r2 + 1.1 r1], 0, 0}], {Blue, Cylinder[{{0, 0, 0}, {r2, 0, 0}}, thick]},(*tube to robe*) Tube[{{0, 0, 0}, {0, 0, 2}}, thick/2],(*robe*) {LightGray, Cylinder[{{0, 0, 2 - 0.03}, {0, 0, 2 - 0.01}}, 0.4]} ,(*disk at top*) Tube[topWheel, 0.01], {Red, Tube[#, 0.01] & /@ topSpins} }], currentPercAngle, {0, 0, 1}], Axes -> False, AxesLabel -> {"x", "y", "z"}, PlotRange -> {{-zoom, zoom}, {-zoom, zoom}, {-1.1, 2.1}}, SphericalRegion -> True, Boxed -> False, ImagePadding -> .1, ImageSize -> 400 ] }}, Frame -> True, FrameStyle -> LightGray]; Which[state == "RUN" || state == "STEP", currentSpinAngle = Mod[currentSpinAngle + If[clockWise, -1, 1] delTheta, 2 Pi]; currentPercAngle = Mod[currentPercAngle + If[clockWise, -1, 1] (delTheta*perc/w), 2 Pi]; If[state == "RUN", tick = Not[tick]] ]; g ], Grid[{ {Grid[{ { Button[Text@Style["run", 12], {state = "RUN"; tick = Not[tick]}, ImageSize -> {40, 40}], Button[Text@Style["step", 12], {state = "STEP"; tick = Not[tick]}, ImageSize -> {40, 40}], Button[Text@Style["stop", 12], {state = "STOP"; tick = Not[tick]}, ImageSize -> {40, 40}], Button[Text@Style["reset", 12], {state = "RESET"; r1 = 1; r2 = 1; spin = 2; zoom = 2.2; n = 10; tick = Not[tick]}, ImageSize -> {40, 40}] } }, Spacings -> {.3, 0}, Frame -> True, FrameStyle -> Gray ], SpanFromLeft }, { "radius of wheel", Manipulator[Dynamic[r1, {r1 = #; tick = Not[tick]} &], {.2, 1, .1}, ImageSize -> Small], Dynamic[padIt1[r1, {2, 1}]] }, { "distance away", Manipulator[Dynamic[r2, {r2 = #; tick = Not[tick]} &], {.2, 2, .01}, ImageSize -> Small], Dynamic[padIt1[r2, {2, 1}]] }, { "number of rods", Manipulator[Dynamic[n, {n = #; tick = Not[tick]} &], {3, 15, 1}, ImageSize -> Small], Dynamic[padIt1[n, 2]] }, { "wheel spin (hz)", Manipulator[Dynamic[spin, {spin = #; tick = Not[tick]} &], {.1, 5, .1}, ImageSize -> Small], Dynamic[padIt1[spin, {2, 1}]] }, { "wheel spin clockwise", Checkbox[Dynamic[clockWise, {clockWise = #; tick = Not[tick]} &]] }, { "zoom", Manipulator[Dynamic[zoom, {zoom = #; tick = Not[tick]} &], {1, 4, .1}, ImageSize -> Small], Dynamic[padIt1[zoom, {2, 1}]] } }, Frame -> True, Alignment -> Center, FrameStyle -> Gray ], {{tick, False}, None}, {{r1, 1}, None}, {{r2, 1}, None}, {{spin, 2}, None}, {{zoom, 2.2}, None}, {{n, 10}, None}, {{state, "STOP"}, None}, {{clockWise, True}, None}, {{currentSpinAngle, 0}, None}, {{currentPercAngle, 0}, None}, ControlPlacement -> Left, Alignment -> Center, ImageMargins -> 0, FrameMargins -> 0, TrackedSymbols :> {tick}, Initialization :> ( integerStrictPositive = (IntegerQ[#] && # > 0 &); integerPositive = (IntegerQ[#] && # >= 0 &); numericStrictPositive = (Element[#, Reals] && # > 0 &); numericPositive = (Element[#, Reals] && # >= 0 &); numericStrictNegative = (Element[#, Reals] && # < 0 &); numericNegative = (Element[#, Reals] && # <= 0 &); bool = (Element[#, Booleans] &); numeric = (Element[#, Reals] &); integer = (Element[#, Integers] &); (*--------------------------------------------*) padIt1[v_?numeric, f_List] := AccountingForm[v, f, NumberSigns -> {"-", "+"}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) padIt1[v_?numeric, f_Integer] := AccountingForm[Chop[v], f, NumberSigns -> {"-", "+"}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) padIt2[v_?numeric, f_List] := AccountingForm[v, f, NumberSigns -> {"", ""}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) padIt2[v_?numeric, f_Integer] := AccountingForm[Chop[v], f, NumberSigns -> {"", ""}, NumberPadding -> {"0", "0"}, SignPadding -> True]; (*--------------------------------------------*) ) ]