Design Interactive Demonstrations for Your Classroom

Ed Pegg Jr
Wolfram Research
training@wolfram.com

What Is a Demonstration?

It is a Manipulate with an explanation

A few seconds with the Wolfram Demonstrations Project.

Manipulate[Grid[{{
Graphics[{EdgeForm[Black],Lighter[Orange,.3],Disk[{0,0},1],Black,Table[Line[{{0,0},{Sin[2Pi i/n],Cos[2Pi i/n]}}],{i,n}]},ImageSize->{300,400}],Graphics[{EdgeForm[Black],Lighter[Orange,.3],Table[With[{u=(Pi/n)},{Disk[{0,2i Tan[u]},1,{-u,u}],Disk[{1,(2i+1) Tan[u]},1,{Pi-u,Pi+u}]}],{i,n/2}]},ImageSize->{200,400}]}}],
{{n,8,"number of sectors"},4,40,2,Appearance->"Labeled"}]

As the number of sectors increases, you can see that the area of the circle is equal to its radius multiplied by half its circumference.

Before You Start–Author Guidelines

Author Guidelines (http://demonstrations.wolfram.com/guidelines.html)

Get a new Demonstrations Template: File > New > Demonstration.

Change the Title to something other than “Your Title Here”.

(From Guidelines) “Search through the existing Demonstrations for topics close to yours. Some topics in the site, like trigonometric functions, are very densely populated, so vary your search terms to make sure you see everything relevant. It is fine if there is already something similar to your idea—just give your Demonstration a different emphasis.”

Search Demonstrations for your title, and any keywords that may be related.

Put those keywords in the Search Terms section, one cell per keyword.

In Related Links, put the titles of related Demonstrations, one per cell.

For each Related Link title, use the cursor to select the title, then Insert > Hyperlink to make the link to the URL.

Example: Hinged Dissection of a Pentagram to a Decagon

Look at Authoring Notebooks

For each related Demonstration, download the Author Code and look over the Authoring Notebook

For completely new Demonstrations, look at the Author Code for some other Demonstrations you have liked.

Write an Initial Caption

Put in the Caption your first thoughts on what will be shown

(From Caption guidelines) “The caption provides all the information needed to understand the Demonstration. It should be between three and five sentences long, but clarity is more important than length.”

If your text reads well, then possible control names will be obvious.

“Note how changing jjj affects one of the curves.” –poor control label, inexact description–unlikely.

“Note how changing velocity affects the blue curve.”–”velocity” is a good control label.

Write the Code–Initialization

Initialization Code–in section of that name

Initialization :> (**code here**)

There are two techniques. Use only one of them.

Code useful for other purposes should be placed in Initialization Code.

TetrahedronVolume[{{x1_,y1_,z1_},{x2_,y2_,z2_},{x3_,y3_,z3_},{x4_,y4_,z4_}}] := Abs[Det[(({{x1, y1, z1, 1}, {x2, y2, z2, 1}, {x3, y3, z3, 1}, {x4, y4, z4, 1}}))]]/6;

Write the Code–Controls on Top–Nice-Looking Formulas

Manipulate[
With[{p = FunctionF[FunctionG[x][[ggg]]][[fff]]},
With[{pp=D[p,x]},
Column[{
Graphics[Text[Style[Row[{ToString[TraditionalForm[y]]," = ",ToString[TraditionalForm[f[g[x]] ]]," = ",FunctionF[FunctionG[x][[ggg]]][[fff]]}],14]],ImageSize->{450,40}],
Graphics[Text[Style[Row[{ToString[TraditionalForm[Derivative[1][y] ]]," = ",Derivative[1][f],"(",TraditionalForm[g[x]],")",Derivative[1][g],"(",TraditionalForm[x],")"," = ", DFunctionF[FunctionG[x][[ggg]]][[fff]],"(",DFunctionG[x][[ggg]],")"}],14]],ImageSize->{450,40}],
Plot[
{p,pp},
{x,-10,10},PlotRange->{{-xr,xr},{-yr,yr}},ImageSize->{450,225},Frame->True,AspectRatio-> 1/2,Epilog-> {AbsolutePointSize[7],Red,Point[{xval,p}/. x-> xval],Green,
Line[{{xval-10,p-10pp},{xval+10,p+10pp}}]/.x->xval},ImagePadding->{{25,25},{25,10}}]}]]],

{{fff,1,TraditionalForm[f[x]]},Thread[Range[8]->TraditionalForm/@functs ],ControlType->Setter, Appearance-> "FramedPalette"},
{{ggg,2,TraditionalForm[g[x]]},Thread[Range[8]->TraditionalForm/@functs ],ControlType->Setter, Appearance-> "FramedPalette"},
{{xr,2,"plot domain"},0,10,Appearance-> "Labeled"},
{{yr,2,"plot range"},0,10,Appearance-> "Labeled"},
{{xval,1,Row[{Style["x", Italic]," value"}]},-10,10,Appearance-> "Labeled"},
AutorunSequencing->{1,2,3},
SynchronousInitialization->False,
Initialization:>(
functs = {Sin[x],Cos[x],x^2,1/(x^2 + 1), Sqrt[1+x^2],(1-x)^2, Exp[x],x^3};
FunctionF[x_]:= {Sin[x],Cos[x],x^2,1/(x^2 + 1), Sqrt[1+x^2],(1-x)^2, Exp[x],x^3};
FunctionG[x_]:= {Sin[x],Cos[x],x^2,1/(x^2 + 1), Sqrt[1+x^2],(1-x)^2, Exp[x],x^3};DFunctionF[x_] := {Cos[x],(-Sin[x]),2 x,(-((2 x)/(((1+(x^2)))^2))),(x/(Sqrt[1+(x^2)])),(-2 (1-x)),Exp[x],3 (x^2)};DFunctionG[x_] := {Cos[x],(-Sin[x]),2 x,(-((2 x)/(((1+(x^2)))^2))),(x/(Sqrt[1+(x^2)])),(-2 (1-x)),Exp[x],3 (x^2)};
)]

{{xval,1,Row[{Style["x", Italic]," value"}]},-10,10,Appearance-> "Labeled"}

{{xr,2,"plot domain"},0,10,Appearance-> "Labeled"}

{{fff,1,TraditionalForm[f[x]]},Thread[Range[8]->TraditionalForm/@functs ],ControlType->Setter, Appearance-> "FramedPalette"}

Write the Code–Controls on the Left

(Subscript[ineq, 1]) = False;
(Subscript[ineq, 2]) = False;
(Subscript[ineq, 3]) = False;
Manipulate[RegionPlot[{
If[(Subscript[ineq, 1]),y>(Subscript[m, 1]) x + (Subscript[b, 1]),y<(Subscript[m, 1]) x + (Subscript[b, 1])],
If[(Subscript[ineq, 2]),y>(Subscript[m, 2]) x + (Subscript[b, 2]),y<(Subscript[m, 2]) x + (Subscript[b, 2])],
If[(Subscript[ineq, 3]),y>(Subscript[m, 3]) x + (Subscript[b, 3]),y<(Subscript[m, 3]) x + (Subscript[b, 3])]},
{x,-10,10},{y,-10,10},PerformanceGoal->"Quality",Axes-> True, 
PlotLabel-> Style[Column[{
Row[{"(Subscript[y, 1]) ",If[(Subscript[ineq, 1]),"> ","< "],If[(Subscript[m, 1])<0,"","  "],ToString[NumberForm[(Subscript[m, 1]),{3,2}]] ," (Subscript[x, 1])",If[(Subscript[b, 1])<0," - "," + "], ToString[NumberForm[Abs[(Subscript[b, 1])],{3,2}]]}],
Row[{"(Subscript[y, 2]) ",If[(Subscript[ineq, 2]),"> ","< "],If[(Subscript[m, 2])<0,"","  "],ToString[NumberForm[(Subscript[m, 2]),{3,2}]] ," (Subscript[x, 2])",If[(Subscript[b, 2])<0," - "," + "], ToString[NumberForm[Abs[(Subscript[b, 2])],{3,2}]]}],
Row[{"(Subscript[y, 3]) ",If[(Subscript[ineq, 3]),"> ","< "],If[(Subscript[m, 3])<0,"","  "],ToString[NumberForm[(Subscript[m, 3]),{3,2}]] ," (Subscript[x, 3])",If[(Subscript[b, 3])<0," - "," + "], ToString[NumberForm[Abs[(Subscript[b, 3])],{3,2}]]}]
}],"Label",12],ImageSize->{400,400}],
{{(Subscript[m, 1]),1.5,Subscript[Style["m",Italic],"1"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
{{(Subscript[b, 1]),0.4,Subscript[Style["b",Italic],"1"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
Row[{"reverse inequality ",Subscript[Style["y",Italic],"1"],Spacer[10],Checkbox[Dynamic[(Subscript[ineq, 1]),Initialization-> False],{False,True}]}],
Delimiter,
{{(Subscript[m, 2]),0.3,Subscript[Style["m",Italic],"2"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
{{(Subscript[b, 2]),2.1,Subscript[Style["b",Italic],"2"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
Row[{"reverse inequality ",Subscript[Style["y",Italic],"2"],Spacer[10],Checkbox[Dynamic[(Subscript[ineq, 2]),Initialization-> False],{False,True}]}],
Delimiter,
{{(Subscript[m, 3]),-.8,Subscript[Style["m",Italic],"3"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
{{(Subscript[b, 3]),1.3,Subscript[Style["b",Italic],"3"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny},
Row[{"reverse inequality ",Subscript[Style["y",Italic],"3"],Spacer[10],Checkbox[Dynamic[(Subscript[ineq, 3]),Initialization-> False],{False,True}]}],AutorunSequencing -> {1,2,5,6},
SaveDefinitions-> True]

ControlPlacement->Left

{{(Subscript[m, 3]),-.8,Subscript[Style["m",Italic],"3"]},-3.,3.,.01,Appearance-> "Labeled", ImageSize-> Tiny}

Write the Code–Output Visibility

Manipulate[Graphics[{Red,Disk[pos1],Green,Disk[pos2],Blue,Disk[pos3]},PlotRange->{{-15,15},{-15,15}},ImageSize->350],
Style["disks",Bold],
"",
{{pos1,{-5,-5},"red"},{-10,-10},{10,10},ImageSize->Tiny},{{pos2,{0,0},"green"},{-10,-10},{10,10},ImageSize->Tiny},{{pos3,{5,5},"blue"},{-10,-10},{10,10},ImageSize->Tiny},
ControlPlacement->Left]

Write the Code–Controls with Locators

Manipulate[
If[Length[loc]<3,AppendTo[loc,RandomReal[{0,10},{2}]]];ListDensityPlot[Map[Flatten,Transpose[{loc,Range[Length[loc]]}]],PlotRange->{{0,10},{0,10}},InterpolationOrder->0,Mesh->If[mesh,All,None],ColorFunction->(ColorData[colors][#]&),FrameTicks->False],
{{loc,RandomReal[{0,10},{10,2}]},{0,0},{10,10},Locator,LocatorAutoCreate->True},{{colors,"BeachColors","color scheme"},ColorData["Gradients"]},
{{mesh,False,"show borders"},{True,False}}]

{{loc,RandomReal[{0,10},{10,2}]},{0,0},{10,10},Locator,LocatorAutoCreate->True}

Write the Code–LocatorPane

Liner[{pt1_,pt2_}]:= Simplify[Det[{{x,y,1},{First[pt1],Last[pt1],1},{First[pt2],Last[pt2],1}}]/
(GCD@@Flatten[CoefficientList[Det[{{x,y,1},{First[pt1],Last[pt1],1},{First[pt2],Last[pt2],1}}],{x,y}]])];
ReturnLines[ptList_] :=Select[Union[Flatten[Last[#],1]]&/@(Transpose/@SplitBy[Sort[{Liner[#],#}&/@Subsets[Union[ptList],{2}]],First]),Length[#]>2&];
UnsortedUnion[x_]:=Reap[Sow[1,x],_,#1&][[2]];
solutions = {
{{1,1},{1,3},{1,5},{2,2},{2,3},{2,4},{3,1},{3,3},{3,5}},
{{1,1},{1,2},{1,4},{1,7},{2,2},{3,3},{4,4},{5,2},{6,2},{7,1}},
{{1,2},{1,7},{2,2},{2,4},{3,7},{3,9},{4,1},{4,6},{5,1},{5,9},{6,3},{6,5},{7,6},{7,8},{8,3},{8,8},{9,4},{9,5}}};

Manipulate[
SeedRandom[sr];DynamicModule[{data=If[sr<4,Take[UnsortedUnion[Join[solutions[[sr]],Table[RandomInteger[{1,9}],{60},{2}]]],25],Take[UnsortedUnion[Partition[Table[RandomInteger[{1,9}],{80}],2]],25]]},LocatorPane[Dynamic[data[[Range[n]]]],Dynamic[Block[{fit,x},With[{poly=Map[Min[9,Max[{1,Round[#]}]]&,Take[data,n],{2}]},Graphics[{AbsoluteThickness[3],Switch[Length[#],3,{RGBColor[1,.71,0],Line[#]},4,{Green,Line[#]},__,{Red,Line[#]}]&/@ReturnLines[poly],AbsolutePointSize[4],Gray,Point/@Complement[Flatten[Table[{a,b},{a,1,9},{b,1,9}],1],poly],AbsolutePointSize[12],RGBColor[.33,.26,.78],Point/@poly},PlotRange->{{.5,9.5},{.5,9.5}},ImageSize->{400,450},
PlotLabel->Text@With[{linetypes = Length/@ReturnLines[poly]},
Grid[{Flatten[{"points in line",Range[3,9]}],Flatten[{"occurrences",Table[Count[linetypes,n],{n,3,9}]}]}, Frame-> All]]]]]],Appearance->""]],
{{n,10,"number of points"},4,25,1,Appearance->"Labeled"},
{{sr,81,"random seed"},1,103,1,Appearance->"Labeled"},
SaveDefinitions->True]

LocatorPane

Grid is good for organizing results

Write the Code–Body

PerpendicularBisector[{pt1_,pt2_}] := Liner[({pt1,pt2}-Table[(pt1+pt2)/2,{2}]).{{0,-1},{1,0}} + Table[(pt1+pt2)/2,{2}]]
Liner[{pt1_,pt2_}]:= Simplify[Det[{{x,y,1},{First[pt1],Last[pt1],1},{First[pt2],Last[pt2],1}}]/
(GCD@@Flatten[CoefficientList[Det[{{x,y,1},{First[pt1],Last[pt1],1},{First[pt2],Last[pt2],1}}],{x,y}]])];
LinerSimple[{pt1_,pt2_}]:=Det[{{x,y,1},{First[pt1],Last[pt1],1},{First[pt2],Last[pt2],1}}];
TriangleArea[{p1:{x1_,y1_},p2:{x2_,y2_},p3:{x3_,y3_}}] := Abs[Det[Append[#,1]&/@{p1,p2,p3}]]/2;
CorrespondingAltitudePoint[{p1_,p2_,p3_}]:={x,y}/.Solve[{(y-p1[[2]])(p2[[2]]-p3[[2]])==(p3[[1]]-p2[[1]])(x-p1[[1]]),(y-p2[[2]])(p3[[1]]-p2[[1]])==(p3[[2]]-p2[[2]])(x-p2[[1]])},{x,y}][[1]];
ColoredLabeledPoint[color_RGBColor, text_String] := Graphics[{EdgeForm[{Gray}], color, Disk[{-.2,.1},1],Black,Text[Style[text,Small],{0,0}, FormatType->StandardForm]}, ImageSize-> {15,15}];

Manipulate[
Module[{lineA,lineB,lineC,a,b,c,angA,angB,angC,incircleradius,circumcircleradius,pta,ptb,ptc,medA,medB,medC,perpA,perpB,perpC,alta,altb,altc,alteqA,alteqB,alteqC,II,GG,OO,HH,area},
Column[{
Dynamic@Text@Row[{"This is ",
Switch[sign, -1,"an acute, ",0,"a right, ",1,"an obtuse, "],
Switch[Length[Union[{a,b,c}]], 1, "equilateral", 2, "isosceles", 3, "scalene"],
 " triangle with area ", area = InputForm[Abs[Det[Append[#,1]&/@{ptA, ptB, ptC}]]/2]}],
Graphics[{
Dynamic[{
lineA = Liner[{ptB,ptC}];
lineB = Liner[{ptA,ptC}];
lineC = Liner[{ptA,ptB}];

{Thick,
Line[{ptB, ptC}],
Line[{ptA, ptC}],
Line[{ptA, ptB}]},

Tooltip[(ContourPlot[lineA==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Thin, Gray}]/.Tooltip[x_,___]:>x)[[1]],Column[{lineA==0,Row[{OverBar["BC"]," = ",a}], Row[{"∠A"," ≈ ",NumberForm[angA,{5,2}],"°"}]}, Alignment-> Center]],
Tooltip[(ContourPlot[lineB==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Thin, Gray}]/.Tooltip[x_,___]:>x)[[1]],Column[{lineB==0,Row[{OverBar["AC"]," = ",b}],
Row[{"∠B"," ≈ ",NumberForm[angB,{5,2}],"°"}]}, Alignment-> Center]],
Tooltip[(ContourPlot[lineC==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Thin, Gray}]/.Tooltip[x_,___]:>x)[[1]],Column[{lineC==0,Row[{OverBar["AB"]," = ",c}],
Row[{"∠C"," ≈ ",NumberForm[angC,{5,2}],"°"}]}, Alignment-> Center]],

(*a b c are the length of legs opposite A B C*)
a = Norm[ptB-ptC];
b = Norm[ptA-ptC];
c = Norm[ptA-ptB];
angA = N[180 ArcCos[(-a^2 + b^2 + c^2)/(2  b c)]/Pi];
angB = N[180 ArcCos[(a^2 - b^2 + c^2)/(2 a  c)]/Pi];
angC = N[180 ArcCos[(a^2 + b^2 - c^2)/(2 a b )]/Pi];
sign = Sign[(#[[3]]^2 - #[[2]]^2 - #[[1]]^2&/@{SortBy[{a,b,c}, N[#]&]})[[1]]];

ControlActive[
{}, (* ---Part of ControlActive - don't draw anything extra --*)
{   (* -------------- Part of ControlActive --------------------*)

If[MemberQ[onoffswitches, 1],
(* ---------------- angle bisectors- -------------- *)
II = N[Transpose[{ptA, ptB, ptC}].{a,b,c}/(a+b+c)];
incircleradius = N[Sqrt[(b+c-a)(c+a-b)(a+b-c)/(a+b+c)]/2];

{Pink,Tooltip[
Circle[II,incircleradius],
Column[{Row[{"radius ", incircleradius}], "incircle"}, Alignment-> Center]],
ContourPlot[Simplify[N[LinerSimple[{ptA, II}]]]==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Pink}][[1]],
ContourPlot[Simplify[N[LinerSimple[{ptB, II}]]]==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Pink}][[1]],
ContourPlot[Simplify[N[LinerSimple[{ptC, II}]]]==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Pink}][[1]]},
{}],

If[MemberQ[onoffswitches, 2],
(* ------------------- medians ---------------------*)
{pta = (ptB+ptC)/2;
ptb = (ptA+ptC)/2;
ptc = (ptA+ptB)/2;

medA = Liner[{pta,ptA}];
medB = Liner[{ptb,ptB}];
medC = Liner[{ptc,ptC}];
GG =(ptA+ptB+ptC)/3;

ContourPlot[medA==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Green}][[1]],
ContourPlot[medB==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Green}][[1]],
ContourPlot[medC==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Green}][[1]]},
{}],

If[MemberQ[onoffswitches, 3],
(* ------------ perpendicular bisectors ------------*)
{circumcircleradius = Norm[ptA-OO];
perpA = PerpendicularBisector[{ptB,ptC}];
perpB = PerpendicularBisector[{ptA,ptC}];
perpC = PerpendicularBisector[{ptA,ptB}];
OO ={x,y}/.Solve[{perpA==0, perpB==0}][[1]];

Cyan,Tooltip[
Circle[OO,circumcircleradius ],
Column[{Row[{"radius ", circumcircleradius}],"circumcircle"},Alignment-> Center]],
ContourPlot[perpA==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Cyan}][[1]],
ContourPlot[perpB==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Cyan}][[1]],
ContourPlot[perpC==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Cyan}][[1]]},
{}],

If[MemberQ[onoffswitches, 4],
(* ----------------- altitudes ------------------------*)
{alta=CorrespondingAltitudePoint[{ptA,ptB, ptC}];
altb=CorrespondingAltitudePoint[{ptB, ptC, ptA}];
altc=CorrespondingAltitudePoint[{ptC, ptA,ptB}];
alteqA = Liner[{alta,ptA}];
alteqB = Liner[{altb,ptB}];
alteqC = Liner[{altc,ptC}];
HH ={x,y}/.Solve[{alteqA==0, alteqB==0}][[1]];

ContourPlot[alteqA==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Brown}][[1]],
ContourPlot[alteqB==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Brown}][[1]],
ContourPlot[alteqC==0,{x,-9,9},{y,-9,9}, PlotPoints-> 4, ContourStyle->{Brown}][[1]]},
{}],

EdgeForm[{Gray}],
If[#[[6]],
Tooltip[
{#[[3]],Disk[#[[2]],.25],Black,Text[Style[#[[1]],Small],#[[2]]+{-.00,-.05}, FormatType->StandardForm]},
 Column[{Text@#[[2]], #[[4]],#[[5]]}, Alignment-> Center]],
{}]&/@
{{"I",N[II],Pink,"incenter", "= ⋂ angle bisectors", MemberQ[onoffswitches, 1]},
{"G",GG, Green,"centroid", "= ⋂ medians", MemberQ[onoffswitches, 2]},
{"O",OO, Cyan,"circumcenter", "= ⋂ perp. bisectors", MemberQ[onoffswitches, 3]},
{"H",HH,LightBrown,"orthocenter", "= ⋂ altitudes", MemberQ[onoffswitches, 4]}}

}] (* Part of ControlActive *)

}],

Locator[Dynamic[ptA,(If[valuesOK[{#, ptB, ptC}],ptA=#]& @ Clip[Round[#],{-8,8}])&],Graphics[{Yellow,
Disk[{0,0},1],Black,Thick,Circle[{0,0},1],
Text[Style["A",Medium],Automatic,FormatType->StandardForm]},ImageSize->20]],
Locator[Dynamic[ptB,(If[valuesOK[{ptA, #, ptC}],ptB=#]& @ Clip[Round[#],{-8,8}])&],Graphics[{Yellow,
Disk[{0,0},1],Black,Thick,Circle[{0,0},1],
Text[Style["B",Medium],Automatic,FormatType->StandardForm]},ImageSize->20]],
Locator[Dynamic[ptC,(If[valuesOK[{ptA, ptB, #}],ptC=#]& @ Clip[Round[#],{-8,8}])&],Graphics[{Yellow,
Disk[{0,0},1],Black,Thick,Circle[{0,0},1],
Text[Style["C",Medium],Automatic,FormatType->StandardForm]},ImageSize->20]]

},
GridLines-> {{-9,-8,-7,-6,-5,-4,-3,-2,-1,{0,Thick},1,2,3,4,5,6,7,8,9},{-9,-8,-7,-6,-5,-4,-3,-2,-1,{0,Thick},1,2,3,4,5,6,7,8,9}}, 
GridLinesStyle->Directive[LightGray],
PlotRange->{{-9,9},{-9,9}}, ImageSize-> 450],

TogglerBar[Dynamic[onoffswitches],Thread[Range[1,4]-> {
Row[{ColoredLabeledPoint[Pink, "I"]," = ⋂ angle bisectors"},BaseStyle->{"Label",12}], 
Row[{ColoredLabeledPoint[Green, "G"]," = ⋂ medians"},BaseStyle->{"Label",12}],
Row[{ColoredLabeledPoint[Cyan, "O"]," = ⋂ perp. bisectors "},BaseStyle->{"Label",12}],
Row[{ColoredLabeledPoint[LightBrown, "H"]," = ⋂ altitudes "},BaseStyle->{"Label",12}]}]]
}, Alignment-> Center]],
{{ptA,{7,-1}},{-9,-9},{9,9},ControlType->None},
{{ptB,{-5,-5}},{-9,-9},{9,9},ControlType->None},
{{ptC,{3,7}},{-9,-9},{9,9},ControlType->None},
{{sign,-1},{-1,0,1},ControlType->None}, 
{{onoffswitches,{1,2,3,4}},ControlType->None},
SaveDefinitions-> True,
AutorunSequencing->{5},
Initialization:>(valuesOK[pts_] := Abs[Det[Append[#,1]&/@pts]]/2 >0)]

Tooltip

Locator

TogglerBar

ContinuousAction ->False

Troubleshoot the Code–Good-Looking Fonts

Inconsistent fonts

Manipulate[Column[{
Plot[Sin[x],{x,-5,5},PlotRange->2,ImageSize->500,PlotLabel->TraditionalForm[Sin[x]]],
Row[{TraditionalForm[Sin[x]]}]},Alignment->Center],
{{a,0,"peak"},-4,4}]

The Text command with one argument fixes the problem

Manipulate[Column[{
Plot[Sin[x],{x,-5,5},PlotRange->2,ImageSize->500,PlotLabel->TraditionalForm[Sin[x]]],
Text@Row[{TraditionalForm[Sin[x]]}]},Alignment->Center],
{{a,0,"peak"},-4,4}]

Troubleshoot the Code–3D Graphics–Panel Size

Inconsistent size when moved

Manipulate[Graphics3D[Cuboid[{0,0,0},{.3,.4,x}],PlotLabel->Style[Text@Row[{Style["x",Italic]," = ",x}],16]],{x,.2,.7}]

SphericalRegion->True fixes the problem

Manipulate[Graphics3D[Cuboid[{0,0,0},{.3,.4,x}],PlotLabel->Style[Text@Row[{Style["x",Italic]," = ",x}],16],SphericalRegion->True],{x,.2,.7}]

Troubleshoot the Code–Packages

Using packages requires Quiet and Get

Manipulate[SeedRandom[seed];DynamicModule[{mm=Array[{##}&,{q,q}],m=Table[If[Random[]<.27,0,1],{q},{q}],gg={0,0}},Dynamic@(If[gg=={0,0},{},m=lightstep[m,gg,q];gg={0,0}];
Pane[
With[{grid = Abs[m-1]},
With[{graph = StructureToGraph[grid]},
With[{
conn = Combinatorica`ConnectedQ[graph],
weak = WeakestRowOrColumn[grid]},
Column[{If[conn&&weak≠ 0,Text@"rigid",Text@"not rigid"],Grid[MapIndexed[Button[{Graphics[Line[{{0,0},{1,1}}]]," "}[[1+#1]],gg=#2,ImageSize->{350/(q+1),350/(q+1)},Background->White,FrameMargins->0]&,m,{2}],Spacings->{0,0}]},Alignment-> Center]]]],{350,350},Alignment->Center])],
{{q,6,"size"},3,9,1},
{{seed,1,"new structure"},1,100000,1},
AutorunSequencing->{1},
Initialization:>{
Quiet[Get["Combinatorica`"]];
lightstep[m_,p_,_]:=Abs[m-Total[RotateLeft[ReplacePart[Array[0&,Dimensions[m]],p->1],#]&/@{{0,0}}]];
StructureToGraph[structure_List] :=Combinatorica`FromUnorderedPairs[With[{braces=Position[structure,1]},Flatten[Table[If[MemberQ[braces[[a]]-braces[[b]],0],{a,b},Sequence@@{}],{a,1,Length[braces]-1},{b,a+1,Length[braces]}],1]]];WeakestRowOrColumn[structure_List] := Min[Flatten[{Total@structure,Total@Transpose[structure]}]];},SynchronousInitialization->False]

Quiet[Get["Combinatorica`"]]

Troubleshoot the Code–Panel Size

Tools > Test Image Size

Controls That Adapt

Use PaneSelector to change controls

Manipulate[
Graphics[Switch[ctrl,
1,{diskcolor,Disk[{0,0},radius]},
2,{rectanglecolor,Rectangle[{0,0},{width,1}]}],PlotRange->2],
{{ctrl,1,""},{1->"circle",2->"rectangle"}},
PaneSelector[{
1->Column[{
Control[{radius,1,2}],
Control[{{diskcolor,Blue,"disk color"},Blue}]
}],
2->Column[{
Control[{width,1,2}],
Control[{{rectanglecolor,Red,"rectangle color"},Red}]
}]
},Dynamic[ctrl]]]

Thumbnail and Snapshots

Once the code is written, make one Thumbnail and three Snapshots

Copy the cell with the Manipulate panel and paste it to make four new cells.

Troubleshoot the Code–Loop Elimination

Scroll down to the Snapshots—do they resolve?

An example of a cell that will not resolve and the cell bracket.

Table[FactorInteger[n!+1][[1,1]],{n,1,10000}]

Troubleshoot the Code–Nonlocalized Code

These two Manipulate examples are nonlocalized. The variable “a” is used in both, globally.

Manipulate[ a=n; a, {n,1,10}]

Manipulate[ a=n; a, {n,1,10}]

Three of the methods that can be used to localize variables include Module, With, and declaring the variable.

Manipulate[ Module[{a},a=n; a], {n,1,10}]

Manipulate[ With[{a=n}, a], {n,1,10}]

Manipulate[ a=n; a, {n,1,10},{a, ControlType-> None}]

Finalize the Caption

Once the Manipulate is finished, go back and write the caption in a final form. From the Manipulate instructions:

“The caption provides all the information needed to understand the Demonstration. It should be between three and five sentences long, but clarity is more important than length. Include only text in this section—no code, graphics, etc. Do not change the cell style or copy cells from other sections. Do not copy text from books or the web. Write your ideas in your own words. If you want to refer to something on the web, link to it in the Details.”

Finalize the Details

Give links to sources and citations for any images.

This optional section is for a more detailed description of the Demonstration than the caption, but it should still be as concise as possible. This section may also include numbered snapshot captions (e.g. Snapshot 1: phrase or sentence without an initial capital and without a period, unless more than one sentence is used) and explanations of the Manipulate control labels. Define any symbols undefined so far. Include only text in this section—no code, graphics, etc. Do not change the cell style or copy cells from other sections.

Finalize the Details–References

Books

[1] L. D. Schmidt, The Engineering of Chemical Reactions, New York: Oxford University Press, 1998.

Articles

D. Pearson, "A Polynomial-Time Algorithm for the Change-Making Problem," Operations Research Letters, 33(3), 2005 pp. 231-234.

Authoring Information

Simplest: just put in your name.

Once you have been published, follow the same format.

If you are a new author, start with just one submission.

Control Suggestions

Click the boxes that you think are appropriate. But do not worry about it much. This is by far the easiest section to edit.

Final Checks

1. Spell check  (Edit > Check Spelling).

2. Tools > Test Image Size, and make sure the Manipulate panel fits.

3. Move all the controls, to make sure the panel does not change size.

4. One Snapshot, three different Thumbnails in different cells, in those sections.

5. Use Update Thumbnail & Snapshots, make sure five items are updated.

6. Verify cell brackets of the panels do not turn on and interfere with each other.

7. Close Mathematica. Relaunch the notebook and run Autorun. If there are errors, panel resizing, or cell brackets not resolving, fix the problems.

Submit Your Demonstration

Go to the Authoring area, test it, and submit it (http://demonstrations.wolfram.com/participate/authoringarea.jsp).

If there are problems, write to the Demonstrations Team: demonstrations@wolfram.com.

Edit Process

If there are serious problems with a submission, you will generally hear from the Demonstrations Team quickly.

Usually, if changes are necessary, the Demonstrations Team will send a notebook with starting edits. It is important to use that version.

Wrap-Up

Take a look at other Demonstrations.

Go and create something that helps the scientific community.