Retrograde Motion Illusion for an Electric Fan

cage=Graphics3D[{Black,Cylinder[{{0,0,0},{.25,0,0}},.1],
Opacity[0],EdgeForm[{Thick,Black}],Black,Table[Cylinder[{{0,0,0},{.25,0,0}},R],{R,.2,1,.2}],Thick,Black,Opacity[1],Table[Line[{{0,Sin[θ],Cos[θ]},{.25,Sin[θ],Cos[θ]}}],{θ,0,11π/6,π/6}]},Boxed->False,ViewPoint->{1,-1,0}];

base=Graphics3D[{White,Cylinder[{{-.125,0,.05},{-.125,0,-1.4}},.1],Cylinder[{{-.125,0,-1.4},{-.125,0,-1.5}},.5]}];

blades[rpm_]:=Graphics3D[Rotate[{Darker[Gray],Polygon[{{0,1,0},{.25,1,0},{.25,-1,0},{0,-1,0},{0,1,0}}],
Polygon[{{0,1/2,(Sqrt[3])/2},{.25,1/2,(Sqrt[3])/2},{.25,-1/2,-(Sqrt[3])/2},{0,-1/2,-(Sqrt[3])/2},{0,1/2,(Sqrt[3])/2}}],
Polygon[{{0,-1/2,(Sqrt[3])/2},{.25,-1/2,(Sqrt[3])/2},{.25,1/2,-(Sqrt[3])/2},{0,1/2,-(Sqrt[3])/2},{0,-1/2,(Sqrt[3])/2}}]},2π rpm Mod[SessionTime[],60]/120,{-1,0,0}],Boxed->False];

Manipulate[Show[cage,base,Refresh[blades[rpm],UpdateInterval->1/f],ImageSize->{600,400},Boxed->False],{{rpm,10,"relative fan speed"},0,50,Appearance->"Labeled"},{{f,5,"relative strobe frequency"},1,10,Appearance->"Labeled"},SaveDefinitions->True]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Retrograde Motion Illusion for an Electric Fan" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/RetrogradeMotionIllusionForAnElectricFan/

Contributed by: S. M. Blinder

A full-function Wolfram Mathematica 6 system is required to edit this notebook.
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »