# Extending a ternary plot to a tetrahedron (using ListPlot)

I have been making ternary plots of data that is a list of sets of 3 numbers, where the numbers in each set sum to one (call this "DATA"). To do this, I first transform DATA onto the 2D surface with the following:

transf[{a_, b_, c_}] := {b + c/2, (Sqrt[3] c)/2}

Map[transf,DATA].


This gives a list of sets of 2 numbers that map onto a simplex (call this DATA2). This is how I've plotted DATA2:

Show[{
RegionPlot[Sqrt[3] a1 - a2 < 0, {a1, 0, .5}, {a2, 0, 1},
DisplayFunction -> Identity, PlotStyle -> White,
BoundaryStyle -> None],
RegionPlot[Sqrt[3] a1 + a2 > Sqrt[3], {a1, .5, 1}, {a2, 0, 1},
DisplayFunction -> Identity, PlotStyle -> White,
BoundaryStyle -> None],
RegionPlot[a2 < 0, {a1, 0, 1}, {a2, -.2, 1},
DisplayFunction -> Identity, PlotStyle -> White,
BoundaryStyle -> None],
ListPlot[{{0, 0}, {1, 0}, {.5, Sqrt[3]/2}, {0, 0}}, Joined -> True,
PlotStyle -> {Black, Thickness[.015]}],
ListPlot[{DATA2}, Joined -> True,
PlotMarkers -> Automatic]},
AspectRatio -> Automatic, Frame -> False,
PlotRange -> {{0, 1}, {0, 1}}]


Example:

Question: Now, I have an extended data set that is made up of sets of 4 numbers that sum to one. I'd like to plot the data in an analogous way, but now on the corresponding tetrahedron. However, I'm not sure how to transform the data or how to draw the appropriate tetrahedron.

Can anyone help with this, please?

-

Is this the sort of thing you want?

data = #/Total[#, {2}] &@Log@RandomReal[1, {10000, 4}];
pts = data.PolyhedronData["Tetrahedron", "VertexCoordinates"];
Graphics3D[Point[pts, VertexColors -> RGBColor @@@ data],  Axes -> True]


Based on Ray Koopman's answer to Uniformly distributed n-dimensional probability vectors, which I used in my answer to Random reals according to conditions for a similar purpose.

Updated -- Below is a plot the tetrahedron added and the points joined and colored in order:

data = #/Total[#, {2}] &@Log@RandomReal[1, {20, 4}];
pts = data.PolyhedronData["Tetrahedron", "VertexCoordinates"];
Graphics3D[{
GraphicsComplex[pts,
{PointSize[Medium],
Point[Range@Length@pts, VertexColors -> Automatic],
Line[Range@Length@pts, VertexColors -> Automatic]},
VertexColors -> (ColorData["Rainbow"] /@ Rescale[Range@Length@pts])
], {Thick, PolyhedronData["Tetrahedron", "Edges"]}}, Axes -> True]


Other color schemes than "Rainbow" may be used in the VertexColors option:

VertexColors -> (ColorData["Rainbow"] /@ Rescale[Range@Length@pts])


This GraphicsComplex option associates a color with each point in pts, that are used when the setting VertexColors -> Automatic occurs in Point, Line, or Polygon (not present here). Unfortunately Arrow does not accept the VertexColors option, so if arrows are used, each arrow would have to be colored indvidually (programmatically).

If more than one data set is to be colored, it would probably be best to use separate GraphicsComplexes and color them with sufficiently distinct color schemes.

-
This is not quite what I had in mind, but perhaps I could use it as a starting point. Ideally, I'd like to draw the tetrahedron, as in the example of the simplex which I've now added above. In that example, I've plotted two of the data sets--one in grey, one in black. –  jmbierna Aug 15 '14 at 12:54
@jmbierna It was hard to tell since DATA was not given nor an image initially (and I usually do not pore over code until I can see what the issue is). See the update -- adding another data set with a different color should be easy. –  Michael E2 Aug 15 '14 at 13:02
That's fair, I was not giving enough info. This looks very promising. I guess it will be easy to take away the box (frame) too? Many thanks for your help. –  jmbierna Aug 15 '14 at 13:06
@jmbierna Boxed -> False and leave out the Axes option. And you're welcome. :) –  Michael E2 Aug 15 '14 at 13:08
At the risk of pushing my luck: Is there an easy way to replace the points with arrowheads that show the direction of movement? E.g., suppose the n sets are arranged from time 0 to time n. Then the figure could show the dynamics of the system over time. –  jmbierna Aug 15 '14 at 15:47