3D Ternary Plot - Triangular Prism?

Question

I'm new to Mathematica and I am using it as a free trial online.

I am doing a biology experiment, varying the composition of people's diet and seeing the effect of that on sleep. Because I am varying macronutrient break down, I have a three part system. (eg. 50% protein, 30% carbohydrates, 20% fat etc). I can denote this percentage diet break down on a ternary plot.

I then want to extend this into 3D space because my dependent variable is sleep duration etc - how can I plot this 'y' value for a corresponding point on the ternary plot?

eg. 7 hours sleep corresponds to 50:30:20, 8 hours sleep corresponds to 40:20:40 etc

Appreciate I may not have been the clearest, so happy to explain things again if needs-be! In an attempt to make some thing clearer, I am attaching a hand drawn picture of what I think I want!

There are a couple of different ways I can visualise it in my head:

In the first idea - I have a density plot, with, for example, three different qualities of sleep.

In the second idea, the whole ternary plot becomes sort of an x axis? I then extend into the 3D plane with my sleep variable...this would be like a normal 'y' axis, i.e. the higher you go, the higher the number. Would it be possible to do this with just one sleep variable or would it have to be done with a minimum of two sleep variables? If it needs more than one sleep variable that is fine too, because I have for example, time it takes to get to sleep and deep sleep percentage too, which I could put on the same graph.

Hopefully my 'triangular prism' reference is starting to make sense now!!

Answer 1

I'll start by making a random dataset. Here we take 2 random numbers for the first two variables then set the third such that $a+b+c=1$ to be consistent with a Ternary plot. Here $a,b,c$ correspond to carbs, fat, protein respectively. We take the 4th variable to be another independent random number which corresponds to sleep for your case. Lastly we select only the data where $\{a,b,c\}>0$

data = Select[Table[
{a, b, 1 - a - b, RandomReal[]} /. {a -> RandomReal[], b -> RandomReal[]}, {i, 5000}],
 # == Abs[#] &];

We'll want to define our transformation from 3 variables down into our triangular 2D grid and convert our data over. This I just pull directly from Wikipedia.

toGrid[p_] := 1/2 {2 p[[2]] + p[[3]], Sqrt[3] p[[3]]};
dataPts = {10 toGrid[Most@#], Last@#} & /@ data;

Next we'll define some quantities to draw our triangular grid with

pts3D = Select[Tuples[Range[0, 10], {3}], #[[1]] + #[[2]] + #[[3]] == 10 &];
pts = toGrid /@ pts3D;
ptsG = Table[toGrid /@ Select[pts3D, #[[i]] == 0 &], {i, 3}];
lines = {Thread[{ptsG[[1]], ptsG[[2]]}], 
   Thread[{ptsG[[2]], ptsG[[3]]}], 
   Thread[{ptsG[[1]], Reverse[ptsG[[3]]]}]};

Add some styling and text to spruce it up

st[sz_] := Style[#, Black, Bold, FontFamily -> "Times", sz] &;
rot = 60 Degree;
ticks = st[12] /@ Table[10 i, {i, 0, 10}];
labels = {Rotate[Text[st[16]["Carbs"], {1.5, 5}], rot],
   Text[st[16]["Fats"], {5, -1}],
   Rotate[Text[st[16]["Protein"], {8.5, 5}], -rot]};
mkTicks[ind_, ang_, off_] := Table[
Rotate[Text[If[ind == 2, Reverse[ticks], ticks][[i]], 
    ptsG[[ind, i]] + off], ang], {i, Length[ticks]}]

Finally draw it! Here sleep is a number between 0 and 1 with 0 being red, 1/2 being blue, 1 being green and anything in between a proportional blend between the 3.

Graphics[{Point /@ pts, labels, Line /@ lines, mkTicks[1, rot, {1/4, 1/4}],
 mkTicks[2, 0, {-2/5, 0}], mkTicks[3, -rot, {1/5,-1/3}], Opacity[0.25],
 {FaceForm@Blend[{Red, Blue,Green}, #[[-1]]], Disk[#[[1]], 0.2]} & /@ dataPts}]

Obviously a non-random dataset should show some more revealing patterns. In my experience 3D graphs are really hard to make look nice and convey the data in a digestible way, I think this way should work nicely.

edit:

Here's some quick and dirty code for an idea of a DensityPlot. Because my data is random it looks mostly like a solid block of color. You can clean it up and add all the axes and stuff if you like.

int = Interpolation[dataPts, InterpolationOrder -> 1];
dataInt[x_, y_] = If[y < Sqrt[x^2 + y^2] Sin[rot] && y < Sqrt[(1 - x)^2 + y^2] Sin[rot],int[x, y], I];
plt2 = DensityPlot[dataInt[x, y], {x, 0, 1}, {y, 0, 1}]