2
$\begingroup$

I have data to make multiple ternary plots, each having 3 points on it.

Is it possible to stack those ternary plots in 3D on top of each other? Then, is it possible to connect the points of the same color in each ternary plot with each other in 3D to see how, for example, the blue point evolves as you move in 3D.

Here is an example to make 2 ternary plots.

vec1 = {{{0.3, 0.4, 0.3}}, {{0.6, 0.3, 0.1}}, {{0.25, 0.25, 0.5}}}; 
vec2 = {{{0.25, 0.3, 0.45}}, {{0.5, 0.15, 0.35}}, {{0.2, 0.2, 0.6}}}; 
TernaryListPlot[{vec1[[1]], vec1[[2]], vec1[[3]]}, PlotStyle -> {Blue, Red, Magenta}, FrameLabel -> {"A", "B", "C"}, PlotStyle -> PointSize[0.04]]
TernaryListPlot[{vec2[[1]], vec2[[2]], vec2[[3]]}, PlotStyle -> {Blue, Red, Magenta}, FrameLabel -> {"A", "B", "C"}, PlotStyle -> PointSize[0.04]]

Can I stack these two and connect vec1[[1]] to vec2[[1]], vec1[[2]] to vec2[[2]] etc using a line?

$\endgroup$

2 Answers 2

6
$\begingroup$

Maybe this result?

Edit

Clear["Global`*"];
ternary[{p1_, p2_, p3_}] := {p1 + 1/2 p2, Sqrt[3]/2 p2};

vec1 = {{{0.3, 0.4, 0.3}}, {{0.6, 0.3, 0.1}}, {{0.25, 0.25, 0.5}}};
vec2 = {{{0.25, 0.3, 0.45}}, {{0.5, 0.15, 0.35}}, {{0.2, 0.2, 0.6}}};

pts1 = PadRight[#, 3] & /@ ternary /@ Flatten[vec1, 1];
pts2 = PadRight[#, 3, 1] & /@ ternary /@ Flatten[vec2, 1];
plane1 = 
  Polygon[PadRight[#, 3] & /@ 
    ternary /@ {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}];
plane2 = 
  Polygon[PadRight[#, 3, 1] & /@ 
    ternary /@ {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}];

Graphics3D[{{Opacity[.2], plane1, 
   plane2}, {MapThread[{#3, AbsolutePointSize[8], Point[#1], 
      Point[#2], Arrow[{#1, #2}]} &, {pts1, 
     pts2, {Blue, Red, Magenta}}]}}, BoxRatios -> Automatic, 
 Boxed -> False, Axes -> True, ViewProjection -> "Orthographic"]

enter image description here

Original

Clear["Global`*"];
vec1 = {{{0.3, 0.4, 0.3}}, {{0.6, 0.3, 0.1}}, {{0.25, 0.25, 0.5}}};
vec2 = {{{0.25, 0.3, 0.45}}, {{0.5, 0.15, 0.35}}, {{0.2, 0.2, 0.6}}};
plane = ContourPlot3D[x + y + z == 1, {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
    Mesh -> None, ContourStyle -> {White, Opacity[0.8]}];
points1 = ListPointPlot3D[vec1, PlotStyle -> {Blue, Red, Magenta}];
points2 = ListPointPlot3D[vec2, PlotStyle -> {Blue, Red, Magenta}];
arrows = 
  Graphics3D[Arrow /@ Thread@{Flatten[vec1, 1], Flatten[vec2, 1]}];
Show[plane, points1, points2, arrows, PlotRange -> All, 
 BoxRatios -> Automatic, Boxed -> False, Axes -> False]

enter image description here

$\endgroup$
2
  • $\begingroup$ Thanks for the answer! So the magnitude of each vector that produces a point is exactly 1, so in a way, each of the points show percentages of what I call A,B, and C in the ternary plots. That is why I need them to stay in a ternary plot, and have them stacked with increasing z-direction. Even if adding arrows is not doable, it would still be helpful to simply have the ternary plots stacked on top of each other with some fixed space in between each consecutive one. $\endgroup$
    – juv95
    Jul 7 at 2:58
  • $\begingroup$ @juv95 I have updated the answer,does it satisfy the request? $\endgroup$
    – cvgmt
    Jul 7 at 5:54
3
$\begingroup$

Pre-process input data to add z-coordinates and re-group:

zlevels = {1, 5};

vecs = Transpose @ MapApply[Map[Append[#]] @ Apply[Join][#2]&][
   Transpose @ {zlevels, {vec1, vec2}}]
 {{{0.3, 0.4, 0.3, 1}, {0.25, 0.3, 0.45, 5}},  
  {{0.6, 0.3, 0.1, 1}, {0.5, 0.15, 0.35, 5}},  
  {{0.25, 0.25, 0.5, 1}, {0.2, 0.2, 0.6, 5}}}

Use vecs with Charting`TernaryListPlot3D:

Charting`TernaryListPlot3D[vecs,
 "PlotBaseStyle" -> Directive[AbsolutePointSize[9]],
 PlotRange -> {-3, 9}, FaceGrids -> None, 
 PlotStyle -> Directive[FaceForm[], EdgeForm[]]]

enter image description here

Post-process to add arrows:

ReplaceAll[Point[x_] :> {Point[x], Arrowheads[Large], Arrow[x]}] @ %

enter image description here

If needed, add ternary clip-planes at desired z-levels:

Show[%,
 MapThread[
   Charting`TernaryListPlot3D[{{0, 0, 0, #}, {0, 0, 1, #}, {0, 1,  0, #}}, 
     "PlotBaseStyle" -> Directive[AbsolutePointSize[0]], 
     Ticks -> None, 
     PlotStyle -> Directive[FaceForm[Directive[Opacity[.1], #2]], 
       EdgeForm[]]] &][{zlevels, {Red, Green}}], 
 BoxRatios -> 1]

enter image description here

$\endgroup$

Your Answer

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

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