Max-Min Problems from Calc 1

Clear[CreateSignLine, CreateRangedSignLine]
CreateSignLine[ mess_,x_,plotlabel_:None]:=
Block[ {realsols, xvals, text, basegraphics,k,xmin,xmax,signs,mess1},
mess1=Simplify[1/mess];
realsols=Join[Solve[ mess==0,x,Reals], Solve[Denominator[mess]==0,x,Reals],Solve[mess1==0,x,Reals]] ;
xvals=If[Length[realsols]==0, {},Quiet[Select[Sort[x/. realsols], (Element[mess/. x-> #1, Reals]||((Denominator[ mess]/. x-> #1) ==0)||((mess1/. x-> #1) ==0))&]]];
If[Length[xvals]==0,
Return[Show[Graphics[Table[ Text[Which[ (mess/. x->0)>0, "+",(mess/. x->0)<0,"-"], {k,.5} ], {k,-5,5,.5}]], PlotRange-> {{-5,5}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}]]];
xmin=Floor[Min[xvals]]-1;
xmax=Ceiling[ Max[xvals]+1];
basegraphics=Quiet[Join[ {Black}, Map[ Which[((Denominator[mess]/. x-> #1)==0)||(mess1/. x-> #1)==0||(mess1/. x-> #1)===Indeterminate,Circle[ {#1,0},1/15],True,Disk[ {#1,0},1/15]]&,xvals], Map[Text[ TraditionalForm[#1], {#1,-.75}]&,xvals] ]];
signs=Quiet[Table[Text[Which[Min[Abs[xvals-k]]<.1,"", !Element[(mess/. x-> k), Reals],"X",(mess/. x->k)>0, "+", True, "-"], {k,If[!Element[(mess/. x-> k), Reals],0,.5]}   ], {k,xmin,xmax,.2}]];
Return[Show[Graphics[Union[basegraphics,signs]], PlotRange-> {{xmin,xmax}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}, PlotRangePadding-> .1, PlotLabel-> plotlabel]]
];

CreateRangedSignLine[ mess_,x_,{a_,b_},plotlabel_:None]:=
Block[ {realsols, xvals, text, basegraphics,k,xmin,xmax,signs,mess1},
mess1=Simplify[1/mess];
realsols=Union[{ToRules[Reduce[ mess==0 && a≤ x≤ b,x,Reals]]}, {ToRules[Reduce[Denominator[mess]==0 && a≤ x ≤ b,x,Reals]]},{ToRules[Reduce[mess1==0 && a≤ x≤ b,x,Reals]]}] ;
xvals=If[Length[realsols]==0, {},Quiet[Select[Sort[x/. realsols], (Element[mess/. x-> #1, Reals]||((Denominator[ mess]/. x-> #1) ==0)||((mess1 /. x-> #1)==0))&]]];
If[Length[xvals]==0,
Return[Show[Graphics[Table[ Text[Which[ (mess/. x->0)>0, "+",(mess/. x->0)<0,"-"], {k,.5} ], {k,-5,5,.5}]], PlotRange-> {{-5,5}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}]]];
xmin=Floor[Min[xvals]]-1;
xmax=Ceiling[ Max[xvals]+1];
basegraphics=Quiet[Join[ {Black}, Map[ Which[((Denominator[mess]/. x-> #1)==0)||(mess1/. x-> #1)==0||(mess1/. x-> #1)===Indeterminate,Circle[ {#1,0},1/15],True,Disk[ {#1,0},1/15]]&,xvals], Map[Text[ TraditionalForm[#1], {#1,-.75}]&,xvals] ]];
signs=Quiet[Table[Text[Which[Min[Abs[xvals-k]]<.1,"", !Element[(mess/. x-> k), Reals],"X",(mess/. x->k)>0, "+", True, "-"], {k,If[!Element[(mess/. x-> k), Reals],0,.5]}   ], {k,a,b,.2}]];
Return[Show[Graphics[Union[basegraphics,signs]], Graphics[{Blue,Text[Which[ !Element[(mess/. x-> a), Reals],"X",(mess/. x->a)>0, "+", (mess/. x->a)==0,"0",True, "-"], {a,.6}],Text[Which[ !Element[(mess/. x-> b), Reals],"X",(mess/. x->b)>0, "+", (mess/. x->b)==0,"0",True, "-"], {b,.6}],Disk[{a,0},1/14], Disk[ {b,0},1/14]}], PlotRange-> {{a,b}, {-1.5,1.5}},  Ticks-> {Union[Table[k, {k,-5,5}],{a,b}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}, PlotRangePadding-> .3, PlotLabel-> plotlabel]]
];

NCreateSignLine[ mess_,x_,numflag_, plotlabel_:None]:=
Block[ {realsols, xvals, text, basegraphics,k,xmin,xmax,signs,mess1},
mess1=Simplify[1/mess];
realsols=Join[Solve[ mess==0,x,Reals], Solve[Denominator[mess]==0,x,Reals],Solve[mess1==0,x,Reals]] ;
xvals=If[Length[realsols]==0, {},Quiet[Select[Sort[x/. realsols], (Element[mess/. x-> #1, Reals]||((Denominator[ mess]/. x-> #1) ==0)||((mess1/. x-> #1) ==0))&]]];
If[numflag≠ Infinity, xvals=N[xvals,numflag]];
If[Length[xvals]==0,
Return[Show[Graphics[Table[ Text[Which[ (mess/. x->0)>0, "+",(mess/. x->0)<0,"-"], {k,.5} ], {k,-5,5,.5}]], PlotRange-> {{-5,5}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}]]];
xmin=Floor[Min[xvals]]-1;
xmax=Ceiling[ Max[xvals]+1];
basegraphics=Quiet[Join[ {Black}, Map[ Which[((Denominator[mess]/. x-> #1)==0)||((mess1/. x-> #1 )==0),Circle[ {#1,0},1/15],True,Disk[ {#1,0},1/15]]&,xvals], Map[Text[ TraditionalForm[#1], {#1,-.75}]&,xvals] ]];
signs=Quiet[Table[Text[Which[Min[Abs[xvals-k]]<.1,"", !Element[(mess/. x-> k), Reals],"X",(mess/. x->k)>0, "+", True, "-"], {k,If[!Element[(mess/. x-> k), Reals],0,.5]}   ], {k,xmin,xmax,.2}]];
Return[Show[Graphics[Union[basegraphics,signs]], PlotRange-> {{xmin,xmax}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}, PlotRangePadding-> .1, PlotLabel-> plotlabel]]
];

NCreateRangedSignLine[ mess_,x_,{a_,b_},numflag_, plotlabel_:None]:=
Block[ {realsols, xvals, text, basegraphics,k,xmin,xmax,signs,mess1},
mess1=Simplify[1/mess];
realsols=Union[{ToRules[Reduce[ mess==0 && a≤ x≤ b,x,Reals]]}, {ToRules[Reduce[Denominator[mess]==0 && a≤ x ≤ b,x,Reals]]},{ToRules[Reduce[mess1==0 && a≤ x≤ b,x,Reals]]}] ;
xvals=If[Length[realsols]==0, {},Quiet[Select[Sort[x/. realsols], (Element[mess/. x-> #1, Reals]||((Denominator[ mess]/. x-> #1) ==0)||((mess1 /. x-> #1)==0))&]]];
If[numflag≠ Infinity, xvals=N[xvals,numflag]];
If[Length[xvals]==0,
Return[Show[Graphics[Table[ Text[Which[ (mess/. x->0)>0, "+",(mess/. x->0)<0,"-"], {k,.5} ], {k,-5,5,.5}]], PlotRange-> {{-5,5}, {-1.5,1.5}},  Ticks-> {Table[k, {k,-5,5}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}]]];
xmin=Floor[Min[xvals]]-1;
xmax=Ceiling[ Max[xvals]+1];
basegraphics=Quiet[Join[ {Black}, Map[ Which[((Denominator[mess]/. x-> #1)==0)||(mess1/. x-> #1)==0,Circle[ {#1,0},1/15],True,Disk[ {#1,0},1/15]]&,xvals], Map[Text[ TraditionalForm[#1], {#1,-.75}]&,xvals] ]];
signs=Quiet[Table[Text[Which[Min[Abs[xvals-k]]<.1,"", !Element[(mess/. x-> k), Reals],"X",(mess/. x->k)>0, "+", True, "-"], {k,If[!Element[(mess/. x-> k), Reals],0,.5]}   ], {k,a,b,.2}]];
Return[Show[Graphics[Union[basegraphics,signs]], Graphics[{Blue,Text[Which[ !Element[(mess/. x-> a), Reals],"X",(mess/. x->a)>0, "+", (mess/. x->a)==0,"0",True, "-"], {a,.6}],Text[Which[ !Element[(mess/. x-> b), Reals],"X",(mess/. x->b)>0, "+", (mess/. x->b)==0,"0",True, "-"], {b,.6}],Disk[{a,0},1/14], Disk[ {b,0},1/14]}], PlotRange-> {{a,b}, {-1.5,1.5}},  Ticks-> {Union[Table[k, {k,-5,5}],{a,b}], None}, Axes-> {True, False},TicksStyle->{Opacity[1], Black}, PlotRangePadding-> .3, PlotLabel-> plotlabel]]
];

Volume of a box.

You have a piece of cardboard 50” on a side.  You will make an open-topped box from this by removing squares of equal size from the 4 corners and folding up the resultant flaps.  What is the largest volume box you can make?

Manipulate[ Column[{Row[{Show[Graphics[{LightBlue, Polygon[{{x,0},{50-x,0},{50-x,x},{50,x},{50,50-x},{50-x,50-x},{50-x,50},{x,50},{x,50-x},{0,50-x},{0,x},{x,x},{x,0}}], LightRed, Rectangle[{0,0}, {x,x}], Rectangle[{50-x,x},{50,0}], Rectangle[{50,50},{50-x,50-x}], Rectangle[{0,50},{x,50-x}], Thick, Dashed, Red,Line[{{0,50-x},{x,50-x},{x,50}}], Line[{{0,x},{x,x},{x,0}}], Line[{{50-x,0},{50-x,x},{50,x}}], Line[{{50-x,50},{50-x,50-x}, {50,50-x}}], Blue, Line[{{x,x},{50-x,x},{50-x,50-x},{x,50-x},{x,x}}]}], ImageSize-> 225,PlotLabel->Row[{"The squares removed have side length ",x}]],Show[Graphics3D[Cuboid[{x,x,0},{50-x,50-x,x}], PlotRange-> {{0,50},{0,50},{0,25}}],ImageSize->300, Axes->True, PlotLabel-> Row[{"The current volume is ",x(50-2x)^2, " (in^3)"}]]}], Plot[ t(50-2t)^2, {t,0,x}, PlotRange-> {{0,25},{-.1,11000}}, ImageSize-> 300, PlotLabel-> "Volume vs. length of side removed", AxesLabel-> {" side length", " volume"}, Epilog->{Red, PointSize[Medium], Point[{x,x(50-2x)^2}], Line[{{x,0},{x,x(50-2x)^2}}]}]}, Alignment-> Center], {{x,.01, "Side length of removed squares:"},.01,25,.01}, SaveDefinitions-> True]

Solution

Let x be the side length of the square being removed.  Then as you are removing squares on each side and each side has length 50,  0≤2x≤50 or 0≤x≤25.  The length l of the box will be 50-2x, and the width w will also be 50-2x.  The depth d  of the box is the same as the size of the squares being removed, so d=x.  The volume of a box is given by its length times width times depth, so we need ot maximize V=l w d=(50-2x)(50-2x)x=((x(50-2x))^2), where 0≤x≤25.

V'=((d/(dx))x)(((50-2x))^2)+x((d/(dx))(((50-2x))^2))=(((50-2x))^2)+x(2(50-2x)(-2))=(((50-2x))^2)-4x(50-2x)=(50-2x)( (50-2x)-4x)=(50-2x)(50-6x).  This exists everywhere, so the critical numbers will come from V'=0.  This happens when 50-2x=0 or 50-6x=0, which is x=25,(25/3).  As the volume is continuous on th eclosed interval [0,25], it suffices to make a table of values for x=0, (25/3), 25 and choose the largest:

TableForm[{x, x(50-2x)^2}/. {{x->0}, {x-> 25/3}, {x-> 25}}, TableHeadings-> {None, {x,Row[{"Volume = ",x(50-2x)^2}]}}, TableAlignments->Center]

So we see the largest volume is (250000/27) cubic inches, and this happens when squares of side length (25/3) are removed.

The point on a curve closest to a given point

Which point on the curve y=(x^2) is closest to the point (4,(7/2))?

Manipulate[ Row[{Plot[t^2, {t,-6,6}, Epilog-> {PointSize[Medium], Point[ {{x[[1]], x[[1]]^2},{4,7/2}}], Line[ {{x[[1]], x[[1]]^2},{4,7/2}}]}, ImageSize-> 250, PlotLabel-> Column[{Row[{"The current point is (",x[[1]],", ",x[[1]]^2,")."}]}]],Plot[Sqrt[(t-4)^2+ (t^2-7/2)^2],{t,-6,x[[1]]}, Epilog-> {PointSize[Medium],Point[ {x[[1]],  Sqrt[(x[[1]]-4)^2+(x[[1]]^2-7/2)^2] }], Line[{{x[[1]],0},{x[[1]],  Sqrt[(x[[1]]-4)^2+(x[[1]]^2-7/2)^2] }}] },ImageSize-> 250, PlotRange-> {{-6,6},{-.1, 20}}, PlotLabel-> Row[{"The current distance is ", Sqrt[(x[[1]]-4)^2+(x[[1]]^2-7/2)^2]}]]}], {{x,{-1.,0}}, Locator, Appearance-> None}, SaveDefinitions->True]

Solution

Let x be an any real number.  Then we can represent any point on the curve y=(x^2) as the point (x,(x^2)).  The distance from (4,(7/2)) to (x,(x^2)) is given by D=(Sqrt[(((x-4))^2)+((((x^2)-(7/2)))^2)]).  We have to minimize this with no restrictions on x.  ((dD)/(dx))=(d/(dx))((((((x-4))^2)+((((x^2)-(7/2)))^2)))^(1/2))=(1/2)((((((x-4))^2)+((((x^2)-(7/2)))^2)))^(-1/2))(d/(dx))((((x-4))^2)+((((x^2)-(7/2)))^2))=(1/2)((((((x-4))^2)+((((x^2)-(7/2)))^2)))^(-1/2))(2(x-4)+2((x^2)-(7/2))2x)=((4(x^3)-12x-8)/(2(Sqrt[(((x-4))^2)+((((x^2)-(7/2)))^2)])))=((2((x^3)-3x-2))/(Sqrt[(((x-4))^2)+((((x^2)-(7/2)))^2)])).
The square root on the bottom is the distance from (x,(x^2)) to (4,(7/2)); as (4,(7/2)) is not on the curve, the bottom is never 0 and the derivative is defined everywhere.  The derivative can only be 0 when (x^3)-3x-2=0.  (x^3)-3x-2=(((x+1))^2)(x-2), so the derivative is only 0 at x=-1, 2.  Doing a sign line for the derivative we have

Show[CreateSignLine[ 2(x^3-3x-2)/Sqrt[ (x-4)^2+(x^2-7/2)^2],x,TraditionalForm[y'[x]==2(x^3-3x-2)/Sqrt[ (x-4)^2+(x^2-7/2)^2]]], PlotRange-> Automatic]

From this we can see the distance in decreasing on (-∞,-1) and (-1,2) and increasing on (2,∞); therefore x=2 corresponds to an absolute minimum.  So the point (x,(x^2))=(2,(2^2))=(2,4) is the closes point on y=(x^2) to the point (4,(7/2)).

Cylinder of maximum volume in a sphere

What is the largest volume for a cylinder which can be inscribed in the unit sphere?

Manipulate[ Row[{Show[ Graphics3D[ {Opacity[.2], Sphere[{0,0,0},1],Opacity[1],Cylinder[{ {0,0,Sqrt[1-x^2]}, {0,0,-Sqrt[1-x^2]}}, x]}] ,PlotRange-> {{-1,1},{-1,1},{-1,1}}, Boxed-> False, Axes-> {True, False, True}, AxesOrigin-> {0,0,0}, ImageSize-> 300, ViewPoint-> {1,10,3},PlotLabel-> Row[{"The current volume is ", Pi x^2 Sqrt[1-x^2], " (in^3)"}]], Plot[ Pi t^2 Sqrt[1-t^2], {t,0,x}, PlotRange-> {{0,1}, {0,2}}, ImageSize-> 250, PlotLabel-> Column[{"Volume vs. radius", Row[{"the current radius is ",x}]}, Alignment-> Center],Epilog-> {PointSize[Medium],Point[ {x,   Pi x^2 Sqrt[1-x^2] }], Line[{{x,0},{x,  Pi x^2 Sqrt[1-x^2] }}] }, AxesLabel-> {"radius", "volume"}]}], {{x,.005,"Radius of inscribed cylinder"},0.005,1,.005},SaveDefinitions-> True]

Solution

Orient the cylinder vertically as in the picture.  If we cut the 3D picture in half to get a cross-section the unit sphere will become the unit circle and the cylinder will become a rectangle.  If we let x be the radius of the cylinder, then as the radius touches the sphere we must have 0≤x≤1.  The rectangle will go up and down from the points (x,0) and (-x,0) until they hit the circle:

Show[ParametricPlot[{Cos[t], Sin[t]}, {t,0,2Pi}], Graphics[{PointSize[Medium],Point[{{1/3,0}, {1/3, Sqrt[1-1/9]}, {1/3, -Sqrt[1-1/9]}, {-1/3, Sqrt[1-1/9]}, {-1/3, -Sqrt[1-1/9]}}], Line[{{1/3,0}, {1/3, Sqrt[1-1/9]}, {-1/3, Sqrt[1-1/9]}, {-1/3, -Sqrt[1-1/9]},{1/3, -Sqrt[1-1/9]}, {1/3,0}}], Style[Text[TraditionalForm[x], {.4,.1}], FontSize->14],Style[Text["(x,(Sqrt[1 - (x^2)]))", {.65,1}], FontSize->14],Style[Text["(x,-(Sqrt[1 - (x^2)]))", {.65,-1}], FontSize->14]}
], PlotRange-> {{-1.2,1.2},{-1.2,1.2}}]

The height h of the cylinder is the distance from (x,-(Sqrt[1-(x^2)])) to (x,(Sqrt[1-(x^2)])); so h=2(Sqrt[1-(x^2)]).  The volume of a cylinder of radius r and height h is V=π (r^2) h.  Using our values r=x and h=2(Sqrt[1-(x^2)]) we get V=π ((x(2(Sqrt[1-(x^2)])))^2)=4π x(1-(x^2))=4π(x-(x^3)), where 0≤x≤1.  V'=4π(1-3(x^2)).  This exists everywhere so the only critical numbers will come from when V'=0.  This is the same as 1-3(x^2)=0, or x=±(Sqrt[(1/3)])=±(1/(Sqrt[3])).  Only x=(1/(Sqrt[3])) is in the interval 0≤ x≤ 1, so we need only make a table of values for x=0, (1/(Sqrt[3])), 1.

TableForm[{x, 4Pi x (x-x^3)}/. {{x->0}, {x-> 1/Sqrt[3]}, {x-> 1}}, TableHeadings-> {None, {x,Row[{"Volume = ",4Pi (x-x^3)}]}}, TableAlignments->Center]

So the maximum volume cylinder you can put in the unit sphere is one of ((8π)/9) cubic units, and it has a radius of (1/(Sqrt[3])) and a height of 2(Sqrt[1-((((1/(Sqrt[3]))))^2)])=2(Sqrt[(2/3)]).

Cylinder of maximum volume with a given area

The surface area of a cylinder is 24π square units.  What is the maximum volume it can have?

Manipulate[ Row[{Show[ Graphics3D[ {Cylinder[{ {0,0,0}, {0,0,(12-x^2)/x}}, x]}] ,PlotRange-> {{-3.6,3.6},{-3.6,3.6},{0,50}}, Boxed-> False, Axes-> {True, False, True}, AxesOrigin-> {0,0,0}, ImageSize-> 250, ViewPoint-> {1,10,3},BoxRatios-> {1,1,1},PlotLabel-> Row[{"The current volume is ", Pi x(12-x^2), " (in^3)"}]], Plot[ Pi t (12-t^2), {t,0,x}, PlotRange-> {{0,Sqrt[13]}, {0,60}}, ImageSize-> 250, PlotLabel-> Column[{"Volume vs. radius", Row[{"the current radius is ",x}]}, Alignment-> Center],Epilog-> {PointSize[Medium],Point[ {x,   Pi x(12-x^2) }], Line[{{x,0},{x,  Pi x(12-x^2) }}] }]}], {{x,.3,"Radius of cylinder with area 24 π:"},0.005,Sqrt[12],.001},SaveDefinitions-> True]

Solution

The surface area of a cylinder of radius r and height h is A=2π (r^2)+2π r h (the area of 2 circles of radius r and a rectange whose height is h and whose width is the circle’s circumference 2π r).  The volume is given by V=π (r^2)h.  We need to eliminate one of the variables in the volume formula before we can apply our max-min technique to it (which is only good for functions of 1 variable, not 2).  Given that the area is 24 π we know 24 π=2π (r^2)+2π r h; solving this for h yields h=((24π-2π (r^2))/(2π r))=((12-(r^2))/r).  Substituting this value for h into the volume formual gives V=π (r^2)h=π (r^2)(((12-(r^2))/r))=π(12r-(r^3)).  r must be 0 or larger; in addition, there is an upper limit on how large r can get because of the area formula  24 π=2π (r^2)+2π r h.  The lowest the height can be is 0; this would give us 24 π=2π (r^2)+2π r 0=2 π (r^2), or (r^2)=12, which yields r=(Sqrt[12])=2(Sqrt[3]) (remember, r≥0). So the radius r must be in the interval 0≤r≤(Sqrt[12]).  V'=π(12-3(r^2)).  This exists everywhere, so the only critical numbers will come from where V'=0.  This happens only if 12-3(r^2)=0, or (r^2)=4, which gives us r=±2.  Since the radius cannot be negative we need only make a table of values for the volume with the endpoints r=0, (Sqrt[12]) and the critical point r=2:

TableForm[{HoldForm[x], Pi(12x-x^3)}/. {{x->0}, {x-> 2}, {x-> Sqrt[12]}}, TableHeadings-> {None, {x,Row[{"Volume = ",Pi (12x-x^3)}]}}, TableAlignments->Center]

So it looks like the maximum volume of the cylinder is 16π cubic units, and it happens when the radius is 2 and the height is ((12-(2^2))/2)=4.  Note that this is a “square” can, one whose width and height is the same.

Chasing a frisbee

You are standing on a beach and you are 20 feet away from the water.  You toss a frisbee 40 feet directly down the beach and 10 feet into the water.  If your dog takes twice as long to swim as it does to run and can only run/swim in straight lines, what path should it take to get to the frisbee the quickest?

Manipulate[ Row[{Show[ Graphics[{RGBColor[.92,.72,.53], Rectangle[ {-5,-25},{45,0}], LightBlue, Rectangle[{-5,0},{45,12}],Red, Disk[{40,10},.5], Black, Disk[{0,-20},1/2], Gray,Disk[{x[[1]],0},3/4], Black,Thickness[.005], Arrow[{{0,-20},{x[[1]],0}}], Thickness[.01], Arrow[{{x[[1]],0},{40,10}}]}], Axes-> True, AxesOrigin-> {0,0}, ImageSize-> 325, PlotRange->{{-5,45},{-25,12}} , PlotLabel-> Row[{"The sand-water transition happens ",x[[1]]," feet down the beach"}]],Plot[EuclideanDistance[{0,-20},{t,0}]+2 EuclideanDistance[{t,0},{40,10}],{t,-.0001,x[[1]]}, Epilog-> {PointSize[Medium],Point[ {x[[1]],  EuclideanDistance[{0,-20},{x[[1]],0}]+2 EuclideanDistance[{x[[1]],0},{40,10}] }], Line[{{x[[1]],0},{x[[1]], EuclideanDistance[{0,-20},{x[[1]],0}]+2 EuclideanDistance[{x[[1]],0},{40,10}] }}] },ImageSize-> 250, PlotRange-> {{0,45},{-.1, 120}}, PlotLabel-> Row[{"The current total travel time is ",EuclideanDistance[{0,-20},{x[[1]],0}]+2 EuclideanDistance[{x[[1]],0},{40,10}]}]]}], {{x,{10.,0}}, Locator, Appearance-> None}, SaveDefinitions->True]

Solution

Let the origin be placed at the waterline directly in front of where we stand.  Then we are at the point (0,-20) and the frisbee is at the point (40,10).  Given that our dog can only run in straight lines the only choice he can make to minimize the travel time is where he will enter the water.  Assume this point is (x,0).  For simplicity assume that the dog’s land speed is 1 foot per second, so the swim speed is (1/2) foot per second.  If (Subscript[d, 1])is the distance the dog runs and (Subscript[d, 2])is the distance he swims then we need to figure out the corresponding times for each part of the trip.  In general distance = speed × time, or time=(distance/speed); so the time the dog runs is ((Subscript[d, 1])/1)=(Subscript[d, 1]) and the time he swims is ((Subscript[d, 2])/(1/2))=2(Subscript[d, 2]).  So the total travel time to be minimized is T=(Subscript[d, 1])+2(Subscript[d, 2]), where (Subscript[d, 1]) is the land distance and (Subscript[d, 2]) is the water distance.  (Subscript[d, 1])is the distance from (0,-20) to (x,0), so (Subscript[d, 1])=(Sqrt[(((x-0))^2)+(((0+20))^2)])=(Sqrt[(x^2)+400]).  (Subscript[d, 2]) is the distance from (40,10) to (x,0), so (Subscript[d, 2])=(Sqrt[(((x-40))^2)+(((0-10))^2)])=(Sqrt[(x^2)-80x+1700]).  So we need to minimize T=(Subscript[d, 1])+2(Subscript[d, 2])=(Sqrt[(x^2)+400])+2(Sqrt[(x^2)-80x+1700]).  There is no restriction on the value of x, although we would certainly expect the maximum to happen somewhere from 0 to 40.

T'=(d/(dx))((Sqrt[(x^2)+400])+2(Sqrt[(x^2)-80x+1700]))=(d/(dx))(((((x^2)+400))^(1/2))+2((((x^2)-80x+1700))^(1/2)))=(1/2)((((x^2)+400))^(-1/2))(2x)+(1/2)((((x^2)-80x+1700))^(-1/2))(2x-80)=(x/(Sqrt[(x^2)+400]))+((2x-80)/(Sqrt[(x^2)-80x+1700])).  This exists everywhere as the numbers in the roots are never 0 (being the sums of 2 squares), so the critical numbers will happen when T'=0.  This is the same as (x/(Sqrt[(x^2)+400]))+((2x-80)/(Sqrt[(x^2)-80x+1700]))=0, or -(x/(Sqrt[(x^2)+400]))=((2x-80)/(Sqrt[(x^2)-80x+1700])).  Squaring both sides gives ((x^2)/((x^2)+400))=((((2x-80))^2)/((x^2)-80x+1700)), or ((x^2)/((x^2)+400))=((4(x^2)-320x+6400)/((x^2)-80x+1700)).  Cross-multiplying yields (x^2)((x^2)-80x+1700)=((x^2)+400)(4(x^2)-320x+6400), or (x^4)-80(x^3)+1700(x^2)=4 (x^4)-320 (x^3)+8000 (x^2)-128000 x+2560000.  Bringing all the terms to one side reduces this to 3 (x^4)-240 (x^3)+6300 (x^2)-128000 x+2560000=0.  This is too hard for us to solve exactly, but graphing y=3 (x^4)-240 (x^3)+6300 (x^2)-128000 x+2560000 gives us

Plot[3 (x^4)-240 (x^3)+6300 (x^2)-128000 x+2560000, {x,-1,50}]

So we can see there is a solution near 35 and a solution near 45.  Using Newton’s Method to estimate these solutions gives us x≈35.17378, 45.13989.  The second solution cannot really be a solution to (x/(Sqrt[(x^2)+400]))+((2x-80)/(Sqrt[(x^2)-80x+1700]))=0 as it makes both terms of the right hand side positive; it must be an extraneous root introduced by squaring both sides.  So using an approximate sign line for the derivative we have

Show[NCreateSignLine[(x/(Sqrt[400+(x^2)]))+((-80+2 x)/(Sqrt[1700-80 x+(x^2)])),x,10, TraditionalForm[T'[x]==(x/(Sqrt[400+(x^2)]))+((-80+2 x)/(Sqrt[1700-80 x+(x^2)]))]], PlotRange-> Automatic]

So the total time is decreasing until the approximate root x≈35.17378 and increasing after it. So to minimize the total travel time the dog should run from you directly to a point about 35.17378 down the shoreline and then swim straight out to the frisbee.

Getting a pipe around a corner

There is an “L” shaped hallway where a 7 foot wide hallway and a 14 foot wide hallway meet.  What is the longest pipe you can get around the corner if you can’t tilt it up or down?  For simplicity, ignore the width of the pipe.

Manipulate[  Row[{Show[Graphics[{Line[ {{-20,0},{0,0},{0,30}}], Line[{{-20,-7}, {14,-7},{14,30}}], Line[{{-7/m,-7},{14,14m}}],PointSize[Large], Point[{{-7/m,-7},{14,14m}}]}], PlotRange-> {{-21,15},{-8, 31}}, AspectRatio-> Automatic, ImageSize-> 250, PlotLabel-> Column[{Row[{"The current slope is ",m}],""}]],
Plot[EuclideanDistance[{14,14t},{-7/t,-7}], {t,0,m}, PlotRange-> {{0,10},{0,120}},ImageSize->300, PlotLabel-> Column[{"Pipe length vs. slope", Row[{"The current length is ",EuclideanDistance[{14,14m},{-7/m,-7}]} ]}, Alignment-> Center],AxesLabel-> {"slope", "length"},Epilog-> {PointSize[Medium], Line[{{m,0},{m,EuclideanDistance[{14,14m},{-7/m,-7}]}}], Point[{m,EuclideanDistance[{14,14m},{-7/m,-7}]}]}]} ]
, {{m,.01,"Slope of the pipe"},.01,10,.01}]

Solution

The longest pipe you can get around the corner will be one where the pipe will simultaneously scrape the inside corner of the turn and the outside walls of the two hallways (if it doesn’t, then you can extend the pipe length a little more - and if it’s longer than that it will get stuck).  So counterintuitively we are actually looking for the shortest pipe which meets those criteria - the longest pipe than can get around the corner is also the shortest one that gets stuck (it will just scrape against the wall/corners and then move on).  Let m be the slope of a pipe which touches the inside corner and the outside walls.  If we place the origin at the inside corner, the equation of the line the pipe is in will be y=m x. The length of the pipe is the distance between where it touches the two outside walls.  Let the 14’ hallway be oriented vertically and the 7’ hallway be horizontal as in the diagram above.  Then the point where the pipe touches the vertical wall has x-coordinate x=14; as it is on the line y=m x the y-coordinate must be 14m, so the point is (m,14m).  The y-coordinate where the pipe touches the horizontal wall is y=-7; as it is on the line y=m x we have -7=m x, or x=-(7/m).  So the coordinates of the lower point are (-(7/m),-7).  So we are trying to minimize the length/distance L between the two points (14,14m) and (-(7/m),-7).  Using the distance formula L=(Sqrt[(((14- -(7/m)))^2)+(((-7-14m))^2)])=(Sqrt[(((14+(7/m)))^2)+(((7+14m))^2)]).  Minimizing this is the same as minimizing D=(((14+(7/m)))^2)+(((7+14m))^2) as bigger numbers have bigger square roots (this is a common trick in optimizing quantities under a single root - you don’t have to do it this way, but it makes taking the derivative easier).  The slope must be in the range (0,∞) as the line can ger nearly horizontal and nearly vertical.
D'=(d/(dm))((((14+(7/m)))^2)+(((7+14m))^2))=2(14+(7/m))(-(7/(m^2)))+2(7+14m)14=392m+196-(196/(m^2)) -(98/(m^3)).  This exists as long as m>0, so we need only worry about where it is 0. Taking 392m+196-(196/(m^2)) -(98/(m^3))=0 and multiplying it by ((m^3)/98) yields the equation 4(m^4)+2(m^3)-2m-1=0; the right hand side factors as (2m+1)(2(m^3)+1)=0, so either m=-(1/2) or 2(m^3)-1=0  (i.e. m=-(1/2),(1/(2^(1/3)))).
m=-(1/2) is outside our range, so the only breakpoint for our sign line will be m=(1/(2^(1/3))).

Show[ CreateRangedSignLine[392m+196-(196/(m^2)) -(98/(m^3)),m,{.0001,4},TraditionalForm[ L'[x]==392m+196-(196/(m^2)) -(98/(m^3))]], PlotRange-> Automatic]

So we see the length is decreasing until m=(1/(2^(1/3))) and increasing afterwards (the line above shows from from 0 to 4 only for convenience).  Therefore the longest pipe we can get around the corner has a slope of m=(1/(2^(1/3))).  Dropping that value into the length L=(Sqrt[(((14+(7/m)))^2)+(((7+14m))^2)]) and simplifying gives the maximum length is 7(Sqrt[5+6(2^(1/3))+3((((2^(1/3))))^2)])≈29.133567

Document by Dr. Christopher Moretti.  Subject to the FreeCDF licensing terms from Wolfram Research (see http://www.wolfram.com/cdf/adopting-cdf/licensing-options.html for details)