# Manipulate two graphs with one parameter

This question is related to a previous question Create a slider to illustrate Fubini theorem.

Thank to the help of @kglr, now I can create sliders to control the slice.

 ClearAll[a, B1, B2, B3, B4];

B4[a_?NumericQ] :=
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], Thickness[0.06],
Specularity[White, 30]]];(*The blue plane*)

B1 =
ParametricPlot3D[{x, y, 0.01*(x + 5)^2}, {x, -5, 5}, {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, 5}, {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, 5}, {z, 0,
0.01*(x + 5)^2}, PlotPoints -> 100, Mesh -> 20,
MeshStyle -> Opacity[.1],
PlotStyle ->
Directive[Red, Opacity[0.4], Specularity[White, 30]]];

t1 = 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}];

t2 = Plot[{4.8 + Sin[x],
3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x))}, {x, -5,
5}, PlotRange -> {1.7, 6}];

t3[a_?NumericQ] :=
Plot[100* Sign[x - a], {x, -5, 5}, ExclusionsStyle -> Blue,
PlotRange -> {3 + (-8 + a) (1/
13 + (0.01 + 0.0022*(-4 + a))*(5 + a)), 4.8 + Sin[a]}];

t4 = Manipulate[Show[t2, t3[a]], {{a, 1}, -5, 5}];

Grid[{{t1, t4}}, ItemSize -> {{30, 30}}, Frame -> All,
FrameStyle -> Red]


My question: How can we create only one slider for $$a$$ to control two graphs? The parameter $$a$$ for the picture on the left is used for the plane $$x=a$$ (the blue plane), while the same $$a$$ is for the line $$x=a$$ on the right hand side picture. That is, we will have the following illustration.

Thank for any hint.

### Code

ClearAll[f1, f2, f3]
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

viewpoint = {-2.7, 1.6, 1.3};

plt1 = Plot3D[f3[x], {x, -5, 5}, {y, 2, 6},
Mesh -> 20, PlotStyle -> Opacity[0], MeshStyle -> Opacity[.8],
BoundaryStyle -> Directive[Thick, Gray], Lighting -> "Neutral",
PlotPoints -> 25, RegionFunction -> (f2[#] <= #2 <= f1[#] &),
BoxRatios -> {1, 1, 1}, ViewPoint -> viewpoint, ImageSize -> Medium];

plt2 = ParametricPlot3D[{{x, f1[x], z f3[x]}, {x, f2[x], z f3[x]}}, {x, -5, 5}, {z, 0, 1},
PlotPoints -> 50, Mesh -> None,
PlotStyle -> {Directive[Red, Opacity[0.3], Specularity[White, 30]],
Directive[Green, Opacity[0.3], Specularity[White, 30]]}];

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

plt2d[a_] := ParametricPlot[{x, v f1[x] + (1 - v) f2[x]}, {x, -5, 5}, {v, 0, 1},
MeshFunctions -> {#4 &}, AspectRatio -> 1,
Mesh -> {{{0, Directive[Opacity[1], Green, Thick]},
{1, Directive[Opacity[1], Red, Thick]}}},
PlotStyle -> LightBlue, PlotPoints -> 30,
Axes -> False, BoundaryStyle -> None, ImageSize -> Medium,
Epilog -> {Thick, Blue, Arrowheads[Medium], Arrow[{a, #[a]} & /@ {f2, f1}]}]

Manipulate[Row[{plt2d[a], Show[plt1, plt2, polygon[a]]}, Spacer[10]],
{{a, 1}, -5, 5, 1/50}]


Is this what you want ?

Manipulate[
Grid[{{Show[B1, B2, B3, B4[a], AxesStyle -> Thick, Boxed -> False,
AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z},
BoxRatios -> {1, 1, 1.3}], Show[t2, t3[a]]}},
ItemSize -> {{30, 30}}], {{a, 1}, -5, 5}]


(Please format the item size accordingly)

As your code for some reason crashes my mathematica kernel, I'll give you an example with a shorter, lighter code that can be easily adapted to your case:

plt1[a_] := Plot[Sin[a*x], {x, 0, 10}];
plt2[a_] := Plot[Cos[a*x], {x, 0, 10}];

Manipulate[
Grid[{{plt1[a], plt2[a]}}, ItemSize -> {{30, 30}}, Frame -> All,
FrameStyle -> Red], {{a, 1}, -5, 5}]


This should translate to your example as follows:

1) Remove manipulate from t1 and t4:

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

t4[a_] := Show[t2, t3[a]];


2) Add manipulate in the final Grid

  Manipulate[Grid[{{t1[a], t4[a]}}, ItemSize -> {{30, 30}}, Frame -> All,
FrameStyle -> Red], {{a, 1}, -5, 5}]