# How to show different number of graph between the options of a PopupMenu (within Manipulate)?

I have the following code. My question is: how do I do so that when I choose the first option the s orbital and its graph appear; in the second option, the p orbitals and their graph; and in the following options, the rest of the orbitals (d and f) with their respective graphs?

fs[theta_, phi_] := (1/Sqrt[2]*1/Sqrt[2*Pi])^2;
fpx[theta_, phi_] := (Sqrt[3]*Sin[theta]/2*Cos[phi]/Sqrt[Pi])^2;
fpy[theta_, phi_] := (Sqrt[3]*Sin[theta]/2*Sin[phi]/Sqrt[Pi])^2;
fpz[theta_, phi_] := (Sqrt[6]*Cos[theta]/2*1/Sqrt[2*Pi])^2;

Manipulate[Row[{
SphericalPlot3D[Orbital[theta, phi], {theta, 0, Pi}, {phi, 0, 2*Pi},
PlotRange -> All,
PlotStyle -> {{Pink, Directive[Opacity[0.5]]}, {Pink,
Directive[Opacity[0.5]]}}, PlotTheme -> "Scientific",
AxesLabel -> {Style[x, Medium], Style[y, Medium],
Style[z, Medium]}, AxesStyle -> GrayLevel[0.3],
Mesh -> 50, MeshStyle -> Opacity[0.2], ImageSize -> Medium],
Plot[Integrate[Orbital[theta, phi], {phi, 0, 2*Pi}], {theta, 0, Pi},
PlotRange -> All, PlotStyle -> {{Red, Thickness[0.003]}},
Frame -> True, FrameLabel -> {"\[Theta]", "\[CapitalGamma]"},
FrameStyle -> Directive[GrayLevel[0.30], 11],
RotateLabel -> False, ImageSize -> Medium]
}],
{{Orbital, fs}, {
fs -> "s",
fpx -> "\!$$\*SubscriptBox[\(p$$, $$x$$]\)",
fpy -> "\!$$\*SubscriptBox[\(p$$, $$y$$]\)",
fpz -> "\!$$\*SubscriptBox[\(p$$, $$z$$]\)"


I have tried several ways, but so far I can't get it.

• What is wrong? It seems to work, s and p orbitals appear. d and f are not implemented. Commented Jan 8, 2023 at 9:16
• I would like all three p orbitals to appear together. I didn't put the d and f orbitals for reasons of space, but the idea is the same. Commented Jan 8, 2023 at 16:45
• Manipulate variable values can also be lists, so: {Orbital, {fs}}, {{fs} -> "s", {fpx, fpy, fpz} -> "p"}. Then, use Map over Orbital to show multiple plots, so instead of Orbital[theta, phi] use Evaluate[#[theta, phi] & /@ Orbital] and Evaluate[Integrate[#[theta, phi], {phi, 0, 2*Pi}] & /@ Orbital]. Furthermore, I suggest precomputing the integrals for better performance. Commented Jan 8, 2023 at 16:55

Here is your example with s and p orbitals:

fs[theta_, phi_] := (1/Sqrt[2]*1/Sqrt[2*Pi])^2;
fpx[theta_, phi_] := (Sqrt[3]*Sin[theta]/2*Cos[phi]/Sqrt[Pi])^2;
fpy[theta_, phi_] := (Sqrt[3]*Sin[theta]/2*Sin[phi]/Sqrt[Pi])^2;
fpz[theta_, phi_] := (Sqrt[6]*Cos[theta]/2*1/Sqrt[2*Pi])^2;

disp[Orbital_] :=
SphericalPlot3D[Orbital[theta, phi], {theta, 0, Pi}, {phi, 0, 2*Pi},
PlotRange -> All,
PlotStyle -> {{Pink, Directive[Opacity[0.5]]}, {Pink,
Directive[Opacity[0.5]]}}, PlotTheme -> "Scientific",
AxesLabel -> {Style[x, Medium], Style[y, Medium], Style[z, Medium]},
AxesStyle -> GrayLevel[0.3], Mesh -> 50, MeshStyle -> Opacity[0.2],
ImageSize -> Medium]

Manipulate[
Switch[Orbital
, s, disp[fs]
, p, Row[disp /@ {fpx, fpy, fpz}]
]
, {{Orbital, s}, {s -> "s", p -> "p"}, ControlType -> PopupMenu}]


• Wow! Thank you! Commented Jan 9, 2023 at 16:36

Using TogglerBar rather than PopupMenu provides greater flexibility.

Clear["Global*"]

fs[theta_, phi_] :=
(1/Sqrt[2]*1/Sqrt[2*π])^2;
fpx[theta_, phi_] :=
(Sqrt[3]*Sin[theta]/2*Cos[phi]/Sqrt[π])^2;
fpy[theta_, phi_] :=
(Sqrt[3]*Sin[theta]/2*Sin[phi]/Sqrt[π])^2;
fpz[theta_, phi_] :=
(Sqrt[6]*Cos[theta]/2*1/Sqrt[2*π])^2;

funcs[t_, p_] = Through[{fs, fpx, fpy, fpz}[t, p]];

ints[t_] = Integrate[funcs[t, p], {p, 0, 2*π}];


Plotting,

Manipulate[Module[{f, legends,
colors = {Lighter[Blue, 0.5], Red, Green, Darker[Orange, 0.2]}},
Orbital =
If[Orbital === {}, {1, 2, 3, 4}, Sort[Orbital]];
f = funcs[theta, phi][[Orbital]];
legends = {HoldForm[s], HoldForm[Subscript[p, x]],
HoldForm[Subscript[p, y]], HoldForm[Subscript[p, z]]}[[
Orbital]];
Column[{
SphericalPlot3D[Evaluate[f],
{theta, 0, π}, {phi, 0, 2*π},
PlotRange -> 1/4, PlotStyle ->
(Opacity[0.5, #] & /@ colors)[[Orbital]],
PlotTheme -> "Scientific",
AxesLabel -> (Style[#, Medium] & /@ {"x", "y", "z"}),
AxesStyle -> GrayLevel[0.3],
Mesh -> 50, MeshStyle -> Opacity[0.2],
ImageSize -> Medium, PlotLegends -> legends],
Plot[Evaluate[ints[theta]], {theta, 0, π},
PlotRange -> {-0.05, 1.55}, Frame -> True,
FrameLabel -> (Style[#, 14] & /@ {"θ", "Γ"}),
FrameStyle -> Directive[GrayLevel[0.30], 11],
RotateLabel -> False, ImageSize -> Medium,
PlotLegends -> legends, PlotStyle ->
(colors[[Orbital]] /. Green :> {Dashed, Green})]}]],
{{Orbital, {1, 2, 3, 4}}, {1 -> HoldForm[s],
2 -> HoldForm[Subscript[p, x]],
3 -> HoldForm[Subscript[p, y]],
4 -> HoldForm[Subscript[p, z]]},
ControlType -> TogglerBar}]
`

• Thanks! This will help me with another problem I have with Manipulate: graphing hybrid orbitals. Commented Jan 9, 2023 at 16:38