ggtern - create contoured ternary plot

Question

I am trying to create a ternary plot with contoured filling using the "ggtern" package. The aim would be to create a similar plot as shown below, where each triangulation point (EXT;INT;SA) expresses a value MF...

I was using the "stat_interpolate_tern()" function, based on the friendly support of the stackoverflow community see here. However, due to the linear model of the interpolation, the decreasing values in the right bottom corner are then missing. Also defining the contour thresholds is not optimal. What I get so far...

Does anyone have an idea, how this can be done with ggtern? Here the data and code example...

SA <- c(1.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.9, 0.1, 0.1, 0.8, 0.0, 0.0, 0.2, 0.2, 0.8, 0.3, 0.7, 0.0, 0.0, 0.3, 0.7, 0.0, 0.4, 0.0, 0.6, 0.6, 0.4, 0.5, 0.0, 0.5, 0.1, 0.1, 0.8, 0.7, 0.1, 0.2, 0.1, 0.7,
    0.2, 0.6, 0.1, 0.1, 0.6, 0.3, 0.3, 0.1, 0.5, 0.1, 0.4, 0.5, 0.4, 0.6, 0.2, 0.2, 0.3, 0.5, 0.2, 0.5, 0.2, 0.3, 0.4, 0.4, 0.2, 0.3, 0.3, 0.4)
INT <- c(0.0, 0.0, 1.0, 0.1, 0.9, 0.0, 0.1, 0.9, 0.0, 0.0, 0.8, 0.2, 0.8, 0.0, 0.2, 0.0, 0.3, 0.7, 0.3, 0.7, 0.0, 0.6, 0.0, 0.4, 0.0, 0.4, 0.6, 0.5, 0.5, 0.0, 0.1, 0.8, 0.1, 0.1, 0.2, 0.7, 0.7, 0.2,
     0.1, 0.1, 0.3, 0.6, 0.3, 0.6, 0.1, 0.4, 0.1, 0.5, 0.1, 0.4, 0.5, 0.2, 0.6, 0.2, 0.5, 0.3, 0.3, 0.2, 0.5, 0.2, 0.4, 0.2, 0.4, 0.4, 0.3, 0.3)
EXT <- c(0.0, 1.0, 0.0, 0.9, 0.1, 0.1, 0.0, 0.0, 0.9, 0.2, 0.2, 0.8, 0.0, 0.8, 0.0, 0.7, 0.0, 0.3, 0.7, 0.0, 0.3, 0.4, 0.6, 0.6, 0.4, 0.0, 0.0, 0.0, 0.5, 0.5, 0.8, 0.1, 0.1, 0.2, 0.7, 0.1, 0.2, 0.1,
     0.7, 0.3, 0.6, 0.3, 0.1, 0.1, 0.6, 0.5, 0.4, 0.4, 0.5, 0.1, 0.1, 0.2, 0.2, 0.6, 0.2, 0.2, 0.5, 0.3, 0.3, 0.5, 0.2, 0.4, 0.4, 0.3, 0.4, 0.3)
MF <- c(1.433, 0.251, 0.000, 0.176, 0.000, 1.556, 1.490, 0.087, 0.522, 1.718, 0.000, 0.098, 0.347, 0.772, 1.642, 1.093, 1.762, 0.000, 0.052, 0.713, 1.857, 0.000, 1.367, 0.022, 1.814,
       1.726, 1.043, 1.424, 0.001, 1.722, 0.428, 0.122, 1.656, 1.798, 0.330, 0.384, 0.138, 1.777, 0.661, 1.763, 0.271, 0.166, 1.733, 0.753, 0.984, 0.236, 1.574, 0.204, 1.232, 1.471,
       1.086, 1.748, 0.409, 0.568, 0.790, 1.505, 0.520, 1.552, 0.451, 0.884, 1.094, 1.180, 0.484, 0.831, 0.859, 1.123)
df <- data.frame(SA,INT,EXT,MF)

library(ggtern)
library(viridis)

ggtern(df, aes(INT, EXT,SA, value = MF)) +
  stat_interpolate_tern(geom="polygon",
                        formula = value~y+x,
                        method = lm, n = 100,
                        breaks = seq(0, 2.5, length.out = 9),
                        aes(fill = ..level..), expand = 1) +
  scale_fill_viridis()+
  labs(fill = "MultiF.") +
  theme_rgbw() +
  theme(tern.panel.grid.ontop = TRUE)

Thank you in advance for your support!

Answer 1

With ggtern, I had some difficulties as well providing the right interpolation. Especially, the polygons are a bit tricky.

When you switch to stat = "InterpolateTern" instead of stat = "polygon", you could reproduce your example, together with the important changes in base = "identity" and method = "auto":

ggtern(df,
  aes(INT, EXT,SA, value = MF)) +
    geom_interpolate_tern(
        stat = "InterpolateTern",
        method = "auto",
        na.rm = TRUE,
        formula = value ~ x + y,
        expand = 0,
        base = "identity",
        aes(
            colour = after_stat(level)
        ),
        breaks = seq(0,1.75, length.out = 9),
        size = 2
    ) + scale_colour_viridis() +
    theme_rgbw()

But this gives only the countours:

I was not able to generate a polygon based plot to deliver the desired output as the polygons are usually truncated.

I helped myself with a workaround:

ggtern(df, 
             aes(INT, EXT,SA, value = MF)) +
    geom_interpolate_tern(
        stat = "InterpolateTern",
        method = "auto",
        na.rm = TRUE,
        formula = value ~ x + y,
        expand = 0,
        base = "identity",
        aes(
            colour = after_stat(level)
        ),
        breaks = seq(0,1.8, length.out = 500),
        size = 5
    ) +
    geom_interpolate_tern(
        stat = "InterpolateTern",
        method = "auto",
        na.rm = TRUE,
        formula = value ~ x + y,
        expand = 0,
        base = "identity",
        aes(
            colour = after_stat(level)
        ),
        breaks = seq(0, 1.75, length.out = 9),
        size = 1,
        colour = "white"
    )+  scale_colour_viridis() +
    theme_rgbw() + 
    theme_gridsontop()

This delivers:

You have to play a bit with breaks and size to colour the whole area. Probably, it is worth to calculate a model first and plot this extrapolated to the triangle corners.

Another alternative:

ggtern(df, 
             aes(INT, EXT,SA, value = MF)) +
    geom_hex_tern(
        stat = "hex_tern",
        fun = "mean",
        na.rm = TRUE,
        binwidth = .1 # depends on your data granularity  
    ) +
    scale_fill_viridis() +
    theme_rgbw() + 
    theme_gridsontop()

Resulting in:

Kind regards Markus