Project Ideas with Wolfram Language

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

Abraham Gadalla
abegadalla@yahoo.com
763 420 3875

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}]

Expand (((a+b))^n) and Factor (a^n)+ (b^n)

ClearAll["Global`*"];

Clear[a];Clear[b];Clear[fun];Clear[n];
Manipulate[
Block[{a,b},If[fun,
Style[Row[{TraditionalForm[(a + b )^n]," = ",Expand[f[a,b,n]]}],16,Bold],
Style[Row[{TraditionalForm[ (a^n) + (b^n) ]," = ",Factor[g[a,b,n]]}],16,Bold]]],
{{fun,True,""},{True->Style["( a + b )^n",20,Background->Yellow],False->Style["(a^n)+(b^n)",20,Background->Yellow]},Setter},
{{n,2,"n"},1,40,1,Appearance->"Labeled"},TrackedSymbols->{fun,n},ContentSize->{600,200},Initialization:>{f[a_,b_,c_]:=Expand[(((a + b ))^c)];
g[a_,b_,c_]:=Factor[(a^c) + (b^c)];},SaveDefinitions->True]

Illustrating the difference between two squares
  (a^2) - (b^2)  = ( a - b ) ( a + b )

Manipulate[
	(*Length of Yellow Rectangle*)
	a = 4;
	If[z<b,z=b];
	Graphics[{
	(*Draw Yellow rectangle*)
	EdgeForm[{Thick,Dashed,Black}],Yellow,(*Rectangle[{0,0},{a,a}],*)Polygon[{{b,0},{a,0},{a,a},{0,a},{0,b},{b,b}}],
	(*Draw Pink rectangle*)
	Pink,Rectangle[{0,0},{b,b}],
Text[Style["(b^2)",16,Bold,Black,"TraditionalForm"],{b/2,b/2}],
If[divide,{{Dashed,Thick,Black,Line[{{b,b},{b,a}}]}(*,
RGBColor[0,0.6,1],Rectangle[{0,b},{b,a}]*)}],

{Black,Line[{{0,0},{0,-1}}],Line[{{b,0},{b,-0.6}}],Line[{{a,0},{a,-1}}],Line[{{a,0},{a+0.7,0}}],
Line[{{a,a},{a+0.7,a}}],
Line[{{0,0},{-0.7,0}}],Line[{{0,b},{-0.7,b}}],
Line[{{0,a},{-0.7,a}}],


Arrowheads[{-0.03,0.03}],
Arrow[{{0,-0.9},{a,-0.9}}],Arrow[{{0,-0.5},{b,-0.5}}],Arrow[{{b,-0.5},{a,-0.5}}],Arrow[{{a+0.5,0},{a+0.5,a}}],
Arrow[{{-0.5,0},{-0.5,b}}],Arrow[{{-0.5,b},{-0.5,a}}],


Text[Style[" a ",16,"TraditionalForm"],{a/2,-0.7}]},

If[move,

	{If[z==b,EdgeForm[White],EdgeForm[{Black}]],
	RGBColor[0,0.6,1],Rectangle[{b,a},{z,a+b}],
	RGBColor[0,0.6,1],Rectangle[{0,z},{b,a}],Black,Rotate[Text[Style["(a^2) - (b^2)",16,Bold,"TraditionalForm"],{(a+b)/2,0.75 a }],π/2]
      ,{White,Rectangle[{0,b},{b,z}]}}
     ,{Black,Text[Style["(a^2) - (b^2)",16,Bold,"TraditionalForm"],{2a/3,0.85a }]}],
If[dimensions,
{Black,Line[{{a,0},{a+1,0}}],

Line[{{z,a+ b},{a+1,a+ b}}],Line[{{a,a},{a+0.5,a}}],
Arrowheads[{-0.03,0.03}],Arrow[{{a+0.95,0},{a+0.95,a+b}}],

Arrow[{{a+0.5,a},{a+0.5,a+b}}],Arrow[{{b,-0.5},{a,-0.5}}],
Text[Style["b",16,"TraditionalForm"],{a+.3,a+.5b}],
Rotate[Text[Style["a + b",16,"TraditionalForm"],{a+0.9,.5(a+b)}],π/2]

},
{Black,Line[{{0,0},{0,-1}}],Line[{{b,0},{b,-0.6}}],Line[{{a,0},{a,-1.}}],Arrowheads[{-0.03,0.03}],
Arrow[{{b,-0.5},{a,-0.5}}]
}
],{},
{Dashing[0.01],RGBColor[0.2,0.2,0.8],Line[{{0,b},{0,a}}],Line[{{0,a},{b,a}}]},

Black,
Text[Style["a",16,"TraditionalForm"],{a+.3,.5a}],
Text[Style["b",16,"TraditionalForm"],{.5b,-.35}],
Rotate[Text[Style["b",16,"TraditionalForm"],{-0.7,.5b}],π/2],
Text[Style["a - b",16,"TraditionalForm"],{b+.5(a-b),-0.35}],
Rotate[Text[Style["a - b",16,"TraditionalForm"],{-.7,b+.5(a-b)}],π/2],Text[Style["(b^2)",16,Bold,"TraditionalForm"],{b/2,b/2}]

},PlotLabel->If[dimensions,Style["(a^2)- (b^2) = \n ( a - b ) a + ( a - b) b = \n ( a - b ) ( a + b )",16,"TraditionalForm"]],
ImageSize->{300,400},
            PlotRange->{{-2,6},{-2,7.5}},Axes->False
	],
Grid[{{Control[
{{b,1,"Red Rectangle (b)"},0,3.,ImageSize->Tiny,Appearance-> "Labeled"}],Control[{{divide,False,"Divide"},{False,True}}]},{Control[
{{z,b,"Blue Rectangle (z)"},b,a,ImageSize->Tiny,Appearance->"Labeled"}],Control[{{move,False,"Move Rect"},{False,True}}],Control[{{dimensions,False,"Dimensions"},{False,True},Enabled->move}]}}],SynchronousUpdating->True
]

Expand (((a-b))^n) and Factor (a^n)- (b^n)

ClearAll["Global`*"];

DynamicModule[{fun1,n},Manipulate[
Clear[a];Clear[b];
If[fun1,
Style[Row[{TraditionalForm[(a - b )^n,n]," = ",Expand[f1[a,b,n]]}],16,Bold],
Style[Row[{TraditionalForm[ (a^n) - (b^n) ,n]," = ",Factor[g1[a,b,n]]}],16,Bold]],
{{fun1,True,""},{True->Style["( a - b )^n",20,Background->Yellow],False->Style["(a^n) - (b^n)",20,Background->Yellow]},Setter},
{{n,2,"n"},1,40,1,Appearance->"Labeled"},TrackedSymbols->{fun1,n},ContentSize->{600,200},Initialization:>{f1[a_,b_,c_]:=(((a - b ))^c);
g1[a_,b_,c_]:=(a^c) - (b^c);}, SaveDefinitions->True]]

Illustrating the absolute value in a two coordinate system

Definitions :

The absolute value of a real number x, represented by the symbol | x |, is given by :
		({{{, ({{x, if x > 0}, {0
-x, if x = 0
if x <0}})}})

The following plot illustrate the above definition :

pAbs=Plot[Abs[x],{x,-6,6},PlotStyle->{Thick,Blue},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]}},
GridLines->{Range[-6,8,2],Range[-6,8,2]},Ticks->{Range[-8,8,2],Range[-8,8,2]},PlotRange->{{-8,8},{-4,8}},

Ticks->{{-6,-4,-2,0,2,4,6},{-6,-4,-2,0,2,4,6,8}}];
garrows=Graphics[{Blue,Arrow[{{5.7,5.7},{6,6}}],Arrow[{{-5.7,5.7},{-6,6}}],Text[Style["y = | x |" ,18 ,Thick, Blue],{2,6.3}]
}];
Show[pAbs,garrows]

Horizontal Translation of the absolute value of x

The following program illustrates the two coordinate graph of the absolute value

ClearAll["Global`*"];

Manipulate[Plot[Tooltip[{Abs[x],Abs[x-a]}],{x,-10,10},PlotStyle->{{Thick,Blue},{Thick,Purple}},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]}},
GridLines->{Range[-10,10,2],Range[-6,10,2]},Ticks->{Range[-8,8,2],Range[-8,8,2]},PlotRange->{{-10,10},{-4,10}},

Ticks->{{-10,-8,-6,-4,-2,0,2,4,6,8,10},{-6,-4,-2,0,2,4,6,8,10}}],
{{a,-3,"Displacement"},-5,5,1,Appearance->"Labeled"},TrackedSymbols:>a]

Solving Equations involving Absolute values

Solving equations involving adding or subtracting two absolute values :
Example1: Find all real values of x that satisfy:  | x |  -  |x + 3| = 3,
Example2: Find all real values of x that satisfy:  | x |  +  |x + 3| = 3.

ClearAll["Global`*"];

Manipulate[
answer1=Reduce[Abs[x]-Abs[x-a]==a,x ∈ Reals];
answer2=Reduce[Abs[x]+Abs[x-a]==a,x ∈ Reals];
Column[{
Item[

Which[example1&&showsol1,Style[Row[{Style["Solve: | x | - | x ",Black],If[a<0,Style["+ ",Black],Style["- "],Black],Style[Abs[a],Black],Style[" | = ",Black],Style[ a,Black],"\nSolution: ",answer1,"\n"}],18,Purple],
example2&&showsol2,Style[Row[{Style["Solve: | x | + | x ",Black],If[a<0,Style["+ ",Black],Style["- ",Black]],Style[Abs[a],Black],Style[" | = ",Black],Style[ a,Black],"\nSolution: ",answer2,"\n"}],18,Purple],
example2,Style[Row[{"\nSolve: | x | + | x ",If[a<0,"+ ","- "],Abs[a]," | = ",a,"\n"}],18,Black],
True,Style[Row[{"\nSolve: | x | - | x ",If[a<0,"+ ","- "],Abs[a]," | = ",a,"\n"}],18,Black]],Alignment->{Center},Frame->True,ItemSize->{27,3}],

Item[

pltTranslate=Plot[Tooltip[{Abs[x],Abs[x-a]}],{x,-10,10},PlotStyle->{{Thick,Blue},{Thick,Purple}},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]}},
GridLines->{Range[-10,10,2],Range[-6,10,2]},Ticks->{Range[-8,8,2],Range[-8,8,2]},PlotRange->{{-10,10},{-4,10}},
Ticks->{{-10,-8,-6,-4,-2,0,2,4,6,8,10},{-6,-4,-2,0,2,4,6,8,10}}];

px1=Plot[Tooltip[Abs[x]-Abs[x-a]],{x,-10,10},PlotStyle->{Thick,Darker[Green]}];
graphsol1=If[a<0,Graphics[{Thick,Red,Arrowheads[0.05],Arrow[{{0,a},{10,a}}]}],Graphics[{Thick,Red,Arrowheads[0.05],Arrow[{{a,a},{10,a}}]}]];
px2=Plot[Tooltip[Abs[x]+Abs[x-a]],{x,-10,10},PlotStyle->{Thick,Darker[Green]}];

graphsol2=If[a<0,Graphics[{Text[Style["No Solution",16,Red],{-4,10}]}],Graphics[{Thick,Red,Arrowheads[{-0.04,0.04}],Arrow[{{0,a},{a,a}}]}]];

Which[example1&&hint1&&showsol1,Show[pltTranslate,px1,graphsol1,ImageSize->Medium],
example1&&hint1,Show[pltTranslate,px1,ImageSize->Medium],
example1&&showsol1,Show[pltTranslate,graphsol1,ImageSize->Medium],
example2&&hint2&&showsol2,Show[pltTranslate,px2,graphsol2,ImageSize->Medium],
example2&&hint2,Show[pltTranslate,px2,ImageSize->Medium],example2&&showsol2,Show[pltTranslate,graphsol2,ImageSize->Medium],True,Show[pltTranslate,ImageSize->Medium]]
,Alignment->{Center},Frame->True]
}],
{{a,3,"Displacement"},-5,22
,1,Appearance->"Labeled"},
Row[{Control[
{{example1,True,"example1"},{True,False},Enabled->!example2}],Spacer[10],Control[
{{hint1,False,"hint1"},{True,False},Enabled->!hint2}],Spacer[10],

Control[{{showsol1,False,"Graph sol1"},{False,True},Enabled->!hint2}],Spacer[20],

Control[
{{example2,False,"example2"},{False,True},Enabled->!example1}],Spacer[10],Control[
{{hint2,False,"hint2"},{True,False},Enabled->!hint1}],Spacer[10],Control[{{showsol2,False,"Graph Sol2"},{False,True},Enabled->!hint1}]}],


TrackedSymbols:>{a,example1,hint1,showsol1,example2,hint2,showsol2},SaveDefinitions->True]

Cookies for All

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

If[answer,Style[Row[{Spacer[30],"\na) Andy bought ",numberCookies4," Cookies\nb) If there are ", n+1," 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 Aiden 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+1, 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, 4, "Total Siblings"},4,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",Style["\nLength of a row = ",18,Blue,Italic],lengthOfRow," feet",Spacer[2]," = ",lengthOfRow/3, " Yards\n"}],20,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]]

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}]]

Necklace w. different colors and different sizes  (Comparing Parabola and Hyperbolic functions )

ClearAll["Global`*"];

Manipulate[Block[{circ,c,xs1,gcl},
circ[center_,radius_]:={Circle[center,radius],Black,PointSize[0.01],Point[center]};
colorByIndex[i_]:=ColorData[clrf]@First@i;
colrtByIndex[j_]:=ColorData[clrt]@Last@j;

diskf[center_,radius_,index_]:=Join[{colorByIndex@index,Disk[center,radius],Red},circ[center,radius]];
diskrt[center_,radius_,index_]:=Join[{colrtByIndex@index,Disk[center,radius],Red},circ[center,radius]];
f[x_]:=ah Cosh[x/ah];
ph=Plot[f[x],{x,-9.5,9.5},AspectRatio->Automatic,PlotRange->{-1,21},Axes->False];
gh=Quiet[Graphics[{
{Arrowheads[0.03],Arrow[{{ah ArcCosh[20/ah],20},{ah ArcCosh[21/ah],21}}],Arrow[{{-ah ArcCosh[20/ah],20},{-ah ArcCosh[21/ah],21}}]},

{diskf[{-x,f[x]},r,IntegerDigits[ clrf]],diskrt[{x,f[x]},r,IntegerDigits[clrt]]}/.NestList[{FindRoot[EuclideanDistance[{x,f@x}/.#[[1]],{x,f@x}]==#[[2]]+ratio #[[2]],{x,x/.#[[1]],(x+1/2)/.#[[1]]}],ratio #[[2]]}&,{{x->0.},1.},m]/.{{{xr_Rule},rd_?NumericQ}:>{xr,Rule[r,rd]}}

},PlotRange->{{-11,11},{-1,17}},Axes->False
]];
Off[ReplaceAll::rmix];


(* Show the exponent curve ap x^p *)

g[x_]:=ap (x^p);
pc=Plot[{ap (x^p)},{x,-14.5,14.5},AspectRatio->Automatic,Axes->False,

PlotLabel->Style[Framed[Row[{Style["(Subscript[y, 1]) = ",16],Style[TraditionalForm[ah Cosh[(x/ah)]],16],Style["         (Subscript[y, 2]) = ",16],Style[TraditionalForm[ap x^p],16]}]],Black,Background->Lighter[Yellow]],PlotRange->{{-8.5,8.5},{-3,25}}];
gc=Quiet[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}}]},

{diskf[{-x,g[x]},r,IntegerDigits[7+ x]],diskf[{x,g[x]},r,IntegerDigits[x]]}/.NestList[{FindRoot[EuclideanDistance[{x,g@x}/.#[[1]],{x,g@x}]==#[[2]]+ratio #[[2]],{x,x/.#[[1]],(x+1/2)/.#[[1]]}],ratio #[[2]]}&,{{x->0.},1},m]/.{{{xr_Rule},rd_?NumericQ}:>{xr,Rule[r,rd]}}

},PlotRange->{{-8.5,8.5},{-3,25}},Axes->False
]];
If[parab,
Show[pc,gc,ph,gh,ImageSize->Medium,PlotRange->All],Show[ph,gh,ImageSize->Medium,PlotRange->All]]],

Delimiter,
Style["Choose your Colors",14],
{{clrf,47,"Left color"},1,92,1,Appearance->"Labeled"
,ImageSize->Tiny},
{{clrt,51,"Right color"},1,92,1,Appearance->"Labeled"
,ImageSize->Tiny},
Delimiter,
Style["Shape of Necklace",14],
{{ah,2.2,""},0.1,5,0.1,Appearance->"Labeled"
,ImageSize->Tiny},
Delimiter,
Style["Number of Pearls",14],
{{m,15,""},1,17,1,ImageSize->Tiny,Appearance->"Labeled"},
Delimiter,
Style["Ratio bet. two Radii",14],
{{ratio,0.93,""},0.75,1.,0.01,ImageSize->Tiny,Appearance->"Labeled"},
Delimiter,
{{parab,True,"Parabola"},{False,True}},
{{ap,0.1,"ap"},0.01,3.,0.01,Appearance->"Labeled",ImageSize->Tiny,Enabled->parab},
{{p,2,"exponent"},2,8,2,Appearance->"Labeled",ImageSize->Tiny},
ControlPlacement->Left,
TrackedSymbols->{m,ratio,clrf,clrt,ah,parab,ap,p},Initialization:>{ClearAll["Global`*"];}]

a Little advanced model in Trig functions

Manipulate[Plot[Vertshift+amplitude function[freq (x-phaseshift)],{x,-π,2π},PlotStyle->{Thick,Blue},AxesOrigin->{0,0},Axes->True,Ticks->{{-π,((-π)/2),0,(π/2),π,((3π)/2),2π},{-6,-4,-2,2,4,6}},TicksStyle->Directive[Black,Bold,14],PlotRange->{{-4,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,ArcSin,ArcCos,ArcTan,ArcCsc,ArcSec,ArcCot}},{{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}]

ClearAll["Global`*"];

Creating multi - assignments from a math League problem

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]

Ratio between areas of circles and area of the encompassing triangle 6-8-2017 (using Table[Table])

Based on a problem by Stewart (Early Transcendentals 5 e Thomson publisher, 2003, Ch. 11, Infinite Seq. and Series Problems Plus # 15 P. 791)

ClearAll["Global`*"];

DynamicModule[{m,rc,answer},Manipulate[disk[center_,radius_]:={EdgeForm[{Thick,Blue}],FaceForm[RGBColor[1,0,1]],Disk[center,radius],PointSize[0.015],Point[center]};
radius[k_]:=1/(k-1+(Sqrt[3]));
areaofcircles[m_]:=π (((radius[m]))^2) m (m+1)/2;
areaoftriangle:=(Sqrt[3]);
ratio[m_]:=((π m (m+1)(((radius[m]))^2))/(2 (Sqrt[3])));
limit=Limit[((π n (n+1)(((radius[n]))^2))/(2 (Sqrt[3]))),n->∞];
Graphics[{If[answer,
Inset[Style[TraditionalForm[Row[{"\!\(\*FractionBox[\(Total\\ area\\ of\\ Circles\), \(Area\\ of\\ Triangle\)]\) = ",ratio[m],"\nLimit [ratio as No. Circles->∞] = ",limit}]],16,Purple,Bold],{0,2}],Inset[Style["\nCalculate the ratio between \nthe total area of disks and the area of triangle\n",16,Black,Italic],{0,2}]], 
{EdgeForm[{Thick,Red}],LightYellow,Polygon[{{rc (Sqrt[3])-1,0},{1 -(Sqrt[3])rc,0},{1-0.5 rc (Sqrt[3]),3 rc/2},{(Sqrt[3])rc/2,(Sqrt[3])-1.5 rc},{-0.5 rc (Sqrt[3]),(Sqrt[3])-1.5 rc},{0.5 rc (Sqrt[3])-1,1.5 rc}}]},{LightYellow,Disk[{(rc (Sqrt[3])-1) ,rc},rc,{5π/6,3π/2}],Disk[{1-rc(Sqrt[3]),rc},rc,{3π/2,13π/6}],Disk[{0,((Sqrt[3])-2 rc) },rc,{π/6,5π/6}]},{Thick,Red,Circle[{(rc (Sqrt[3])-1) ,rc},rc,{5π/6,3π/2}],Circle[{1-rc(Sqrt[3]),rc},rc,{3π/2,13π/6}],Circle[{0,((Sqrt[3])-2 rc) },rc,{π/6,5π/6}]},Table[Table[
disk[{(m+i-2(j+1))radius[m],(1+(Sqrt[3]) (i-1)) radius[m]},radius[m]],{i,j+1}],{j,0,m-1}]},Axes->False,AxesOrigin->{0,0}],Row[{Control[{{rc,0.07,"roundingradius"},0.01,0.3,Appearance->"Labeled",ImageSize->Tiny}],Control[{{m,7,"number of circles"},1,30,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"Answer"},{False,True}}]}],TrackedSymbols->{m,rc,answer}]]

DynamicModule[{m,rc,answer,n},Manipulate[disk[center_,radius_]:={EdgeForm[{Thick,Blue}],FaceForm[RGBColor[1,0,1]],Disk[center,radius],PointSize[0.015],Point[center]};
radius[k_]:=1/(k-1+(Sqrt[3]));pool=Graphics[{{EdgeForm[{Thick,Red}],LightYellow,Polygon[{{rc (Sqrt[3])-1,0},{1 -(Sqrt[3])rc,0},{1-0.5 rc (Sqrt[3]),3 rc/2},{(Sqrt[3])rc/2,(Sqrt[3])-1.5 rc},{-0.5 rc (Sqrt[3]),(Sqrt[3])-1.5 rc},{0.5 rc (Sqrt[3])-1,1.5 rc}}]},{LightYellow,Disk[{(rc (Sqrt[3])-1) ,rc},rc,{5π/6,3π/2}],Disk[{1-rc(Sqrt[3]),rc},rc,{3π/2,13π/6}],Disk[{0,((Sqrt[3])-2 rc) },rc,{π/6,5π/6}]},{Thick,Red,Circle[{(rc (Sqrt[3])-1) ,rc},rc,{5π/6,3π/2}],Circle[{1-rc(Sqrt[3]),rc},rc,{3π/2,13π/6}],Circle[{0,((Sqrt[3])-2 rc) },rc,{π/6,5π/6}]},Table[Table[
disk[{(m+i-2(j+1))radius[m],(1+(Sqrt[3]) (i-1)) radius[m]},radius[m]],{i,j+1}],{j,0,m-1}]},Axes->False];rotPool=Show[pool,Graphics[{Table[Rotate[#,k π/3,{-1,0}],{k,1,n}]},Axes->False]&/@pool,ImageSize->500],Row[{Control[{{rc,0.07,"roundingradius"},0.01,0.3,Appearance->"Labeled",ImageSize->Tiny}],Control[{{m,7,"number of circles"},1,30,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{answer,False,"Answer"},{False,True}}],Control[{{n, 5,"No Rot"},1,5,1,Appearance->"Labeled",ImageSize->Tiny}]}],TrackedSymbols->{m,rc,answer,n}]]

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 of equal lengths.

Proof:
Let 2 a, 2 b, 2 c, and 2 d represent complex numbers running along the edges 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

Framed[DynamicModule[{v,a1,b2,c1,d1,d2,hint,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 PR = QS and perpendicular to it; i.e\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}]},If[hint,{
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)}],Green,PointSize[0.025],Point[{(a1+c1)/2,0.}]}],
{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["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],{d1,d2-0.25}],
(*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[{{hint,False,"hint"},{False,True}}]},{Control[
{{d1,-0.5,"d1"},-0.5,-2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{d2,-1.,"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,hint,d1,d2,answer,theta},SaveDefinitions->True]],
Background->White,FrameStyle->{Thick,Black}]

Given any triangle MON, draw squares on its three sides, then the centers P and Q of two of the squares. Draw segment PQ.  Does PQ always contain M.  The center R of the third square is connected to the opposite vertexM Is QP Congruent to MR and perpendicular to it?

ClearAll["Global`*"];

Framed[DynamicModule[{v,a1,b1,b2,c1,hint,rotCenter,show,theta},Manipulate[

v={{a1,0},{b1,b2},{c1,0}};
lengthA=EuclideanDistance[{(a1+b1-b2)/2,(b1+b2-a1)/2},{(b1+b2+c1)/2,(b2+c1-b1)/2}];
lengthB=EuclideanDistance[{b1,b2},{(c1+a1)/2,(a1-c1)/2}];
slopeA=(a1-2 b1 +c1)/(2 b2+c1-a1);
slopeB=(a1-c1-2 b2)/(a1+c1 - 2 b1);
slopeAB =slopeA slopeB;
Column[{
Item[If[show,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 triangle OMN\n Construct squares on its sides with centers P, Q, and R",14,Black,Italic],Style["\nShow that MR = PQ and perpendicular to it\n",15,Blue,Italic]}]],Frame->True,Alignment->{Left}],

Item[

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

{EdgeForm[{Dashed,Blue}],FaceForm[{Pink,Opacity[0.7]}],
Polygon[{v[[1]],v[[2]],{b1-b2,-a1+b1+b2},{a1-b2,-a1+b1}}],
Polygon[{v[[2]],v[[3]],{c1+b2,c1-b1},{b1+b2,b2+c1-b1}}],
Polygon[{v[[3]],v[[1]],{a1,a1-c1},{c1,a1-c1}}]},
{Red,Line[{v[[1]],{b1-b2,b1+b2-a1}}],Line[{v[[2]],{a1-b2,-a1+b1}}],Line[{v[[3]],{b1+b2,c1+b2-b1}}],Line[{v[[3]],{a1,a1-c1}}],Line[{v[[2]],{c1+b2,c1-b1}}],Line[{v[[1]],{c1,a1-c1}}]},
GraphicsComplex[v,{{FaceForm[Yellow],Polygon[{1,2,3}]},
If[hint,Rotate[{EdgeForm[{Thick,Black}],FaceForm[Red,Opacity[0.5]],Polygon[{{b1,b2},{c1,0.0001},{(c1+a1)/2,(a1-c1)/2}}]},-theta,{(b1+c1)/2,(b2)/2}]],
If[rotCenter,
{Green,PointSize[0.025],Point[{(b1+c1)/2, (b2)/2}]}],
{Arrow[{1,2}],Arrow[{2,3}],Arrow[{3,1}]}}],
{Blue,Thick,Arrow[{{(a1+b1-b2)/2,(b1+b2-a1)/2},{(b1+b2+c1)/2,(b2+c1-b1)/2}}],Arrow[{{b1,b2},{(c1+a1)/2,(a1-c1)/2}}]},Text[Style["P",16,Black,Italic,Bold],{(a1+b1-b2)/2-0.1,(b1+b2-a1)/2+0.2}],
Text[Style["Q",16,Black,Italic,Bold],{(b1+b2+c1)/2,(b2+c1-b1)/2+0.2}],
Text[Style["R",16,Black,Italic,Bold],{(c1+a1)/2+0.2,(a1-c1)/2}-0.15],
Text[Style["M",16,Black,Italic,Bold],{b1,b2+0.2}],
Text[Style["N",16,Black,Italic,Bold],{(c1)+0.15,(0.001)}],
Text[Style["A",20,Blue,Italic,Bold],{(b1+b2+c1)/2-0.4,(b2+c1-b1)/2+0.3}],
Text[Style["B",20,Blue,Italic,Bold],{(c1+a1)/2-0.1,(a1-c1)/2+0.4}],
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"},-2.5,0.5,Appearance->"Labeled",ImageSize->Tiny}],Control[{{b1,-2.5,"b1"},-2.5,c1-0.8,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{b2,1.21,"b2"},0.5,2.5,Appearance->"Labeled",ImageSize->Tiny}],Control[{{hint,False,"hint"},{False,True}}]},{Control[
{{c1,2.5,"c1"},0.5,2.5,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{rotCenter,False,"rotCenter"},{False,True}}],
Control[{{theta,0.,"beta"},0,π/2,π/180,Appearance->"Labeled",ImageSize->Tiny}],Control[{{show,False,"show"},{False,True}}]}
}],
TrackedSymbols:>{a1,b1,b2,c1,hint,rotCenter,theta,show},SaveDefinitions->True]],
Background->White,FrameStyle->{Thick,Black}]

Rotating an Equilateral Triangle

ClearAll["Global`*"];

Manipulate[With[{q=Quotient[θ,(2/3)π],m=Mod[θ,(2/3)π]},Show[{Graphics[{PointSize[0.02],If[θ>2π/3,Red,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 Day\n",16,Purple],{1.5,.3}],Inset[Image[],{1.5,-0.9}]},{}]},
Axes->{False,False},PlotRange->{{-1,5.7},{-3,2}},ImageSize->750],

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->750],{}],
(* 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->750],

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->750]
}]],{{θ,0,"Rotation angle θ"},0,2Pi,Appearance->"Labeled"},
TrackedSymbols->{θ},Initialization:>{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]};}]

Rotating a rectangle about a center of a square.

Calculate the common area between a square and a rectangle whose vertex is at the center of the square.

ClearAll["Global`*"];

DynamicModule[{θ,hint,answer},Manipulate[
If[answer,θ=0,θ];
Column[{
Item[
Which[answer,Style["\nCommon area = (1/4) of area of square = 1 (in^2)\n",16,Purple],hint,Style["\n rotate the rectangle until its sides coinside with the square's diagonals ( θ = 0 )\n",14, Blue],True,Style["Calculate the common area bet. the square and \nthe rectangle if the square's side = 2 and the rctangle has length 3(Sqrt[2]) and width 1.5(Sqrt[2])\n",14,Black]
],Frame->True,Alignment->Left],
Item[

Graphics[{
{EdgeForm[{Thick,Black}],FaceForm[White],Rectangle[{-1,-1},{1,1}]},Which[θ<0.,{EdgeForm[{Thick,Black}],FaceForm[{Red,Opacity[0.9]}],Polygon[{{0,0},{1,Tan[π/4+θ]},{1,-1},{Tan[π/4+θ],-1}}]},θ>0,{EdgeForm[{Thick,Black}],FaceForm[{Red,Opacity[0.9]}],Polygon[{{0,0},{1,Tan[π/4-θ]},{1,1},{Tan[π/4-θ],1}}]}],

If[answer,{{EdgeForm[{Thick,Blue}],FaceForm[{Yellow,Opacity[0.5]}],Polygon[{{0,0},{1.5,1.5},{4.5,-1.5},{3,-3}}]},{EdgeForm[{Thick,Blue}],FaceForm[{Red,Opacity[0.8]}],Polygon[{{0,0},{1,1},{1,-1}}]}
},Rotate[{EdgeForm[{Thick,Blue}],FaceForm[{Yellow,Opacity[0.5]}],Polygon[{{0,0},{1.5,1.5},{4.5,-1.5},{3,-3}}]},θ,{0,0}]
],
If[hint,
Which[θ<0.,{EdgeForm[{Thick,Blue}],FaceForm[{Red,Opacity[0.8]}],Polygon[{{0,0},{1,1},{1.,Tan[π/4+θ]}}],Polygon[{{0,0},{1,-1},{Tan[π/4+θ],-1}}]},θ==0.,{EdgeForm[{Thick,Blue}],FaceForm[{Red,Opacity[0.8]}],Polygon[{{0,0},{1,1},{1,-1}}]},θ>0.,
{EdgeForm[{Thick,Blue}],FaceForm[{Red,Opacity[0.8]}],Polygon[{{0,0},{1,1},{Tan[π/4-θ],1}}],Polygon[{{0,0},{1,-1},{1,-Tan[π/4-θ]}}]}
]
]},AxesOrigin->{0,0},Axes->True,ImageSize->Medium,PlotRange->{{-1.5,5},{-4.5,2.7}}]
,Frame->True,Alignment->{Center}]
}],
Row[{
Control[{{θ,-π/10.,"rot.Angle"},-π/4.,π/4.,Appearance->"Labeled",ImageSize->Tiny",Enabled->hint"}],
Spacer[30],Control[{{hint,False,"hint"},{False,True}}],Spacer[30],Control[
{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{θ,hint,answer}]]

General case of interior area

ClearAll["Global`*"];

DynamicModule[{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,

PlotLabel->PopupMenu[Dynamic[n],{3->Style["\nTriangle\n",20],4->Style["\nQuadrilateral\n",20],5->Style["\nPentagon\n",20],6->Style["\nHexagon\n",20],7->Style["\nHeptagon\n",20],8->Style["\nOctagon\n",20],9->Style["\nNonagon\n",20],10->Style["\ndDecagon\n",20],11->Style["\nHendecagon\n",20],12->Style["\nDodecagon\n",20],13->Style["\nTriskaidecagon\n",20],14->Style["\nTetrakaidecagon\n",20],15->Style["\nPentakaidecagon\n",20],16->Style["\nHexakaidecagon\n",20],17->Style["\nHeptakaidecagon\n",20],18->Style["\nOctakaidecagon\n",20],19->Style["\nEnneakaidecagon\n",20],20->Style["\nIcosagon\n",20],21->Style["\nIcosikaihenagon\n",20],22->Style["\nIcosikaidigon\n",20],23->Style["\nIcosikaitrigon\n",20],24->Style["\nIcosikaitetragon\n",20],25->Style["\nIcosikaipentagon\n",20],26->Style["\nIcosahexagon\n",20],27->Style["\nIcosaheptagon\n",20],28->Style["\nIcosaoctagon\n",20],29->Style["\nIcosaenneagon\n",20],30->Style["\nTriacontagon\n",20]}]


]
,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",18->"octakaidecagon",19->"enneakaidecagon",20->"icosagon",21->"icosikaihenagon",22->"icosikaidigon",23->"icosikaitrigon",24->"icosikaitetragon",25->"icosikaipentagon",26->"icosahexagon",27->"iicosaheptagon",28->"icosaoctagon",29->"icosaenneagon",30->"triacontagon"}]]
,Frame->True,Alignment->{Center}]
}],
Row[{Control[{{n,3,"polygon"},3,30,1,PopupMenu}],
,Spacer[90],Control[{{answer,False,"answer"},{False,True}}]}],TrackedSymbols:>{n,answer},SaveDefinitions->True]]

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

Example 1

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];
)
]

Designing the New YMCA Logo

ClearAll["Global`*"];

Manipulate[
Module[{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,"up/down"},{-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]}]

}]

YMCA LOGO in a circle and in an Ellipse

Manipulate[


(*Module[{chopedarea1,chopedarea2,shadedarea,line1,verticescoord,darrows,line2,segmentcoord,cir,cnr, an,gp,rect},*)
dummyr1 = rl;
(*ypr:=1.125 b c (Sqrt[3])-b c/16;*)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])}}]
}];
(* Reflecting Line *)
prl:=ParametricPlot[{rl,t},{t,(h  +1.125 )(Sqrt[3]) b c-0.125 b c,0},PlotStyle->{Dashing[0.02],Red,Thick}];
(* Graphing the triangle *)
gp:=Graphics[{EdgeForm[{Thick,Blue}],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->False,AxesOrigin->{0,0}];

(* Reflecting the Triangle *)
gpyr:=Graphics[{RGBColor[0,0.6,1],Opacity[0.6],
Polygon[{{2 rl-(1-(Sqrt[3])/8) b c,0},{2 rl-(-1+(Sqrt[3])/8) b c,0},{2 rl -(-1+(Sqrt[3])/16) b c,3 b c / 16},
{2 rl -(-b c (Sqrt[3])/16),((Sqrt[3])-3/16
) b c},{2 rl -(Sqrt[3]) b c/16,((Sqrt[3]) - 3/16) b c},{2 rl- (1 - (Sqrt[3])/16)b c, 3 b c/16}}],
Disk[{2 rl-(-b c+(Sqrt[3]) b c/8),b c/8},b /8,{ π/2,7π/6}],
Disk[{2 rl-(b c-(Sqrt[3]) b c/8),b c/8},b /8,{-π/6, π/2}],
Disk[{2 rl,b c (Sqrt[3])-b c/4},b /8,{c π/6,5 c π/6}],
If[c==1,{RGBColor[0,0.6,1],Opacity[0.6],Disk[{2 rl-(-b +(Sqrt[3]) b /8),b c/8},b /8,{ 3 π/2,13π/6}],
(* Left on the Reflection *)
Disk[{2 rl -(b -(Sqrt[3]) b /8),b c/8},b /8,{ 5 π/6,3π/2}],
Disk[{2 rl-0,b c (Sqrt[3])-b c/4},b /8.,{c π/6,5 c π/6}]},{}]
},Axes->False,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,{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}]
}]}


}];

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

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

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

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

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

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


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

},

{
If[c==-1,{RGBColor[0.1,0.6,0.6],Opacity[0.8],
(*Top reflected right *)
Disk[{2 rl-(k b c +1.25 b c-0.125 b c (Sqrt[3]) ),0.125 b c},b/8,{  -π/6,π/2}],
(* Top reflected left *)
Disk[{2 rl-(1.25 b c+ b c /(4(Sqrt[3]))) ,0.25 b c},b/4,{ π/2,11 π/12}],
Disk[{2 rl-(b /(2 (Sqrt[3]))+ b/8) c,1.125 (Sqrt[3]) b c},b/4,{5 π/6,7π/6}],

(*Bottom Reflected right *)
Disk[{2 rl-(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,{  π/6,-π/2}],
(*Bottom Reflected Left *)

Disk[{2 rl-(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,{ 7 π/6,3 π/2}]


},{(*Reflected Middle right *)
GrayLevel[1],
Disk[{2 rl-(b c/(2 (Sqrt[3])) +k b c + b c/8 ),1.125 (Sqrt[3]) b c},b/4,{ 5π/6,7π/6}],
(*Reflected Top right becomes top left *)
RGBColor[0.1,0.6,0.6],Opacity[0.8],
Disk[{2 rl-(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,{π/2,7 π/6}],
(*Reflected Top left becomes top right*)
Disk[{2 rl-((h+0.125) b c+b c /(4 (Sqrt[3]))),(h+ 1.125 )b c (Sqrt[3]) - 0.25 b c},b/4,{  π/6,π/2}],
(*Reflecte upside down Middle  *)
Disk[{2 rl-(b /(2 (Sqrt[3]))+ b/8) c,1.125 (Sqrt[3]) b c},b/4,{- π/6,π/6}],
(*Bottom Right *)
Disk[{2 rl-(k b c +1.25 b c-0.125 b c (Sqrt[3]) ),0.125 b c},b/8,{  5π/6, 3π/2}],
(*Bottom Left *)
Disk[{2 rl-(1.25 b c+ b c /(4(Sqrt[3])) ),0.25 b c},b/4,{ 3 π/2,4π/2}]
}]}

}];
ymcalogo:=Graphics[{Inset[Text@Row[{Style["Year Around",18,Blue,Italic],Style["  Fitness\n\n",22,Blue,Italic]}],{xpt,ypt+1}],Inset[Text@Row[{Style["at the  ",14,Italic],Style[ "Y M C A\n",24,Black,Italic]}],{xpt,ypt-10}]}];
myemail:=Graphics[Inset[Text@Style["\na_gadalla@comcast.net\n       (763) 420 3875\n ",14,Blue],{xpt,ypt-21}]];

myemailc:=Graphics[Inset[Text@Style["\na_gadalla@comcast.net\n      (763) 420 3875\n ",14,Red],{xpt,ypt-85}]];

(* show thetriangle and the rectangle *)
gpr:=Show[gp,rect,(*ImageSize->{450,450},*)Axes->False,PlotRange->Automatic(*{{24 c,-12 c},{39 c,-7 c}}*)];
(*rotcntr:=Graphics[{Red,PointSize[0.025],Point[{ptr[[1]],ptr[[2]]}]}];*)

rotcntr:=Graphics[{{Red,PointSize[0.025],Point[{xpt,ypt}]}(*,Text[Style["\na_gadalla@comcast.net\n\n(763) 420 3875\n ",14,Blue],{xpt,ypt-10}]*)}];
(*gprt=Table[Rotate[gpr,k π/6,{(k+1.25 )b c- b c (Sqrt[3]) /8,1.125 b c (Sqrt[3])+b c /16}],{k,0,n,1}],*)
rt=ReflectionTransform[{1,0}];
ymc=If[showrl,Show[gpr,prl,gpyr,rectr,rotcntr,ymcalogo,myemail,PlotRange->Automatic,If[grid,{GridLines->{Range[-30,30],Range[-30,30]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}]],
Show[gpr,gpyr,rectr,rotcntr,ymcalogo,myemail,PlotRange->Automatic,If[grid,{AxesOrigin->{0,0},Axes->True,GridLines->{Range[-30,30],Range[-30,30]},GridLinesStyle->Directive[GrayLevel[0.7]]},{}]]];
(*tbl=Table[Rotate[gpr,k π/6,{rl,-20}],{k,1,n}],*)
(*Show[tbl,PlotRange->Automatic],*)
(*Show[gpr,gprt],*)
group=Show[gp,rect,rotcntr,gpyr,rectr,PlotRange->Automatic];
(* Place the YMCA in one circle by rotation  *)
onecirc=Show[group,Graphics[Table[Rotate[#,k α,{xpt,ypt}],{k,1,12}]]&/@group,ImageSize->400];

If[ellps,Show[myemail,Graphics[Table[Translate[#,66(1+GoldenRatio){GoldenRatio Cos[k π/6],Sin[k π/6]}],{k,1,12,1}]&/@onecirc[[1]]]],

If[circ,Show[ymcalogo,onecirc,Graphics[Table[Translate[#,72(1+GoldenRatio){ Cos[k π/6],Sin[k π/6]}],{k,1,12,1}]&/@onecirc]],
(* Graphics[Table[Translate[#,6(1+GoldenRatio){GoldenRatio Cos[k π/6],Sin[k π/6]}],{k,1,12,1}]&/@egg] *)(* to look at it *)
Show[ymcalogo,group,Graphics[Table[Rotate[#,k α,{xpt,ypt}],{k,1,n}]]&/@group,ImageSize->400]]],

Delimiter,

Row[{Control[{{showrl,False,"Show rfl"},{False,True}}],Control[{{grid,False,"Grid"},{False,True}}] }],
{{c,-1,"up/down"},{-1,1}},
Delimiter,
"half length of side of outer Δ (b)",
{{b,4,""},3,7,.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.1,""},1.0,1.8,.1, ControlType->VerticalSlider,ImageSize-> Tiny},
{{rotate,False,"Rotate"},{False,True}},
{{rotrect,True,"Rotrectangle"},{False,True}},
{{α,π/6,"Rotation angle"},-π,2 π,π/180.,Appearance->"Labeled",ImageSize->Tiny},
{{n,11,"No.Rotations"},1,16,1,Appearance->"Labeled",ImageSize->Tiny},
{{rl,-8.9(*(k+1.25 )b c*),"x=-5 refL"},-21,0,0.01,Appearance->"Labeled",ImageSize->Tiny},
{{xpt,-9.4,"x-coord of rot"},-100,100,0.1,Appearance->"Labeled",ImageSize->Tiny},
{{ypt,-48.5,"y-coord of rot"},-100,100,0.10,Appearance->"Labeled",ImageSize->Tiny},
{{circ,False,"circle"},{False,True},Enabled->!ellps},
{{ellps,False,"ellipse"},{False,True},Enabled->!circ},

{{ptr,{dummyrl,8 c},"Rot Center"},{-20,-15},{15,15},{0.1,0.1},Appearance->None,Locator},
{{dummyr1,-9.63},ControlType->None},
TrackedSymbols->{showrl,c,b,k,h,n,rl,rotate,dummyrl,rotrect,xpt,ypt,circ,ellps,α},
ControlPlacement->Left,SaveDefinitions->True,

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

}]

Project  Calculate the volume, surface area, circumference and area of the egg shaped figure

ClearAll["Global`*"];

DynamicModule[{a,equations,vol,areaegg,surfArea,circumf},Manipulate[
Column[{
Item[

Column[{If[equations,Style[Row[{Style[" 1) The Parametric Equations are: \n",Italic],Style["x = "],Style[a ],Style[" Cos [ t ],   y =  "],Style[a],Style[" Sin [ t ],         - (π/2) ≤ t ≤ (π/2) \n"],Style["x = "],Style[2 a ],Style[" Cos [ t ],   y =  "],Style[-a],Style[" + "],Style[ 2 a ],Style[" Sin [ t ],     (π/2) ≤ t ≤ ((3  π)/4) \n"],
Style["x = "],Style[a (2 - (Sqrt[2]) )],Style[" Cos [ t ] - "], Style[a],Style [" ,  y =  "],Style[a (2 - (Sqrt[2]))],Style[" Sin [ t ],   ((3  π)/4) ≤ t ≤ ((5  π)/4) \n"],
Style["x = "],Style[2 a ],Style[" Cos [ t ] "], Style [",   y =  "],Style[a],Style["  +  "], Style[2 a ],Style[" Sin [ t ],    ((5  π)/4) ≤ t ≤ ((3  π)/2) "]}],15,Purple],
Text@Style[" 1) Write the parametric equations for the egg according to the figure",14,Black,Italic]],
(*The circumference of the egg  = ( 3 - ((Sqrt[2])/2) ) (π a) *)
Column[{If[circumf,Style[Row[{" 2)  Circumference = ",NumberForm[( 3-((Sqrt[2])/2)) π a,{5,3}]," cm"}],14,Blue,Italic],
Text@Style[" 2) Calculate the circumsference of the egg",14, Black,Italic]],(* Area of the egg = ( ( 3 - (Sqrt[2]) ) π - 1) (a^2)  *)
If[areaegg,Style[Row[{"       3)  Area of the egg = ",NumberForm[( (3 - (Sqrt[2]))π-1) (a^2),{5,3}]," (cm^2)"}],14,Blue,Italic],
Text@Style[" 3) Calculate the area of the egg",14, Black,Italic]],If[vol,Style[Row[{" 4) Volume of the Egg = ",NumberForm[-π (40.(Sqrt[2]) +3 π -71) (a^3) /3,{6,3}]," (cm^3) "}],14,Blue,Italic],
Text@Style[" 4) Calculate the volume of the egg",14,Italic]],
(* Surface Area  = (14 -4 (Sqrt[2])-π) (a^2)*)
If[surfArea,Style[Row[{"5)  Surface Area = ",NumberForm[ (14 -4 (Sqrt[2])-π) (a^2),{5,3}]," (cm^2)"}],14,Blue,Italic],
Text@Style[" 5) Calculate the surface area of the egg\n",14, Black,Italic]]}]
}  ],Alignment->{Left},Frame->All],
Item[

(* Drawing the three dimensions egg *)

pv1=RevolutionPlot3D[{Sqrt[a^2 - x^2]},{x,0,a},RevolutionAxis->{1,0,0},Boxed->False,Mesh->False,Axes->None,ColorFunction->Function[{Opacity[0.3],Hue[6]}]];
pv2=RevolutionPlot3D[{ -a + Sqrt[4 a^2 - x^2]},{x,-(Sqrt[2]) a,0},RevolutionAxis->{1,0,0},Boxed->False,Mesh->False,Axes->None,ColorFunction->Function[{Opacity[0.3],Hue[6]}]];
pv3=RevolutionPlot3D[{Sqrt[(2 a - a Sqrt[2])^2 - (x + a )^2]},{x,-3 a+a (Sqrt[2]),-(Sqrt[2])a},RevolutionAxis->{1,0,0},Boxed->False,Mesh->False,Axes->None,ColorFunction->Function[{Opacity[0.3],Hue[6]}]];

egg:=Graphics[{d1,d2,d3,d4},ImageSize->Large,AspectRatio->Automatic];
eggt1:=Graphics[Table[Translate[#,2 a(1+GoldenRatio){ Cos[k π/12],Sin[k π/12]}],{k,-6,6,2}]&/@egg];
eggt2:=Graphics[Table[Translate[#,4 a(1+GoldenRatio){ Cos[k π/12], Sin[k π/12]-0.5}],{k,7.,9,1}]&/@egg[[1]]];
eggt3:=Graphics[Table[Translate[#,4 a(1+GoldenRatio){ Cos[k π/12],0.5+Sin[k π/12]}],{k,15,17,1}]&/@egg[[1]]];
eggt4:=Graphics[Table[Translate[#,2 a (2-(Sqrt[2]))(1+GoldenRatio){((-1)/((2-(Sqrt[2]))))+ Cos[k π/12],Sin[k π/12]}],{k,9,15,3}]&/@egg[[1]]];
sh1:=Show[txt,eggt1,PlotRange->Automatic];
sh2:=Show[eggt2,PlotRange->Automatic];
sh3:=Show[eggt3,PlotRange->Automatic];
sh4:=Show[eggt4,PlotRange->Automatic];

Grid[{{Show[pv1,pv2,pv3,ImageSize->Small,PlotRange->All],
Show[Graphics[{c1,c2,c3,c4,t1,t2,l1,l2,l3,l4,dimension},Axes->False,AxesOrigin->{0,0},AspectRatio->Automatic,ImageSize->250]]},{Show[sh1,sh2,sh3,sh4,ImageSize->Small,PlotRange->Automatic]}}],Alignment->{Left},Frame->All]
}],
Row[{Control[{{a,2.," a"},1.,4.,ImageSize->Tiny,Appearance->"Labeled"}],Control[{{equations,False,"Param. eqns"},{False,True}}],Spacer[3],Control[{{circumf,False,"circumf."},{False,True}}], Spacer[3], Control[{{areaegg,False,"area"},{False,True}}],Spacer[3],  Control[{{vol,False,"Volume"},{False,True}}],Spacer[3],
Control[{{surfArea,False,"Surf. Area"},{False,True}}]
}],Initialization:>{Clear [c1,c2,c3,c4,area,circom];
c1:={Thick, Purple, Circle[{0,0},a,{-π/2,π/2}],Point[{0,0}]};
c2:={Thick, Pink, Circle[{0,a},2a,{5π/4,3π/2}]};
c3:={Thick, Pink, Circle[{0,-a},2a,{π/2,3π/4}]};
c4:={Thick, Red, Circle[{-a,0},(2-(Sqrt[2]))a,{3π/4,5π/4}],Point[{-a,0}]};
l1:={Purple, Line[{{0,-a},{0,a}}]};
l2:={Blue, Line[{{-a (Sqrt[2]),a- a (Sqrt[2])},{0,a}}]};
l3:={Orange, Line[{{-a (Sqrt[2]),-a+ a (Sqrt[2])},{0,-a}}]};
l4:={Black, Line[{{-3 a+a (Sqrt[2]),0},{a,0}}]};
dimension:={Black,Line[{{-a,0},{-a,-0.72}}],Arrowheads[{-0.05,0.05}],Arrow[{{0,-0.55},{-a,-0.55}}]};
t1:=Text[Style["a",{"Times-Bold",14}],{a/2,-0.4}];
t2:=Text[Style[Row[{Style["a = "],Style[NumberForm[a,{3,2}]],Style[" cm "]}],{"Times-Bold",14}],{-a/2,-0.4}];
d1:={FaceForm[Pink],Disk[{0,0},a,{-π/2,π/2}]};
d2:={FaceForm[Pink],Disk[{0,-a},2a,{π/2,3π/4}]};
d3:={FaceForm[Pink], Disk[{0,a},2a,{5π/4,3π/2}]};
d4:={FaceForm[Pink],Disk[{-a,0},(2-(Sqrt[2]))a,{3π/4,5π/4}]};
txt:=Graphics[Text[Style["Happy Day",16,Italic,Purple],{-a+0.75,0}]];
v1=Integrate[π (a^2 - x^2),{x,0,a}];
v2=Integrate[π ( -a + Sqrt[4 a^2 - x^2])^2,{x,-(Sqrt[2]) a,0}];
v3=Integrate[π ( (2 a - a Sqrt[2])^2 - (x + a )^2),{x,-3 a+a (Sqrt[2]),-(Sqrt[2])a}];
volume := FullSimplify[v1+v2+v3];

 },TrackedSymbols->{a,equations,vol,areaegg,surfArea,circumf}]]

ClearAll["Global`*"];

Illustrating the relationship among the Geometric Mean, Arithmetic Mean ( AM) and the Harmonic Mean (HM)

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["G.M. = \!\(\*SqrtBox[\(k\\ l\)]\) ",14,Bold,Red],{1.74 r,y[1.5 r]/2}],
Inset[Style["H.M. = HM = \!\(\*FractionBox[\(2\\ k\\ l\), \(k + l\)]\) ",14,Bold,Black,Italic],{0.85  r,r/2}],
Inset[Style["A.M. = OM = ((k + l)/2) ",14,Bold,Blue,Italic],{ 0.85r,0.85r}],
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}}],Inset[Style["A.M. = Arithmetic Mean ",11,Bold,Blue,Italic],{2.5 r,0.8r}],
Inset[Style["H.M. = Harmonic Mean ",11,Bold,Blue,Italic],{ 2.5r,0.6r}]


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

Geometric mean between  r1 and r3 of three tangent circles

ClearAll["Global`*"];

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)];(*u=r1 Cot[alpha];v=N[r3( Cot[alpha]-Cos[alpha])];*)
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[
(*If[u==r3 (Cot[alpha]-Cos[alpha])-r1 Cos[alpha],u=r1 Cot[alpha]],*)
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])}],
Line[{{r1 Cot[alpha],r1},{r1 Cot[alpha],0}}],Line[{{r2 Cot[alpha],r2},{r2 Cot[alpha],0}}],
Text[Style["r2 = ?",Small],{r2 Cot[alpha],r2/2}],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,{{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.01],Point[{r3 Cot[alpha]-r3/2 Cos[alpha],r3-(r3/2)Sin[alpha]}]},{EdgeForm[{Thick,Black}],FaceForm[Cyan],Disk[{u+r1/2,(u +r1/2)Tan[alpha]},r1/2,{alpha,π+alpha}],PointSize[0.012],Point[{u+r1/2,(u +r1/2)Tan[alpha]}]},
If[u==r3 (Cot[alpha]-Cos[alpha])-r1 Cos[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,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[{r2 Cot[alpha],r2 },r2,{alpha,π+alpha}]},

Red,Arrow[{{v,v Tan[alpha]},{v-r2 Sin[alpha],v Tan[alpha]+r2 Cos[alpha]}}]
},{}],
If[answer,Text[Style[Row[{"r2 = ",r2}],Small],{r2 Cot[alpha],3r2/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[r3( Cot[alpha]-Cos[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`*"];

Module[{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}]]

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 the radius 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))

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,
	and α is the angle between the line passes through the centers and a horizontal line.

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=Quiet[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 ",n,"  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,Graphics[plotcntrLine[[1]]],Graphics[plotTangtLine[[1]]],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]]

Illustrating Involution of a Circle and the meaning of π
I. π as a length of a semi-circle with radius = 1.

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. 
Given any point T ( r Cos θ , r Sin θ  ) on the surface of the circle, the coordinates of the corresponding point P on the involution curve are:

	x = r  ( Cos θ + θ Sin θ )      and    y = r ( Sin θ - θ Cos θ )
	
Hence:  ((d x)/(d θ)) = r θ  Cos θ ,     and         ((d y)/(d θ)) = r θ  Sin θ 
The length of the involution curve of the semi circle = (∫_0^Θ)(Sqrt[((( ((d x)/(d θ)) ))^2) + ((( ((d y)/(d θ)) ))^2)])dθ = ((Θ^2)/2) r
For r = 1 cm, the length of that curve at any angle θ radians  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`*"];

DynamicModule[{angle,radian},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[{Which[π/2>θ≥π/4,Text[Style["(π/4)",Black,18,Blue,Bold],{Cos[(( π)/4)]+0.1,Sin[(( π)/4)]}],
3π/4>θ≥π/2,Text[Style["(π/2)",18,Blue,Bold],{0,1.24}],
π>θ≥ 3π/4,Text[Style["((3  π)/4)",18,Bold,Blue],{Cos[((3 π)/4)],Sin[((3 π)/4)]}] ]}];
txt3:=Graphics[{Which[0.6<θ≤1,{Text[Style["first rad.",Black,24,Black,Bold],{0.9,0.5}],Thickness[0.015],Opacity[0.5],Green,Circle[{0,0},1,{0,1.0}]},
1<θ≤2,{Text[Style["(2^nd) rad.",24,Black,Bold],{0,0.8}],Thickness[0.015],Opacity[0.5],Blue,Circle[{0,0},1,{1.0,2.0}]},
2<θ≤ 3,{Text[Style["(3^rd) rad.",24,Bold,Black],{-1.2,0.7}],Thickness[0.015],Opacity[0.5],Red,Circle[{0,0},1,{2.0,3.0}]} ],If[radian,{Text[Style["(1^st) rad.",Black,24,Black,Bold],{0.9,0.5}],Text[Style[Row[{NumberForm[180./π,{5,3}],"°"}],14],{0.33,0.15}],Text[Style[Row[{NumberForm[360./π,{5,3}],"°"}],14],{0,0.57}],
Text[Style[Row[{NumberForm[540./π,{5,3}],"°"}],14],{-0.5,0.35}],
Circle[{0,0},0.5,{0,2}],Circle[{0,0},0.65,{0,3}],
Text[Style["(2^nd) rad.",24,Black,Bold],{0,1.2}],Text[Style["(3^rd) rad.",24,Bold,Black],{-1.2,0.7}],Arrow[{{0,0},{Cos[1],Sin[1]}}],
Arrow[{{0,0},{Cos[2],Sin[2]}}],Arrow[{{0,0},{Cos[3],Sin[3]}}],Thickness[0.015],Opacity[0.5],Green,Circle[{0,0},1,{0.,1.0}],Blue,Circle[{0,0},1,{1.0,2.0}],Disk[{0,0},0.17,{1,2}],Red,Circle[{0,0},1,{2.0,3.0}],Disk[{0,0},0.21,{2,3}],{EdgeForm[Red],FaceForm[Green],Opacity[0.5],Disk[{0,0},0.15,{0,1}]}
}]}];

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,txt3,ImageSize->Large],Row[{Control[
 {{angle,.1,"Angles"},179.99,0.1,0.01,Appearance->"Labeled"}],Spacer[30],Control[{{radian,False,"radians"},{False,True}}]}],TrackedSymbols->{angle,radian},SaveDefinitions->True]]

II.  π as an Area

Maria Gaetana Agnesi (1718 - 1799  Italian Mathematician .

She wrote the first text that included both differential and integral calculus .
  By the age of 30, she was an honorary member of the faculty at the University of Bologna (Italy).  One of the function she studied is:
		  f(x) =((a^3)/(((x^2) + (a^2) )))

The area under the graph when a = 1 is π square units.

areaMaria = (∫_(-∞)^∞)(1/(1+(x^2)))\[DifferentialD]x;   areaE= (∫_(-∞)^∞)((2(E^x))/(1+(E^(2x))))\[DifferentialD]x;
Column[{
pAgnesi=Plot[(1/(1+(x^2))),{x,-3,3},PlotStyle->{Thick,Brown},Filling->Axis,AspectRatio->Automatic,FillingStyle->LightBrown,ImageSize->525,PlotLabel->Style[StandardForm[1 /(x^2 +1)],36,Blue],Epilog->Text[Style["area = π ",20,Black],{0,0.3}]],
pExponent=Plot[((E^x)/(1+(E^(2x)))),{x,-3,3},PlotStyle->{Thick,Red},Filling->Axis,AspectRatio->Automatic,FillingStyle->LightYellow,ImageSize->525,PlotRange->{{-3.1,3.1},{-0.5,1}},PlotLabel->Style[StandardForm[(E^x) /(1+(E^(2x)))],36,Red],Epilog->Text[Style["area = (π/2) ",20,Red],{0,0.3}]],
pExponent=Plot[{((E^x)/(1+(E^(2x)))),((-(E^x))/(1+(E^(2x))))},{x,-3,3},PlotStyle->{{Thick,Red}},ImageSize->525,Filling->Axis,AspectRatio->Automatic,FillingStyle->{LightYellow},PlotLabel->Style[Row[{StandardForm[(E^x) /(1+(E^(2x)))]," , ",StandardForm[-(E^x) /(1+(E^(2x)))]}],36,Black],PlotRange->{{-3.1,3.1},{-1,1}},Epilog->Text[Style["area = π ",20,Black],{0,0.1}]],
pExponent2=Plot[((2(E^x))/(1+(E^(2x)))),{x,-3,3},PlotStyle->{Thick,Red},Filling->Axis,AspectRatio->Automatic,FillingStyle->LightYellow,ImageSize->525,PlotRange->{{-3.1,3.1},{-0.5,1}},PlotLabel->Style[StandardForm[2(E^x) /(1+(E^(2x)))],36,Red],Epilog->Text[Style["area = π ",20,Red],{0,0.3}]]
}]

Graphics[{EdgeForm [{Thick,Black}],FaceForm[RGBColor[0,0.6,1]],Disk[{0,0},1],PointSize[0.015],Point[{0,0}]},PlotLabel->"Radius = 1, Area = π",Axes->False]

ClearAll["Global`*"];

III.  π  as a Volume

RegionPlot3D[x^2+y^2≤1&&x+1≥z,{x,-1,1},{y,-1,1},{z,0,2},PlotRange->All,PlotPoints->96,AxesLabel->{"x","y","z"},Boxed->False]

2(∫_(-1)^1)(∫_0^(Sqrt[1-(x^2)]))(x+1)\[DifferentialD]y\[DifferentialD]x

RegionPlot3D[x^2+y^2≤1,{x,-1,1},{y,-1,1},{z,0,1},PlotRange->All,PlotPoints->96,AxesLabel->{"x","y","z"},Boxed->False,Lighting->"Neutral"]

IV.   π as an Infinite Series:

∫(1/(1+(x^2)))\[DifferentialD]x

Integrate the Maclaurin series :

Series[(1/(1+(x^2))),{x,0,10}] =1-(x^2)+(x^4)-(x^6)+(x^8)-(x^10)+((O[x])^11) ,(-1 < x < 1 )

term by term gives:

ArcTan[x] + C = ∫(1/(1+(x^2)))\[DifferentialD]x = x - ((x^3)/3) + ((x^5)/5) -((x^7)/7) +((x^9)/9) +((x^11)/11) +((x^13)/13) - . . . .

ArcTan[x] = x - ((x^3)/3) + ((x^5)/5) -((x^7)/7) +((x^9)/9) +((x^11)/11) +((x^13)/13) - . . . . - C

Since ArcTan[0] = 0, then C = 0.
Hence ArcTan[x] = x - ((x^3)/3) + ((x^5)/5) -((x^7)/7) +((x^9)/9) +((x^11)/11) +((x^13)/13) - . . . 
Limit [ArcTan[x],  x->1] = ArcTan [1] = (π/4), Therefore:

4 (∑_(k=1)^∞)((((-1))^(k+1))(1/(2 k - 1)))  = π

Here are other series derived from Euler’s formulas and others.

4 - 8 (∑_(k=1)^∞)(1/((4 k - 1 ) ( 4 k + 1 )))  = π

(Sqrt[6 (∑_(k=1)^∞)(1/(( k)^2))]) = π

(Sqrt[8 (∑_(k=0)^∞)((1/(2 k + 1)))^2])  = π

(Sqrt[8 (∑_(k=1)^∞)((1/(2 k - 1)))^2])   = π

(Sqrt[12 (∑_(k=1)^∞)((((-1))^(k+1))/(( k)^2))])  = π

(Sqrt[24 (∑_(k=1)^∞)(1/((2 k)^2))]) = π

2 (∏_(k=1)^∞)(((2 k )^2)/((2 k - 1 ) ( 2 k + 1 ))) = π

and finally the well known Euler’s formula that combines e, π, and i as well as cos and sin is:

(e^(π i)) = Cos[π] + i Sin[π] = -1

Volume of the Wedge

DynamicModule[{a,n,b},Manipulate[RegionPlot3D[x^2+y^2≤1&&z<a x^n+b,{x,-1,1},{y,-1,1},{z,0,5 Abs[a]},PlotRange->All,PlotPoints->81,BoxRatios->{1,1,1},AxesLabel->{"x","y","z"},Boxed->False,ImageSize->Medium,AspectRatio->Automatic,ViewPoint->{-2.1202468699579824`,2.5403503597696693`,0.7079359152151338`},ViewVertical->{-0.7310935721354741`,0.989159322309439`,0.9120834528016077`}],
Row[{
Control[{{a,1,"a"},-6,6,1,Appearance->"Labeled",ImageSize->Tiny}],Control[{{n,1,"n"},-4,4,1,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{b,0,"b"},-8,8,1,Appearance->"Labeled",ImageSize->Tiny}]
}],TrackedSymbols:>{a,n,b},SynchronousUpdating->False]]

A right circular cylinder is cut by two planes to form a wedge.  One plane is perpendicular to the axis of the cylinder and the second makes an angle theta degrees with the first. Calculate the volume of the wedge for any angle theta.

Based on problem # 55 of Section 6.2 at Page 423; Calculus 5 th Edition by Larson Hostetler & Edwards.

ClearAll["Global`*"];

Manipulate[
ClearAll["Global`*"];
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 = \n(∫_0^1)((1-x^2)Tan[α])\[DifferentialD]x = 2(∫_0^1)(∫_0^(Sqrt[1 - (x^2)]))(y Tan[α]) \[DifferentialD]y \[DifferentialD]x = ",Blue,Italic],Style[volume,Blue],Style["  cubic units \n",Blue,Italic]}],16],Text@Style["\nCalculate the volume of the wedge giving that:\n the radius is one unit and the angle of the cut is α\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[
{{α,π/4,"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,True,"Show Top"},{False,True}}],Control[{{showside,True,"Show Side"},{False,True}}] }}],
TrackedSymbols->{α,ang,top,x,dx,answer,showside},SaveDefinitions->True]

Volume of wedge with just one plane cut

ClearAll["Global`*"];Clear[α];

DynamicModule[{α,,ang,top,x,dx,answer,showside},Manipulate[
y1:=(Sqrt[1.-x^2]);h1:=2y1 Tan[α];
y2:=(Sqrt[1.-(x+dx)^2]);
h2:=2y2 Tan[α];
y:=(Sqrt[1-u^2]);
du:=0.2;dv:=0.01;
y3:=(Sqrt[1-(u+du)^2]);
h3:=2y3 Tan[α];
h:=2((Sqrt[1-u^2]) )Tan[α];
(*volume:=FullSimplify[ 2(∫_0^1)(4(1-w^2)Tan[α])\[DifferentialD]w];*)
volume:=2(∫_(-1)^1)(∫_0^(Sqrt[1-(q^2)]))(q+1)\[DifferentialD]p\[DifferentialD]q;
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 that:\nthe radius is one unit and the angle of the cut is α°\n",16,Italic]],Alignment->Left,Frame->True],
Item[
(* Displaying the top of the Wedge *)
rpb=If[top,{RevolutionPlot3D[{t,2Tan[α]},{t,0,1},{φ,0,ang},Mesh-> 5, Lighting-> "Neutral",PlotStyle-> {GrayLevel[0.99]}],RevolutionPlot3D[{{t ,0}},{t,-1,1.},{θ,0,π},Boxed->False]},RevolutionPlot3D[{{t ,0}},{t,-1,1.},{θ,0,π},Boxed->False]];

(* Display the side *)

pcl=If[showside,{ParametricPlot3D[{Cos[u],Sin[u],2ht},{u,-π/90,ang},{ht,0,Tan[α]},(*PlotTheme->"Marketing"*)BoundaryStyle->{Black},PlotStyle->GrayLevel[0.3], Lighting-> "Neutral"]},{}];
grp:=Graphics3D[{

{Table[{{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]),2(Sqrt[1-(-1+k dv)^2])Tan[α]}}]}
},{k,0,199,1}]},


(*Bottom polygon *)
Table[{ColorFunction->"Rainbow",Polygon[{{u,-y,0},{u+du,-y3,0},{u+du,y3,0},{u,y,0}}],
(* Back Polygon *)
 Polygon[{{u,y,0},{u+du,y3,0},{u+du,y3,h3},{u,y,h}}],
(* two sides polygons *)
Polygon[{{u+du,-y3,0},{u+du,y3,0},{u+du,y3,h3}}], 
Polygon[{{u,-y,0},{u,y,0},{u,y,h},{u,-y,0}}],

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


(* The moving polygon *)
(*Bottom polygon *)
{Red,Polygon[{{x,-y1,0},{x+dx,-y2,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[1,0,0],Polygon[{{x+dx,-y2,0},{x+dx,y2,0},{x+dx,y2,h2}}]}, 
{EdgeForm[Red],FaceForm[Blue],Polygon[{{x,-y1,0},{x,y1,0},{x,y1,h1},{x,-y1,0.}}]},

(* Front Polygon *)
{EdgeForm[{Thick,Red}],FaceForm[Blue],Polygon[{{x,-y1,0},{x,y1,h1},{x+dx,y2,h2},{x+dx,-y2,0}}]},
(* Plane of cut *)
ParametricPlot3D[{Cos[t],Sin[t],If[t≥0,2Tan[α] Sin[t],0]},{t,-π,π},PlotStyle->{Thick,Red}][[1]],
(*
ParametricPlot3D[{ Sin[t], Cos[t],Tan[α](1+ Cos[t])},{t,0,2π},PlotStyle->{Thick,Red}][[1]](*,Axes->True,AxesLabel->{{"x"},{"y"},{"z"}},Boxed->False,PlotTheme->"Marketing"*)*)
(*ParametricPlot3D[{Cos[θ],Sin[θ],(1+Sin[θ])Tan[α]},{θ,0,2*Pi},Boxed->False,PlotStyle->{Thick,Red}(*Axes->True,AxesLabel->{{"x"},{"y"},{"z"}*)][[1]]*)
(* Border Plane*)
ParametricPlot3D[{ Cos[x], Sin[x],Tan[α]( Sin[x] +1)},{x,0,2π}
][[1]]
}];
Show[grp,rpb,pcl,ImageSize->400,Boxed->False],Alignment->{Center},Frame->True]}],
Grid[{
{Control[
{{α,π/4,"angle of cut"},π/12,5 π/12,π/12,ImageSize->Tiny,Appearance->"Labeled"}],Control[
{{ang ,π,"angle"},π/720,2.π,π/720.,Appearance->"Labeled",ImageSize->Tiny}]},{Control[
{{x,-0.4,"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]]

Example 1 Calculating volume using washer method :

Manipulate[
g[x_]:=Sqrt[ x];
f[x_]:=0.5 x;
volume:=π(∫_0^3)((((g[x]))^2)-(f[x])^2)\[DifferentialD]x;
Column[{
Item[
If[answerg,Style[Row[{Style["Volume of the solid = \nπ(∫_0^3)(",16,Italic],Superscript[Style[Row[{"(",g[x],")"}],16,Italic],2 ],"-",Superscript[Style[Row[{"(",f[x],")"}],16,Italic],2 ],Style[")dx",Italic]," = ",volume," " ,Superscript[cm,3],"\n"}],16,Purple],Style[Row[{"Calculate the volume of the solid resulting from\n rotating the region bounded by ",  TraditionalForm[g[x]],", ",TraditionalForm[f[x]]," about the x-axis.\n"}],16,Italic,Black]
],Alignment->{Center},Frame->True,ItemSize->{36,4}],

Item[
fun=ParametricPlot3D[{{x,0,g[ x]},{x,0,0.5 x}},{x,0,4},PlotStyle->{{Thick,Blue},{Thick,Black}},Boxed->False];

revfunh1=RevolutionPlot3D[g[ t],{t,0,4},{θ,0,-theta},RevolutionAxis->{1,0,0},Mesh->None,PlotStyle->Opacity[0.6],Boxed->False,Axes->{False,False,False},
ViewPoint->{1.5,-4,0}];

revfunh2=RevolutionPlot3D[f[t],{t,0,4},{θ,0,-theta},RevolutionAxis->{1,0,0},Mesh->None,PlotStyle->Opacity[0.6],Boxed->False,Axes->{False,False,False},
ViewPoint->{1.5,-4,0}];
ax=Graphics3D[{
Thick,Black,Arrow[{{-0.6,0,0},{4.8,0,0}}],Arrow[{{0,0,0},{0,0,1.5}}],Arrow[{{0,0,0},{0,0,-1.5}}],Text[Style["x",Italic,24],{4.95,0,0}],Text[Style["y",Italic,24],{0,0,2}],
Blue,Text[Style[Row[{"f(x) = (Sqrt[x]) \n"}],16,Blue],{0,2.4,2.1}],Text[Style[Row[{"\ng(x) = 0.5 x \n"}],16,Black],{0,2.4,1.8}]},Boxed->False,ViewPoint->{1.5,-4,0},Axes->{False,False,False}];

crossdisk=Graphics3D[{{Blue,Thick,Arrowheads[0.03],Arrow[{{u,0,0},{u,0,(Sqrt[u])}}],Arrow[{{4,0,0},{4,0,2}}],Text[Style["4 ",Italic,Bold,20],{4,0,-0.15}],Text[Style["x ",Italic,Bold,16],{u,0,-0.15}]},
If[integrate,{Table[{EdgeForm[{Thick,Black}],FaceForm[Red],

Polygon[Join[Table[{u-0.2 n,(Sqrt[u-0.2 n])Sin[θ],(Sqrt[u-0.2 n])Cos[θ]},{θ,0,theta,π/180}],
Table[{u-0.2 n,0.5 (u-0.2 n) Sin[θ],0.5 (u-0.2 n) Cos[θ]},{θ,0,theta,π/180}]]]},{n,0,4 u,1}],

Table[{EdgeForm[{Thick,Black}],FaceForm[Red],

Polygon[Join[Table[{u+0.2 n,(Sqrt[u+0.2 n])Sin[θ],(Sqrt[u+0.2 n])Cos[θ]},{θ,0,theta,π/180}],
Table[{u+0.2 n,0.5 (u+0.2 n) Sin[θ],0.5 (u+0.2 n) Cos[θ]},{θ,0,theta,π/180}]]]},{n,0,m,1}]},{{EdgeForm[{Thick,Black}],FaceForm[Red],

Polygon[Join[Table[{u,(Sqrt[u])Sin[θ],(Sqrt[u])Cos[θ]},{θ,0,theta,π/180}],
Table[{u,0.5 (u) Sin[θ],0.5 (u) Cos[θ]},{θ,0,theta,π/180}]]]}}]


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

Show[ax,revfunh1,revfunh2,fun,crossdisk,ImageSize->Medium,PlotRange->{{0,5},{-2.3,2.3},{-2.4,2.4}}],Alignment->{Center},Frame->True]
}],

Grid[{{Control[
{{theta,π,"angle"},π/180,2.π,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{u,1.5,"u"},0.2,4,0.1,Appearance->"Labeled",ImageSize->Tiny}],
Control[{{m,0,"# disks"},0,20-6 u,1,Appearance->"Labeled",ImageSize->Tiny}]},{Control[{{integrate,False,"Integrate"},{False,True}}],Control[{{answerg,False,"answer"},{False,True}}]}}],TrackedSymbols->{theta,m,u,integrate,answerg},SaveDefinitions->True]

Illustrating the concept of washer by another example :

Volume of Solids of Revolutions (Washer Methods ):  Given:
 (Subscript[f, 1]) (x) = (x^2),
(Subscript[f, 2]) (x) = (Sqrt[x])

ClearAll["Global`*"];

Manipulate[
f1[x_]:=x^2;f2[x_]:=Sqrt[x];
xint=x/.FindRoot[f1[x]==f2[x],{x,0.9}];
xvol:=π(∫_0^1)(f1[x]^2-f2[x]^2)\[DifferentialD]x;
yvol:=2π(∫_0^1)x (f1[x]-f2[x])\[DifferentialD]x;
Column[{
Item[
If[answer,Style[Row[{"\nthe volume obtained by revolving about x-axis = ",xvol4," = ",N[xvol], " (cm^3)\nthe volume obtained by revolving about y-axis = ",yvol4," = ",N[yvol], " (cm^3)\n"}],12,Purple,Italic],Style["\nCalculate the volume by rotating the region about the x - axis and\nCalculate the volume by rotating the region about the y - axis\n",12 ,Black,Italic]
],Frame->True],
Item[
(*First evaluate the functions and plot them *)
p0=Plot[Tooltip[{f1[x],f2[x]}],{x,0,1.1},AspectRatio->Automatic,PlotStyle->{Thick,Blue},AxesOrigin->{0,0},PlotLabel->Style[Row[{"f1(x ) = ",f1[x],"\nf2( x ) = ",f2[x]}],14,Blue,Italic],AxesStyle->{{Arrowheads[{-0.03,0.03}],Directive[Thick,Italic,Black,14]},{Arrowheads[{-0.03,0.03}],Directive[Thick,Italic,Black,12]}},AxesLabel->{Style["x",Italic,14],Style["y",Italic,14]}];
gtext=Graphics[{Inset[Style[Row[{"( ",xint," , ",f1[xint],")"}],16,Black],{xint-0.15,f1[xint]}]}];
p1=RegionPlot[x^2≤y≤(Sqrt[x]),{x,0,1.},{y,0,1}];
fun=ParametricPlot3D[{{x,0,f1[x]},{x,0,f2[x]}},{x,0,xint},BoxRatios->{1,1,1},PlotStyle->{{Thick,Blue},{Thick,Black}},Boxed->False,Axes->{False,False,False}];

(* Second rotate each function about the y-axis *)
revfun1y=RevolutionPlot3D[f1[t],{t,0,xint},{θ,0,theta},RevolutionAxis->{0,0,1},Mesh->3,PlotStyle->Opacity[0.6],Boxed->False,BoxRatios->{1,1,1},Axes->{False,False,False},ViewPoint->{2.122,-2.422,1.041},ViewVertical->{0.3302,-0.6437,2.8711}];
revfun2y=RevolutionPlot3D[f2[t],{t,0,xint},{θ,0,theta},RevolutionAxis->{0,0,1},Mesh->3,PlotStyle->Opacity[0.6],Boxed->False,BoxRatios->{1,1,1},Axes->{False,False,False},ViewPoint->{2.122,-2.422,1.041},ViewVertical->{{0.3302,-0.6437,2.8711}}];

(* Show the cross section of the washer inside the functions *)
crossdisky=Graphics3D[{
If[integratey,
Table[
{EdgeForm[{Thick,Black}],FaceForm[Pink],Polygon[
Join[
Table[{f1[u-0.1 n]Cos[θ],f1[u-0.1 n] Sin[θ],u-0.1 n},{θ,0,theta,π/180}],
Table[{f2[u-0.1 n]Cos[θ],f2[u-0.1 n] Sin[θ],u-0.1 n},{θ,0,theta,π/180}]
]]},{n,0,10 u-0.001,1}],


{EdgeForm[{Thick,Black}],FaceForm[Pink],Polygon[
Join[
Table[{f1[u]Cos[θ],f1[u] Sin[θ],u},{θ,0,theta,π/180}],
Table[{f2[u]Cos[θ],f2[u] Sin[θ],u},{θ,0,theta,π/180}]
]]}
]
},Axes->{False,False,False},Boxed->False,BoxRatios->{1,1,1}];

(*Now rotating about the x-axis *)

revfun1x=RevolutionPlot3D[f1[ t],{t,0,1},{θ,0,-theta},RevolutionAxis->{1,0,0},Mesh->None,PlotStyle->Opacity[0.6],Boxed->False,BoxRatios->{1,1,1},Axes->{False,False,False},
ViewPoint->{1.5,-4,0}];

revfun2x=RevolutionPlot3D[f2[t],{t,0,1},{θ,0,-theta},RevolutionAxis->{1,0,0},Mesh->None,PlotStyle->Opacity[0.6],Boxed->False,BoxRatios->{1,1,1},Axes->{False,False,False},
ViewPoint->{1.5,-4,0}];
axes=Graphics3D[{{Thick,Black,Arrowheads[0.02],Arrow[{{-0.3,0,0},{1.15,0,0}}],Arrow[{{0,0,0},{0,0,1.1}}],Arrow[{{0,0,0},{0,0,-1.15}}]}
,Text[Style["x",Italic,24],{1.15,0,0}],Text[Style["y",Italic,24],{0,0,1.15}]
},Boxed->False,BoxRatios->{1,1,1},Axes->{False,False,False},ViewPoint->{1.5,-4,0}];
crossdiskx=Graphics3D[{
{Blue,Thick,Arrowheads[0.03],Arrow[{{u,0,0},{u,0,(Sqrt[u])}}],Arrow[{{1,0,0},{1,0,1.}}],Text[Style["1 ",Italic,Bold,20],{1,0,-0.15}],Text[Style["x ",Italic,Bold,16],{u,0,-0.15}]},
If[integratex,
Table[{EdgeForm[{Thick,Black}],FaceForm[Red],

Polygon[Join[Table[{u-0.1 n,f1[u-0.1 n]Sin[θ],f1[u-0.1 n]Cos[θ]},{θ,0,theta,π/180}],
Table[{u-0.1 n,f2[u-0.1 n] Sin[θ],f2[u-0.1 n] Cos[θ]},{θ,0,theta,π/180}]]]},{n,0,10 u-0.001,1}],

{EdgeForm[{Thick,Black}],FaceForm[Red],

Polygon[Join[Table[{u,f1[u]Sin[θ],f1[u]Cos[θ]},{θ,0,theta,π/180}],
Table[{u,f2[u] Sin[θ],f2[u] Cos[θ]},{θ,0,theta,π/180}]]]

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


Grid[{{Show[p0,p1,gtext,ImageSize->Small],Show[revfun1y,revfun2y,crossdisky,fun,ImageSize->Small]},{Show[axes,revfun1x,revfun2x,crossdiskx,fun,ImageSize->Small]}}],Frame->True,Alignment->{Center}]
}],
Row[{Control[{{theta,4π/4,"angle"},π/180,2π,Appearance->"Labeled",ImageSize->Tiny}],
Spacer[15],Control[{{u,0.6,"y general"},0.2,1,0.01,Appearance->"Labeled",ImageSize->Tiny}],Spacer[15],Control[{{integratey,False,"integrate Y"},{False,True}}],Spacer[21],Control[{{integratex,False,"integrate x"},{False,True}}],Spacer[21],Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{theta,u,integratey,integratex,answer}]

calculate the volume by revolving a figure about a vertical axis:

Calculate the volume when rotating an area enclosed by two functions about a vertical axis

Which of the following axis gives bigger volume of solid ?
    a.  Rotation about the y - axis
    b. Rotation about x = 2. and why ?
    Solve this problem using both washer and shell methods.

ClearAll["Global`*"];

Manipulate[
f[x_]:=4. x;g[x_]:=x^3;
sol=FindRoot[f[x]==g[x],{x,2.1}];
xint=sol[[1,2]];

volume1=(∫_0^xint)(2 π (a1-x)(f[x]-g[x]))\[DifferentialD]x;
Column[{
Item[If[answer,Style[Row[{"\nVolume of the solid = ",volume1,"  (cm^3)\n"}],16,Purple],Style[Row[{"\nCalculate the volume of the solid generated by \nrevolving the region about ",If[a1>-10^-8&&a1<10^-8,"y axis\n",Row[{"x = ",a1}]],"\n"}],
16,Black,Italic]
],Alignment->{Center}, Frame->True],
Item[

fp1=Plot[{f[x],g[x]},{x,0,xint},Filling->{1->{2}},FillingStyle->Pink,AxesLabel->{ x ,Y},LabelStyle->Directive[12,Italic,Bold],PlotRange->{{-1,6.5},{-0.5,9}},AspectRatio->Automatic];

text1=Graphics[{{Thick,Black},Line[{{0,0},{xint,g[xint]}}],Inset[Style["y = 4 x",12,Bold,Italic],{0.7,4}]}];
text2=Graphics[Text[Style["y= (x^3)",14,Italic,Blue],{1.5,2.6}]];

text3=Graphics[Text[Style[Row[{"x = ",a1}],16,Bold,Italic,Red],{a1,8.3}]];

fp2=Plot[{f[-(x-2 a1)],g[2 a1-x]},{x,2a1-xint,2 a1},Filling->{1->{2}},FillingStyle->Hue[0.15],AspectRatio->Automatic,PlotRange->{{2 a1-xint,2 a1+3},{-1,9}}];
pp=ParametricPlot[{a1,t},{t,0,8},PlotStyle->{Thickness[0.01],Dashing[{0.001,0.03,0.11,0.03}],RGBColor[1,0,0]}];
(*Translate the Grph *)
revx2=Quiet[Graphics3D[{Translate[fillcap[angle][[1]],{a1,0,0}]},Axes->True]];
ppp:=ParametricPlot3D[{a1,0,t},{t,0,8.2},PlotStyle->{Thickness[0.01],Dashing[{0.001,0.03,0.11,0.03}],RGBColor[1,0,0]}];

s1=Row[{Show[fp1,pp,If[hint,Show[fp2,PlotRange->All],{}],text1,text2,text3,AspectRatio->Automatic,PlotRange->{{-1,4.6},{-1,8.7}},ImageSize->Medium],Spacer[35],
Show[revx2,ppp,ImageSize->Medium,AspectRatio->Automatic,Boxed->False]}],Alignment->{Center},Frame->True]
}],
Row[{Control[{{a1,2,"revolving axis"},-3,3,Appearance->"Labeled",ImageSize->Tiny}],Control[
{{angle,2,"revolving angle"},0, π,Appearance->"Labeled",ImageSize->Tiny}],Control[{{hint,False,"hint"},{False,True}}],Spacer[10],
Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{a1,angle,hint,answer},Initialization:>{fillcap[angle_]:=Block[{fig,cap1,cap2,line1,line2,polycap1,polycap2},
region={{r Cos[θ],r Sin[θ],f[a1-r]},{r Cos[θ],r Sin[θ],g[a1-r]}};
fig=RevolutionPlot3D[region,{r,a1-xint,a1},{θ,0,angle}];
cap1=ParametricPlot3D[Evaluate[region/.θ->0],{r,a1-xint,a1}];
cap2=ParametricPlot3D[Evaluate[region/.θ->2angle],{r,a1-xint,a1}];
line1=Cases[cap1,_Line,Infinity];
line2=Cases[cap2,_Line,Infinity];
polycap1=line1[[1,1]]~Join~Reverse@line1[[2,1]]//Polygon;
polycap2=line2[[1,1]]~Join~Reverse@line2[[2,1]]//Polygon;
Show[fig,Graphics3D[{EdgeForm[{Thick,Blue}],FaceForm[{Opacity[1],Pink}],polycap1,polycap2}]]
];}, SaveDefinitions->True]

Example 1:
Calculate the volume of the solid when rotating the area bounded by f1 ( x) = (x^2) and f2 (x) = 2 sin ( 2 x ) about the vertical line x = 2.

Step by step rotating about x = a

Example 1

SetOptions[EvaluationNotebook[],CellContext->Notebook];

Calculate the area enclosed by f1 ( x) = (x^2) and f2 ( x ) = 2 sin (2 x) between zero and the point of intersection.
Solution:
We proceed as follows:
First, we need to find the intersection point by solving the two equations.

f1[x_]:=x^2;
f2[x_]:=2 Sin[2 x];
sol=FindRoot[f1[x]==f2[x],{x,1.1}];

Second, we integrate a slice whose width is delta x  from zero to the intersection point.

f1[x_]:=x^2;
f2[x_]:=2 Sin[2 x];
sol=FindRoot[f1[x]==f2[x],{x,1.1}];
xint=sol[[1,2]];
labels=Graphics[{Inset[Style[" f1(x)= (x^2)\n", 16,Black],{0.8,0.3}],Inset[Style[" f2(x)= 2 Sin(2 x)\n", 16,Black],{0.4,1.85}],
Inset[Style[Row[{"( ",xint," , ", f1[xint]," )"}],16,Black],{xint,f1[xint]-0.1}]},PlotRange->All,Axes->True,AxesOrigin->{0,0}];plt=Plot[{f1[x],f2[x]},{x,0,xint},(*Filling->{1->{2}},FillingStyle->Yellow,*)AxesOrigin->{0,0},AspectRatio->Automatic,PlotRange->All];
slice=Graphics[{EdgeForm[{Thick,Black}],FaceForm[Red],Polygon[{{0.5,f1[0.5]},{0.5,f2[0.5]},{0.6,f2[0.6]},{0.6,f1[0.6]}}]}];
Show[labels,plt,slice,PlotRange->All]

Now we need to find the volume of the solid when rotating the area bounded by f1 ( x) = (x^2) and f2 (x) = 2 sin ( 2 x ) about the vertical line x = 2.

a1=2;
theta1=π/2;
f1[x_]:=x^2;
f2[x_]:=2 Sin[2 x];
sol=FindRoot[f1[x]==f2[x],{x,1.1}];
xint=sol[[1,2]];
area= (∫_0^xint)(f2[x]-f1[x])\[DifferentialD]x;
plt=Plot[{f1[x],f2[x]},{x,0,xint},Filling->{1->{2}},FillingStyle->{Yellow},AxesOrigin->{0,0},AspectRatio->Automatic];
labels=Graphics[{Inset[Style[" (Subscript[f, 1])(x)= (x^2)\n", 16,Black],{0.9,1.0}],Inset[Style[" (Subscript[f, 2])(x)= 2 Sin(2 x)\n", 16,Black],{0.4,1.85}],
Inset[Style[" x = 2 ", 16,Blue],{2,1.9}],
Inset[Style[Row[{"( ",xint," , ", f1[xint]," )"}],16,Black],{xint,f1[xint]-0.1}]},PlotRange->All,Axes->True,AxesOrigin->{0,0}];
text=Graphics[Text[Style[Row[{"area of region = \n",area," square units "}],14,Black],{0.5,1.6}]];
param=ParametricPlot[{a1,t},{t,0,2},PlotStyle->{Dashing[{0.001,0.03,0.11,0.03}],Blue}];
Show[plt,param,labels,text,PlotRange->{{0,2.1},{0,2.1}}]

cap1=ParametricPlot3D[Evaluate[region/.θ->0],{r,a1-xint,a1}];

cap2=ParametricPlot3D[Evaluate[region/.θ->2 theta1],{r,a1-xint,a1}];

a1=2;theta1=3π/4;
region={{r Cos[θ],r Sin[θ],f1[a1-r]},{r Cos[θ],r Sin[θ],f2[a1-r]}};
fig=RevolutionPlot3D[region,{r,a1-xint,a1},{θ,0,theta1}];
cap1=ParametricPlot3D[Evaluate[region/.θ->0],{r,a1-xint,a1}];
cap2=ParametricPlot3D[Evaluate[region/.θ->2theta1],{r,a1-xint,a1}];
line1=Cases[cap1,_Line,Infinity];
line2=Cases[cap2,_Line,Infinity];
polycap1=line1[[1,1]]~Join~Reverse@line1[[2,1]]//Polygon;
polycap2=line2[[1,1]]~Join~Reverse@line2[[2,1]]//Polygon;
Show[fig,Graphics3D[{EdgeForm[{Thick,Blue}],FaceForm[{Opacity[1],Pink}],polycap1,polycap2}]]

Putting things together

f1[x_]:=x^2;
f2[x_]:=2 Sin[2 x];
sol=FindRoot[f1[x]==f2[x],{x,1.1}];
xint=sol[[1,2]];a1=2;
region={{r Cos[θ],r Sin[θ],f1[a1-r]},{r Cos[θ],r Sin[θ],f2[a1-r]}};
fillcap[theta1_]:=Block[{fig,cap1,cap2,line1,line2,polycap1,polycap2},
fig=RevolutionPlot3D[region,{r,a1-xint,a1},{θ,0,theta1}];
cap1=ParametricPlot3D[Evaluate[region/.θ->0],{r,a1-xint,a1}];
cap2=ParametricPlot3D[Evaluate[region/.θ->2theta1],{r,a1-xint,a1}];
line1=Cases[cap1,_Line,Infinity];
line2=Cases[cap2,_Line,Infinity];
polycap1=line1[[1,1]]~Join~Reverse@line1[[2,1]]//Polygon;
polycap2=line2[[1,1]]~Join~Reverse@line2[[2,1]]//Polygon;
Show[fig,Graphics3D[{EdgeForm[{Thick,Blue}],FaceForm[{Opacity[1],Pink}],polycap1,polycap2}]]
];

fillcap[π/2]

translate=Graphics3D[{Translate[fillcap[π/2][[1]],{2,0,0}]},Axes->True]

ClearAll["Global`*"];

Module[{a1,theta1,hint,answer},Manipulate[
f1[x_]:=2. Sin[2 x];f2[x_]:=x^2;
sol=FindRoot[f1[x]==f2[x],{x,1.1}];
xint=sol[[1,2]];
volume1:=(∫_0^xint)2 π x (f1[x]-f2[x])\[DifferentialD]x;
region:={{r Cos[θ],r Sin[θ],f1[a1-r]},{r Cos[θ],r Sin[θ],f2[a1-r]}};fig:=RevolutionPlot3D[region,{r,a1-xint,a1},{θ,0,theta1}];

Column[{
Item[If[answer,Style[Row[{"\nVolume of the solid = ",volume1,"  (cm^3)\n"}],16,Purple],Style[Row[{"\nCalculate the volume of the solid generated by \nrevolving the region about x = ",If[a1>-10^-8&&a1<10^-8,y,a1]," axis\n"}],
16,Black,Italic]
],Alignment->{Center}, Frame->True],
Item[

fp1=Plot[{f1[x],f2[x]},{x,0,xint},Filling->{1->{2}},FillingStyle->Pink,AxesLabel->{ "x" ,"Y"},LabelStyle->Directive[12,Italic,Bold],PlotRange->{{-1,6.5},{-0.5,2.3}},AspectRatio->Automatic];

text1=Graphics[Inset[Style["y = 2 Sin (2 x)",12,Bold,Italic],{0.27,1.21}]];
text2=Graphics[Text[Style["y = (x^2)",14,Italic,Blue],{1.,0.6}]];
intersectionpoint=Graphics[Inset[Style[Row[{"( ",xint," , ", f1[xint]," )"}],16,Black],{xint,f1[xint]-0.1}]];
text3=Graphics[Text[Style[Row[{"x = ",a1}],16,Bold,Italic,Red],{a1-0.2,1.8}]];

fp2=Plot[{f1[-(x-2 a1)],f2[2 a1-x]},{x,2a1-xint,2 a1},Filling->{1->{2}},FillingStyle->Hue[0.15],AspectRatio->Automatic];
pp=ParametricPlot[{a1,t},{t,0,2},PlotStyle->{Thickness[0.01],Dashing[{0.001,0.03,0.11,0.03}],RGBColor[1,0,0]}];
ppp:=ParametricPlot3D[{a1,0,t},{t,0,3.2},PlotStyle->{Thickness[0.006],Dashing[{0.0015,0.02,0.07,0.02}],RGBColor[0,0,1]}];

revx2=Quiet[Graphics3D[{Translate[fillcap1[theta1][[1]],{a1,0,0}]},Axes->True]];

s1=Row[{Show[fp1,pp,If[hint,Show[fp2],{}],text1,text2,intersectionpoint,text3,AspectRatio->Automatic,PlotRange->All,ImageSize->Medium],Spacer[35],
Show[revx2,ppp,ImageSize->Medium,AspectRatio->Automatic,Boxed->False]}],Alignment->{Center},Frame->True]
}],
Row[{Control[{{a1,2,"revolving axis"},-3.,3,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[
{{theta1,2,"revolving angle"},0, π,Appearance->"Labeled",ImageSize->Tiny}],Spacer[30],Control[{{hint,False,"hint"},{False,True}}],Spacer[30],
Control[{{answer,False,"answer"},{False,True}}]
}],TrackedSymbols:>{a1,theta1,hint,answer},Initialization:>{fillcap1[theta1_]:=Block[{fig,cap1,cap2,line1,line2,polycap1,polycap2},
fig=RevolutionPlot3D[region,{r,a1-xint,a1},{θ,0,theta1}];
cap1=ParametricPlot3D[Evaluate[region/.θ->0],{r,a1-xint,a1}];
cap2=ParametricPlot3D[Evaluate[region/.θ->2theta1],{r,a1-xint,a1}];

line1=Cases[cap1,_Line,Infinity];
line2=Cases[cap2,_Line,Infinity];
polycap1=line1[[1,1]]~Join~Reverse@line1[[2,1]]//Polygon;
polycap2=line2[[1,1]]~Join~Reverse@line2[[2,1]]//Polygon;
Show[fig,cap1,cap2,Graphics3D[{EdgeForm[{Thick,Blue}],FaceForm[{Opacity[1],Pink}],polycap1,polycap2}]]
];},  SaveDefinitions->True]]

Example 2

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`*"];

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}]

Example 3

Rotating a Parabola about x = a

We use Cylindrical method, or washer  to calculate the volume.
N.B.:  Verify your answer by calculating the area of the parabola as a base of a prism.
The area of the parabola = (2/3) Base times height = (2/3) 6 (9) = 36 square units.
Therefore, the volume = 36 times the circumference of the circle whose radius = the distance between the revolution axis and the centerline of the parabola.

ClearAll["Global`*"];

Manipulate[
Off[(MessageTemplate[Dot, rect, "Nonrectangular tensor encountered.", , , , , Local])];
f[x_]=(9 - (x+5)^2);
g[x_]=b(9 - (x+5)^2);
volumeP=(∫_(-8)^(-2))(2 π (revolutionaxis-x)(f[x]))\[DifferentialD]x;
region={{r Cos[θ],r Sin[θ],f[revolutionaxis+r]}};

axis=Graphics3D[{Blue,InfiniteLine[{revolutionaxis,0,0},{0,0,1}]}];fig=RevolutionPlot3D[region,{r,-revolutionaxis-2,-revolutionaxis-8},{θ,0,angle/2},PlotStyle->Green,PlotRange->All];
tfig=Graphics3D[{InfiniteLine[{revolutionaxis,0,0},{0,0,1}],Translate[fig[[1]],{revolutionaxis,0,0}]},Axes->True];
pp:=ParametricPlot3D[{revolutionaxis,0,t},{t,0,12},PlotStyle->{Thickness[0.006],Dashing[{0.0015,0.02,0.07,0.02}],RGBColor[0,0,1]}];
t2=RotationMatrix[θ,{0,0,1}].{x-revolutionaxis,y,z}+{revolutionaxis,0,0};
wall=t2/.{x->t,y->0,z->f[t]};
floor=t2/.{x->t,y->0,z->0};
capleft=t2/.{x->t,y->0,z->g[t],θ->0};
capright=t2/.{x->t,y->0,z->g[t],θ->angle};
surface=ParametricPlot3D[{wall,floor},{θ,0,angle},{t,-8,-2},PlotStyle->{Green,LightBlue},Boxed->False,PlotRange->All];
capL=ParametricPlot3D[{capleft},{t,-2,-8},{b,0,1},PlotStyle->{LightOrange},Boxed->False,PlotRange->All,MeshStyle->None];
caps=ParametricPlot3D[{capleft,capright},{t,-2,-8},{b,0,1},PlotStyle->{Green,Blue},Boxed->False,PlotRange->All];
slice1=ParametricPlot3D[{wall,floor},{θ,0,angle},{t,-6,-6+deltat},PlotStyle->{Red,Red},Boxed->False,PlotRange->All,AxesLabel->{Style["x",Large,Italic],Style["y",Large,Italic],Style["z",Large,Italic]},Axes->True,Boxed->False,PlotLabel->Style["Volume of the revolving solid\n =(∫_(-8)^(-2))(2 π (revolutionaxis-x)(f[x]))\[DifferentialD]x",14,Purple]];
slice=Graphics3D[{{Red,Polygon[{{-7,0,f[-7]},{-7+deltat,0,f[-7+deltat]},{-7+deltat,0,0},{-7,0,0}}]},{Red,Polygon[RotationTransform[angle,{0,0,1},{revolutionaxis,0,0}][{{-7,0,f[-7]},{-7+deltat,0,f[-7+deltat]},{-7+deltat,0,0},{-7,0,0}}]],Blue,InfiniteLine[{revolutionaxis,0,0},{0,0,1}]}}
];

Show[slice1,slice,surface,tfig,pp,PlotRange->All],
{{deltat,0.6,"slice thickness"},0.3,3.6,0.3,Appearance->"Labeled"},
{{revolutionaxis,3,"Revolutionaxis"},-1,4,1,Appearance->"Labeled"},
{{angle,-3π/4,"angle"},-2π,2.π,Appearance->"Labeled"},
TrackedSymbols:>{deltat,revolutionaxis,angle},SaveDefinitions->True]

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

ClearAll["Global`*"];

Module[{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 3 Revolving a hexagon

Write a function or functions to generate the following 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}}];
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]

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,  apothem = 3(Sqrt[3]) units  
Area = Half perimeter times apothem = 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 hexagon.

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}]

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

ClearAll["Global`*"];

Module[{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]]

Now check for the AP Calculus AB test question 2014

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`*"];

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,1.2}];

Module[{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,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=Quiet[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=Quiet[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,AxesLabel->{Style["x",FontSize->16,Italic],Style["y",FontSize->16,Italic],Style["Z",FontSize->16,Italic]},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->Large],Show[fillcaps[theta],ImageSize->Medium]}],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]]