1
$\begingroup$

I currently have a plot that I want to display in the format of ListPlot3D (as in some continuous 2D contour embedded in 3D), but the key is that I'd like to preserve this color coding I have.

I am basically quantifying some variable of a system (svet on the z-axis) as a function of two varying parameters (b and $\gamma$ on the x and y axis respectively). Each time I quantify this variable, svet, I try 3 different methods and color code the output based on which method gave me the maximal value. Then I append each output to its own array and plot each of the 3 arrays separately to manually color code them.

Is there a way I can preserve this coloring and switch this to a ListPlot3D?

Here is the code:

(*basically a package for more convenient commands*)
Get["http://www.fmt.if.usp.br/~gtlandi/download/melt.m"]
LoadPauliMatrices[];

(*3 different methods to quantify svet*)
r1[\[Theta]_] := Cos[\[Theta]]*\[Sigma]x + Sin[\[Theta]]*\[Sigma]y;
r2[\[Theta]_] := Cos[\[Theta]]*\[Sigma]x + Sin[\[Theta]]*\[Sigma]z;
r3[\[Theta]_] := Cos[\[Theta]]*\[Sigma]z + Sin[\[Theta]]*\[Sigma]y;
rot1[\[Theta]_, \[Phi]_] := kron[r1[\[Theta]], r1[\[Phi]]] // Simplify;
rot2[\[Theta]_, \[Phi]_] := kron[r2[\[Theta]], r2[\[Phi]]] // Simplify;
rot3[\[Theta]_, \[Phi]_] := kron[r3[\[Theta]], r3[\[Phi]]] // Simplify;

(*getting the values*)
Dynamic[i]
Dynamic[b]
XY2m1 = {};
XY2m2 = {};
XY2m3 = {};
Table[{svetvals = {}; 
   Do[\[CapitalDelta] = 0; 
    Ham = (1 + g)/2 kron[\[Sigma]x, \[Sigma]x] + (1 - g)/
       2 kron[\[Sigma]y, \[Sigma]y] + \[CapitalDelta]*
       kron[\[Sigma]z, \[Sigma]z] + 
      b (KronEye[\[Sigma]z, 2, 1] + KronEye[\[Sigma]z, 2, 2]); 
    gs = Transpose[Eigsys[Ham][[2]]][[1]]; \[Rho]gs = out[gs, gs]; 
    If[i == 1, { 
      corrgs[\[Theta]_, \[Phi]_] := 
       Tr[rot1[\[Theta], \[Phi]] . \[Rho]gs];
      Svet2 = 
       1/2 (corrgs[\[Theta]1, \[Phi]1] + corrgs[\[Theta]2, \[Phi]1] + 
          corrgs[\[Theta]1, \[Phi]2] - corrgs[\[Theta]2, \[Phi]2]); 
      svet = NMaximize[
        Svet2, {\[Theta]1, \[Theta]2, \[Phi]1, \[Phi]2}]; 
      AppendTo[svetvals, ComplexExpand[Re[svet[[1]]]]]; 
      Clear[corrgs, Svet2, svet]},
     If[i == 2, { 
       corrgs[\[Theta]_, \[Phi]_] := 
        Tr[rot2[\[Theta], \[Phi]] . \[Rho]gs];
       Svet2 = 
        1/2 (corrgs[\[Theta]1, \[Phi]1] + corrgs[\[Theta]2, \[Phi]1] +
            corrgs[\[Theta]1, \[Phi]2] - corrgs[\[Theta]2, \[Phi]2]); 
       svet = NMaximize[
         Svet2, {\[Theta]1, \[Theta]2, \[Phi]1, \[Phi]2}]; 
       AppendTo[svetvals, ComplexExpand[Re[svet[[1]]]]]; 
       Clear[corrgs, Svet2, svet]},
      If[
       i == 3, { 
        corrgs[\[Theta]_, \[Phi]_] := 
         Tr[rot3[\[Theta], \[Phi]] . \[Rho]gs];
        Svet2 = 
         1/2 (corrgs[\[Theta]1, \[Phi]1] + 
            corrgs[\[Theta]2, \[Phi]1] + corrgs[\[Theta]1, \[Phi]2] - 
            corrgs[\[Theta]2, \[Phi]2]); 
        svet = NMaximize[
          Svet2, {\[Theta]1, \[Theta]2, \[Phi]1, \[Phi]2}]; 
        AppendTo[svetvals, ComplexExpand[Re[svet[[1]]]]]; 
        Clear[corrgs, Svet2, svet]}, "Failed"]]], {i, 1, 3, 1}];
   If[Max[svetvals] == Part[svetvals, 1], 
    AppendTo[XY2m1, {b, g, Max[svetvals]}], 
    If[Max[svetvals] == Part[svetvals, 2], 
     AppendTo[XY2m2, {b, g, Max[svetvals]}], 
     If[Max[svetvals] == Part[svetvals, 3], 
      AppendTo[XY2m3, {b, g, Max[svetvals]}]]]];}, {b, 0, 2, 0.2}, {g,
    0, 1, 0.05}];

(*plotting*)
M1n2 = ListPointPlot3D[XY2m1, PlotStyle -> {Red}, 
   PlotLegends -> {"Method 1"}];
M2n2 = ListPointPlot3D[XY2m2, PlotStyle -> {Green}, 
   PlotLegends -> {"Method 2"}];
M3n2 = ListPointPlot3D[XY2m3, PlotStyle -> {Blue}, 
   PlotLegends -> {"Method 3"}, AxesStyle -> Directive[Black, 1]];
plane = Plot3D[z = 1, {x, 0, 2}, {y, 0, 1}, 
   PlotStyle -> {Opacity[0.5], Blue}];
Show[M1n2, plane, M2n2, M3n2, PlotRange -> All]

Here's the plot: svet against gamma and b

And here's sort of what I want the plot to look like (but color coded) listplot3d

I've seen a few other questions where they used colorfunction like here, but it seems that color function works by color coding the heights of a separate array (like a 4th dimension), whereas I've got a "4th dimension" picking the maximum of a triplet at every point.

$\endgroup$
3
  • $\begingroup$ does this give something close to what you need: ListPlot3D[Join[XY2m1, XY2m2, XY2m3], PlotStyle -> Opacity[.5], VertexColors -> Flatten[MapThread[# /. {__Real} :> #2 &][{{XY2m1, XY2m2, XY2m3}, {Red, Green, Blue}}]]]? $\endgroup$
    – kglr
    Feb 25, 2023 at 19:31
  • $\begingroup$ @kglr Yes that's amazing! $\endgroup$
    – jay
    Feb 25, 2023 at 22:00
  • $\begingroup$ @kglr Apologies for the multiple mentions, would you mind just briefly explaining what this is part is doing, so I could make adjustments for other data? MapThread[# /. {__Real} :> #2 &] $\endgroup$
    – jay
    Feb 25, 2023 at 22:46

1 Answer 1

1
$\begingroup$

You may define your own color function like:

colfun = 
  Function[{x, y, z}, 
   Which[MemberQ[XY2m1, {x, y, z}], Red, MemberQ[XY2m2, {x, y, z}], 
    Green, _, Blue]];
legend = 
  SwatchLegend[{Red, Green, Blue}, {"Method1", "Method2", "Method3"}, 
   LegendMarkers -> 
    Graphics[{EdgeForm[Black], Opacity[0.5], Rectangle[]}], 
   LegendFunction -> (Framed[#, RoundingRadius -> 5] &), 
   LegendMargins -> 5];

ListPlot3D[Join[XY2m1, XY2m2, XY2m3], ColorFunction -> colfun, 
 ColorFunctionScaling -> False, PlotStyle -> White , 
 PlotLegends -> legend]

enter image description here

$\endgroup$
2
  • $\begingroup$ Many thanks! Might I ask how/why it's selecting some parts of the mesh to be white though? $\endgroup$
    – jay
    Feb 25, 2023 at 17:01
  • $\begingroup$ Because only the part around the points are colored and I choose a white background. $\endgroup$ Feb 25, 2023 at 19:11

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.