Graphics & Visualization: Dynamic Visualizations with Mathematica

Manipulate[

Show[

Graphics3D[{Specularity[White,30],Sphere[s p1[θ],.4],Sphere[s p2[θ],.4],Sphere[s p3[θ],.4],Sphere[s p4[θ],.4]}],

ParametricPlot3D[Flatten[Partition[RotateLeft[{x ,y,-Pi,x,y,Pi },#],3]&/@Range[0,2],1]+n(Sin[x+ y+a]+Cos[x+ y+a]),{x,-Pi,Pi},{y,-Pi,Pi},Mesh->False,PlotStyle->Directive[Opacity[.8],Specularity[White,20]],PlotPoints->20]

,SphericalRegion->True,PlotRange->6,Boxed->False,Background->Black,ViewAngle->.3,ImageSize->300,

ViewAngle->0.3,ViewPoint->{1.9336790674757351`,-2.2404857124242743`,1.6404600075676545`},ViewVertical->{0.10439769478013806`,-0.07653264248249605`,0.9915865448659736`},

Lighting->{

{"Point",Red,s p1[θ]},
{"Point",Green,s p2[θ]},
{"Point",Blue,s p3[θ]},
{"Point",Yellow,s p4[θ]}}],

Grid[{
{"","move lights",Control@{{θ,Pi,""},0,2Pi,Animator,AppearanceElements->{"PlayPauseButton"},AnimationRunning->False,AnimationRate->.1}},
{"","wiggle",Control@{{a,0,""},-Pi,Pi,Animator,AppearanceElements->{"PlayPauseButton"},AnimationRunning->False,AnimationRate->.4}}
},Alignment->{{Center,Right,Center},Center}],

{{n,.1,"intensity"},ControlType->None},
{{s,2.5},ControlType->None},
SaveDefinitions->True,FrameMargins->0,AppearanceElements->None,ControlPlacement->Right,Initialization:>(
p1[θ_]:=RotationTransform[θ,{0,0,1}][{0,2,0}];
p2[θ_]:=RotationTransform[θ+Pi/2,{1,0,1}][{0,2,0}];
p3[θ_]:=RotationTransform[θ+Pi,{1,0,0}][{0,2,0}];
p4[θ_]:=RotationTransform[θ+3Pi/2,{1,0,-1}][{0,2,0}];
)]

Vitaliy Kaurov
Wolfram Research
wolfram-u@wolfram.com

Dynamic Visualizations versus Animations

Multiple time channels and real-time controls

imgsiz=350;Row[{
Manipulate[
Graphics[
With[{th=(1-rMin)/(2n-1)},
Table[Rotate[{
{Black,Disk[c(i/(2n-1)),Abs[1-(1-rMin)(i/(2n-1))]]},
{White, Disk[c(i/(2n-1))+
{0,d(-th + 2 th((i+1)/(2n-1)))},Abs[1-(1-rMin)((i+1)/(2n-1))]]}
},360° tw(i/(2n-1)),{0,0}],{i,0,2n-1,2}]
],PlotRange->1,ImageSize->imgsiz{1,1}],
{{n,16,"rings"},1,50,1},
{{rMin,.02,"inner radius"},0,1},
{{d,-1.07,"displacement"},-10,10},
{{tw,0,"twist"},0,10},
{{c,{0,0}},-{1,1},{1,1},ControlType->Locator,Appearance->None}
,FrameMargins->0],
Manipulate[Graphics3D[Dynamic@{{Specularity[White,30],Gray,Table[{With[{b=bb},Polygon[{
{(R+(-s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(-s)  Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(-s)  Sin[b+ (t+Pi/24)/2]},{(R+(-s) Cos[b+t/2 ])Cos[t],(R+(-s)  Cos[b+t/2])Sin[t],(-s)  Sin[ b+t/2]},
{(R+(+s) Cos[b+t/2 ])Cos[t],(R+(+s) Cos[b+t/2])Sin[t],(+s) Sin[b+ t/2]},
{(R+(+s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(+s) Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(+s) Sin[ b+(t+Pi/24)/2]}}]],With[{b=bb+Pi/2},Polygon[{
{(R+(-s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(-s)  Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(-s)  Sin[b+ (t+Pi/24)/2]},{(R+(-s) Cos[b+t/2 ])Cos[t],(R+(-s)  Cos[b+t/2])Sin[t],(-s)  Sin[ b+t/2]},
{(R+(+s) Cos[b+t/2 ])Cos[t],(R+(+s) Cos[b+t/2])Sin[t],(+s) Sin[b+ t/2]},
{(R+(+s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(+s) Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(+s) Sin[ b+(t+Pi/24)/2]}}]]},{t,-Pi,Pi,Pi/24}]},{Specularity[White,30],Orange,With[{b=bb},Sphere[{(R+(+s) Cos[b+(st+Pi/24)/2 ])Cos[(st+Pi/24)],(R+(+s) Cos[b+(st+Pi/24)/2])Sin[(st+Pi/24)],(+s) Sin[ b+(st+Pi/24)/2]},s]]}},PlotRange->{{-5,5},{-5,5},{-2,2}},Boxed->False,SphericalRegion->True,ViewAngle->.284,ImageSize->(imgsiz+7){1,1}],
{{R,2,"radius"},1,3},
{{s,1/2,"width"},0,1},
{{bb,Pi,"twist"},0,2Pi},
{{st,0,"sphere position"},-2Pi,2Pi},FrameMargins->0]}]

Exploring a Logo by Grignani, Christopher Carlson

Möbius Monorail, Michael Schreiber

Code is not a video

Mathematica advantages

Numerous graphical functions

Functions that automatically construct interfaces

Dynamic and interactive programming environment

Wide range of image processing functionality

Integration with standard video and image formats

More than 8000 free examples at the Wolfram Demonstrations Project

And much more...

Nuances of 2D and 3D evolution

Self-triggered Dynamic for long running simulations

Distinguishing 3D motion of camera from motion of content

A glimpse into gaming, virtual reality, and immersion

Touring complex structures with the Mathematica simulated camera

Recording of evolution via trajectories in parameter space

Animation paths: splines and interpolation

Fusion of multiple time channels and scales

Fusion of camera and content dynamics

Slow motion and acceleration

Visual bookmarking

Import, export, and image processing

The Driving Forces of Visual Dynamics

Sequential time controls

Animate[

Plot3D[Sin[x+a]Sin[y+b^2],{x,0,2Pi},{y,0,2Pi},PlotRange->1,PlotPoints->20,Mesh->True,ImageSize->400],

{a,0,2Pi,AnimationRate->.1},
{b,0,2Pi,AnimationRate->.1}]

Precompute for heavy evaluations

Game of Life rules

GameOfLife={224,{2,{{2,2,2},{2,1,2},{2,2,2}}},{1,1}};
Puffer={{1,4},{2,5},{3,1},{3,5},{4,2},{4,3},{4,4},{4,5},{8,1},{9,2},{9,3},{10,3},{11,3},{12,2},{15,1},{15,4},{16,5},{17,1},{17,5},{18,2},{18,3},{18,4},{18,5}};

Game of Life app

Manipulate[

ArrayPlot[CellularAutomaton[GameOfLife,{SparseArray[Puffer->1],0},500][[t]],PixelConstrained->2,Frame->False],

{t,1,500,1,Animator,AnimationRate->20,AnimationRunning->False},FrameMargins->0]

Correct setup

evo=N@CellularAutomaton[GameOfLife,{SparseArray[Puffer->1],0},1000];

Manipulate[

evo=N@CellularAutomaton[GameOfLife,{SparseArray[Puffer->1],0},1000];

Dynamic@ArrayPlot[Mean@evo[[t;;t+200]],ImageSize->800,Frame->False,ColorFunction->"TemperatureMap",PlotRangePadding->0],

{{t,1,"steps"},1,800,1,Animator,AnimationRate->60,AnimationRunning->False},FrameMargins->0]

Use self-triggered Dynamic for a long-running simulation if evolution history is not necessary

Simplest implementation: the driving “engine”

Manipulate[
(* self-triggering engine *)
x=If[run,x+RandomReal[{-1,1}],x]
(* controls *)
,{{run,False},{False,True}}
,{{x,0},ControlType->None}
]

Adding driven content

Manipulate[
(* self-triggering engine *)
y=If[y≠x,y+.001Sign[x-y],y];
(* application *)
Row[Graphics[{Hue[#],Disk[]}]&/@{x,y}]
(* controls *)
,{{x,.5},0,1,Appearance->"Labeled",ImageSize->Small}
,{{y,.5},0,1,Appearance->"Labeled",ImageSize->Small}
]

What can you do with 140 characters of code?

Boris Faleichik, Minsk, Belarus—Grand Prize Winner of One-Liner Competition 2012

r:=.5-Random[];
p=Array[{(8^9){r,r},r+.5}&,99];
Dynamic@Graphics[
Disk@@@(p={#2 #1+{r,r}+(1-#2)MousePosition["Graphics",#1],#2}&@@@p),
PlotRange->44
]

Examples of applications

Fish-in-Pond Simulation, Te-yuan Chyou, Mike Paulin

Predator-Prey Ecosystem: A Real-Time Agent-Based Simulation, Hiroki Sayama

Diffusion-Limited Aggregation: A Real-Time Agent-Based Simulation, Hiroki Sayama

Real-time analysis of Game of Life, Vitaliy Kaurov

2D Spline Evolution Paths: Dynamic Graph Layouts with Memory

Elegant structures of built-in graph data

GraphData["LeviGraph","AllImages"];
GraphicsGrid[Partition[%,5],ImageSize->700]

Graphics[Polygon[#]]&/@GraphData["LeviGraph","AllVertexCoordinates"];
GraphicsGrid[Partition[%,5],ImageSize->700]

Build evolution path on a set of points

pts=RandomReal[1,{7,2}];
ParametricPlot[BSplineFunction[pts,SplineDegree->1,SplineClosed->True][t],{t,0,1},Epilog->{PointSize[Large],Red,Point[pts]},Frame->True,Axes->False,PlotRangePadding->.1,AspectRatio->1]

Set things in motion

logn={"PappusGraph","DodecahedralGraph","CoxeterGraph","Foster048A","TesseractGraph","IcosahedralGraph","LeviGraph","TruncatedDodecahedralGraph","Balaban10Cage","Foster056A","TruncatedIcosahedralGraph","DeltoidalHexecontahedralGraph","SmallRhombicosidodecahedralGraph"};amvcgd=GraphData[#,{"AdjacencyMatrix","AllVertexCoordinates"}]&/@logn;lofofr=MapThread[Rule,{Range[13],logn}];Manipulate[

AdjacencyGraph[amvcgd[[k,1]],
VertexCoordinates->(#[t]&/@(BSplineFunction[#,SplineDegree->1,SplineClosed->True]&/@Transpose[Transpose/@Map[Rescale,Transpose/@N[amvcgd[[k,2]]],{2}]])),
ImageSize->{400,400},GraphStyle->gs]

,{t,0,1,Animator,AnimationRunning->False,AnimationRate->.02,ImageSize->Small},
{gs,{"BackgroundBlack","ThickEdge","BasicBlack","Prototype","SimpleLink","LargeNetwork","SmallNetwork"}},
{{k,7,""},lofofr},

SaveDefinitions->True,

SynchronousUpdating->False,FrameMargins->0]

Adding memory: build your own dynamic layouts

Manipulate[
pt=VertexCoordinates/.AbsoluteOptions[gr,VertexCoordinates];
Dynamic@AdjacencyGraph[AdjacencyMatrix[gr],VertexCoordinates->If[am,VCPath[t,ptls],pt],ImageSize->{450,450},GraphStyle->"ThickEdge",PlotRangePadding->.015,PlotRange->{{0,1},{0,1}}],
Row[{
Spacer[7],
Button["Store",ptls=ptls~Join~{pt},Enabled->If[am==True,False,True]],Spacer[5],
Button["Undo",ptls=Most[ptls],Enabled->If[am==True,False,True]],Spacer[5],
Button["Clear",ptls={},Enabled->If[am==True,False,True]],Spacer[15],
Control@{{t,0,""},0,1,Animator,AppearanceElements->{"ProgressSlider","PlayPauseButton","FasterSlowerButtons","DirectionButton"},AnimationRepetitions->5,AnimationRunning->False,AnimationRate->.05,ImageSize->Tiny,Enabled->If[am==True,True,False]},Spacer[15],
Control@{{am,False,""},{False->"Edit",True->"Animate"},RadioButton,Enabled->If[ptls=={},False,True]}
}],
{{am,False},ControlType->None},
{{ptls,{}},ControlType->None},
{{pt, {}}, ControlType->Locator,Appearance->None},
{{gr,,""},{,,,,,,},ImageSize->Large,Setter,Enabled->If[am==True,False,True]},
FrameMargins->0,Initialization:>(
MotionPath[x_]:=BSplineFunction[#,SplineDegree->1,SplineClosed->True]&/@Transpose[x];VCPath[t_,x_]:=Table[#[[i]][t],{i,Length[#]}]&@MotionPath[x];
)]

Fundamentals of 3D Evolution: Camera versus Content

Separating camera control from content evolution

Möbius Monorail, Michael Schreiber

Manipulate[Graphics3D[Dynamic@{{Specularity[White,30],Gray,Table[{With[{b=bb},Polygon[{
{(R+(-s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(-s)  Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(-s)  Sin[b+ (t+Pi/24)/2]},{(R+(-s) Cos[b+t/2 ])Cos[t],(R+(-s)  Cos[b+t/2])Sin[t],(-s)  Sin[ b+t/2]},
{(R+(+s) Cos[b+t/2 ])Cos[t],(R+(+s) Cos[b+t/2])Sin[t],(+s) Sin[b+ t/2]},
{(R+(+s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(+s) Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(+s) Sin[ b+(t+Pi/24)/2]}}]],With[{b=bb+Pi/2},Polygon[{
{(R+(-s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(-s)  Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(-s)  Sin[b+ (t+Pi/24)/2]},{(R+(-s) Cos[b+t/2 ])Cos[t],(R+(-s)  Cos[b+t/2])Sin[t],(-s)  Sin[ b+t/2]},
{(R+(+s) Cos[b+t/2 ])Cos[t],(R+(+s) Cos[b+t/2])Sin[t],(+s) Sin[b+ t/2]},
{(R+(+s) Cos[b+(t+Pi/24)/2 ])Cos[(t+Pi/24)],(R+(+s) Cos[b+(t+Pi/24)/2])Sin[(t+Pi/24)],(+s) Sin[ b+(t+Pi/24)/2]}}]]},{t,-Pi,Pi,Pi/24}]},{Specularity[White,30],Orange,With[{b=bb},Sphere[{(R+(+s) Cos[b+(st+Pi/24)/2 ])Cos[(st+Pi/24)],(R+(+s) Cos[b+(st+Pi/24)/2])Sin[(st+Pi/24)],(+s) Sin[ b+(st+Pi/24)/2]},s]]}},PlotRange->{{-5,5},{-5,5},{-2,2}},Boxed->False,SphericalRegion->True,ViewAngle->.284,ImageSize->{407,407}],
{{R,2,"radius"},1,3},
{{s,1/2,"width"},0,1},
{{bb,Pi,"twist"},0,2Pi},
{{st,0,"sphere position"},-2Pi,2Pi},FrameMargins->0]

Driving the Mathematica Simulated Camera: Simple Analytic Evolution Paths

Camera-related options

Visualization: Advanced 3D Graphics, Yu-Sung Chang

Clear[billboard3D];
billboard3D[s_,width_,{x_,y_,z_},{nx_,ny_,nz_},{hx_,hy_,hz_}]:=
Module[{img=Rasterize[s,"Image",Background->None],height},
height=width ImageAspectRatio[img];
{
FaceForm[White],EdgeForm[],
Texture[ImageData[img]],
GeometricTransformation[Polygon[{{-.5width,.5height,0},{.5width,.5height,0},{.5width,-.5height,0},{-.5width,-.5height,0}},VertexTextureCoordinates->{{0,1},{1,1},{1,0},{0,0}}],
Quiet@Composition[TranslationTransform[{x,y,z}],RotationTransform[{{0,1,0},{hx,hy,hz}}],RotationTransform[{{0,0,1},{nx,ny,nz}}]]]
}
];

Framed[
Graphics3D[{
(* View frustum *)
FaceForm[],EdgeForm[GrayLevel[.25]],Cuboid[],

(* Objects *)
EdgeForm[],Specularity[White,10],
FaceForm[Red],Sphere[{.3,.4,.2},.2],
FaceForm[Blue],Cylinder[{{.5,.8,0},{.5,.8,.5}},.1],
FaceForm[Green],Cone[{{.7,.5,0},{.7,.5,.4}},.2],

(* Camera *)
FaceForm[GrayLevel[.25]],EdgeForm[],Specularity[White,30],
Cuboid[{.45,-1,.4},{.55,-1.3,.6}],
Cylinder[{{.475,-1.1,.65},{.525,-1.1,.65}},.05],
Cylinder[{{.475,-1.2,.65},{.525,-1.2,.65}},.05],
Cylinder[{{.5,-1,.5},{.5,-.9,.5}},.05],
Cylinder[{{.5,-1.15,.5},{.5,-.9,0}},.01],
Cylinder[{{.5,-1.15,.5},{.35,-1.3,0}},.01],
Cylinder[{{.5,-1.15,.5},{.65,-1.3,0}},.01],
billboard3D[Style["ViewPoint",24,Bold,FontFamily->"Courier"],.4,{.5,-1.15,.8},{1,0,0},{0,0,1}],

(* View span *)
GrayLevel[.25],
With[{p={.5,-.9,.5}},Line[{{p,{0,0,0}},{p,{1,0,0}},{p,{0,0,1}},{p,{1,0,1}}}]],

(* View angle *)
Gray,Dashed,
With[{p={.5,-.9,.5}},Line[{{p,{.5,0,1},{.5,0,0},p}}]],
Arrowheads[{-.015,.015}],Arrow[BezierCurve[{{.5,-.5,0.28},{.5,-.4,.5},{.5,-.5,.72}}]],
billboard3D[Style["ViewAngle",24,Bold,FontFamily->"Courier"],.3,{.5,-.4,.45},{1,0,0},{0,0,1}],

(* View vertical *)
billboard3D[Style["ViewVertical",24,Bold,FontFamily->"Courier"],.35,{.5,-.05,.75},{1,0,0},{0,-1,0}],

(* View center *)
PointSize[Large],Point[{{.5,.5,.5},{.5,0,.5}}],
Arrowheads[.015],Arrow[{{.5,.5,.5},{.5,0,.5}}],
billboard3D[Style["ViewCenter",24,Bold,FontFamily->"Courier"],.25,{.5,.25,.55},{1,0,0},{0,0,1}],

(* View range *)
Gray,
Line[{{{1,0,0},{1,0,-.1}},{{1,1,0},{1,1,-.1}}}],
Arrowheads[{-.02,.02}],Arrow[{{1,0,-0.05},{1,1,-.05}}],
billboard3D[Style["ViewRange",24,Bold,FontFamily->"Courier"],.4,{1.075,.5,-.1},{1,0,0},{0,0,1}]

},
Boxed->False,ImageSize->750,Lighting->"Neutral",
ViewPoint->{5,-2,1.5}
],
FrameMargins->20,FrameStyle->GrayLevel[.75]]

Construct a parametric path around a 3D object

f[t_]:={Cos[t]+.5Sin[2t],Sin[t]+.5Cos[3t],Sin[2t]Cos[3t]}
Show[
ParametricPlot3D[f[t],{t,0,2Pi},PlotStyle->{Red,Thick}],
Graphics3D[{Opacity[.5],Cuboid[-.5{1,1,1}]}],
SphericalRegion->True]

Hook up the camera to the path and take a tour

Animate[
Show[
ParametricPlot3D[f[x],{x,0,2Pi},PlotStyle->{Red,Thick}],
Graphics3D[{Opacity[.5],Cuboid[-.5{1,1,1}]}],ViewVector->Dynamic@{f[t],{0,0,0}},ViewAngle->85Degree,Boxed->False,SphericalRegion->True,Axes->False]
,{t,0,2Pi},AnimationRate->.1]

Real-Time Control of the Camera: Games and Virtual Reality

Control your camera while driving

Manipulate[Show[Graphics3D[
{Green,Specularity[White,20],Dynamic@Arrow[Tube[{{f[x,p[[1]]] Sin[v],Cos[v] f[x,p[[1]]],g[x,p[[2]]]},{f[x,p[[1]]] Sin[v+π s[[1]]],Cos[v+π s[[1]]] f[x,p[[1]]],g[x,p[[2]]]+2 f[x,p[[1]]] Sin[1/2 π s[[1]]] Tan[1/2 π s[[2]]]}},0.05]]}],
ParametricPlot3D[3{Cos[t],Sin[t] ,0},{t,0,2 Pi},PlotStyle->Directive[Red,Thickness[.01]]],ParametricPlot3D[{Cos[t] (3+Cos[u]),Sin[t] (3+Cos[u]),Sin[u]},{t,0,2 Pi},{u,0,2 Pi},PlotStyle->Directive[Blue,Opacity[.2],Specularity[White,20]],Mesh->True,MeshStyle->Opacity[.2],PerformanceGoal->"Quality"],Axes->False,Boxed->False,ImageSize->{500,500},ViewAngle->.25],Item[Control[{{v,0,Text[Style["move",Medium]]},0,Infinity,ControlType->Trigger,AnimationRate->.5,AppearanceElements->{"PlayPauseButton","FasterSlowerButtons"}}],Alignment->Left],Delimiter,Column[{Item[Text[Style["look around",Medium]],Alignment->Left],Item[Control[{{s,{.17,0.},""},{.001,-.999},{1.999,.999}}],Alignment->Left]}],Delimiter,Column[{Item[Text[Style["shift around",Medium]],Alignment->Left],Item[Control[{{p,{3.,0.},""},{6.,-3.},{.01,3.}}],Alignment->Left]}],ControlPlacement->Left,TrackedSymbols->True,FrameMargins->0,SynchronousUpdating->False,SynchronousInitialization->False,Initialization:>(f[x_,y_]:=If[x==0,y,6.01-y];
g[x_,y_]:=If[x==0,y,-y];)]

Use built-in textures for realism

texlis=ImageResize[ExampleData[{"ColorTexture",#},"Image"],{50,50}]&/@ExampleData["ColorTexture"][[All,2]]

Dynamically control the camera view

Manipulate[SeedRandom[13];
Style[Overlay[{Show[
Graphics3D[Table[{Hue[RandomReal[]],Specularity[White,20],Sphere[{RandomReal[{-5,5}],RandomReal[{-5,5}],RandomReal[{-2,2}]},RandomReal[.5]]},{130}]],ParametricPlot3D[{Cos[t] (3+Cos[u]),Sin[t] (3+Cos[u]),Sin[u]},{t,0,2 Pi},{u,0,2 Pi},PlotPoints->Automatic,TextureCoordinateFunction->(4 {2 #4,#5}&),PlotStyle->Directive[Specularity[White,50],Texture[ExampleData[{"ColorTexture",t}]]],Mesh->None,PerformanceGoal->"Quality"],Axes->False,Boxed->False,

(* zoom *)
ViewAngle->Dynamic[a],
(* look/fly around *)
ViewVector->Dynamic[{{f[x,p[[1]]] Sin[v],Cos[v] f[x,p[[1]]],g[x,p[[2]]]},{f[x,p[[1]]] Sin[v+π s[[1]]],Cos[v+π s[[1]]] f[x,p[[1]]],g[x,p[[2]]]+2 f[x,p[[1]]] Sin[1/2 π s[[1]]] Tan[1/2 π s[[2]]]}}],

ImageSize->{480,480},Lighting->"Neutral"],Graphics[{},ImageSize->{480,480}]}],Selectable->False],{{t,"Metal4",""},Rule@@@Transpose[{ExampleData["ColorTexture"][[All,2]],texlis}]},Delimiter,Item[Control[{{v,0,Text[Style["move",Medium]]},0,Infinity,ControlType->Trigger,AnimationRate->.5,AppearanceElements->{"PlayPauseButton","FasterSlowerButtons"}}],Alignment->Left],Delimiter,Column[{Item[Text[Style["zoom",Medium]],Alignment->Left],Item[Control[{{a,π/2.,""},0.01,.99 π,ImageSize->Tiny}],Alignment->Left],}],Delimiter,Column[{Item[Text[Style["look around",Medium]],Alignment->Left],Item[Control[{{s,{.17,0.},""},{.001,-.999},{1.999,.999}}],Alignment->Left]}],Delimiter,Column[{Item[Text[Style["shift around",Medium]],Alignment->Left],Item[Control[{{p,{3.,0.},""},{6.,-3.},{.01,3.}}],Alignment->Left]}],Delimiter,{{x,0,""},{0->"subject",1->"object"}},ControlPlacement->Left,TrackedSymbols->True,FrameMargins->0,SynchronousUpdating->False,SynchronousInitialization->False,Initialization:>(f[x_,y_]:=If[x==0,y,6.01-y];
g[x_,y_]:=If[x==0,y,-y];)]

Tours of Complex 3D Structures: Spline Evolution Paths

Get information and built-in data for a complex Foster 364A graph with Wolfram|Alpha

gr=LinguisticAssistant;

Visualize the structure in 3D

gr3Ds=GraphPlot3D[AdjacencyMatrix[gr],PlotStyle->Opacity[.5],Boxed->False,SphericalRegion->True,AspectRatio->1,ImageSize->500{1,1}]

gr3D=GraphPlot3D[AdjacencyMatrix[gr],Boxed->False,ViewAngle->.3,EdgeRenderingFunction->(Cylinder[#1,.02]&),VertexRenderingFunction->({ColorData["Atoms"][RandomInteger[{1,117}]],Sphere[#1,.05]}&),PlotStyle->Directive[Specularity[White,20]],Boxed->False,SphericalRegion->True,AspectRatio->1,ImageSize->600{1,1},Background->Black]

Construct a spline random walk along the edges of the graph

edg=EdgeList[gr];ver=gr3D[[1,2,2]];
ran=ver[[#]]&/@NestList[{#[[2]],RandomChoice[Complement[VertexList[NeighborhoodGraph[gr,#[[2]]]],#]]}&,{#[[1]],#[[2]]}&@RandomChoice[edg],100][[All,1]];

Soften corners of the spline path to avoid jerky camera motion

a={{0,0},{1,1},{2,0}};
b={{0,0},{1,1},{1,1},{2,0}};
c={{0,0},{1,1},{1,1},{1,1},{2,0}};
Graphics[{BSplineCurve/@{a,b,c},Hue[1,1,1,.4],Thickness[.05],Line[a]}]

pts=RandomReal[1,{13,2}];

ParametricPlot[#[t],{t,0,1},Epilog->{PointSize[Medium],Red,Point[pts]},Frame->True,Axes->False,ImageSize->360]&/@{BSplineFunction[pts,SplineDegree->1],
BSplineFunction[Flatten[Transpose[{pts,pts}],1]]}

bsc=BSplineFunction[Flatten[Transpose[{ran,ran}],1]];
gr3Dh=Show[ParametricPlot3D[bsc[t],{t,0,1},PlotStyle->Directive[RGBColor[0,0,1,.5],Thickness[.02]]],gr3Ds,Graphics3D[{{Orange,Specularity[White,20],Sphere[{ran[[1]],ran[[-1]]},.25]},{Red,PointSize[.02],Point[ran]}}],PlotRange->All,Boxed->False,ViewAngle->.3,SphericalRegion->True,Axes->False]

Hook up the camera to the spline path and take a tour

Manipulate[Show[gr3D,ViewAngle->Dynamic@va,ViewVector->Dynamic@{bsc[t]+.07,bsc[t+.005]+.03},ImageSize->500],{{va,1.2,"zoom"},.1,2.5,Slider},{{t,.51,"time"},0,.99,Animator,AnimationRunning->False,AnimationRate->.004},FrameMargins->0,AppearanceElements->None]

Object Tours with Dramatic Transitions: Interpolating Visual Bookmarks, Controlling Time

A simple fact

Graphics3D[Cuboid[]]

//Options

Bookmark all dynamic channels of the system

Straight Cylinder Engine, Yu-Sung Chang

Initialization

cdelta={{1},{1,2},{1,3,2},{1,4,2,3},{1,2,5,3,4},{1,6,5,4,3,2},{1,5,2,6,3,7,4},{1,4,8,7,6,5,3,2}};
(* Firing order in cycle difference *)
lighting[i_,θ_]:=Module[{l={
{"Spot",Red,{{0,3i,8},{0,3i,3}},{Pi/2,30}},
{"Spot",Lighter[Yellow,.5],{{3,3i-2,2},{0,3i,3}},{Pi/2,10}},
{"Spot",Lighter[Cyan,.5],{{-3,3i-2,2},{0,3i,3}},{Pi/2,10}},
{"Spot",LightGray,{{0,3i-10,15},{0,3i,1}},{Pi/2,30}}
}},If[((15 π)/8)≤θ≤((17 π)/8),Lighting->Append[l,{"Ambient",Yellow}],Lighting->l]];
piston[i_,n_,ρ_,e_,l:True|False]:=Module[{pt1,pt2,
y=3i,θ=π Mod[ρ-((4 )/n) (cdelta[[n,i+1]]-1),4]},
pt1={Cos[θ+(π/2)],3i,Sin[θ+(π/2)]};pt2={0,3i,(Sqrt[9-((Cos[θ+(π/2)])^2)])+Sin[θ+(π/2)]};
{EdgeForm[e],
lighting[i,θ],
GrayLevel[(1/3)],Specularity[White,20],
Cylinder[{{0,y-.3,0},{0,y-.7,0}},1.25],(* Crankwheel 1 *)
Cylinder[{{0,y+.3,0},{0,y+.7,0}},1.25],(* Crankwheel 1 *)
Cylinder[{pt1+{0,.8,0},pt1-{0,.8,0}},.2],(* Rod pin *)
LightBlue,Specularity[White,20],
Cylinder[{pt1,pt2},.2],(* Rod *)
LightGreen,Specularity[White,20],
Cylinder[{pt2-{0,1,0},pt2+{0,1,0}},.2],(* Piston pin *)
RGBColor[0.27,0.50,0.70],Specularity[White,50],
Cylinder[{pt2-{0,0,.4},pt2+{0,0,1}},1],(* Piston head *)
If[l,{
Which[0≤θ<π,Yellow,π≤θ<2 π,Orange,2 π≤θ<3 π,Red,3 π≤θ<4 π,Blue],
Sphere[{2,y,0},.25]
},
{}]
}];
cylinder[n_,e_]:={
EdgeForm[Opacity[.4]],
FaceForm[Opacity[.2]],Lighting->"Neutral",Table[Cylinder[{{0,3y,1.5},{0,3y,5.1}},1.01],{y,0,n-1}]
};
shaft[n_]:={
EdgeForm[None],Lighting->{{"Point",White,{0,3(n-1)/2,5}}},
GrayLevel[(1/3)],Specularity[White,50],
Cylinder[{{0,-1,0},{0,-.4,0}},.5],
Table[Cylinder[{{0,3y-2.6,0},{0,3y-.4,0}},.5],{y,1,n-1}],
Cylinder[{{0,3n-2.6,0},{0,3n-2,0}},.5]
};
is[col_]:=Graphics[{col,EdgeForm[Black],Disk[]},ImageSize->10,BaselinePosition->Bottom];

Bookmark interface

Manipulate[

Graphics3D[{
Table[piston[i,4,t,Opacity[.3],True],{i,0,4-1}],shaft[4],cylinder[4,Opacity[.3]]
},PlotRange->{{-2.3,2.3},{-2,3 4+1},{-2,5.5}},Background->GrayLevel[.75],Boxed->False,ImageSize->{500,500},SphericalRegion->True,


(*View control*)
ViewPoint->Dynamic[point],
ViewAngle->Dynamic[angle],
ViewVertical->Dynamic[vertical]

],

{{point,{1.3,-2.4,2}},ControlType->None},
{{angle,N[25 Degree]},ControlType->None},
{{vertical,{0,0,1}},ControlType->None},

{{t,0,"animate"},0,4,.1,ControlType->Animator,AnimationRunning->False},

SaveDefinitions->True,FrameMargins->0]

Bookmark data

bkmrks={"untitled 1":>{angle=0.4363323129985824`,point={1.3`,-2.4`,2},t=0,vertical={0,0,1}},"untitled 2":>{angle=0.39444441130669516`,point={1.5201139523150833`,-2.3708677380535748`,1.8756971345699025`},t=0.1`,vertical={0.126847954944199`,-0.028406294587906947`,1.9976785220384399`}},"untitled 3":>{angle=0.33684854648035006`,point={2.241771028472129`,-2.010104400436957`,1.5440022523451813`},t=0.30000000000000004`,vertical={0.5630607649947584`,-0.04666747526026012`,1.9677464656234736`}},"untitled 4":>{angle=0.27052603546819537`,point={2.8574141985052237`,-1.4406380667659628`,1.0998845661093624`},t=0.5`,vertical={0.9534234312549466`,-0.08085697276986119`,1.9057536280870608`}},"untitled 5":>{angle=0.27052603546819537`,point={3.283885347669315`,-0.6006305774313203`,0.5525757258668715`},t=0.7000000000000001`,vertical={1.505146645647966`,0.009872141496519325`,1.7740890727181766`}},"untitled 6":>{angle=0.27052603546819537`,point={3.0389313043990605`,1.1103058746928465`,0.9910183609630941`},t=0.7000000000000001`,vertical={1.0484280016127296`,0.07908546398063879`,1.8871902036496633`}},"untitled 7":>{angle=0.2268928045391461`,point={2.4393213723193363`,1.5039791207963191`,1.799377127440171`},t=1.1`,vertical={0.21256401535289432`,-0.03333264744824279`,0.9765784525531709`}},"untitled 8":>{angle=0.2268928045391461`,point={2.067924977260541`,1.8727126073620781`,1.9148456278899133`},t=1.1`,vertical={0.27352990089226104`,-0.0426193264988599`,1.9911276390118795`}},"untitled 9":>{angle=0.15533430581550534`,point={1.6100849600959197`,2.1892434972031296`,2.016144670212613`},t=1.4000000000000001`,vertical={0.11281754897283547`,-0.027322984234906693`,0.9932399786437621`}},"untitled 10":>{angle=0.15533430581550534`,point={0.6842732981828281`,3.093638927493323`,1.1879260245031917`},t=1.6`,vertical={0.03914380706432699`,0.2746367625564725`,1.9229462293217556`}},"untitled 11":>{angle=0.1850049028472588`,point={0.9057259036194504`,3.0397637355232483`,1.1787692817979591`},t=1.8`,vertical={0.07969020794269449`,0.13908385272853813`,0.9870689705730986`}},"untitled 12":>{angle=0.1850049028472588`,point={0.9057259036194504`,3.0397637355232483`,1.1787692817979591`},t=2.`,vertical={0.07969020794269449`,0.13908385272853813`,0.9870689705730986`}},"untitled 13":>{angle=0.1850049028472588`,point={-0.5521763614933012`,3.2131639543308648`,0.9059131682434356`},t=2.2`,vertical={-0.26133538559976965`,0.3450063136223427`,1.870345173384547`}},"untitled 14":>{angle=0.1850049028472588`,point={-0.9843287793967399`,3.1092555848871046`,0.9020125065095675`},t=2.4000000000000004`,vertical={-0.46945990398908255`,0.32667348496634707`,1.868215977296616`}},"untitled 15":>{angle=0.16406095200131524`,point={-1.4449027406596322`,2.941851213951926`,0.841289192254282`},t=2.4000000000000004`,vertical={-0.3383201490440595`,0.15666596429173837`,0.9278982985130133`}},"untitled 16":>{angle=0.18675023208442085`,point={-1.4449027406596322`,2.941851213951926`,0.841289192254282`},t=2.6`,vertical={-0.3383201490440595`,0.15666596429173837`,0.9278982985130133`}},"untitled 17":>{angle=0.19373154903306875`,point={-1.6453283606611293`,2.9349000451033516`,-0.3595223370758861`},t=2.8000000000000003`,vertical={-1.4872434203941238`,0.5147011307697631`,1.4519869123757574`}},"untitled 18":>{angle=0.19373154903306875`,point={-2.3955150652476447`,2.1138827525268367`,-1.114902363770539`},t=3.`,vertical={-1.7202375137558128`,0.6418373970888898`,1.1130980678935911`}},"untitled 19":>{angle=0.23387412148779407`,point={-3.2036798383064005`,1.0787261956232044`,-0.15094796621806078`},t=3.`,vertical={-1.5494400585624086`,0.5400728728543522`,1.389305911346094`}},"untitled 20":>{angle=0.23387412148779407`,point={-3.0567227521130174`,-1.336514051089044`,0.5658411508154738`},t=3.4000000000000004`,vertical={-1.9379404345777105`,0.193300562446032`,1.561333202605683`}},"untitled 21":>{angle=0.26005406004522363`,point={-1.8707551568551686`,-2.7291346086115027`,0.7085897481467968`},t=3.5`,vertical={-1.9338166232394345`,-0.11958425222240351`,1.5924906370351555`}},"untitled 22":>{angle=0.26703537699387153`,point={-0.925203121049766`,-2.8922691506628397`,1.492909355896678`},t=3.5`,vertical={-1.5507590589838276`,-0.0875589142615962`,1.7506231007279283`}},"untitled 23":>{angle=0.22689280453914618`,point={1.7537028494932505`,-2.592248697820142`,1.2863798056285858`},t=4.`,vertical={0.2390213175719076`,-0.09470946293304573`,0.9663844614733431`}},
"untitled 24":>{angle=0.4363323129985824`,point={1.3`,-2.4`,2},t=0,vertical={0,0,1}}};

Interpolate the bookmarks

data=Flatten/@bkmrks[[All,2]];

inda=(Interpolation/@Transpose[data]);Clear[t]

Plot[Evaluate[#[t]&/@inda],{t,1,24},Frame->True,Axes->False,AspectRatio->1/4,Filling->0,PlotRange->All]

Hook up the camera to the interpolation paths and take a tour

Manipulate[

Graphics3D[{
Table[piston[i,4,inda[[5]][t],Opacity[.3],True],{i,0,4-1}],shaft[4],cylinder[4,Opacity[.3]]
},PlotRange->{{-2.3,2.3},{-2,3 4+1},{-2,5.5}},Background->GrayLevel[.75],Boxed->False,ImageSize->{500,500},SphericalRegion->True,


(*View control*)
ViewAngle->inda[[1]][t],
ViewPoint->Evaluate[#[t]&/@inda[[2;;4]]],
ViewVertical->Evaluate[#[t]&/@inda[[6;;8]]]

],

{{t,1,"animate"},1,24,ControlType->Animator,AnimationRunning->False,AnimationRate->1.5},

SaveDefinitions->True,FrameMargins->0]

So, What Is Next?

Improvise!—it’s easy with Mathematica

Integration with major standard video and image formats

data=Import["ExampleData/clip.mov","ImageList"]

Import["ExampleData/clip.mov","Elements"]

Frame-by-frame image processing and analysis

data1=ParallelMap[Binarize[#,.6]&,data]

ListAnimate[GraphicsRow[#,ImageSize->650]&/@Transpose[{data1,data}],AnimationRunning->False,AnimationRate->7,FrameMargins->0]

Export["MyVideo.AVI",data1]

Bonus: control the magic cube

See also: Distorted Cube, by Michael Schreiber

p1[θ_]:=RotationTransform[θ,{0,0,1}][{0,2,0}];
p2[θ_]:=RotationTransform[θ+Pi/2,{1,0,1}][{0,2,0}];
p3[θ_]:=RotationTransform[θ+Pi,{1,0,0}][{0,2,0}];
p4[θ_]:=RotationTransform[θ+3Pi/2,{1,0,-1}][{0,2,0}];
Animate[Show[
Graphics3D[{Specularity[White,30],Sphere[s p1[θ],.4],Sphere[s p2[θ],.4],Sphere[s p3[θ],.4],Sphere[s p4[θ],.4]}],
ParametricPlot3D[Flatten[Partition[RotateLeft[{x ,y,-Pi,x,y,Pi },#],3]&/@Range[0,2],1]+n(Sin[x+ y+a]+Cos[x+ y+a]),{x,-Pi,Pi},{y,-Pi,Pi},Mesh->False,PlotStyle->Directive[Opacity[.8],Specularity[White,20]],PlotPoints->20]
,SphericalRegion->True,PlotRange->6,Boxed->False,Background->Black,ImageSize->500,
ViewAngle->0.3,ViewPoint->{1.9336790674757351`,-2.2404857124242743`,1.6404600075676545`},ViewVertical->{0.10439769478013806`,-0.07653264248249605`,0.9915865448659736`},
Lighting->{{"Point",Red,s p1[θ]},{"Point",Green,s p2[θ]},
{"Point",Blue,s p3[θ]},{"Point",Yellow,s p4[θ]}}],
{{θ,Pi,"rotation"},0,2Pi,AnimationRate->.1},
{{a,0,"flow"},-Pi,Pi,AnimationRate->.4},
{{n,.1,"fluidity"},0,.2},
{{s,2.5,"lights"},.1,4},
SaveDefinitions->True, AnimationRunning->False,FrameMargins->0]