7
$\begingroup$

I'm wondering if there's something in Mathematica similar to the built-in function in R shown in the figures below, borrowed from this post, possibly with flexible axes "orientation", ticksmarks, tick numbers, and gridlines.

enter image description here

By a 3-category Dirichlet distribution, it means that each data point is in the form of $\{u, v, 1-u-v\}$, where the degree of freedom is two with $0<u<1$, $0<v<1$, and $0<u+v<1$.

Currently I've been doing something like the demonstrative code below, transforming the data points myself from $\{u,v\}$ in the usual Cartesian coordinates to the "triangular" coordinates. (here the "vertical" axis is flipped just like those plots from R)

ClearAll[Opt, data, dN]; 
dN = 100; 
data = RandomReal[{0, 1}, {dN, 3}]; 
data = data/(Total /@ data); 
Opt = {PlotStyle -> PointSize -> Medium, AspectRatio -> 1, PlotRange -> {{0, 1}, {0, 1}}, GridLines -> {{1}, {1}} };
GraphicsRow[{ListPlot[data[[;; , 1 ;; 2]], 
    Epilog -> Line@{{1, 0}, {0, 1}}, Evaluate@Opt] , 
ListPlot[ Thread@{1/2 (1 + data[[;; , 1]] - data[[;; , 2]]), Sqrt[3] data[[;; , 3]]/2} , 
    Epilog -> {FaceForm[], EdgeForm@[email protected], Triangle@{{0, 0}, {1, Sqrt[3]}/2, {1, 0}}}, Evaluate@Opt]}, ImageSize -> 500]

enter image description here

Firstly I feel kind of stupid having to do it this way every time. Secondly, it's tedious to add the tickmarks, gridlines, etc.

So, repeating my question statement in the opening line:

Is there actually a similar built-in graphics package in MMA? If not, is there a convenient way to achieve some if not all the features in a "triangular plot" shown in the R plots?

I would imagine that Dirichlet distribution is pretty common and someone have developed something practically useful already.

Pointers to references or any suggestions will be appreciated.

$\endgroup$
4
  • 1
    $\begingroup$ Would you be opposed to using the native R package from within Mathematica through RLink? $\endgroup$
    – MarcoB
    May 2, 2018 at 15:03
  • $\begingroup$ @MarcoB oh thank you for reminding me of that. I wouldn't really mind using RLink, however, I prefer the style of the graphics primitives in MMA. It's also about consistency, it feels a bit weird seeing an R plot among other MMA plots, either in formal or informal presentation. $\endgroup$ May 2, 2018 at 15:13
  • 2
    $\begingroup$ Have you seen How to plot ternary density plots? You might be interested in other posts on ternary plots. $\endgroup$
    – MarcoB
    May 2, 2018 at 15:56
  • $\begingroup$ @MarcoB These posts and in fact just the term "ternary plot" is very helpful. Thank you so much. $\endgroup$ May 3, 2018 at 0:45

1 Answer 1

5
$\begingroup$

How is this? It does not support all Graphics options, but that can be customized. As is, it mimics the styling of ListPlot.

ClearAll[BarycentricPlot];
BarycentricPlot[data_?MatrixQ,
  OptionsPattern[{
    "Ticks" -> N@Range[0, 1, 1/10]
    }]] := 
 Module[{λ, pts, plot, h, c, opts, g, s, prolog, gridlinesx, 
   gridlinesy, ticks},
  h = Sin[Pi/3];
  c = {1/2, h/3};
  λ = data/Total[data, {2}];
  plot = ListPlot[λ.Developer`ToPackedArray[
      N[{{0, 0}, {1, 0}, {1/2, h}}]]];
  opts = Options[plot];
  ticks = OptionValue["Ticks"];
  gridlinesy = ticks[[2 ;; -2]] h;
  gridlinesx = gridlinesy/Tan[Pi/3];
  g[label_, θ_, ϕ_] :=
   Graphics[{
     Rotate[
      Text[Style[label, {}], {1/2, h + 0.1}], ϕ, {1/2, 
       h + 0.1}],
     GridLinesStyle /. opts,
     Line@Transpose[{
        Transpose[{gridlinesx , gridlinesy}],
        Transpose[{1 - gridlinesx , gridlinesy}]
        }]
     },
    PlotRangePadding -> 0,
    ImageMargins -> 0.1,
    PlotRange -> {{0, 1}, {0, 2 h}},
    Axes -> {True, False},
    Ticks -> {Table[{x, Rotate[x, 4 Pi/3 + θ]}, {x, ticks}], 
      None},
    AxesStyle -> (AxesStyle /. opts)
    ];
  s = 1.055;
  prolog = Graphics[{
     Inset[g["\!\(\*SubscriptBox[\(μ\), \(3\)]\)", -Pi, 0], c, c, 
      s],
     Rotate[
      Inset[g["\!\(\*SubscriptBox[\(μ\), \(1\)]\)", 0, Pi], c, c, 
       s], 2/3 Pi, c],
     Rotate[
      Inset[g["\!\(\*SubscriptBox[\(μ\), \(2\)]\)", -Pi, -Pi], c, 
       c, s], 4/3 Pi, c]
     },
    PlotRange -> {{0, 1}, {0, h}},
    PlotRangePadding -> Scaled[0.15],
    Frame -> False
    ];
  Show[{prolog, plot}]
  ]

dN = 1000;
data = RandomReal[{0, 1}, {dN, 3}];
BarycentricPlot[data]

enter image description here

$\endgroup$
1
  • $\begingroup$ It looks great! I will need some time to get familiar with part of the construct that is more advanced (to me). Really appreciated your demonstration of good coding practice. $\endgroup$ May 3, 2018 at 0:53

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.