How to plot ternary density plots?

A basic approach

You can start with a regular density plot, restricted to the domain of x and y using RegionFunction. Then you can transform the plot to an equilateral triangle.

f[p_, q_, r_] := r Sin[10 p]^2 + (1 - r) r Cos[20 q]^2;

dp = DensityPlot[f[x, y, 1 - x - y], {x, 0, 1}, {y, 0, 1}, 
  RegionFunction -> (#1 <= 1 - #2 &), ColorFunction -> (Hue[0.85 #] &),
   Frame -> None, PlotRange -> All, AspectRatio -> Automatic]

Mathematica graphics

It's easy enough to construct the transformation by hand, but it's also easy to use FindGeometricTransform.

{error, xf} = 
  FindGeometricTransform[
    {{0, 0}, {1, 0}, {1, Tan[Pi/3]}/2},
    {{0, 0}, {1, 0}, {0, 1}}];

Graphics[
  GeometricTransformation[
   First @ dp,
   xf
   ]]

Mathematica graphics

We can apply ticks modifying this answer to create a triangleTicks function (see below).

triangleTicks[Graphics[
  GeometricTransformation[
   First@dp,
   xf
   ]]
 ]

Mathematica graphics


Update 3 - A better looking (at low-res) approach

Here's another parametrization that goes along with Mathematica's native subdivision of the plot domain. It shows that the right triangles in the subdivision of the base image are mapped to equilateral triangles in the transformed image. So it looks less distorted, although from a mathematical point of view, the denser the same points, the more faithful the representation. The plot above appears to have a roughly ENE bias due to the mesh subdivision getting compressed.

cartestianToBarycentric2 = 
 Compile[{{x, _Real}, {y, _Real}}, (x - y) {1, 0} + y {1, Sqrt[3]}/2, 
  RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed"]; base = 
 DensityPlot[f[x - y, y, 1 - x], {x, 0, 1}, {y, 0, 1},
  Mesh -> All, MaxRecursion -> 0, RegionFunction -> (#1 >= #2 &), 
  ColorFunction -> (Hue[0.85 #] &), Frame -> None, PlotRange -> All, 
  AspectRatio -> Automatic];
transformed = MapAt[
   cartestianToBarycentric2 @@ Transpose[#] &,
   base,
   {1, 1}];
Graphics[{
  Inset[Show[base, AlignmentPoint -> {1.2, 0}], {0, 0}, Automatic, 
   1],
  Thick, Arrow[{{-0.1, 0.4}, {0.15, 0.4}}],
  Inset[Show[transformed, AlignmentPoint -> {-0.1, 0}], {0, 0}, 
   Automatic, 1]},
 PlotRange -> {{-1.2, 1.15}, {-0.05, 1.0}}
 ]

Mathematica graphics

Here is a plot with a coordinate grid:

dp = DensityPlot[f[x - y, y, 1 - x], {x, 0, 1}, {y, 0, 1},
   MeshFunctions -> {#1 - #2 &, #2 &, 1 - #1 &}, Mesh -> 19,
   RegionFunction -> (#1 >= #2 &), ColorFunction -> (Hue[0.85 #] &), 
   Frame -> None, PlotRange -> All, AspectRatio -> Automatic];
triangleTicks[
 MapAt[
  cartestianToBarycentric2 @@ Transpose[#] &,
  dp,
  {1, 1}]
 ]

Mathematica graphics


Update 1 -- Getting rid of GeometricTransform from the plot

Alexey Popkov pointed out that there is a problem with GeometricTransform and exporting. It was easy to fix the density plot, and the ticks needed rewriting (see below).

cartestianToBarycentric = 
  Compile[{{x, _Real}, {y, _Real}}, x {1, 0} + y {1, Sqrt[3]}/2, 
   RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed"];

MapAt[
 cartestianToBarycentric @@ Transpose[#] &,
 dp,
 {1, 1}]

Update 2 -- Getting rid of GeometricTransform from the ticks

tickGraphics now avoids using GeometricTransform

Basically tickGraphics creates an axis on one side of the equilateral triangle. It is rotated about the sides (counter-rotating the text). The argument total represents the sum of the ternary variables (which should be constant).

ClearAll[tickGraphics, triangleTicks];
Module[{ticklen = 0.025, (*length of ticks (const parameter)*)
        textoffset = 0.04},
 
 tickGraphics[tickrange : {0., total_}, angle_] := 
  With[{rotSideXF = RotationTransform[angle, total {1., Tan[Pi/6]}/2.]},
   {Line[rotSideXF /@ Thread[{tickrange, 0}]],
    With[{rotTickXF = Composition[
          RotationTransform[π/3., rotSideXF @ {#, 0.}],
          rotSideXF]},
       {Text[NumberForm[N @ #, {3, 2}], 
         rotTickXF[total {-ticklen - textoffset, 0} + {#, 0.}], {0, 0.}],
        {Line[rotTickXF /@ {total {-ticklen, 0} + {#, 0.}, {#, 0.}}]}}] & /@
     Select[N @ FindDivisions[tickrange, 4], 0. <= # <= total &]
    }
   ];
 
 triangleTicks[g_Graphics, total_: 1] :=
  Show[
   Graphics[First@g],
   Graphics[{
     AbsoluteThickness[0.5],
     Table[
      tickGraphics[{0., total}, N@angle],
      {angle, 0, 4 Pi/3, 2 Pi/3}]}],
   Axes -> False, Frame -> None, 
   PlotRange -> total {{0, 1 + ticklen}, {0, Sqrt[3]/2 + ticklen/2}}, 
   PlotRangePadding -> 0.07 total, PlotRangeClipping -> False, 
   ImagePadding -> {{20, 5}, {20, 5}}]
 ]

Update: now it is real ternary plot.

You can start with the 2D-adaptation of the surface plotting:

texturize[f_, n_, colf_] := # /. Polygon[{v1_, v2_, v3_}] :> {EdgeForm[], 
      Texture@ImageData@Colorize[Image@f[#1, #2, 1 - #1 - #2] &[#, Transpose[#]] &@
          ConstantArray[Range[-1./n, 1 + 1/n, 1./n], n + 3], 
         ColorFunction -> colf, ColorFunctionScaling -> False], 
      Polygon[{v1, v2, v3}, VertexTextureCoordinates -> {{1 - 1.5/(n+3), 1 - 1.5/(n+3)}, 
         {1.5/(n+3), 1.5/(n+3)}, {1.5/(n+3), 1 - 1.5/(n+3)}}]} &;

f = #3 Sin[10 #1]^2 + (1 - #3) #3 Cos[20 #2]^2 &;

triangleTicks@Graphics@N@Polygon[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}] 
     // texturize[f, 300, Hue]

enter image description here

Here f assumed to be Listable. For ticks I used Michael's triangleTicks function.

Note, that this approach is ~100 times faster than corresponding DensityPlot!


The built-in ContourPlot3D seems fast enough for me:

f = #3 Sin[10 #1]^2 + (1 - #3) #3 Cos[20 #2]^2 &;

frange = Through@{NMinValue, NMaxValue}[{f[x, y, z], 
                    0 <= x <= 1 && 0 <= y <= 1 && 0 <= z <= 1}, {x, y, z}];

AbsoluteTiming[
    trigplot3d = 
        ContourPlot3D[x + y + z == 1, {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
            PlotRange -> All,
            PlotPoints -> 50,
            (* you can add any kind of mesh: *)
            MeshFunctions -> Function[{x, y, z, w}, f[x, y, z]],
            Mesh -> 10,
            (* ColorFunction is essential: *)
            ColorFunctionScaling -> False,
            ColorFunction -> Function[{x, y, z, w},
                    ColorData["Rainbow"][
                        Rescale[f[x, y, z], frange]
                        ]]
            ]]

ternary density plot on ContourPlot3D

The rest work is to transform the Graphics3D to Graphics:

opt3d = {VertexNormals, BoxRatios, Lighting, RotationAction, SphericalRegion};
optboth = {PlotRange, PlotRangePadding};

trigplot2d = 
    trigplot3d /. GraphicsComplex[pts_, others__] :> GraphicsComplex[
                            # + {1/2, 1/(2 Sqrt[3])} & /@ (
                                     ((pts/Sqrt[2]).
                                      RotationMatrix[{{1, 1, 1}, {0, 0, 1}}]\[Transpose]
                                     )[[All, 1 ;; 2]].
                                     RotationMatrix[-((3 π)/4)]\[Transpose]
                                    ),
                            others] /.
                Rule[opt_, _] /; MemberQ[opt3d, opt] :> Sequence[] /.
            Rule[opt_, v_] /; MemberQ[optboth, opt] :> Rule[opt, v[[1 ;; 2]]] /.
        Graphics3D -> Graphics;

Using Michael E2's nice ticking function triangleTicks:

triangleTicks[trigplot2d]

final ternary density plot