Manipulate… Anything

Lou D’Andria
Wolfram Research

Manipulate is a new function built into the upcoming version of Mathematica that enables users to create dynamic user interfaces as easily as they might create a table or a plot. In this talk, we will give a detailed demonstration of Manipulate, emphasizing its flexibility and how tightly integrated it is with Mathematica notebooks, typesetting, and graphics.

Introduction

In the upcoming version of Mathematica, there is a suite of dynamic interactive controls built right into the front end. There are low-level primitives like Dynamic that allow you to build up complicated dialogs. But there are also high-level functions that let you build entire interfaces with just a few keystrokes without needing to know anything about the lower level stuff.

In this talk, we'll focus on one such high-level function: Manipulate. We'll look at Manipulate's syntax and options, and then look at typical and unusual use, as well as the way Manipulate interacts with other features of Mathematica.

As Easy As… Table

In its simplest form, Manipulate's syntax is just like Table. You specify a body, a variable, and a domain for the variable.

Table[x,{x,1,99,2}]

The difference is that Table pre-generates every element of the output, while Manipulate generates one output at a time in an interface that lets you explore the output space.

Manipulate[x,{x,1,99,2}]

Note

You can interact with Manipulate's output even if the kernel is busy doing other evaluations.

Do[1,{1*^7}]//Timing

What Can You Manipulate?

Anything!! Manipulate can be used to interact with anything that can generated as output.

Expressions

Explore Fibonacci numbers or Fibonacci polynomials.

Manipulate[If[poly,Fibonacci[n,z],Fibonacci[n]],{poly,{True,False}},{n,1,100,1}]

Strings

Get help for the options of a common function.

Manipulate[
ToExpression[SymbolName[option]<>"::usage"],
{option,First /@ Options[Plot]}]

Graphics, indirect

The fact that graphics are actually output and not just generated as a side-effect is central to being able to use Manipulate to interact with them.

Manipulate[Plot[Sin[n x],{x,0,2π},PlotStyle->color],{n,1,10},{color,Black}]

Graphics, direct

In fact, there are some controls that you can manipulate directly from within graphics.

x=.;Manipulate[Plot[Evaluate[Fit[pts, {x,x^2,x^3},{x}]],{x,0,1}, PlotRange -> 1], {{pts,RandomReal[1,{4,2}]}, Locator}]

Sounds

Based on Mike Pilat's vector sound work:

Manipulate[tuneIn[song,instrument,tempo,echo,echoOffset],
{song,songList},{instrument,instrumentList},{{tempo,120},40,200},{echo,{False,True}},{echoOffset,.1,1,.1}]

Variable Scoping

The local variables in Manipulate are lexically scoped, much like scoping done by Module. Here are two different Manipulate expressions which use the same variable name, but they don't conflict.

Manipulate[Fibonacci[n,z],{n,1,100,1}]
Manipulate[Plot[Sin[n x],{x,0,2π}],{n,1,10}]

And neither of these variables use the global variable of the same name.

n

Copy and Paste

The scoping actually happens at the box level in the front end at the instant the output is displayed. Pasting Manipulate output scopes variables distinct from the original copy.

File Saving

The current values of the local variables are stored in the file itself, and the state of those variables is refreshed when the file is reopened.

Basic Use

Manipulate[body, variableSpecs, options]

Remember the Polyhedron Explorer? That was quite difficult to develop, and also difficult to try to learn from its example.

How many lines of C code would be needed to generate something like that?

Manipulate Polyhedra

The following Manipulate recreates much of the utility of the Polyhedron Explorer, and does so as essentially a one-liner:

Needs["Graphics`Polyhedra`"]
Needs["Graphics`Shapes`"]
Manipulate[
ShrinkPolygons[OpenTruncate[Stellate[Polyhedron[shape],stellate],truncate],shrink],
{shape,Polyhedra},
{{stellate,1},0.1,2},
{{truncate,0},0,0.5},
{{shrink,1},0.1,2},
ControlPlacement->Bottom, TrackedSymbols -> "Local"]

Things to notice

Manipulate…

… uses system appearance of sliders, popup menus, and other controls, so it will look right on Mac, Windows, etc.

… automatically uses sliders when sliders are appropriate, popup menus when they're appropriate, etc.

… lets you specify initial values of variables: {{variable, initialvalue}, spec...}

… lets you put controls at the top, bottom, left, right, or some combination of locations

… lets you interact directly with things in the content area: rotate, pan, etc

… lets you extract the input which generates the current display

… lets you easily start animations

Most importantly, Manipulate doesn't require that you know anything about the mechanics of hooking controls up to variables. You don't have to become an interface programmer to create interfaces. If you know how to use Table, you already know how to use Manipulate.

Variable Specifications

The type of controls used by Manipulate are determined automatically depending on the form of the variable specifications.

Style[Grid[{
{Style["Variable Specification", Bold], Style["Default Control Type", Bold]},
{{var,xmin,∞}, Animator},
{{var, xmin, xmax}, Manipulator},
{{var,xmin,xmax,Δx},Manipulator},
{{var,{xmin,ymin},{xmax,ymax}}, Slider2D},
{{var,{xmin,ymin},{xmax,ymax},{Δx,Δy}}, Slider2D},
{{var,{True, False}}, Checkbox},
{{var, list}, "PopupMenu or SetterBar"},
{{var, color}, ColorSlider},
{{var, other}, InputField}
}, ItemSize -> {"Columns" -> {{Scaled[0.5]}}},Background-> {"Rows" -> {{White, GrayLevel[0.9]}}}, Dividers->{"ColumnsIndexed"->{2 -> True},"RowsIndexed"->{2 -> True}}], FontFamily->"Helvetica", TextAlignment -> Center]

By default, the initial value of the variable var is taken to be the first element of the specified range, and the label for the control uses the name of the variable var.

Custom initial value: {{var,init}, spec}

Custom label: {{var, init, label}, spec}

The variable specification list itself can also include options: {var, spec, opt -> val, opt -> val, …}

Variable Specification Options

ControlType

You can override the automatically chosen controls by specifying an alternate ControlType either for an individual control or globally for the whole Manipulate.

Style[Grid[{
{Style["Variable Specification", Bold], Style["Valid ControlType Settings", Bold]},
{{var, xmin, xmax}, Row[{Animator, InputField, Style[Manipulator, Bold], Slider, Slider2D,VerticalSlider, None}, ","]},
{{var,xmin,xmax,Δx},Row[{Animator, InputField, Style[Manipulator, Bold], PopupMenu, RadioButtonBar, SetterBar, Slider, Slider2D,VerticalSlider, None}, ","]},
{{var,{xmin,ymin},{xmax,ymax}}, Row[{InputField, Locator, Style[Slider2D, Bold],None}, ","]},
{{var,{xmin,ymin},{xmax,ymax},{Δx,Δy}}, Row[{InputField, Locator, Style[Slider2D, Bold],None}, ","]},
{{var,{True, False}}, Row[{Animator, Style[Checkbox, Bold], CheckboxBar, InputField, Manipulator, Opener, PopupMenu, RadioButtonBar, SetterBar,Slider, TogglerBar, VerticalSlider, None}, ","]},
{{var, list}, Row[{Animator, Checkbox, CheckboxBar, InputField, Manipulator, Style[PopupMenu, Bold], RadioButtonBar, Style[SetterBar, Bold], Slider, TogglerBar, VerticalSlider, None}, ","]},
{{var, color}, Row[{ColorSetter, Style[ColorSlider, Bold], InputField, None}, ","]},
{{var, other}, Row[{Style[InputField, Bold], None}, ","]}
}, Alignment->{Center,Center},ItemSize -> {"Columns" -> {{Scaled[0.5]}}},Background-> {"Rows" -> {{White, GrayLevel[0.9]}}}, Dividers->{"ColumnsIndexed"->{2 -> True},"RowsIndexed"->{2 -> True}}], FontFamily->"Helvetica", TextAlignment -> Center]

Example

Manipulate[boolean,
{boolean,{True,False}},
{boolean,{True,False},ControlType->Slider},
Delimiter,
{boolean,{True,False},ControlType->SetterBar},{boolean,{True,False},ControlType->PopupMenu}]

Note

Yes, you can have more than one control for the same variable.

Yes, you can use Delimiter to draw a rule between controls.

Annotations and Grouping

In addition to specifying variables, you can specify annotations interleaved with the controls.

Style[Grid[{
{Style["Annotation", Bold], Style["Description", Bold]},
{Delimiter, "separate controls with a delimiter line"},
{String, "an arbitrary string"},
{Style, "an arbitrarily styled expression"},
{Row, "a sequence of expressions"},
{Text,"a bit of text"},
{TextCell, "arbitrary text in an inline cell"},
{ExpressionCell, "an arbitrary expression in an inline math cell"},
{Experimental`ControlBlock, "group sets of controls into labeled blocks"}
}, ItemSize -> {"Columns" -> {{Scaled[0.5]}}},Background-> {"Rows" -> {{White, GrayLevel[0.9]}}}, Dividers->{"ColumnsIndexed"->{2 -> True},"RowsIndexed"->{2 -> True}}], FontFamily->"Helvetica", TextAlignment -> Center]

Annotation example

Manipulate[Graphics[{Gray,Rectangle[],Black,Rotate[Rectangle[],θ,center],Red,PointSize[0.03],Point[center]}, PlotRange->2, Axes->True],
"The rotation variable runs from 0 to 2π:",
{θ,0,2π, ControlType -> Animator},
Delimiter,
"Rotation happens around whatever center the user specifies",
{{center,{0,0}},{0,0},{1,1}, ControlType -> Slider2D}
]

Experimental`ControlBlock example

Manipulate[
  Plot[amp f[freq x],{x,0,6},PlotStyle->{color,Dashing[dashing],Thickness[thickness]},Axes->axes,Frame->frame,AxesOrigin->axesorigin,PlotLabel->f],
  {f, {Sin, Cos, Tan}},

  Experimental`ControlBlock["Function Variations",
  {freq, 1, 5},
  {amp, 1, 5}],

  Experimental`ControlBlock["Axes and Frames",
  {axes, {True, False}},
  {frame, {False, True}},
  {axesorigin, {0, 0}, {6, 1}}],

  Experimental`ControlBlock["Plot Style",
  {color, Blue},
  {dashing, 0, 0.1},
  {thickness, 0.001, 0.1}] ]

Manipulate Options

Options for variable specifications can also be given as options to Manipulate as a whole. Manipulate also has other options. We'll look at the important ones.

Options[Manipulate]

Manipulate Options

Initialization

You can use the Initialization option to Manipulate to specify some code that gets evaluated when the Manipulate output is first displayed, for instance in a new Mathematica session.

Manipulate Polyhedra, Revisited

Manipulate[
ShrinkPolygons[OpenTruncate[Stellate[Polyhedron[shape],stellate],truncate],shrink],
{shape,Polyhedra},
{{stellate,1},0.1,2},
{{truncate,0},0,0.5},
{{shrink,1},0.1,2},
ControlPlacement->Bottom, TrackedSymbols -> "Local",Initialization :> (Needs["Graphics`Polyhedra`"];Needs["Graphics`Shapes`"])]

Manipulate Options

SaveDefinitions

The SaveDefinitions option determines whether external definitions required to display the content area are stored with the Manipulate output.

Riemann surface example from Michael Trott

Manipulate[Module[{F=makeRotationMatrix4D[{φxy,φxu,φxv,φyu,φyv,φuv}].{r Cos[φ],r Sin[φ],(r^(1/3)) Cos[φ/3],(r^(1/3)) Sin[φ/3]}},ParametricPlot3D[Evaluate[Most[F]],{r,(10^(-8)),1},{φ,-3 π,3 π},Mesh->False,MaxRecursion->0,PlotPoints->{12,60},PlotRange->All,Boxed->False,Axes->False,ColorFunctionScaling->False,ColorFunction->
(Evaluate[{Hue[0.76 ArcTan[F[[-1]]/2]/(Pi/2)]}/.{r->#4,φ->#5}]&)]],{{φxy,0,(Subscript[ϕ, x,y])},-π,π},{{φxu,0,(Subscript[ϕ, x,u])},-π,π},{{φxv,0,(Subscript[ϕ, x,v])},-π,π},{{φyu,0,(Subscript[ϕ, y,u])},-π,π},{{φyv,0,(Subscript[ϕ, y,v])},-π,π},{{φuv,0,(Subscript[ϕ, u,v])},-π,π},SaveDefinitions->True]

Manipulate Options

TrackedSymbols

The TrackedSymbols option allows you to hint the dynamic tracking mechanism, only watching variables that you care about.

By default Manipulate tracks all variables which are explicitly present in its first argument.

Manipulate[{x,y},{x,0,1}]

Slider[Dynamic[y]]

However, you can override this behavior by using the TrackedSymbols option.

Manipulate[{x,y},{x,0,1}, TrackedSymbols :> {x}]

This is especially useful if you have global variables which change automatically, or which change while you're interacting with the Manipulate output.

Manipulate Options

LocalizeVariables

By default, Manipulate localizes the specified variables, and so it cannot affect the global version of those variables even if it wanted to.

{Manipulate[x,{x,0,1}], Dynamic[x]}

However, you can turn off this localization with the LocalizeVariables option.

{Manipulate[x,{x,0,1}, LocalizeVariables->False], Dynamic[x]}

This is especially useful in conjunction with using None as the first argument of Manipulate, to quickly build up sets of controls that affect variables globally.

Manipulate[None, {x,0,1},{y,0,1},{z,0,1}, LocalizeVariables->False]//CreatePalette;
Dynamic[{x,y,z}]

Manipulate Use

Some typical and atypical examples of Manipulate.

Demonstrations

By far the heaviest use of Manipulate to date is in conjunction with the Demonstrations Site project. Each Demonstration is a Manipulate which focuses on illuminating a single concept. There are hundreds of Demonstrations covering a very wide array of technical and non-technical subjects.

You can see these yourself, or even contribute your own Demonstrations to the project, at http://demonstrations.wolfram.com .

You can learn more about Demonstrations at the talk or the hands-on sessions, tomorrow. Talk to Jeff Bryant, Joe Bolte, and a number of other knowledgeable people.

Manipulate Use

Animations

There are several ways to use Manipulate to generate animations.

• Use the animation controls provided by the default control types.

• Use the Animate function (which actually creates a Manipulate with particular settings).

• Use the built-in autorun animation, which will explore the Manipulate's computational space either one variable at a time, or all at once. (This is used by flash export and the Demonstrations site.)

• Use the built-in bookmarking capabilities, which can automatically animate between these as key frames.

Smiley example from Demonstrations site

Manipulate[Deploy[Graphics[{color,Disk[{0,0},1],Black,MapIndexed[{Rotate[Disk[#1,{s+eyeshape,s-eyeshape}],((-1))^(First[#2]) eyerotation,#1],Black,Thickness[.008],Line[{#1+{-.13,ey-er ((-1))^(First[#2])},#1+{.13,ey+er ((-1))^(First[#2])}}]}&,{r {Sin[t],Cos[t]},r {-Sin[t],Cos[t]}}],Thickness[.02],First[Plot[-.35+a x+b x^2+c x^3,{x,-0.4`,0.4`}]]},PlotRange->All]],{{r,.5,"Eye distance"},0,1.1},{{t,.8,"Eye positions"},0,π},{{s,.1,"Eye size"},.1,.5},{{a,0,"Mouth rotation"},-1,1},{{b,.6,"Frown/Smile"},-1.2`,1.2`},{{c,0,"Mouth twist"},-2,2},{{ey,0.16`,"Eyebrow position"},.05,.3},{{er,0,"Eyebrow rotation"},-1,1},{{eyeshape,0,"Eye shape"},-0.07,0.07},{{eyerotation,0,"Eye rotation"},-9/3,9/3},{color,Yellow},ControlType -> None,Bookmarks->{"happy":>{r=0.592`,t=0.58`,s=0.0955`,a=0,b=1.2`,c=0,ey=0.16`,er=0,eyeshape=0,eyerotation=0,color=Yellow},"sly":>{r=0.4`,t=0.58`,s=0.0955`,a=0,b=1.2`,c=-0.855`,ey=0.16`,er=0,eyeshape=0,eyerotation=0,color=Yellow},"evil":>{r=0.4`,t=0.58`,s=0.0955`,a=0,b=1.1300000000000001`,c=1.3`,ey=0.16`,er=-0.10199999999999998`,eyeshape=0,eyerotation=0,color=Purple},"angry":>{r=0.308`,t=1.445`,s=0.0365`,a=0,b=-0.715`,c=1.3`,ey=0.16`,er=-0.10199999999999998`,eyeshape=0,eyerotation=0,color=Red}}, AutorunSequencing -> Automatic]

Manipulate Use

Interdependent Variables

Variable specifications can depend on other local variables.

Manipulate[Graphics[{Polygon[{{0,0},{x,-y},{x,y},{-x,-y},{-x,y}}],Dashing[0.03],Red,Line[{{{-1,-1},{1,1}},{{-1,1},{1,-1}}}]},PlotRange->1],{{x,0.5},0,1},{{y,0.5},0,x}]

Be aware of circular references!

This can lead to circular references, which work exactly as they should, but which may take some effort to understand.

Manipulate[Grid[{
{"","value","endpoints"},
{"x slider",x,{0,y}},
{"y slider",y,{0,x}}},Frame->All,ItemSize -> 10],{{x,0.5},0,y},{{y,0.5},0,x}]

Manipulate Use

Locators for Direct Manipulation

When interacting with graphics, it can be much more natural to click on and interact with the graphic itself, rather than interacting with some control off to the side. For that, we have Locator-style variables in Manipulate.

Manipulate[Graphics[Table[{Hue[i/n],Circle[i  pt/n, (n-i)/n]},{i,1,n}], PlotRange->1],{n,10,100,1},{{pt,{0,0}}, Locator}]

Sine example from Abby Brown

IllustratingSin[]

Triangle example from Oleksandr Pavlyk

"The point P is constrained to move so that ∠PBA+∠PCA=∠PBC+∠PCB. This demonstration shows that P moves along the brown circle with center at the intersection of the circumcircle and the bisector of the angle A."

IMOTriangleProblem[]

Manipulate Use

Nesting

You can nest calls to Manipulate.

Circle inversion example from Michael Trott

Manipulate[Manipulate[inversionGraphics[n, o, Tan[r], α], 
   {{r, 0.4}, 0, Pi/2}, {{α, 0}, -2, 2}], {{o, 2}, {1, 2}}, 
  {{n, 4}, {2, 4, 6, 8, 10, 12}}]

Manipulate Use

Integration With Typesetting

Manipulate is inert to evaluation, but then is typeset as the user interface you see.

Manipulate[x,{x,0,1}]

FullForm[%]

That means that you can use the Convert To submenu to go between the Manipulate input expression and the rendered interface.

Manipulate Use

Using Output As Input

You can use DynamicSetting to cause Manipulate's output to evaluate to the value shown in its content area.

DynamicSetting[Manipulate[x,{x,0,1}]]

Or you can do this manually by using the Setting function.

Manipulate[x,{x,0,1}]

Manipulate Use

Controlling the Controls

Unfortunately, using the mouse to interact with Manipulate's output only lets you adjust one parameter at a time. There are controllers already in existence that let you change the value of more than one parameter at a time.

Controllers

…

By default, Manipulate and ControllerManipulate output detects whether a controller is present, and automatically associates controller axes with particular Manipulate variables.

Parametric tree example from Theo Gray

The only difference between Manipulate and ControllerManipulate are a few default option settings.

ControllerManipulate[
Graphics[NestList[doTwins[#,thicknessShrinkage,a1,a2,s1,s2]&,{Thickness[originalThickness],Line[{{{0,0},{0,1}}}]},generations],AspectRatio->Automatic,PlotRange->{{-3,3},{0,6}},ImageSize->600],
{{a1,-.3},-Pi/2,Pi/2},
{{a2,.3},-Pi/2,Pi/2},
{{s1,.8},0,1},
{{s2,.8},0,1},
{{generations,7,"Generations"},1,10,1},
{{originalThickness,0.02,"Thickness"},0.,0.2},
{{thicknessShrinkage,0.7,"Thinning"},0.1,1.1},
ControlPlacement->Left]

Overriding the default bindings

If you want to override this automatic binding, you can bind a particular Manipulate local variable to a given controller axis, replace {var, spec} for that variable with axisName -> {var, spec}, where axisName is the string name of the given controller axis.

Typical Axis Names:
	one dimensional:	"X1", "Y1", "Z1", "X2", "Y2"
	two-dimensional:	"XY1", "XY2"
	buttons:		"Button 1", "Button 2"

What Manipulate Isn't

Manipulate…

… is not a control layout engine.

… will not make slow things fast.

… will not find interesting parts of a computational space for you.

Implementation Details

Manipulate is written entirely in top-level Mathematica code. No Java. You can build things like Manipulate yourself in Mathematica code if you want to -- more on that tomorrow -- but we did Manipulate so you don't have to!

Building up Manipulate

The boxes that display as user interface controls in the front end are generated by dedicated functions, like Slider and Panel.

Panel[Column[{Slider[Dynamic[x]], Dynamic[x]}]]

Manipulator is built up from Slider and other control objects. The scoping behavior of Manipulate is handled by the function DynamicModule.

DynamicModule[{x},Panel[Column[{Slider[Dynamic[x]],Item[Dynamic[x], Background -> White, FrameStyle -> GrayLevel[0.8]]}],FrameMargins -> 10, DefaultBaseStyle -> {}]]

Etc.

Many more details in my talk tomorrow: To Manipulate and Beyond.

Conclusion

Manipulate brings dynamic user interfaces to the next version of Mathematica in a way that is very flexible and accessible. Its tight integration with typesetting and Mathematica notebooks makes it ideal for exploring computational spaces, regardless of how sophisticated the user happens to be. The fact that it was written entirely in top-level Mathematica code should encourage Mathematica programmers everywhere!

Many thanks to all those who have provided examples for this talk. Please go to theirs!!

Questions?

Implementation

Off[General::obspkg]
Off[General::obspkgfn]

Manipulate Tree (Controller example)

Theo Gray

Needs["Geometry`Rotations`"]

twinOneLine[{start_,end_},t_,a1_,a2_,l1_,l2_]:={{end,end+l1 Rotate2D[end-start,a1,{0,0}]},{end,end+l2 Rotate2D[end-start,a2,{0,0}]}};

twinLine[Line[lines_],t_,a1_,a2_,l1_,l2_]:=Line[Flatten[Map[twinOneLine[#,t,a1,a2,l1,l2]&,lines],1]];

twinLine[Thickness[th_],t_,a1_,a2_,l1_,l2_]:=Thickness[th t];

doTwins[lines_,t_,a1_,a2_,l1_,l2_]:=Flatten[Map[twinLine[#,t,a1,a2,l1,l2]&,lines]];

Manipulate[
Graphics[NestList[doTwins[#,thicknessShrinkage,a1,a2,s1,s2]&,{Thickness[originalThickness],Line[{{{0,0},{0,1}}}]},generations],AspectRatio->Automatic,PlotRange->{{-3,3},{0,6}},ImageSize->600],
"X1"->{{a1,-.3},-Pi/2,Pi/2},
"X2"->{{a2,.3},-Pi/2,Pi/2},
"Y1"->{{s1,.8},0,1},
"Y2"->{{s2,.8},0,1},
{{generations,7,"Generations"},1,10,1},
{{originalThickness,0.02,"Thickness"},0.,0.2},
{{thicknessShrinkage,0.7,"Thinning"},0.1,1.1},
ControlPlacement->Left]

Parallelogram Manipulate (Not used)

Theo Gray

angleFromSides[a_,b_,c_]:=ArcCos[(((a^2)+(b^2)-(c^2))/(2 a b))]

mag[v_]:=Sqrt[Total[(v^2)]]

Manipulate[
Graphics[{
Line[{{0,0},p1,p1+p2,p2,{0,0}}],
Line[{{0,0},p1+p2}],
Line[{p1,p2}],
Style[{
Text["A",p1,{1.2,0}],
Text["B",p1+p2,{-1.2,0}],
Text["C",p2,{-1.2,0}],
Text["D",{0,0},{1.2,0}],
Text["E",(p1+p2)/2,{0,1.5}]
},FontSize->14,FontWeight->Bold],
Style[{
Text[NumberForm[mag[p2],3],p1+p2/2,{0,-1.1}],
Text[NumberForm[mag[p2],3],p2/2,{0,1.1}],
Text[NumberForm[mag[p1],3],p1/2,{1.1,0}],
Text[NumberForm[mag[p1],3],p1/2+p2,{-1.1,0}],

Text[NumberForm[angleFromSides[mag[p1+p2]/2,mag[p2-p1]/2,mag[p2]]/Degree,3],(p1+p2)/2,{0,-2}]
},FontSize->10]
},PlotRange->{{-1.3,3.3},{-1.1,2.3}},ImageSize->700],
"XY1Absolute"->{p1,{-1,0},{1,1}},
"XY2Absolute"->{p2,{0,-1},{2,2}},
ControlPlacement->Left
]

Light Box (ControlPlacement example)

Chris Hill

FloorWall[div_,extent_]:=Module[{step=N[extent/(div-1)]},Polygon[Flatten[Table[{{i,j,0.},{i+step,j,0.},{i+step,j+step,0.},{i,j+step,0.}},{i,0.,extent-step/2,step},{j,0.,extent-step/2,step}],1]]];

Swap[e_,{a_,b_,c_}]:=(e/.v:{__Real}:>{v[[a]],v[[b]],v[[c]]});

TransX[e_,off_]:=(e/.{u_Real,v_Real,w_Real}:>{u+off,v,w});

Trans[e_,off_]:=(e/.{u_Real,v_Real,w_Real}:>{u,v,w}+off);

Scal[e_,s_]:=(e/.{u_Real,v_Real,w_Real}:>{u,v,w}*s);

makeFloor[div_,extent_]:=Module[{},
floor1=TransX[FloorWall[div,extent],0];
floor2=TransX[FloorWall[div,extent],extent];
floor3=TransX[FloorWall[div,extent],-extent];
backsplash=Trans[Scal[Swap[FloorWall[div,extent],{1,3,2}],{3,1,1}],{-1,0,0}]];

makeFloor[15,1];

ThreeWalls[div_,extent_]:=Swap[FloorWall[div,extent],#]&/@{{1,2,3},{2,3,1},{3,2,1}};

ThreeFloors[div_,extent_]:=TransX[FloorWall[div,extent],#]&/@{0,extent,-extent};

walls=ThreeWalls[50,1];

Manipulate[With[{lightpos={x,y,z},lightpos1={x1,y1,z1},lightpos2={x2,y2,z2}},Graphics3D[{EdgeForm[None],{White,Line[{{0,-.1,0.01},{0,1.1,0.01}}],Line[{{1,-.1,0.01},{1,1.1,0.01}}]},{Lighting->{{Red,{{lightpos,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos]},floor1},{Lighting->{{Green,{{lightpos1,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos1]},floor2},{Lighting->{{Blue,{{lightpos2,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos2]},floor3},
{Lighting->{{Red,{{lightpos,{0,0,0}},0}},{Green,{{lightpos1,{0,0,0}},0}},{Blue,{{lightpos2,{0,0,0}},0}}},backsplash}},ViewPoint->{2,1.6,1.9},PlotRange->{{-1,2},{0,1},{0,1}}]],{{y,0.5},0,1},{{z,0.2},0.1,1},{{y1,0.5},0,1},{{z1,0.2},0.1,1},{{y2,0.5},0,1},{{z2,0.2},0.1,1},{{x,0.5},-1,2},{{x1,1.5},-1,2},{{x2,-.5},-1,2},ControlPlacement->Left]

Springs (Breaking out example)

Michael Trott

springLine[{p1_, p2_}, w_] := Module[{q1 = p1 + (1*(p2 - p1))/6, 
    q2 = p2 + (1*(p1 - p2))/6, dq, l, n}, dq = q2 - q1; l = Norm[dq]; 
    n = (Reverse[dq]*{-1, 1})/l; (Line[{p1, q1, ##1, q2, p2}] & ) @@ 
     Table[q1 + (k/w + 1/(2*w))*(q2 - q1) + 
       (-1)^k*n*Min[1/(8*l), 1/(w/2)], {k, 0, w - 1}]]

springForce[{p1_, p2_}, α_] := 
  ((p2 - p1)*(Sqrt[(p1 - p2) . (p1 - p2)] - 1)^α)/
   Sqrt[(p1 - p2) . (p1 - p2)]

neighbors[{x[i_, j_][t_], y[i_, j_][t_]}] := 
   {{x[i + 1, j][t], y[i + 1, j][t]}, {x[i - 1, j][t], 
     y[i - 1, j][t]}, {x[i, j + 1][t], y[i, j + 1][t]}, 
    {x[i, j - 1][t], y[i, j - 1][t]}};

equationsOfMotion[n_, {𝓀_, α_, γ_, ϵ_}] := 
   Flatten[Table[{Thread[D[{x[i, j][t], y[i, j][t]}, t] == 
         {vx[i, j][t], vy[i, j][t]}], 
       Thread[D[{vx[i, j][t], vy[i, j][t]}, t] == 
         -((γ*{vx[i, j][t], vy[i, j][t]}*Sqrt[vx[i, j][t]^2 + 
                vy[i, j][t]^2]^ϵ)/Sqrt[vx[i, j][t]^2 + 
              vy[i, j][t]^2]) + 𝓀*Total[
            (springForce[{{x[i, j][t], y[i, j][t]}, #1}, α] & ) /@ 
             neighbors[{x[i, j][t], y[i, j][t]}]]]}, {i, 1, n - 2}, 
      {j, 1, n - 2}] /. {x[0, j_][_] :> 0, y[0, j_][_] :> j, 
      x[n - 1, j_][_] :> n - 1, y[n - 1, j_][_] :> j, 
      x[j_, 0][_] :> j, y[j_, 0][_] :> 0, x[j_, n - 1][_] :> j, 
      y[j_, n - 1][_] :> n - 1, vx[0, j_][_] :> 0, vy[0, j_][_] :> 0, 
      vx[n - 1, j_][_] :> 0, vy[n - 1, j_][_] :> 0, 
      vx[j_, 0][_] :> 0, vy[j_, 0][_] :> 0, vx[j_, n - 1][_] :> 0, 
      vy[j_, n - 1][_] :> 0}];

solveEquationsOfMotion[xyInits_, vxyInts_, {𝓀_, α_, γ_, ϵ_}, 
   T_] := Module[{n = Length[xyInits] + 2}, 
   {Table[{x[i, j], y[i, j]}, {i, 1, n - 2}, {j, 1, n - 2}], 
     Table[{vx[i, j], vy[i, j]}, {i, 1, n - 2}, {j, 1, n - 2}]} /. 
    NDSolve[Flatten[{equationsOfMotion[n, {𝓀, α, γ, ϵ}], 
        MapThread[Equal, {Table[{x[i, j][0], y[i, j][0]}, 
           {i, 1, n - 2}, {j, 1, n - 2}], xyInits}, 3], 
        MapThread[Equal, {Table[{vx[i, j][0], vy[i, j][0]}, 
           {i, 1, n - 2}, {j, 1, n - 2}], vxyInts}, 3]}], 
      Flatten[Table[{x[i, j], y[i, j], vx[i, j], vy[i, j]}, 
        {i, 1, n - 2}, {j, 1, n - 2}]], {t, 0, T}][[1]]]

springGraphics[ndsol_, t_] := Module[{dQ, n, mS}, 
   n = Length[ndsol[[1]]] + 2; xyValues = 
     Table[Which[i == 0, {0, j}, i == n - 1, {n - 1, j}, j == 0, 
       {i, 0}, j == n - 1, {i, n - 1}, True, {ndsol[[1,i,j,1]][t], 
        ndsol[[1,i,j,2]][t]}], {j, 0, n - 1}, {i, 0, n - 1}]; 
    mS[{i1_, j1_}, {i2_, j2_}] := 
     If[TrueQ[dQ[Sort[{{i1, j1}, {i2, j2}}]]], {}, 
      dQ[Sort[{{i1, j1}, {i2, j2}}]] = True; 
       springLine[{xyValues[[j1,i1]], xyValues[[j2,i2]]}, 12]]; 
    Graphics[{{PointSize[0.2/n], Gray, Table[Point[{i, 0}], 
        {i, 1, n - 2}], Table[Point[{i, n - 1}], {i, 1, n - 2}], 
       Table[Point[{0, j}], {j, 1, n - 2}], Table[Point[{n - 1, j}], 
        {j, 1, n - 2}]}, {PointSize[0.2/n], Black, 
       Table[Point[xyValues[[j + 1,i + 1]]], {i, 1, n - 2}, 
        {j, 1, n - 2}]}, Table[{Thickness[0.002], Black, 
        mS[{j + 1, i + 1}, {j + 1, i}], mS[{j + 1, i + 1}, 
         {j + 1, i + 2}], mS[{j + 1, i + 1}, {j, i + 1}], 
        mS[{j + 1, i + 1}, {j + 2, i + 1}]}, {i, 1, n - 2}, 
       {j, 1, n - 2}]}, PlotRange -> All, Frame -> True, 
     FrameTicks -> None, PlotRangeClipping -> False]]

ManipulateSprings[]:=Manipulate[DynamicModule[{pt, innerPositions, locators, 
    allSpringPointPairs, nds, T = 100}, 
   xyValues = (DeleteCases[#1, {0, 0} | {0, n - 1} | {n - 1, 0} | 
         {n - 1, n - 1}] & )[Flatten[Table[{i, j}, {j, 0, n - 1}, 
        {i, 0, n - 1}], 1]]; innerPositions = 
     Dynamic /@ Flatten[Table[pt[{i, j}], {j, 1, n - 2}, 
        {i, 1, n - 2}], 1]; locators = Locator /@ innerPositions; 
    Do[pt[{i, j}] = {i, j}, {j, 0, n - 1}, {i, 0, n - 1}]; 
    allSpringPointPairs = 
     Union[Sort /@ Flatten[Table[{{{j, i}, {j - 1, i}}, 
          {{j, i}, {j + 1, i}}, {{j, i}, {j, i - 1}}, 
          {{j, i}, {j, i + 1}}}, {j, 1, n - 2}, {i, 1, n - 2}], 2]]; 
    Row[{Graphics[{Dynamic[(springLine[pt /@ #1, 12] & ) /@ 
          allSpringPointPairs], {PointSize[0.1/n], GrayLevel[0.8], 
         Point /@ xyValues}, locators}, Frame -> True, 
       ImageSize -> 400, FrameTicks -> None, PlotRangeClipping -> 
        False, PlotRange -> {{-2^(-1), n - 1/2}, 
         {-2^(-1), n - 1/2}}], Button["Relax!", 
       nds = solveEquationsOfMotion[Table[pt[{i, j}], {i, 1, n - 2}, 
           {j, 1, n - 2}], Table[{0, 0}, {n - 2}, {n - 2}], 
          {𝓀, α, γ, ε}, T]; CreatePalette[Animate[springGraphics[nds, 
           t], {t, 0, T, 0.25}, DisplayAllSteps -> True]],ImageSize -> Automatic]}]], 
  {{n, 3}, {3, 4, 5, 6, 7, 8}}, {{𝓀, 1}, 0.01, 3}, 
  {{α, 1}, 0.01, 4}, {{γ, 0.1}, 0.01, 4}, {{ε, 1}, 0.01, 4}]

Parametric Spheres (Bookmarks example)

Michael Trott

Manipulate[
Graphics3D[Table[{SurfaceColor[Hue[f t/(2 Pi)]],
                 Sphere[{Cos[α t], Sin[β t], Sin[γ t]}, r]}, 
                 {t, 0., 2. Pi, 2Pi/n}], Boxed -> False],
                 {{f, 1}, 0, 20}, 
                 {{r, 0.25}, 0, 2}, {{n, 120}, 1, 360, 1}, 
                 {{α, 3}, 0, 8}, {{β, 5}, 0, 8}, {{γ, 4}, 1, 8}]

Parametric EllipticTheta (AutoAction example)

Michael Trott

Manipulate[ParametricPlot[{Re[EllipticTheta[a, x,qr Exp[I qφ]]],Im[EllipticTheta[a, x,qr Exp[I qφ]]]},{qφ,-Pi+10^-4,Pi-10^-4},Axes->False],{{a,4},{1,2,3,4}},{{qr,0.94,Abs[q]},0,0.95},{{x,1},-Pi,Pi}]

Riemann Surface (SaveDefinitions example)

Michael Trott

makeRotationMatrix4D[{φxy_,φxu_,φxv_,φyu_,φyv_,φuv_}]:=
  Fold[Dot,IdentityMatrix[
      4],{{{Cos[φxy],Sin[φxy],0,0},{-Sin[φxy],
          Cos[φxy],0,0},{0,0,1,0},{0,0,0,1}},{{Cos[φxu],0,
          Sin[φxu],0},{0,1,0,0},{-Sin[φxu],0,
          Cos[φxu],0},{0,0,0,1}},{{Cos[φxv],0,0,
          Sin[φxv]},{0,1,0,0},{0,0,1,0},{-Sin[φxv],0,0,
          Cos[φxv]}},{{1,0,0,0},{0,Cos[φyu],
          Sin[φyu],0},{0,-Sin[φyu],Cos[φyu],
          0},{0,0,0,1}},{{1,0,0,0},{0,Cos[φyv],0,
          Sin[φyv]},{0,0,1,0},{0,-Sin[φyv],0,
          Cos[φyv]}},{{1,0,0,0},{0,1,0,0},{0,0,Cos[φuv],
          Sin[φuv]},{0,0,-Sin[φuv],Cos[φuv]}}}]

Manipulate[Module[{F=makeRotationMatrix4D[{φxy,φxu,φxv,φyu,φyv,φuv}].{r Cos[φ],r Sin[φ],(r^(1/3)) Cos[φ/3],(r^(1/3)) Sin[φ/3]}},ParametricPlot3D[Evaluate[Most[F]],{r,(10^(-8)),1},{φ,-3 π,3 π},Mesh->False,MaxRecursion->0,PlotPoints->{12,60},PlotRange->All,Boxed->False,Axes->False,ColorFunctionScaling->False,ColorFunction->
(Evaluate[{Hue[0.76 ArcTan[F[[-1]]/2]/(Pi/2)]}/.{r->#4,φ->#5}]&)]],{{φxy,0,(Subscript[ϕ, x,y])},-π,π},{{φxu,0,(Subscript[ϕ, x,u])},-π,π},{{φxv,0,(Subscript[ϕ, x,v])},-π,π},{{φyu,0,(Subscript[ϕ, y,u])},-π,π},{{φyv,0,(Subscript[ϕ, y,v])},-π,π},{{φuv,0,(Subscript[ϕ, u,v])},-π,π}]

Circle Inversion (Nesting example)

Michael Trott

invert[Circle[{X_, Y_}, R_], Circle[{x_, y_}, r_]] :=
With[{𝒹 = (x - X)^2 + (y - Y)^2}, 
     Circle[{X, Y} + R^2 {x - X, y - Y}/(𝒹 - r^2), Abs[r R^2/(r^2 - 𝒹)]]]

inversionGraphics[n_Integer, o_Integer, r_, α_] := 
With[{δφ = 2Pi/n},
Module[{circles}, 
Graphics[Reverse @
MapIndexed[{Hue[0.72 (#2[[1]] - 1)/o], #1}&, circles = 
    (* remove "bad" circles *)
    DeleteCases[#, _Circle?(MemberQ[#, Indeterminate, {-1}] || 
                            Negative[Last[#]]&), Infinity]& @ 
    NestList[Flatten[Outer[invert, #, #]]&, 
             Table[Circle[(1 + α (-1)^jφ) {Cos[Pi/2 + jφ δφ], Sin[Pi/2 + jφ δφ]}, r], 
                          {jφ, n}] // N, o]],
          (* keep center constant *)
          PlotRange -> (Max[(Abs[#1] + #2)& @@@Flatten[circles]])
                        {{-1, 1}, {-1, 1}}]]] // Internal`DeactivateMessages

Manipulate[Manipulate[inversionGraphics[n, o, Tan[r], α],
                      {{r, 0.4}, 0, Pi/2}, {{α, 0}, -2, 2}],
           {{o, 2}, {1, 2}},
           {{n, 4}, {2, 4, 6, 8, 10, 12}}]

Three-Body Problem (ContinuousAction example)

Jeff Bryant

ManipulateThreeBodyProblem["2D",opts___]:=Manipulate[Block[{M1,M2,μpotential,a,G,Porb,Ωorb,Φ,x,y,z,mu,deriv,posAtL1,ΦAtL1,posAtL2,ΦAtL2,posAtL3,ΦAtL3,μ,grL1,solution},
M1=1;
M2=q M1;
μpotential=M2/(M1+M2);
a=1;
G=1;
Porb=Sqrt[4 (π^2) (a^3)/(G (1+q))];
Ωorb=2 π/Porb;
Φ[x_,y_,z_]:=-((G M1)/(Sqrt[(((x+q/(1+q)))^2)+(y^2)+(z^2)]))-((G M2)/(Sqrt[(((x-a+q/(1+q)))^2)+(y^2)+(z^2)]))-(1/2) ((Ωorb)^2) ((((x-μpotential +q/(1+q)a))^2)+(y^2));
deriv=D[Φ[x,0,0],x];
posAtL1=FindRoot[deriv==0,{x,.3}];
ΦAtL1=Φ[x/.posAtL1,0,0];
posAtL2=FindRoot[deriv==0,{x,1.5}];
ΦAtL2=Φ[x/.posAtL2,0,0];
posAtL3=FindRoot[deriv==0,{x,-1}];
ΦAtL3=Φ[x/.posAtL3,0,0];
μ=mu/.Solve[q==mu/(1-mu),mu][[1]];
grL1=Normal[ContourPlot[Φ[x,y,0],{x,x/.posAtL1,x/.posAtL2},{y,-.6,.6},PlotPoints->10,Contours->{ΦAtL1},ContourStyle->{Red},ContourShading->False,Background->Black]]/.Line[x__]:>Polygon[x];
solution=NDSolve[{
x''[t]==2 y'[t]+x[t]-(((1-μ) (x[t]+μ))/((((((x[t]+μ))^2)+((y[t])^2)))^(3/2)))-((μ (x[t]-1+μ))/((((((x[t]-1+μ))^2)+((y[t])^2)))^(3/2)))-friction x'[t],
y''[t]==-2 x'[t]+y[t]-(((1-μ) y[t])/((((((x[t]+μ))^2)+((y[t])^2)))^(3/2)))-((μ y[t])/((((((x[t]-1+μ))^2)+((y[t])^2)))^(3/2)))-friction y'[t],
y[0]==0,x[0]==Evaluate[x/.posAtL1],y'[0]==Vy0,x'[0]==Vx0},{x[t],y[t]},{t,0,13}];
Show[ParametricPlot[Evaluate[{x[t],y[t]}/.solution],{t,0,orbtime},PlotStyle->{RGBColor[1,0,0]}],grL1,Graphics[{PointSize[0.02],White,Point[{-μ,0}],Text["M1",{-μ,-.1}],Text["M2",{1-μ,-.1}],Text["CM",{0,-.1}],Text["+",{0,0}],Text["q="<>ToString[q],{-.2,.5},{-1,0}],Text["friction="<>ToString[friction],{.4,.5},{-1,0}],Text["
(Subscript[Vx, 0])="<>ToString[Vx0],{-.2,.4},{-1,0}],Text["
(Subscript[Vy, 0])="<>ToString[Vy0],{.4,.4},{-1,0}],Text["orbits="<>ToString[orbtime],{-.2,.3},{-1,0}]},Axes->False],TextStyle->{FontFamily->"Arial",FontWeight->"Bold"},PlotRange->{{x/.posAtL3,x/.posAtL2},{-.8,.8}},Background->Black,Axes->False,ImageSize->600]],{friction,0,0.06},{Vx0,-.02,-0.05},{{Vy0,0},-0.05,.05},{{q,.4},0.2,0.8},{{orbtime,3},0.1,10},opts]

Audio`Music` example (Sound example)

Support functions by Mike Pilat

Needs["Audio`Music`"]

PlayNote[sn_SoundNote]:=PlayMusic[SoundTrack[{sn}]]

PlotMusicHashFunction[MIDIEvent[t_,_,opts___]]:={"Channel","Note",t}/.{opts}

rectanglize[{{x1_,y1_},{x2_,y2_}}]:=
(
If[x2>XMAX,XMAX=x2];
If[y2<YMIN, YMIN=y2];
If[y2+1>YMAX,YMAX=y2+1];
Rectangle[{x1,y1},{x2,y2+1}]
)

PlotMusic[st_SoundTrack]:=
Block[{XMAX=0,YMIN=127,YMAX=0},
Module[{midi,events,ons,offs,hash,tmp,tpb},
midi=Audio`Music`Private`NormalizeSoundTracksToMIDI[{st},False,None];
tpb="Resolution"/.List@@Rest[midi];
events=Flatten[First/@First[midi]]/.
MIDIEvent[t_,"NoteOn",aaa___,"Velocity"->0,bbb___]:>MIDIEvent[t,"NoteOff",aaa,"Velocity"->0,bbb];
ons=Cases[events,MIDIEvent[t_,"NoteOn",___,"Note"->n_,___,"Channel"->c_,___],1];
offs=Cases[events,MIDIEvent[t_,"NoteOff",___,"Note"->n_,___,"Channel"->c_,___],1];
tmp=PlotMusicHashFunction[#]&/@ons;
tmp=tmp[[Ordering[tmp]]];
ons=Map[Reverse[Rest[#]]&,Split[tmp,(First[#]==First[#2])&],{2}];
tmp=PlotMusicHashFunction[#]&/@offs;
tmp=tmp[[Ordering[tmp]]];
offs=Map[Reverse[Rest[#]]&,Split[tmp,(First[#]==First[#2])&],{2}];
tmp=Riffle[Map[rectanglize,Transpose/@Transpose@{ons,offs},{2}],
{Blue,Red,Green,Purple,Yellow,Brown}];
Button[
Graphics[{Thickness[1/Min[600,50XMAX]],
RGBColor[.85,.85,.85],
Line[Table[{{x,YMIN-.5},{x,YMAX+.5}},{x,0,XMAX,tpb}]],
Orange,tmp},PlotRange->{{-1,XMAX+1},{YMIN-1,YMAX+1}},ImageSize->{Max[150,Min[600,50XMAX]],150},AspectRatio->150/(Max[150,Min[600,50XMAX]]),Background->White],
PlayMusic[st]
]
]
]

Pilatπ=(60+First[RealDigits[N[Pi,60]]]);

Remainder by Lou D'Andria

MajorScale={"C4","D4","E4","F4","G4","A4","B4","C5"};

MajorArpeggio={"C4","E4","G4","C5","G4","E4","C4"};

MelodicMinorScale={"C4","D4","E♭4","F4","G4","A4","B4","C5"};

HarmonicMinorScale={"C4","D4","E♭4","F4","G4","A♭4","B4","C5"};

NaturalMinorScale={"C4","D4","E♭4","F4","G4","A♭4","B♭4","C5"};

MinorArpeggio={"C4","E♭4","G4","C5","G4","E♭4","C4"};

TuningNote={"A4"};

tuneIn[song_,instrument_,tempo_,echo_,echoOffset_]:=Module[{st},
st=SoundTrack[SoundNote[#,1/4]& /@ ToExpression[song],"Instrument"->instrument,"Tempo"->tempo];
If[echo,st=SoundTrack[{st,SoundTrack[st,{echoOffset}]}]];
PlayMusic[st];
PlotMusic[st]]

songList={"TuningNote","MajorArpeggio","MinorArpeggio","MajorScale","MelodicMinorScale","HarmonicMinorScale","NaturalMinorScale","Pilatπ"};
instrumentList=InstrumentNumberToName /@ Range[0,127];

Manipulate[tuneIn[song,instrument,tempo,echo,echoOffset],{song,songList},{instrument,instrumentList},{{tempo,120},40,200},{echo,{False,True}},{echoOffset,.1,1,.1}]

Triangle Problem example

Oleksandr Pavlyk

Triangle[x1_List,x2_List,x3_List]:={PointSize[0.02],Point[{x1,x2,x3}],Line[{x1,x2,x3,x1}]};

CircleInsideTriangle[x1_List,x2_List,x3_List]:=Module[{x,y,n,eqs},
eqs=({x,y}-x1).Cross[x2-x1]/Norm[x2-x1]==({x,y}-x2).Cross[x3-x2]/Norm[x3-x2]==({x,y}-x3).Cross[x1-x3]/Norm[x1-x3];
n={x,y}/.ToRules[Reduce[eqs,{x,y}]];
n=N[n,50];
{{PointSize[0.02],Point[n]},Circle[n,(n-x1).Cross[x2-x1]/Norm[x2-x1]]}
];

CircleAroundTriangle[x1_List,x2_List,x3_List]:=Module[{r},
r=Inverse[{x2-x1,x3-x2}].Differences[(Norm /@ {x1,x2,x3})^2/2];
{{PointSize[0.02],Point[r]},Circle[r,Norm[r-x1]]}
];

LineOfConstantDifferenceOfAngles[pA_,pB_,pC_,δ_?NumberQ]:=Module[{pP,f,pI,t1,t2},
f=RotationTransform[δ/2];
pI = First[Last[CircleInsideTriangle[pA,pB,pC]]];
{t1,t2}={t1,t2}/.ToRules[Reduce[And@@Thread[pB+t1*f[pI-pB]==pC+t2*f[pI-pC]],{t1,t2}]];
pP = pB+t1 f[pI-pB];
pP
];

FindPointpM[pA_, pI_, {pC_, rC_}]:=Module[{t,pM,ru},
ru=ToRules[Reduce[Total[((pI-pA)t+pA-pC)^2]==rC^2&&t>1]];
pM=((pI-pA)t+pA)/.ru;
If[ArrayQ[pM,1,NumberQ],
{{PointSize[0.02], Point[pM]},{Line[{pA,2pM-pI}]}, Circle[pM,Norm[pM-pI]]},{}]
];

IMOTriangleProblem[] := Manipulate[With[{pnts={p1,p2,p3 }},Graphics[{Triangle@@pnts,{Blue,pI=CircleInsideTriangle@@pnts, Text[Style["I",FontSize->14,Bold],First[Last[pI]],3Normalize[p1-First[Last[pI]]]]},{Red,pC=CircleAroundTriangle@@pnts,Text[Style["O",Larger,Bold],First[Last[pC]],{1.5,-2.5}]},With[{pP=LineOfConstantDifferenceOfAngles[p1,p2,p3,δ]},
{Green,Line[{{p3,pP},{pP,p2}}],{PointSize[0.02],Point[pP]},
{Black,Dashed,Circle[p1,Norm[First[Last[pI]]-p1],{-Pi/3,Pi/2+Pi/3}]}, Text[Style["P",Larger,Bold],pP,3Normalize[Normalize[p2-pP]+Normalize[p3-pP]]]}],
{Brown,DotDashed,FindPointpM[p1,First[Last[pI]], List@@(Last[pC])]},
Text[Style["A",Larger,Bold],p1,3Normalize[p2+p3-2p1]],
Text[Style["C",Larger,Bold],p2,3Normalize[p1+p3-2p2]],
Text[Style["B",Larger,Bold],p3,3Normalize[p1+p2-2p3]]
},Axes->True,GridLines->Automatic,PlotRangeClipping->True,ImageSize->{500,400},ImagePadding->{{20,20},{20,20}}]
],{{p1,{1,2}},{0,0},{10,10},Locator},{{p2,{9,3}},{0,0},{10,10},Locator},{{p3,{2,8}},{0,0},{10,10},Locator},{{δ,0,"∠PBA-∠PBC"},-Pi,Pi},ControlPlacement->Top,TrackedSymbols:>{p1,p2,p3,δ},Bookmarks->{"Isoceless triangle":>{p1={2.,2.},p2={8.,2.},p3={5.,10.},δ=0},"Right triangle":>{p1={2.,2.},p2={8.,2.},p3={2.,10.},δ=0},"Equilateral triangle":>{p1={2.,2.},p2={10.,2.},p3={6,2. (1+2 (Sqrt[3]))},δ=0}},AutorunSequencing->Automatic,ControllerLinking->True,SaveDefinitions->True]

Illustrating Sin

Abby Brown

IllustratingSin[] := Manipulate[
Module[{anglegraph,maingraph},
anglegraph[th_,showtext_]:=Show[
Graphics[{
{Lighter[Gray,0.5],Circle[{0,0},1]},
{Darker[Green,0.2],Thick,Circle[{0,0},1,{0,th}]},
{Lighter[Gray,0.5],Line[{{0,0},{Cos[th],Sin[th]}}]},
{Red,Thick,Line[{{Cos[th],0},{Cos[th],Sin[th]}}]},
If[showtext,Rotate[Text[Style[N[Sin[th]],11],{Cos[th]-0.15,Sin[th]/2}],3Pi/2,{Cos[th]-0.15,Sin[th]/2}],{}],
{Lighter[Red,0.3],Dashing[Medium],Line[{{Cos[th],Sin[th]},{2,Sin[th]}}]}
}],
PlotRange->1,ImageSize->145,BaseStyle->{12},Axes->True,Ticks->{{-1,1},{-1,1}},PlotRange->{{-1,1},{-1,1}},PlotRangePadding->0.25];

maingraph[th_,showtext_]:=Module[{},
Show[Plot[{Sin[x]},{x,0.0001,th},PlotRange->{{0,2Pi},{-1,1}},PlotRangePadding->{0,0.25},ImagePadding->{{30,12},{0,0}},PlotRangeClipping->False,PlotStyle->Gray,
Ticks->{Table[{n Pi/4,n Pi/4},{n,0,8}],Table[n,{n,-1,1,1/2}]},
GridLines->{Table[{n Pi/4,Lighter[Gray,0.7]},{n,-2,8}],Table[{n,Lighter[Gray,0.7]},{n,-1,1,1/2}]},ImageSize->{Automatic,145}],
Graphics[{If[showtext,Rotate[Text[Style[N[Sin[th]],11],{th+0.15,Sin[th]/2}],3Pi/2,{th+0.15,Sin[th]/2}],{}],
{Lighter[Red,0.3],Dashing[Medium],Line[{{th,Sin[th]},{-2,Sin[th]}}]},
{Darker[Green,0.2],Thick,Line[{{0,0},{th,0}}]},
{Red,Thick,Line[{{th,0},{th,Sin[th]}}]}
}],AspectRatio->Automatic,BaseStyle->{12}]];

DynamicModule[{pt={Cos[ptctrl],Sin[ptctrl]},pt2={ptctrl,0}},
Labeled[Grid[{
{SliderPane[Dynamic[pt,
{(pt={Cos[pt2[[1]]],Sin[pt2[[1]]]})&,
(pt=Normalize[#];pt2={If[pt2=={2Pi,0},2Pi,Mod[ArcTan[#[[1]],#[[2]]],2 Pi]],0})&,
(pt=Normalize[#];ptctrl=pt2[[1]])&}],
Dynamic[anglegraph[If[pt2=={2Pi,0},2Pi,Mod[ArcTan[pt[[1]],pt[[2]]],2 Pi]],showvalue]]],
SliderPane[Dynamic[pt2,
{(pt2={If[pt2=={2Pi,0},2Pi,Mod[ArcTan[pt[[1]],pt[[2]]],2 Pi]],0})&,
(pt2={#[[1]],0};pt={Cos[#[[1]]],Sin[#[[1]]]})&,
(pt2={#[[1]],0};ptctrl=#[[1]])&}],
Dynamic[maingraph[If[pt2=={2Pi,0},2Pi,Mod[ArcTan[pt[[1]],pt[[2]]],2 Pi]],showvalue]]]}},Spacings->0],{Style[Row[{"Illustrating ",Style["sin(",Red],Style["x",Italic,Bold,Darker[Green,0.3]],Style[")",Red]}],20,FontFamily->"Helvetica",Gray],
Style["",10,Lighter[Gray,0.7],FontFamily->"Helvetica"]},{{Top,Left},{Bottom,Right}}]]
],
{{showvalue,False,"show value"},{False,True}},
{{ptctrl,Pi/6,""},0,2Pi},TrackedSymbols:>{showvalue,ptctrl},
AutorunSequencing->Automatic,SaveDefinitions->True,ControllerLinking->True]

Conference Extras

The remaining slides were not discussed during the talk, but might prove useful for reference.



Variable Specification Options

ControlPlacement

You can change where controls are displayed relative to the content display area via the ControlPlacement option.

Light box example from Chris Hill

Manipulate[With[{lightpos={x,y,z},lightpos1={x1,y1,z1},lightpos2={x2,y2,z2}},Graphics3D[{EdgeForm[None],{White,Line[{{0,-.1,0.01},{0,1.1,0.01}}],Line[{{1,-.1,0.01},{1,1.1,0.01}}]},{Lighting->{{Red,{{lightpos,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos]},floor1},{Lighting->{{Green,{{lightpos1,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos1]},floor2},{Lighting->{{Blue,{{lightpos2,{0,0,0}},0}}},{Yellow,PointSize[0.025],Point[lightpos2]},floor3},
{Lighting->{{Red,{{lightpos,{0,0,0}},0}},{Green,{{lightpos1,{0,0,0}},0}},{Blue,{{lightpos2,{0,0,0}},0}}},backsplash}},ViewPoint->{2,1.6,1.9},PlotRange->{{-1,2},{0,1},{0,1}}]],{{y,0.5},0,1},{{z,0.2},0.1,1},{{y1,0.5},0,1},{{z1,0.2},0.1,1},{{y2,0.5},0,1},{{z2,0.2},0.1,1},{{x,0.5},-1,2},{{x1,1.5},-1,2},{{x2,-.5},-1,2},ControlPlacement->Right]

Variable Specification Options

ContinuousAction

By default, Manipulate updates the content area in real time as you drag the slider around. If your function that generates the content area is too slow, you may want to wait to call it until you release the control. You can change this behavior via the ContinuousAction option.

Three body problem example from Jeff Bryant

ManipulateThreeBodyProblem["2D",ContinuousAction->False]

Variable Specification Options

AutoAction

On the other hand, you can get super reactive controls that don't even wait until you click on them by setting the AutoAction option.

EllipticTheta example from Michael Trott

Manipulate[ParametricPlot[{Re[EllipticTheta[a, x,qr Exp[I qφ]]],Im[EllipticTheta[a, x,qr Exp[I qφ]]]},{qφ,-Pi+10^-4,Pi-10^-4},PlotRange->All,Frame->True,Axes->False,FrameTicks->None,AspectRatio->1],{{a,4},{1,2,3,4}},{{qr,0.94,Abs[q]},0,0.95},{{x,1},-Pi,Pi},AutoAction->True]

Manipulate Use

Escaping Scoping: Global Variables

As with Module, it is possible to have Manipulate's body be affected by external variables, and vice versa.

Random walk example

This Manipulate displays a simple random walk as it happens, but also stores the points in a global variable, which you can access at the same time.

Manipulate[
Graphics[{Line[Dynamic[If[!paused,mylist=AppendTo[lis,Last[lis]+RandomChoice[stepsize×{{1,0},{0,1},{-1,0},{0,-1}}]],lis]]],Hue[1],AbsolutePointSize[10],Point[Dynamic[Last[lis]]]},PlotRange->All],{{lis,{{0,0}}},_,ControlType->None},{stepsize,Range[10]},{paused,{False,True}}]

Graphics[Line[mylist]]

Manipulate Use

Escaping Scoping: FrontEnd

Manipulate's contents can contain arbitrary controls, including buttons that do something based on the current value of the local variables.

Springs example from Michael Trott

ManipulateSprings[]