NotebookDirectory[]

SetDirectory[NotebookDirectory[]]

Problem 4 on E1

In this problem I gave the following region.

houseFound=Graphics[{
{Yellow,
Polygon[Join[Table[{x,1/x},{x,.5,2,.05}],Reverse[Table[{x,4/x},{x,1,4,.05}]]]]},
{Line[{(-10){1,4},(10){1,4}}],
Line[{(-10){1,1/4},(10){1,1/4}}],
Line[Table[{x,1/x},{x,.1,5,.05}]],
Line[Table[{x,4/x},{x,.1,5,.05}]]}},
PlotRange->{{0,4.2},{0,4.2}},Frame->True,AspectRatio->Automatic,ImageSize->600]

(* Export["houseFound.gif",houseFound,"GIF","ImageSize"->600];  *)

N[(1/2)(Sqrt[E])]

N[4(E^4)]

N[(1/2)(E^(0.5/8))]

N[4(E^(4/8))]

I asked you to calculate the volume of the house built on this yellow foundation with the roof at the level z= x (e^x).  The lowest level of this roof is (1/2)(Sqrt[e]) ≈0.8243606353500641` at the point (1/2,2). The highest level of this roof is 4(e^4) ≈218.39260013257694`.  It is difficult to to plot a graph with such high difference in highest and lowest value. Therefore, instead of  the function x (e^x), I will use x (e^(x/8)) and instead of y (e^y) I will use y (e^(y/8)). For these new functions the lowest and the highest levels are approximately 0.5322472294589297` and  6.594885082800513`. Still significant bur more managable, as you will see below.

Solve[{x y ==(t^2),y/x==s^2},{x,y}]

x Exp[x/8]/.{{x->(t/s),y->s t}}

y Exp[y/8]/.{{x->(t/s),y->s t}}

g3D=Show[
Graphics3D[{
{Yellow,
Polygon[Join[Table[{x,1/x,0},{x,.5,2,.05}],Reverse[Table[{x,4/x,0},{x,1,4,.05}]]]]} (*,
{Thickness[0.001],GrayLevel[.9],Line[{(-10){1,4,0},(10){1,4,0}}],
Line[{(-10){1,1/4,0},(10){1,1/4,0}}],
Line[Table[{x,1/x,0},{x,.1,5,.05}]],
Line[Table[{x,4/x,0},{x,.1,5,.05}]]}*) } ],
ParametricPlot3D[{t/s,s t,(((E^(t/(8s))) t)/s)},{s,1/2,2},{t,1,2},PlotStyle->{Red},Mesh-> False],
ParametricPlot3D[{x,4 x,t x Exp[x/8]},{x,1/2,1},{t,0,1},PlotStyle->{Opacity[.5]},Mesh-> False],
ParametricPlot3D[{x, x/4,t x Exp[x/8]},{x,2,4},{t,0,1},PlotStyle->{Opacity[.5]},Mesh-> False],ParametricPlot3D[{x,1/ x,t x Exp[x/8]},{x,1/2,2},{t,0,1},PlotStyle->{Opacity[.95]},Mesh-> False],ParametricPlot3D[{x,4/ x,t x Exp[x/8]},{x,1,4},{t,0,1},PlotStyle->{Opacity[.75]},Mesh-> False],
Graphics3D[{
{Thickness[0.01],Line[Table[{x,4x, x Exp[x/8]},{x,1/2,1,.05}]]},
{Thickness[0.01],Line[Table[{x,x/4, x Exp[x/8]},{x,2,4,.05}]]},
{Thickness[0.01],Line[Table[{x,4/x, x Exp[x/8]},{x,1,4,.05}]]},
{Thickness[0.01],Line[Table[{x,1/x, x Exp[x/8]},{x,1/2,2,.05}]]},
{Thickness[0.01],Line[Table[{x,4x,0},{x,1/2,1,.05}]]},
{Thickness[0.01],Line[Table[{x,x/4,0},{x,2,4,.05}]]},
{Thickness[0.01],Line[Table[{x,4/x, 0},{x,1,4,.05}]]},
{Thickness[0.01],Line[Table[{x,1/x, 0},{x,1/2,2,.05}]]},
{Thickness[0.01],Line[{{1/2,2,0},{1/2,2, (1/2) Exp[(1/2)/8]}}]},
{Thickness[0.01],Line[{{1,4,0},{1,4, (1) Exp[(1)/8]}}]},
{Thickness[0.01],Line[{{2,1/2,0},{2,1/2, (2) Exp[(2)/8]}}]},{Thickness[0.01],Line[{{4,1,0},{4,1, (4) Exp[(4)/8]}}]}
}],PlotRange->{{0,4.2},{0,4.2},{0,6.6}},BoxRatios->{1,1,1},AxesLabel->{x,y,z},ImageSize->800]

autoRotate[gr_Graphics3D,rate_: 7]:=DynamicModule[{vp,va,vv,vc},{vp,va,vv,vc}=gr~AbsoluteOptions~#~OptionValue~#&@{ViewPoint,ViewAngle,ViewVertical,ViewCenter};
Overlay[{Show[Graphics3D[],ViewPoint->Dynamic[vp],ViewAngle->Dynamic[va],SphericalRegion->True],Show[gr,SphericalRegion->True,ViewPoint->Dynamic[RotationMatrix[Clock[2 π,rate],vv].vp],ViewAngle->Dynamic[va],Boxed->False,Axes->False]},All,1]]

g3D~AbsoluteOptions~#~OptionValue~#&@{ViewPoint,ViewAngle,ViewVertical,ViewCenter}

autoRotate[g3D,12]

MyRotate[gr_Graphics3D,step_,frame_]:=Module[{vp,va,vv,vc},{vp,va,vv,vc}=gr~AbsoluteOptions~#~OptionValue~#&@{ViewPoint,ViewAngle,ViewVertical,ViewCenter};
Overlay[{Show[Graphics3D[],ViewPoint->Dynamic[vp],ViewAngle->Dynamic[va],SphericalRegion->True],Show[gr,SphericalRegion->True,ViewPoint->Dynamic[RotationMatrix[frame((2Pi)/step),vv].vp],ViewAngle->Dynamic[va],Boxed->False,Axes->False]},All,1]]

ListAnimate[Table[MyRotate[g3D,64,k],{k,0,63}]]

houseAni=Table[MyRotate[g3D,64,k],{k,0,63}];

(* Export["houseAniS1.gif",houseAni[[1]],"GIF","ImageSize"->800];

Export["houseAni.gif",houseAni,"GIF","AnimationRepetitions"->Infinity,"ImageSize"->800,"DisplayDurations"->0.4] 
*)

Show[
ParametricPlot3D[{t/s,s t,(E^((s t)/8)) s t},{s,1/2,2},{t,1,2}],
ParametricPlot3D[{x,4 x,t 4 x Exp[4 x/8]},{x,1/2,1},{t,0,1},PlotStyle->{Opacity[.5]}],
ParametricPlot3D[{x, x/4,t (x/4) Exp[(x/4)/8]},{x,2,4},{t,0,1},PlotStyle->{Opacity[.5]}],ParametricPlot3D[{x,1/x,t (1/x) Exp[(1/x)/8]},{x,1/2,2},{t,0,1},PlotStyle->{Opacity[.5]}],ParametricPlot3D[{x,4/x,t (4/x) Exp[(4/x)/8]},{x,1,4},{t,0,1},PlotStyle->{Opacity[.5]}],PlotRange->All,BoxRatios->{1,1,1}]

Below I show how to get a parametric equation of a surface that looks like a wall. The wall below straches along the curve  {Cos[t],t,0} in xy-plane, from the point {1,0,0} to the point {1,4 Pi,0}. At the point {Cos[t], t, 0} the wall is exactly  2(2+Sin[t]) high. I use the parameter s, 0 ≤s ≤ 1 to make the surface stretch from the point  {Cos[t],t,0} at the foundation to the point  {Cos[t],t,2(2+Sin[t])}  at the top of the wall.

vp={1.3`,-2.4`,2.`}

ParametricPlot3D[{Cos[t],t,s 2(2+Sin[t])},{t,0,4Pi},{s,0,1},Mesh->False,AxesLabel->{x,y,z},PlotRange->{{-1.1,1.1},{0,4 Pi},{0,6.2}},Ticks->{{-1,0,1},Range[0,4 Pi,Pi/2],Range[0,7]},ViewPoint->Dynamic[vp]]

vp

Manipulate[ParametricPlot3D[{Cos[t],t,s 2(2+Sin[t])},{t,0,4Pi},{s,0,ps},Mesh->False,AxesLabel->{x,y,z},PlotRange->{{-1.1,1.1},{0,4 Pi},{0,6.2}},Ticks->{{-1,0,1},Range[0,4 Pi,Pi/2],Range[0,7]},ViewPoint->{2.630551316817253`,-1.6348703760321255`,1.3628641249822349`}],{ps,0.05,1}]

wallAni=Table[ParametricPlot3D[{Cos[t],t,s 2(2+Sin[t])},{t,0,4Pi},{s,0,ps},Mesh->False,PlotPoints->{300,100},AxesLabel->{x,y,z},PlotRange->{{-1.1,1.1},{0,4 Pi},{0,6.2}},Ticks->{{-1,0,1},Range[0,4 Pi,Pi/2],Range[0,7]},ViewPoint->{2.630551316817253`,-1.6348703760321255`,1.3628641249822349`},ImageSize->800],{ps,0.05,1,0.05}];

ListAnimate[wallAni]

(* 
Export["wallAniS1.gif",Last[wallAni],"GIF","ImageSize"->800];

Export["wallAni.gif",wallAni,"GIF","AnimationRepetitions"->Infinity,"ImageSize"->800,"DisplayDurations"->0.4] 
  *)