0
$\begingroup$

If anyone has any idea how to turn all of that plotting stuff (hcpii4plot) into a function which takes hcpii4angfunc[θ, ϕ] as an argument, that would make my notebook a lot neater and easier to read. I have been struggling with this for a couple of months now and couldn't find how to do it anywhere online...

hcpii4angfunc[θ_, ϕ_] = -1.1619488688971678` + 
  0.8938068222285906` Cos[2 θ] + 
  3.1283238778000673` Cos[2 θ]^2

hcpii4plot = 
  SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π}, 
   ColorFunction -> 
    Function[{x, y, z, θ, ϕ, r}, 
     ColorData["DarkRainbow"][hcpii4angfunc[θ, ϕ]]], 
   ColorFunctionScaling -> False, Mesh -> False, Boxed -> False, 
   AxesOrigin -> {0, 0, 0}, 
   PlotRange -> {{-1.3, 1.3}, {-1.3, 1.3}, {-1.22, 1.22}}, 
   LabelStyle -> Directive[Black, 14], Ticks -> None, 
   AxesStyle -> Arrowheads[{-0.05, 0.05}], 
   Method -> {"ShrinkWrap" -> True}, ViewPoint -> {-2, -2, 1}, 
   ViewVertical -> {1, 1, 1}];
Graphics[Inset[hcpii4plot, Center, Center, ImageScaled[1]], 
 Epilog -> {Text[Style["x", FontSize -> 20], 
    ImageScaled[{0.03, .33}]], 
   Text[Style["y", FontSize -> 20], ImageScaled[{.97, .33}]], 
   Text[Style["z", FontSize -> 20], ImageScaled[{.5, .99}]]}]
BarLegend[{"DarkRainbow", {MinValue[
    hcpii4angfunc[θ, ϕ], {θ, ϕ}], 
   MaxValue[hcpii4angfunc[θ, ϕ], {θ, ϕ}]}}, 
 LegendLayout -> "Row", LabelStyle -> Directive[Black, 14]]

Any help would be greatly appreciated!

Improve this question
$\endgroup$

1 Answer 1

Reset to default
2
$\begingroup$

Like this?

fun1[fun2_] := Module[
  {hcpii4plot},
  hcpii4plot = SphericalPlot3D[
    1
    , {θ, 0, π}
    , {ϕ, 0, 2 π}
    , ColorFunction -> Function[
      {x, y, z, θ, ϕ, r}
      , ColorData["DarkRainbow"][fun2[θ, ϕ]]]
    , ColorFunctionScaling -> False
    , Mesh -> False
    , Boxed -> False
    , AxesOrigin -> {0, 0, 0}
    , PlotRange -> {{-1.3, 1.3}, {-1.3, 1.3}, {-1.22, 1.22}}
    , LabelStyle -> Directive[Black, 14]
    , Ticks -> None
    , AxesStyle -> Arrowheads[{-0.05, 0.05}]
    , Method -> {"ShrinkWrap" -> True}
    , ViewPoint -> {-2, -2, 1}
    , ViewVertical -> {1, 1, 1}
    ];
  Column@{
    Graphics[
     Inset[hcpii4plot, Center, Center, ImageScaled[1]]
     , Epilog -> {
       Text[Style["x", FontSize -> 20], ImageScaled[{0.03, .33}]],
       Text[Style["y", FontSize -> 20], ImageScaled[{.97, .33}]],
       Text[Style["z", FontSize -> 20], ImageScaled[{.5, .99}]]}
     ],
    BarLegend[{
      "DarkRainbow"
      , {MinValue[fun2[θ, ϕ], {θ, ϕ}]
       , MaxValue[fun2[θ, ϕ], {θ, ϕ}]}
      }
     , LegendLayout -> "Row"
     , LabelStyle -> Directive[Black, 14]
     ]
    }
  ]

and then

fun1[hcpii4angfunc]

Mathematica graphics

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you for the quick reply, yes this is what I was after! :-) Do you know why the image of the sphere is now smaller, or how to make it bigger? Is it possible to have a function to generate 2 lines of output, just like hcpii4plot ? Could you explain a bit how this Module and Column syntax works? But these are just curiosities, thank you for answering my main question! $\endgroup$
    – Bart
    Commented Jul 26, 2018 at 18:16
  • $\begingroup$ Because it's in automatic size inside a Column. Try specifying a specific size such as ImageSize-> 600 $\endgroup$
    – rhermans
    Commented Jul 26, 2018 at 18:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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