# Create a color coded ListPlot3D

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*)

(*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:

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

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.

• 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}}]]]?
– kglr
Feb 25, 2023 at 19:31
• @kglr Yes that's amazing!
– jay
Feb 25, 2023 at 22:00
• @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 &]
– jay
Feb 25, 2023 at 22:46

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]


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