Skip to main content

plotting - Create a slider to illustrate Fubini theorem


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.




Answer



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


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...