4
$\begingroup$

I would like to illustrate the Fubini theorem in Calculus like the following picture (taken from this page):

enter image description here

This is what I tried:

a := 1;
B4 := ParametricPlot3D[{a, y, z}, {y, 
   3 + (-8 + a)* (1/13 + (0.01 + 0.0022*(-4 + a))*(5 + a)), 
   4.8 + Sin[a]}, {z, 0, 0.01*(a + 5)^2}, PlotPoints -> 100, 
  Mesh -> 20, 
  PlotStyle -> 
   Directive[Blue, Opacity[0.4], 
    Specularity[White, 30]]];(*The blue plane*)

B1 := 
 ParametricPlot3D[{x, y, 0.01*(x + 5)^2}, {x, -5, 8}, {y, 
   3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x)), 
   4.8 + Sin[x]}, Mesh -> 20, PlotStyle -> Opacity[0], 
  MeshStyle -> Opacity[.8], 
  PlotStyle -> 
   Directive[Blue, Opacity[0.3], Specularity[White, 30]]];

B2 := ParametricPlot3D[{x, 
    3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x)), 
    z}, {x, -5, 8}, {z, 0, 0.01*(x + 5)^2}, PlotPoints -> 100, 
   Mesh -> 20, MeshStyle -> Opacity[.1], 
   PlotStyle -> 
    Directive[Green, Opacity[0.3], Specularity[White, 30]]];

B3 := ParametricPlot3D[{x, 4.8 + Sin[x], z}, {x, -5, 8}, {z, 0, 
    0.01*(x + 5)^2}, PlotPoints -> 100, Mesh -> 20, 
   MeshStyle -> Opacity[.1], 
   PlotStyle -> 
    Directive[Red, Opacity[0.4], Specularity[White, 30]]];


Show[B1, B2, B3, B4, AxesStyle -> Thick, Boxed -> False, 
 AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z}, 
 BoxRatios -> {1, 1, 1.3}]

enter image description here

Now, I don't know how to create a slider to adjust the value of $a$ running from -5 to 8, so that we will have the same illustration. I also would like to put two figures side by side as seen from the picture above.

Could anyone give me a help! Thanks alot.

$\endgroup$
  • 1
    $\begingroup$ Define B4 as a function of a and use Set (=) when you define B1, B2 and B3; (that is, use ClearAll[a, B1, B2, B3, B4]; B4[a_?NumericQ] := ...; B1=..'B2=...; B3=...) Then use Manipulate[ Show[B1, B2, B3, B4[a], AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z}, BoxRatios -> {1, 1, 1.3}], {{a, 1}, -5, 8}] $\endgroup$ – kglr Jan 23 at 2:07
  • $\begingroup$ @kglr Thanks, do you know how to put two figures side-by-side with different scales. I tried: GraphicsRow[{Manipulate[ Show[B1, B2, B3, B4[a], AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z}, BoxRatios -> {1, 1, 1.3}], {{a, 1}, -5, 5}], Plot[{4.8 + Sin[x], 3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x))}, {x, -5, 8}, PlotRange -> {1.7, 6}]}, Spacings -> Scaled[0.4]] $\endgroup$ – Binjiu Jan 23 at 3:35
4
$\begingroup$

enter image description here

If it is not essential to have two different colors for the filling in the 3D plot, you can use a single Plot3D with the option Filling to get the 3D surface.

ClearAll[f1, f2, f3, polygon, arrow]
f1[x_] := 4.8 + Sin[x]
f2[x_] := 3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x))
f3[x_] := 0.01*(x + 5)^2

polygon[a_] := Graphics3D[{EdgeForm[{Thick, Blue}], Opacity[.5, Blue], 
   Polygon[{{a, f1[a], 0}, {a, f1[a], f3[a]}, {a, f2[a], f3[a]}, {a, f2[a], 0}}]}]

arrow[a_] := Graphics[{Thick, Blue, Arrowheads[Medium], Arrow[{a, #[a]} & /@ {f2, f1}]}]

pp = ParametricPlot[{x, v f1[x] + (1 - v) f2[x]}, {x, -5, 5}, {v, 0, 1}, 
   Mesh -> None, PlotStyle -> Opacity[.5, LightGray], 
   PlotPoints -> 30, Frame -> False, AxesOrigin -> {-6, 3/2}, 
   Ticks -> {{{-5, "a"}, {5, "b"}}, None}, AspectRatio -> 1, 
   AxesLabel -> {"x", "y"}, BoundaryStyle -> Directive[Thick, Gray], 
   ImageSize -> Medium];

bottom = ParametricPlot3D[{x, v f1[x] + (1 - v) f2[x], 0}, {x, -5, 5}, {v, 0, 1}, 
   Mesh -> None, PlotStyle -> None, PlotPoints -> 30, 
   Boxed -> False, BoxRatios -> 1, 
   BoundaryStyle -> Directive[AbsoluteThickness[3], Darker@Gray]];

p3d = Plot3D[f3[x], {x, -5, 5}, {y, 2, 6}, 
   PlotStyle -> FaceForm[Opacity[.5, White], Opacity[0]], 
   BoundaryStyle -> Directive[Thick, Red], 
   Mesh -> 20, MeshStyle -> Red, 
   Lighting -> "Neutral", Filling -> Bottom, 
   FillingStyle -> FaceForm[Opacity[.5, Red], Opacity[.3, White]], 
   PlotPoints -> 25, RegionFunction -> (f2[#] <= #2 <= f1[#] &), 
   BoxRatios -> {1, 1, 1}, ViewPoint -> {-2.7, 1.6, 1.3}, ImageSize -> Medium];

Manipulate[Row[{Show[pp, arrow[t]], Show[p3d, bottom, polygon[t]]}, Spacer[10]],
   {{t, 1}, -5, 5, 1/50}]

enter image description here

The animation above is generated using:

frames = Table[Row[{Show[pp, arrow[t]], Show[p3d, bottom, polygon[t]]}, 
    Spacer[10]], {t, -5, 5, 1/5}];

Export["fubini2.gif", frames, "AnimationRepetitions" -> Infinity]

An alternative approach is to use a Locator (instead of a Slider) to control the parameter a:

Deploy @ DynamicModule[{p = {1, f2[1]}}, 
  Row[{Show[pp, 
        Graphics[{Thick, Blue, Arrowheads[Medium], 
         Dynamic @ Arrow[{p[[1]], #[p[[1]]]} & /@ {f2, f1}], 
         Locator[Dynamic[p, (p = #; p[[2]] = f2[p[[1]]]) &], 
            Graphics[{Black, Rectangle[]}, ImageSize -> 10]]}], PlotRange -> All], 
   Dynamic@Show[p3d, bottom, polygon[p[[1]]]]}, Spacer[10]]]

enter image description here

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.