Newton’s Cradle

Introductory Notes

This example builds a complete cradle with spheres, springs, and support structure. The motion of the spheres is modeled using the simple harmonic angular displacement approximation.

Initialization

<< Graphics`Colors`<< Graphics`Shapes`<< DynamicVisualizer`

General::spell1  // OffGeneral::spell  // Off

Parameters

\(nBalls\ \  = \ 5; \  (*\ number\ of\ balls\ *) 
pendulumLength = 6; 
    \  (*\ the\ vertical\ length, \ from\ the\ centre\ of\ ball\ *) 

    ballToFloor\  = 3.0; \  (*\ from\ the\ centre\ of\ the\ ball\ *) 

    frameHeight\  = \ ballToFloor + pendulumLength; 

    frameLength\  = \ 2 \((nBalls + 0.5)\); 
    \  (*\ each\ ball\ has\ diameter\ of\ 2\ *) 
frameDepth\  = \ 6; \)

Create Objects

Set up Dynamic Visualizer

ClearVisualizer[];

\(\(SetOptions[\ Camera[{VisualizerUniverse, "Camera"}], 
		
      Location\  -> \ {0, \(-4\), 0}]; \)\)

SetOptions[ $DefaultModel3D, 
      ModelRange -> {{-7, 7}, {-7, 7}, {-4, 10}}]

Create Balls

Define the ball graphic as a sphere.

gSphere  =  Graphics3D[ Sphere[] ];

\(allBalls = {}; 
initialBallLocations = {}; 

    Do[
		location\  = \ {2\ \((iBall - 0.5)\) - nBalls, 0, ballToFloor}; 
      
		Visualize[\ gSphere]; 
		
      AppendTo[allBalls, \ $LastVisualizerObject]; 
		
      AppendTo[initialBallLocations, location]; 
		
      \(SetOptions[$LastVisualizerObject, 
			
        RenderMode -> SmoothShaded, 
			
        InvariantPoint\  -> \ \ {0, 0, pendulumLength}, 
			
        Color -> \ {{Blue, White}}, 
			Location -> location, 

        			InteractiveMovement -> False, 
			
        Ambient\  -> \ 0.3, Specular -> 0.2, Diffuse -> 0.6

        		]; \)
	
	, \ {iBall, nBalls}]\)

Create Support Frame

average[list_]  :=  (Plus@@list)/Length[list]; 
    smoothFrame[t0_]  := 
      average[Table[{xFunct[t],  yFunct[t], zFunct[t]}, {t, t0 - 0.1, 
            t0 + 0.1, 0.05}]]

\(zFunct = \ 
      Interpolation[
        frameHeight \(({0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1} /. \ 0 -> 0.02)\), \ 
        InterpolationOrder -> 1]; 

    xFunct\  = \ 
      Interpolation[\ 
        frameLength\ \(({0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0} - 0.5)\), \ 
        InterpolationOrder -> 1]; 

    yFunct = \ 

      Interpolation[\ 
        frameDepth \(({1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0} - 0.5)\), \ 
        InterpolationOrder -> 1]; \)

gFrame = 
      ParametricPlot3D[smoothFrame[t],  {t,  2,  10},  PlotPoints -> 500, 
        DisplayFunction -> Identity, Compiled -> False];

\(frameGraphics = \ 
      Graphics3D@Prepend[\ {Thickness[0.05]}, First@\ gFrame]; 

    CreateObject[frameObject = \ Object3D["Frame"], 
frameGraphics]; 
    \)

\(\(SetOptions[frameObject, \ RenderMode -> SmoothShaded, 
	
      Color -> {SteelBlue}, \ Specular -> 1, Ambient -> 0.2, \ 
      Diffuse -> 0.99, InteractiveMovement -> False]; \)\)

\(\(SetOptions[\ Camera[{VisualizerUniverse, "Camera"}], 
		
      Location\  -> \ {0, \(-3.5\), 0.5}, 
	
      YawPitchRoll -> \ {0, \(-0.07\), 0}, 
	Visible -> False]; \)\)

Floor

\(Plot3D[\ 0, \ {x, \(-5\), 5}, {y, \(-5\), 5}\ , \ 
      PlotPoints -> 16, \ DisplayFunction\  -> Visualize]; 

    floor\  = \ $LastVisualizerObject; \)

\(\(SetOptions[floor, \ InteractiveMovement -> False, 
	
      Scale -> 14, 
RenderMode -> 	SmoothShaded, \ 
      Color -> {{White, Blue}}
	, \ Ambient -> \ 0.7, \ Specular -> 0, 
      Diffuse -> 0]; \)\)

Strings

\(\(
 (*\ allow\ for\ ball\ radius\ of\ 1\ *) 

    \(stringHeight\  = \ pendulumLength - 1; \)\)\)

\(strings = {}; 

    Do[
		stringGraphics = 
        Graphics3D[{Thickness[0.001], 
            Line[{{0, \(-frameDepth\)/2, 0}, {0, 0, \(-stringHeight\)}, 

                			{0, frameDepth/2, 0}
			}]\ \ }]; 
	
      Visualize[stringGraphics]; \ 
	
      AppendTo[strings, \ $LastVisualizerObject]; 
	
      \(SetOptions[$LastVisualizerObject, 
		\ 	
        InvariantPoint -> {0, 0, 0}, 
				
        Location -> {initialBallLocations[\([i, 1]\)], 0, frameHeight}, 
        
	RenderMode -> Wireframe, InteractiveMovement -> False

        		]; \)
		, {i, nBalls}]\)

SetOptions[ strings, Color -> White];

Animation of Three-Ball Motion Using Simple Harmonic Motion Approximation

Animation Parameters

\(\( (*\ Number\ of\ frames\ for\ a\ swing\ up\ and\ down\ *) 

    halfPeriod\  = \ 10; \ 
nBallSwings\  = \ 3; 
    \  (*\ how\ many\ balls\ in\ motion\ *) 
totalFrames = 60; 
    \  (*\ Number\ of\ frames\ in\ movie\ *) \)\)

Create Animation

\(\( (*\ for\ a\ given\ ball\ at\ a\ given\ time, \ 
      calculate\ its\ swing\ left\ *) 

    anglesLeftSide[ball_, t_]\  := 
      Max[0. , \ N@Sin[\(π\ t\)\/halfPeriod]]\  /; ball\  <= nBallSwings; 
    
anglesLeftSide[_, _]\  = \ 0. ; \  (*\ default\ is\ zero\ *) 

    
 (*\ for\ a\ given\ ball\ at\ a\ given\ time, \ 
      calculate\ its\ swing\ right\ *) 

    anglesRightSide[ball_, t_]\  := 
      Min[0. , \(-N@\ Sin[\(π \((\ t + halfPeriod)\)\)\/halfPeriod]\)] /; 
        \ \((nBalls\  - \ ball < \ nBallSwings)\); 

    anglesRightSide[_, _]\  = \ 0. ; \  (*default\ swing\ is\ zero\ *) \)\)

\(\(
 (*\ 
      This\ function\ returns\ the\ list\ of\ each\ ball' s\ angular\ 
        deviation\ at\ a\ given\ time\ *) 

    \(ballDisplacement[ball_, t_]\  := 
      anglesLeftSide[ball, t]\  + anglesRightSide[ball, t]\ ; \)\)\)

\(\(anim\  = \ 
      Table[{DV`SetOptions[{\ allBalls[\([iBall]\)], \ strings[\([iBall]\)]}, 
            YawPitchRoll -> \ {0, 0, ballDisplacement[iBall, t]}]

          		,  (*\ 
            Rotate\ the\ model\ by\ 2\ π\ during\ the\ whole\ sequence
              \ *) 
		
          DV`SetOptions[\ $DefaultModel3D, \ 
            YawPitchRoll -> \ {2  π\ t/totalFrames, 0, 0}]
			}

        	, \ {t, totalFrames}, {iBall, nBalls}]; \)\)

Visualize[anim];