Projects Ideas with Mathematica for effective teaching and learning

based on a preparation by :
  Cliff Hastings,
Wolfram Research
training@wolfram.com

Tailored for presentation at Wolfram conference on
 10 - 19 - (4 *7*8*9) by :
  Abraham Gadalla
abegadalla@yahoo.com
763 420 3875

Table of Contents

What is Mathematica

Examples in :
  	Algebra
	Geometry
	PreCalculus
	Calculus
Why should Mathematica be the Standard for teaching and learning

What is Mathematica ?

Mathematica is  :
  a document - creation tool
  a computing environment
  a vast knowledge base
  a well - established community.
  There are about 10,452 educational projects in all fields written by teachers and professionals; check at:
  Demonstrations.wolfram.com

When programming with Mathematica, 
  Keep in mind the following three rules :
  	1. Functions are capitalized.
    	2. Use [ ] to surround function arguments.
    	3. Use { } to denote lists and ranges.

Table[(a^2),{a,1,10}]

Table[Prime[a],{a,1,10}]

Manipulate[Expand[(5 u +2 v)^n],{{n,2,"n"},1,5,1,Appearance->"Labeled"}]

Manipulate[Factor[(u^m -1)],{{m,2,"m"},1,7,1,Appearance->"Labeled"}]

FindSequenceFunction[{1,3,7,15,31},n]

Reduce[ u^2 -5 u + 6==0,u]

Manipulate[Plot[{Sin[x],Sin[freq x]},{x,-π,2 π},PlotStyle->{{Thick,Black},{Thick,Blue}}],{{freq,1,"frequency"},1,5,Appearance->"Labeled"}]

a Little advanced model in Trig functions

more complicated model

Manipulate[Plot[Vertshift+amplitude function[freq (x-phaseshift)],{x,-2π,2π},PlotStyle->{Thick,Blue},AxesOrigin->{0,0},Axes->True,Ticks->{{-2π,-((3π)/2),-π,((-π)/2),0,(π/2),π,((3π)/2),2π},{-6,-4,-2,2,4,6}},TicksStyle->Directive[Black,Bold,14],PlotRange->{{-7,7},{-6,6}},
PlotLabel->Text@Style[Framed[Row[{NumberForm[amplitude,{4,2}]," ",function," [ ",NumberForm[freq,{4,2}]," ( x ",NumberForm[phaseshift,{4,2}],")]  + ",NumberForm[Vertshift,{4,2}]}]],14,Bold,Blue,Background->Lighter[Yellow]],

GridLines->{Range[-2 π,2 π,π/2],Range[-6,6,2]},
GridLinesStyle->Directive[GrayLevel[0.7]]],{function,{Sin,Cos,Tan,Csc,Sec,Cot}},{{freq,2,"frequency"},1,5,ImageSize->Tiny,Appearance->"Labeled"},{{amplitude,3,"amplitude"},1,5,ImageSize->Tiny,Appearance->"Labeled"},{{phaseshift,-π/2,"Phase Shift"},-π/2,π/2,π/12,ImageSize->Tiny,Appearance->"Labeled"},{{Vertshift,2,"vertical Shift"},-5,5,ImageSize->Tiny,Appearance->"Labeled"},ControlPlacement->Left,TrackedSymbols->{function,freq,amplitude,phaseshift,Vertshift}]

Application: Interactively computing indefinite integrals

ClearAll["Global`*"]

Display a sum of squares in unevaluated form

(∑_(i=1)^10)(HoldForm[((#)^2)]&)[i]

Show a formula and its valuation

TraditionalForm[Manipulate[With[{n=n},HoldForm[∫(1/((x^n)-1))\[DifferentialD]x]]==Framed[∫(1/((x^n)-1))\[DifferentialD]x,Background->LightYellow],{{n,3},1,10,1,Appearance->"Labeled"},TrackedSymbols:>{n},Initialization:>Clear[x]]]

Free Form Input

Enhance your day - to - day tasks by using Mathematica to visualize, clarify, verify,  and explain the concept while getting all students involved.

Projects Ideas and activities with Mathematica

What time is it now?

ClearAll["Global`*"];

Manipulate[
makehand[m_,n_,o_,p_]:={Thick,Arrowheads[0.05],Arrow[{{m,n},{o,p}}]};
Column[{
Item[Text@Style["Happy Day\nI wish you an enjoyable seminar and a Successful Year",FontFamily->"Times New Roman",24,Bold,Darker [Blue],Italic],Frame->True,Alignment->Center],
hourhand:=makehand[0,0,0,0.6 radius];

minutehand:={Blue,makehand[0,0,0,0.75 radius]};

secondhand:={Red,makehand[0,-0.1,0,0.85 radius]};
Item[
Quiet[Graphics[{
  Inset[PolarPlot[x Sin[ x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[0,0,1]},ImageSize->Tiny],{ radius Cos[π/3],radius Sin[ π/3]}],
Inset[PolarPlot[{x Cos[ x],-x Cos[x]},{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[1,0,1]},ImageSize->Tiny],{radius Cos[π/6],radius Sin[ π/6]}],
Inset[PolarPlot[x Sin[11 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[0,0,1]},ImageSize->Tiny],{radius Cos[2π/3],radius Sin[2 π/3]}],
Inset[PolarPlot[{x Cos[6 x],-x Cos[6 x]},{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{Hue[0.9]},ImageSize->Tiny],{radius Cos[π/2],radius Sin[ π/2]}],
Inset[PolarPlot[x Sin[9 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[1,0,1]},ImageSize->Tiny],{radius Cos[3π/3],radius Sin[3 π/3]}],
Inset[PolarPlot[x Sin[4 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[1,0,1]},ImageSize->Tiny],{radius Cos[7π/6],radius Sin[7 π/6]}],
Inset[PolarPlot[x Sin[7 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[0,0,1]},ImageSize->Tiny],{radius Cos[4π/3],radius Sin[4 π/3]}],Inset[PolarPlot[x Sin[5 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{RGBColor[0,0,1]},ImageSize->Tiny],{radius Cos[5π/3],radius Sin[5 π/3]}],
Inset[PolarPlot[{x Sin[2 x],-x Sin[2 x]},{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{Hue[0.9]},ImageSize->Tiny],{radius Cos[11π/6],radius Sin[11 π/6]}],
Inset[PolarPlot[{x Sin[3 x],-x Sin[3 x]},{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{Hue[0.9]},ImageSize->Tiny],{radius Cos[3π/2],radius Sin[3 π/2]}],
Inset[PolarPlot[{x Sin[5 x],-x Sin[5x]},{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{Hue[0.9]},ImageSize->Tiny],{radius Cos[5π/6],radius Sin[5 π/6]}],
Inset[PolarPlot[x Sin[3 x],{x,0,k Pi},PlotRange->All,Axes->False,PlotStyle->{Hue[0.9]},ImageSize->Tiny],{radius Cos[6π/3],radius Sin[6 π/3]}],
Inset[
Dynamic[Style[Refresh[DateString[{"DayNameShort" ," ","Day"," ","MonthNameShort"," ", "Year","\n\n  ","Hour12Short",":","Minute"," ","AMPM"}],UpdateInterval->1],FontFamily->"Edwardian Script ITC",24,Bold,Blue(*RGBColor[1,0,1]*)]],{0,0.4 radius}],
{Purple,PointSize[0.03],Point[{0,0}]},(* Numbers *)
  Rotate[hourhand, Dynamic[Refresh[-30 Mod[AbsoluteTime[]/3600, 60] °, UpdateInterval -> 60]], {0, 0}],
  Rotate[minutehand, Dynamic[Refresh[-6 Mod[AbsoluteTime[]/60, 60] °, UpdateInterval -> 1]], {0, 0}],
  Rotate[secondhand, Dynamic[Refresh[-6 Mod[AbsoluteTime[], 60] °, UpdateInterval -> 1/20]], {0, 0}]
  },ImageSize->Large]],Frame->True]}],{{k,13,"loops"},5,20,1,Appearance->"Labeled"},
{{radius,5,"Radius"},.5,7,Appearance->"Labeled"},TrackedSymbols->{k,radius}]

Examples for Warm UP

Calculate the ratios of areas of Triangles

ClearAll["Global`*"];

Manipulate[
ratioGray=(n-1)/(2 n);
ratioRed=(n+1)/(2 n);
ratioGrayToRed=(n-1)/(n+1);
Column[{
Item[
Which[question==1,
If[answerG,Style[Row[{"\nRatio of \!\(\*FractionBox[\(Area\\ of\\ Gray\\ Triangles\), \(Area\\ of\\ Δ\\ ABC\)]\) = ",TraditionalForm[ratioGray],"\n"}],20,Black],Style["\nCalculate the Ratio of \!\(\*FractionBox[\(Area\\ of\\ Gray\\ Triangles\), \(Area\\ of\\ Δ\\ ABC\)]\)\n",20,Black]],
question==2,
If[answerR,Style[Row[{"\nRatio of \!\(\*FractionBox[\(Area\\ of\\ Red\\ Triangles\), \(Area\\ of\\ Δ\\ ABC\)]\) = ",TraditionalForm[ratioRed],"\n"}],20,Blue],Style["\nCalculate the Ratio of \!\(\*FractionBox[\(Area\\ of\\ Red\\ Triangles\), \(Area\\ of\\ Δ\\ ABC\)]\)\n",20,Red]],
question==3,
If[answerGR,Style[Row[{"\nRatio of \!\(\*FractionBox[\(Area\\ of\\ Gray\\ Triangles\), \(Area\\ of\\ Δ\\ RedTriangles\)]\) = ",TraditionalForm[ratioGrayToRed],"\n"}],20,Purple],Style["\nCalculate the Ratio of \!\(\*FractionBox[\(Area\\ of\\ Gray\\ Triangles\), \(Area\\ of\\ Δ\\ RedTriangles\)]\)\n",20,Black]
]],Alignment->Left,Frame->True],
Item[
gline=Graphics[{Table[{Line[{{k/n,2 k/n Sin[Pi/3]},{2-k/n,2 k/n Sin[Pi/3]}}],Line[{{2 k/n,0},{k/n+1,(2-2 k/n)Sin[Pi/3]}}],Line[{{2 k/n,0},{k/n,2 k/n Sin[Pi/3]}}]},{k,0,n}]},AxesOrigin->{0,0},Axes->True];gtriangle=Graphics[{
Text[Style["A",24,Black],{0,-0.1}],Text[Style["C",24,Black],{2,-0.1}],
Text[Style["B",24,Black],{1,(Sqrt[3])+0.1}]},AxesOrigin->{0,0},Axes->False];
redTriangles=Graphics[{
Table[Table[{Red,Polygon[{{(2i-j)/n,j(Sqrt[3])/n},{(2 i+1-j)/n,(j+1)(Sqrt[3])/n},{(2 i+2-j)/n,j(Sqrt[3])/n}}]},{i,j,n-1,1}],{j,0,n-1}]},AxesOrigin->{0,0},Axes->False];
grayTriangles=Graphics[{
Table[Table[{GrayLevel[0.8],Polygon[{{(2i-j+1)/n,(j+1)(Sqrt[3])/n},{(2 i+2-j)/n,(j)(Sqrt[3])/n},{(2 i+3-j)/n,(j+1)(Sqrt[3])/n}}]},{i,j,n-2,1}],{j,0,n-2}]

},AxesOrigin->{0,0},Axes->False];

Which[question==1,Show[grayTriangles,gline,ImageSize->500],question==2,Show[redTriangles,gline,ImageSize->500],question==3,
Show[grayTriangles,redTriangles,gline,ImageSize->500,PlotRange->All]
],Alignment->{Center},Frame->True]
}],
Row[{
Control[
{{n,4,"# of Δ"},2,20,1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],
Control[{{question,1,"Question"},1,3,1,Setter}],Spacer[10],Control[{{answerG,False,"GrayRatio"},{False,True},Enabled->question==1}],Spacer[10],Control[{{answerR,False,"RedRatio"},{False,True},Enabled->question==2}],Spacer[10],Control[{{answerGR,False,"GToRedRatio"},{False,True},Enabled->question==3}]
}],TrackedSymbols:>{n,question,answerG,answerR,answerGR,gray,red,both}]

Draw equilateral triangles with points

Manipulate[
sum[n]=If[EvenQ[n],
n (n+2)(2 n+1)/8,
(n(n+2)(2 n+1)-1)/8];
tg1=Graphics[{
If[n==1,Inset[Style["This is a triangle",18,Bold,Black],{0,10}],
Inset[Row[{Style["There are ",17,RGBColor[.25,.43,.82],Bold],Style[sum[n],17,Bold,RGBColor[.25,.43,.82]],
Style[" triangles.",17,RGBColor[.25,.43,.82],Bold],"\n",
		Style["Can you find them ?",17,RGBColor[.49,0,0],Bold,Italic]
}],{0,  2}]]
}];
tg2=Graphics[{
Table[{Blue,Disk[{-1+(2 i/n),0},0.02]},{i,0,n,1}],

Table[{Blue,Disk[{-1+(2 i/n)Cos[π/3],(2 i/n)Sin[π/3]},0.02]},{i,1,n,1}],

Table[{Red,Disk[{-1+2/n+( (2i+2j)/n)Cos[ π/3],( 2(j)/n)Sin[ π/3]},0.02]},{i,0,n,2},{j,1,n-i-2,1}],
Table[{Gray,Disk[{1-2/n-( (2i+2j)/n)Cos[ π/3],( 2(j)/n)Sin[ π/3]},0.02]},{i,0,n,2},{j,1,n-i-3,1}],
Table[{Purple,Disk[{1-(2 i/n)Cos[π/3],(2 i/n)Sin[π/3]},0.02]},{i,1,n-1,1}]
},Axes->False
];
Show[tg1,tg2,ImageSize->Medium,PlotRange->Automatic],
{{n,3,"NumberofDivisions"},1,30,1,Appearance->"Labeled"},TrackedSymbols->{n}]

Cookies for All

Framed[Manipulate[
numberCookies4=8( a+1)-1;
numberCookies=(2^((n-1)))( a+1)-1;
Item[

If[answer,Style[Row[{Spacer[30],"\na) Andy bought ",numberCookies4," Cookies\nb) If there are ", n," Siblings \n Andy must have bought ",numberCookies ," Cookies\n"}],24,Purple,Italic],Row[{Style["\n       Cookies for All\n",28,Purple],Style["\nAndy bought some cookies.  His mother told him to give his sister Angie half the cookies and also half a cookie and to give his brother Alex half the remaining cookies and also half a cookie, and after that his brother Andrew will get half the remaining and also half a cookie. \n Then Andy asked his MUm What do I get Mum?\n Mum said There will be just ",12,Black,Italic],Style [a,14,Purple],Style[ " cookie(s) remaining for you",12,Black],Style["\na) How many cookies did Andy buy?\n",13,Blue,Italic],Style["b)If the process continued to ",12,Black],Style[n, 14, Purple],Style[" brothers and sisters including Andy.\n",12,Black],Style[" How many Cookie did Andy Buy ?\n",13,Blue]

}]
],
Alignment->{Left},Frame->True,ItemSize->{80,6}],
Row[{Control[{{ n, 5, "Total Siblings"},5,32,1,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{ a,1, "Left for Andy"},1,10,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols->{n,a,answer}],Background->RGBColor[0.1,0.6,1]]

Home Work in the Bath-room

Let:
a = number of extra tiles if each tile would be m inches smaller than the existing one.
b = number of tiles less if each tile would be m inches bigger than the existing one.
length = length of each tile in terms of a, and b.
numberOfTiles length = length of arrow of tiles = length of a row along the wall.

ClearAll["Global`*"];

Framed[Manipulate[
numberOfTiles=(2a b )/(a -b);
length= (a + b )/(a - b);
lengthOfRow=2 a b (a + b )/(12(((a - b ))^2));
Item[
Row[{
If[answer,Style[Row[{Spacer[30],



Style[" \n Number of tiles = ",18,Blue,Italic],numberOfTiles,Style["\nlength of each tile = ",18,Blue,Italic], length," inches\n","\nLength of a row = ",lengthOfRow," feet\n"}],24,Purple,Italic],Row[{Style["\n",20],Spacer[60],Style["Home Work in the bath-room! \n",20,Red,Italic]

}]
]
,
Row[{Style["\nWhat are you doing so long in the bath room?\n asked the mother her little boy.\n\nThe boy replied that he was doing his assignment.\n What?!, Your assignment in the bath-room.  Come out now!.\n The boy explained that he was trying to figure out the length of a row of that wall\n",12,Black,Italic],Style[" If each tile were an inch smaller, there would have to be ",12,Purple,Italic],Style[ a ,14,Blue],Style[" more tiles to the row along that wall:  but if each tile were an inch bigger there would be ",12,Purple,Italic],Style[ b,14,Blue],Style[ " tiles less\n",12,Purple,Italic],Style["How long was that wall\n\n Can you help the boy before going to the bath-room?\n", 12,Red,Italic]
}]
}],
Alignment->{Left},Frame->True,ItemSize->{60,6}],
Row[{
Control[
{{a,6,"more tiles"},3,63,3,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[
{{b,4,"Less tiles"},2,Dynamic[2 a/3],2,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[
{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{a,b,answer}],Background->RGBColor[0.1,0.6,1]]

Let us go for a ride

ClearAll["Global`*"];

Framed[DynamicModule[{a,b,d,check},Manipulate[
m=Solve[(b-1)((((b-1)((b-1)(x-a)-a b) -a b^2)/(b^3)))==d,x];
Item[If[check,Style[Row[{Style["John Started with  $", Italic],NumberForm[m[[1,1,2]],{5,2}],Style[".",Purple],Style["\nOn the first day, he spent $",Black],a,Style[" parking & admission plus $",Black],TraditionalForm[(m[[1,1,2]]-a)/b],Style[" on rides.",Black],Style["\nJohn started the second day with  $",Purple],TraditionalForm[(m[[1,1,2]]-a)(b-1)/b],Style[".\nhe spent $",Black],a,Style[" parking & admission plus $",Black],

TraditionalForm[((m[[1,1,2]]-a)(b-1)-a b)/b^2],Style[" on rides. ",Black],Style["\nOn the third day, John started with $",Purple],((m[[1,1,2]]-a)(b-1)-a b)(b-1)/b^2,Style["\nhe spent $ ",Black],a,Style[" parking & admission plus $",Black],((b-1) ((m[[1,1,2]]-a)(b-1)-a b)- a b^2)/b^3,Style["on rides. ",Black],"\nAt the end of the third day John had $",d," left."
}],16,Purple],Style[Row[{Style["\n"],Spacer[180],Style["County fair\n",Red,24],Style["\nOn the first day, John paid $",16],Style[a,16],Style[" for parking and admission.\nHe spent " , 16],TraditionalForm[1/b],Style[" of the money he had left on rides.\n",16],Style["After repeating this spending pattern on the following two days, John had $",16],Style[d,16],Style[" left.\nHow much money did John have before he went to the fair?\n",16]
}],Italic,Black]

]

,Alignment->{Left},Frame->True,ItemSize->{80,6}],
Grid[{{Control[
{{a ,3,"Park&Admision"},1,10,1,ImageSize->Tiny,Appearance->"Labeled"}],
Control[{{b,2,"part of Money\nspent on rides"},2,10,1,ImageSize->Tiny,Appearance->"Labeled"}]},{Control[
{{d,1,"Money left on\n3rd. Day"},0.1,10.,0.1,ImageSize->Tiny,Appearance->"Labeled"}],Control[{{check,False,"check answer"},{False,True}}] }}],TrackedSymbols->{a,b,d,check},SaveDefinitions->True]],Background->RGBColor[0.1,0.6,1]]

Given a pair of parallel lines and a point between them find a circle that is tangent to both lines and passes through the point.

The given lines and the point are:

DynamicModule[{m,b1,b2},Manipulate[
(*Visualizing the given elements*)
ln1[x_]:= m x+b1;
ln2[x_] := m x +b2;
pt = {3, 6};Plot[{ln1[x],ln2[x]},{x,0,6},AxesOrigin->{0,0},PlotStyle->{{Thick,Purple},{Thick,Blue}},Epilog-> {Red,PointSize[0.03],Point[pt]},PlotRange->{{0,7},{0,11}},ImageSize->Large(*AspectRatio-> Automatic*)],
{{m,0.5,"Slope"},-1,2,Appearance->"Labeled"},

{{b1,0,"b1-y-intercept"},0,4,Appearance->"Labeled"},

{{b2,6,"b2-y-intercept"},0,7,Appearance->"Labeled"},TrackedSymbols->{m,b1,b2}]]

Tangent Circles to two parallel Lines

Given a pair of parallel lines and a point between them find a circle that is tangent to both lines and passes through the point.

DynamicModule[{m,u,v,b1,b2,x,y,sol,show},
Manipulate[
ln1[x_]:=m x+b1;
ln2[x_]:=m x + b2;
sol=Quiet[Solve[{ (x-u)^2 + (y-v)^2==(b2-b1)^2/(4 (m^2+1))&&y == m x +(b2+b1)/2 },{x,y},Reals]];
Column[{
Item[
Which[show&&v>ln2[u] ||show&&v<ln1[u],
Style["\nThe diameters of the tangent circles are \nthe distances between the given point and the lines\n",14,Italic,Purple],
show&&ln2[u] >v>ln1[u],

Row[{Style["1. Draw parallel line (Green) at half way between the two given lines.",12,Purple],Style["\n2. Draw a gray circle with center at the given point and",12,Black],Style["radius = half the distance between the two given lines",12,Black],Style["\n3. The intersection points of the circle and the green line are the centers of the required tangent circles, their radii are the distances from the intersection points and the given point.",12,Blue,Italic]}],
True,
Style[Row[{"Given two parallel lines: \n(Subscript[y, 1])= ",TraditionalForm[m "x" + b1]," , ",Spacer[30],"y2 =",TraditionalForm[m "x"+ b2],", and a point ",TraditionalForm[{u,v}],"\nDraw circles that passes through the point and tangent to the lines\n"}],13,Black,Italic]
],Alignment->Left,Frame->True,ItemSize->{30,3}],

Item [

If[show,

If[v>ln2[u] ||v<ln1[u],
Plot[{ln1[x],ln2[x],m x+(b2+b1)/2},{x,0,15},ImageSize->Medium,PlotStyle->{{Thick,Purple},{ Thick,Gray},{Green}},
Epilog->{
{Red,PointSize[0.03],Point[{u,v}]},
{Blue,
PointSize[0.02],Point[{((u m^2+v m+ 2 u - b2 m)/(2 (m^2+1))),0.5 (v+((v m^2 + u m +b2)/(m^2+1)))}],
PointSize[0.02],Point[{((u m^2+v m+ 2 u - b1 m)/(2 (m^2+1))),0.5 (v+((v m^2 + u m +b1)/(m^2+1)))}],
Thick,Circle[{((u m^2+v m+ 2 u - b2 m)/(2 (m^2+1))),0.5 (v+((v m^2 + u m +b2)/(m^2+1)))},((Abs[m u + b2 -v])/(2 (Sqrt[m^2 + 1]))),{0,2π}],Thick,Circle[{((u m^2+v m+ 2 u - b1 m)/(2 (m^2+1))),0.5 (v+((v m^2 + u m +b1)/(m^2+1)))},((Abs[m u + b1 -v])/(2 (Sqrt[m^2 + 1]))),{0,2π}]}},AspectRatio->Automatic,AxesOrigin->{0,0}ImageSize->Medium,PlotRange->{{0,15},{0,15}}],
Plot[{ln1[x],ln2[x],m x+(b2+b1)/2},{x,0,15},PlotStyle->{{Thick,Purple},{Thick, Gray},{Green}},ImageSize->Medium,
Epilog->
{Red,PointSize[0.03],Point[{u,v}],Gray,Circle[{u,v},(b2-b1)/(2 (Sqrt[m^2+1]))],Blue,
Thick,Circle[{x,y},(b2-b1)/(2 (Sqrt[m^2+1]))]/.sol,
PointSize[0.02],Point[{x,y}]/.sol},
AspectRatio->Automatic,AxesOrigin->{0,0},PlotRange->{{0,15},{0,15}}]],

Plot[{ln1[x],ln2[x]},{x,0,15},AxesOrigin->{0,0},PlotStyle->{{Thick,Purple},{Thick,Blue}},AspectRatio->Automatic,Epilog-> {Red,PointSize[0.03],Point[{u,v}],Inset[Style[TraditionalForm[{u,v}],12,Red],{u,v+0.6}]},PlotRange->{{0,15},{0,15}},ImageSize->Medium]
],Alignment->{Center},Frame->True]
}],
Style["lines",16,Blue],
{{m,0.5,"Slope"},0,2,0.1,Appearance->"Labeled",ImageSize->Tiny},
{{b1,0,"lin1: \ny-intercept"},0,7,0.1,Appearance->"Labeled",ImageSize->Tiny},
{{b2,6,"line2:\ny-intercept"},2,9,0.1,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["Point",16,Red],
{{u,6,"x-coord.\n of point"},1,15,0.1,Appearance->"Labeled",ImageSize->Tiny},
{{v,7,"y-coord.\n of point"},1,15,0.1,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
{{show,False,"show"},{False,True}},
ControlPlacement->Left,
TrackedSymbols->{m,u,v,b1,b2,x,y,sol,show}]]

What is This?

Framed[Manipulate[
this=2 n - 14;

Item[
Row[{
If[answer,Style[Row[{Spacer[30],"\nThis = ",this,"\n"}],24,Red,Italic],Row[{Style["\n",24],Spacer[70],Style["What is This \n\n",24,Red,Italic]

}]
]
,
Row[{Style["\nTake half of This,\n          and add one more.\nThen treble that,\n          and add on four.\n\nBut just the same result you'd see,\n          By adding This to  ", 14,Black],Style[n,Purple, 18],Style["\n\nSo what is This?\n         you'll have to say!\nYour fun with figures for today!\n",14, Black,Italic]
}]
}],
Alignment->{Left},Frame->True,ItemSize->{80,6}],
Row[{Control[{{ n,23, "n"},23,93,10,Appearance->"Labeled"}],Spacer[30],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols->{n,answer}],Background->RGBColor[0.1,0.6,1]]

This and That

Framed[Manipulate[
this=(1+c)/3;
that = c this;
Item[
Row[{
If[answer,Style[Row[{Spacer[30],"\nThis = ",this," and That = ",that,"\n"}],24,Red,Italic],Row[{Style["\n",24],Spacer[70],Style["This and That \n\n",24,Red,Italic]

}]
]
,
Row[{Style["\nAdd This to That:\n\nDivide by three.\n\nThe Square of This, You'll surely see.\n\nBut That to This is ", 14,Black],Style[c, 15,Blue,Italic],Style[" to one.\n\nSo figure out what they are, just for fun!\n",14, Black,Italic]
}]
}],
Alignment->{Left},Frame->True,ItemSize->{80,6}],
Row[{Control[{{ c, 5, "ratio"},2,92,3,Appearance->"Labeled"}],Spacer[30],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols->{c,answer}],Background->RGBColor[0.1,0.6,1]]

Application of Completing the square

Find the area of the largest rectangle in a right triangle

ClearAll["Global`*"];

DynamicModule[{w,hint,answer},Manipulate[
area[u_]:=9 u - 0.75 u^2;
Column[{
Item[
If[answer,Style[Row[{"\nThe area of the largest rectangle = ",area[6]," (cm^2)\n\n               Ratio = 1 : 2\n" }],16,Italic,Purple],
Style["\nCalculate the area of the largest rectangle that can be inscribed in a right triangle with AC = 9 cm and CB = 12 cm \nCalculate the ratio of area of rectangle : area of triangle\n",16,Italic,Black]],Alignment->Left,Frame->True,ItemSize->{43,2}],
Item[
graphrect=Graphics[{
{Thick,Line [{{0,0},{12,0}}],Line[{{12,0},{0,9}}],Line[{{0,0},{0,9}}]},If[answer,{EdgeForm[{Thick,Blue}],FaceForm[Pink],Rectangle[{0,0},{6,4.5}],Text[Style["x",16,Bold,Italic],{3,5 }],
Text[Style["y",16,Bold,Italic],{6.5,2.25}]},
{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Rectangle[{0,0},{w,9-0.75 w}],Text[Style["x",16,Bold,Italic],{w/2,9.5-0.75w }],
Text[Style["y",16,Bold,Italic],{w+0.5,(9.5-0.75w)/2}]}],Text[Style["A",18,Bold,Italic],{0,9.5}],
Text[Style["B",18,Bold,Italic],{12,-0.5}],
Text[Style["C",18,Bold,Italic],{0,-0.5}],
If[hint,Text[Style["Write the equation of the area of\nthe rectangle in a vertex form\n",14,Purple],{8,7}]]

},Axes->True];

plotarea=Plot[9 x-0.75 x^2,{x,0,12},PlotStyle->{Thick,Blue},AxesLabel->{(*Style["\nwidth ",14,Blue],*)"",Style["Area of \nRectangle",14,Blue]},PlotLabel->If[answer,Style[Row[{"area of rectangle = ",TraditionalForm[-(9/12) (((x - 6 ))^2)+27], " (cm^2)\n"}],15,Blue,Italic],
Style[Row[{"area of rectangle = ",area[w], " (cm^2)\n"}],15,Blue,Italic]],
Epilog->If[answer,{PointSize[0.025],Green,Point[{6,27}],Inset[Style[TraditionalForm[{6 , 27 }],Blue,16],{6,29}],Inset[Style["\nwidth ",18,Blue,Italic],{6,4}]},{PointSize[0.025],Red,Point[{w,area[w]}],Inset[Style[TraditionalForm[{w , area[w]+1 }],Purple,12],{w+2 , area[w]}],Inset[Style["\nwidth ",18,Blue,Italic],{6,4}]}],PlotRange->{{-1,14},{-1,30}}];
Column[{
Show[graphrect,ImageSize->Medium],Show[plotarea,ImageSize->Medium]}],Alignment->Center,Frame->True,ItemSize->{43,4}]
}],
Row[{
Control[
{{w,9,"width"},0.5,11.5,Appearance->"Labeled"}],Spacer[30],Control[{{hint,False,"hint"},{False,True}}],Spacer[30],Control[
{{answer,False,"answer"},{False,True}}]}],
TrackedSymbols:>{w,hint,answer},SaveDefinitions->True]]

Draw the parabola

ClearAll["Global`*"];

Manipulate[Block[{circ,c,xs1,gc1},circ[center_,radius_]:={Circle[center,radius],PointSize[0.012],Point[center]};
g[x_]:=ap x^p;
pp=Plot[ap x^p,{x,-(21/ap)^(1/p),(21/ap)^(1/p)},AspectRatio->Automatic,Axes->False,

PlotLabel->Style[Framed[Row[{Style["y = ",16],Style[TraditionalForm[ap x^p],16]}]],Black,Background->Lighter[Yellow]],
PlotRange->{{-(21/ap)^(1/p),(21/ap)^(1/p)},{-3,25}}];
colorByIndex[i_]:=ColorData[clr]@First@i;
customDisk[center_,radius_,index_]:=Join[{colorByIndex@index,Disk[center,radius],Black},circ[center,radius]];

(* updated: new argument to specify distance between centers *)
cp[x_,d_,rr_]:=Block[{xxp},
xxp/.FindRoot[EuclideanDistance[{x,g@x},{xxp,g@xxp}]==rr,{xxp,x+d}]];

(* updated: iterator based on "No. of pearls" control *)
rad=With[{r=ratio^(#-1)&},Table[r[n],{n,(m+1)/2}]];

(* added: list of inter-center distances *)
rrs=Total/@Partition[rad,2,1];

(* updated: FoldList instead of NestList, so that we can use the inter-center distances with the new definition of c[] *)
xsp=
With[{d=0.1},
Join[
Reverse@Rest@FoldList[cp[#,-d,#2]&,0,rrs],
FoldList[cp[#,d,#2]&,0,rrs]]];

ysp=g/@xsp;
psp=Thread@{xsp,ysp};

(* added: list of all radii on both sides of necklace *)
allRads=Join[Reverse@Rest@rad,rad];

gcp=Graphics[{{Arrowheads[0.03],Arrow[{{(20/ap)^(1/p),20},{(21/ap)^(1/p),21}}],Arrow[{{-(20/ap)^(1/p),20},{-(21/ap)^(1/p),21}}]},

(* updated: allRads instead of rad *)
MapIndexed[customDisk[#,allRads[[First@#2]],#2]&,psp]},Axes->True,AspectRatio->Automatic];

Show[pp,gcp,ImageSize->Medium,PlotRange->All]],


Style["Parabola",16],
{{ap,0.2,"ap"},0.12,0.42,0.01,Appearance->"Labeled",ImageSize->Tiny,Enabled->parab},
{{p,2,"exponent"},2,8,2,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["Ratio bet. two Radii",14],
{{ratio,0.93,""},0.75,1.,0.01,ImageSize->Tiny,Appearance->"Labeled"},
(* updated: initial value and range spec for pearl numbers --- only odd, by 2 *)
(* note: you can of course change this as you see fit; this modification is only for illustration *)
Delimiter,
Style["Number of Pearls",14],
{{m,17,"No. \nof Pearls"},1,25,2,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["Choose your color",14],
{{clr,70,"clr"},1,92,1,Appearance->"Labeled",ImageSize->Tiny},

ControlPlacement->Left,
TrackedSymbols:>{m,clr,ap,p,ratio},

SaveDefinitions->True]

Necklace w. different colors for each Pearle and different sizes

ClearAll["Global`*"];

DynamicModule[{ah,m,clr,ap,p,parab,ratio},Manipulate[Block[{circ,c,xs1,gc1},circ[center_,radius_]:={Circle[center,radius],PointSize[0.02],Point[center]};
f[x_]:=ah Cosh[x/ah];
ph=Plot[ah Cosh[x/ah],{x,-11,11},AspectRatio->Automatic,Axes->False,
PlotLabel->Column[{
Style[Framed[Row[{Style["(Subscript[y, 1]) = ",16],Style[TraditionalForm[ah Cosh[(x/ah)]],16] }]],Black,Background->Lighter[Yellow]],If[parab,Style[Framed[Row[{Style["(Subscript[y, 2]) = ",16],Style[TraditionalForm[ap x^p],16]}]],Black,Background->Lighter[Yellow]]]
}],


PlotRange->{{-11,11},{-3,25}}];
colorByIndex[i_]:=ColorData[clr]@First@i;
customDisk[center_,radius_,index_]:=Join[{colorByIndex@index,Disk[center,radius],Black},circ[center,radius]];

(* updated: new argument to specify distance between centers *)
c[x_,d_,rr_]:=Block[{xx},
xx/.FindRoot[EuclideanDistance[{x,f@x},{xx,f@xx}]==rr,{xx,x+d}]];

(* updated: iterator based on "No. of pearls" control *)
rad=With[{r=ratio^(#-1)&},Table[r[n],{n,(m+1)/2}]];

(* added: list of inter-center distances *)
rrs=Total/@Partition[rad,2,1];

(* updated: FoldList instead of NestList, so that we can use the inter-center distances with the new definition of c[] *)
xs1=
With[{d=0.1},
Join[
Reverse@Rest@FoldList[c[#,-d,#2]&,0,rrs],
FoldList[c[#,d,#2]&,0,rrs]]];

ys1=f/@xs1;
ps1=Thread@{xs1,ys1};

(* added: list of all radii on both sides of necklace *)
allRads=Join[Reverse@Rest@rad,rad];

gc1=Graphics[{{Arrowheads[0.03],Arrow[{{ah ArcCosh[24/ah],24},{ah ArcCosh[25/ah],25}}],Arrow[{{-ah ArcCosh[24/ah],24},{-ah ArcCosh[25/ah],25}}]},

(* updated: allRads instead of rad *)
MapIndexed[customDisk[#,allRads[[First@#2]],#2]&,ps1]},Axes->False,AspectRatio->Automatic];

(*Draw the Parabola*)

g[x_]:=ap x^p;
pp=Plot[ap x^p,{x,-(21/ap)^(1/p),(21/ap)^(1/p)},AspectRatio->Automatic,Axes->False,(*PlotLabel->Style[Framed[Row[{Style["(Subscript[y, 1]) = ",16],Style[TraditionalForm[ah Cosh[(x/ah)]],16],If[parab,Style["/(Subscript[ny, 2]) = ",16],Style[TraditionalForm[ap x^p],16]]}]],Black,Background->Lighter[Yellow]],*)PlotRange->{{-(21/ap)^(1/p),(21/ap)^(1/p)},{-3,25}}];

(* updated: new argument to specify distance between centers *)
cp[x_,d_,rr_]:=Block[{xxp},
xxp/.FindRoot[EuclideanDistance[{x,g@x},{xxp,g@xxp}]==rr,{xxp,x+d}]];
(* updated: FoldList instead of NestList, so that we can use the inter-center distances with the new definition of c[] *)
xsp=
With[{d=0.1},
Join[
Reverse@Rest@FoldList[cp[#,-d,#2]&,0,rrs],
FoldList[cp[#,d,#2]&,0,rrs]]];

ysp=g/@xsp;
psp=Thread@{xsp,ysp};
gcp=Graphics[{{Arrowheads[0.03],Arrow[{{(20/ap)^(1/p),20},{(21/ap)^(1/p),21}}],Arrow[{{-(20/ap)^(1/p),20},{-(21/ap)^(1/p),21}}]},

(* updated: allRads instead of rad *)
MapIndexed[customDisk[#,allRads[[First@#2]],#2]&,psp]},Axes->False,AspectRatio->Automatic];
If[parab,
Show[ph,gc1,pp,gcp,ImageSize->Medium,PlotRange->All],

Show[ph,gc1,ImageSize->Medium,PlotRange->All]]],

Delimiter,
Style["Catinary (Upper Necklace)",14],
{{ah,3,"ah"},0.1,5,0.1,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["Ratio bet. two Radii",14],
{{ratio,0.93,""},0.75,1.,0.01,ImageSize->Tiny,Appearance->"Labeled"},

(* updated: initial value and range spec for pearl numbers --- only odd, by 2 *)
(* note: you can of course change this as you see fit; this modification is only for illustration *)
Delimiter,
Style["Number of Pearls",14],
{{m,17,"No. \nof Pearls"},1,25,2,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["Choose your Colors",14],
{{clr,70,"clr"},1,92,1,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
{{parab,True,"Parabola"},{False,True}},
{{ap,0.2,"ap"},0.12,0.42,0.01,Appearance->"Labeled",ImageSize->Tiny,Enabled->parab},
{{p,2,"exponent"},2,8,2,Appearance->"Labeled",ImageSize->Tiny,Enabled->parab},
ControlPlacement->Left,

ControlPlacement->Left,
TrackedSymbols:>{ah,m,clr,ap,p,parab,ratio}]]

Draw your Smiley Face
Learning and Group Participation while having fun

Draw your own smiley face
Instead of explaining the effect of changing the value of an exponent in a curve, or vertical and horizontal stretch in a parabola, let students explore and record the results

ClearAll["Global`*"];

Framed[Manipulate[

plt:=Plot[1-x^p,{x,-1,1},PlotStyle->{Thick,Black},Filling->Axis,FillingStyle->RGBColor[1,0.925,0.92],Axes->False,AxesOrigin->{0,0},PlotRange->All];

grface:=Graphics[{{RGBColor[1,0.925,0.92],
Disk[{0,0},{1,fcl},{π,2 π}]},{Thick,Circle[{0,0},{1,fcl},{π,2 π}]},
{GrayLevel[1],EdgeForm[{GrayLevel[0],Thickness[Large]}]}  }];
gtext1:=Graphics[{Text[Style["Get Your A",18,Bold,Italic,Red],{0,0.875}],
Text[Style["\nShow your smile",14,Italic,Purple],{0,0.78}],
Text[Style["\nWe Love Math",12,Italic,Purple],{0,0.66}]

}];
gtext2:=Graphics[{Text[Style["Mr. G. is an exp. Licensed Teacher",14,Italic,Blue],{0.,-1.9}],
Text[Style["a_gadalla@comcast.net",14,Italic,Blue]
,{0,-2.1}]}];
(* Graphing the eyes *)
graphellips:=Graphics[{
{RGBColor[0.95,0.96,0.96],Disk[{0.5,0},{0.4,h1},{0,π}],Disk[{0.5,0},{0.4,h2},{π,2 π}],

Disk[{-0.5,0},{0.4,h1},{0,π}],Disk[{-0.5,0},{0.4,h2},{π,2 π}]},

{Thick,Black,Circle[{0.5,0},{0.4,h1},{0,π}]},{Black,Thick,Circle[{0.5,0},{0.4,h2},{π,2 π}]},

{Thick,Black,Circle[{-0.5,0},{0.4,h1},{0,π}]},{Black,Thick,Circle[{-0.5,0},{0.4,h2},{π,2 π}]},

(* Eye Brows trimming and raising *)

{Thickness[0.016],Opacity[0.8],Circle[{0.35,-0.18},{0.71,Abs[eyeb]},{41 Degree,eyebln}],Circle[{-0.35,-0.18},{0.71,eyebl},{139 Degree,eyebll}]},

(*Right and Left Iris*)
{color,Disk[{cnr,0.07},0.165,{0,2 π}],Disk[{cnl,0.07},0.165,{0,2 π}]},

(*Right and left Pupils*)
{RGBColor[0.42,0.13,0.03],Disk[{cnr,0.07},0.05,{0,2 π}],Disk[{cnl,0.07},0.05,{0,2 π}]},
(* Nose Control *)
{RGBColor[0.995,0.65,0.65],Polygon[{{0.012,-n1},{-0.012,-n1},{-0.06,-n2},{0.06,-n2}}]}


}];
pltm:=Plot[a x^2+b x+c,{x,-.42,0.42},PlotStyle->{Thickness[0.025],Red,Opacity[0.7]}];
Show[plt,grface,graphellips,gtext1,gtext2,pltm,Axes->False,AxesOrigin->{0,0},PlotRange->{{-1.3,1.3},{-2.5,1.2}},AspectRatio->Automatic],

Delimiter,
Row[{Style["forehead control",Blue] ,"  ",Style["1 - ",Italic,14],Superscript[Style["x",Italic,14],"p"]," "}], 
{{p,16,"Exponent p"},4,30,2,Appearance->"Labeled",ImageSize->Tiny},
Row[{Style["face length control",Blue]," ",Superscript[Style[ "x",Italic],"2"]," + ",TraditionalForm[ Superscript[Style["y",Italic],"2"]/Superscript[Style["fcl",Italic],"2 "]],Style[" = 1",Italic], " "}],
{{fcl,1.6,Row[{"face lngth (",Style["fcl",Italic]," )"}]},1.1,1.6,0.01,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
(*Row[{Style["eyebrows Control",Blue,Italic],*)Style["eyebrows control",Blue],
Style["trimming",Italic,Purple],
{{eyebln,101 Degree,Style["right eyebrow"]},105 Degree,45 Degree,1 Degree,Appearance->"Labeled",ImageSize->Tiny},
{{eyebll,75Degree,"left eyebrow"},105 Degree,75 Degree,1 Degree,Appearance->"Labeled",ImageSize->Tiny},
Style["raising",Italic,Purple],
{{eyeb,0.6,Row[{Style["right eyebrow "](*,Style["eyeb",Italic],")"*)}]},0.59,0.65,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{eyebl,0.60,Row[{Style["left eyebrow "](*,Style["eyebl",Italic],")"*)}]},0.59,0.72,0.01,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["eye opennings control",Italic,Blue],
{{h1,0.25,"upper eyelid"},0.25,0.3,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{h2,0.13,"lower eyelid"},0.12,0.14,0.01,Appearance->"Labeled",ImageSize->Tiny},
(*{colorw,GrayLevel[1],ImageSize->Tiny},*)

Delimiter,
Style["Iris control",Blue,Italic],
{{cnr,0.5,Style["right Iris",Italic]},0.4,0.6,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{cnl,-0.5,Style["left Iris",Italic]},-0.6,-0.4,0.01,Appearance->"Labeled",ImageSize->Tiny},
{color,RGBColor[0.8,0.76,0.15],ImageSize->Tiny},
Delimiter,
Style["nose control",Italic,Blue],
{{n1,0.1,"beginning nose"},0.1,0.5,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{n2,0.62,"nose length"},0.2,0.72,0.01,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Row[{Style["mouth control",Blue]," parabola ",Style["a",Italic],Superscript[Style["x",Italic],"2"],"+", Style["b",Italic],Style["x",Italic],"+",Style["c",Italic]," "}],

{{a,0.5,Row[{"smile (",Style["a",Italic],")"}]},-0.77,1.4,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{b,0.,Row[{"twist mouth (",Style["b",Italic],")"}]},-0.27,0.23,0.1,Appearance->"Labeled",ImageSize->Tiny},
{{c,-0.89,Row[{"mouth position (",Style["c",Italic],")"}]},-0.74,-0.7 Dynamic[fcl],0.01,Appearance->"Labeled",ImageSize->Tiny},


TrackedSymbols->{p,fcl,h1,h2,color,cnr,cnl,,eyebln,eyebll,eyeb,eyebl,n1,n2,a,b,c},Paneled->False,SaveDefinitions->True],FrameMargins->9,Background->RGBColor[1,0.5,0.5]]

Find the different Coin within12 coins with three times weighings.

You have 12 coins that should have the same weight. One of the coins is either heavier or lighter than the other eleven coins. 
Can you find the different one and determine whether it is lighter or heavier in three weighing operations?

Solution

First we divide the coins into three groups of four and weigh the first four, say # 1, 2, 3, & 4 against theother group, say 5, 6, 7, & 8

For simplicity let the color Blue stands for lighter,
and the color Red stands for heavier

Case I:  Left side of balance goes up, right side goes down

This means that the counterfeit coin could be in either group: 
 If it is lighter, then it is either one , two, three, or four.  
 If it is heavier, it would be # 5, 6, 7, or 8.

Case II:  Left side balances the right side.

This means the counterfeit coin is among the third group, namely : # 9, 10, 11, and 12.

ClearAll["Global`*"];

DynamicModule[{caseIA,caseIB,caseII},graphCoins=Graphics[{Text[Style["\nFind the counterfeit coin using only three times weighing\nand determine whether it is lighter or heavier\n",Italic,Black,18],{12,5}],Table[{EdgeForm[Thick],FaceForm[Yellow],Opacity[0.9],Disk[{2i+1.5,0},1],
Inset[Style[TraditionalForm[i+1],FontSize->21,FontColor->Black],{2i+1.5,0}]},{i,0,11}],


{Thickness[0.007],Black,Circle[{7,-5},{4.5,1.5},{π,2π}],Circle[{18,-5},{4.5,1.5},{π,2π}],Line[{{7,-6.5},{7,-8.5}}],Line[{{18,-6.5},{18,-8.5}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{2,-9.5},{23,-8.5}]


},ImageSize->Large,Axes->False];

grafCaseAWt1=Graphics[{
{Thickness[0.007],Black,Circle[{-6,1.5},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,0},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],

{EdgeForm[Thick],FaceForm[Blue],Opacity[0.9],Disk[{-3,1.5},1],
Inset[Style[TraditionalForm[4],FontSize->21,FontColor->White],{-3,1.5}]},

Table[{EdgeForm[Thick],FaceForm[Blue],Opacity[0.9],Disk[{-2i-3,1.2},1],
Inset[Style[TraditionalForm[4-i],FontSize->21,FontColor->White],{-2i-3,1.2}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Blue],Opacity[0.9],Disk[{-9,1.5},1],
Inset[Style[TraditionalForm[1],FontSize->21,FontColor->White],{-9,1.5}]},

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{3,-0.08},1],
Inset[Style[TraditionalForm[5],FontSize->21,FontColor->White],{3,-0.08}]},

Table[{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{2i+3,-0.35},1],
Inset[Style[TraditionalForm[i+5],FontSize->21,FontColor->White],{2i+3,-0.3}]},{i,1,2}],

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{9,-0.08},1],
Inset[Style[TraditionalForm[8],FontSize->21,FontColor->White],{9,-0.08}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+9],FontSize->21,FontColor->Black],{2i+15,0}]},{i,0,3}]},Axes->False,AxesOrigin->{0,0},ImageSize->Large];

grafCaseAWt2a=Graphics[{
{Thickness[0.007],Black,Circle[{-6,1.5},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,0},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],
Table[{EdgeForm[Thick],FaceForm[Blue],Opacity[0.9],Disk[{-2i-3,1.2},1],
Inset[Style[TraditionalForm[3-i],FontSize->21,FontColor->White],{-2i-3,1.2}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{-3,1.5},1],
Inset[Style[TraditionalForm[3],FontSize->21,FontColor->White],{-3,1.5}]},

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{-9,1.5},1],
Inset[Style[TraditionalForm[5],FontSize->21,FontColor->White],{-9,1.5}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+3,-0.35},1],
Inset[Style[TraditionalForm[i+9],FontSize->21,FontColor->Black],{2i+3,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{3,0},1],
Inset[Style[TraditionalForm[9],FontSize->21,FontColor->Black],{3,0}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{21,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{21,0}]},


{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{9,0},1],
Inset[Style[TraditionalForm[4],FontSize->21,FontColor->White],{9,0}]},


Table[{EdgeForm[Thick],FaceForm[Red],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+6],FontSize->21,FontColor->White],{2i+15,0}]},{i,0,2}]},Axes->False,AxesOrigin->{0,0},ImageSize->Large];

grafCaseAWt3=Graphics[{
{Thickness[0.007],Black,Circle[{-6,1.5},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,0},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],

{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{-6,1.05},1.],
Inset[Style[TraditionalForm[1],FontSize->21,FontColor->White],{-6,1.05}]},

{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{6,-0.4},1.],
Inset[Style[TraditionalForm[3],FontSize->21,FontColor->White],{6,-0.4}]},


Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+14,0},1],
Inset[Style[TraditionalForm[i+1],FontSize->18,FontColor->Black],{2i+14,0}]},{i,1,5}],

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+3,-2.4},1],
Inset[Style[TraditionalForm[i+1],FontSize->18,FontColor->Black],{2i+3,-2.4}]},{i,6,11}]},
Axes->False,AxesOrigin->{0,0},ImageSize->{700}];





(* If coins 1, 2, 3, and 5 balance against the normal coins 9, 10, and 11, and the light coin # 4, then the counterfeit coin could be a heavier one and it is either 6, 7, or 8 *)

grafCaseAWt2b=Graphics[{
{Thickness[0.007],Black,Circle[{-6,0},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,-1.5},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],
Table[{EdgeForm[Thick],FaceForm[Blue],Opacity[0.9],Disk[{-2i-3,-0.35},1],
Inset[Style[TraditionalForm[3-i],FontSize->21,FontColor->White],{-2i-3,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{-3,0},1],
Inset[Style[TraditionalForm[3],FontSize->21,FontColor->White],{-3,0}]},

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{-9,0},1],
Inset[Style[TraditionalForm[5],FontSize->21,FontColor->White],{-9,0}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+3,-0.35},1],
Inset[Style[TraditionalForm[i+9],FontSize->21,FontColor->Black],{2i+3,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{3,0},1],
Inset[Style[TraditionalForm[9],FontSize->21,FontColor->Black],{3,0}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{21,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{21,0}]},


{EdgeForm[Thick],FaceForm[Blue],Opacity[0.8],Disk[{9,0},1],
Inset[Style[TraditionalForm[4],FontSize->21,FontColor->White],{9,0}]},


Table[{EdgeForm[Thick],FaceForm[Red],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+6],FontSize->21,FontColor->White],{2i+15,0}]},{i,0,2}]},Axes->False,AxesOrigin->{0,0},ImageSize->Large];
(*the counterfeit coin could be a heavier one and it is either 6, 7, or 8 *)
grafCaseAWt3b=Graphics[{
{Thickness[0.007],Black,Circle[{-6,1.5},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,0},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{-6,1.05},1.],
Inset[Style[TraditionalForm[6],FontSize->21,FontColor->White],{-6,1.05}]},

{EdgeForm[Thick],FaceForm[Red],Opacity[0.8],Disk[{6,-0.4},1.],
Inset[Style[TraditionalForm[8],FontSize->21,FontColor->White],{6,-0.4}]},
{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{21,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{21,0}]},
Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+1],FontSize->21,FontColor->Black],{2i+15,0}]},{i,0,4}],
Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+4,-2},1],
Inset[Style[TraditionalForm[i+1],FontSize->21,FontColor->Black],{2i+4,-2}]},{i,5,6}],Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+2,-2},1],
Inset[Style[TraditionalForm[i+1],FontSize->21,FontColor->Black],{2i+2,-2}]},{i,8,11}]},
Axes->False,AxesOrigin->{0,0},ImageSize->{700}];




(* Case II the first 8coins balance, the counterfeit coin has to be within coins  9 to 12 *)

graphCaseII=Graphics[{
{Thickness[0.007],Black,Circle[{-6,0},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,-1.5},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],
Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{-2i-3,-0.35},1],
Inset[Style[TraditionalForm[4-i],FontSize->21,FontColor->Black],{-2i-3,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{-3,0},1],
Inset[Style[TraditionalForm[4],FontSize->21,FontColor->Black],{-3,0}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{-9,0},1],
Inset[Style[TraditionalForm[1],FontSize->21,FontColor->Black],{-9,0}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{2i+3,-0.35},1],
Inset[Style[TraditionalForm[i+5],FontSize->21,FontColor->Black],{2i+3,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{3,0},1],
Inset[Style[TraditionalForm[5],FontSize->21,FontColor->Black],{3,0}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{21,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{21,0}]},


{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{9,0},1],
Inset[Style[TraditionalForm[8],FontSize->21,FontColor->Black],{9,0}]},

Table[{EdgeForm[Thick],FaceForm[Pink],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+9],FontSize->21,FontColor->Black],{2i+15,0}]},{i,0,3}]},Axes->False,AxesOrigin->{0,0},ImageSize->Large];


graphCaseIIWt2=Graphics[{
{Thickness[0.007],Black,Circle[{-6,0},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,-1.5},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],

Table[{EdgeForm[Thick],FaceForm[Pink],Opacity[0.8],Disk[{-2i-2,-0.35},1],
Inset[Style[TraditionalForm[12-i],FontSize->21,FontColor->Black],{-2i-2,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Pink],Opacity[0.8],Disk[{-8,-0.35},1],
Inset[Style[TraditionalForm[9],FontSize->21,FontColor->Black],{-8,-0.35}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{2i+4,-0.35},1],
Inset[Style[TraditionalForm[i+5],FontSize->21,FontColor->Black],{2i+4,-0.35}]},{i,1,2}],
{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{4,-0.35},1],
Inset[Style[TraditionalForm[5],FontSize->21,FontColor->Black],{4,-0.35}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{21,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{21,0}]},


{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{23,0},1],
Inset[Style[TraditionalForm[8],FontSize->21,FontColor->Black],{23,0}]},
{EdgeForm[Thick],FaceForm[Pink],Opacity[0.8],Disk[{25,0},1],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{25,0}]},


Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+15,0},1],
Inset[Style[TraditionalForm[i+1],FontSize->21,FontColor->Black],{2i+15,0}]},{i,0,3}]},Axes->False,AxesOrigin->{0,0},ImageSize->Large];
graphCaseIIWt3=Graphics[{
{Thickness[0.007],Black,Circle[{-6,1.5},{4.5,1.5},{π,2π}],Circle[{6,0},{4.5,1.5},{π,2π}],Line[{{-6,0},{-6,-3}}],Line[{{6,-1.5},{6,-3}}]},Gray,EdgeForm[{Thick,Black}],Rectangle[{-12,-4},{12,-3}],

{EdgeForm[Thick],FaceForm[Pink],Opacity[0.8],Disk[{-6,1.05},1.],
Inset[Style[TraditionalForm[12],FontSize->21,FontColor->Black],{-6,1.05}]},

{EdgeForm[Thick],FaceForm[Green],Opacity[0.8],Disk[{6,-0.4},1.],
Inset[Style[TraditionalForm[1],FontSize->21,FontColor->Black],{6,-0.4}]},

Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+19,0},1],
Inset[Style[TraditionalForm[i+1],FontSize->18,FontColor->Black],{2i+19,0}]},{i,0,4}],
Table[{EdgeForm[Thick],FaceForm[Green],Opacity[0.9],Disk[{2i+8,-2.4},1],
Inset[Style[TraditionalForm[i+1],FontSize->18,FontColor->Black],{2i+8,-2.4}]},{i,5,10}]},

Axes->False,AxesOrigin->{0,0},ImageSize->{700}];


Manipulate[
Which[caseIA,Column[{Show[grafCaseAWt1,ImageSize->Large],
Show[grafCaseAWt2a,ImageSize->Large],Show[grafCaseAWt3,ImageSize->Large]}],
caseIB,Column[{Show[grafCaseAWt2b,ImageSize->Large],Show[grafCaseAWt3b,ImageSize->Large]}],caseII,Column[{Show[graphCaseII,ImageSize->Large],Show[graphCaseIIWt2,ImageSize->Large],Show[graphCaseIIWt3,ImageSize->Large]}],
True,Show[graphCoins]],
Row[{
Control[{{caseIA,False,"first case"},{False,True}}],Spacer[30],Control[{{caseIB,False,"first case b"},{False,True}}],Spacer[30],Control[{{caseII,False,"Second Case"},{False,True}}]}],TrackedSymbols:>{caseIA,caseIB,caseII},SaveDefinitions->True]]

Part II Geometry

Ratio of Areas in a Square

ClearAll["Global`*"];

Manipulate[
Graphics[{{GrayLevel[0.7],Polygon[{{0,0},{10,0},{10,10},{0,10},{0,0}}]},
{Yellow,Polygon[{{0,0},{(100/(10+z)),((10 z)/(10+z))},{0,10}}]},{Yellow,Polygon[{{10,0},{10,z},{(100/(10+z)),((10 z)/(10+z))}}]},If[hint,{PointSize[0.02],Purple,Point[{10/(1+0.1 z),z/(1+0.1 z)}],Dashing[0.03],Arrow[{{10/(1+0.1 z),z/(1+0.1 z)},{10,z/(1+0.1 z)}}],Arrow[{{10/(1+0.1 z),z/(1+0.1 z)},{10/(1+0.1 z),0}}]
}],

{Thick,Line[{{0,0},{10,0}}]},
{Thick,Line[{{10,0},{10,10}}]},{Thick,Line[{{10,10},{0,10}}]},{Thick,Line[{{0,10},{0,0}}]},{Thick,Blue,Line[{{0,10},{10,0}}]},
{Thick,Red,Line[{{0,0},{10,z}}]},
Inset[Style[" I ",18,Bold],{9.7,0.9}],Inset[Style[" II",18,Bold],{7,0.5}],Inset[Style[" III ", 18,Bold],{2,4}],Inset[Style[" IV",18,Bold],{5,7}],
If[Answer,
Inset[Style[Row[{"Ratio of \n","Area I : Area II : Area III : Area IV  ="," \n ","   1   :   ",10 /z,"   :   ", ((((10/z)))^2), "   :   ", ((100 + 10 z -(z^2))/(z^2))}],16,Bold,Blue],{5,12}],{Inset[Style[Row[{"Calculate the ratio of \n","Area I : Area II : Area III : Area IV "}],16,Bold],{5,12} ]}]}],

Grid[{{Control[{{z,2,"height"},1,9.,0.1,Appearance->"Labeled"}]},{Control[{{hint,False,"hint"},{False,True}}],Control[{{Answer,False,"Answer"},{False,True}}]}}],TrackedSymbols->{z,hint,Answer}]

Calculate the ratio of shaded Areas in a Rectangle

Based on AMC 12 A, February 2, 2016

Manipulate[
yellowArea=2 ( (2.5+4-z)(4)/2+2.5 (3-w)/2);
(* Half of the gray area consists of two triangles:
The first has a base of 1 + w and height = 2.5
The second has a base of 1+ z and height = 4.
Hence the gray area = (1+ w )2.5 + (1+z) 4 *)
grayArea=(1+w ) 2.5 + (1+z ) 4;
(*grayArea=40-yellowArea;*)
ratio=FullSimplify[yellowArea/grayArea];
Graphics[{{Yellow,Opacity[0.9],Polygon[{{0,0},{8,0},{8,5},{0,5},{0,0}}]},
{GrayLevel[0.7],Polygon[{{7-w,0},{8,0},{8,1+z},{4,2.5}}]},{GrayLevel[0.7],Polygon[{{0,4-z},{4,2.5},{1+w,5},{0,5}}]},
{Thick,Line[{{0,0},{8,0}}]},
{Thick,Line[{{8,0},{8,5}}]},{Thick,Line[{{8,5},{0,5}}]},{Thick,Line[{{0,5},{0,0}}]},{Thick,Blue,Line[{{0,4-z},{8,1+z}}]},
{Thick,Red,Line[{{1+w,5},{7-w,0}}]},
Line[{{0,0},{0,-1.6}}],Line[{{8,0},{8,-1.6}}],Line[{{8,0},{9.6,0}}],Line[{{8,1+z},{9,1+z}}],Line[{{8,5},{9.6,5}}],Line[{{7-w,0},{7-w,-1}}],
Arrowheads[{-0.03,0.03}],Arrow[{{0,-0.8},{7-w,-0.8}}],Arrow[{{7-w,-0.8},{8,-0.8}}],Arrow[{{0,-1.4},{8,-1.4}}],
Arrow[{{8.6,0},{8.6,1+z}}],Arrow[{{8.6,1+z},{8.6,5}}],Arrow[{{9.4,0},{9.4,5}}],
Inset[Style[" 8 cm",14,Purple],{4,-1.2}],Inset[Style[StandardForm[7-w],14,Purple],{(7-w)/2,-0.5}],
Inset[Style[StandardForm[1+w],14,Purple],{8-(1+w)/2,-0.5}],
Inset[Style[" 5 cm",14,Purple],{9.2,2.5}],Inset[Style[StandardForm[4-z],14,Purple],{8.5,1+(4+z)/2}],
Inset[Style[StandardForm[1+z],14,Purple],{8.5,(1+z)/2}],
If[hint,{Red,Arrowheads[0.03],Arrow[{{4,2.5},{4,0}}],Arrow[{{4,2.5},{8,2.5}}],Line[{{0,5},{8,0}}],
Inset[Style["4 cm",14],{6,2.7}],Inset[Style["2.5 cm",14],{4,1.25}]
}
],
If[Answer,
Inset[Style[Row[{"Gray area = ",grayArea,"  (cm^2)",Spacer[55],"Yellow area = ",yellowArea,"  (cm^2)\n Ratio of Gray area  : Yellow area = \n ",Spacer[53],"   1   :   ",ratio,"\n"}],12,Blue,Italic],{5,7}],{Inset[Style[Row[{"Calculate the ratio of \n","Gray area  :  Yellow area II "}],17,Italic,FontFamily->"Palatino"],{4,7} ]}]}],

Row[{Control[{{w,0,"length"},0,6.,0.1,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{z,0,"height"},0,4,0.1,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{hint,False,"Hint"},{False,True}}],Spacer[5],Control[
{{Answer,False,"Answer"},{False,True}}]}],TrackedSymbols->{w,z,hint,Answer},SaveDefinitions->True]

Application of Euler' s theory :
Cos [ θ ] + i Sin [θ ] = (e^(i θ)),
Cos [ θ ] - i Sin [θ ] = (e^(-i θ))

A square is constructed on the side of an arbitrary quadrilateral.
Prove that the segments joining the centers of the opposite squares are perpendicular and are pf equal lengths.

Proof:
Let 2 a, 2 b, 2 c, and 2 d represent complex numbers running along the edgees of the quadrilateral.  The only condition is that the quadrilateral close up, i.e.
		a + b + c + d = 0
Choose the origin of C to be at the vertex where 2 a begins.  Then:
 point p = a + i a ;
 point q = 2 a + b + i b;
 point r = 2 a + 2 b + c + i c;
 point s = 2 a + 2 b + 2 c + d + i d.
 The complex number A = s - q from q to s and B = r - p ( from p to r ) are given by:
 
 	A = ( b + 2 c + d) + i (d - b)  and
 	B = (a + 2 b + c) + i (c - a).
 	
 We wish to show that A and B are perpendicular and of equal length.
 This means that B = i A, which says that B is A rotated by π/2,
  which is the same as A + iB = 0
  A+ i B = (a + b + c + d ) + i (a + b + c + d ) = 0

ClearAll["Global`*"];

Framed[DynamicModule[{v,a1,b2,c1,d1,d2,answer,theta},Manipulate[

v={{a1,0},{0,b2},{c1,0},{d1,d2}};
lengthA=EuclideanDistance[{(a1-b2)/2,(b2-a1)/2},{(c1+d1-d2)/2,(d1+d2-c1)/2}];
lengthB=EuclideanDistance[{(b2+c1)/2,(b2+c1)/2},{(a1+d1+d2)/2,(a1-d1+d2)/2}];
slopeA=((d1+d2-c1)/2- (b2-a1)/2)/( (c1+d1-d2)/2-(a1-b2)/2);
slopeB=((a1-d1+d2)/2-(b2+c1)/2)/((a1+d1+d2)/2-(b2+c1)/2);
slopeAB =slopeA slopeB;
Column[{
Item[If[answer,Style[Row[{"\nlength A = ",lengthA,",",Spacer[12],"slope A = ",slopeA,"\nlength B = ",lengthB,",",Spacer[12],"slope B = ",slopeB,"\nProduct of slopes = ",slopeAB,"\n"}],16,Italic,Blue],Row[{Style["\nGiven any quadrilateral with side lengths\n 2 a, 2 b, 2 c, and 2 d",14,Black,Italic],Style["\nShow that A + i B = 0, where i =(Sqrt[-1])\n",15,Blue,Italic]}]],Frame->True,Alignment->{Left}],
Item[

Graphics[{GraphicsComplex[v,Arrow[{1,2,3,4,1}]],

{EdgeForm[{Dashed,Blue}],FaceForm[{Pink,Opacity[0.7]}],
Polygon[{v[[1]],v[[2]],{-b2,b2-a1},{a1-b2,-a1}}],
Polygon[{v[[2]],v[[3]],{c1+b2,c1},{b2,c1+b2}}],Polygon[{v[[3]],v[[4]],{d1-d2,d1+d2-c1},{c1-d2,d1-c1}}],Polygon[{v[[1]],v[[4]],{d1+d2,a1-d1+d2},{a1+d2,a1-d1}}]},

{Red,Line[{v[[1]],{-b2,b2-a1}}],Line[{v[[2]],{a1-b2,-a1}}],Line[{v[[3]],{b2,c1+b2}}],Line[{v[[4]],{a1+d2,a1-d1}}],Line[{v[[3]],{d1-d2,d1+d2-c1}}],Line[{v[[2]],{c1+b2,c1}}],Line[{v[[4]],{c1-d2,d1-c1}}],Line[{v[[1]],{d1+d2,a1-d1+d2}}]},

GraphicsComplex[v,{{FaceForm[Yellow],Polygon[{1,2,3,4}]},
Rotate[{EdgeForm[{Thick,Black}],FaceForm[Red,Opacity[0.5]],Polygon[{{(b2+c1)/2,(b2+c1)/2},{c1,0.0001},{(a1+d1+d2)/2,(a1-d1+d2)/2}}]},theta,{(a1+c1)/2,(0.001)}],
{Arrow[{1,2}],Arrow[{2,3}],Arrow[{3,4}],Arrow[{4,1}]}}],
{Blue,Thick,Arrow[{{(a1-b2)/2,(b2-a1)/2},{(c1+d1-d2)/2,(d1+d2-c1)/2}}],Arrow[{{(b2+c1)/2,(b2+c1)/2},{(a1+d1+d2)/2,(a1-d1+d2)/2}}]},
(*Text[Style["+",28,Black],{(a1+c1)/2,0}],*)
{PointSize[0.03],Black,Point[{(a1+c1)/2,0}]},Text[Style["P",16,Black,Italic,Bold],{(a1-b2)/2-0.1,(b2-a1)/2+0.2}],
Text[Style["Q",16,Black,Italic,Bold],{(b2+c1)/2,(b2+c1)/2+0.2}],
Text[Style["R",16,Black,Italic,Bold],{(c1+d1-d2)/2+0.2,(d1+d2-c1)/2}-0.15],
Text[Style["M",16,Black,Italic,Bold],{0.001,b2+0.2}],
Text[Style["N",16,Black,Italic,Bold],{(c1)+0.15,(0.001)}],
Text[Style["T",16,Black,Italic,Bold],{(a1+b2),(a1+b2)-0.25}],
Text[Style["S",16,Black,Italic,Bold],{(a1+d1+d2)/2-0.1,(a1-d1+d2)/2-0.1}],
Text[Style["A",20,Blue,Italic,Bold],{(a1+d1+d2)/2+0.3,(a1-d1+d2)/2+0.4}],
Text[Style["B",20,Blue,Italic,Bold],{(c1+d1-d2)/2-0.1,(d1+d2-c1)/2+0.4}],
Text[Style["2 a",14,Black,Italic],{-0.25,b2-0.3}],Text[Style["2 b",14,Black,Italic],{c1-0.35,0.15}],
Text[Style["2 c",14,Black,Italic],{d1+0.2,d2+0.2}],Text[Style["2 d",14,Black,Italic],{a1+0.4,-0.1}],
Text[Style["O",16,Black,Italic,Bold],{a1-0.15,0}]

},Axes->True,AspectRatio->Automatic,PlotRange->All,ImageSize->{450,300}],Frame->True,Alignment->{Center}]
}],
Grid[{{Control[{{a1,-1.5,"a1"},-0.5,-2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{b2,1,"b2"},0.5,2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{c1,1,"c1"},0.5,2.5,Appearance->"Labeled",ImageSize->Tiny}]},{Control[
{{d1,-0.5,"d1"},-0.5,-2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{d2,-0.5,"d2"},-0.5,-2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[{{theta,0.,"beta"},0,π/2,π/180,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"answer"},{False,True}}]}
}],
TrackedSymbols:>{a1,b2,c1,d1,d2,answer,theta},SaveDefinitions->True]],
Background->White,FrameStyle->{Thick,Black}]

Ratio between areas of circles and area of the encompassing triangle

ClearAll["Global`*"];

DynamicModule[{n,answer,radius},Manipulate[
lineOfCircles[n_,loc_,r_]:=(*Table[{Thick,Blue,Circle[loc+{(i-1)*2*r,0},r]},{i,n}];*)
Table[{EdgeForm[Directive[Thick,Blue]],RGBColor[1,0,1],Disk[loc+{(i-1)*2*r,0},r]},{i,n}];

areaofcircles[n_]:=π n (n+1)(((radius[n]))^2)/2;
areaoftriangle:=(Sqrt[3]);
ratio[n_]:=((π n (n+1)(((radius[n]))^2))/(2 (Sqrt[3])));
triangle={Line[{{-1,0},{0,Sqrt[3]}}],Line[{{0,Sqrt[3]},{1,0}}],Line[{{1,0},{-1,0}}]};

triangleOfCircles[n_,loc_,radius_]:=Table[lineOfCircles[n-(i-1),loc+(i-1)*2 radius*{Cos[π/3],Sin[π/3]},radius],{i,1,n}];Graphics[{If[answer,
Inset[Style[TraditionalForm[Row[{"\!\(\*FractionBox[\(Total\\ area\\ of\\ Circles\), \(Area\\ of\\ Triangle\)]\) = ",ratio[n]}]],16,Purple,Bold],{0,2}],Inset[Style["\nCalculate the ratio between \nthe total area of circles and the area of triangle\n",16,Black,Italic],{0,2}]], {Thick,triangle,triangleOfCircles[n,{-(n-1)*radius[n],radius[n]},radius[n]]}}],Row[{Control[{{n,1,"number of circles"},1,30,1,Appearance->"Labeled"}],Spacer[33],Control[{{answer,False,"Answer"},{False,True}}]}],TrackedSymbols->{n,answer},Initialization:>{ClearAll["Global`*"];,radius[m_]:=Abs[(1/(m-1+(Sqrt[3])))];},      SaveDefinitions->True]]

Another AMC problem.  Illustrating the solution with Mathematica

An American H.S. Math Exam Question by Izidor Hafner
 4 - 11 - 16 modified by Abe Gadalla 4 - 25 - 16

DynamicModule[{α,β,hint,angle},Manipulate[SeedRandom[ranint];With[{prava=α-2 β},With[{answ=RandomSample[Join[RandomSample[Complement[Table[prava+i,{i,-5,9}],{prava}],4],{prava}],5]},With[{indan=Position[answ,prava][[1,1]],answ2=Table[((answ[[i]])^o),{i,1,5}]},Module[{cp=Sin[β Degree]/Sin[(α-β)Degree],rez=α-2 β},
Text@Style[Column[{
Graphics[{Line[{{-1,0},{1,0}}],Line[{{-Cos[α Degree],Sin[α Degree]},{0,0}}],Line[{{-Cos[α Degree],Sin[α Degree]},{cp,0}}],Line[{{Cos[(α -2β)Degree],Sin[(α -2β)Degree]},{0,0}}],Line[{{Cos[(α -2β)Degree],Sin[(α -2β)Degree]},{cp,0}}],Circle[{0,0},1,{0,Pi}],
Text[Style["A",16],1.1{-Cos[α Degree],Sin[α Degree]}],
Text[Style["B",16],1.1{Cos[(α -2β)Degree],Sin[(α -2β) Degree]}],
Text[Style["M",16],{-1,-0.1}],
Text[Style["C",16],{0,-0.1}],
Text[Style["P",16],{cp,-0.1}],
Text[Style["N",16],{1,-0.1}],
Text[Style[Row[{α,"°"}],16],{-0.18,0.05}],Text[Style[Row[{β,"°"}],14],{-Cos[(α+β)/2 Degree+0.6],Sin[α Degree]-0.15}],
Text[Style[Row[{β,"°"}],14],{0.8Cos[(α -2β)Degree],0.85Sin[(α -2β) Degree]}],


If[hint,{{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Opacity[0.5],Polygon[{{0,0},{Cos[(α -2β)Degree],Sin[(α-2β) Degree]},{cp,0}}]},
Rotate[{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Opacity[0.5],Polygon[{{0,0},{Cos[(α -2β)Degree],Sin[(α-2β) Degree]},{cp,0}}]},angle Degree,{0,0}],{Dashing[0.01],Circle[{0,0},cp,{0,(angle)Degree}]},If[angle==180-2(α-β),
Text[Style["Q",16],1.1 cp{-Cos[2(α-β) Degree]+0.1,Sin[2(α-β) Degree]+0.1}]]
}
]

},
PlotRange->{{-1.2,1.2},{-0.2,1.2}},ImageSize->1.06{400,250}],Row[{"The distinct points A and B are on a semicircle of diameter MN"}],Row[{"and center C. The point P is on CN and ∠CAP = ∠CBP = (β^o)."}],Row[{"If ∠ACM = (α^o), then ∠NCB equals"}],Row@Map[Row,Inner[List,{"  (a)  ","  (b)  ","  (c)  ","  (d)  ","  (e)  "},answ2,List]],If[x==="","  ",If[x==indan,"Correct.","Wrong!"]]},Alignment->Center],14]
]]]],
Row[{Control[
{{α,40},35,50,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{β,10},4,17,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{hint,False,"hint"},{False,True}}],Spacer[30],Control[{{angle,0 ,"angle"},0,180-2(α-β),1,Appearance->"Labeled",ImageSize->Tiny}]
}],{{ranint,RandomInteger[{1,400}]},ControlType->None},
Button[Style["random question",Background->Yellow],x="";sh=False;α=RandomInteger[{35,50}];β=RandomInteger[{4,17}];ranint=RandomInteger[{1,1990}]],"   ",{{x,"","answer"},{1->"a",2->"b",3->"c",4->"d",5->"e"},ControlType->RadioButtonBar,ControlPlacement->Bottom},TrackedSymbols:>{α,β,hint,angle}]]

Illustrating the relationship among the Geometric Mean, Arithmetic Mean and the Harmonic Mean

ClearAll["Global`*"];

cir[{x_,y_},rad_,angle_]={Thick,Blue,Circle[{x,y},r,{0,π}],PointSize[0.01],Point[{x,y}]};
r=1;
y[x_]:= Sqrt[(r^2 -(x-r)^2)];
Graphics[{
cir[{r,0},1,{0,π}],{Thick,Blue,Arrow[{{r,0},{1.5 r,y[1.5 r]}}],Red,Arrow[{{1.5r,0},{1.5 r,y[1.5 r]}}],Purple,Arrow[{{1.5r,0},{4.5 r/4,(Sqrt[3])r/8}}],Black,Arrow[{{4.5 r/4,(Sqrt[3])r/8},{1.5 r,y[1.5 r]}}],
PointSize[0.015],Green,Point[{4.5 r/4,(Sqrt[3])r/8}],Blue,Point[{1.5 r,y[1.5 r]}],
Line[{{0,0},{2r,0}}]},
Inset[Style["C ",14,Bold,Blue],{-0.08,0}],Inset[Style["G ",14,Bold,Red],{1.502 r+0.08,0.04}],
Inset[Style["D ",14,Bold,Blue],{2. r+0.08,0}],Inset[Style["M ",14,Bold,Red],{1.52 r,y[1.5 r]+0.06}],
Inset[Style["GM = \!\(\*SqrtBox[\(k\\ l\)]\) ",14,Bold,Red],{1.52 r,y[1.5 r]/2}],
Inset[Style[" HM = \!\(\*FractionBox[\(2\\ k\\ l\), \(k + l\)]\) ",14,Bold,Black,Italic],{ r,r/2}],
Inset[Style["OM = AM = ((k + l)/2) ",14,Bold,Blue,Italic],{ 0.85r,0.8r}],
Inset[Style["H ",14,Bold,Black],{4.5 r/4-0.04,(Sqrt[3])r/8}],
Inset[Style["O ",14,Bold],{ r,-0.05}],Black,
Inset[Style["k ",14,Bold,Italic],{ 3r/4,-0.15}],Black,
Inset[Style["l ",14,Bold,Italic],{ 7r/4,-0.15}],Black,
Line[{{0,0},{0,-0.25}}],Line[{{1.5 r,0},{1.5 r, -0.25}}],Line[{{2r,0},{2 r,-0.25}}],
Arrowheads[{-0.03,0.03}],Arrow[{{0,-0.2},{1.5 r,-0.2}}],Arrow[{{1.5r,-0.2},{2 r,-0.2}}]



},AxesOrigin->{0,0},Axes->False]

cir[{x_,y_},rad_,angle_]={Thick,Blue,Circle[{x,y},r,{0,π}],PointSize[0.01],Point[{x,y}]};
r=1;
y[x_]:= Sqrt[(r^2 -(x-r)^2)];
Graphics[{
cir[{r,0},1,{0,π}],{Thick,Blue,Arrow[{{r,0},{0.5 r,y[0.5 r]}}],
{EdgeForm[{Thick,Black}],FaceForm[Cyan],Opacity[0.6],Disk[{0.25 r,0},0.25 r,{0,π}],Disk[{1.25 r,0},0.75 r,{0,π}]},PointSize[0.02],Blue,Point[{0.25 r,0}],Point[{1.25 r,0}],
Red,Arrow[{{0.5r,0},{0.5 r,y[0.5 r]}}],(*{Red,Dashing[0.03],Circle[{0.5 r,0},y[0.5 r],{0,π}]},*)Purple,Arrow[{{.5r,0},{3.5 r/4,(Sqrt[3])r/8}}],Black,Arrow[{{3.5 r/4,(Sqrt[3])r/8},{.5 r,y[.5 r]}}],
PointSize[0.015],Green,Point[{3.5 r/4,(Sqrt[3])r/8}],Blue,Point[{0.5 r,y[0.5 r]}],
Line[{{0,0},{2r,0}}]},
Inset[Style["C ",14,Bold,Blue],{-0.08,0}],Inset[Style["G ",14,Bold,Red],{0.46 r,0.06}],
Inset[Style["D ",14,Bold,Blue],{2. r+0.08,0}],Inset[Style["M ",14,Bold,Red],{0.48 r,y[0.48 r]+0.06}],
Inset[Style["GM = \!\(\*SqrtBox[\(k\\ l\)]\) ",14,Bold,Red],{0.48 r,y[0.48 r]/2}],
Inset[Style[" HM = \!\(\*FractionBox[\(2\\ k\\ l\), \(k + l\)]\) ",14,Bold,Black,Italic],{ r,r/2}],
Inset[Style["OM = AM = ((k + l)/2) ",14,Bold,Blue,Italic],{ 0.95r,0.8r}],
Inset[Style["H ",14,Bold,Black],{3.5 r/4+0.08,(Sqrt[3])r/8}],
Inset[Style["O ",14,Bold],{ r,-0.07}],Black,
Inset[Style["k ",14,Bold,Italic],{ 5r/4,-0.15}],Black,
Inset[Style["l ",14,Bold,Italic],{ r/4,-0.15}],Black,
Line[{{0,0},{0,-0.25}}],Line[{{0.5 r,0},{.5 r, -0.25}}],Line[{{2r,0},{2 r,-0.25}}],
Arrowheads[{-0.03,0.03}],Arrow[{{0,-0.2},{0.5 r,-0.2}}],Arrow[{{0.5r,-0.2},{2 r,-0.2}}]



},AxesOrigin->{0,0},Axes->False]

Schumacher's Knife

Prove that the area of the shaded region is equal to the area of the red circle

ClearAll["Global`*"];

Module[{a,b},Manipulate[

 Show[Graphics[{

{GrayLevel[0.8],Disk[{a+b,0},a+b,{0, Pi}]},
{GrayLevel[1.0],Disk[{a,0},a,{0, Pi}]},
{GrayLevel[1.0],Disk[{2 a+b,0},b,{0, Pi}]},

	Line[{{0,0}, {2*(a+b), 0}}],
	Line[{{2 a,0}, {2 a,2 Sqrt[a b]}}],
	
	Thick,Blue,Circle[{a,0},a, {0, Pi}],
	{PointSize[0.02], Blue, Point[{a, 0}]},
	Thick,Red,Circle[{2 (a),Sqrt[a b]},Sqrt[a b], {0,2 Pi}],
	{PointSize[0.02], Red, Point[{2 (a),Sqrt[a b]}]},
	Thick,Black,Circle[{a + b,0},(a +b), {0,Pi}],
	{PointSize[0.02], Black, Point[{ a + b, 0}]},
	Thick,Blue,Circle[{2 a+b,0},b,{0, Pi}],
	{PointSize[0.02], Blue, Point[{2 a + b, 0}]},
	Text[Style["A",Black,Bold,16],{0,-.9}],
	Text[Style["B",Black,Bold,16],{2 a,-.9}],
	Text[Style["D",Black,Bold,16],{2 (a+b),-.9}],
	Text[Style["C",Black,Bold,16],{2 a,2 Sqrt[a b]+.7}],
	Inset[Row[{Style["Shaded Area = ",18,Bold,Black],
	Style[π a b,18,Bold,Black],"  ",Style[Superscript[in,2],18,Bold,Black]}],{a/2,2 Sqrt[a b]+7}],
	Inset[Row[{Style["Area of Red Circle = ",18,Bold,Red],
	Style[π a b,18,Bold,Red],"  ",Style[Superscript[in,2],18,Bold,Red]}],{2 a,2 Sqrt[a b]+7}],
	ImageSize-> {600,600},AspectRatio-> Automatic
	
	}],ImageSize->Large],
	Row[{Control[
	{{a,9," LeftRadius a"},1,10,Appearance->"Labeled",ImageSize->Tiny}]Spacer[15],Control[
	{{b,5,"RightRadius b"},1,6,Appearance->"Labeled",ImageSize->Tiny}]}],TrackedSymbol->{a,b}]]

Find the Ratio between a chord and a radius

ClearAll["Global`*"];

Manipulate[
cir[{x_,y_},rad_,angle_]={Thick,Blue,Circle[{x,y},r,{0,2π}],PointSize[0.01],Point[{x,y}]};
Graphics[{cir[{0,0},r,{0,2 π}],cir[{2 r,0},r,{0,2 π}],cir[{4 r,0},r,{0,2 π}],{Thick,Line[{{0,0},{((15 r)/4),(((Sqrt[15]) r)/4)}}],
Line[{{-r,0},{5 r,0}}]},
Red,PointSize[0.01],Point[{(((15) r)/4),((((Sqrt[15])) r)/4)}],
Purple,PointSize[0.01],Point[{(((15-3(Sqrt[5])) r)/8),((((Sqrt[15])-(Sqrt[3])) r)/8)}],Purple,PointSize[0.01],Point[{(((15+3(Sqrt[5])) r)/8),((((Sqrt[15])+(Sqrt[3])) r)/8)}],Red,Thick,Line[{{4 r,0},{((15 r)/4),(((Sqrt[15]) r)/4)}}],
Inset[Style["A ",14,Bold],{0,-0.7}],
Inset[Style["S ",14,Bold],{(((15-3(Sqrt[5])) r)/8),((((Sqrt[15])-(Sqrt[3])) r)/8)+0.5}],

Inset[Style["B ",14,Bold],{2 r,-0.7}],Inset[Style["T ",14,Bold],{(((15+3(Sqrt[5])) r)/8),((((Sqrt[15])+(Sqrt[3])) r)/8)+0.5}],

Inset[Style["C ",14,Bold],{4 r,-0.7}],Inset[Style[ "r ",14,Bold,Red],{4.05 r, r/2}],

Inset[Style["D ",14,Bold],{((15 r)/4),(((Sqrt[22]) r)/4)}],
If[Answer,Switch[Steps,1,{

Dashing[0.01],Purple,Line[{{2 r,0},{(((15+3(Sqrt[5])) r)/8),((((Sqrt[15])+(Sqrt[3])) r)/8)}}],Line[{{2 r,0},{(((15) r)/8),((((Sqrt[15])) r)/8)}}],

PointSize[0.01],Purple,Point[{(((15) r)/8),((((Sqrt[15])) r)/8)}],Inset[Style[" E ",14,Bold,Purple],{(((15) r)/8),((((Sqrt[25])) r)/8)}]},
2,{Dashing[0.01],Purple,Line[{{2 r,0},{(((15+3(Sqrt[5])) r)/8),((((Sqrt[15])+(Sqrt[3])) r)/8)}}],Line[{{2 r,0},{(((15) r)/8),((((Sqrt[15])) r)/8)}}],

PointSize[0.01],Purple,Point[{(((15) r)/8),((((Sqrt[15])) r)/8)}],Inset[Style[" E ",14,Bold,Purple],{(((15) r)/8),((((Sqrt[25])) r)/8)}],Inset[Style["(BE/CD) = (AB/AC) = (1/2) ",14,Bold,Purple],{0,5.}]},3,{Dashing[0.01],Purple,Line[{{2 r,0},{(((15+3(Sqrt[5])) r)/8),((((Sqrt[15])+(Sqrt[3])) r)/8)}}],Line[{{2 r,0},{(((15) r)/8),((((Sqrt[15])) r)/8)}}],

PointSize[0.01],Purple,Point[{(((15) r)/8),((((Sqrt[15])) r)/8)}],Inset[Style[" E ",14,Bold,Purple],{(((15) r)/8),((((Sqrt[25])) r)/8)}],Inset[Style["(BE/CD) = (AB/AC) = (1/2) ",14,Bold,Purple],{0,5.}],Inset[Style["The Ratio     ST : r  = (Sqrt[3]) : 1 \n",16,Bold,Blue],{10,5}]}],
{Inset[Style["Calculate the Ratio       ST : r ", 16,Bold,Red,Italic],{r,5}]}]},Axes->False,PlotRange->{{-4,23},{-4,7}},ImageSize->Large],
{{r,3,"Radius"},1,4,Appearance->"Labeled"},{{Answer,False,"Answer"},{False,True}},
{{Steps,1,"Steps"},{1,2,3},ControlType->RadioButton},(*Enabled->If[Answer,True,False]},*)TrackedSymbols->{r, Answer,Steps}]

Find the Ratio between a chord and a radius variation 2

Manipulate[
cir[{x_,y_},rad_,angle_]={Thick,Blue,Circle[{x,y},r,{0,2π}],PointSize[0.01],Point[{x,y}]};
Graphics[{cir[{r,0},r,{0,2 π}],cir[{3 r,0},r,{0,2 π}],cir[{5 r,0},r,{0,2 π}],{Thick,Line[{{0,0},{((24 r)/5),(((Sqrt[24]) r)/5)}}],
Line[{{-r/2,0},{13 r/2,0}}]},
Red,PointSize[0.015],Point[{(((24) r)/5),((2(Sqrt[6]) r)/5)}],
Purple,PointSize[0.01],Point[{(2.88-0.32 (Sqrt[6]))r,(0.24(Sqrt[6])-0.16)r}],
Purple,PointSize[0.01],Point[{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r}],Red,Thick,Line[{{5 r,0},{((24 r)/5),(((Sqrt[24]) r)/5)}}],
Inset[Style["A ",14,Bold],{0,-0.7}],
Inset[Style["S ",14,Bold],{(2.88-0.32 (Sqrt[6]))r,(0.24(Sqrt[6])-0.16)r+0.6}],

Inset[Style["B ",14,Bold],{3 r,-0.7}],Inset[Style["T ",14,Bold],{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r+0.5}],

Inset[Style["C ",14,Bold],{5 r,-0.7}],Inset[Style[ "r ",14,Bold,Red],{5.05 r, r/2}],

Inset[Style["D ",14,Bold],{((24r)/5),(((Sqrt[24]) r)/5)+0.7}],
{Inset[Style["Calculate the Ratio       ST : r ", 16,Bold,Black,Italic],{2r,7}],Inset[Style["Write the coordinates of the points: S , T, and D", 14,Bold,Black,Italic],{2r,6}]},
If[Answer,{Inset[Row[{Style["D = ",14,Purple,Bold],Style[NumberForm[{((24.r)/5),(((Sqrt[24.]) r)/5.)},{6,3}],12,Bold,Purple]}],{6 r, 7.}],
Inset[Row[{Style["T = ",14,Purple,Bold],Style[NumberForm[{(((72.+8.(Sqrt[6])) r)/25.), ((4.+6.(Sqrt[6]))/25)},{6,3}],12,Bold,Purple]}],{6 r, 6}],
Inset[Row[{Style["E = ",14,Purple,Bold],Style[NumberForm[{((72. r)/25.), ((6.r(Sqrt[6.]))/25.)},{6,3}],12,Bold,Purple]}],{6 r,5}],

Inset[Row[{Style["S = ",14,Purple,Bold],Style[NumberForm[{(((72.-8.(Sqrt[6.])) r)/25), ((-4+6(Sqrt[6.]))/25.)},{6,3}],12,Bold,Purple]}],{6 r, 4}],Switch[Steps,1,{

Dashing[0.01],Purple,Arrowheads[0.02],Arrow[{{3 r,0},{2.88 r,(0.24(Sqrt[6])) r}}],Arrow[{{3 r,0},{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r}}],
Green,PointSize[0.015],Point[{2.88 r,(0.24(Sqrt[6])) r}],
Inset[Style[" E ",12,Bold,Purple],{2.88 r,(0.24(Sqrt[6.])) r+0.5}],

},
2,{Dashing[0.01],Red,Arrowheads[0.02],Arrow[{{3 r,0},{2.88 r,(0.24(Sqrt[6])) r}}],Arrow[{{3 r,0},{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r}}],
Green,PointSize[0.015],Point[{2.88 r,(0.24(Sqrt[6])) r}],
PointSize[0.01],Purple,Point[{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r}],Inset[Style[" E ",14,Bold,Purple],{2.88 r,(0.24(Sqrt[6])) r+0.5}],Inset[Style["(BE/CD) = (AB/AC) = (3/5) ",14,Bold,Purple],{0,4.}]},
3,{Dashing[0.01],Purple,Arrowheads[0.02],Arrow[{{3 r,0},{2.88r,0.24 (Sqrt[6]) r}}],Arrow[{{3 r,0},{(2.88+0.32 (Sqrt[6]))r,(0.24(Sqrt[6])+0.16)r}}],
Green,PointSize[0.015],Point[{2.88 r,(0.24(Sqrt[6])) r}],
Inset[Style[" E ",14,Bold,Purple],{2.88 r,(0.24(Sqrt[6])) r+0.5}],Inset[Style["(BE/CD) = (AB/AC) = (3/5) ",14,Bold,Purple],{0,4.}],Inset[Style["The Ratio     ST : r  = 8 : 5 \n",16,Bold,Blue],{9,4}]}]
}
]},Axes->False,PlotRange->{{-4,23},{-4,8}},ImageSize->Large],
Row[{Control[
{{r,3,"Radius"},1,4,Appearance->"Labeled",ImageSize->Tiny}],Spacer[45],Control[{{Answer,False,"Answer"},{False,True}}],Spacer[15],Control[
{{Steps,1,"Steps"},{1,2,3},ControlType->RadioButton}]}],TrackedSymbols->{r, Answer,Steps}]

Geometric mean between  r1 and r3 of three angent circles

ClearAll["Global`*"];

DynamicModule[{r1,r3,answer,u,v,check},Manipulate[
cir[center_,radius_]={Thick,Circle[center,radius],PointSize[0.01],Point[{center}]};
dsc[center_,radius_]={Disk[center,radius],PointSize[0.01],Point[{center}]};
r2=(Sqrt[r1 r3]);alpha=ArcSin[(r3-r2)/(r3+r2)];
Column[{
Item[
If[answer,Style[Row[{"\nradius of the middle circle = ",r2,"\nThe geometric mean between r1 = ",r1," and r3 = ",r3," is ",r2,"\n"}],14,Italic,Purple],Style[Row[{"\nGiven three tangent circles as shown with\n smallest radius r1 = ",r1," and largest radius r3 = ",r3, "\nCalculate the radius of the middle circle as well as the geometric mean between r1 and r3\n"}],12, Black]
],Alignment->Left,Frame->True],
Item[
grthree=Graphics[{cir[{r1 Cot[alpha],r1},r1],Purple,cir[{r2 Cot[alpha],r2},r2],Black,cir[{r3 Cot[alpha],r3},r3],
PointSize[0.01],Point[{r3 (Cot[alpha]-Cos[alpha]),r3(1- Sin[alpha])}],
,

{EdgeForm[{Thick,Black}],FaceForm[Cyan],Disk[{u,u Tan[alpha]},r1,{alpha,π+alpha}],PointSize[0.015],Point[{u,u Tan[alpha]}]},




If[answer,{{EdgeForm[{Thick,Black}],FaceForm[Cyan],Opacity[0.6],Disk[{r3 Cot[alpha]-r3/2 Cos[alpha],r3-(r3/2)Sin[alpha]},r3/2,{alpha,π+alpha}],PointSize[0.007],Point[{r3 Cot[alpha]-r3/2 Cos[alpha],r3-(r3/2)Sin[alpha]}]},{Thick,Blue,Circle[{(r3 Cot[alpha] +r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha])/2 ,((r3 Cot[alpha] +r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha])/2) Tan[alpha]},(r3 +r1)/2,{alpha,π+alpha}]},Red,PointSize[0.01],Point[{(r3 Cot[alpha] +r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha])/2 ,((r3 Cot[alpha] +r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha])/2) Tan[alpha]}],
Arrow[{{r3 (Cot[alpha]-Cos[alpha]),r3(1- Sin[alpha])},{r3 (Cot[alpha]-Cos[alpha])-r2 Sin[alpha],r3(1- Sin[alpha])+r2 Cos[alpha]}}],Inset[Style[Row[{Style[" r = GM (r1, r3)\n ",12,Black]," = ",r2}],12],{r3 (Cot[alpha]-Cos[alpha])-r2 Sin[alpha]+3,(r3(1- Sin[alpha])+r2 Cos[alpha])0.9}]},{}],
If[check,{EdgeForm[{Thick,Purple}],FaceForm[Yellow],Opacity[0.4],Disk[{v,v Tan[alpha]},r2,{alpha,π+alpha}],PointSize[0.01],Point[{v,v Tan[alpha]}]},{}],
Line[{{r1 Cot[alpha],r1},{r1 Cot[alpha],0}}],Line[{{r2 Cot[alpha],r2},{r2 Cot[alpha],0}}],Line[{{r3 Cot[alpha],r3},{r3 Cot[alpha],0}}],
Text[Style[Row[{"r1 = ",r1}],Small],{r1 Cot[alpha],r1/2}],
Text[Style[Row[{"r3 = ",r3}],Small],{r3 Cot[alpha],r3/2}],
If[answer,Text[Style[Row[{"r2 = ",r2}],Small],{r2 Cot[alpha],3r2/2}],
Text[Style["r2 = ?",Small],{r2 Cot[alpha],r2/2}]]


},Axes->True,AxesLabel->{Style["x",Large,Bold,Italic],Style["y",Large,Bold,Italic]},
AxesStyle->{{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,14]},{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,14]}},AxesOrigin->{0,0}];

plotcntrLine=Plot[{ x Tan[alpha]},{x,-3,1.5r3 Cot[alpha] },PlotStyle->{Red,Dashing[{0.001,0.02,0.14,0.02}]}];
plotTangtLine=Plot[{ x Tan[2 alpha]},{x,-3,r3 Cot[alpha] },PlotStyle->{Blue}];
Show[grthree,plotcntrLine,plotTangtLine,ImageSize->Large],Alignment->{Center},Frame->True]
}],
Grid[{
{Control[{{r1 ,2.,"radius1"},1.,5,Appearance->"Labeled",ImageSize->Tiny}],Control[{{r3 ,9.,"radius3"},6.,15.,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"Answer"},{False,True}}]},{Control[{{u,5.2,"cntr1"},r1 Cot[alpha],r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha],Appearance->"Labeled",ImageSize->Tiny}],
Control[{{v,N[r2 Cot[alpha]],"cntr2"},r2 Cot[alpha],r3( Cot[alpha]-Cos[alpha]),Appearance->"Labeled",ImageSize->Tiny,Enabled->check}],Control[{{check,False,"Check"},{False,True},Enabled->answer}]}
}],TrackedSymbols:>{r1,r3,answer,u,v,check}]]

Given five tangent circles and the radius of the smallest and the largest one.  Find the radius of the middle one.

ClearAll["Global`*"];

DynamicModule[{r1,r5,answer},Manipulate[
r3=(Sqrt[r1 r5]);r2=(Sqrt[r1 r3]);r4=(Sqrt[r3 r5]);

alpha=ArcSin[(r5-r4)/(r5+r4)];
cir[center_,radius_]={Thick,Circle[center,radius],PointSize[0.015],Point[{center}]};

Column[{
Item[If[answer,Style[Row[{"\nThe radius of the third circle = ",r3, " cm\n"}],16,Purple],Style[Row[{"\nThe smallest circle of the five tangent circles\n has radius = ",r1," cm and the largest has radius = ", r5, " cm\n Find the radius of the middle circle\n"}],16,Black]],Alignment->Left,Frame->True],
Item[
gcircle=Graphics[{cir[{r1 Cot[alpha],r1},r1],Blue,cir[{r2 Cot[alpha],r2},r2],Purple,cir[{r3 Cot[alpha],r3},r3],Red,cir[{r4 Cot[alpha],r4},r4],Black,
cir[{r5 Cot[alpha],r5},r5],Line[{{r1 Cot[alpha],r1},{r1 Cot[alpha],0}}],Line[{{r5 Cot[alpha],r5},{(r5)Cot[alpha],0}}],Purple,Line[{{(r3)Cot[alpha],r3},{(r3)Cot[alpha],0}}],

Text[Style[Row[{"r1 = ",r1, " cm"}],12,Black],{r1 Cot[alpha],r1/2}],
If[answer,Text[Style[Row[{"r3 = ",r3, " cm"}],12,Purple],{r3 Cot[alpha],3r3/2}],Text[Style[Row[{"r = ? cm"}],12,Purple],{r3 Cot[alpha],r3/2}]],
Text[Style[Row[{"r5 = ",r5, " cm"}],12,Black],{(r5)Cot[alpha],r5/2}]
},Axes->False,PlotRange->Automatic];
plotcntrLine=Plot[{0, x Tan[alpha]},{x,0.93 r1  Cot[alpha],1.03r5 Cot[alpha] },PlotStyle->{{Thick,Purple},{Red,Dashing[{0.001,0.02,0.14,0.02}]}}];
plotTangtLine=Plot[{ x Tan[2 alpha]},{x,0.93 r1  Cot[alpha],1.03r5 Cot[alpha] },PlotStyle->{Blue}];
Show[gcircle,plotcntrLine,plotTangtLine,ImageSize->Large],Alignment->{Center},Frame->True,ItemSize->{40,10}]
}],
Row[{Control[{{r1 ,12.,"radius1"},7,17.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{r5 ,18.,"radius5"},18.,30.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{answer,False,"Answer"},{False,True}}]
}],TrackedSymbols:>{r1,r5,answer},SaveDefinitions->True]]

General case for odd number of tangent circles ( n is odd)

Let alpha be the angle between the center line of the tangent circles and the horizontal line. 
Hence:

Sin (alpha) = ((r2 - r1)/(r2 + r1 )) =  ((r3 - r2)/(r3 + r2 )) =  ((r4 - r3)/(r4 + r3 )) =  ((r5 - r4)/(r5  + r 4 )) = . . .= ((r n - r (n-1))/(r n  + r (n-1) )) 
 
Solving the first two proportions together : ((r2 - r1)/(r2 + r1 )) =  ((r3 - r2)/(r3 + r2 ))   gives:  r2 = (Sqrt[r1 r3])

Similarly from : ((r4 - r3)/(r4 + r3 )) =  ((r5 - r4)/(r5  + r 4 )) , we get after simplifications:            r4 = (Sqrt[r3 r5]) 
and from:  ((r3 - r2)/(r3 + r2 )) =  ((r4 - r3)/(r4 + r3 ))  ,  we obtain       			       r3 = (Sqrt[r2 r4])
Squaring the third equation and substituting r2and r4, gives:
		(r3^2) = r2 r4 = (Sqrt[r1 r3 r3 r5]) = r3 (Sqrt[r1 r5])
Dividing by r3, since it is > 0, gives:				       r3 = (Sqrt[r1 r5])

We notice that r3 is the radius of the middle circle between the smallest and the largest;
r3 was also the middle circle between r2 and r4;  r4 is the middle circle between the third and fifth circles.
Therefore, the general case for the odd number of circles is :   (Subscript[r, (((n+1)/2))]) = (Sqrt[r1 (Subscript[r, n]) ])
where (Subscript[r, n])  is the radius of the n-circle.
In general from the above observation and from the previous example:  (Subscript[r, (((k + j)/2)) ]) = (Sqrt[(Subscript[r , k])(Subscript[r, j])])
where (Subscript[r, k])  and (Subscript[r, j])  are the radii of the kth and jth circles, and both j and k are either odd or even numbers.

Developing the formula for the radius of the k circle in that system.  Given theradius of the smallest circle (Subscript[r, 1]) and the radius of the largest circle (Subscript[r, n])

For simplicity, consider a system of four circles:

Let α be the measure of the angle between the center line of the circles and a horizontal line: 
	
	Sin [α]  = (((Subscript[r, 2]) - (Subscript[r, 1]))/((Subscript[r, 2]) + (Subscript[r, 1])))  =  (((Subscript[r, 3]) - (Subscript[r, 2]))/((Subscript[r, 3]) + (Subscript[r, 2])))  = (((Subscript[r, 4]) - (Subscript[r, 3]))/((Subscript[r, 4]) + (Subscript[r, 3])))  
	We get:  (Subscript[r, 3]^2) = (Subscript[r, 2])  (Subscript[r, 4 ]);   		(Subscript[r, 2]^2) = (Subscript[r, 1]) (Subscript[r, 3])
	then	(Subscript[r, 2]^4) = (Subscript[r, 1]^2)  (Subscript[r, 3]^2)  = (Subscript[r, 1]^2)  (Subscript[r, 2])  (Subscript[r, 4 ])  or (Subscript[r, 2]^3) = (Subscript[r, 1]^2) (Subscript[r, 4]) 		(Subscript[r, 2]) = (Subscript[r, 1]^(2/3))  (Subscript[r, 4]^(1/3))    
	Substituting (Subscript[r, 2]) in (Subscript[r, 3])  gives  (Subscript[r, 3]^2) = (Subscript[r, 1]^(2/3)) (Subscript[r, 4]^(4/3))   	or    	(Subscript[r, 3]) = (Subscript[r, 1]^(1/3))  (Subscript[r, 4]^(2/3))

For simplicity, consider a system of Six circles:

	Sin [α]  = (((Subscript[r, 2]) - (Subscript[r, 1]))/((Subscript[r, 2]) + (Subscript[r, 1])))  =  (((Subscript[r, 3]) - (Subscript[r, 2]))/((Subscript[r, 3]) + (Subscript[r, 2])))  = (((Subscript[r, 4]) - (Subscript[r, 3]))/((Subscript[r, 4]) + (Subscript[r, 3])))  =  (((Subscript[r, 5]) - (Subscript[r, 4]))/((Subscript[r, 5]) + (Subscript[r, 4]))) =  (((Subscript[r, 6]) - (Subscript[r, 5]))/((Subscript[r, 6]) + (Subscript[r, 5])));
	We have:   (Subscript[r, 2]^2) = (Subscript[r, 1]) (Subscript[r, 3])	  (Subscript[r, 3]^2) = (Subscript[r, 2])  (Subscript[r, 4   ]) =   (Subscript[r, 1])  (Subscript[r, 5 ]);  	 (Subscript[r, 4]^2) = (Subscript[r, 3])  (Subscript[r, 5 ]);    (Subscript[r, 5]^2) = (Subscript[r, 4])  (Subscript[r, 6 ]);  
	then	(Subscript[r, 5]^4) = (Subscript[r, 3]) (Subscript[r, 5])  (Subscript[r, 6]^2)        	Hence   (Subscript[r, 5]^8) =  (Subscript[r, 1]) (Subscript[r, 5])(Subscript[r, 5]^2) (Subscript[r, 6]) 		(Subscript[r, 5]) = (Subscript[r, 1]^(1/5))  (Subscript[r, 6]^(4/5))    
	From the above equations, we get:  (Subscript[r, 2]) = (Subscript[r, 1]^(4/5)) (Subscript[r, 6]^(1/5))     ,  (Subscript[r, 3]) = (Subscript[r, 1]^(3/5))  (Subscript[r, 6]^(2/5)) , and    (Subscript[r, 4]) = (Subscript[r, 1]^(2/5))  (Subscript[r, 6]^(3/5))

Taking the above equations one step further, we find the general formula for the radius in this scheme to be:

	r (k ) = ((Subscript[r, 1])^((((n - k )/(n - 1))) ))  ((Subscript[r, n])^((((k-1)/(n-1)))))   and     Sin[ α ] = ((((Subscript[r, n])^((((1 )/(n - 1))) )) -   ((Subscript[r, 1])^(((1/(n-1))))))/(((Subscript[r, n])^((((1 )/(n - 1))) )) +   ((Subscript[r, 1])^(((1/(n-1)))))))
	Where k varies from 1 to number of circles n

Given n tangent circles and the radius of the smallest and the largest one.  Find the general formula of the radius

ClearAll["Global`*"];

DynamicModule[{r1,rn,answer,n},Manipulate[

r[k_]:=r1^((n-k)/(n-1)) ( rn^((k-1)/(n-1)));
alpha=ArcSin[(rn^(1/(n-1))- r1^(1/(n-1)))/(rn^(1/(n-1))+ r1^(1/(n-1)))];

cir[center_,radius_]={Thick,Circle[center,radius],PointSize[0.015],Point[{center}]};

Column[{
Item[Which[
answer&&OddQ[n],Row[{Style["\nThe explicit formula for kth radius in terms of the first and the last circle is\n\nr[k] = r1^((n-k)/(n-1)) rn^((k-1)/(n-1))\n",18,Black],
Style[Row[{"\nThe radius of the middle circle = ",r[(n+1)/2], " cm\n"}],16,Purple]}],answer&&EvenQ[n],Row[{Style["\nThe explicit formula for kth radius in terms of the first and the last circle is\n\nr[k] = r1^((n-k)/(n-1)) rn^((k-1)/(n-1))\n",18,Black],Style[Row[{"\nThe radius of the middle plus one circle = ",r[(n)/2+1], " cm\n"}],16,Purple]}], True,
Style[Row[{"\nThe smallest circle of the five tangent circles\n has radius = ",r[1]," cm and the largest has radius = ", rn, " cm\n Find the explicit formula for the radius, and the radius of the middle circle if # circles is odd\n"}],16,Black]],Alignment->Left,Frame->True],
Item[
gcircle=Graphics[{Black,
Table[cir[{r[i]Cot[alpha],r[i]},r[i]],{i,1,n}],
(*cir[{r[n] Cot[alpha],r[n]},r[n]],*)Line[{{r1 Cot[alpha],r1},{r1 Cot[alpha],0}}],Line[{{r[n]Cot[alpha],r[n]},{(r[n])Cot[alpha],0}}],Purple,If[OddQ[n],Line[{{(r[(n+1)/2])Cot[alpha],r[(n+1)/2]},{(r[(n+1)/2])Cot[alpha],0}}],Line[{{(r[(n)/2+1])Cot[alpha],r[(n)/2+1]},{(r[(n)/2+1])Cot[alpha],0}}]],

Text[Style[Row[{"r1 = ",r[1], " cm"}],12,Black],{r[1] Cot[alpha],r[1]/2}],
Which[answer&&OddQ[n],Text[Style[Row[{Subscript[r,(n+1)/2]," = ",r[(n+1)/2], " cm"}],12,Purple],{r[(n+1)/2] Cot[alpha],((n+1)/2)r[(n+1)/2]/2}],OddQ[n],Text[Style[Row[{"r = ? cm"}],12,Purple],{r[(n+1)/2] Cot[alpha],r[(n+1)/2]/2}],answer&&EvenQ[n],Text[Style[Row[{Subscript[r,(n)/2+1]," = ",r[(n)/2+1], " cm"}],12,Purple],{r[(n)/2+1] Cot[alpha],((n)/2+1)r[(n)/2+1]/2}],EvenQ[n],Text[Style[Row[{"r = ? cm"}],12,Purple],{r[(n)/2+1] Cot[alpha],r[(n)/2+1]/2}]],
Text[Style[Row[{Subscript[r,n]," = ",r[n], " cm"}],12,Black],{r[n] Cot[alpha],r[n]/2}]
},Axes->False,PlotRange->Automatic];
plotcntrLine=Plot[{0, x Tan[alpha]},{x,0.93 r[1]1  Cot[alpha],1.03r[n ]Cot[alpha] },PlotStyle->{{Thick,Purple},{Red,Dashing[{0.001,0.02,0.14,0.02}]}}];
plotTangtLine=Plot[{ x Tan[2 alpha]},{x,0.93 r[1]  Cot[alpha],1.03r[n ]Cot[alpha] },PlotStyle->{Blue}];
Show[gcircle,plotcntrLine,plotTangtLine,ImageSize->Large,PlotRange->All],Alignment->{Center},Frame->True,ItemSize->{40,10}]
}],
Row[{
Control[{{n ,5,"No.\n Tan. Circ"},3,25,1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],
Control[{{r1 ,12.,"radius1"},1.,13.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{rn,48.,"radius5"},11,100.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{answer,False,"Answer"},{False,True}}]
}],TrackedSymbols:>{n,r1,rn,answer},SaveDefinitions->True]]

Twin Circles of Archimedes and their siblings

ClearAll["Global`*"];

DynamicModule[{a,b,m,n,answer,z,otherTwins,xtwin,ytwin},Manipulate[
Column[{
Item[
If[answer,Style[Row[{"\n The radius of each ofthe twin circles = \!\(\*FractionBox[\(a\\ b\), \(a\\  + \\ b\)]\) = ", TraditionalForm[ a b/ (a+b)]," in \nRadius of the new twins = ",Rchain[z,a,b]," in.\n"}],15,Purple],
Style["\nProve that the radius of each of the twin circles = \!\(\*FractionBox[\(a\\ b\), \(a\\  + \\ b\)]\) \nFind other twin circles and their radius\n",16,Black]],Alignment->Left,Frame->True],
Item[
(* Graph the main body *)
Graphics[{{GrayLevel[0.8],Disk[{a+b,0},a+b,{0,Pi}]},{GrayLevel[1.0],Disk[{a,0},a,{0,Pi}]},{GrayLevel[1.0],Disk[{2 a+b,0},b,{0,Pi}]},Line[{{0,0},{2*(a+b),0}}],Line[{{2 a,0},{2 a,2 Sqrt[a b]}}],
Line[{{0,0},{0,-2}}],Line[{{a,0},{a,-1}}],Line[{{a+b,0},{a+b,-2}}],Line[{{2 a,0},{2 a ,-1.1}}],Line[{{2 a + b,0},{2 a + b,-1.1}}],Arrowheads[{-0.02,0.02}],Arrow[{{0,-1},{a,-1}}],Arrow[{{0,-1.9},{a+b,-1.9}}],Arrow[{{2 a ,-1},{2 a + b,-1}}],
Text[Style[Row[{"a = ",a}],12,Black],{a/2,-0.6}],
Text[Style[Row[{"b = ",b}],12,Black],{2 a +b/2,-0.6}],
Text[Style[Row[{"a + b = ",a + b}],12,Black],{(a+ b )/2,-1.6}],

Thick,Blue,Circle[{a,0},a,{0,Pi}],{PointSize[0.015],Blue,Point[{a,0}]},Thick,Black,Circle[{a+b,0},(a+b),{0,Pi}],{PointSize[0.015],Black,Point[{a+b,0}]},Thick,Blue,Circle[{2 a+b,0},b,{0,Pi}],{PointSize[0.015],Blue,Point[{2 a+b,0}]},Text[Style["A",Black,Bold,16],{0,-1.15}],Text[Style["B",Black,Bold,16],{2 a,-1.15}],Text[Style["D",Black,Bold,16],{2 (a+b),-1.15}],Text[Style["C",Black,Bold,16],{2 a,2 Sqrt[a b]+.8}],

(* Graph the twin circles *)
(*   Right Twin circle *)
{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{xtwin[a,b],ytwin[a,b]},Rtwin[a,b],{0,2 Pi}]},(*Circle[{xtwin[a,b],ytwin[a,b]},Rtwin[a,b],{0,2 Pi}],*){PointSize[0.015],Purple,Point[{xtwin[a,b],ytwin[a,b]}]},

(*   Left Twin circle *)
{EdgeForm[{Thick,Red}],FaceForm[White],Disk[{xtwinlft[a,b],ytwinleft[a,b]},Rtwin[a,b],{0,2 Pi}]},(*Thick,Black,Circle[{xtwinlft[a,b],ytwinleft[a,b]},Rtwin[a,b],{0,2 Pi}],*){PointSize[0.015],Purple,Point[{xtwinlft[a,b],ytwinleft[a,b]}]},



{Purple,Arrowheads[0.02],Arrow[{{xtwinlft[a,b],ytwinleft[a,b]},{2 a,ytwinleft[a,b]}}],Arrow[{{xtwin[a,b],ytwin[a,b]},{2 a,ytwin[a,b]}}]},If[answer,{Text[Style[Row[{" (Subscript[r, t]) = ",TraditionalForm[Rtwin[a,b]]}],14,Purple],{xtwinlft[a,b]+Rtwin[a,b]/2,1.1 ytwinleft[a,b]}],Text[Style[Row[{" (Subscript[r, t]) = ",TraditionalForm[Rtwin[a,b]]}],14,Purple],{xtwin[a,b]-Rtwin[a,b]/2,1.1 ytwin[a,b]}],
Text[Style[Row[{"radius = ",StandardForm[Rclw[kt[a,b],a,b]]}],14,Purple],{xcw[kt[a,b],a,b]+ Rclw[kt[a,b],a,b],yClockwise[kt[a,b],a,b]+1.5 Rclw[kt[a,b],a,b]}],
Text[Style[Row[{"radius = ",StandardForm[Rclw[kt[a,b],a,b]]}],14,Purple],{xcw[kt[a,b],a,b]+ Rclw[kt[a,b],a,b],yClockwise[kt[a,b],a,b]+1.5 Rclw[kt[a,b],a,b]}],
Text[Style[Row[{"radius = ",StandardForm[Rchain[z,a,b]]}],14,Purple],
{xCounterClw[z,a,b]-Rchain[z,a,b],y[z,a,b]+1.5  Rchain[z,a,b]}]

},
{Text[Style[" (Subscript[r, t]) = ?",14,Purple],{xtwinlft[a,b]+Rtwin[a,b]/2,1.1 ytwinleft[a,b]}],Text[Style[" (Subscript[r, t]) = ?",14,Purple],{xtwin[a,b]-Rtwin[a,b]/2,1.1 ytwin[a,b]}]}],
(* Chain circles right side of the twins clockwise direction *)
		(* Place the table for the chain right to twin circles *)
Table[{EdgeForm[{Thick,Purple}],FaceForm[White],Disk[{xClockwise[kright+k,b,a],y[kright+k,b,a]},Rchain[kright+k,b,a],{0,2 Pi}],PointSize[0.012],Point[{xClockwise[kright+k,b,a],y[kright+k,b,a]}]},{k,1,n}],
(* Chain circles left side of the twins Counter clockwise direction *)
		(* Place the table for the chain on the left side of the twin circles *)

Table[{EdgeForm[{Thick,Purple}],FaceForm[White],Disk[{xCounterClw[kleft+k,a,b],y[kleft+k,a,b]},Rchain[kleft+k,a,b],{0,2 Pi}],PointSize[0.01],Black,Point[{xCounterClw[kleft+k,a,b],y[kleft+k,a,b]}]},{k,1,m}],

(*Find other twin circles with equal radii (on the right and on the left) *)
(* On the right hand side *)
If[otherTwins,{{EdgeForm[{Thick,Black}],FaceForm[Pink],Disk[{xcw[kt[a,b],a,b],yClockwise[kt[a,b],a,b]},Rclw[kt[a,b],a,b],{0,2 Pi}],PointSize[0.01],Black,Point[{xcw[kt[a,b],a,b],yClockwise[kt[a,b],a,b]}]},

(* On the left hand side *)

{EdgeForm[{Thick,Black}],FaceForm[Pink],Disk[{xCounterClw[z,a,b],y[z,a,b]},Rchain[z,a,b],{0,2 Pi}],PointSize[0.01],Black,Point[{xCounterClw[z,a,b],y[z,a,b]}]}
}]
},
ImageSize->{600,400},AspectRatio->Automatic,PlotRange->Automatic,Axes->False(*{{-2,32},{-2,22}}*)
],Alignment->{Center},Frame->True]
}],
Grid[{
{Control[
{{a,7,"left radius"},1,10,1,Appearance->"Labeled"}],Control[
{{b,4,"right radius"},1,10,1,Appearance->"Labeled"}]},{Control[
{{m,0,"number of left circles"},0,10,1,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{n,0,"number of right circles"},0,10,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"answer"},{False,True}}]},{Control[{{otherTwins,False,"Other Twins"},{False,True}}],Control[

{{z,3,"z Disk #"},1.,9.,Appearance->"Labeled",ImageSize->Tiny,Enabled->otherTwins}]}}],TrackedSymbols->{a,b,m,n,answer,z,otherTwins},
Initialization:>(
(* Radius of the chain circles is Rchain *)
Rchain[k_,a_,b_]:=a b (a+b)/(a (a+b)+(k b)^2);
Rclw[k_,a_,b_]:=FullSimplify[a b (a+b)/(b (a+b)+(k a)^2)];
(* The x and y coordinates of the chain circles are : *)
x[k_,a_,b_]:=(2 a+b) Rchain[k,a,b]/b;
x[k_,a_,b_;a>b]:=(2 a+b) Rchain[k,a,b]/b;
x[k_,a_,b_;a<b]:=2 (a+b)-(a+2 b) Rchain[k,a,b]/a;
(* Radius of the twin circles Rtwin *)
Rtwin[a_,b_]:= a b /(a+b);
(* x -coordinates and y-coordinates of the twin circles *)
xtwin[a_,b_]:=2 a+Rtwin[a,b];
ytwin[a_,b_]:=2 Sqrt[ b Rtwin[a,b]]; 
xtwinlft[a_,b_]:=2 a-Rtwin[a,b];
ytwinleft[a_,b_]:=2 Sqrt[ a Rtwin[a,b]]; 

(* x-codinates and y-coordinates of the chain circles clockwise *)
xClockwise[k_,a_,b_]:=2 (a + b)-x[k,a,b];
y[k_,b_,a_]:=2 k Rchain[k,b,a];

(* x-codinates and y-coordinates of the chain circles counter clockwise *)
kright:=Sqrt[(a+b)/a];
kleft:=Sqrt[(a+b)/b];
xCounterClw[k_,a_,b_]:=(2 a+ b)Rchain[k,a,b]/b;

(*Find kt in the clockwise direction that forms*the twins when k1=2*)

	kt[a_,b_]:=Sqrt[(b^2 (z^2-1))/a^2+1];
xcw[k_,a_,b_]:=2 (a+b)-(2 b+a)*Rclw[k,a,b]/a;
yClockwise[k_,a_,b_]:=2 k Rclw[k,a,b];
),SaveDefinitions->True]]

Decorating a Glass Panel

Manipulate[areaTr:= (1-((Sqrt[2])/2))^2;
Column[{
Item[If[Answer,Style[Row[{"\nArea of Red Triangle = ",areaTr,"  sq. meters.\n"}],16,Italic,Purple],Style["\nCalculate the area of one of the red triangles\ngiven that the radius of the yellow disk = 1 meter\n",16,Black]],Alignment->{Center},Frame->True],
Item[
Graphics[{
{EdgeForm[Red],FaceForm[Yellow],Disk[]},{EdgeForm[Blue],Opacity[0.5],RGBColor[1,0.6,0.3],Rectangle[{-((Sqrt[2])/2),-((Sqrt[2])/2)},{((Sqrt[2])/2),((Sqrt[2])/2)}]},{EdgeForm[Blue],Yellow,Polygon[{{-1,0},{0,-1},{1,0},{0,1}}]},{EdgeForm[Blue],Red,Polygon[{{-1+((Sqrt[2])/2),((Sqrt[2])/2)},{0,1},{1-((Sqrt[2])/2),((Sqrt[2])/2)}}],Polygon[{{-1+((Sqrt[2])/2),((-(Sqrt[2]))/2)},{0,-1},{1-((Sqrt[2])/2),((-(Sqrt[2]))/2)}}]},{EdgeForm[Blue],Green,Polygon[{{((Sqrt[2])/2),1-((Sqrt[2])/2)},{1,0},{((Sqrt[2])/2),-1+((Sqrt[2])/2)}}],Polygon[{{((-(Sqrt[2]))/2),1-((Sqrt[2])/2)},{-1,0},{((-(Sqrt[2]))/2),-1+((Sqrt[2])/2)}}]},{Thick,EdgeForm[Purple],White,Disk[{0,0},radius]},{Thick,Purple,PointSize[0.025],Point[{0,0}]}
},Axes->False,ImageSize->360],Alignment->{Center},ItemSize->{33,4},Frame->True]
}],Row[{Control[
{{radius,(Sqrt[2.])-1,"Radius"},0.01,((Sqrt[2])/2),Appearance->"Labeled"}],Spacer[21],Control[
{{Answer,False,"Ansewer"},{False,True}}]
}],
TrackedSymbols->{radius,Answer}]

Nested Squares

Develop the sequence of areas of squares

Manipulate[Graphics[{EdgeForm[Directive[Blue]],RGBColor[0,0.6,1],Rectangle[],
{Cyan,Polygon[{{0,0.5},{0,1},{0.5,1}}]},

{Cyan,Polygon[{{0.5,0},{1,0},{1,0.5}}]},{Yellow,Rotate[Rectangle[{0.5-0.25(Sqrt[2]),0.5-0.25(Sqrt[2])},{0.5+0.25(Sqrt[2]),0.5+0.25(Sqrt[2])}],θ Degree,{0.5,0.5}]},
{Red,Rectangle[{0.25,0.25},{0.75,0.75}]},
{Green,Rotate[Rectangle[{0.5-0.25/(Sqrt[2]),0.5-0.25/(Sqrt[2])},{0.5+0.25/(Sqrt[2]),0.5+0.25/(Sqrt[2])}],θ Degree,{0.5,0.5}]},Blue,Rectangle[{0.375,0.375},{0.625,0.625}],{Pink,Rotate[Rectangle[{0.5-0.125/(Sqrt[2]),0.5-0.125/(Sqrt[2])},{0.5+0.125/(Sqrt[2]),0.5+0.125/(Sqrt[2])}],θ ,{0.5,0.5}]},Cyan,Rectangle[{0.5-0.125/2,0.5-0.125/2},{0.5+0.125/2,0.5+0.125/2}]},Axes->True,AxesOrigin->{0,0}],
{{θ,45,"Rotation"},-180,180,5,Appearance->"Labeled"},TrackedSymbols->{θ}]

Calculate area inside a hexagon

Vertices[Hexagon]
(*Graphics[{PointSize[0.025],Purple,Point/@%},AspectRatio->1];*)
Manipulate[Graphics[{Thick,Purple,Line[{{(1/2),((Sqrt[3])/2)},{-(1/2),((Sqrt[3])/2)}}],Line[{{-(1/2),((Sqrt[3])/2)},{-1,0}}],Line[{{-1,0},{-(1/2),-((Sqrt[3])/2)}}],Line[{{-(1/2),-((Sqrt[3])/2)},{(1/2),-((Sqrt[3])/2)}}],Line[{{(1/2),-((Sqrt[3])/2)},{1,0}}],Line[{{(1/2),((Sqrt[3])/2)},{1,0}}],
{PointSize[0.025],Red,Point[{0,0}]},{EdgeForm[{Blue,Thick}],FaceForm[Pink],Disk[{1,0},0.5,{2π/3,4π/3}],
Disk[{(1/2),((Sqrt[3])/2)},0.5,{π,5π/3}],
Disk[{-(1/2),((Sqrt[3])/2)},0.5,{4π/3,6π/3}],
Disk[{-1,0},0.5,{5π/3,7π/3}],

Disk[{-(1/2),-((Sqrt[3])/2)},0.5,{0,2π/3}],
Disk[{(1/2),-((Sqrt[3])/2)},0.5,{π/3,3π/3}]
},
If[answer,Text[Style["area of the internal white region = 54 (Sqrt[3]) - 18 π (in^2)\n",14, Blue],{0,1.1}],Text[Style["What is the area of the internal white region,\n if the side length of the hexagon = 6 in?\n",16,Black,Italic],{0,1.1}]
]

},Axes->False,AxesOrigin->{0,0},AspectRatio->1],
{{answer,False,"answer"},{False,True}},TrackedSymbols:>answer]

General case of interior area

ClearAll["Global`*"];

Module[{n,answer},Manipulate[
areaInt=n Sin[2π/n]/2-(n-2)π Sin[π/n]^2/2;
Column[{Item[If[answer,Row[{Style["\narea of the interior region = \n\n",14, Blue],Style[Row[{areaInt," (in^2)\n"}],14,Blue]}],Style["\nCalculate the interior green area given that the radius of the circumcircle is 1 inch\n",16,Black,Italic]],Frame->True,Alignment->{Center}
],
Item[
Graphics[{{EdgeForm[{Blue,Thick}],FaceForm[{Opacity[0.9],Green}],Polygon[Table[{Sin[2π k/n],Cos[2π k/n]},{k,1,n}]]},
{EdgeForm[{Blue,Thick}],FaceForm[Pink],Table[Disk[{Sin[2π k/n ],Cos[2π k/n]},Sin[π/n],{(n-(2 k-1))π/n,(2 n-(2k+1)) π/n}],{k,1,n}]},
{Purple,Thick,Circle[{0,0},1],PointSize[0.02],Point[{0,0}]}
},Axes->True,AxesOrigin->{0,0},ImageSize->Medium],Frame->True,Alignment->{Center},ItemSize->{36,3}]
}],
Row[{Control[{{n,3,"polygon"},3,60,1,PopupMenu}],
,Spacer[90],Control[{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{n,answer},SaveDefinitions->True]]

Tangent Circles in Polygons 2 - 19 - 15

ClearAll["Global[`*"];

DynamicModule[{n,answer},Manipulate[
cir[center_,radius_]={Thick,Circle[center,radius],PointSize[0.015],Point[center]};
dsk1[center_,radius_]={EdgeForm[{Thick,Red}],FaceForm[{Opacity[0.7],Yellow}],Disk[center,radius],PointSize[0.015],Point[{center}]};
dsk2[center_,radius_]={EdgeForm[{Thick,Red}],FaceForm[{Opacity[0.2],Purple}],Disk[center,radius],PointSize[0.015],Point[{center}]};
dsk3[center_,radius_]={EdgeForm[{Thick,Red}],FaceForm[{Opacity[1],Red}],Disk[center,radius],PointSize[0.015],Point[{center}]};
rchain[i_]:=((Sin[(π/i)])/(2+Tan[(π/i)]));
cntrchain[i_]:=rchain[i]-Cos[π/i];
radiuscenters[i_]:=Abs[cntrchain[i]];

radius2[i_]:=Abs[1-rchain[n] Sec[π/n]];
Column[{
Item[
If[answer,Style[Row[{"\nThe radius of the chain circle = ",N[rchain[n]]," cm\n"}],16,Blue],Style["\nCalculate the radius of the chain circles if\nthe radius of the circumcircle of the polygon is 1 cm \n",16,Black,Italic]
],Frame->True,Alignment->Left],
Item[ 

Graphics[{{EdgeForm[{Blue,Thick}],FaceForm[{Opacity[0.1],Green}],Polygon[Table[{Sin[2π k/n],Cos[2π k/n]},{k,1,n}]]},
dsk3[{0,0},radiuscenters[n]-rchain[n]],

Which[
Mod[n,4]==0,{
Table[dsk1[radiuscenters[n]{Cos[π ( k )/( n)],Sin[π ( k )/( n)]},rchain[n]],{k,1,2(n),2}],
Table[dsk2[radius2[n]{Cos[π (2 k )/( n)],Sin[π (2 k )/( n)]},rchain[n]],{k,0,n-1,1}]
},

Mod[n,4]==1,
{
Table[dsk2[radius2[n]{Cos[π (2 k + 1)/(2 n)],Sin[π (2 k + 1)/(2 n)]},rchain[n]],{k,0,2n,2}],
Table[dsk1[radiuscenters[n]{Cos[π (2 k + 1)/(2 n)],Sin[π (2 k + 1)/(2 n)]},rchain[n]],{k,1,2n,2}]},

Mod[n,4]==2,
{
Table[dsk2[radius2[n]{Cos[π ( k )/( n)],Sin[π ( k )/( n)]},rchain[n]],{k,1,2(n),2}],
Table[dsk1[radiuscenters[n]{Cos[π (2 k )/( n)],Sin[π (2 k )/( n)]},rchain[n]],{k,0,n-1,1}]
},

Mod[n,4]==3,
{
Table[dsk1[radiuscenters[n]{Cos[π (2 k + 1)/(2 n)],Sin[π (2 k + 1)/(2 n)]},rchain[n]],{k,0,2n,2}],
Table[dsk2[radius2[n]{Cos[π (2 k + 1)/(2 n)],Sin[π (2 k + 1)/(2 n)]},rchain[n]],{k,1,2n,2}]}

]


,cir[{0,0},1],{Dashing[0.02],cir[{0,0},radiuscenters[n]],Blue,cir[{0,0},radius2[n]]}},Axes->False,AxesOrigin->{0,0},ImageSize->Medium,PlotLabel->PopupMenu[Dynamic[n],{3->"triangle",4->"quadrilateral",5->"pentagon",6->"hexagon",7->"heptagon",8->"octagon",9->"nonagon",10->"decagon",11->"hendecagon",12->"dodecagon",13->"triskaidecagon",14->"tetrakaidecagon",15->"pentakaidecagon",16->"hexakaidecagon",17->"heptakaidecagon"}]]
,Frame->True,Alignment->{Center}]
}],
Row[{Control[{{n,3,"polygon"},3,24,1,PopupMenu}],
,Spacer[90],Control[{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{n,answer},SaveDefinitions->True]]

Areas

The Ratio between the shaded area and the small circle

Manipulate[
If[center<radius-Radius,center=radius-Radius];
If[center>Radius-radius,center=Radius-radius];
area=π ((Radius^2) -(radius^2));
ratio= ((Radius^2) -(radius^2))/(radius^2);
Column[{
If[Answer,Text @ Style[Row[{"Ratio of shaded area to small circle = ",TraditionalForm[ratio]," = ",NumberForm[N@ (ratio),{5,4}]}],18,Bold, Blue],
Style["Calculate the Ratio of the shaded Area to the area of the small Circle",16,Bold,Red]],
Graphics[{
GrayLevel[0.8],Disk[{0,0},Radius],
Thick, Black,Circle[{0,0},Radius],
White,Disk[{center,0},radius],
 Thick,Blue,Circle[{center,0},radius],
PointSize[0.03],Blue,Point[{center,0}],
Black,Dashed,Line[{{-Radius,0},{Radius,0}}]
},PlotRange->5.1,(*Axes->True,*)ImageSize->Large]
},Alignment->Center],
Row[{
Control[
{{Radius,3,"large radius R"},radius,5,0.1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[6],Control[{{radius,1.5,"small radius r"},0.2,Radius-0.3,0.1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[6],Control[ {{center,-0.9},radius-Radius,Radius-radius,0.1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[6],Control[
{{Answer,False,"Answer"},{False,True}}]}],TrackedSymbols->{Radius,radius,center,Answer}]

The Area of the Lunes and the Area of the Triangle.

This program shows that the sum of the areas of the two lunes is equal to the area of the triangle.  Prove it.

Manipulate[
Graphics[{
b:=Sqrt[1-a^2];
arealeftlune=
If[a≤0,
π (1-Abs[a])/4-0.5(ArcSin[b]-b),
π (a-1)/4+0.5 ( ArcSin[b]+b )];
arearightlune=If[a>0,
π (1-a)/4+0.5 (b-ArcSin[b]),
π (Abs[a]-1)/4+0.5 (b+ArcSin[b] )];

{Hue[0.5],Disk[{(a-1)/2, b/2},Sqrt[2 a+2]/2,{ArcTan[Sqrt[(1-a)/(1+a)]],π+ArcTan[Sqrt[(1-a)/(1+a)]]}]},
{Hue[0.5],Disk[{(a+1)/2,b/2},Sqrt[2 - 2 a]/2,{-ArcTan[Sqrt[(1+a)/(1-a)]],π-ArcTan[Sqrt[(1+a)/(1-a)]]}]},
{GrayLevel[1],Disk[{0,0},1,{0,π}]},
{Hue[0.85],Polygon[{ {-1,0}, {a,b},{1,0} }]},
Thick,Circle[{0,0},1,{0,π}],{PointSize[Large],Point[{0,0}]},
Thick,Circle[{(a-1)/2, b/2},Sqrt[2 a+2]/2,{ArcTan[Sqrt[(1-a)/(1+a)]],π+ArcTan[Sqrt[(1-a)/(1+a)]]}],
Thick,Circle[{(a+1)/2,b/2},Sqrt[2 - 2 a]/2,{-ArcTan[Sqrt[(1+a)/(1-a)]],π-ArcTan[Sqrt[(1+a)/(1-a)]]}],
Line[{{-1,0},{1,0}}],
Line[{{-1,0},{a,b}}],
Line[{{a,b},{1,0}}],
Inset[Style["A",20,Bold],{a,Sqrt[1-a^2]+0.09}],
Inset[
Row[{Style["Area of Left Lune = ",20,Bold],Style[arealeftlune,20,Bold],Style["  square units",20,Bold],"\n"}],{-0.02,-0.3}],
Inset[
Row[{Style["Area of Right Lune = ",20,Bold],Style[arearightlune,20,Bold],Style["  square units",20,Bold],"\n"}],{-0.03,-0.45}],
Inset[
Row[{Style["Area of the Triangle = ",20,Bold],Style[Sqrt[1-a^2],20,Bold],Style["  square units",20,Bold],"\n"}],{-0.03,-0.7}],
Inset[
Row[{Style["Verify that the total area of the Lunes = ",20,Bold,Red],"\n",Style["The area of the Triangle",20,Bold,Red]}],{-0.1,-1}]
},ImageSize->{450,450},PlotRange->1.3],{{a,0.3,Style[" A ",16,Bold]},-0.95,0.95,Appearance->"Labeled"},TrackedSymbols->{A}]

Yin Yang

Animate[Graphics[{Red,Disk[{0,0},2,{0,Pi}],Blue,Disk[{0,0},2,{Pi,2Pi}],Red,Disk[{-1,0},1],Blue,Disk[{1,0},1]},PlotRange->2.1,ImageSize->450]/.Disk[x__]:>Rotate[Disk[x],d Degree,{0,0}],{d,0,360},AnimationRunning->False]

Yin Yang and More

The Yin Yang symbol is a Chinese representation of the entire celestial phenomenon.
   It is said to contain the cycle of the Sun, the Moon and the four seasons. 
   The ancient Chinese observed that the universe is changing every day. Hence, one little circle Yin (standing for the Moon) is marked at the summer position. Another little circle Yang (standing for the Sun) is marked at the winter position.

ClearAll["Global`*"];

DynamicModule[{a,b,c,answer,ansrYang,YinYang},
Manipulate[
mxn = If[(a==1/3 ) || (a==2/3),  
aa=Rationalize[a];ToString[IntegerPart[100*aa],TraditionalForm]<>ToString[FractionalPart[aa],TraditionalForm],
NumberForm[100*(a),{4,2}]];
mycircle[{x_,y_},rad_,{theta1_,theta2_}]:={Circle[{x,y},rad,{theta1,theta2}],PointSize[Large],Point[{x,y}]};
If[YinYang,
Graphics[{

If[ansrYang,
Inset[Row[{Style[mxn,18,Bold],
Style["% of the circle is shaded Blue.",18,Bold],"\n"}],{0,1.3}],
Inset[Style["  What percent of the circle is shaded Blue ? ",18,Bold,Blue],{0,1.3}]],
{Hue[0.7],Disk[{0,0},1,{3 π/2,2.5 π}]},
{GrayLevel[1],Disk[{0,a},1-a,{3 π/2,5 π/2}]},
{Hue[1],Disk[{0, 0},1,{π/2,3 π/2}]},
{Hue[1],Disk[{0, a},1-a,{3 π/2,5 π/2}]},
{Hue[0.7],Disk[{0,a-1},a,{π/2,3 π/2}]},
Line[{{0,-1},{0,1}}],
Thick,mycircle[{0,0},1,{0,2 π}],
mycircle[{0,a-1},a,{π/2,3 π/2}],
mycircle[{0,a},1-a,{3 π/2, 2.5 π}]},
ImageSize->{500,500}

],
mxf = If[(b==2/3 ) && (c==1/3),  
bc=Rationalize[b-c];ToString[IntegerPart[100*bc],TraditionalForm]<>ToString[FractionalPart[bc],TraditionalForm],
NumberForm[100*(b-c),{4,2}]];
Graphics[{

If[answer,
Inset[Row[{Style[mxf,18,Bold],
Style[" % of the circle is shaded",18,Bold],"\n"}],{0,1.3}],Inset[Style["  What percent of the circle is shaded ? ",18,Bold,Purple],{0,1.3}]],
{Hue[0.5],Disk[{b-1,0},b,{0,π}]},
{GrayLevel[1.0],Disk[{c-1,0},c,{0,π}]},
{Hue[0.5],Disk[{c,0},1-c,{π,2 π}]},
{GrayLevel[1],Disk[{b,0},1-b,{π, 2 π}]},
Line[{{-1,0},{1,0}}],
Thick,Circle[{b-1,0},b,{0,π}],
mycircle[{c-1,0},c,{0,π}],
Circle[{c,0},1-c,{π, 2 π}],
mycircle[{b,0},1-b,{π,2 π}],
mycircle[{0,0},1,{0,2 π}]},
ImageSize->{500,500}]

],
{{a,1/3,Style["radius "]},0.1,0.9,Appearance->"Labeled",Enabled->YinYang},
{{ansrYang,False,Style["ansrYang",16,Bold]},{False,True}},
{{YinYang,True,""},{True->Style["Yin-Yang",13,Background->Yellow],False->Style["more",13,Background->Yellow]}},
{{b,2/3,"upper curve"},0.5,0.99,Appearance->"Labeled",Enabled->Not[YinYang]},{{c,1/3,"Lower curve"},0.1,0.5,Appearance->"Labeled",Enabled->Not[YinYang]},
{{answer,False,Style["answer",16,Bold]},{False,True},Enabled->Not[YinYang]},TrackedSymbols:>{a,b,c,ansrYang,YinYang,answer},

SaveDefinitions->True]]

A Square within a Square

ClearAll["Global`*"];

DynamicModule[{b,answer,solution,steps},Manipulate[

Graphics[{
If[solution,
Switch[steps,1,{Inset[Style[Row[{"area of blue parallelogram =  \n",
"area of 10×10 square - area of two red triangles = \n",100," - ", 10," ",Style["b",Italic] , " = ",100-10b}], 20],{5,17}],

{Hue[0.6],GraphicsComplex[p[b],Polygon[{1,2,3,4}]
]},
{RGBColor[0.9,0,0.2],Polygon[{{0,0},{b,10},{0,10}}]
},
{RGBColor[0.9,0,0.2],Polygon[{{10-b,0},{10,0},{10,10}}]
}},
2,{
Inset[Style[Row[{"area of blue rectangle = ", (Sqrt[100+(b^2)]) ," ",Style["x",Italic]," = ",100- 10 b }], 20],{5,17}],

{Hue[0.6],GraphicsComplex[t[b],Polygon[{1,2,3,4}]
]},

{RGBColor[0.9,0,0.2],Polygon[{{0,0},{b,10},{0,10}}]
},
{RGBColor[0.9,0,0.2],Polygon[{{10-b,0},{10,0},{10,10}}]
}},

3,{
Inset[Style[Row[{"area of the blue square = ",((Style["x",Italic])^2) ," = ",
area}],20],{5,17}]

}],
{
If[answer,Inset[Style[Row[{"The area of shaded square = ",area}],20],{5,17}],
Inset[Style[" Calculate the area of the shaded square.",20],{5,17}]]
}],

{Thick,Line[{{0,0},{10,0}}]},
{Thick,Line[{{0,0},{0,10}}]},
{Thick,Line[{{10,0},{10,10}}]},
{Thick,Line[{{0,10},{10,10}}]},
(*{Red, Text[Style["b", 14, Italic], {b/2, 10.95}]},*)
{Red, Text[Style[Row[{Style["b",Italic],Style[" = "],NumberForm[b ,{4,2}]}],14], {b/2, 10.95}]},
{Red,Arrowheads[{-0.02,0.02}], Arrow[{{0, 10.5}, {b,10.5}}]},
{Red,Arrowheads[{-0.02,0.02}], Arrow[{{-0.7, 0}, {-0.7,10.}}]},
{Red, Text[Style[Row[{Style["a",Italic],Style[" = 10 "] }],14], {-1.7, 5}]},
(*{Red,Arrowheads[.02], Arrow[{{.9*b/2, 10.5}, {0,10.5}}]},
{Red,Arrowheads[.02], Arrow[{{1.1*b/2, 10.5}, {b,10.5}}]},*)
{Red,Line[{{0,0},{b,10}}]},
{Red,Line[{{10,10},{10-b,0}}]},
{Blue,Line[{{0,b},{10,0}}]},
{Blue,Line[{{0,10},{10,10-b}}]},
{Hue[0.6],GraphicsComplex[v[b],Polygon[{1,2,3,4}]
]}
},ImageSize->{450,450},PlotRange->{{-7,17},{-3,19}}],
{{b,10(2.-(Sqrt[3])),"b = distance from vertex"},0.7,9.3,0.01,Appearance->"Labeled"},
{{answer,False,"answer"},{False,True},Enabled->Not@solution},
{{solution,False},{False,True}},
{{steps,1,"steps"},{1,2,3},ControlType->RadioButton,Enabled->solution},
TrackedSymbols->{b,answer,solution,steps},SaveDefinitions->True,
AutorunSequencing->{1,2,3},
Initialization:>{
p[b_]:={{0,0},{b,10},{10,10},{10-b,0}};
t[b_]:={ 
{(1000-100 b+10 b^2)/(100+b^2),(10 b^2)/(100 +b^2)},
{(1000+10 b^2+b^3)/(100+b^2),(1000+20 b^2)/(100+ b^2) },{(10 b^2+100 b+b^3)/(100+b^2),(1000+10 b^2+100 b)/(100+ b^2) },{10 b^2/(100+b^2),100 b/(100 +b^2)}
 };
v[b_]:={
{100 b/(100+b^2),1000/(100 +b^2)},
{10 b^2/(100+b^2),100 b/(100 +b^2)},
{(1000+10 b^2-100 b)/(100+b^2),b - b (1000+10 b^2-100 b)/(1000+10 b^2) },
{(1000)/(100+b^2),(1000-100 b+10 b^2)/(100 +b^2)}
 };area:=(100-10 b)^2/(100+b^2)}]]

Illustrating Involution of a Circle and the meaning of π

A string is wrapped around a circle with radius one cm.  As the string is unwound, its end traces a path called the involute of the circle as shown in purple.
The length of that curve at any angle θ rad. is ((θ^2)/2)cm.
The figure shows also wrapping a line of length π about a semi circle with radius one.  The arc length = θ cm.

ClearAll["Global`*"];

Module[{angle},Manipulate[θ=angle π/180.;
gr:=Graphics[{
{Thick,Red,,Arrow[{{0,0},{Cos[θ],Sin[θ]}}]},
{Thick,Purple,Arrow[{{0,0},{Cos[θ],0}}],
Arrow[{{Cos[θ],0},{Cos[θ],Sin[θ]}}]},
{Dashing[0.01],Blue,Line[{{Cos[θ],Sin[θ]},{θ Sin[θ]+Cos[θ],Sin[θ]-θ Cos[θ]}}]},
{PointSize[0.02],Blue,Point[{θ Sin[θ]+Cos[θ],Sin[θ]-θ Cos[θ]}]},

{Blue,Thick,Line[{{Cos[θ],Sin[θ]},{-(π-θ) Sin[θ]+Cos[θ],Sin[θ]+(π-θ) Cos[θ]}}]},{Gray,Circle[{0,0},1,{0,π}]}
}];
func[u_,θ_]=If[u<θ,{Cos[u],Sin[u]},{Cos[θ]-Sin[θ] (u-θ),Sin[θ]+Cos[θ] (u-θ)}];
text4[u_,θ_]:=If[u≤θ,{Cos[u],Sin[u]},Graphics[{Text[Style[u,Red,Bold,18],{Cos[θ]-Sin[θ] (u-θ)-0.15,Sin[θ]+Cos[θ] (u-θ)}]}]];

txt2:=Graphics[{If[θ≥π/4,Text[Style["(π/4)",Black,18,Blue,Bold],{Cos[(( π)/4)]+0.1,Sin[(( π)/4)]}]],If[
θ≥π/2,Text[Style["(π/2)",18,Blue,Bold],{0,1.24}]],If[
π>θ≥ 3π/4,Text[Style["((3  π)/4)",18,Bold,Blue],{Cos[((3 π)/4)],Sin[((3 π)/4)]}] ]}];

txt:=Graphics[{{Purple,Thick,Circle[{0,0},0.2,{0,θ}]},Text[Style[Row[{NumberForm[angle ,{5,2}],"°"}],Red,14],{Cos[θ/2]/2,Sin[θ/2]/3}],
Text[Style[Row[{"Arc length = ", NumberForm[θ,{7,6}]," cm"}],16,Blue,Italic],{1,1.6}],Text[Style[Row[{"Involution curve\nlength = ", NumberForm[(θ^2)/2,{7,5}]," cm"}],16,Purple,Italic],{-1,2.7}],
Text[Style[Row[{"Cos ", NumberForm[angle,{5,2}],"°"}],14,Purple,Italic],{0.5 Cos[θ],-0.12}],
If[7 π/8≥θ≥π/8,Text[Style[Row[{"Sin ", NumberForm[angle,{5,2}],"°"}],14,Purple,Italic],{0.1+ Cos[θ],0.5 Sin[θ]}],{}]

}];
pr1:=ParametricPlot[{{Cos[t],Sin[t]},{t Sin[t]+Cos[t],Sin[t]-t Cos[t]}},{t,0,θ},PlotStyle->{{Thick,Blue},{Thick,Purple}},AspectRatio->Automatic,PlotRange->{{-2.1,2.1},{-1,3.5}},AxesOrigin->{0,0},Axes->True,PlotLabel->Style[Framed["Involution of a Circle"],20,Black,Background->Lighter[Yellow]],Epilog->{PointSize[0.02],Red,Point[Table[func[u,θ],{u,0,π,π/4}]]},AxesLabel->{Style["x ",Large,Bold,Italic,Black],Style["y ",Large,Bold,Italic]},GridLines->{Range[-5,5],Range[-5,5]},GridLinesStyle->Directive[GrayLevel[0.7]]];
Show[pr1,gr,
text4[π,θ],txt,txt2,ImageSize->Large],
 {{angle,1,"Angles"},179.99,0.1,0.01,Appearance->"Labeled"},TrackedSymbols->{angle},SaveDefinitions->True]]

Ratio of areas of Hexagons and a star

Manipulate[
Graphics[{

(*Draw the Outer Hexagon *)
White,Polygon[{{a,a (Sqrt[3])},{2 a,0},{a,-a (Sqrt[3])},{-a,-a (Sqrt[3])},{-2 a,0},{-a,a (Sqrt[3])}}],

Blue,Circle[{0,0},2 a (Sqrt[3]),{0,2π}],Dashing[0.015],Line[{{-3 a,-a (Sqrt[3])},{-3 a,a (Sqrt[3])}}],Line[{{-3 a,a (Sqrt[3])},{0,2 a (Sqrt[3])}}],
Line[{{0,2 a(Sqrt[3])},{3 a,a (Sqrt[3])}}],Line[{{3 a,a(Sqrt[3])},{3 a,-a (Sqrt[3])}}],
Line[{{3 a,-a(Sqrt[3])},{0,-2 a (Sqrt[3])}}],Line[{{0,-2 a (Sqrt[3])},{-3 a,-a (Sqrt[3])}}],



(* Draw Inner Polygon *)

{Yellow,Polygon[{{-2a,0},{-a,a (Sqrt[3])},{a,a (Sqrt[3])},{2 a,0},{a,-a (Sqrt[3])},{-a,-a (Sqrt[3])}}]},
{PointSize[0.015],Red,Point[{0,0}]},

(* Draw the Star *)
Orange,Polygon[{{a,a (Sqrt[3])},{2 a,0},(1-t){3 a,a (Sqrt[3])}}],Orange,Polygon[{{a,-a (Sqrt[3])},(1-t){0,-2 a(Sqrt[3])},{-a,-a (Sqrt[3])}}]  ,

Polygon[{{-a,a (Sqrt[3])},{-2 a,0},(1-t){-3 a,a (Sqrt[3])}}],RGBColor[.79,.1,.26],Polygon[{{a,a (Sqrt[3])},(1-t){0,2 a(Sqrt[3])},{-a,a (Sqrt[3])}}],Polygon[{{a,-a (Sqrt[3])},{2 a,0},(1-t){3 a,-a (Sqrt[3])}}],Polygon[{{-a,-a(Sqrt[3])},{-2 a,0},(1-t){-3 a,-a (Sqrt[3])}}] ,


(* Divide the inner hexagon into triangles*)
If[solution&&steps==2&&n==0,{

{GrayLevel[0.8],
Polygon[{{ a,a(Sqrt[3])},{2 a,0},{ a,-a (Sqrt[3])}}],Polygon[{{a, a (Sqrt[3])},{-a,a (Sqrt[3])}, {-2a,0}}],
Polygon[{{-2a,0},{-a,-a (Sqrt[3])},{a,-a (Sqrt[3])}}]},
{RGBColor[1,0,0.5],Polygon[{{a,a (Sqrt[3])},{0, 0},{a, -a (Sqrt[3])}
}]},Hue[0.55],Polygon[{{a,a (Sqrt[3])
},{0,0},{-2a,0}}],RGBColor[0.1,0.8,0.1],Polygon[{{-2 a ,0},{0,0},{a, - a (Sqrt[3])
}}] ,

RGBColor[0.7,0,0,5],Dashing[0.01],Line[{{a,a (Sqrt[3])},{a,-a (Sqrt[3])}}],Line[{{a,a (Sqrt[3])},{-2 a,0}}],Line[{{-2a,0},{a,-a (Sqrt[3])}}]

},{}],

(*Translate the triangles out of Hexagon *)
If[solution&&steps==3,{

{GrayLevel[0.8],
Polygon[{{2 a n+ a,a(Sqrt[3])},{2 a,0},{2 a n + a,-a (Sqrt[3])}}],Polygon[{{-n a+a,a n (Sqrt[3]) +a (Sqrt[3])},{-a,a (Sqrt[3])}, {- a n-2a,a n (Sqrt[3])}}],
Polygon[{{-2a-a n,-a n (Sqrt[3])},{-a,-a (Sqrt[3])},{a-a n,-a (Sqrt[3])-a n (Sqrt[3])}}]},
RGBColor[1,0,0.5],Polygon[{{-n a+a,a n (Sqrt[3]) +a (Sqrt[3])
},{n a, n a (Sqrt[3])},{2 a n+a,2a n(Sqrt[3]) -a (Sqrt[3])}
}],Hue[0.55],Polygon[{{-4 a n +a,a (Sqrt[3])
},{-2 a n,0},{-2a-a n,-a n (Sqrt[3])}}],RGBColor[0.1,0.8,0.1],Polygon[{{-2 a+2 a n ,-2 a n (Sqrt[3])},{a n, -a n (Sqrt[3])},{2 a n + a, - a (Sqrt[3])
}}] ,

RGBColor[0.7,0,0,5],Dashing[0.01],Line[{{a,a (Sqrt[3])},{a,-a (Sqrt[3])}}],Line[{{a,a (Sqrt[3])},{-2 a,0}}],Line[{{-2a,0},{a,-a (Sqrt[3])}}]

},{}]},

PlotLabel->Which[solution&&steps==1,Style["\n Map Star into inner hexagon \n", 20, Black,Italic],solution&&steps==2&&n==0,Style["\nDivide the inner hexagon into triangles\n",20,Black,Italic],solution&&steps==3&&n==0,
Style["\n Translate triangles out of hexagon\n ", 20,Italic, Black],
solution&&steps==4|| Answer,Style["\nRatio of areas of\ninner Hexagon : Star : outer Hexagon are:\n1   :   2   :  3 \n", 20,Blue,Italic],
True,
Style["Calculate the ratio of the areas of: \n the inner Hexagon : the Star : the outer Hexagon\n",16, Purple]
],PlotRange->{{-11,11},{-11,11}} ,Axes->True,ImageSize->500],
{{a,3,"a = side length of small △ "},1/(Sqrt[3]),3,Appearance->"Labeled"},
{{solution,False},{False,True}},
Grid[{{Control[
{{t,0,"Map Star in Hexagon"},0,1,ImageSize->Tiny,Appearance->"Labeled",Enabled->Dynamic[solution]}],Control[

{{n,0,"Translate Δs out"},0,1,ImageSize->Tiny,Appearance->"Labeled",Enabled->If[Dynamic[solution&&steps==3],True,False]}]},{Control[{{steps,1,"steps"},{1,2,3,4},ControlType->RadioButton,Enabled->solution}],Control[
{{Answer,False,"Answer"},{False,True}}]}}],TrackedSymbols->{solution,steps,Answer,a,t,n}]

Calculate the Length of the Belt

DynamicModule[{x,y,z,θ, length},
Manipulate[

θ=ArcCos[(y/(2 x + y + z))];
length=2 (x θ+(2x+y+z)Sin[θ]+(x+y)(π-θ));
Graphics[{
If[Answer,{
Dashing[0.01],Red,Thick,Line[{{0,0},{2 x + y + z-y Cos[θ],y Sin[θ]}}],
Text[Style["Q ",16,Bold,Red],{ 2 x + y + z-y Cos[θ]+1.,y Sin[θ]}],
Inset[Row[{Style["Belt length = ",Purple,Bold,24],Style["A",RGBColor[0,0,1],16,Bold],
Style["         +      ",Black,16,Bold],
Style["2 B",RGBColor[1,0,0],16,Bold],
Style["    +   ",Black,14,Bold],
Style[" C   ",RGBColor[.49,0,0],16,Bold],
Style[" \n                                = ",Purple,24,Bold],
Style[NumberForm[2θ x,{5,3}],RGBColor[0,0,1],14,Bold],Style["   +   ",Black,16],Style[NumberForm[2 (2x+y+z)Sin[θ],{5,3}],RGBColor[1,0,0],16,Bold],Style["  +   ",Black,16,Bold],Style[NumberForm[2(Pi-θ)(x+y),{5,3}],RGBColor[.49,0,0],16,Bold],Style[" = ",16,Bold,Purple],
Style[NumberForm[length,{5,3}],"\n\n\n",Purple,16,Bold]
}],{10,18}],
Inset[Style[Row[{"( ",Chop[NumberForm[-x Cos[θ],4]]," , ",NumberForm[ x Sin[θ],4], " ) "}],12,Black,Bold],{-x Cos[θ]-1, x Sin[θ]+1.5}],
Inset[Style[Row[{"( ",NumberForm[2 x+y+z-(x+y) Cos[θ],4]," , ", NumberForm[(x+y) Sin[θ],4], " ) "}],12,Black,Bold],{2 x+y+z-(x+y) Cos[θ], (x+y) Sin[θ]+1.2}]
},{Inset[Style["Calculate the length of the Belt\n\n",24,Bold,Blue],{10,16}]}],
Text[Style["x",Italic,14],{x/2,-(x+y)/9}],
Text[Style["z",Italic,14],{x+z/2,-(x+y)/9}],
Text[Style["x",Italic,14],{x+z+x/2,-(x+y)/9}],
Text[Style["y",Italic,14],{2x+z+y/2,-(x+y)/9}],
Text[Style["θ",Italic,14],{2x+z+y -(x+y)/15,(x+y)/15}],
Text[Style["O ",16,Bold],{-0.9,0}],
Text[Style["A","Label",Purple,16],{-x-(x+y)/9,0}],
Text[Style["B","Label",Purple,16],{( x+y+z+1)Sin[θ]/2,(x+y) Sin[θ]+0.75}],
Text[Style["P ",16,Bold],{2 x + y + z+1,0}],
Text[Style["C","Label",Purple,16],{3x+z+2y+(x+y)/9,0}],
{Thick,Purple,Line[{{-x Cos[θ], x Sin[θ]},{2 x + y + z-(x+y)Cos[θ],(x+y)Sin[θ]}}],
Line[{{-x Cos[θ], -x Sin[θ]},{2 x + y + z-(x+y)Cos[θ],-(x+y)Sin[θ]}}]},
Line[{{0,0},{-x Cos[θ], x Sin[θ]}}],
Line[{{0,0},{-x Cos[θ],- x Sin[θ]}}],
Line[{{2 x+y+z,0},{2 x + y + z-(x+y)Cos[θ],(x+y)Sin[θ]}}],
Line[{{2 x+y+z,0},{2 x + y + z-(x+y)Cos[θ],-(x+y)Sin[θ]}}],
Line[{{0,0},{2 x + y + z,0}}],
{Red,Line[{{2 x+z,-(x+y)/15},{2x+z,(x+y)/15}}]},
Circle[{0,0},x,{θ-π,π-θ}],
Circle[{2 x+y+z,0},x+y,{π-θ,π+θ}],
{Thick,Purple,Circle[{0,0},x,{π-θ,π+θ}],
Circle[{2 x+y+z,0},x+y,{θ-π,π-θ}]}

},PlotRange->{{-10,43},{-13,22}},(*Axes->True,*)ImageSize->Large,AspectRatio->Automatic],

{{x,6.,"x"},4,7,0.1,Appearance->"Labeled"},
{{y,3.,"y"},0,5,0.1,Appearance->"Labeled"},
{{z,3,"z"},.1,9,0.1,Appearance->"Labeled"},
{{Answer,False,"Answer"},{False,True}},
TrackedSymbols->{x,y,z,θ,length,Answer}]]

Rotating an Equilateral Triangle

Draw a Heart

ClearAll["Global`*"];

Module[{θ},Manipulate[With[{q=Quotient[θ,(2/3)π],m=Mod[θ,(2/3)π]},Show[{Graphics[{PointSize[0.02],Blue,Point[f[θ]],EdgeForm[{Thick,Blue}],Pink,Rotate[Polygon[{{q,0},{ q+1/2,((Sqrt[3])/2) },{(q+1),0}}],-m,{q+1,0}],
{PointSize[0.02],Red,Point[g[θ/6+5π/3]]},Blue,Point[-3f[-θ/6-2π/3]],If[θ==2π,Inset[Style["Happy\nValentine's\nDay\n",16,Purple],{1.5,-0.6}],{}]},
Axes->{False,False},PlotRange->{{-1,7},{-3,2}},ImageSize->450],

ParametricPlot[{f[s]},{s,10^-9,θ},AxesOrigin->{0,0},PlotRange->{{-1,2 π/3+0.01},{-1.3,2.01}}, PlotStyle->{{Thickness[0.005],Blue},{Thick,Black}},Ticks->None, ImageSize->500],If[θ>2 π/3,
ParametricPlot[{f[k]},{k,2 π/3,θ},AxesOrigin->{0,0},PlotRange->{{-1,4 π+1.1},{-1.3,2.01}}, PlotStyle->{{Thickness[0.005],Red}},Ticks->None, ImageSize->500],{}],
(* Plot the lower parts *)

ParametricPlot[{-3f[-j/6-2π/3]},{j,10^-9,θ},AxesOrigin->{0,0},PlotRange->{{-1,4 π+1.1},{-1.3,2.01}}, PlotStyle->{Thickness[0.005],Blue},Ticks->None, ImageSize->500],

ParametricPlot[{g[j+5π/3]},{j,10^-9,θ/6.05},AxesOrigin->{0,0},PlotRange->{{-1,4 π+1.1},{-1.3,2.01}}, PlotStyle->{Thickness[0.005],Red},Ticks->None, ImageSize->500]
}]],{{θ,0,"Rotation angle θ"},0,2Pi,Appearance->"Labeled"},
TrackedSymbols->{θ},Initialization:>{ClearAll["Global`*"];f[θ_]:={Quotient[θ,2π/3]+1,0}+Total[{Cos[#],Sin[#]}&/@{5Pi/6-Mod[θ,2Pi/3],7Pi/6-θ}]/Sqrt[3];
g[β_]:=3 {Cos[#],Sin[#]}&/@{5 π/3+Mod[β, π/3]};},SaveDefinitions->True]]

Solving by reflection

Example 1

Manipulate[
p1:=Plot[aa - x,{x,0,aa},Filling->Axis,FillingStyle->RGBColor[1,0,1],PlotStyle->{Black,Thick},AspectRatio->Automatic,PlotRange->{{0,10},{0,10}},PlotLabel->If[Answer,TraditionalForm@Text@Style[
Row[{"shaded area = ",(a^2)," - \!\(\*FractionBox[\(π\\ \*SuperscriptBox[\(a\), \(2\)]\), \(4\)]\) = ",NumberForm[N[((aa^2)/4) (4 - π )],{5,3}]}],
18,Bold,RGBColor[0.25, 0.43, 0.82]],Text@Style["Calculate the shaded area ",16,Black,Italic]]
];
gr:=Graphics[{EdgeForm[Thick],FaceForm[GrayLevel[1]], Disk[{aa,0}, aa,{((3π)/4), π}]}
];
g2:=Graphics[{EdgeForm[Thick],FaceForm[GrayLevel[1]], Disk[{aa,0}, aa,{(π/2), π}]}
];
p2:=Plot[aa - x,{x,aa ((Sqrt[2])/2),aa},Filling->Axis,FillingStyle->RGBColor[1, 0,1],PlotStyle->{Black,Thick}];

p2r:=Plot[{aa - x,aa-(Sqrt[aa^2-(x)^2])},{x,aa ((Sqrt[2])/2),aa},Filling->{1->{2}},FillingStyle->RGBColor[1,0,0],PlotStyle->{{Black,Thick},{Black,Thick}}];

g2r:=Graphics[{EdgeForm[{Thick,Black}],FaceForm[{RGBColor[1, 0, 0.02]}],Polygon[{{0,aa},{aa,aa},{aa,0}}],EdgeForm[Thick],FaceForm[GrayLevel[1]], Disk[{0,aa}, aa,{((7π)/4),2 π}],Thick,Circle[{aa,0},aa,{3 π/4,π/2}]}];
g3r:=Graphics[{EdgeForm[{Thick,Black}],FaceForm[{RGBColor[1, 0, 0]}],Polygon[{{0,aa},{aa,aa},{aa,0}}],EdgeForm[Thick],FaceForm[GrayLevel[1]], Disk[{aa,0}, aa,{((2π)/4), π}],Thick,Circle[{aa,0},aa,{3 π/4,π/2}]}];

p3:=Plot[aa - (Sqrt[(aa^2)-(x^2)]),{x,0,aa ((Sqrt[2])/2)},Filling->Axis,FillingStyle->RGBColor[1,0,1],PlotStyle->{Black,Thick}];
p3r:=Plot[{aa ,Sqrt[aa^2-(x-aa)^2]},{x,aa (Sqrt[2])-aa,aa},Filling->{1->{2}},FillingStyle->RGBColor[1,0,0],PlotStyle->{Black,Thick}];
If[Answer,Show[p1,g3r,g2],If[explain,Show[p1,g3r,p3,p2r,p2],Show[p1,gr,p2,p3]],Show[p1,gr,p2,p3]],
(*If[explain,Show[p1,g3r,p3,p2r,p2],If[Answer,Show[p1,g3r,g2],Show[p1,gr,p2,p3]],Show[p1,gr,p2,p3]],*)
(*If[Answer,Show[p1,g3r,g2],Show[p1,gr,p2,p3]],*)
Row[{Control[
{{explain,False,"hint"},{False,True},Enabled->!Answer}],Spacer[100],Control[
{{Answer,False,"Answer"},{False,True}(*,Enabled->!explain*)}]}],
{{aa,9, "a"},2,10,Appearance->"Labeled"},TrackedSymbols->{explain,Answer,aa},SaveDefinitions->True]

Solving by reflection

Example 2

Given Isosceles Triangle ABC with vertex angle A = θ°.  If m ∠ DCB = 60 ° and m ∠EBC = 50 °.  Find m ∠ CDE

Manipulate[
a:=6;
n:=a (Sqrt[3])/((Sqrt[3])Cos[80  Degree]+Sin[80 Degree]);
b:= 2 n Sin[80 Degree] (Sqrt[3.])/3;
u:=a Sin[80 Degree]/(Cos[40 Degree]);
v:=u Sin[50 Degree]/Sin[80 Degree];
l:=a/(2Cos[80 Degree]);
Column[{
Item[If[Answer,Text@Style["Reflect the whole figure over line AC\nthen     m ∠ CDE = 30°\n", 14, Blue,Italic],Text@Style["Given Isosceles Triangle ABC with vertex A = 20°.  If m ∠ DCB = 60° and m ∠ EBC = 50°.  Find m ∠ CDE",14,Italic] ],ItemSize->{27,2},Alignment->{Center},Frame->True],
Item[

Graphics[{Line[{{0,0},{0,-1}}],Line[{{a,0},{a,-1}}],{Arrowheads[{-0.06,0.06}],Arrow[{{0,-0.8},{a,-0.8}}]},
Inset[Style[Row[{a," cm"}],14,Black],{a/2,-0.5}],
{Thick,(*Line[{{0,0},{a/2,h}}],Line[{{a,0},{a/2,h}}],*)Line[{{0,0},{a,0}}]
,Line[{{a,0},{a+b Cos[2π/3],b Sin[2π/3]}}]},
{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Disk[{a/2,17},3,{13 π/9,14π/9}],Disk[{0,0},2,{0,5π/18}],Disk[{a,0},2,{2π/3,π}],Disk[{n Cos[80 Degree],n Sin[80 Degree]},1,{5π/3,11π/6}]},


Inset[Text@Style[Row[{"β = 50° "}],14,Italic,Black],{1.8,0.8}],Inset[Text@Style[Row[{"α = 20°"}],14,Italic],{a/2.,13}],Inset[Text@Style[Row[{"θ = 60°"}],14,Italic,Black],{a-1.4,0.4}],
{Thick,Line[{{0,0},{u Cos[50 Degree],u Sin[50 Degree]}}]},
{Thick,Line[{{n Cos[80 Degree],n Sin[80 Degree]},{u Cos[50 Degree],u Sin[50 Degree]}}]},


{Red,PointSize[0.015],Point[{a+v Cos[100 Degree], v Sin[100 Degree]}]},

Rotate[{Thick,Line[{{0,0},{l,0}}]},80 Degree,{0,0}],Rotate[{Thick,Line[{{a-l,0},{a,0}}]},-80 Degree,{a,0}],
Inset[Text@Style["A",18,Bold],{3,17.4}],Inset[Text@Style["B",18,Bold],{-0.5,-0.5}],Inset[Text@Style["C",18,Bold],{a+0.5,-0.5}],
Inset[Text@Style["D",18,Bold],{0.6,n Sin[80 Degree]}],

Inset[Text@Style["?",18,Bold,Red],{n Cos[80 Degree]+1,n Sin[80 Degree]-1.2}],
Inset[Text@Style["E",18,Bold],{u Cos[50 Degree]+0.5,u Sin[50 Degree]}],
If[Answer,{{RGBColor[0,0.6,0.9],Polygon[{{a,0},{n Cos[80 Degree],n Sin[80 Degree]},{a+a Cos[20 Degree],a Sin[20 Degree]}}]},{Dashing[0.01],Black,Line[{{0,0},{u Cos[50 Degree],u Sin[50 Degree]}}],
Line[{{a,0},{a/2,l Sin[80 Degree]}}]

},{Purple,Line[{{a,0},{a+a Cos[20 Degree],a Sin[20 Degree]}}],
Line[{{a/2.,l Sin[80 Degree]},{a+a Cos[20 Degree],a Sin[20 Degree]}}],Line[{{
n Cos[80 Degree],n Sin[80 Degree]},{a+a Cos[20 Degree],a Sin[20 Degree]}}]},Inset[Text@Style["F",18,Bold],{a+a Cos[20 Degree]+0.5,a Sin[20 Degree]}],
Inset[Text@Style["30°",18,Bold,Red],{n Cos[80 Degree]+1.7,n Sin[80 Degree]-1.8}],Inset[Text@Style[Row[{" 20°"}],14,Italic,Red],{a-1,2.5}],Inset[Text@Style[Row[{"80°"}],14,Italic,Red],{a+.6,0.6}],Inset[Text@Style["50°",14,Italic,Red],{u Cos[50 Degree]-0.7,u Sin[50 Degree]+1}],Inset[Text@Style["50°",14,Italic,Red],{a+a Cos[20 Degree]-0.9,a Sin[20 Degree]}],Inset[Text@Style["20°",14,Italic,Red],{a+2.,0.3}],
Inset[Text@Style["40°",14,Red],{n Cos[80 Degree]+0.3,n Sin[80 Degree]-1.4}],
If[coord,{
Inset[Text@Style[Row[{"( ",NumberForm[n Cos[80. Degree],{5,3}]," , ",NumberForm[n Sin[80. Degree],{5,3}]," ) "}],14,Italic,Red],{0,n Sin[80 Degree]+0.6}],

Inset[Text@Style[Row[{"( ",NumberForm[u Cos[50. Degree],{5,3}]," , ",NumberForm[u Sin[50. Degree],{5,3}]," ) "}],14,Italic,Red],{u Cos[50. Degree]+3,u Sin[50 Degree]}],

Inset[Text@Style[Row[{"( ",NumberForm[a+a Cos[20. Degree],{5,3}]," , ",NumberForm[a Sin[20. Degree],{5,3}]," ) "}],14,Italic,Red],{a+a Cos[20. Degree],a Sin[20 Degree]-0.9}],
Inset[Text@Style[Row[{"( ",NumberForm[l Cos[80. Degree],{5,3}]," , ",NumberForm[l Sin[80. Degree],{5,3}]," ) "}],14,Italic,Red],{a-0.2,l Sin[80 Degree]}]},

{}]
},


{}]


},AxesOrigin->{0,0},Axes->False,AspectRatio->Automatic,ImageSize->Medium],ItemSize->{27,2},Alignment->{Center},Frame->True]
}],
Row[{Control[
{{Answer,False,"Answer"},{False,True}}],Spacer[90],Control[{{coord,False,"show coord"},{False,True}}]}],

TrackedSymbols->{Answer,coord},SaveDefinitions->True,AutorunSequencing->{1,2}]

Solving Geometrical problems by Reflection

Example 3

Reflection and Rotation
Reflecting a figure about a line
then rotating it.  In addition to rotating the existing figure.

ClearAll["Global`*"];

Manipulate[points={{x1,y1},{x2,y2},{x3,y3}};


(* Reflection of triangle over line y = m x + b *)
coordtymxb:=Graphics[{
Inset[Text@Style[Row[{"( ",NumberForm[xr2,3]," , ",NumberForm[yr2,3]," )"}],12,Black,Background->Lighter[Yellow,0.5]],{xr2+2,yr2+0.5}]
}];

(* Additional coordinates if reflection over x-axis *)

coordx:=Graphics[
Inset[Text@Style[Row[{"( ",NumberForm[x3,3]," , ",NumberForm[-y3,3]," )"}],12,Black,Background->Lighter[Yellow,0.5]],{xr3-0.5,-yr3-0.9}]];


(* Drawing Polygons *)
part1t:=Graphics[
If[rotate,Table[Rotate[{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Polygon[{{x1,y1},{t1,y1},{t1,t2}}]},i theta,{x1,y1}],{i,0,n,2}],{EdgeForm[{Thick,Blue}],FaceForm[Yellow],Polygon[{{x1,y1},{t1,y1},{t1,t2}}]}]];
part1tr:=Graphics[{EdgeForm[{Thick,Blue}],FaceForm[Cyan],Polygon[{{x1,y1},{x2,y2},{t1,-t2}}]}];
part1trh:=Graphics[If[rotref,
Table[Rotate[{EdgeForm[{Thick,Blue}],FaceForm[Cyan],Polygon[{{x1,y1},{tr1h,tr2h},{t1,t2}}]},i theta,{x1,y1}],{i,0,n,2}],{EdgeForm[{Thick,Blue}],FaceForm[Cyan],Polygon[{{x1,y1},{tr1h,tr2h},{t1,t2}}]}]
];


triangle:=
Graphics[{
If[rotate,Table[
Rotate[{EdgeForm[{Thick,Blue}],
Opacity[0.5,RGBColor[0.8,0,0.3]],Polygon[{{x1,y1},{x2,y2},{x3,y3}}]},k theta,{x1,y1}],{k,0,n,2}],


{EdgeForm[{Thick,Blue}],
Opacity[0.5,RGBColor[0.8,0,0.3]],Polygon[{{x1,y1},{x2,y2},{x3,y3}}]}],
If[showt,{
Inset[Text@Style["A ",14,Bold,Black],{x1,y1-1}],Inset[Text@Style["B ",14,Bold,Black],{x2,y2-1}],Inset[Text@Style["C ",14,Bold,Black],{x3+1,y3}],
(*Inset[Text@Style["D ",14,Bold,Red],{t1+0.5,t2+0.5}],*)(*If[showt,*)
Inset[Text@Style[Row[{"( ",x1," , ",y1," )"}],12,Black,Background->Lighter[Yellow,0.5]],{x1,y1+0.9}],
Inset[Text@Style[Row[{"( ",x2," , ",y2," )"}],12,Black,Background->Lighter[Yellow,0.5]],{x2+1,y2+0.9}],
Inset[Text@Style[Row[{"( ",x3," , ",y3," )"}],12,Black,Background->Lighter[Yellow,0.5]],{x3-1,y3+1.3}],

Inset[Text@Style[Row[{"( ",NumberForm[t1,{4,2}]," , ",NumberForm[t2,{4,2}]," )"}],12,Black,Background->Lighter[Yellow,0.5]],{t1,t2+1.5}]},{}]
},PlotLabel->If[Answert,
Text@Style[Row[{Style["Pink area : Yellow area = ",16,Purple,Italic],Style[NumberForm[ratio,{5,3}],Purple],Style[" : 1",Purple],Style["\nRadius of the semicircle = ",Red, Italic],Style[NumberForm[rds,{4,2}],16,Red,Italic]}],16],
Text@Style["Calculate ratio of Pink area to yellow area\nCalculate the radius",16,Italic]],PlotRange->{{-12,12},{-12,12}},If[grid,{Axes->True,AxesStyle->{{Blue,Thick},{Blue,Thick}},AxesLabel->{Style[x,Large,Bold,Italic,Blue],Style[y,Large,Bold,Italic]},GridLines->{Range[-12,12],Range[-12,12]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}]];
(* White Disk *)
whitedisk:=Graphics[{
If[rotate,Table[Rotate[{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{x2-rds,y2},rds,{0,π}],(*k theta,{x1,y1}],{k,0,n}]*)Red,Arrowheads[0.03],Arrow[{{x2-rds,y2},{t1,t2}}],PointSize[0.015],Point[{x2-rds,0}](*Text[Style["O ",14,Italic],{x2-rds,-1}]*)},k theta,{x1,y1}],{k,0,n,2}],{{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{ x2-rds,y2},rds,{0,π}]},

{Red,Arrowheads[0.03],Arrow[{{x2-rds,y2},{t1,t2}}]},{PointSize[0.015],Point[{x2-rds,0}]},Inset[Text@Style["D ",14,Bold,Red],{t1+0.5,t2+0.5}]}],



If[Answert,{Text[Style[Row[{"r = ",NumberForm[rds,{4,2}]}],13,Italic,Red],{(x2-rds+t1)/2,t2/2}],(*Text[Style["Calculate the radius",16,Black],{-6,7}]],*)
Text[Style[Row[{αdeg,"°"}],14,Italic,Red],{x2-rds-1.5,-0.9}]},{}]},PlotRange->All];




(*Red,Arrow[{{x2-rds,y2},{t1,t2}}],PointSize[0.015],Point[{x2-rds,0}],Text[Style["O ",14,Italic],{x2-rds,-1}],If[Answert,Text[Style[Row[{"r = ",NumberForm[rds,{4,2}]}],13,Italic],{(x2-rds+t1)/2,t2/2}]],(*Text[Style["Calculate the radius",16,Black],{-6,7}]],*)
Text[Style[Row[{αdeg,"°"}],14,Italic],{x2-rds-1.5,0.5}]}];*)
whitediskrfl:=Graphics[{
{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{ x2-rds,y1},rds,{0,-π}]},{Blue,Arrowheads[0.03],Arrow[{{x2-rds,y2},{t1,-t2}}]},

Inset[Text@Style[Row[{"( ",NumberForm[t1,{4,2}]," , ",NumberForm[-t2,{4,2}]," )"}],Background->Lighter[Yellow,0.5]],{t1,-t2-0.9}],

{Red,Arrowheads[0.03],Arrow[{{x2-rds,y2},{t1,t2}}]},

(*  Reflected arrow *)
(*{Blue,Arrow[{{xrcntr,yrcntr},{t1,t2}}]},*)
(* that was the important arrow *)

{PointSize[0.015],Point[{x2-rds,0}]}
}];
(*Graphics Reflected Triangle*)
whitediskrflh:=Graphics[{{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{ xrcntr,yrcntr},rds,{2 theta,2 theta-π}],PointSize[0.015]},Point[{xrcntr,yrcntr}], 
If[showt,
Inset[Text@Style[Row[{"( ",NumberForm[xrcntr,{4,2}]," , ",NumberForm[yrcntr,{4,2}]," )"}],12,Black,Background->Lighter[Yellow,0.5]],{xrcntr-3,yrcntr}],{}],If[rotref,{Table[Rotate[{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{xrcntr,yrcntr},rds,{2 theta,2 theta-π}],(*k theta,{x1,y1}],{k,0,n}]*)Blue,Arrowheads[0.03],Arrow[{{xrcntr,yrcntr},{t1,t2}}]},i(theta),{x1,y1}],{i,2,n,2}],{EdgeForm[{Thick,Black}],FaceForm[White],Disk[{ xrcntr,yrcntr},rds,{2 theta,2 theta-π}],PointSize[0.015]},Point[{x2-rds,0}],Point[{xrcntr,yrcntr}],
(*{}],*)
{Red,Arrowheads[0.03],Arrow[{{x2-rds,y2},{t1,t2}}]},

(*  Reflected arrow *)
{Blue,Arrow[{{xrcntr,yrcntr},{t1,t2}}]},
(* that was the important arrow *)

PointSize[0.015],Point[{x2-rds,0}]


    },{Blue,Arrowheads[0.03],Arrow[{{xrcntr,yrcntr},{t1,t2}}]}]
}];

trianglrymxbh=Graphics[If[rotref,
Table[
Rotate[{EdgeForm[{Thick,Blue}],
Opacity[0.5,RGBColor[0.8,0,0.3]],Polygon[{{x1,y1},{xr2,yr2},{x3,y3}}]},k theta,{x1,y1}],{k,0,n,2}],
{
{EdgeForm[{Thick,Blue}],
Opacity[0.5,Hue[0.9]],Polygon[{{x1,y1},{xr2,yr2},{x3,y3}}]},
Inset[Text@Style[Row[{Style["Equation of reflection line  y",Italic],Style[" = "],NumberForm[m,{2,1}],Style["x",Italic]," + ",b}],14,Purple],{-1,12}]}]


];
(*Graphics Reflected Triangle over x-axis*)
trianglrymxb:=Graphics[{EdgeForm[{Thick,Blue}],
Opacity[0.5,Hue[0.9]],Polygon[{{x1,y1},{x2,y2},{x3,-y3}}]

}];
original:=Show[triangle,part1t,whitedisk];
refx:=Show[triangle,part1t,whitedisk,trianglrymxb,part1tr,whitediskrfl,coordx];
refh:=Show[triangle,part1t,whitedisk,trianglrymxbh,part1trh,whitediskrflh];

(* Place the star in a circle *)
translatestarc:=Graphics[Table[Translate[#,(20+20 GoldenRatio){{Cos[t π/6],Sin[t π/6]}}],{t,1,12,1}]&/@refh];
(* Place the star in an ellipse *)
translatestare:=Graphics[Table[Translate[#,(20+20 GoldenRatio){{ Cos[t π/6],GoldenRatio Sin[t π/6]}}],{t,1,12,1}]&/@refh[[1]]];
If[incircle,Show[refh,translatestarc,PlotRange->Automatic],
If[ellipse,Show[translatestare,PlotRange->Automatic],

Show[triangle,part1t,whitedisk,

If[reflx,refx,original],If[reflhyp,Show[trianglrymxbh,part1trh,whitediskrflh],{original}]]] ],

Style["General info",14,Italic],
{{x1,0,"x1"},-12,11,.1,Appearance->"Labeled",ImageSize->Tiny},
{{x2,12,"x2"},-12,12,.1,Appearance->"Labeled",ImageSize->Tiny},
{{x3,12,"x3"},-12,12,.1,Appearance->"Labeled",ImageSize->Tiny},
{{y3,12 /(Sqrt[3.]),"y3"},-12,12,.1,Appearance->"Labeled",ImageSize->Tiny},
{{grid,True,"Show Grid"},{False,True}},
{{showt,False,"Showcordt"},{False,True}},
{{Answert,False,"Answert"},{False,True}},
Style["Reflections",14,Italic],
{{reflx,False,"refl x-axis"},{False,True}},
{{reflhyp,False,"refl hypot"},{False,True}},
{{rotref,False,"Rotate\n reflected"},{False,True}},
Style["Rotation",14,Italic],
{{rotate,False,"Rotate"},{False,True}},
{{n,2,"No. of\n rotations"},0,16,2,Appearance->"Labeled",ImageSize->Tiny},
{{incircle,False,"Incircle"},{False,True}},
{{ellipse,False,"Ellipse"},{False,True}},
ControlPlacement->Left,
TrackedSymbols->{x1,x2,x3,y3,grid,rotate,n,reflx,Answert,showt,reflhyp,incircle,ellipse},SaveDefinitions->True,Initialization:>(ClearAll["Global`*"];
areat:=Abs[0.5Det[(({{1, 1, 1}, {x1, x2, x3}, {y1, y2, y3}}))]];

(* Slope and y-intercept of hypotenuse *)
m:=((y3-y1)/(x3-x1));
b:=y1-(y3-y1) x1 / (x3-x1);
y1:=0;
y2:=0;xr1:=N[(1/(1+(m^2)))((1-(m^2))x1+ 2 m y1 - 2 b m),3];
yr1:=N[(1/(1+(m^2)))(2 m x1- (1-(m^2)) y1 + 2 b ),3];
xr2:=N[(1/(1+(m^2)))((1-(m^2))x2+ 2 m y2 - 2 b m),3];
yr2:=N[(1/(1+(m^2)))(2 m x2- (1-(m^2)) y2 + 2 b ),3];
xr3:=N[(1/(1+(m^2)))((1-(m^2))x3+ 2 m y3 - 2 b m),3];
yr3:=N[(1/(1+(m^2)))(2 m x3- (1-(m^2)) y3 + 2 b ),3];

theta:=ArcTan[((y3-y1)/(x3-x1))];
α:=π/2.-theta;
αdeg:=NumberForm[α 180/π,{4,2}];

rds:=y3 (x2 - x1 )/(y3+Sqrt[Abs[(x3-x1)^2. + y3^2. ]]);
(*Reflection of point center x2 - rds,0 over the hypotenuse *)
xrcntr:=N[(1/(1+(m^2)))((1-(m^2))(x2-rds)+ 2 m y1 - 2 b m),3];
yrcntr:=N[(1/(1+(m^2)))(2 m (x2-rds)- (1-(m^2)) y1 + 2 b ),3];
g:=x2-rds;
z:=y3/(x3-x1);
(*Point of Tangency (t1,t2 ) *)
t1:=(g+z^2 x1)/(z^2+1);
t2:=g/z-(g+z^2 x1)/(z (z^2+1));

tr1:=N[(1/(1+(m^2)))((1-(m^2))t1+ 2 m t2- 2. b m),3];
tr2:=N[(1/(1+(m^2)))(2 m t1- (1-(m^2)) t2+ 2 b ),3];
tr1h:=N[(1/(1+(m^2)))((1-(m^2))t1+ 2 m y2- 2. b m),3];tr2h:=N[(1/(1+(m^2)))(2 m t1 -(1-(m^2))y2+  2. b ),3];
area1:=0.5 rds Sqrt[(t1-x1)^2+t2^2] - 0.5 rds^2 α;

lnthtangAD:=(Sqrt[(t1-x1)^2 + (t2^2)]);
areaqd:=areat-0.5 rds lnthtangAD;
area2:=areaqd-0.5 rds^2 (π-α);
ratio:=FullSimplify[area2/area1];
)
]

Drawing 7 pointed star with multiple reflections using trig functions Red & Blue Arrows

This is the beauty of Mathematics with Mathematica

Manipulate[ClearAll["Global`*"];Pane[mata:={{x1,x2,x3,xD,xE},{y1,y2,y3,yD,yE},{1,1,1,1,1}};
matf:=((1/(1+(m^2)))){{1-(m^2),2 m, -2 b m},{2 m, (m^2)-1,2 b},{0,0,1+(m^2)}};
prf:=FullSimplify[matf . mata]//MatrixForm;
xr1:=prf[[1,1,1]];
yr1:=prf[[1,2,1]];xr2:=prf[[1,1,2]];yr2:=prf[[1,2,2]];xr3:=prf[[1,1,3]];yr3:=prf[[1,2,3]];xDr:=prf[[1,1,4]];
yDr:=prf[[1,2,4]];tr1:=prf[[1,1,5]];
tr2:=prf[[1,2,5]];
phi:=ArcTan[((y3-y1)/(x3-x1))];
m0=((y3-y1)/(x3-x1));
beta:=ArcTan[m];
alpha:=ArcTan[((y2-y1)/(x2-x1))];
theta:=Abs[phi-alpha];
AC:=Sqrt[(y3-y1)^2+(x3-x1)^2];
AB:=Sqrt[(y2-y1)^2+(x2-x1)^2];
rad:=((AB Sin[theta])/(1+Sin[theta]));
AD:=AB-Abs[rad];
AE:=Abs[AD Cos[theta]];

(* Point of Tangencies  {t1, t2 }*)
t1:=AE Cos[phi];
t2:=AE Sin[phi];
(* Center of Semi-circle is {xD , yD}  *)
xD:=(((AB-rad)x2+rad x1)/AB);
yD:=(((AB-rad)y2+rad y1)/AB);

(* points t1, t2  are the same as  tangency xE, yE *)

xE:=xD-rad Cos[π/2 - phi];
yE:=yD+rad Sin[π/2-phi];
plt:=Plot[{m x + b},{x,-3,6},PlotStyle->Red];
gp:=Graphics[{{EdgeForm[Blue],FaceForm[RGBColor[0,0.6,1]],Polygon[{{x1,y1},{x2,y2},{x3,y3}}]},
{EdgeForm[Blue],FaceForm[RGBColor[1,0.6,1]],Polygon[{{x1,y1},{xD,yD},{xE,yE}}]},
{White,EdgeForm[{Thick,Black}],Disk[{xD,yD},rad,{alpha,π+alpha}]},{PointSize[0.015],Blue,Point[{x1,y1}],Point[{x2,y2}],Point[{x3,y3}],Black,Point[{xD,yD}]},
{Purple,Arrow[{{xD,yD},{xE,yE}}]},
If[grid,{Axes->True,AxesLabel->{Style[x,Large,Bold,Italic],Style[y,Large,Bold,Italic]},GridLines->{Range[-10,10],Range[-10,10]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}],
If[rotate,Outer[Rotate[{{EdgeForm[Blue],FaceForm[RGBColor[0,0.6,1]],Polygon[{{x1,y1},{x2,y2},{x3,y3}}]},

{EdgeForm[Blue],FaceForm[RGBColor[1,0.6,1]],Polygon[{{x1,y1},{xD,yD},{xE,yE}}]},
{White,EdgeForm[{Thick,Black}],Disk[{xD,yD},rad,{alpha,π+alpha}]},{PointSize[0.015],Blue,Point[{x1,y1}],Point[{x2,y2}],Point[{x3,y3}],Black,Point[{xD,yD}]},
{Red,Arrowheads[0.025],Arrow[{{xD,yD},{xE,yE}}]}},#,{x1,y1}]&, (2 theta) Range[n]],{}]
},If[grid,{Axes->True,AxesLabel->{Style[x,Large,Bold,Italic],Style[y,Large,Bold,Italic]},GridLines->{Range[-10,10],Range[-10,10]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}]];


(* Reflected Polygons and Disk  *)
gpr:=Graphics[{{EdgeForm[Blue],FaceForm[Cyan],Polygon[{{xr1,yr1},{xr2,yr2},{xr3,yr3}}]},
{EdgeForm[Blue],FaceForm[Orange],Polygon[{{xr1,yr1},{xDr,yDr},{tr1,tr2}}]},
{White,EdgeForm[{Thick,Black}],Disk[{xDr,yDr},rad,{2beta-alpha+π,2π+2beta-alpha}]},
{Blue,Arrowheads[0.025],Arrow[{{xDr,yDr},{tr1,tr2}}]},If[angle,{Red,Line[{{xDr-1.,yDr},{xDr+1.3,yDr}}],Circle[{xDr,yDr},0.75,{0,2 beta-alpha}],Text[Style[" θ °",18],{xDr+0.3,yDr+0.15}]},{}],
{Red,Point[{xr1,yr1}],Point[{xr2,yr2}],Point[{xr3,yr3}]},If[dash,{Dashing[0.01],Line[{{x1,y1},{xr1,yr1}}],Line[{{x2,y2},{xr2,yr2}}],Line[{{x3,y3},{xr3,yr3}}]},{}],
{PointSize[0.015],Black,Point[{xDr,yDr}]},If[grid,{Axes->True,AxesLabel->{Style[x,Large,Bold,Italic],Style[y,Large,Bold,Italic]},GridLines->{Range[-10,10],Range[-10,10]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}],
If[rotref,Outer[Rotate[{{EdgeForm[Blue],FaceForm[Cyan],Polygon[{{xr1,yr1},{xr2,yr2},{xr3,yr3}}]},
{EdgeForm[Blue],FaceForm[Orange],Polygon[{{xr1,yr1},{xDr,yDr},{tr1,tr2}}]},
{White,EdgeForm[{Thick,Black}],Disk[{xDr,yDr},rad,{2beta-alpha+π,2π+2beta-alpha}]},
{Blue,Arrowheads[0.025],Arrow[{{xDr,yDr},{tr1,tr2}}]},
{Red,Point[{xr1,yr1}],Point[{xr2,yr2}],Point[{xr3,yr3}]},If[dash,{Dashing[0.01],Line[{{x1,y1},{xr1,yr1}}],Line[{{x2,y2},{xr2,yr2}}],Line[{{x3,y3},{xr3,yr3}}]},{}],
{PointSize[0.015],Black,Point[{xDr,yDr}]}},#,{x1,y1}]&,(2 theta) Range[nr]],{}]
},If[grid,{Axes->True,AxesLabel->{Style[x,Large,Bold,Italic],Style[y,Large,Bold,Italic]},GridLines->{Range[-10,10],Range[-10,10]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}]];


(* Place the star in a circle   First Translate the group *)
gpgpr:=Show[gpr,gp,ImageSize->400,PlotRange->All];
starc:=Graphics[Table[Translate[#,(11.7+11.7 GoldenRatio){Cos[t π/6],Sin[t π/6] }],{t,1,12,1}]&/@gpgpr];

(* Place the star in an Ellipse   First Translate the group *)
stare:=Graphics[Table[Translate[#,(9.7+9.7 GoldenRatio){ Cos[t π/6], GoldenRatio Sin[t π/6] }],{t,1,12,1}]&/@gpgpr[[1]]];
Column[{Item[If[Answer,Text@Style[Row[{Style["m ∠ θ = ",Purple,Italic],Style[NumberForm[(2 beta-alpha) 180./π, {4,2}],Italic],"°\n"}],18,Purple],Text@Style["Calculate the measure of the central angle θ at the first reflected semi-circle",18]],Alignment->{Center}],

Item[If[ellipse,Show[stare,ImageSize->{500,600}],If[incircle,Show[gpgpr,starc,ImageSize->{650,600}],If[refl&&line,Show[gpgpr,plt],If[refl,gpgpr,
If[line,Show[gp,plt,ImageSize->{400,400}],
Show[gp,ImageSize->{400,400},PlotRange->All]]]]]],

Alignment->{Center},ItemSize->Automatic]}]],

Row[{Control[{{Answer,False,"Answer"},{False,True}}],Control[{{incircle,False,"In Circle"},{False,True}}],Control[{{ellipse,False,"in ellipse"},{False,True}}]
}],
Delimiter,
Style["Polygon Coord.",14,Blue],
{{x1,0,"x1"},-4,4,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{y1,0,"y1"},-4,4,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{x2,3,"x2"},-4,10,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{y2,1.03,"y2"},-4,4,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{x3,5.75,"x3"},-12,12,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{y3,5.75,"y3"},-5,12,0.01,Appearance->"Labeled",ImageSize->Tiny},
Row[{Control[{{line,True,"Polygon"},{False,True}}],Control[{{grid,False,"Grid"},{False,True}}]
}],
Delimiter,
Style["Reflection Line",14,Red],
{{line,False,"Reflection line"},{False,True}},
{{m,m0,"Slope"},-3,3,0.01,ImageSize->Tiny,Appearance->"Labeled"},
{{b,0.,"y-cept"},-4,5,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{refl,True,"Refl"},{False,True}},Row[{Control[{{angle,False,"Show Angle"},{False,True}}],Control[
{{dash,False,"Dashed lines"},{False,True}}]}],
Delimiter,
Style["Reflection Control",14,Purple],
{{rotref,True,"rotate\nreflected"},{False,True}},{{nr,6,"No.LRot"},0,16,1,ImageSize->Tiny,Appearance->"Labeled"},
Delimiter,
Style["Rotation Control",14,Blue],
{{rotate,True,"Rot"},{False,True}},
{{n,6,"No. Rot"},0,16,1,ImageSize->Tiny,Appearance->"Labeled"},
ControlPlacement->Left,

TrackedSymbols->{m,b,m0,grid,refl,n,rotate,rotref,nr,line,angle,dash,Answer,incircle,ellipse,x1,y1,x2,y2,x3,y3}]

What is the largest equilateral triangle that can be inscribed in a unit square (A square  with side length = 1 cm)

Manipulate[
Graphics[{EdgeForm[{Thick,Black}],FaceForm[Yellow],Rectangle[{0,0},{1,1}],

Text[Style["A",16,Bold,Black],{-0.05,0}],
Text[Style["B",16,Bold,Black],{1.05,0}],
Text[Style["C",16,Bold,Black],{1.05,1.05}],
Text[Style["D",16,Bold,Black],{0,1.05}],
If[solution,{
{EdgeForm[{Thick,Blue}],FaceForm[Red],Polygon[{{0,0},{1,Tan[15°]},{Sec[15°]Cos[75°],Sec[15°]Sin[75°]}}]},
Text[Style["E",16,Bold,Black],{1.05,Tan[15°]}],
Text[Style["F",16,Bold,Black],{Sec[15°]Cos[75°],0.05+Sec[15°]Sin[75°]}],
Text[Style["θ = 15°",16,Bold,Black],0.25{Cos[15° /2]+0.3,Sin[15 °/2]}],
{Arrowheads[0.03],Thick,Black,Arrow[{{0.2,0},0.2{Cos[θ],Sin[15°]}}]},

Text[Style["45°",16,Bold,Black],{0.94,0.15+Tan[15° ]}],

{Thick,Black,Circle[{1,Tan[15°]},0.12,{π/2,135°}]},

Text[Style["75°",16,Bold,Black],{0.93,Tan[15° ]-0.12}],
{Thick,Black,Circle[{1,Tan[15°]},0.1,{195°,270°}]},

Text[Style["45°",16,Bold,Black],{Sec[15°]Cos[75°]+0.13,Sec[15°]Sin[75°]-0.05}],
{Thick,Black,Circle[{Sec[15°]Cos[75°],Sec[15°]Sin[75°]},0.08,{7π/4,2 π}]},

{Thick,Black,Circle[{Sec[15°]Cos[75°],Sec[15°]Sin[75°]},0.08,{π,17π/12}]},
Text[Style["75°",16,Bold,Black],{Sec[15°]Cos[75°]-0.12,Sec[15°]Sin[75°]-0.06}],
Text[Style[Row[{
"The length of the side of \nthe equilateral triangle = ",Simplify[Sec[15°]]," cm\nmaximum area of equilateral triangle = ", FullSimplify[((Sqrt[3])/4) Sec[15°]^2],"  (cm^2)\n"}],14,Purple],{0.5,1.2}]
},

{Text[Style["Calculate the side length and the area of the largest \nequilateral triangle that can be inscribed in a unit square",13,Italic,Black],{0.5,1.2}],
Inset[Style[Row[{"θ = ",θ}],14,Bold,Blue],0.25{Cos[θ /2]+0.3,Sin[θ /2]}],
{EdgeForm[{Thick,Blue}],FaceForm[Red],Polygon[{{0,0},{1,Tan[θ]},{Sec[θ]Cos[π/3+θ],Sec[θ]Sin[θ+π/3]}}]},
{Arrowheads[0.03],Thick,Red,Arrow[{{0.2,0},0.2{Cos[θ],Sin[θ]}}]},

Text[Style["E",16,Bold,Black],{1.05,Tan[θ]}],

Text[Style["F",16,Bold,Black],{Sec[θ]Cos[θ+π/3],0.05+Sec[θ]Sin[θ+π/3]}]
}]
}],

{{θ,11°,"inclination angle"},20°,0° ,1°,Appearance->"Labeled"},{{solution,False,"solution"},{False,True}}
,TrackedSymbols:>{θ,solution},ContentSize->390]

PreCalculus

Example:
Find the minimum and maximum area of a triangle in a square whose vertex is on the quarter circle of the square.

Manipulate[
x=1/(2 Cos[t]);
y=(1- x Cos[t])/Sin[t];
areacheck=1/(4 Sin[2 t]);

plot1=Plot[1/(4 Sin[2 T]),{T,π/180,t},PlotStyle->{Thick,Blue},AxesOrigin->{0,0},Axes->True,AspectRatio->Automatic,AxesOrigin->{0,0},PlotRange->{{-0.1,1.6},{-0.1,0.75}},Ticks->{{0,π/12,π/6,π/4,π/3,5π/12},{0,0.2,0.4,0.6}},AxesLabel->{"m ∠ BCP"," Area of Δ"},LabelStyle->Directive[12,Bold],GridLines->{Range[0,π/2,π/12],Range[-0.2,0.6,0.2]},ImageSize->Medium,GridLinesStyle->Directive[RGBColor[0,0.6,1]],Epilog->{Purple,PointSize[0.02],Point[{t,areacheck}],Inset[Style[Row[{"{ ",NumberForm[t , 2] ,",  ",N[areacheck,3]," }"}],12,Bold],{t,areacheck-0.15}],Arrowheads[0.05],Blue,Thick,Arrow[{{0,0},{6π/12,0}}],Arrow[{{0,0},{0,0.75}}]
}];

gsq=Graphics[{
If[Answer,
Inset[Row[{Style["Area of Triangle = ",16,Blue,Italic],Style[areacheck,16,Blue]}],{0.5,1.2}],Inset[Style["What is the largest and smallest areas\n that the shaded triangular region \ncan have?\n",18,Italic, Black],{0.5,1.2}]],Inset[Style["A",18,Bold],{-0.05,-0.05}],Inset[Style["B",18,Bold],{x,-0.05}],Inset[Style["C",18,Bold],{-0.05,y}],Inset[Style["P",18,Bold,Purple],{Cos[t]+0.03,Sin[t]+0.03}],
{Purple,Arrowheads[{-0.04,0.04}],Arrow[{{0.0,-0.09},{x,-0.09}}],Arrow[{{-0.09,0},{-0.09,y}}]},Inset[Row[{Style["x",14,Italic]," = ",x}],{x/2,-0.04}],
Inset[Row[{Style["y",14,Italic]," = ",y}],{-0.,y/2}],
{ Thick,Line[{{x,0},{1,0}}],
Line[{{0,y},{0,1}}],Line[{{0,1},{1,1}}],Line[{{1,1},{1,0}}]},{Dashing[0.01],Line[{{0,0},{x,0}}],Line[{{0,0},{0,y}}]},
{EdgeForm[Red],FaceForm[Yellow],Polygon[{{x,0},{Cos[t],Sin[t]},{0,y}}]},
Red,Circle[{0,0},1,{0,π/2}],{PointSize[0.025],Red,Point[{Cos[t],Sin[t]}]}},ImageSize->300];
Row[{Show[gsq],Spacer[30],Show[plot1]}],Row[{Control[{{t,π/4,"∠ BCP"},π/6,π/3,π/72,Appearance->"Labeled"}],Spacer[90],Control[
{{Answer,False,"Answer"},{False,True}}]}],
TrackedSymbols->{t,x,Answer}]

Designing the Old YMCA Logo

ClearAll["Global`*"];

Manipulate[
area1:=(Sqrt[3]) b^2;
area2:=(Sqrt[3]) (b-t(Sqrt[3]))^2;
coloredareat:=area1-area2;
Areaparallel:= 3 t (Abs[b]+t/4) (Sqrt[3]);
arearect:=3 t (Abs[b]+t/4) (Sqrt[3]);
totcoloredarea:=coloredareat+Areaparallel+arearect;

gp1=Graphics[{Red,
Polygon[{{-b,0},{ b,0},{0,b c(Sqrt[3])}}]},Axes->True,AxesOrigin->{0,0}];
gp2=Graphics[{GrayLevel[1],Polygon[{{-b+t (Sqrt[3]),c t},{b-t (Sqrt[3]),c t},{0,c b(Sqrt[3])-2 c t}}],
Inset[Style[" (t/2) ",14, Blue],{(b + t / 4) c, -0.15 c}],Inset[Row[{Style[" 3 ",14,Blue],Style["t ",14,Blue, Italic]}], {(b+1.75 t)c,-0.18 c}],
Inset[Style[" b ",14,Blue, Italic],{-b c/2,-0.18 c}],Inset[Style[" (t/4) ",14,Blue],{-t c,1.15( b+((t )/4)) c (Sqrt[3])}]}];
gline:=Graphics[{
Thick,Line[{{-b,0},{b,0}}],Line[{{-b,0},{0,c b (Sqrt[3])}}],
Line[{{0,c b (Sqrt[3])},{b,0}}],Line[{{-b+t (Sqrt[3]),c t},{b-t (Sqrt[3]),c t}}],Line[{{b-t (Sqrt[3]),c t},{0,b c(Sqrt[3])-2 c t}}],Line[{{-b+t (Sqrt[3]),c t},{0,c b(Sqrt[3])-2 c t}}]},Axes->True,AxesOrigin->{0,0}];
an:=If[Answer,Graphics[Inset[Style[Row[{"colored area = ",totcoloredarea," sq. units\n"}],16,Red],{-t,(Sqrt[3])(2b +t)c +0.3 c}],AxesOrigin->{0,0}],Graphics[Inset[Style["Calculate the gray and Red areas if the heights \nof the parallelogram and the rectangle are the same \n and the triangle is equilateral.",16,Red],{-2 t,(Sqrt[3])(2b +t)c +0.3 c}],Axes->False,AxesOrigin->{0,0}]];
rect:=Graphics[{GrayLevel[0.3],Polygon[{{3.25 c t,(b+((t )/4)) c (Sqrt[3])},{c t/4,(b+t/4)c (Sqrt[3])},{c t/4,2(b+t/4)c (Sqrt[3])},{3.25c t,2(b+((t )/4)) c (Sqrt[3])}}],
Polygon[{{(b+ t/2) c,0},{(b+3.5 t) c,0},{3.25 c t,(b+((t )/4)) c (Sqrt[3])},{c t/4,(b+t/4)c (Sqrt[3])}}]}];
darrows:=Graphics[{Arrowheads[{-0.05,0.05}],Arrow[{{(b+3.5 t)c,-0.12 c},{(b+0.5 t) c,-0.12 c}}],Arrow[{{-b c,-0.12 c},{0,-0.12 c}}]}];
arrows:=Graphics[{Arrow[{{c t,1.3(b+t/4)c (Sqrt[3])},{c t/4,1.3(b+t/4)c (Sqrt[3])}}],
Arrow[{{-b c/3,1.3(b+t/4)c (Sqrt[3])},{0,1.3(b+t/4)c (Sqrt[3])}}],
Inset[Style["t ",18, Italic],{-.1,0.5 c t}]}];
line2:=Graphics[{Thick,Line[{{(b+ t/2) c,0},{(b+3.5 t) c,0}}],Line[{{(b+ t/2) c,0},{c t/4,(b+t/4)c (Sqrt[3])}}],Line[{{(b+3.5 t) c,0},{3.25 c t,(b+((t )/4)) c (Sqrt[3])}}],Line[{{3.25c t,2(b+((t )/4)) c (Sqrt[3])},{c t/4,2(b+t/4)c (Sqrt[3])}}],
Line[{{c t/4,(b+t/4)c (Sqrt[3])},{c t/4,2(b+t/4)c (Sqrt[3])}}],Line[{{3.25 c t,(b+((t )/4)) c (Sqrt[3])},{3.25 c t,2(b+((t )/4)) c (Sqrt[3])}}],
{Blue,Line[{{0,(b) c (Sqrt[3])},{0,1.35( b+((t )/4)) c (Sqrt[3])}}],
Line[{{0,0},{0,-0.2 c}}],
Arrowheads[.5{-0.05,0.05}],Arrow[{{0,t c},{0, .1 t c}}],
Line[{{b,0},{b,-0.2 c}}],
Line[{{(b+t/2)c,0},{(b+t/2)c,-0.2 c}}],
Line[{{-b c,0},{-b c,-0.2 c}}],
Line[{{b c,0},{b c,-0.2 c}}],
Line[{{(3.5 t + b)c,0},{(3.5 t + b)c,-0.2 c}}]}
}];
Show[an,gp1,gp2,gline,rect,line2,darrows,arrows,PlotRange->All, ImageSize-> {500,400}],
{{Answer,False,"answer"},{False,True},ControlPlacement->Left},
{{c,-1, ""},{-1->Style["right side up",13,Background->Yellow], 1->Style["upside down",13,Background->Yellow]}},
{{b,1,Row[{"Δ half length ", Style["b", Italic]}]},1,2,.01,Appearance->"Labeled"},
{{t,0.3,Row[{"Δ thickness ", Style["t", Italic]}]},0.2,Floor[10((Sqrt[3])/3.) (b-0.3)]/10, .01,Appearance->"Labeled"},
TrackedSymbols->{Answer,c,b,t},SaveDefinitions->True]

Designing the New YMCA Logo

Manipulate[
DynamicModule[{chopedarea1,chopedarea2,shadedarea,line1,verticescoord,darrows,line2,segmentcoord,cir,cnr, an,gp,rect},
(* Calculating the choped areas with radius = b/8 and sector with central angle = 2 π/3 
Chopped area = area of two triangles  - area of sector*)
chopedarea1:=2 (0.5)(b/8)(b(Sqrt[3]))/8 - 0.5 (b/8)^2 (2π/3);
(*Calculating the choped areas with radius = b/4 and sector with central angle = π/3 
Chopped area = area of two triangles  - area of sector*)
chopedarea2:=2 (0.5)(b/4)(b/(4 (Sqrt[3])))- 0.5 (b/4)^2 (π/3);
(*shaded  area=area of triangle +area of two parallelograms - 5 choped areas with radius b/8 and two with radius b/4 *)
shadedarea:=(1.125 + h )(Sqrt[3]) k b^2 + 17 (Sqrt[3]) (b^2)/8 - 5 chopedarea1-2 chopedarea2;

an:=If[Answer,{Graphics[Inset[Style[Row[{"\n\nshaded Area = ",shadedarea," sq. units\n\n"}],17,Bold,Blue],{1.1b c,-1.2 b c}],AxesOrigin->{0,0}]},{Graphics[Inset[Style["\n\ncalculate the total shaded areas\n\n ",17,Bold,Red],{1.1b c,-1.2 b c}],Axes->False,AxesOrigin->{0,0}]}];
(*Draw the structures of the logo*)
line1:=Graphics[{Dashing[0.01],Line[{{(1.25 b) c,0},{(1.25 b+ k b) c,0}}],Line[{{(1.25 b) c,0},{b c/8,(9 b/8)c (Sqrt[3])}}],Line[{{(1.25+k )b c,0},{k b c +0.125 b c,(((9 b )/8)) c (Sqrt[3])}}],
Line[{{(0.125+k)b c,(((9 b )/8)) c (Sqrt[3])},{(0.125+h+k)b c,(1.125+h)(Sqrt[3])b c}}],
Line[{{0.125 b c,1.125b c(Sqrt[3])},{(0.125+h)b c,(1.125+h) b c (Sqrt[3])}}],
Line[{{(0.125+h)b c,(1.125+h) b c (Sqrt[3])},{(0.125+h+k)b c,(1.125+h)(Sqrt[3])b c}}],
Line[{{-b,0},{b,0}}],Line[{{-b,0},{0,c b (Sqrt[3])}}],
Line[{{0,c b (Sqrt[3])},{b,0}}],



{Blue,Line[{{0,(b) c (Sqrt[3])},{0,1.35( 1.125 b) c (Sqrt[3])}}],
Line[{{0,0},{0,-0.4 b c}}],
Line[{{(h+k+0.125) b c,(1.125+h)(Sqrt[3]) b c},{(h+k+0.5) b c,(1.125+h)(Sqrt[3]) b c}}],
Line[{{k b c +0.5 b c+h b c,9 b c (Sqrt[3])/8},{k b c +0.125 b c, b c (Sqrt[3])+ b c (Sqrt[3])/8}}],

Line[{{b,0},{b,-0.4b c}}],
Line[{{(1.25 b)c,0},{(1.25 b)c,-0.4b c}}],
Line[{{(k b+1.25 b)c,0},{(k b +1.25 b)c,-0.4b c}}],
Line[{{-b c,0},{-b c,-0.4b c}}],
Line[{{b c,0},{b c,-0.4b c}}],
Line[{{b c/8,(1.125b)(Sqrt[3]) c},{b c/8,1.35(1.125  b )(Sqrt[3]) c}}]}
}];
verticescoord:=
If[coord1, {Graphics[{
Inset[Style[Row[{"( ",NumberForm[1.25 b  c,3], " ,  0 ) "}],12,Bold],{1.25 b c,-0.1 b c}],
Inset[Style[Row[{"( ",NumberForm[k b c +1.25 b c,3], " ,  0 ) "}],12,Bold],{k b c +1.25 b c,-0.16 b c}],
(* Middle Section *)
Inset[Style[Row[{"(  ",NumberForm[0.125 b c,3], " ,  ",NumberForm[(((9b )/8.)) c (Sqrt[3]),3],"  ) "}],12,Bold],{0.2 b c ,b c (Sqrt[3])+0.35 c b }],Inset[Style[Row[{"(  ",NumberForm[k b c +0.125 b c,3], " ,  ",NumberForm[(((9b )/8.)) c (Sqrt[3]),3],"  )"}],12,Bold],{(k+0.75) b c ,b c (Sqrt[3]) +0.1 b c}],
(* Bottom Section *)
Inset[Style[Row[{"(  ",NumberForm[(h+.125 )b c,3], " ,  ",NumberForm[(((8 h + 9  )/8.)) b c (Sqrt[3]),3],"  ) "}],12,Bold],{(h+.125 ) b c-0.5b c,(((8 h + 9  )/8.))b c (Sqrt[3]) }],Inset[Style[Row[{"(  ",NumberForm[(h +k)b c +.125 b c,3], " ,  ",NumberForm[(((8 h + 9 )/8.)) b c (Sqrt[3]),3],"  ) "}],12,Bold],{(h + k+0.125) b c+0.1b c,(((8 h + 9 )/8.))b c (Sqrt[3])+0.15 c b }],

(* Triangle Part *)
Inset[Style[Row[{"( ",-b  c, " ,  0 ) "}],12,Bold],{-b c,0.1 b c}],
Inset[Style[Row[{"( ",b c, " ,  0 ) "}],12,Bold],{b c -0.25 b c,0.1  b c}],
Inset[Style[Row[{"( 0 ", " ,  ",b c (Sqrt[3]),"  ) "}],12,Bold],{-0.60 b c,b c (Sqrt[3])}]  
}]},

{Graphics[Inset[Style["\n\nFind Coordinates of Vertices\n\n",17,Bold,Red],{1.1b c,-1.2 b c}]  ]}];


darrows:=Graphics[{Arrowheads[{-0.04,0.04}],Arrow[{{(1.25 +k)b c,-0.3 b c},{(1.25 b) c,-0.3 b c}}],Arrow[{{-b c,-0.3 b c},{0,-0.3 b c}}],Arrow[{{(h+k+0.4) b c, 9 b c (Sqrt[3])/8},{(h+k+0.4) b c, (9 +8 h)b c (Sqrt[3])/8}}],

Inset[Text@Style[Row[{Style["k",Italic]," ",Style["b",Italic]," = ",NumberForm[k b,3]}],12,Blue,Bold],{(5  / 4+k/2) b c, -0.48b c}],
Inset[Text@Style[NumberForm[b/4.,2],12,Blue], {(1.125 b)c,-0.38b  c}],
Inset[Text@Style[Row[{Style["b",Italic]," "," = ",NumberForm[b,3]}],12,Blue,Bold],
{-b c/2,-0.48 b c}],
Inset[Text@Style[NumberForm[b/8.,3],12,Blue,Bold],{-0.19 b c,1.23( 1.125 b) c (Sqrt[3])}],
Inset[Text@Style[Row[{Style["(Sqrt[3]) "],Style["h",Italic]," ",Style["b",Italic]," = ",NumberForm[(Sqrt[3]) h b ,4]}],12,Blue,Bold],{ (h+k+0.1) b c,(1.125+h/2)(Sqrt[3])b c }],
Arrowheads[{0,0.04}],Arrow[{{-b c / 2,1.45(b)c (Sqrt[3])},{0,1.45(b)c (Sqrt[3])}}],
Arrow[{{2 b c / 3,1.45(b)c (Sqrt[3])},{ b c/8,1.45(b)c (Sqrt[3])}}],
Arrow[{{b c /2 ,-0.3b c},{b c,-0.3 b c}}]

}];line2:=Graphics[{Inset[Text@Style[Row[{Style["Small radius",Italic]," = ",TraditionalForm[Style["b",Italic]/8]," = ",NumberForm[b/8.,3]}],RGBColor[1,0,0.3],Opacity[0.9],12,Bold],{(-0.25) b c,(1.0+2 h/3)(Sqrt[3])b c}],
Inset[Text@Style[Row[{Style["Big Radius",Italic]," = ",TraditionalForm[Style["b",Italic]/4]," = ",NumberForm[b/4.,3]}],RGBColor[0,0,1],12,Bold],{ -(0.25) b c,(1.125+0.8 h)(Sqrt[3])b c}],
Thick,Line[{{(1.25 +k-(Sqrt[3])/8) b c ,0},{b c+b c/4+b c /(4 (Sqrt[3])),0}}],
(* Triangle Lines *)
Line[{{(1-(Sqrt[3])/8) b c,0},{(-1+(Sqrt[3])/8) b c,0}}],
Line[{{(1 - (Sqrt[3])/16)b c, 3 b c/16},{(Sqrt[3]) b c/16,((Sqrt[3]) - 3/16) b c}}],
Line[{{(-1+(Sqrt[3])/16) b c,3 b c / 16},
{-b c (Sqrt[3])/16,((Sqrt[3])-3/16) b c}}],

(* End of triangle lines *)

(* Parallelogram upper *)
Line[{{k b c + b c /8+b c  /(8(Sqrt[3])),9 b c (Sqrt[3 ])/8-b c/8},{k b c + b c + b c/4 -b c(Sqrt[3])/16,3b c /16}}],
Line[{{b c +b c/4-b c /(8 (Sqrt[3])), b c/8},{b c/8+b c/(8 (Sqrt[3])),9 b c (Sqrt[3])/8
-b c/8}}],


(* Parallelogram lower *)
Line[{{((b c)/24)(3 +  (Sqrt[3])),((b c)/8)(9  (Sqrt[3]) + 1)},{ h b c +b c/8-b c/(8(Sqrt[3])), -b c/8+h b c (Sqrt[3])+9 b c (Sqrt[3])/8}}],

Line[{{((b c)/24)(3 +  (Sqrt[3]))+k b c, ((b c)/8)(9  (Sqrt[3]) + 1)},{h b c +k b c +b c/8-b c(Sqrt[3])/16, -3 b c/16+h b c (Sqrt[3])+9 b c (Sqrt[3])/8}}],
(* Bottom line *)

Line[{{(h+0.125) b c+b c/(4(Sqrt[3])),(h+1.125) b c (Sqrt[3])},{(h+k+0.125) b c-b c(Sqrt[3])/8,(h+1.125) b c (Sqrt[3])}}]
}];
segmentcoord:=

If[coord2,Graphics[{
(* Top Section *)

Inset[Style[Row[{"( ",NumberForm[(k+1.25)b c-b c (Sqrt[3])/8.,3]," , 0 )"}],12,Bold,Purple],
{(k+1.25)b c-b c (Sqrt[3])/8. +0.2 b c,-0.17b c}],
Inset[Style[Row[{" ( ",NumberForm[b c+b c/4.+b c /(4.0  (Sqrt[3])),3]," , 0 )"}],12,Bold,Purple],
{b c+b c/4.+b c /(4. (Sqrt[3])) -0.05 b c,-0.07 b c}],

Inset[Style[Row[{" ( ",NumberForm[(1-(Sqrt[3])/8.) b c,3]," , 0 )"}],12,Bold,Purple],
{(1-(Sqrt[3])/8) b c -0.1 b c,-0.15 b c}],Inset[Style[Row[{" ( ",NumberForm[(-1+(Sqrt[3])/8.) b c ,3]," , 0 )"}],12,Bold,Purple],
{(-1.+(Sqrt[3])/8.) b c +0.05 b c,-0.1 b c}],
Inset[Style[Row[{" ( ",NumberForm[( b c +b c/4.-b c /(8. (Sqrt[3])) ),3]," , ",NumberForm[b c/8.,3]," )"}],12,Bold,Purple],
{( b c +b c/4.-b c /(8. (Sqrt[3]))) +0.1 b c,b c/8.}],

Inset[Style[Row[{" ( ",NumberForm[((k+1.25) b c  -b c(Sqrt[3])/16.),3]," , ",NumberForm[(3.b c /16.),3]," )"}],12,Bold,Purple],
{(k+1.25 -(Sqrt[3])/16.) b c+0.5 b c,(3b c /16)+0.05 b c}],

Inset[Style[Row[{" ( ",NumberForm[((1. - (Sqrt[3])/16.)b c),3]," , ",NumberForm[3. b c/16.,3]," )"}],12,Bold,Red],
{((1. - (Sqrt[3])/16.)b c) -0.4 b c,(3 b c/16)+0.1 b c}],
Inset[Style[Row[{" ( ",NumberForm[((-1. + (Sqrt[3])/16.)b c),3]," , ",NumberForm[3. b c/16.,3]," )"}],12,Bold,Red],
{((-1. + (Sqrt[3])/16.)b c) -0.03 b c,(3. b c/16)+0.1b c}],
Inset[Style[Row[{" ( ",NumberForm[((Sqrt[3.]) b c/16.),3]," , ",NumberForm[((Sqrt[3.]) - 3./16.) b c,3]," )"}],12,Bold,Red],
{((Sqrt[3.]) b c/16.) +0.15 b c,((Sqrt[3.]) - 3./16.) b c-0.18 b c}],

Inset[Style[Row[{" ( ",NumberForm[(-(Sqrt[3]) b c/16.),3]," , ",NumberForm[((Sqrt[3.]) - 3./16.) b c,3]," )"}],12,Bold,Red],
{-0.6 b c,1.55 b c}],
(* Mid section *)
Inset[Style[Row[{" ( ",NumberForm[(k b c + b c /8+b c  /(8.(Sqrt[3]))),3]," , ",NumberForm[(9b c (Sqrt[3 ])/8.-b c/8),3]," )"}],12,Bold,Purple],
{(k b c +b c/4+b c /(8. (Sqrt[3]))) +0.35 b c,(9b c (Sqrt[3 ])/8.-b c/8.)-0.04 b c}],

Inset[Style[Row[{" ( ",NumberForm[(k b c + b c /8+b c  /(8.(Sqrt[3]))),3]," , ",NumberForm[(9b c (Sqrt[3 ])/8.+b c/8),3]," )"}],12,Bold,Purple],
{(k b c +b c/4+b c /(8. (Sqrt[3]))) +0.35 b c,(9b c (Sqrt[3 ])/8.-b c/8.)+0.3 b c}],
Inset[Style[Row[{" ( ",NumberForm[(b c/8.+b c/(8. (Sqrt[3]))),3]," , ",NumberForm[9. b c (Sqrt[3])/8.
-b c/8.,3]," )"}],12,Bold],
{(b c/8.+b c/(8. (Sqrt[3]))) -0.03 b c,(9. b c (Sqrt[3.])/8.
-b c/8.)-0.04 b c}],
Inset[Style[Row[{"( ",NumberForm[((b c)/24.)(3. +  (Sqrt[3.])),3]," , ",NumberForm[((b c)/8.)(9.  (Sqrt[3.]) + 1),3]," )"}],12,Bold],{((b c)/24)(3 +  (Sqrt[3]))+0.1 b c,((b c)/8)(9.  (Sqrt[3]) + 1)+0.1 b c}],

(* Bottom Section *)

Inset[Style[Row[{"( ",NumberForm[h b c + b c/8.-b c/(8.(Sqrt[3.])),3]," , ",NumberForm[-b c/8.+(8 h + 9) b c (Sqrt[3.])/8.,3]," )"}],12,Bold],{h b c + b c/8-b c/(8(Sqrt[3]))-0.5 b c,-b c/8+(8 h + 9) b c (Sqrt[3])/8-0.03 b c}],

Inset[Style[Row[{"( ",NumberForm[h b c + b c/8.+b  c (Sqrt[3])/12.,3]," , ",NumberForm[(8h +9) b c (Sqrt[3.])/8.,3]," )"}],12,Bold],{h b c + b c/8.+b  c (Sqrt[3])/12.-0.4 b c,(8 h + 9) b c (Sqrt[3])/8+0.1 b c}],
Inset[Style[Row[{"( ",NumberForm[h b c + k b c + b c/8.-b c(Sqrt[3])/16.,3]," , ",NumberForm[(8 h+9. )b c (Sqrt[3])/8.-3 b c /16.,3]," )"}],12,Bold],{h b c + k b c + b c/8.-b c(Sqrt[3])/16+0.1 b c,(8 h+9. )b c (Sqrt[3])/8.-3 b c /16}],

Inset[Style[Row[{"( ",NumberForm[h b c + k b c+ b c/8.-b c (Sqrt[3])/8.,3]," , ",NumberForm[h b c (Sqrt[3])+9. b c (Sqrt[3.])/8 ,3]," )"}],12,Bold],{h b c + k b c+ b c/8.-b c (Sqrt[3])/8.+0.3 b c,h b c (Sqrt[3])+9. b c (Sqrt[3.])/8. +0.2 b c}]

}],
Graphics[
{Inset[Style["\n\nFind the coordinates of the endpoints\n of the  line segments that will connect the arcs\n\n",17,Bold,Red],{1.1b c,- 1.2b c}]}]
];


cir:=
If[c==-1,{ccn[{k b c+1.25 b c-0.125 b c (Sqrt[3]) ,0.125 b c},b/8,{  π/2, 7π/6}],


ccn[{1.25 b c+ b c /(4(Sqrt[3])) ,0.25 b c},b/4,{  π/2,π/6}],
ccn[{(b /(2 (Sqrt[3]))+ b/8) c,1.125 (Sqrt[3]) b c},b/4,{ π/6,-π/6}],
ccn[{b c/(2 (Sqrt[3])) + k b c+b c/8 ,1.125 (Sqrt[3]) b c},b/4,{ π/6,-π/6}],
(*Most left part of parallelogram *)
ccn[{(h+k+0.125) b c-0.125 b c (Sqrt[3]) ,(h+1.125) (Sqrt[3]) b c-0.125 b c},b/8,{ 5 π/6,3π/2}],
ccn[{(h+0.125 )b c+b c /(4 (Sqrt[3])),( h+1.125) b c (Sqrt[3]) - 0.25 b c},b/4,{ 3 π/2,11 π/6}],
(* Circles on Corners of Triangles*)
ccn[{0.125 b c(Sqrt[3])- b c  ,0.125 b c},b/8,{ π/2, - π/6}],
ccn[{-0.125 b c(Sqrt[3])+ b c  ,0.125 b c},b/8,{ π/2,7   π/6}],
ccn[{0  , b c (Sqrt[3]) - b c/4},b/8,{ c  π/6,5 c π/6}]

},{ccn[{b /(2. (Sqrt[3]))+ b/8,1.125 (Sqrt[3]) b },b/4,{5 π/6,7π/6}],
ccn[{b /(2. (Sqrt[3])) + k b  +b /8 ,1.125 (Sqrt[3]) b },b/4,{ 5π/6,7π/6}],
ccn[{(h  + k+0.125 )b -0.125 b  (Sqrt[3]) ,(h+1.125 )(Sqrt[3]) b -0.125 b },b/8,{11π/6,5π/2}],
ccn[{k b +1.25 b c-0.125 b  (Sqrt[3]) ,0.125 b },b/8,{  3π/2, 13π/6}],
ccn[{1.25 b + b  /(4.(Sqrt[3])) ,0.25 b },b/4,{ 7 π/6,3π/2}],
ccn[{h b  +0.125 b +b  /(4. (Sqrt[3])),(h+ 1.125 )b  (Sqrt[3]) - 0.25 b },b/4,{  π/2,5 π/6}],
(* For Triangles *)

ccn[{0.125 b (Sqrt[3])- b   ,0.125 b },b/8,{5   π/6,3 π/2}],

ccn[{-0.125 b (Sqrt[3])+ b   ,0.125 b },b/8,{ 3 π/2, 13 π/6}],ccn[{0  , b  (Sqrt[3]) - b /4},b/8,{  π/6,5  π/6}]}];


cnr:=If[cntr,{Graphics[{
(*Top Left center *)
Inset[Style[Row[{"( ",NumberForm[( k +1.25) b c-0.125 b c (Sqrt[3]) ,3],", ",NumberForm[0.125 (Sqrt[3]) b c,3]," )"}],12,Bold,Purple],{( k +1.4) b c-0.125 b c (Sqrt[3]),0.125 (Sqrt[3]) b c}],

(*Top second left (next) *)

Inset[Style[Row[{"( ",NumberForm[1.25 b c+ b c /(4.(Sqrt[3.])) ,3],", ",NumberForm[0.25 b c,3]," )"}],12,Bold,Purple],{1.25 b c+ b c /(4(Sqrt[3])),0.25 b c+0.12 b c}],

(* Middle left *)
Inset[Style[Row[{"( ",NumberForm[b c/(2. (Sqrt[3])) +k b c + b c/8.,3],", ",NumberForm[1.125 (Sqrt[3]) b c,3]," )"}],12,Bold,Purple],{(b /(2 (Sqrt[3]))+k b + b/8) c,1.125 (Sqrt[3]) b c-0.1 b c}],

(* Middle right *)
Inset[Style[Row[{"( ",NumberForm[(b /(2. (Sqrt[3.]))+ b/8.) c,3],", ",NumberForm[1.125 (Sqrt[3]) b c,3]," )"}],12,Bold,Purple],{(b /(2 (Sqrt[3]))+b/8) c,1.125 (Sqrt[3]) b c+0.1 b c}],
(*center at bottom left and bottom right *)
Inset[Style[Row[{"( ",NumberForm[k b c +h b c +0.125 b c-0.125 b c (Sqrt[3]),3],", ",NumberForm[h b c (Sqrt[3])+1.125 (Sqrt[3]) b c-0.125 b c,3]," )"}],12,Bold,Purple],{k b c +0.125 b c+ h b c -0.125 b c (Sqrt[3]),h b c (Sqrt[3])+1.125 (Sqrt[3]) b c+0.125 b c}],
Inset[Style[Row[{"( ",NumberForm[0.125 b c+h b c +b c /(4. (Sqrt[3.])),3],", ",NumberForm[h b c (Sqrt[3])+1.125 b c (Sqrt[3]) - 0.25 b c,3]," )"}],12,Bold,Purple],{0.125 b c+h b c +b c /(4 (Sqrt[3]))-0.2 b c,h b c (Sqrt[3])+1.125 b c (Sqrt[3]) - 0.25 b c-0.1 b c}],
(* Centers of circles in a triangle *)
Inset[Style[Row[{"( ",NumberForm[-0.125 b  c(Sqrt[3.])+ b  c,3],", ",NumberForm[0.125 b c,3]," )"}],12,Bold,Purple],{0.25 b (Sqrt[3])- b  ,0.125 b c+0.1 b c}],

Inset[Style[Row[{"( ",NumberForm[-0.125 b (Sqrt[3.])+ b   ,3],", ",NumberForm[0.125 b c,3]," )"}],12,Bold,Purple],{-0.125 b (Sqrt[3])+ b  ,0.125 b c+0.1 b c}],
Inset[Style[Row[{"( 0 ",", ",NumberForm[b c (Sqrt[3.]) - b c/4.,3]," )"}],12,Bold,Purple],{0.001b ,b c (Sqrt[3]) - b c/4-0.2 b c}]
}]},{Graphics[{Inset[Style["\n\nFind coordinates of arc centers\n\n",17,Bold,Red],{1.1 b c, -1.2 b c}]}]
}];


(* Graphing the triangle *)
gp:=Graphics[{RGBColor[1,0,0.3],Opacity[0.8],
Polygon[{{(1-(Sqrt[3])/8) b c,0},{(-1+(Sqrt[3])/8) b c,0},{(-1+(Sqrt[3])/16) b c,3 b c / 16},
{-b c (Sqrt[3])/16,((Sqrt[3])-3/16
) b c},{(Sqrt[3]) b c/16,((Sqrt[3]) - 3/16) b c},{(1 - (Sqrt[3])/16)b c, 3 b c/16}}],
Disk[{-b c+(Sqrt[3]) b c/8,b c/8},b /8,{-c π/2,c π/6}],
Disk[{b c-(Sqrt[3]) b c/8,b c/8},b /8,{ π/2,7 π/6}],
Disk[{0,b c (Sqrt[3])-b c/4},b /8,{c π/6,5 c π/6}],
If[c==1,{RGBColor[1,0,0.3],Opacity[0.8],Disk[{-b +(Sqrt[3]) b /8,b c/8},b /8,{ 5 π/6,3 π/2}],
Disk[{b -(Sqrt[3]) b /8,b c/8},b /8,{ 3 π/2,13π/6}],
Disk[{0,b c (Sqrt[3])-b c/4},b /8.,{c π/6,5 c π/6}]},{}]
},Axes->True,AxesOrigin->{0,0}];


rect:=Graphics[{{RGBColor[0.6,0,1],Opacity[0.8],
Polygon[{{(1.25 b) c,0},{(k+1.25 )b c,0},{(k+0.125) b c,(((9 b )/8)) c (Sqrt[3])},{0.125 b c,(1.125 b)c (Sqrt[3])}}],

Polygon[{{(k+0.125 )b c,(1.125 b) c (Sqrt[3])},{0.125 b c,(1.125 b)c (Sqrt[3])},

{ h b c +0.125b c,(h b+(((9b )/8)) )c (Sqrt[3])},{k b c+ h b c +b c/8,(h + 9  /8) b c(Sqrt[3])}}],
Polygon[{{b c/16+(k+.125) b c,1.125 b c (Sqrt[3])-b c/8},{(k+.125) b c, 1.125 (Sqrt[3 ])b c},{b c/16+(k+0.125) b c,1.125 b c (Sqrt[3])+b c /8}}]
},

{GrayLevel[1],

(* Top polygons *)Polygon[{{(k+1.25 )b c,0},{(k+1.25 )b c- b c (Sqrt[3]) /8,0},{(k+1.25 ) b c- b c (Sqrt[3]) /8,b c/8},{(k+1.25 ) b c  + b  (Sqrt[3]) /8+b c(Sqrt[3])/16,b c/8 + b c/16}}],
Polygon[{{1.25 b c + b c/(4 (Sqrt[3]))- b c (Sqrt[3])/8 ,b c/8},{1.25 b c ,0},
{1.25 b c+ b c / (4 (Sqrt[3])), 0}}],

(*Middle right *)
Polygon[{{b c/10+b c /(8 (Sqrt[3])),1.125 b c (Sqrt[3])-b c/16},{b c/8, 1.125 (Sqrt[3 ])b c},{b c/10+b c/(8 (Sqrt[3])),1.125 b c (Sqrt[3])+b c /16}}],

(* Polygon bottom left *)
Polygon[{{(k + h +0.125 ) b c ,(h + 1.125) b c (Sqrt[3])},{(k+h+0.125-((Sqrt[3])/8))b c,(h+1.125) b c (Sqrt[3])},{(k + h +0.125 - ((Sqrt[3])/8)) b c, (h + 1.125) b c (Sqrt[3]) - ((b c )/8)},{(k + h +0.125) b c -((Sqrt[3])/16) b c ,(h + 1.125) b c (Sqrt[3]) -((3 b c)/16)}}],


(*Polygon bottom right *)Polygon[{{(h +0.125) b c + ((b c (Sqrt[3]))/12), (h +1.125 ) b c (Sqrt[3]) -b c/4},
{(h +0.125) b c + ((b c (Sqrt[3]))/12), (h + 1.125 ) b c (Sqrt[3])},{(h+0.125)b c, (h+1.125) b c (Sqrt[3])},{(h+0.125 )b c - ((b c (Sqrt[3]))/24),(h +1.125 ) b c (Sqrt[3])- b c/8}}]

},

{
If[c==-1,{(*GrayLevel[1],Disk[{b c/(2 (Sqrt[3])) + 9b c/8 ,1.125 (Sqrt[3]) b c},b/4,{ π/6,-π/6}]*)RGBColor[0.6,0,1],Opacity[0.8],
(*Top left *)
Disk[{k b c +1.25 b c-0.125 b c (Sqrt[3]) ,0.125 b c},b/8,{  π/2, 7π/6}],
(* Top right *)
Disk[{1.25 b c+ b c /(4(Sqrt[3])) ,0.25 b c},b/4,{  π/2,π/6}],
(*Middle right*)
Disk[{(b /(2 (Sqrt[3]))+ b/8) c,1.125 (Sqrt[3]) b c},b/4,{ π/6,-π/6}],
(*Bottom Left *)
Disk[{k b c +h b c +0.125 b c-0.125 b c (Sqrt[3]) ,(h  +1.125 )(Sqrt[3]) b c-0.125 b c},b/8,{ 5 π/6,3π/2}],
(*Bottom Right *)

Disk[{h b c +0.125 b c+b c /(4 (Sqrt[3])),(h+ 1.125 )b c (Sqrt[3]) - 0.25 b c},b/4,{ 3 π/2,11 π/6}]


},{(*Middle right *)
GrayLevel[1],
Disk[{b c/(2 (Sqrt[3])) +k b c + b c/8 ,1.125 (Sqrt[3]) b c},b/4,{ 5π/6,7π/6}],
(*Top right *)
RGBColor[0.6,0,1],Opacity[0.8],
Disk[{k b c+h b c+0.125 b c-0.125 b c (Sqrt[3]) ,(h+1.125 )(Sqrt[3]) b c-0.125 b c},b/8,{11π/6,5π/2}],
(*Top left *)
Disk[{(h+0.125) b c+b c /(4 (Sqrt[3])),(h+ 1.125 )b c (Sqrt[3]) - 0.25 b c},b/4,{  π/2,5 π/6}],
(*Middle Left *)
Disk[{(b /(2 (Sqrt[3]))+ b/8) c,1.125 (Sqrt[3]) b c},b/4,{5 π/6,7π/6}],
(*Bottom Right *)
Disk[{k b c +1.25 b c-0.125 b c (Sqrt[3]) ,0.125 b c},b/8,{  3π/2, 13π/6}],
(*Bottom Left *)
Disk[{1.25 b c+ b c /(4(Sqrt[3])) ,0.25 b c},b/4,{ 7 π/6,3π/2}]
}]}

}];

Switch[steps,
1,Show[line1,verticescoord,darrows,ImageSize->{450,450},Axes->ax,PlotRange->{{(k+2.75)b c , -1.5 b c},{(1.5 + h ) b c(Sqrt[3]),-1.5 b c}}],
2,Show[line1,darrows,line2,segmentcoord,PlotRange->{{(k+2.75)b c , -1.5 b c},{(1.5 + h ) b c(Sqrt[3]),-1.5 b c}},ImageSize->{450,450},Axes->ax],
3,Show[line1,line2,darrows,cir,cnr,PlotRange->{{(k+2.75)b c , -1.5 b c},{(1.5 + h ) b c(Sqrt[3]),-1.5 b c}},ImageSize->{450,450},Axes->ax],
4,Show[an,line1,line2,darrows,gp,rect,cir,PlotRange->{{(k+2.75)b c , -1.5 b c},{(1.5 + h ) b c(Sqrt[3]),-1.5 b c}},ImageSize->{450,450},Axes->ax]
]],
{{steps,1,"step"},{1,2,3,4},ControlType->RadioButton},
Delimiter,
{{ax,False,"axes"},{False,True}},
{{coord1,False,"coord1"},{False,True},Enabled->steps==1},
{{coord2,False,"coord2"},{False,True},Enabled->steps==2},
{{cntr,False,"center"},{False,True},Enabled->steps==3},
{{Answer,False,"answer"},{False,True},Enabled->steps==4},
{{c,-1,Style["up/down",13,Background->Yellow]},{-1,1}},
Delimiter,
"half length of side of outer Δ (b)",
{{b,4,""},1,8,.1,Appearance->"Labeled", ImageSize-> Tiny},
"coefficient of thickness (k)",
{{k,1,""},1,1.5,.1,Appearance->"Labeled", ImageSize-> Tiny},
"height of lower part (h)",
{{h,1.5,""},1.2,1.8,.1, ControlType->VerticalSlider,Appearance->"Labeled",ImageSize-> Tiny},

TrackedSymbols->{coord1,coord2,cntr,Answer,c,b,k,h,steps,ax},
ControlPlacement->Left,SaveDefinitions->True,

Initialization:>{
ccn[center_,radius_,angle_]:=Graphics[{Thick,Circle[center,radius,angle],PointSize[0.01],Point[center]}]

}]

-

Design your swimming pool

DynamicModule[{l1,l2,l3,w,h,startingdepth,deepdepth,deepestdepth,Answer},Manipulate[

Module[{v3zero, m1, m2, m3, v3, v2, v1, galons,v},
If[deepestdepth<deepdepth,deepestdepth=deepdepth];
v3zero=l3 w h;
If[l2==0&&l3==0&&h>shallowdepth,h=shallowdepth,h];

If[l2>0&&l3==0&&h>deepdepth,h=deepdepth,h];

If[deepdepth==deepestdepth,h==Min[deepdepth,h],h==Min[deepestdepth,h]];
If[deepestdepth<h,h=deepestdepth,h];
If[shallowdepth>deepdepth,deepdepth=shallowdepth];
If[shallowdepth>deepestdepth,deepestdepth=shallowdepth];
m1=(shallowdepth - startingdepth)/l1;

m2=If[l2>0&&deepdepth==shallowdepth,0,If[l2>0,(deepdepth-shallowdepth )/l2,0]];m2=If[l2==0||deepdepth==shallowdepth,0,If[l2>0,(deepdepth-shallowdepth )/l2,0]];

m3=If[l3==0,0,(deepestdepth-deepdepth)/l3];
v3=If[l3==0,0,Which[m3==0,l3 w h,m3>0&&h<m3 l3,((h^2 w)/(2m3)),m3>0&&h>m3 l3,((w l3)/2)(2 h -m3 l3 ),True,v3zero/2]];
v2=If[l2==0,0,Which[m2==0&&l2>0,w l2 (h-m3 l3),
m2==0&&m3>0&&h>m3 l3,l2 w (h-m3 l3), 
m2>0&&h≤(m2 l2+m3 l3),(((h- m3 l3 )^2 w)/(2m2)),m2>0&&(m2 l2 + m3 l3)<h<(m1 l1+m2 l2+m3 l3),w l2 (2 h - m3 l3 - m2 l2 )/2,
m2>0&&h>(m1 l1+m2 l2+m3 l3),((w l2)/2)(2 (h- m3 l3 ) -m2 l2 )]];
v1=If[m1==0&&h≥(m2 l2 + m3 l3),w l1 (h- m2 l2 - m3 l3),0];v1=Which[m1>0&&m2 l2+m3 l3<h≤(m1 l1+m2 l2+m3 l3),(((h-m2 l2 - m3 l3)^2 w)/(2m1)),m1≥0&&h≤m1 l1 +l2 m2 +m3 l3,0,True,w l1( h -m2 l2-m3 l3 - 0.5 m1 l1)];
v=N[v1+v2+v3,4];
galons=7.48051945 v;

Column[{
Item[
If[Answer,Text@Style[Row[{Style["Volume of water = ",Italic],galons,Style[" Gallons\n",Italic]}],14,Purple],Text@Style[Row[{Style["How many gallons of water are in the pool \n when the water height at deepest end = ",Italic],h,Style["  feet"] }],14]],Alignment->{Center},Frame->True],

Item[
With[{a0=If[l3==0,{l1+l2,0,m1 l1+m2 l2},{l1+l2+l3,0,m1 l1+m2 l2+m3 l3}],b0=If[l3==0,{l1+l2,w,m1 l1+m2 l2},{l1+l2+l3,w,m1 l1+m2 l2+m3 l3}],c0=If[l3==0,{l1+l2,w,deepdepth},{l1+l2+l3,w,deepestdepth}],d0=If[l3==0,{l1+l2,0,deepdepth},{l1+l2+l3,0,deepestdepth}],

a1=If[l3==0,{l2,0,m2 l2},{l2+l3,0,m2 l2+m3 l3}],
b1=If[l3==0,{l2,w,m2 l2},{l2+l3,w,m2 l2+m3 l3}],c1=If[l3==0,{l2,w,deepdepth},{l2+l3,w,deepestdepth}],
d1=If[l3==0,{l2,0,deepdepth},{l2+l3,0,deepestdepth}],

a2=If[l3==0,{0,0,0},{l3,0,m3 l3}],
b2=If[l3==0,{0,w,0},{l3,w,m3 l3}],
c2=If[l3==0,{0,w,deepdepth},{l3,w,deepestdepth}],
d2=If[l3==0,{0,0,deepdepth},{l3,0,deepestdepth}],

a3={0,0,0},
b3={0,w,0},
c3=If[l3==0,{0,w,deepdepth},{0,w,deepestdepth}],
d3=If[l3==0,{0,0,deepdepth},{0,0,deepestdepth}],

a11={l2+l3+If[m1>0,(h-m2 l2 - m3 l3 )/m1,l1],0,h},
b11={l2+l3+If[m1>0,(h-m2 l2 - m3 l3 )/m1,l1],w,h},
c11=If[l3==0,{l2+If[m1>0,(h-m2 l2 )/m1,l1],w,h},{l2+l3+If[m1>0,(h-m2 l2 - m3 l3)/m1,l1],w,h}],
d11=If[l3==0,{l2+If[m1>0,(h-m2 l2 )/m1,l1],0,h},{l2+l3+If[m1>0,(h-m2 l2 - m3 l3)/m1,l1],0,h}],

a21=If[l3==0,{0+If[m2>0,(h)/m2,l2],0,h},{l3+If[m2>0&&m3>0,(h-m3 l3)/m2,If[m2>0,h/m2,l2]],0,h}],
b21=If[l3==0,{0+If[m2>0,(h)/m2,l2],w,h},{l3+If[m2>0&&m3>0,(h-m3 l3)/m2,If[m2>0,h/m2,l2]],w,h}],
c21={0,w,h},
d21={0,0,h},

a2e=If[l3==0,{l2+l1,0,h},{l2+l3+l1,0,h}],
b2e=If[l3==0,{l2+l1,w,h},{l2+l3+l1,w,h}],

b31=If[m3>0,{h/m3,w,h},{l3,w,h}],
d31=If[m3>0,{h/m3,0,h},{l3,0,h}]},

Graphics3D[{{EdgeForm[Black],FaceForm[Cyan],Opacity[0.9],

If[h>(m1 l1 +m2 l2 + m3 l3),Polygon[{d21,c21,b2e,a2e}],
If[m1 l1 +m2 l2 + m3 l3≥h>l2 m2 +l3 m3 ,Polygon[{d21,c21,b11,a11}]]],
If[m2 l2 +m3 l3 ≥h> m3 l3,Polygon[{d21,c21,b21,a21}]],
If[h≤m3 l3 ,Polygon[{d21,c21,b31,d31}]]},
{Orange,Polygon[{a3,a2,d2,d3}],Polygon[{a2,d2,d1,a1}],Polygon[{a1,d1,d0,a0}]},{GrayLevel[0.8],Polygon[{a0,d0,c0,b0}],Polygon[{a3,d3,c3,b3}],Polygon[{b3,a3,a2,b2}],Polygon[{b2,a2,a1,b1}],Polygon[{c0,b0,b1,c1}],Polygon[{c1,b1,b2,c2}],Polygon[{c2,b2,b3,c3}],Polygon[{a1,b1,b0,a0}]},
Inset[Text@Style[Row[{"\nCurrent\n water level = ",h," feet "}],16,Purple  ],{3,w+14,deepestdepth+3}],
Inset[Text@Style[Row[{"Width = \n",w," ft "}],16,Purple  ],{l1+l2+l3+9, w+1,startingdepth/2}],
Inset[Text@Style[Row[{N[startingdepth,2]," \nfeet "}],14,Black   ],{l1+l2+l3,0,-startingdepth}],
Inset[Text@Style[Row[{N[shallowdepth,2]," \nfeet "}],14,Black   ],{l3+l2,0,-shallowdepth}],
If[l3==0&&l2==0,Inset[""]],
If[l3==0&&l2>0,Inset[Text@Style[Row[{deepdepth,"\n feet "}],14,Black   ],{0,0,-deepdepth-9}]],

If[l2==0&&l3>0,Inset[Text@Style[Row[{deepestdepth,"\n feet "}],14,Black   ],{0,0,-deepestdepth}]],
If[l2>0&&l3>0,{Inset[Text@Style[Row[{NumberForm[deepestdepth,{3,2}],"\n feet"}],14,Black],{0,0, -deepestdepth  } ],Inset[Text@Style[Row[{deepdepth,"\n feet "}],14,Black   ],{l3,0,-deepdepth-12}]},Inset[""]]
},Boxed->False,SphericalRegion->True,Axes->False,AxesOrigin->{0,0},PlotRange->All, ImageSize-> {420,400}]],Frame->True,Alignment->{Center}]

}]],
"width in feet",
{{w,24,""},10,72,0.5,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["shallow section",Bold],
"starting depth",
{{startingdepth,4, ""},1.,8,0.1,Appearance->"Labeled",ImageSize->Tiny},
"length in feet",
{{l1,25,""},10,50,0.5,Appearance->"Labeled",ImageSize->Tiny},
"depth at transition",
{{shallowdepth,12,""},3,12,0.5,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["transition section",Bold],
"length in feet",
{{l2,0,""},0,30,0.5,Appearance->"Labeled",ImageSize->Tiny},
Delimiter,
Style["deep section",Bold],
"depth at transition",
{{deepdepth,12,""},6,20,0.5,Appearance->"Labeled",ImageSize->Tiny,Enabled->l2>0},
"length in feet",
{{l3,25,""},0,50,0.5,Appearance->"Labeled",ImageSize->Tiny},
"ending depth",
{{deepestdepth,20,""},6,20,0.5,Appearance->"Labeled",ImageSize->Tiny,Enabled->l3>0},
Delimiter,
Style["water level at deep end"],
{{h,8,""},1.,If[l3==0,Dynamic[deepdepth],Dynamic[deepestdepth]],0.01,Appearance->"Labeled",ImageSize->Tiny},
Style["answer",Bold],
{{Answer,False,""},{False,True}},

ControlPlacement->Left,
TrackedSymbols->{l1,l2,l3,w,startingdepth,shallowdepth,deepdepth,deepestdepth,h,Answer}]]

Given a Point F (u, v), and a line a x + b y + c = 0.
Construct at least 3 points that are at equal distances from the given point “F” and the line.

ClearAll["Global`*"];

DynamicModule[{a,b,c,d,u,v,x1,y1,hint,Answer,point,focus},Manipulate[



x1=point[[1]];y1=point[[2]];u=focus[[1]];v=focus[[2]];
xint[x_,y_]:=(b^2  x - a b y - a c)/(a^2 + b^2);
yint[x_,y_]:= ( b xint[x,y] + a y - b x)/a;
distPointPoint[x_,y_]:=FullSimplify[EuclideanDistance[{x,y},{u,v}]];
distPtLine[x_,y_]:=Chop[FullSimplify[((Abs[a x+ b y +c])/(Sqrt[(a^2)+b^2]))]];
sol1=Quiet[FindRoot[{(a^2+b^2)((x-u)^2 + (y-v)^2)-(a u + b v + c )^2 ==0, (a x + b y - a u - b v)==0},{{x,-3.},{y,3}}]];
xc1=sol1[[1,2]];
yc1=sol1[[2,2]];
sol2=Quiet[FindRoot[{(a^2+b^2)((x-u)^2 + (y-v)^2)-(a u + b v + c )^2 ==0, (a x + b y - a u - b v)==0},{{x,5.},{y,3}}]];
xc2=sol2[[1,2]];
yc2=sol2[[2,2]];
ycord=Quiet[FindRoot[(a x1 + b y + c)^2 == (a^2 + b^2 ) ((x1-u)^2+ (y-v)^2),{y,-5.}]];
(* yp is the y coordinate of the point on the parabola; {x1,yp} is on the parabola *)
yp=ycord[[1,2]];
Column[{
Item[
If[Answer,Style[Row[{Style["The locus of points that are at equal distances from the focus  F and the line (directrix) is a parabola; Its equations is: \n",15,Italic],Style[TraditionalForm[
b^2 x^2-2 a b x y +a^2 y^2 -2 (a c + (a^2 + b^2 ) u) x - 2 (b c + (a^2 + b^2 ) v ) y - c^2 + (a^2 + b^2) (u^2 + v^2)==0]
,15,Italic,Bold],"\n"}],Black],Style[Row[{"\nGiven a line ",TraditionalForm[a x + b y + c ==0]," and a point F ", TraditionalForm[{u,v}],"\nConstruct at least 3 points that are at equal distances from the given point F  and the line.\n"}],14,Italic,Black] ],Frame->True,Alignment->Left],
Item[

parabola=ContourPlot[b^2 x^2-2 a b x y +a^2 y^2 -2 (a c + (a^2 + b^2 ) u) x - 2 (b c + (a^2 + b^2 ) v ) y - c^2 + (a^2 + b^2) (u^2 + v^2)==0,
{x,-12,12},{y,-12,20},AxesOrigin->{0,0},GridLines->Automatic,AspectRatio->Automatic,GridLinesStyle->GrayLevel[0.85],ContourStyle->{Dotted,Thick,Red},Axes->True,PlotRange->{{-12,12},{-12,18}}];

line=If[b≠0,Plot[-a/b x-c/b,{x,-12,12},PlotStyle->{{Thick,Black},{Thick,Blue}},
AspectRatio->Automatic,GridLinesStyle->GrayLevel[0.85],GridLines->{Range[-12,12],Range[-12,15]},Ticks->{Range[-12,12],Range[-10,10]},PlotRange->{{-12,12},{-12,16}},AxesOrigin->{0,0}]];
cntrLine=Plot[b(x-u)/a+ v,{x,-12,12},PlotStyle->Directive[Dashing[{0.001,0.02,0.11,0.02}],Red,Thickness[0.003]]];
parallelLine=Plot[(-a/b)(x - u) + v,{x,-12,12},PlotStyle->{Thin,Black},AspectRatio->Automatic];


grcircle=Graphics[{Circle[{u,v},distPtLine[u,v]]}];

grPoint=Graphics[{
{PointSize[0.02],Purple,Point[{u,v}]},
If[Answer,{PointSize[0.025],Green,Point[{x1,yp}],Point[{xc1,yc1}],Point[{xc2,yc2}],
Text[Style[NumberForm[TraditionalForm[{x1,yp}],{5,2}],12,Blue],{x1,yp+0.6}],
Point[{(u+xint[u,v])/2,(v+yint[u,v])/2}],
Text[Style[TraditionalForm[{(u+xint[u,v])/2,(v+yint[u,v])/2}],14,Purple],{(u+xint[u,v])/2,(v+yint[u,v])/2-1}],
Text[Style[NumberForm[TraditionalForm[{xint[x1,yp],yint[x1,yp]}],{5,2}],12,Blue],{xint[x1,yp],yint[x1,yp]-0.7}],
Text[Style["F ",18,Purple],{u, v-0.95}],
Text[Style["P ",18,Blue],{x1, yp-1.5}],
Text[Style["(Subscript[D, l]) ",18,Blue],{xint[x1,yp], yint[x1,yp]-1.5}],

{PointSize[0.02],Red,Point[{xint[x1,yp],yint[x1,yp]}]},{Purple,Arrow[{{u,v},{x1,yp}}]},{Blue,Arrow[{{x1,yp},{xint[x1,yp],yint[x1,yp]}}]},
{PointSize[0.02],Purple,Point[{u,v}]},
Text[Style[TraditionalForm[{u,v}],12,Purple],{u,v+0.6}],

Text[Style["(Subscript[d, 1]) ",15,Black],{(u+x1)/2,(v+yp)/2+0.3}],
Text[Style["(Subscript[d, 2]) ",15,Black],{(x1+xint[x1,yp])/2,(yp+yint[x1,yp])/2+0.3}],

Text[Style[Row[{" (Subscript[d, 1]) = ",NumberForm[distPointPoint[x1,yp],{5,2}] }],16,Purple],{-5,13}],

Text[Style[Row[{"(Subscript[d, 2]) = ",NumberForm[distPtLine[x1,yp],{5,2}] }],16,Blue],
{4,14}],

Text[Style[NumberForm[TraditionalForm[a x + b y +c==0],{5,2}],16,Bold,Black],{xint[x1,yp]-2.5, yint[x1,yp]-2.5}]

},{{PointSize[0.02],Red,Point[{x1,y1}]}
,
Text[Style[NumberForm[TraditionalForm[{x1,y1}],{5,2}],12,Blue],{x1,y1+0.6}],
Text[Style["F ",18,Purple],{u, v-0.95}],
Text[Style["P ",18,Blue],{x1, y1+1.2}],
Text[Style["D ",18,Blue],{xint[x1,y1], yint[x1,y1]-1.5}],
Text[Style[TraditionalForm[{u,v}],12,Purple],{u,v+0.6}],
Text[Style[TraditionalForm[{xint[x1,y1],yint[x1,y1]}],12,Blue],{xint[x1,y1],yint[x1,y1]-0.7}],
Text[Style[TraditionalForm[a x + b y + c==0],16,Bold,Black],{xint[x1,y1]-2, yint[x1,y1]-2.5}],
Text[Style["(Subscript[d, 1]) ",15,Black],{(u+x1)/2,(v+y1)/2+0.3}],
Text[Style["(Subscript[d, 2]) ",15,Black],{(x1+xint[x1,y1])/2,(y1+yint[x1,y1])/2+0.3}],

Text[Style[Row[{" (Subscript[d, 1]) = ",NumberForm[distPointPoint[x1,y1],{5,2}]}],16,Purple],{-5,13}],

Text[Style[Row[{"(Subscript[d, 2]) = ",NumberForm[distPtLine[x1,y1],{5,2}] }],16,Blue],
{3,15}],

{PointSize[0.02],Red,Point[{xint[x1,y1],yint[x1,y1]}]},{PointSize[0.02],Blue,Point[{x1,y1}]},{Purple,Arrow[{{u,v},{x1,y1}}]},{Blue,Arrow[{{x1,y1},{xint[x1,y1],yint[x1,y1]}}]}

}]

}];
Which[Answer,Show[line,grcircle,grPoint,parallelLine,parabola,cntrLine,
(*parabola,parallelLine,line,grcircle,grPoint,cntrLine,*)ImageSize->{450,450}],hint,Show[line,grcircle,grPoint,parallelLine,ImageSize->{450,450}],
True,Show[line,grPoint,ImageSize->{450,450}]],
Alignment->{Center},Frame->True]
}],
{{point,{2,3},{"P "}},{-10.,-10.},{10.,10.},{0.01,0.01},Appearance->None,ControlType->Locator},
{{focus,{-3,6},{"focus "}},{-10.,-10.},{10.,10.},{0.01,0.01},Appearance->None,ControlType->Locator},
Grid[{
{Control[
{{a,2,"a"},-5,5,0.01,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{b,-4,"b"},-10,7,0.01,Appearance->"Labeled",ImageSize->Tiny}],Control[{{c,-4,"c"},-5,5,0.01,Appearance->"Labeled",ImageSize->Tiny}],

Control[{{Answer,False,"Answer"},{False,True}}]},{Control[{{hint,False,"hint"},{False,True}}]}

}],
TrackedSymbols->{a,b,u,v,c,d,x1,y1,point,focus,hint,Answer},SaveDefinitions->True]]

Locus of centers of circles that are tangent to a given circle and a given vertical line.

Find the locus of the centers of all tangent circle that are tangent to a given vertical line and a given circle.

ClearAll["Global`*"];

Manipulate[cir[cntr_,rad_]:={Circle[cntr,rad],PointSize[0.02],Point[{cntr}]};

Column[{
Item[
Which[answer&&a>0,Style[Row[{"Equation of the locus of centers\n of circles is  (y^2) = ",

TraditionalForm[ -2 (R+a)(x-(R+ a)/2)],"\n"}],14,Purple],
answer&&a≤0,Style[Row[{"Equation of the locus of centers\n of circles is  (y^2) = ",

TraditionalForm[ 2 (R-a)(x+(R+ a)/2)],"\n"}],14,Purple],
True,
Style["Write the Equation of the locus of centers \nof family of tangent circles that are tangent\n to a given circle and a vertical line\n",12,Black,Italic]],Alignment->Left,Frame->True,ItemSize->{24,3}],

Item[prm = ParametricPlot[{a,t},{t,-10,10},PlotStyle->{Thick,Blue}];
gc=Graphics[{{Thick,Red,cir[{0,0},R]},Black,

If[a==0,{Table[cir[{0,R+r},r],{r,0.5,3,0.15}],
Table[cir[{0,-(R+r)},r],{r,0.5,3,0.15}]}],

If[a>0,{Table[cir[{x,(Sqrt[Abs[(R+a - 2 x) (R+a)]])},Abs[a-x]],{x,0,(a+R)/2.,0.15}],cir[{(a+R)/2,0},Abs[(a-R)/2]],Table[cir[{x,-(Sqrt[Abs[(R+a - 2 x) (R+a)]])},Abs[a-x]],{x,0,(a+R)/2.,0.15}]},

{Table[cir[{-x,(Sqrt[Abs[(R-a - 2 x) (R-a)]])},Abs[-a-x]],{x,0,Abs[(-a+R)]/2.,0.15}],cir[{(a-R)/2,0},Abs[(a+R)/2]],Table[cir[{-x,-(Sqrt[Abs[(R-a - 2 x) (R-a)]])},Abs[-a-x]],{x,0,Abs[(-a+R)]/2.,0.15}]}],
Text[Style[TraditionalForm[x^2+y^2==R^2],12,Red],{0,0.5}],
Text[Style[Row[{" x = ", a}],14,Blue],{a,12}],Which[answer&&a>0,Text[Style[Row[{" \!\(\*SuperscriptBox[\(y\), \(\(2\)\(\\ \)\)]\) = ",TraditionalForm[ - 2 (R+a)(x-(R+ a)/2)]}],12,Purple],{3,10}],answer&&a≤0,Text[Style[Row[{" \!\(\*SuperscriptBox[\(y\), \(\(2\)\(\\ \)\)]\) = ",TraditionalForm[ 2 (R-a)(x+ (R- a)/2)]}],12,Purple],{3,10}]]
},

Axes->True,AxesOrigin->{0,0},PlotRange->{{-7,11},{-15,15}}];
locus=If[a>0,Plot[{(Sqrt[Abs[(R+a - 2 x) (R+a)]]), -(Sqrt[Abs[(R+a - 2 x) (R+a)]])},{x,-R-a,(a + R)/2},PlotStyle->{{Thick,Purple}}],Plot[{(Sqrt[Abs[( 2 x+R-a ) (R-a)]]), -(Sqrt[Abs[(R-a + 2 x) (R-a)]])},{x,(-a+R)/2.,-(-a+R)/2.},PlotStyle->{{Thick,Purple}}]];
Show[gc,locus,prm,ImageSize->Medium,PlotRange->All],Alignment->{Center},Frame->True,ItemSize->{24,3}]
}],
Grid[{{Control[
{{R, 2,"Radius of the \ngiven circle"},2,5,Appearance->"Labeled",ImageSize->Tiny}],Control[{{a,3,"Tangent Line"},-6,6,Appearance->"Labeled",ImageSize->Tiny}]},{Control[{{answer,False,"answer"},{False,True}}]}}],TrackedSymbols->{R,a,answer},SaveDefinitions->True]

Equations of Ellipse as an inside locus and a hyperbola as an ouside locus of the centers 1/12 /14

ClearAll["Global`*"];

cir[center_,radius_]:={Circle[center,radius],PointSize[0.015],Point[center]};
disk[center_,radius_]:={EdgeForm[Thick],Disk[center,radius],PointSize[0.015],Point[center]};
disk1[center_,radius_]:={Disk[center,radius],PointSize[0.009],Point[center]};
disk2[center_,radius_,index_]:=Join[{colorByIndex@index,{Disk[center,radius],Orange},PointSize[0.009],Point[center]}];
Quiet[1/0];

DynamicModule[{a,b,m,n,R,r,t,color,color1,clr},Manipulate[

d:=R+r+t;
c:=d/2;
(* If both circles have equal radii i.e R = r and they are separated, the locus of the center of the tangent circles is a verticalline *)
xheq:=R+d/2;
colorByIndex[i_]:=ColorData[clr]@First@i;
(*colorByIndex[i_]:=ColorData[clr]@First@i;*)
(* If R ≠ r ; The disk and the circle have two different radii, the locus of the centers of the external tangent circles lie on a hyperbola with its foci are the centers of the disk and the original circle *)
a:=(R-r)/2.;
b:=Sqrt[Abs[c^2-a^2]];
If[b≠0,xh:=R +d/2+a (Sqrt[ k^2+b^2])/b];

(* h is the radius of the external tangent circle which is the same as radiusextr*)
h=Abs[Sqrt[k^2 +(xh-(R+d))^2]-r];
radiusextr:=Abs[Sqrt[Abs[(xh-R)^2+k^2]]-R];
(*Plot the hyperbola *)
If[R==r,Quiet[1/0]];
pcntr=If[R>r&&R≠r&&a≠0&&b≠0,ContourPlot[{ b^2(x-xheq)^2- a^2 y^2 ==a^2 b^2},{x,xheq,6},{y,-3,3},ContourStyle->{Thick,Dashing[0.01],Red},AspectRatio->Automatic],
ContourPlot[{b^2 (x-xheq)^2-  y^2a^2 == a^2 b^2},{x,-6,xheq},{y,-3,3},ContourStyle->{Thick,Dashing[0.01],Red},AspectRatio->Automatic]];
prt=ParametricPlot[{xheq,T},{T,-4,5},PlotStyle->{Dashing[0.01],Red}];

(*Inside Tangent Circles *)
(* Centers xin,yin,radius rin *)
rin:=(-t ( (R+d)^2 - r^2))/(2(4 R d+d t- r t - R t));
xin:= (- (4 R + t ) rin/t);
yin:=Sqrt[Abs[(R-rin)^2 - (xin-R)^2]];

rleft:= R + t/2;
rrt:=Abs[t]/2;
rchain[k_,rlft_,rrit_]:=((rlft rrit (rlft + rrit))/(rlft (rlft +rrit)+(k rrit)^2));
(*rchain[k,rleft,rrt]*)
(*rin*)
indx:=Reduce[rchain[k,rleft,rrt]==rin,k];
k1:=indx[[2,2]];
k2:=indx[[1,2]];
xchn[k_,a_,b_]:=(2 a + b) rchain[k,a,b]/b;
ychn[k_,a_,b_]:=2 k rchain[k,a,b];
xchn[k1+1,rleft,rrt];
ychn[k1+1,rleft,rrt];
rchain[k1+1,rleft,rrt];


(* Point of intersection between the black circle and the disk {xintersect, yintersect} *)
If [ t<0,{xintersect:= R + d/2 + (R^2 - r^2)/(2 d),yintersect:= Sqrt[Abs[(d^2+2 R d +r^2-R^2)(R^2+2 R d - r^2 - d^2)/(2 d)]]},{}]; 

(* Locus of the the centers of the inside tangent circles is an ellipse *)
(* Focal constant 2ae , and the center of the ellipse {x0 , 0} is at the modpoint between the first center  ( R + t/2 ) and the second center (2 R + t/2). i.e
  x0 = (R+t/2 + R/2 = (3 R +t)/2  *)
(* We have three points on the ellipse:  {R + t/2 , 0}, {2 R + t/2 , 0} , and {xin , yin}.
By plugging either the first point {R + t/2 , 0}, or the third point {2 R + t/2 , 0} into the general equation of the ellipse ae^2 (x - x0 )^2 + be^2 y^2 = ae^2 be^2, one obtain be = R/2.  *)
cntrellipse:= (3 R +t)/2;
be:=R/2;

(* Plugging the third point { xin, yin} into the general equation of the ellipse:
ae^2 (x - x0 )^2 + be^2 y^2 = ae^2 be^2
and simplifying, yields: ae = (R yin)/(Sqrt[Abs[4 (xin - x0)^2 - R^2]])   *) 
ae:=R (yin)/Sqrt[Abs[4 (xin - cntrellipse)^2 - R^2]];

grc=Graphics[{
{Thick,Black,cir[{R,0},R]},{Red,Thick,cir[{R+d,0},r]},If[t<0,{EdgeForm[{Thick,Blue}],FaceForm[RGBColor[0.7,0.9,1]],disk[{R+t/2,0},R+(t)/2],disk[{2R+t/2,0},Abs[t/2]],disk[{xin,yin},rin],disk[{xin,-yin},rin],{Black,Thick,cir[{R,0},R]},{Purple,Dashing[0.01],Thick,cir[{cntrellipse,0},{be,ae}]}},{{EdgeForm[{Thick,Black}],FaceForm[Cyan],disk[{R,0},R]},{EdgeForm[{Thick,Red}],FaceForm[Yellow],disk[{R+d,0},r]},{Blue,cir[{2 R + t/2,0},t/2]}}],If[R>r&&t>0,{{EdgeForm[{Thick,Red}],FaceForm[Yellow],disk[{R+d,0},r]},Table[{RGBColor[0,0.6,1],cir[{xh,k},h]},{k,1,3,0.2}],
Table[{RGBColor[0,0.6,1],cir[{xh,-k},h]},{k,1,3,0.2}]},
{Table[{RGBColor[0,0.6,1],cir[{xh,k},h]},{k,2,3,0.2}],Table[{RGBColor[0,0.6,1],cir[{xh,-k},radiusextr]},{k,2,3,0.2}]}],
Line[{{0,0},{2 (R+r)+t,0}}]


},Axes->False,AxesOrigin->{0,0},PlotRange->All];
grchain=Graphics[{
Table[{EdgeForm[{Purple}],color,disk1[{xchn[k1+i,rleft,rrt],ychn[k1+i,rleft,rrt]},rchain[k1+i,rleft,rrt]]},{i,1,n,1}],
Table[Point[{xchn[k1+i,rleft,rrt],ychn[k1+i,rleft,rrt]}],{i,1,n,1}],
(*Table[{EdgeForm[{Red}],
disk2[{xchn[k2-i,rleft,rrt],ychn[k2-i,rleft,rrt]},rchain[k2-i,rleft,rrt],IntegerDigits[i]]},{i,1,n,1}],*)
Table[{EdgeForm[{Purple}],color1,disk1[{xchn[k2-i,rleft,rrt],ychn[k2-i,rleft,rrt]},rchain[k2-i,rleft,rrt]]},{i,1,n,1}],

Table[Point[{xchn[k2-i,rleft,rrt],ychn[k2-i,rleft,rrt]}],{i,1,n,1}],

If[n≥1,{Black,Dashing[0.01],Circle[{R+(( t)/4),0},{R+(( t)/4),(Sqrt[R^2+R t /2])}]},{}]
},Axes->True,AxesOrigin->{0,0},PlotRange->All];

If[t<0,Show[grchain,grc,pcntr,ImageSize->350,PlotRange->All],


If[R==r,Show[grc,prt,ImageSize->350,PlotRange->All],
Show[grc,pcntr,ImageSize->350,PlotRange->All]]],
Delimiter,
Grid[{{Control[
{{R,2.,"Radius of left Circle R"},0.4,2,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{r,1.356,"Radius of right disk r"},0.4,2,ImageSize->Tiny,Appearance->"Labeled"}]},{Control[
{{t,-0.792,"Distance bet edges t"},-0.9 R,1.5 R,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{n,3,"No. of chain circles"},0,14,1,ImageSize->Tiny,Appearance->"Labeled"}]},
{Control[
{color,RGBColor[1.,0.4498359655146105,0.4698710612649729],ImageSize->Tiny}],

Control[
{color1,RGBColor[0.27093919279774165,1.,0.03738460364690623],ImageSize->Tiny}]}}],
TrackedSymbols:>{a,b,m,n,R,r,t,color,color1,clr},SynchronousUpdating->True,SaveDefinitions->True,Initialization:>{cir[center_,radius_]:={Circle[center,radius],PointSize[0.015],Point[center]};
disk[center_,radius_]:={EdgeForm[Thick],Disk[center,radius],PointSize[0.015],Point[center]};
disk1[center_,radius_]:={Disk[center,radius],PointSize[0.009],Point[center]};
disk2[center_,radius_,index_]:=Join[{colorByIndex@index,{Disk[center,radius],Orange},PointSize[0.009],Point[center]}];
Quiet[1/0];

}]]

Trigonometry

If Sec [ x ] + Tan [ x ] = (p/q)  , where p and q are relatively prime. 
 Show that Tan [ (x/2)]  = ((p - q )/(p + q)).

ClearAll["Global`*"];

Framed[Manipulate[If[proof,Style[Row[{"Given: ",Style[HoldForm[Sec [x] + Tan[x] =(p/q)],Purple],"\n",Spacer[30],"Then    ",HoldForm[((1+Sin[x])/(Cos[x]))=(p/q)],"\n i.e.",Spacer[20],HoldForm[((1+Sin[x]-Cos[x])/(1+Sin[x]+Cos[x]))=((p-q)/(p+q))],"\n\nLeft Hand Side = ",HoldForm[((1+2Sin[(x/2)] Cos[(x/2)]-(1-2 ((Sin[(x/2)])^2)))/(1+2Sin[(x/2)] Cos[(x/2)]+(2 ((Cos[(x/2)])^2)-1))) =((2 Sin[(x/2)] (Cos[(x/2)]+Sin[(x/2)]))/(2 Cos[(x/2)] (Cos[(x/2)]+Sin[(x/2)])))=Tan[(x/2)]],"\n\nHence: ",Style[Framed[HoldForm[Tan[(x/2)]=((p-q)/(p+q))]],Bold,Blue,Background->Lighter[Yellow]],"\n"}],16,Purple],Style[Row[{"If ",HoldForm[Sec["x"]+Tan["x"]=(p/q)],", where p and q are relatively prime.\nShow that: ",HoldForm[Tan[(("x")/2)]=((p-q)/(p+q))],"\n"}],18,Black,Italic]],
{{proof,False,"Proof"},{False,True}},TrackedSymbols:>{proof},SaveDefinitions->True,Initialization:>{ClearAll["Global`*"];}],FrameMargins->9,Background->RGBColor[0,0.6,1]]

Calculus

Differentiability and Continuity

Illustrating the difference bet. continuous and not differentiable at x = 0 vs. continuous and differentiable at x = 0.

The derivative of f (x) at point c is given by:
f'(c) = (lim_(x->c))((f(x) - f(c))/(x - c))
provided that the limit exists.
The existence of the limit requires that the one sided limits:
	(lim_(x->(SuperMinus[c])))((f(x) - f(c))/(x - c))  and  (lim_(x->(SuperDagger[c])))((f(x) - f(c))/(x - c))
exist and are equal.  These one-sided limits are called the derivatives from the left and from the right, respectively.  f is differentiable on the closed interval [a, b] if it is differentiable on (a, b) and if the derivative from the right at a and the derivative from the left at b both exist.

Although it is true that differentiability implis continuity, the converse is not true.  That is, it is possible for a function to be continuous at x = c and not differentiable at x = c.
 (for example:  f(x) = Abs {x - c], or f ( x) = (x - c )^(1/3) ).
The following example illustrates the first example where c = 0. and comparing it with a function with a smooth curve such as f(x) = x^2.

Module[{z},Manipulate[
mainp=Plot[{Abs[x],x^2},{x,-z,z},Axes->True,PlotLabel->Style["\nDifferentiability and Continuity\n",20,Italic,Red],PlotStyle->{{Thick,Red},{Thick,Blue}},AxesLabel->{Style["x",Large,Bold,Italic],Style["y",Large,Bold,Italic]},PlotRange->{{-z,z},{-z/4,z}},
AxesStyle->{{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,14]},{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,14]}},
GridLines->{Range[-z,z,z/4],Range[-z,z,z/4.]},Ticks->{Range[-z,z,N[z/4.,{3,2}]],Range[-z,z,N[z/4.,{3,2}]]},AspectRatio->Automatic];
text=Graphics[{Text[Style[Row[{"f(x) = ",TraditionalForm[ Abs[x]]}],18,Red],{z/3,7z/8}],Rotate[Text[Style["slope = 1",18,Red],{z/2,2z/3}],π/4],
Rotate[Text[Style["slope = -1",18,Red],{-z/2,2z/3}],-π/4],Text[Style[Row[{"f(x) = ",TraditionalForm[ x^2]}],18,Blue],{3z/4,4 z/8}],Text[Style["Slope = 2 x",18,Blue],{2z/3,z/4}]}];
Show[mainp,text],
{{z,1,"zoom"},1.,0.1,Appearance->"Labeled"},TrackedSymbols:>{z}]]

Related Rates

This program illustrates the concept of Related Rates.

ClearAll["Global`*"];

DynamicModule[{a,h,pouringRate,answer},Manipulate[
risingRate=pouringRate/(π a^2 h^2);hNew=h+(pouringRate-3)(a/h)^2;
Column[{
Item[If[answer,Style[Row[{"\n Surface is rising at a rate = ",NumberForm[risingRate,{5,3}]," cm per second\n"}],18,Italic,Purple], Style[Row[{"Tea is pouring into a conical vessel at a rate = ",NumberForm[pouringRate,{5,3}]," (cm^3). per second\ncalculate the rate at which the surface is rising\n when the depth of the Tea is ", h," cm.\n"}],14,Black,Italic]],Alignment->Left,Frame->True],
Item[
pcone=Plot[a Abs[ x],{x,-6,6},PlotStyle->{Thick,Black},AspectRatio->Automatic,AxesStyle->{Arrowheads[{-0.03,0.03}],Directive[Italic,Black,12]},PlotRange->{{-7,9},{-1,16}}];
If[h>6 a,h=6 a,h];
If[a>10/6,a=10/6,a];
pliquid=Plot[h,{x,0,h/a},PlotStyle->{Thick,Blue}];
pradius=Plot[6 a,{x,0,6},PlotStyle->{Thick,Purple}];
pliquidN=Plot[hNew,{x,0,hNew/a},PlotStyle->{Thick,Blue}];
gdimensions=Graphics[{
{Black,Line[{{h/a,h},{h/a+0.5,h}}],Arrowheads[{-0.03,0.03}],Arrow[{{h/a+0.4,0},{h/a +0.4,h}}],Arrowheads[0.06],Thick,Arrow[{{0,16},{0,12}}]},
{Purple,Line[{{6,6 a},{6.6,6 a}}],
Arrowheads[{-0.03,0.03}],Arrow[{{6.4,0},{6.4,6 a}}]},
Text[Style["r",18,Blue],{h/(2 a),h+0.2}],
Text[Style[Row[{NumberForm[h/a,{5,2}]," cm"}],14,Blue],{h/(2 a),h-0.5}],
Text[Style["R",18,Purple],{3,6a+0.4}],
Text[Style["6 cm",18,Purple],{3,6a-0.4}],
Text[Style["h",18,Blue],{h/( a)+0.7,h/2}],
Text[Style[Row[{NumberForm[h,{5,2}]," cm"}],14,Blue],{h/( a),h/2-0.7}],
Text[Style["H",18,Blue],{6.9,3 a}],
Text[Style[Row[{NumberForm[6 a,{5,2}]," cm"}],14,Blue],{6.3,3 a-0.7}],
If[answer,Text[Style[Row[{"(dh/dt) = ",Style[NumberForm[risingRate,{5,3}],Blue],"\n cm / Sec "}],16,Italic,Bold],{-4,3}],
Text[Style["(dh/dt) = ?\n cm / Sec",16,Italic,Bold],{-5,3}]],
Text[Style[Row[{"Pouring Rate = (dv/dt) = \n",pouringRate," (cm^3) / Sec"}],16,Italic,Bold],{5,14}],
{Purple,Circle[{0,6 a},{6,2}]},
{Orange,Circle[{0,h},{h/a,1}]}
}];
gdimensionsN=Graphics[{
{Black,Line[{{hNew/a,hNew},{hNew/a+0.5,hNew}}],Arrowheads[{-0.03,0.03}],Arrow[{{hNew/a+0.4,0},{hNew/a +0.4,hNew}}],Arrowheads[0.06],Thick,Arrow[{{0,16},{0,12}}]},
{Purple,Line[{{6,6 a},{6.6,6 a}}],
Arrowheads[{-0.03,0.03}],Arrow[{{6.4,0},{6.4,6 a}}]},
Text[Style["r",18,Blue],{hNew/(2 a),hNew+0.2}],
Text[Style[Row[{NumberForm[hNew/a,{5,2}]," cm"}],14,Blue],{hNew/(2 a),hNew-0.6}],
Text[Style["R",18,Purple],{3,6a+0.4}],
Text[Style["6 cm",18,Purple],{3,6a-0.4}],
Text[Style["h",18,Blue],{hNew/( a)+0.7,hNew/2}],
Text[Style[Row[{NumberForm[hNew,{5,2}]," cm"}],14,Blue],{hNew/( a),hNew/2-0.7}],
Text[Style["H",18,Blue],{6.9,3 a}],Text[Style[Row[{NumberForm[6 a,{5,2}]," cm"}],14,Blue],{6.3,3 a-0.7}],
If[answer,Text[Style[Row[{"(dh/dt) = ",Style[NumberForm[risingRate,{5,2}],Blue],"\n cm / Sec "}],16,Italic,Bold],{-4,3}],
Text[Style["(dh/dt) = ?\n cm / Sec",16,Italic,Bold],{-5,3}]],
Text[Style[Row[{"Pouring Rate = (dv/dt) = \n",pouringRate," (cm^3) / Sec"}],16,Italic,Bold],{5,14}],
{Purple,Circle[{0,6 a},{6,2}]},
{Orange,Circle[{0,hNew},{hNew/a,1}]}
}];



gcone3d=Graphics3D[{{Opacity[0.1],Blue,Cone[{{0,0,6 a},{0,0,0}},6]},
Glow[Red],Black,Cone[{{0,0,h},{0,0,0}},h/a]},Axes->False,Boxed->False,AspectRatio->Automatic,{ViewPoint->{0.3161890076625623`,-3.289072375904266`,0.7294020958955624`},ViewVertical->{0.04366219822152509`,-0.4009483418998996`,1.2200794433691133`}}];

gcone3dN=Graphics3D[{{Opacity[0.1],Blue,Cone[{{0,0,6 a},{0,0,0}},6]},
Glow[Red],Black,Cone[{{0,0,hNew},{0,0,0}},hNew/a]},Axes->False,Boxed->False,AspectRatio->Automatic,{ViewPoint->{0.3161890076625623`,-3.289072375904266`,0.7294020958955624`},ViewVertical->{0.04366219822152509`,-0.4009483418998996`,1.2200794433691133`}}];
If[pouringRate>3,Row[{
Show[pcone,pliquidN,gdimensionsN,pradius,ImageSize->Medium],Spacer[10],Show[gcone3dN,ImageSize->Medium,PlotRange->All]}],

Row[{
Show[pcone,pliquid,gdimensions,pradius,ImageSize->300],Spacer[10],Show[gcone3d,ImageSize->300,PlotRange->All]}]],Alignment->Left,Frame->True]
}],

Row[{Control[{{a,1.5,"slope"},0.2,3,Appearance->"Labeled",ImageSize->Tiny}],Spacer[20],
Control[
{{h,3,"hight of liquid"},1,8.1,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{pouringRate,3,"Pouring Rate\n (cm^3)/min."},1,12.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{a,h,pouringRate,answer},SaveDefinitions->True]]

Largest Isosceles Triangle Inscribed in a Circle

The isosceles triangle of largest area inscribed in a circle is an equilateral triangle.

Module[{α,θ,areaT,answer},Manipulate[
If[answer,θ=π/3,θ=θ];

areaT:=Sin[θ ] (1.+Cos[θ ]);
Column[{
Item[If[answer,Style[Row[{"\nThe largest iscosceles triangle inscribed in a circle is an equilateral triangle\nIt covers ", NumberForm[(areaT/π),4]," of the circle\n"}],14,Purple],Style["\nFind the largest isoceles triangle inscribed in a circle\n",15,Black]],Alignment->Left,Frame->True],
Item[

Grid[{
{Graphics[{
Thick,Blue,Circle[{0,0},1],If[answer,{EdgeForm[{Thick,Blue}],Darker[Green],Polygon[{{0,1},{Cos[7π/6],Sin[7π/6]},{Cos[11π/6],Sin[11π/6]}}]},


{EdgeForm[{Thick,Black}],RGBColor[0.8,0,.30],Polygon[{{0,1},{Cos[θ-π/2 ],Sin[θ-π/2 ]},{Cos[(3π/2-θ)],Sin[(3π/2-θ)]}}]}],
{Green,PointSize[0.03],Point[{0,0}]},{Thick,Black,Circle[{0,1},0.25,{-π/2-θ /2,-π/2+θ/2}]},Black,Text[Style["A",14,"Label"],1.1{0,1}],
Inset[Style[Row[{"θ  "}],16,Bold],{0.05,0.6}],
Inset[Style[Row[{"θ = ",θ 180/π,"°"}],16,Bold],{0,1.35}],
Text[Style["B",14,"Label"],1.1{Cos[(3π/2-θ)],Sin[(3π/2-θ)]}],Text[Style["C",14,"Label"],1.11{Cos[θ-π/2 ],Sin[θ-π/2 ]}]},PlotRange->Automatic],
Plot[(areaT/π),{θ,π/18,13π/15.},Epilog->{PointSize[Large],ColorData["HTML","OrangeRed"],Point[{θ,(areaT/π)}]},AxesOrigin->{0,0},PlotStyle->{Thick,Blue},PlotLabel->Style[Row[{"The triangle covers ",NumberForm[(areaT/π),4]," of the circle",".\n"}],14,Bold,"Label"],AxesLabel->{Style["angle A","Label",14,Bold],Style["circle coverage","Label",14,Bold]},ImageSize->400,PlotRange->All]}
}],Alignment->Left,Frame->True]
}],Row[{Control[{{θ,π/6,"angle A in degrees"},π/15,153 π/180.,π/180,Appearance->"Labeled",Enabled->!answer}],Spacer[20],
Control[{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{θ,answer},Initialization:>
{areaT:=Sin[θ] (1+Cos[θ]);}]]

Rectangle in an Ellipse

Module[{a,b,answer,x1,showmax},Manipulate[

y1=FullSimplify[(b/a)(Sqrt[(a^2)-(x1^2)])];
arearect=FullSimplify[4. x1 y1];
c:=FullSimplify[a-0.1];
maxarearect=FullSimplify[2 a b];
areaellipse=π a b;
ratioareas=arearect/areaellipse;

Column[{

Item[
If[answer,
Style[Row[{"\narea of rectangle = ",NumberForm[arearect,{5,3}]," ",Superscript[cm,2],Spacer[60],"Ratio = \!\(\*FractionBox[\(area\\ rectangle\), \(area\\ of\\ ellipse\)]\) = ",TraditionalForm[arearect/areaellipse],"\n"}],14,Purple],
If[showmax,Style[Row[{"\narea of rectangle = ",NumberForm[arearect,{5,3}]," ",Superscript[cm,2],";",Spacer[12],"Max ratio =\!\(\*FractionBox[\(rectangle\\ of\\ max . \\ area\), \(area\\ of\\ ellipse\)]\) =",TraditionalForm[maxarearect/areaellipse],"\n"}],16,Red],
Style[Row[{"\nCalculate the ratio of \!\(\*FractionBox[\(the\\ area\\ of\\ the\\ inscribed\\ Rectangle\), \(\(\\n\)\(area\\ of\\ Ellipse\)\)]\)","\nWhat is the maximum ratio?\n"}],16,Black]
]
],Frame->True],
Item[


ellipse=ParametricPlot[{a Cos[t], b Sin[t]},{t,0,2π},PlotStyle->{Thick,Blue},
AxesLabel->{Style["x",Large,Bold,Italic],Style["y",Large,Bold,Italic]},AxesStyle->{{Arrowheads[{-0.04,0.04}],Directive[Thick,Black,12]},{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,12]}},PlotRange->{{-5.3,5.3},{-5.3,5.3}},AspectRatio->Automatic];
plotrelation=Plot[4. x    (Sqrt[(a^2)-(x^2)])/(π (a^2)),{x,0.05,5},PlotStyle->{Thick,Blue},

Epilog->{PointSize[Large],If[showmax,{Red,Point[{a (Sqrt[2.])/2,2/π}]},
{Purple,Point[{x1,ratioareas}]}
]},PlotRange->{{-1,5.1},{-0.2,0.99}},AxesStyle->{{Arrowheads[{-0.04,0.04}],Directive[Thick,Black,12]},{Arrowheads[{-0.04,0.04}],Directive[Thick,Italic,Black,12]}},AxesLabel->{Style["x",Medium,Black],Style["Ratio\n\!\(\*FractionBox[\(area\\ of\\ rect\), \(area\\ of\\ ellipse\)]\)",14,Black]}];
foci=Graphics[{
{Purple,PointSize[0.015],If[a>b,{Point[{(Sqrt[(a^2)-(b^2)]),0}],Point[{-(Sqrt[(a^2)-(b^2)]),0}]},{Point[{0,(Sqrt[(b^2)-(a^2)])}],Point[{0,-(Sqrt[(b^2)-(a^2)])}]}
]},
If[showmax,{EdgeForm[Black],FaceForm[Red],Rectangle[{-((a(Sqrt[2]))/2),-((b(Sqrt[2]))/2)},{((a(Sqrt[2]))/2),((b(Sqrt[2]))/2)}]},
{EdgeForm[Red],FaceForm[Orange],Rectangle[{-x1,-y1},{x1,y1}]}
]
}];
Row[{Show[ellipse,foci,ImageSize->Medium],Show[plotrelation,ImageSize->Medium]}]
,Frame->True,Alignment->{Center}]
}],
Grid[{
{Control[
{{a,3,"Semi axis a"},1,5.,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{b,4,"Semi axis b"},1,5.,Appearance->"Labeled",ImageSize->Tiny}]},{Control[
{{x1,0.3,"x1"},0.1,Dynamic[c],Appearance->"Labeled",ImageSize->Tiny}],Control[
{{answer,False,"answer"},{False,True},Enabled->!showmax}],Control[
{{showmax,False,"showmax"},{False,True},Enabled->!answer}]}
}],
TrackedSymbols:>{a,b,x1,answer,showmax}]
]

Find the dimensions of a cone of minimum volume that can be circumscribed about a sphere of radius R

We need to consider the equation of the volume of the cone as  a function of its base radius r and the radius of the Ball “R”, i.e.
Since volume of the cone = (π/3) (r^2) h , where r = base radius and  h = height.

Graphics[{Thick,Circle[{0,1},1],Line[{{0,0},{0,3}}],Line[{{-(Sqrt[3]),0},{(Sqrt[3]),0}}],Line[{{-(Sqrt[3]),0},{0,3}}],Line[{{(Sqrt[3]),0},{0,3}}],Blue,Arrow[{{0,1},{((Sqrt[3])/2),(3/2)}}],Arrow[{{0,1},{((-(Sqrt[3]))/2),(3/2)}}],{Purple, Line[{{0,3},{-2,3}}],Line[{{0,1},{-1.3,1}}],Line[{{-2.1,0},{-(Sqrt[3]),0}}],Arrowheads[{-0.03,0.03}],Arrow[{{-1.15,1},{-1.15,3}}],Arrow[{{-1.9,0},{-1.9,3}}]},

Text[Style["R",Blue,16],{0.35,1.4}],Text[Style["R",Blue,16],{-0.35,1.4}],Text[Style["R",Blue,16],{-0.15,0.5}],Text[Style["r",Red,24],{0.75,0.15}],Text[Style["E",Black,16],{-(Sqrt[3]),-0.15}],Text[Style["C",Black,16],{(Sqrt[3]),-0.15}],Text[Style["A",Black,16],{0,3.2}],Text[Style["B",Black,16],{0,-0.15}],Text[Style["M",Black,16],{-0.1,0.8}],Text[Style["D",Black,16],{1,(3/2)}],Text[Style["h - R",Purple,16],{-1.15,2}],Text[Style["h ",Purple,16],{-2,1.5}],Rotate[Text[Style["(Sqrt[(((h - R))^2) - (R^2)])",16,Purple],{0.65,2.2}],-π/3]},Axes->False]

Usig the similar triangles:  Δ ADM ~ Δ ABC which gives:
	
	(AD/AB) = (DM/BC) = (AM/AC)
  
  	((Sqrt[(((h-R))^2)-(R^2)])/h) = (R/r) = ((h-R)/(Sqrt[(r^2)+(h^2)]))  
  Simplifying the first expression gives: ((Sqrt[h (h-2 R)])/h)
  And  we reach:  (r^2) = (((R^2)h)/(h - 2 R)) 
Hence:  volumeh (h) = ((π (R^2) (h^2))/(3 (h -2 R)))  .  
After differentiating with respect to h and equating the result with zero, we obtain:

		h = 4 R, which gives the base radius of the cone to be (Sqrt[2 ]) R 

One can reach the same result when replacing the height h by its equivallent in terms of R and r:
		
		h = ((2 R (r^2))/((r^2) - (R^2)))
Hence: the volume of the cone as a function of its base radius becomes: volumeb (r) = (π/3) (r^2) h   = 
((2 π R (r^4))/(3 ((r^2) - (R^2))))

ClearAll["Global`*"];

DynamicModule[{rc,R,H,k1,answer},Manipulate[
(* Volume of the cone in terms of its base radius r. that cone encompasses the sphere with radius R  *)
volumeb[r_]:=((2 π (R) (r^4))/(3 ((r^2)-(((R))^2))));
(* volume of cone at any height h and circumscribes the ball with radius R*)
volumeh[h_]:=(( π (((R))^2)(h^2))/(3 (h-2R)));

(* After differentiation and equating with zero, the minimum volume occurs at height = 4 R and base radius rc = (Sqrt[2]) R *)
H:=4. R; rc:=(Sqrt[2.])R;

WFCone[{blis_List,vlis_List},rad_?Positive]/;blis[[;;2]]==vlis[[;;2]]:=Block[{pts=TranslationTransform[blis][Table[rad{Cos[t],Sin[t],0},{t,0,2π,π/12}]]},
{Line[N[pts]],Line[Join[{vlis},{#}]&/@Most[pts]]}];wcone:=Graphics3D[{WFCone[{{0,0,0},{0,0,k1 R}},R Sqrt[k1 R/(k1 R - 2 R)]]},Boxed->False,AspectRatio->Automatic];
conemin=Graphics3D[{Opacity[0.2],Pink,Sphere[{0,0,R},R],{Opacity[0.3],Darker[Green],Cone[{{0,0,0},{0,0,4 R}},rc]}},Boxed->False,AspectRatio->Automatic];
conemin1=Graphics3D[{{Orange,Mesh->30,Sphere[{0,0,R},R]},{Black,WFCone[{{0,0,0},{0,0,4 R}},rc]}},Boxed->False,(*AspectRatio->Automatic,*)ViewPoint->{1.791,2.717,0.927}];
wsph:=Graphics3D[{Red,Sphere[{0,0,R},R]},Boxed->False,AspectRatio->Automatic];

(*Volume of Cone in terms of the radius of its base. *)

pr0= Plot[volumeb[r],{r,R+0.1,6},PlotRange->Automatic,PlotStyle->Gray,AxesLabel->{Style["Radius\n of Base",14],Style["Volume of Cone",14,Italic]},AxesOrigin->{0,0},PlotRangePadding->1];
pr= Plot[volumeb[r],{r,R+0.1,rc},PlotRange->{{-1,11},{-10,250}},PlotStyle->{Thick,Blue}];
gpr=Graphics[{PointSize[0.02],Red,Point[{R Sqrt[k1 R/(k1 R - 2 R)],volumeb[R Sqrt[k1 R/(k1 R - 2 R)]]}]}];
gpt=Graphics[{PointSize[0.035],Blue,Point[{rc,volumeb[rc]}],
Inset[Style[Row[{Style["( "],rc,Style["  , "],volumeb[rc],Style["  ) "]}],14,Black,Bold],{0.9 rc, volumeb[rc]+20}]},ImagePadding->All];


(*Volume of Cone in terms of its height *)

ph0= Plot[volumeh[h],{h,2R+0.03,12.5},PlotRange->Automatic,PlotStyle->Gray,AxesLabel->{Style["Height\n of Cone",12,Italic,Black],Style["Volume of Cone",12,Italic,Black,Italic]},AxesOrigin->{0,0},PlotRangePadding->1,ImagePadding->All];
ph= Plot[volumeh[h],{h,2R+0.1,4 R},PlotRange->{{-1,15.5},{-10,250}},PlotStyle->{Thick,Blue}];
gph=Graphics[{PointSize[0.02],Red,Point[{k1 R,volumeh[k1 R]}]}];
gpth=Graphics[{PointSize[0.035],Blue,Point[{H,volumeh[H]}],
Inset[Style[Row[{Style["( "],H,Style["  , "],volumeh[H],Style["  ) "]}],14,Black,Bold],{0.97 H, volumeh[H]+5}]},ImagePadding->All];

Grid[{
{If[answer,Show[conemin1,ImageSize->Small],Show[wsph,wcone,ImageSize->Small]],If[answer,Style[Row[{Style["Calculate the dimensions of a cone\nof minimum volume that circumpscribes\na sphere with radius R\n",13,Italic,Black],"Base radius = ",TraditionalForm[(Sqrt[2]) R]," in\nHight = ",
TraditionalForm[4 R]," in \nMinimum volume = ",TraditionalForm[volumeh[H]]," (in^3)\n"}],16,Purple],

Style["Calculate the dimensions of a cone\nof minimum volume that circumpscribes\na sphere with radius R",13,Italic,Black]
]},{If[answer,Show[pr0,pr,gpt,ImageSize->250],Show[pr0,gpr,ImageSize->250]],If[answer,Show[ph0,ph,gpth,ImageSize->250],Show[ph0,gph,ImageSize->250]]} 
 }],
Row[{
Control[
{{R,1,"Radius\n of Sphere"},1,3,Appearance->"Labeled",ImageSize->Tiny}],Spacer[18],Control[{{k1,3.,"height\nmultiple of R"},3.,4.,Appearance->"Labeled",ImageSize->Tiny,Enabled->!answer}],Spacer[12],Control[{{answer,False,"answer"},{False,True}}]
}],
TrackedSymbols->{R,k1,answer},SaveDefinitions->True]]

Divide an interior area into two equal parts.

ClearAll["Global`*"];

DynamicModule[{answer,h},Manipulate[
Clear[x];
sh=Quiet[Solve[(8 x - 27 x^3 - h)==0.,x]];
ah=sh[[2,1,2]];
bh=sh[[3,1,2]];

area1=(∫_0^ah)(h-(8. x - 27 x^3))\[DifferentialD]x;
area2=(∫_ah^bh)((8. x - 27 x^3)-h)\[DifferentialD]x;s=Quiet[Solve[(∫_0^a)(c-(8 x - 27. x^3))\[DifferentialD]x==(∫_a^b)((8. x - 27. x^3)-c)\[DifferentialD]x,c]];
u=s[[1,1,2]];
s1=Quiet[Solve[u==(8 b - 27 b^3),b]];
ub=s1[[3,1,2]];
uc=8 ub - 27 ub^3;
s2=Quiet[Solve[8 x - 27 x^3==uc]];
ua=s2[[3,1,2]];
areaBelowLine=(∫_0^ua)(uc-(8. x - 27 x^3))\[DifferentialD]x;
areaAboveLine=(∫_ua^ub)((8. x - 27 x^3)-uc)\[DifferentialD]x;
Column[{
Item[
If[answer,Style[Row[{"\nheight y = ",uc,"\n Area above the line = ",NumberForm[areaAboveLine,{5,3}], "\nArea under the line = ",NumberForm[areaBelowLine,{5,3}],"\n"}],16,Purple], 
Style[Row[{"A horizontal line y = ",h, "  intersects the curve y = 8 x - 27 (x^3). \nFind a number c such that the areas of the shaded regions are equal\n"}],14,Black,Italic](*Style[Row[{"\ny = ",NumberForm[h,{5,3}] ,
"\nArea above the line = ",NumberForm[area2,{5,3}],"\nArea under the line = ",NumberForm[area1,{5,3}],"\n"}],14,Black]*) ],ItemSize->{30,3},Alignment->{Center},Frame->True],
Item[
txt:=Graphics[{Inset[Style[Row[{"\nArea above the line = ",NumberForm[area2,{5,3}]}],14,Purple],{0.3,h+0.25}],Inset[Style[Row[{"\nArea under the line = ",NumberForm[area1,{5,3}],"\n"}],14,Purple],{0.15,h-0.15}],Inset[Row[{Style["\ny = ",14,Bold,Red,Italic],Style[NumberForm[h,{5,3}],14,Bold,Red,Italic]}],{0.05,h+0.2}]}];
p0=Plot[{8x-27 (x^3),h},{x,0,(Sqrt[(8/27.)])},PlotStyle->{{Thick,Black},{Thick,Red}},AxesOrigin->{0,0}];
p1=Plot[{8x-27 (x^3),h},{x,0,bh},PlotStyle->{{Thick,Black},{Thick,Red}},AxesOrigin->{0,0},PlotLabel->Row[{Style["y = 8 x - 27 (x^3)",18,Italic],Style["\nheight = ",18,Red,Italic],Style[NumberForm[h,{4,3}],18,Bold,Red,Italic]}],Filling->h,FillingStyle->GrayLevel[0.7],PlotRange->All];

txtanswer:=Graphics[{Inset[Style[Row[{"\nArea above the line = ",NumberForm[areaAboveLine,{5,3}]}],14,Purple],{0.3,uc+0.25}],Inset[Style[Row[{"\nArea under the line = ",NumberForm[areaBelowLine,{5,3}],"\n"}],14,Purple],{0.15,uc-0.15}],Inset[Row[{Style["\ny = ",14,Bold,Red,Italic],Style[uc,14,Bold,Red,Italic]}],{0.05,uc+0.2}]}];

p0a=Plot[{8x-27 (x^3),uc},{x,0,(Sqrt[(8/27.)])},PlotStyle->{{Thick,Black},{Thick,Red}},AxesOrigin->{0,0},AxesLabel->{Style["x",Blue,16],Style["y",16,Blue]}];
p1a=Plot[{8x-27 (x^3),uc},{x,0,ub},PlotStyle->{{Thick,Black},{Thick,Red}},AxesOrigin->{0,0},Filling->uc,PlotLabel->Style["y = 8 x - 27 (x^3)",18,Bold,Red,Italic],AxesLabel->{Style["x",Blue,16],Style["y",16,Blue]},FillingStyle->GrayLevel[0.7],PlotRange->All];
If[answer,Show[p1a,p0a,txtanswer,ImageSize->Medium],
Show[p1,p0,txt,ImageSize->Medium]],ItemSize->{30,3},Alignment->{Center},Frame->True]
}],Row[{Control[
{{h,0.6,"Height"},0.,1.6,Appearance->"Labeled"}],Spacer[30],Control[{{answer,False,"Answer"},{False,True}}]}],TrackedSymbols:>{answer,h},SaveDefinitions->True]]

Volume of the Wedge

ClearAll["Global`*"];

DynamicModule[{α,ang,top,x,dx,answer,showside},Manipulate[

y1:=(Sqrt[1.-x^2]);h1:=y1 Tan[α];
y2:=(Sqrt[1.-(x+dx)^2]);
h2:=y2 Tan[α];
y:=(Sqrt[1-u^2]);
du:=0.2;dv:=0.01;
y3:=(Sqrt[1-(u+du)^2]);
h3:=y3 Tan[α];
h=(Sqrt[1-u^2]) Tan[α];
volume=FullSimplify[ (∫_0^1)((1-w^2)Tan[α])\[DifferentialD]w];
Column[{Item[If[answer,Text@Style[Row[{Style["\nVolume of Wedge = ",Blue,Italic],Style[volume,Blue],Style["  cubic units \n",Blue,Italic]}],18],Text@Style["\nCalculate the volume of the wedge giving the angle of the cut α\n",16,Italic]],Alignment->Left,Frame->True],
Item[
(* Displaying the floor of the Wedge *)
rpb=If[top,RevolutionPlot3D[{t,Tan[α]},{t,0,1},{φ,0,ang},Mesh-> 5, Lighting-> "Neutral",PlotStyle-> {GrayLevel[0.99]}],RevolutionPlot3D[{{t ,0}},{t,0,1.},{θ,0,π},Boxed->False]];

(*pcl=If[showall,{ParametricPlot3D[{Cos[u],Sin[u],ht},{u,0,ang},{ht,0,Tan[α]},Mesh->5,BoundaryStyle->{Black}(*,PlotStyle->Texture[ImageCrop[grp]]*),Boxed->False, Lighting-> "Neutral"],Plot3D[{Tan[α]},{x,-1,1},{y,0,1},RegionFunction->Function[{x,y,z},x^2 +y^2<1]

(*[{x,y,z},x^2+y^2<1]*) ,Mesh-> None,PlotStyle-> {GrayLevel[0.99]}]},{}];*)

(* Display the top *)

pcl=If[showside,{ParametricPlot3D[{Cos[u],Sin[u],ht},{u,0,ang},{ht,0,Tan[α]},Mesh->5,BoundaryStyle->{Black}(*,PlotStyle->Texture[ImageCrop[grp]]*),Boxed->False, Lighting-> "Neutral"](*RevolutionPlot3D[{t,Tan[α]},{t,0,1},{φ,0,ang},Mesh-> 5, Lighting-> "Neutral",PlotStyle-> {GrayLevel[0.99]}]*)},{}];




(*cylb=ParametricPlot3D[{Cos[θ],Sin[θ],z},{θ,0, π},{z,0,Tan[α]},Boxed->False,PlotStyle->{Opacity[.6](*,EdgeForm[Opacity[.7]]*)},Mesh->10];
(*cylhalf=Graphics3D[{Opacity[.3],EdgeForm[Opacity[.3]],Cylinder[]},*)PlotRange->{{-1,1},{0,-1},{0,(Sqrt[3])}}];*)
grp:=Graphics3D[{{Black,Thick,Line[{{-1,0,0},{1,0,0}}]},
{Table[{{Thick,Red,Line[{{-1+k dv,(Sqrt[1-(-1+k dv)^2]),(Sqrt[1-(-1+k dv)^2])Tan[α]},{-1+(k+1) dv,(Sqrt[1-(-1+(k+1) dv)^2]),(Sqrt[1-(-1+(k+1) dv)^2])Tan[α]}}]},{Dashing[0.03],Thick,Blue,Line[{{-1+k dv,(Sqrt[1-(-1+k dv)^2]),0.0},{-1+(k+1) dv,(Sqrt[1-(-1.+(k+1) dv)^2]),0.0}}]},

{Darker[Green],Line[{{-1+k dv,(Sqrt[1-(-1+k dv)^2]),0},{-1+k dv,(Sqrt[1-(-1+k dv)^2]),(Sqrt[1-(-1+k dv)^2])Tan[α]}}]}


},{k,0,199,1}]},
Table[{ColorFunction->"Rainbow",

Polygon[{{u,0,0},{u,y,0},{u,y,h},{u,0,0.}}],  (*First Side *)
Polygon[{{u+du,0,0},{u+du,y3,0},{u+du,y3,h3}}], (*Second Side *)
Polygon[{{u,0,0},{u+du,0,0},{u+du,y3,0},{u,y,0}}], (*Bottom Polygon *)Polygon[{{u,0,0},{u,y,h},{u+du,y3,h3},{u+du,0,0}}],(* Front Polygon *)Polygon[{{u,y,0},{u+du,y3,0},{u+du,y3,h3},{u,y,h}}]},{u,-0.8,0.8,0.4}],

(* The moving polygon *)

(*Bottom polygon *)
Polygon[{{x,0,0},{x+dx,0,0},{x+dx,y2,0},{x,y1,0}}],
(* Back Polygon *)
 Polygon[{{x,y1,0},{x+dx,y2,0},{x+dx,y2,h2},{x,y1,h1}}],
(* two sides polygons *)
{RGBColor[0,0.6,1],Polygon[{{x+dx,0,0},{x+dx,y2,0},{x+dx,y2,h2}}]}, 
{EdgeForm[Red],FaceForm[LightYellow],Polygon[{{x,0,0},{x,y1,0},{x,y1,h1},{x,0,0.}}]},

(* Front Polygon *)
{EdgeForm[{Thick,Red}],FaceForm[Blue],Polygon[{{x,0,0},{x,y1,h1},{x+dx,y2,h2},{x+dx,0,0}}]}
(*   ,If[showall,{ Lighting-> "Neutral",BoundaryStyle->Black,Opacity[0.3],

(*FaceForm[LightOrange],EdgeForm[Directive[Dashed,Thick,Blue]],Opacity[.7],EdgeForm[Opacity[.2]],*)
  
Cylinder[{{0,0,0},{0,0,Tan[α]}},1]},{}]   *)

}];
Show[grp,rpb,pcl,ImageSize->400,Boxed->False],Alignment->{Center},Frame->True]}],
Grid[{
{Control[
{{α,π/3,"angle of cut"},π/12,5 π/12,π/12,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{ang ,2 π,"angle"},π/720,2.π,π/720.,Appearance->"Labeled",ImageSize->Tiny}]},{Control[
{{x,0.,"Prism"},-0.8,0.8,0.2,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{dx,0.2,"Δx"},0.04,0.2,0.02,Appearance->"Labeled",ImageSize->Tiny}]},
{Control[
{{answer,False,"Answer"},{False,True}}],Control[{{top,False,"Show Top"},{False,True}}],Control[{{showside,True,"Show Side"},{False,True}}] }}],
TrackedSymbols->{α,ang,top,x,dx,answer,showside},SaveDefinitions->True]]

Area of a side view of a garage
 (a rectangle topped by isosceles triangle):

Given :
 	1.  a perimeter of the side of a garage. 
	2. the ratio between the height and the width of the rectangle,
	3. the measure of the vertex angle of the top triangle.
a) Calculate the dimensions of the side of the garage and its area. 
b) Explore the measure of the vertex angle that yields maximum area under the
      given perimeter and ratio.

ClearAll["Global`*"];

DynamicModule[{p,ratio,alpha,showmax,answer},Manipulate[
(* Let α = alpha be the vertex angle of the top triagle and p = perimeter of the garage,
let ratio = (height/width) of the rectangle. Hence the area of the garage in terms of α is:  *)
(*area[u_]=(p^2 u (4. ratio  u + (Sqrt[Abs[1. - u^2]])))/(4(u+2 ratio u +1)^2);*)
area1[α_]=(p^2 Sin[α/2] (4. ratio  Sin[α/2] + Cos[α/2]))/(4(Sin[α/2]+2 ratio Sin[α/2]+1)^2);
max=FindMaximum[{area1[x],π/6<x≤π},{x,π/3}];
alphamax1=max[[2,1,2]];

If[alpha>alphamax1,alpha=alphamax1];
(* The vertex angle = alpha *)
x=Sin[alpha/2];
(* The width of the rectangle b in terms of the perimeter and sin( alpha ) is:*)
b=p x /(x + 2 ratio x + 1.);
(* Height of the triangle   height/(b/2)=cot(alpha) 
Therefore height = (b/2) cos(alpha)/sin(alpha)*)
rise= b Cos[alpha/2]/(2. x);
totalheight=b ratio +rise;
(* pitch = rise/span = rise/width b *)
pitch=rise/b;
maxrise= b (Cos[alphamax1/2])/(2 Sin[alphamax1/2]);
pitchmax=maxrise/b;
totalmaxheight=b ratio +maxrise;
Column[{
Item[Style[Row[{Style["\nCalculate the dimensions and the area of the figure\nif its perimeter = ",Italic],TraditionalForm[p,{4,2}],Style[" feet ",Italic]," ",Style[" and the vertex angle",Italic]," = ",Superscript[alpha 180/π,°],"\n"}],16,Black],Frame->True,Alignment->{Center},ItemSize->{36,3}],
Item[

pltarea1=Plot[area1[alpha],{alpha,0,π},(*PlotRange->{{-π/9,10 π/9},{-3,18}},*)PlotLabel->Style[Row[{Style["Perimeter",Italic]," = ",p,Style[" feet",Italic]}],16],AxesLabel->{Style["Vertex\n angle",Medium,Bold,Italic],Style["Area",Medium,Bold,Italic]},
AxesStyle->{{Arrowheads[{0.04}],Directive[Thick,Italic,Black,14]},{Arrowheads[{0.04}],Directive[Thick,Italic,Black,14]}},

GridLines->{Range[0,10π/9,π/18],Automatic},GridLinesStyle->Directive[GrayLevel[0.5]],Ticks->{{{Pi/9,20°},{2Pi/9,40°},{Pi/3,60°},{4Pi/9,80°},{5Pi/9,100°},{2Pi/3,120°},{7Pi/9,140°},{8Pi/9,160°},{Pi,180°}},Automatic}];

maxpt1=Graphics[{PointSize[0.02],Red,Point[{alphamax1,area1[alphamax1]}]}];
greenpt1=Graphics[{Darker[Green],PointSize[0.025],Point[{alpha,area1[alpha]}]}];


garage=Graphics[{{EdgeForm[{Thick,Red}],FaceForm[Orange],Opacity[0.3],Polygon[{{0,0},{0,ratio b},{ b/2,b ratio+rise},{b,ratio b},{b,0}}]},

Line[{{0,0},{0,-0.8}}],Line[{{b,0},{b,-0.8}}],
Line[{{b,0},{b+1.2,0}}],Line[{{ b,ratio b},{ b+0.8,ratio b}}],
Line[{{ b/2,ratio b+rise},{ b+1.2,ratio b+rise}}],
Arrowheads[{-0.03,0.03}],Arrow[{{0,-0.7},{b,-0.7}}],Arrow[{{b+0.7,0},{b+0.7,ratio b}}],Arrow[{{b+0.7,ratio b},{b+0.7,ratio b+rise}}],Arrow[{{b+1.1,0},{b+1.1,ratio b + rise}}],
If[answer,{Text[Style[Row[{Style["width",Italic]," = ",NumberForm[b,{4,3}],Style[" ft"]}],12,Purple],{b/2,-0.5}],Text[Style[Row[{Style["height",Italic]," = ",NumberForm[ratio b,{4,3}],Style[" ft"]}],12,Purple],{b+0.5,ratio b/2.}],

Text[Style[Row[{Style["roof's height",Italic],"\n = ",NumberForm[rise,{4,3}],Style[" ft"]}],12,Purple],{b+0.5,ratio b+rise/2.}],
Rotate[Text[Style[Row[{Style["total height",Italic],"\n = ",NumberForm[totalheight,{4,3}],Style[" ft"]}],12,Purple],{b+1.1,(ratio b+rise)/2-0.3}],π/2]
},{
Text[Style["width = ?",14],{b/2,-0.5}],Text[Style["height = ?",14],{b+0.5,ratio b/2.}],Text[Style["roof's height\n = ?",14],{b+0.5,ratio b+rise/2.}],Rotate[Text[Style[Row[{Style["total height",Italic],"\n = ?",Style[" ft"]}],12,Black],{b+1.1,(ratio b+rise)/2}],π/2]
}],
(*  Write the area of the garage *)
{Text[Style[Superscript[alpha 180/π,°],16,Black],{b/2,b ratio+rise-0.5}],If[answer,
Text[Style[Row[{Style["area of fig.",Italic],"\n = ",NumberForm[area1[alpha],{5,3}],"  ",Superscript[ft,2] }],16,Black],{b/2,ratio b-0.6}]]}
  },Axes->True(*,PlotRange->{{0,5.2},{-1.5,6}}*)(*,(*AspectRatio->Automatic,*)ImageSize->{250,250}*)];

garagemax=
Graphics[{{EdgeForm[{Thick,Blue}],FaceForm[Pink],Opacity[0.5],Polygon[{{0,0},{0,ratio b},{b /2,b ratio+maxrise},{b,b ratio},{b,0}}]},
Line[{{0,0},{0,-0.8}}],Line[{{b,0},{b,-0.8}}],
Line[{{b,0},{b+1.2,0}}],Line[{{ b,ratio b},{ b+0.8,ratio b}}],
Line[{{ b/2,ratio b+ maxrise},{ b+1.2,ratio b+maxrise}}],
(*Line[{{b,0},{b+1.2,0}}],Line[{{ b,ratio b},{ b+1.2,ratio b}}],*)
Arrowheads[{-0.03,0.03}],Arrow[{{0,-0.7},{b,-0.7}}],Arrow[{{b+0.7,ratio b},{b+0.7,ratio b+maxrise}}],Arrow[{{b+0.7,0},{b+0.7,ratio b}}],Arrow[{{b+1.1,0},{b+1.1,ratio b + maxrise}}],

(*  Write the maximum area of the garage *)
If[answer,{Text[Style[Row[{Style["area of fig.",Italic],"\n = ",NumberForm[area1[alphamax1],{5,3}],"  ",Superscript[ft,2] }],16,Black],{b/2,ratio b-0.6}],
Text[Style[Row[{Style["     width",Italic]," = ",NumberForm[b,{4,3}],Style[" ft"]}],12,Purple],{b/2,-0.5}],Text[Style[Row[{Style["     height",Italic]," = ",NumberForm[ratio b,{4,3}],Style[" ft"]}],12,Purple],{b+0.5,ratio b/2.}],
Text[Style[Row[{Style["     roof's height",Italic],"\n = ",NumberForm[maxrise,{4,3}],Style[" ft"]}],12,Purple],{b+0.5,ratio b+maxrise/2.}],
Rotate[Text[Style[Row[{Style["   total height",Italic],"\n   = ",NumberForm[totalmaxheight,{4,3}],Style[" ft"]}],12,Purple],{b+1.1,ratio b-0.2}],π/2]

}],Text[Style[Superscript[alphamax1 180/π,°],16,Black],{b/2,b ratio+maxrise-0.5}]  },Axes->True(*,PlotRange->{{0,5.5},{-1.5,6}},ImageSize->350*)];
(*Show[pltarea,maxpt]*)
If[showmax,Row[{Show[garagemax,ImageSize->300],Show[pltarea1,maxpt1,ImageSize->250],Column[{

Row[{"\n",Style["Dimensions:",24,Italic]}],
Style[Row[{Style["     width           ",Italic]," = ",NumberForm[b,{5,3}],"  ft"}],18],
Style[Row[{Style["     pitch            ",Italic]," = ",NumberForm[pitchmax,{5,3}]}],18],
Style[Row[{Style["     max. rise     ",Italic]," = ",NumberForm[maxrise,{5,3}]," ft."}],18],Style[Row[{Style["     max height  ",Italic]," = ",NumberForm[b ratio,{5,3}]," ft."}],18],
Style[Row[{Style["   total height  ",Italic],"   = ",NumberForm[totalmaxheight,{5,3}]," ft."}],18],
Style[Row[{Style["area of fig.",Italic]," = ",NumberForm[area1[alphamax1],{5,3}],"  ",Superscript[ft,2] }],24,Italic,Black](*,
Spacer[{0,12}],
Show[pltarea1,maxpt1,ImageSize->250]*)
}]
}],
Row[{Show[garage,ImageSize->250],Show[pltarea1,greenpt1,ImageSize->300],If[answer,Column[{
Row[{"\n",Style["Dimensions:",24,Italic]}],
Style[Row[{Style["     width         ",Italic]," = ",NumberForm[b,{5,3}],"  ft"}],18],
Style[Row[{Style["     pitch          ",Italic]," = ",NumberForm[pitch,{5,3}]}],18],
Style[Row[{Style["     rise            ",Italic]," = ",NumberForm[rise,{5,3}]," ft."}],18],
Style[Row[{Style["     height        ",Italic]," = ",NumberForm[b ratio,{5,3}]," ft."}],18],
Style[Row[{Style["   total height",Italic],"   = ",NumberForm[totalheight,{5,3}]," ft."}],18],
Style[Row[{Style["area of fig.",Italic]," = ",NumberForm[area1[alpha],{5,3}],"  ",Superscript[ft,2] }],24,Italic,Black](*,
Spacer[{0,12}],
Show[pltarea1,greenpt1,ImageSize->300]*)
}],
Column[{
Row[{"\n",Style["Dimensions:",24,Italic,White]}],
Style[Row[{Style["     width         ",Italic,White]," = ",NumberForm[b,{5,3}],"  ft"}],18,White],
Style[Row[{Style["     pitch          ",Italic,White]," = ",NumberForm[pitch,{5,3}]}],18,White],
Style[Row[{Style["     rise            ",Italic,White]," = ",NumberForm[rise,{5,3}]," ft."}],18,White],
Style[Row[{Style["     height        ",Italic,White]," = ",NumberForm[b ratio,{5,3}]," ft."}],18,White],
Style[Row[{Style["   total height",Italic,White],"   = ",NumberForm[totalheight,{5,3}]," ft."}],18,White],
Style[Row[{Style["area of fig.",Italic,White]," = ",NumberForm[area1[alpha],{5,3}],"  ",Superscript[ft,2] }],24,Italic,White](*,
(*Spacer[{0,12}],*)
Show[pltarea1,greenpt1,ImageSize->250]*)
}]
(*Show[pltarea1,greenpt1,ImageSize->Medium,PlotRange->All]*)
]
}]
],
Frame->True,ItemSize->{42,2}]
}],

Grid[{{Control[
{{p,8,"perimeter"},6.,15.,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{ratio,0.5,"ratio height to width"},0.36,1.,ImageSize->Tiny,Appearance->"Labeled"}]},{Control[
{{alpha,π/3,"vertex\n angle"},π/6,2π/3,0.00001,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{showmax,False,"show Max "},{False,True}}],Control[{{answer,False,"Answer "},{False,True}}]}}],TrackedSymbols->{p,ratio,alpha,showmax,answer},SaveDefinitions->True]]

Example 3:
Revolving a region enclosed by two functions about a line parallel to the y-axis

ClearAll["Global`*"];

DynamicModule[{revolutionaxis,angle,answer},Manipulate[
f1[x_]:=4-x^2+12x;
f2[x_]:=x^2-8x+26;
xsol=Reduce[f1[x]==f2[x],x];
xmin=xsol[[1,2]];
xmax=xsol[[2,2]];
volume=π(∫_xmin^xmax)((f1[x]-revolutionaxis)^2-(f2[x]-revolutionaxis)^2)\[DifferentialD]x;
Column[{
Item[
If[answer,Style[Row[{"\nthe volume obtained by revolving about y = ",revolutionaxis," is ",NumberForm[volume,{5,3}], " (cm^3)\n"}],12,Purple,Italic],Style[Row[{"\nCalculate the volume by rotating the region about y = ",revolutionaxis,"\n"}],12 ,Black,Italic]
],Frame->True],
Item[

(* show the region to be rotated *)
p3=Plot[Tooltip[{f1[x],f2[x],revolutionaxis}],{x,xmin,xmax},Filling->{1->{2}},FillingStyle->Pink,PlotStyle->{{Thickness[0.01],Blue},{Thickness[0.01],Black},{Thickness[0.021],Red}},AxesLabel->{Style["x",FontSize->16,Italic],Style["y",FontSize->16,Italic]},AxesOrigin->{0,0}];
labelg=Graphics[{Inset[Style["(Subscript[f, 1])[x] = -(x^2)+ 12 x + 4 ",14,Blue,Italic],{5,42}],
Inset[Style["(Subscript[f, 2])[x] = (x^2) - 8 x + 26 ",14,Black,Italic],{5,7}],
Inset[Row[{Style["y = ",14,Red,Italic],Style[revolutionaxis,14,Red]}],{5,revolutionaxis+3}]
}];


ppp:=ParametricPlot3D[{0,t, revolutionaxis},{t,xmin,xmax},ViewPoint->{1.7594720955355576`,-2.6999874210889616`,-1.031661703754242`},ViewVertical->{1.9960254582879642`,-0.8366921615062419`,-0.6265787393203333`},
PlotStyle->{Thickness[0.006],Dashing[{0.0015,0.02,0.07,0.02}],RGBColor[1,0,0]}];
(* The following creates the surface wall *)
regions={{(revolutionaxis-f1[t])Sin[θ], t, (revolutionaxis-f1[t])(1-Cos[θ])+f1[t]},
{(revolutionaxis-f2[t])Sin[θ], t, (revolutionaxis-f2[t])(1-Cos[θ])+f2[t]} };

surfaces=ParametricPlot3D[
regions,{t,xmin,xmax},{θ,0,angle},BoxRatios->{1,1,1},Boxed->False,AxesLabel->{"x","y","Z"},ViewPoint->{3,1.5,0.7}];
boundarytop=regions[[1]]/.{{θ->0},{θ->angle}};
boundarybottom=regions[[2]]/.{{θ->0},{θ->angle}};
boundaryplotT=ParametricPlot3D[#,{t,xmin,xmax},PlotStyle->{Thick,Blue},Boxed->False]&/@boundarytop;
boundaryplotB=ParametricPlot3D[#,{t,xmin,xmax},PlotStyle->{Thick,Black},Boxed->False]&/@boundarybottom;
(* Fill the sections with lines *)
sliceT=Graphics3D[{{Thick,Pink,Table[Line[{{0,i,f2[i]+1},{0,i,f1[i]-1}}],{i,xmin+0.1,xmax-0.1,0.01}]}},Axes->True];

sliceB=Graphics3D[{Thick,Pink,Line[Table[RotationTransform[-angle,{0,1,0},{0,0,revolutionaxis }][{{0,i,f2[i]+1},{0,i,f1[i]-1}}],{i,xmin+0.1,xmax-0.1,0.01}]]},Axes->True];

Column[{Show[p3,labelg,ImageSize->Medium,PlotRange->All],Spacer[30],Show[surfaces,sliceT,sliceB,boundaryplotT,boundaryplotB,ppp,ImageSize->Medium,PlotRange->All]}]
,Frame->True,Alignment->{Center}]
}],
Row[{Control[{{revolutionaxis,-5,"axis of\nrotation"},-10,5.,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[
{{angle,2.7,"rotationangle"},-2π,2π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{revolutionaxis,angle,answer}
,SaveDefinitions->True]]

Calculus AP exam 2014, question # 2

Let R be the region enclosed by the graph of
 f(x) = (x^4)-2.3 (x^3)+4 and the horizontal line y = 4.
a) Find the volume of the solid      generated when R is rotated about the horizontal line y = -2.
       b) Region R is the base of a solid. For this solid, each cross section perpendicular to the x-axis is an isosceles right triangle with a leg in R.  Find the volume of the solid.
	c) The vertical line x = k divides R into two regions with equal areas. Write an equation involving integral expressions whose solutions gives the value of k.

ClearAll["Global`*"];

DynamicModule[{theta,rotationaxis,answer},Manipulate[

f[x_]:=(x^4)-2.3 (x^3)+4;
g[x_]:=4;
(*rotationaxis=-2;*)
(* Solve f [x] = 4 *)
xint=x/.FindRoot[f[x]==4,{x,2}];
xmin=0;
xmax=xint;
halfarea=0.5(∫_xmin^xmax)(g[x]-f[x])\[DifferentialD]x;
k1 = k/.FindRoot[(∫_xmin^k)(g[x]-f[x])\[DifferentialD]x==halfarea,{k,0,1.2}];
volume=π(∫_xmin^xmax)((g[x]-rotationaxis)^2-(f[x]-rotationaxis)^2)\[DifferentialD]x;
Column[{
Item[
If[answer,Style[Row[{"\nthe volume obtained by revolving R about y = ",rotationaxis," is ",NumberForm[volume,{5,3}], " (cm^3)\nhalf the area of the region = ",halfarea," ",Superscript[cm,2],", k = ",k1,"\n"}],12,Purple,Italic],Style[Row[{"\nCalculate the volume by rotating the region about y = ",rotationaxis,"\nFind the vertical line that divides the region into two equal parts.\n"}],12 ,Black,Italic]
],Frame->True],
Item[
(* show the region to be rotated *)
p3=Plot[Tooltip[{f[x],g[x]}],{x,xmin,xmax},Filling->{1->{2}},FillingStyle->Pink,PlotStyle->{{Thickness[0.005],Blue},{Thickness[0.005],Black}},AxesLabel->{Style[x,FontSize->16,Italic],Style["y",FontSize->16,Italic]},AxesOrigin->{0,0},PlotRange->{{-1,3.6},{-3,5}}];

p31=Plot[Tooltip[{f[x],g[x],rotationaxis}],{x,-0.5,3},PlotStyle->{{Thick,Blue},{Thick,Black},{Thickness[0.0061],Dashing[{0.001,0.03,0.11,0.03}],Red}},AxesLabel->{Style["x",FontSize->16,Italic],Style["y",FontSize->16,Italic]},AxesOrigin->{0,0},PlotRange->{{-1,3.6},{-3,5}}];
param=ParametricPlot[{k1,t},{t,0,4.2}];

p312=RegionPlot[f[x]≤y≤g[x],{x,0,k1},{y,f[x],g[x]},PlotStyle->{Opacity[1],Green},AxesLabel->{Style["x",FontSize->16,Italic],Style["y",FontSize->16,Italic]},AxesOrigin->{0,0},PlotRange->{{-1,3.6},{-3,5}}];

p322=RegionPlot[f[x]≤y≤g[x],{x,k1,xint},{y,f[x],g[x]},PlotStyle->{Opacity[1],Yellow},AxesLabel->{Style["x",FontSize->16,Italic],Style["y",FontSize->16,Italic]},AxesOrigin->{0,0},PlotRange->{{-1,3.6},{-3,5}}];

labelg=Graphics[{Inset[Style["f(x) = (x^4)- 2.3 (x^3) + 4 ",14,Blue,Italic],{3,2.5}],
Inset[Style["g(x) = 4 ",14,Black,Italic],{2.7,4.2}],Inset[Style[Row[{"rotation axis is y = ",rotationaxis}],14,Red,Italic],{1.5,rotationaxis+0.5}],If[answer,{
Inset[Style[Row[{halfarea," ",Superscript[cm,2]}],16,Black],{1.1,3.6}],
Inset[Style[Row[{halfarea," ",Superscript[cm,2]}],16,Black],{2,3.3}],
Inset[Style[Row[{" k = ",k1," "}],14,Black],{k1,4.5}]},{}]}];
fillcaps[theta_]:=Block[{surfaces,orig,boundary1,boundary2,lines1,lines2,upper1,upper2,bottom1,bottom2,polygon1,polygon2,caps},
surfaces={{(f[t]-rotationaxis)Sin[θ],t,(f[t]-rotationaxis)Cos[θ]},
{(g[t]-rotationaxis)Sin[θ],t,(g[t]-rotationaxis)Cos[θ]}};
orig=ParametricPlot3D[surfaces,{t,xmin,xmax},{θ,0,theta},BoxRatios->{1,1,1},Boxed->False,ViewPoint->{-3.06,0.948,1.23},ViewVertical->{0.063,-0.164`,-0.984}];
boundary1=surfaces[[1]]/.{{θ->0},{θ->theta}};
boundary2=surfaces[[2]]/.{{θ->0},{θ->theta}};
(lines1=ParametricPlot3D[#,{t,xmin,xmax},PlotStyle->Red]&/@boundary1);
(lines2=ParametricPlot3D[#,{t,xmin,xmax},PlotStyle->Green]&/@boundary2);
{upper1,bottom1}=Cases[#,_Line,Infinity]&/@{lines1[[1]],lines2[[1]]}//Flatten;
(polygon1=upper1[[1]]~Join~Reverse@bottom1[[1]]//Polygon)//Graphics3D//Show[#,Options@orig]&;
{upper2,bottom2}=Cases[#,_Line,Infinity]&/@{lines1[[2]],lines2[[2]]}//Flatten;
(polygon2=upper2[[1]]~Join~Reverse@bottom2[[1]]//Polygon)//Graphics3D//Show[#,Options@orig]&;
caps={polygon1,polygon2}//Graphics3D[{EdgeForm[{Thick,Blue}],Pink,#}]&//Show[#,Options@orig]&;
Show[orig,caps]
];
Column[{Show[p3,p31,If[answer,Show[p312,p322,param],{}],labelg,ImageSize->350],Show[fillcaps[theta],ImageSize->250]}],Alignment->{Center},Frame->True]
}],Row[{Control[
{{theta,3.42237,"rotationa ngle"},π/16,2π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[20],
Control[{{rotationaxis,-2,"rotationAxis"},-2.5,4.2,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{theta,rotationaxis,answer},SaveDefinitions->True]]

Rotating a triangle about x = a

We can use either washer or cylinderical method to calculate the volume.
Verify your answer with the volume of a prism whose base is a triangle and height is the circumference of a circle with radius = the perpendicular distance between the revolution axis and the vertex point (-5, 4) of the triangle.

ClearAll["Global`*"];

DynamicModule[{angle,revaxis,answer},Manipulate[
f[x_]=(4-(4/3)Abs[x+5]);
g[x_]=b (4-(4/3)Abs[x+5]);

(* Use rotation matrix to rotate around ( x - axis, y, z), then translate by the value of the revolution axis  *)
T2={{Cos[θ],-Sin[θ],0},{Sin[θ],Cos[θ],0},{0,0,1}}.{x-revaxis,y,z}+{revaxis,0,0};
(* The rotated around surface with height ->f[a] *)
T3=T2/.{x->a,y->0,z-> f[a],b->1};
(* The rotated bottom surface is T4*)
T4=T2/.{x->a,y->0,z->0,b->1};
(* The original triangle at x = -2, -8 *)
T5=T2/.{x->a,y->0,z-> g[a],θ->0};
(* The triangle after rotating an angle theta T^ *)
T6=T2/.{x->a,y->0,z-> g[a],θ->angle};

a1=2a UnitVector[3,1];
a2=a UnitVector[3,2];
a3=a UnitVector[3,3];
volumeT=(∫_(-8)^(-2))(2 π (revaxis-x)(f[x]))\[DifferentialD]x;



Column[{
Item[If[answer,Style[Row[{"Volume of the solid = ",volumeT,"  (cm^3)\n"}],16,Purple],Style[Row[{"Calculate the volume of the solid generated by \nrevolving the triangular region about x = ",revaxis,"\n"}],
13,Black,Italic]
],Alignment->{Center}, Frame->True,ItemSize->{33,3}],
Item[

Show[
ParametricPlot3D[{T3,T4},{θ,angle,0},{a,-8,-2},PlotStyle->{Green,LightBlue},AxesLabel->{Style["x",Large,Italic],Style["y",Large,Italic],Style[z,Large,Italic]},AspectRatio->Automatic,PlotRange->All],
(*ParametricPlot3D[{a1,a2,a3},{a,0,5},PlotRange->All,AxesLabel->{Style[x,Large,Italic],Style[y,Large,Italic],Style[z,Large,Italic]},AspectRatio->Automatic],*)
Graphics3D[{
{PointSize[0.02],Darker[Green],Point[{0,0,0}]},
{Thick,Black,Arrowheads[0.05],Arrow[Tube[{{0,0,0},{revaxis+8,0,0}}]]},{Thick,Red,Arrow[Tube[{{0,0,0},{0,revaxis+5,0}}]]},{Thick,Blue,Arrow[Tube[{{0,0,0},{0,0,4.5}}]]},
Text[Style["x",Italic,Black,16],{revaxis+8.6,0,0}],
Text[Style["y",Italic,Red,16],{0,revaxis+5.6,0}],
Text[Style["Z",Italic,Black,16],{0,0,5.4}]
},AxesLabel->{Style[x,Large,Italic],Style[y,Large,Italic],Style[z,Large,Italic]},AspectRatio->Automatic],

(*ParametricPlot3D[{axis+Cos[θ],Sin[θ],a},{θ,angle,0},{a,0,6},PlotStyle->{Red},MeshStyle->None],*)
Graphics3D[{Red,Tube[{{revaxis,0,0},{revaxis,0,5}},0.25]}],
ParametricPlot3D[{T5,T6},{a,-8,-2},{b,0,1},PlotStyle->{{Thick,Blue},{Thick,Red}},MeshStyle->None],PlotRange->All,ImageSize->Medium],
Alignment->{Center}, Frame->True]}],
Row[{Control[
{{angle,-3π/4,"revolving angle"},-2π,2π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],Control[{{revaxis,3,"revolving axis"},0.,5,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],
Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{angle,revaxis,answer},SaveDefinitions->True]]

Finally calculating the volume of the revolving solid about the given axis

DynamicModule[{angle,revaxis,answer},Manipulate[
f[x_]=9-(x+5)^2;
g[x_]=b(9-(x+5)^2);

(* Use rotation matrix to rotate around ( x - axis, y, z), then translate by the value of the revolution axis  *)
T2={{Cos[θ],-Sin[θ],0},{Sin[θ],Cos[θ],0},{0,0,1}}.{x-revaxis,y,z}+{revaxis,0,0};
(* The rotated around surface with height ->f[a] *)
T3=T2/.{x->a,y->0,z-> f[a],b->1};
(* The rotated bottom surface is T4*)
T4=T2/.{x->a,y->0,z->0,b->1};
(* The original triangle at x = -2, -8 *)
T5=T2/.{x->a,y->0,z-> g[a],θ->0};
(* The triangle after rotating an angle theta T^ *)
T6=T2/.{x->a,y->0,z-> g[a],θ->angle};

a1=a UnitVector[3,1];
a2=a UnitVector[3,2];
a3=a UnitVector[3,3];
volumeP=(∫_(-8)^(-2))(2 π (revaxis-x)(f[x]))\[DifferentialD]x;
Column[{
Item[If[answer,Style[Row[{"Volume of the solid = ",volumeP,"  (cm^3)\n"}],16,Purple],Style[Row[{"Calculate the volume of the solid generated by \nrevolving the triangular region about x = ",revaxis,"\n"}],
13,Black,Italic]
],Alignment->{Center}, Frame->True,ItemSize->{33,3}],
Item[
Show[
ParametricPlot3D[{a1,a2,a3},{a,0,12},PlotRange->All,AxesLabel->{Style["x",Large,Italic],Style["y",Large,Italic],Style["z",Large,Italic]},AspectRatio->Automatic],
ParametricPlot3D[{T3,T4},{θ,angle,0},{a,-8,-2},PlotStyle->{Green,LightBlue}],
(*ParametricPlot3D[{axis+Cos[θ],Sin[θ],a},{θ,angle,0},{a,0,6},PlotStyle->{Red},MeshStyle->None],*)
Graphics3D[{Red,Tube[{{revaxis,0,0},{revaxis,0,10}},0.25]}],
ParametricPlot3D[{T5,T6},{a,-8,-2},{b,0,1},PlotStyle->{Red,Red},MeshStyle->None],PlotRange->All,ImageSize->Medium],
Alignment->{Center}, Frame->True]}],
Row[{Control[
{{angle,-3π/4,"revolving angle"},-2π,2π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],Control[{{revaxis,3,"revolving axis"},0.,5,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],
Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{angle,revaxis,answer}]]

Example 5  continue
Revolving a hexagonal base defined by a piecewise function about a vertical axis.

f1[x_]:=Piecewise[{{(Sqrt[3])x+14(Sqrt[3]),-11≤x≤-8},
				{6 (Sqrt[3]),-8≤x≤-2},
				{-(Sqrt[3])x+4(Sqrt[3]),-2≤x≤1}}];
Plot[{f1[x],-f1[x]+6 (Sqrt[3])},{x,-11,1},Axes->True,Filling->{1->{{2},Pink}},AxesOrigin->{0,0},PlotRange->All,PlotStyle->{{Thick,Blue}},AspectRatio->Automatic]

Check the area of the Hexagon

f1[x_]:=Piecewise[{{(Sqrt[3])x+14(Sqrt[3]),-11≤x≤-8},{6 (Sqrt[3]),-8≤x≤-2},{-(Sqrt[3])x+4(Sqrt[3]),-2≤x≤1}}];areaHex= (∫_(-11)^1) (2 f1[x]-6 (Sqrt[3]))\[DifferentialD]x

ChecK:
Length of side = 6 units,  apathom = 3(Sqrt[3]) units  
Area = Half perimeter times apathom = 18 times 3 (Sqrt[3]) = 54 (Sqrt[3]) square units

Now calculate the volume when revolving the hexagon about a vertical axis x = 3.
Verify your answer by considering a prism with a hexagonal base and height  = the circumference of a circle with radius = the distance between the revolving axis and the centerline of the gexagon.

ClearAll["Global`*"];

DynamicModule[{angle,revaxis,answer},Manipulate[Column[{
Item[f1[x_]:=Piecewise[{{(Sqrt[3])x+14(Sqrt[3]),-11≤x≤-8},{6 (Sqrt[3]),-8≤x≤-2},{-(Sqrt[3])x+4(Sqrt[3]),-2≤x≤1}}];
volumeh= 2π (∫_(-11)^1)(revaxis-x) (2 f1[x]-6(Sqrt[3]))\[DifferentialD]x;
If[answer,Style[Row[{"Volume of the solid = ",volumeh,"  (cm^3)\n"}],16,Purple],Style[Row[{"Calculate the volume of the solid generated by \nrevolving the hexagonal region about x = ",revaxis,"\n"}],
13,Black,Italic]
],Alignment->{Center}, Frame->True,ItemSize->{45,3}],
Item[

rv=RevolutionPlot3D[{f1[t]},{t,-11,1},{θ,0,angle}];
rvdown=RevolutionPlot3D[-f1[t]+6 (Sqrt[3]),{t,-11,1},{θ,0,angle}];
ppp:=ParametricPlot3D[{revaxis,0,t},{t,0,12},PlotStyle->{Thickness[0.006],Dashing[{0.0015,0.02,0.07,0.02}],RGBColor[0,0,1]}];
rvtranslateup=RevolutionPlot3D[f1[t+revaxis],{t,-11-revaxis,1-revaxis},{θ,0,angle}];
rvtranslatebelow=RevolutionPlot3D[-f1[t+revaxis]+6 (Sqrt[3]),{t,-11-revaxis,1-revaxis},{θ,0,angle}];
grv=Graphics3D[{GraphicsComplex[Transpose[Transpose[rvtranslateup[[1,1]]]+{revaxis,0,0}],rvtranslateup[[1,2]]]},Axes->True];
grv2=Graphics3D[{GraphicsComplex[Transpose[Transpose[rvtranslatebelow[[1,1]]]+{revaxis,0,0}],rvtranslatebelow[[1,2]]]},Axes->True];
poly1=Graphics3D[{Red,Polygon[{{-2,0,0},{1,0,3(Sqrt[3])},{-2,0,6(Sqrt[3])},{-8,0,6(Sqrt[3])},{-11,0,3(Sqrt[3])},{-8,0,0}}]}];
gcap=Graphics3D[{{Red,Polygon[RotationTransform[angle,{0,0,1},{revaxis,0,0}][{{-2,0,0},{1,0,3(Sqrt[3])},{-2,0,6(Sqrt[3])},{-8,0,6(Sqrt[3])},{-11,0,3(Sqrt[3])},{-8,0,0}}]]}
},(*{Thick,Blue,Dashing[{0.001,0.03,0.11,0.03}],InfiniteLine[{revaxis,0,0},{0,0,1}]}},*)Axes->True];
Show[grv,grv2,gcap,poly1,ppp,PlotRange->All,ImageSize->Large],Alignment->{Center}, Frame->True,ItemSize->{45,3}]
}],
Row[{Control[
{{angle,-3π/4,"revolving angle"},-2π,2π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],Control[{{revaxis,3,"revolving axis"},1,8,Appearance->"Labeled",ImageSize->Tiny}],Spacer[10],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{angle,revaxis,answer},SaveDefinitions->True]]

Four Petals Flower

ClearAll["Global`*"];

DynamicModule[{r,sol},Manipulate[
(* Solution 1 
shaded area=area of a square with side length=((Sqrt[3]) - 1 ) r+four segments.Area of a segment=area of a sector with radius=((Sqrt[2]) r ) and angle=π/6-area of triangle with base=((Sqrt[3]) - 1 ) rand height=(((Sqrt[3] + 1 ) r)/2).  *)
areaSeg:=FullSimplify[ (1/2) ((((Sqrt[2]) r ))^2) (π/6) - (1/2) ((Sqrt[3]) - 1 ) r ((((Sqrt[3]) + 1)/2) ) r];
requiredArea1:= FullSimplify[((((Sqrt[3]) - 1 ))^2) (r^2) + 4 FullSimplify[ (1/2) ((((Sqrt[2]) r ))^2) (π/6) - (1/2) ((Sqrt[3]) - 1 ) r ((((Sqrt[3]) + 1)/2) ) r]];
(* Solution 2 *)
(* The shaded area consists of :
Yellow areas + two segments red areas *)

yellowArea2:=HoldForm[Yellow area =4(∫_0^((((Sqrt[3])-1)r)/2))(- r +  (Sqrt[2 (r^2)-x^2]))\[DifferentialD]x]==Framed[4(∫_0^((((Sqrt[3])-1)r)/2))(- r +  (Sqrt[2 (r^2)-x^2]))\[DifferentialD]x,Background->LightYellow];
(* Red Area = 4 times the integral from zero to ((((Sqrt[3])-1)/2)) r [x dy ], where x = (( -r + (Sqrt[2 r^2 - y^2])) -   ((((Sqrt[3])-1)/2)) r) *)
redArea2:=HoldForm[Red and Blue  areas =4(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-y^2])) - ((((Sqrt[3])-1)/2)) r )\[DifferentialD]y]==Framed[4(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-y^2])) - ((((Sqrt[3])-1)/2)) r )\[DifferentialD]y,Background->LightRed];
(*Total shaded area=Yellow area+Red and Blue areas*)
shadedArea2=FullSimplify[yellowArea2 [[1,1,2]]+ redArea2[[1,1,2]]];

(* Solution3 *)
(*Integrate from the lower curve to the upper curve then add the two segments *)
yellowArea3:=HoldForm[Yellow area3=2(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-x^2]))-( r -  (Sqrt[2 (r^2)-x^2])) )\[DifferentialD]x]==Framed[2(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-x^2]))-( r -  (Sqrt[2 (r^2)-x^2])) )\[DifferentialD]x,Background->LightYellow];
redArea3:=HoldForm[Red and Blue  areas =4(∫_((((Sqrt[3])-1)r)/2)^(((Sqrt[2])-1)r))(  (Sqrt[2 (r^2)-(x+r)^2]))\[DifferentialD]x]==Framed[Quiet[4(∫_((((Sqrt[3])-1)r)/2)^(((Sqrt[2])-1)r))(  (Sqrt[2 (r^2)-(x+r)^2]))\[DifferentialD]x],Background->LightRed];
shadedArea3 = FullSimplify[yellowArea3[[1,1,2]] + Quiet[redArea3[[1,1,2]]]];

Column[{
Item[
Which[sol==3,Style[Row[{"\nYellow area3 = 2(∫_0^((((Sqrt[3]) - 1) r)/2))((- r + \!\(\*SqrtBox[\(2\\ \*SuperscriptBox[\(r\), \(2\)] - x^2\)]\))-( r - \!\(\*SqrtBox[\(2\\ \*SuperscriptBox[\(r\), \(2\)] - x^2\)]\)) )\[DifferentialD]x = ",
Framed[2(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-x^2]))-( r -  (Sqrt[2 (r^2)-x^2])) )\[DifferentialD]x,Background->LightYellow],"\nRed and Blue area = 4(∫_((((Sqrt[3]) - 1) r)/2)^(((Sqrt[2]) - 1) r))(  \!\(\*SqrtBox[\(2\\ \*SuperscriptBox[\(r\), \(2\)] - \((x + r)\)^2\)]\))\[DifferentialD]x]",Framed[Quiet[4(∫_((((Sqrt[3])-1)r)/2)^(((Sqrt[2])-1)r))(  (Sqrt[2 (r^2)-(x+r)^2]))\[DifferentialD]x],Background->LightRed],"\nTotal shaded area = ",shadedArea3,"\n"}],12,Bold,Purple],sol==2,Style[Row[{"\nYellow area =4(∫_0^((((Sqrt[3]) - 1) r)/2))(- r + \!\(\*SqrtBox[\(2\\ \*SuperscriptBox[\(r\), \(2\)] - x^2\)]\))\[DifferentialD]x = ",Framed[4(∫_0^((((Sqrt[3])-1)r)/2))(- r +  (Sqrt[2 (r^2)-x^2]))\[DifferentialD]x,Background->LightYellow],"\nRed and Blue  areas = 4(∫_0^((((Sqrt[3]) - 1) r)/2))((- r + \!\(\*SqrtBox[\(2\\ \*SuperscriptBox[\(r\), \(2\)] - y^2\)]\)) - ((((Sqrt[3]) - 1)/2)) r )\[DifferentialD]y = ",Framed[4(∫_0^((((Sqrt[3])-1)r)/2))((- r +  (Sqrt[2 (r^2)-y^2])) - ((((Sqrt[3])-1)/2)) r )\[DifferentialD]y,Background->LightRed],"\nTotal shaded Area = ",shadedArea2,"\n"}],12,Bold,Purple],
sol==1,Style[Row[{"\nShaded area = Area of segment + area of the square = ",requiredArea1,"\n"}],12,Bold,Purple],True,
Style["Show that the shaded area = ((π/3) + 1 -(Sqrt[3]) ) (2 (r^2)) \n Where r = radius of circle\n",16,Purple, Bold]],Alignment->Left,Frame->True],
Item[
p0=Plot[{(Sqrt[r^2-x^2]),-(Sqrt[r^2-x^2])},{x,-r,r},PlotStyle->{{Thick,Black},{Thick,Black}},Axes->True,AxesOrigin->{0,0}];
p1=Plot[{(Sqrt[2  r^2 -(x-r)^2]),-(Sqrt[2  r^2 -(x-r)^2])},{x,r-r(Sqrt[2]),0},PlotStyle->{{Thick,Blue},{Thick,Blue}}];

p2=Plot[{(Sqrt[2  r^2 -(x+r)^2]),-(Sqrt[2  r^2 -(x+r)^2])},{x,0,r(Sqrt[2])-r},PlotStyle->{{Thick,Red},{Thick,Red}}];
p3=Plot[{-r +(Sqrt[2 r^2-x^2]),-r-(Sqrt[2 r^2-x^2])},{x,-r ,r},PlotStyle->{{Thick,Orange},{Thick,Orange}}];
p4=Plot[{-r +(Sqrt[2 r^2-x^2]),r-(Sqrt[2 r^2-x^2])},{x,-r ,r},PlotStyle->{{Thick,Orange},{Thick,Orange}}];
p5=Plot[{(Sqrt[2  r^2 -(x+r)^2]),-(Sqrt[2  r^2 -(x+r)^2])},{x,(r/2)((Sqrt[3])-1),r(Sqrt[2])-r},Filling->{1->{2}},FillingStyle->Lighter[Red],PlotStyle->{{Thick,Red},{Thick,Red}}];
p6=Plot[{-r +(Sqrt[2 r^2-x^2]),r-(Sqrt[2 r^2-x^2])},{x,(r/2)(1-(Sqrt[3])) ,(r/2)((Sqrt[3])-1)},Filling->{1->{2}},FillingStyle->Yellow,PlotStyle->{{Thick,Orange},{Thick,Orange}}];
p7=Plot[{(Sqrt[2  r^2 -(x-r)^2]),-(Sqrt[2  r^2 -(x-r)^2])},{x,r-r(Sqrt[2]),(r/2)(1-(Sqrt[3]))},PlotStyle->{Thick,Blue},Filling->{1->{2}},FillingStyle->Lighter[Blue],PlotStyle->{{Thick,Red},{Thick,Red}}];
gslice=Graphics[{EdgeForm[{Thick,Blue}],FaceForm[Red],Polygon[{{0.1 r,0},{0.1 r,-r +(Sqrt[2 r^2 -(0.1 r )^2])},{0.14 r,-r +(Sqrt[2 r^2 -(0.14 r )^2])},{0.14 r,0}}]}];
gslice3=Graphics[{EdgeForm[{Thick,Blue}],FaceForm[Red],Polygon[{{0.1 r,r -(Sqrt[2 r^2 -(0.1 r )^2])},{0.1 r,-r +(Sqrt[2 r^2 -(0.1 r )^2])},{0.14 r,-r +(Sqrt[2 r^2 -(0.14 r )^2])},{0.14 r,r -(Sqrt[2 r^2 -(0.14 r )^2])}}]}];

(* solution 1 *) psol1=Plot[{(Sqrt[2r^2-(x+r)^2]),-(Sqrt[2r^2-(x+r)^2]),x,-x},{x,-0.7r,0.7r},AspectRatio->1];
gsol1=Graphics[{Circle[{0,0},r],PointSize[0.02],Point[r{(Sqrt[2])-1,0}],Point[ r{(((Sqrt[3])-1)/2),(((Sqrt[3])-1)/2)}],Point[r {(((Sqrt[3])-1)/2),-(((Sqrt[3])-1)/2)}],Text[Style[TraditionalForm[r {(Sqrt[2])-1,0}],12,Black,Italic],{((Sqrt[2])-1) r+0.3,0.0}],Text[Style[TraditionalForm[r {(((Sqrt[3])-1)/2),(((Sqrt[3])-1)/2)}],12,Black,Italic],r {(((Sqrt[3])+0.2)/2),(((Sqrt[3])-1)/2)}],Text[Style[TraditionalForm[r {(((Sqrt[3])-1)/2),((-((Sqrt[3])-1))/2)}],12,Black,Italic],r{(((Sqrt[3])+.1)/2),((-((Sqrt[3])-1))/2)}],
Yellow,Rectangle[r {-((((Sqrt[3])-1)/2)),-((((Sqrt[3])-1)/2))},r {((((Sqrt[3])-1)/2)),((((Sqrt[3])-1)/2))}],{Opacity[0.7,Green],Polygon[{{-r,0},r {(((Sqrt[3])-1)/2),(((Sqrt[3])-1)/2)},r{(((Sqrt[3])-1)/2),-(((Sqrt[3])-1)/2)}}]},{FaceForm[Yellow,Opacity[0.1]],EdgeForm[{Thick,Blue}],Disk[{-r,0},0.3 r,{-π/12,π/12}]},Text[Style[StandardForm[π/6],14,Black,Italic],{-0.6 r,0}]


},Axes->True,AspectRatio->Automatic];
psoln1=Plot[{(Sqrt[2  r^2 -(x+r)^2]),-(Sqrt[2  r^2 -(x+r)^2])},{x,(r/2)((Sqrt[3])-1),r(Sqrt[2])-r},Filling->{1->{2}},FillingStyle->Lighter[Red],PlotStyle->{{Thick,Red},{Thick,Red}}];
Which[sol==3,Show[p0,p1,p2,p3,p4,p5,p6,p7,gslice3,AspectRatio->Automatic,ImageSize->Medium],
sol==2,Show[p0,p1,p2,p3,p4,p5,p6,p7,gslice,AspectRatio->Automatic,ImageSize->Medium],sol==1,Show[gsol1,psol1,psoln1,AspectRatio->Automatic,ImageSize->Medium],sol==0,
Show[p0,p1,p2,p3,p4,p5,p6,p7,AspectRatio->Automatic(*PlotRange->{{-5,5},{-5,8}}*),ImageSize->Medium]],Alignment->{Center},Frame->True]
}],
Row[{Control[
{{r,1, "radius"},1,4,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],
Control[{{sol,0,"Prblm"},{0->"",1->"soln1",2->"soln2",3->"soln3"},ControlType->RadioButtonBar}]}],TrackedSymbols:>{r,sol},SaveDefinitions->True]]

What Time is it now ?

( based on mathematical problem from Mathematical Brain - Teasers  1976 by J.A.H. Hunter, ISBN: 0 - 486 - 23347 - 2)

ClearAll["Global`*"];

Framed[Module[{m,k,hr,n,Answer},Manipulate[

t:=(60 - m + k n )/(k+1);

Item[If[Answer,Style[Row[{Style["\nThe time is ",Italic],
Which[hr==1,Row[{Style["12",Purple,Italic],Style[" : ",Italic],Style[t,Italic],Style[" AM",Italic]}],
hr==13,Row[{Style["12",Purple,Italic],Style[" : ",Italic],Style[t,Italic],Style[" PM",Italic]}],

hr≤12,Row[{Style[hr - 1,Purple,Italic],Style[" : ",Italic],Style[t,Italic],Style[" AM",Italic]}],True,Row[{Style[hr - 13,Italic],,Style[" : ",Italic],Style[t,Italic],Style["  PM \n",Italic]}]
]
}],16,Purple],

Style[Row[{Style["\n              What time is it now ?\n",Red],Style["\n In ",Black],Style[m,Black],Style[" minute's time it will be ",Black],If[k==2,Style["twice",16,Black,Italic],Row[{Style[ k,Black,Italic],Style[" times ",Black,Italic]}]],Style[" as many minutes short of ",Italic],

Which[hr==1,Row[{Style["1:00 AM. \n as it was past",Italic],Style[" 12:00 A.M. ",Black,Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}],
hr==12,Row[{Style[hr,Italic,Black],Style[":00  ",Italic],Style[" Noon ",Italic],Style[" as it was past ", Italic,Black],Style[hr - 1,Italic],Style[":00",Italic],Style[" AM  ",Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}],

hr==13,Row[{Style[hr-12,Italic],Style[":00",Italic],Style[" PM  ",Italic],Style["\n as it was past",Italic],Style[" 12:00 Noon ",Black,Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}],

hr==24,Row[{Style[hr-12,Italic],Style[":00 A.M. ",Black,Italic],Style["\n as it was past ",Italic],Style[hr-13,Italic],Style[" P.M. ",Black,Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}],
hr<12,Row[{Style[hr,Italic,Black],Style[":00",Italic],Style[" AM",Italic],Style[" as it was past ", Italic,Black],Style[hr - 1,Italic],Style[":00",Italic],Style[" AM  ",Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}],hr>12,Row[{Style[hr - 12,Italic],Style[" :00 ",Italic],Style["PM \n",Italic],Style[" as it was past ", Italic,Black],Style[hr - 13,Italic],Style[":00",Italic],Style[" PM  ",Italic],Style[n,Italic],Style[" minutes ago.\n",Italic]}]
]

}],16]],Alignment->{Center},Frame->True]
,
Grid[{{Control[
{{m,2, "In m minutes"}, 1,10,1,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{k,2, "as many"}, 2,10,1,ImageSize->Tiny,Appearance->"Labeled"}],Control[{{hr,1, "O'Clock"}, 1,24,1,ImageSize->Tiny,Appearance->"Labeled"}]},{Control[
{{n,25, "past minutes"}, 1,42,1,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{Answer,False,"Answer"},{False,True}}]}}],
TrackedSymbols->{m,k,hr,n,Answer},ContentSize->{500,200},SaveDefinitions->True]]
,FrameMargins->9,Background->RGBColor[0,0.6,1]]