ggtern contour plot in R

Question

I have this data file that has enough data points for me to plot a "heatmap" in ternary plot. (It is not really heat map, just a scatter plot with enough data points)

library(ggtern)
library(reshape2)

N=90
trans.prob = as.matrix(read.table("./N90_p_0.350_eta_90_W12.dat",fill=TRUE))
colnames(trans.prob) = NULL

# flatten trans.prob for ternary plot
flattened.tb = melt(trans.prob,varnames = c("x","y"),value.name = "W12")
# delete rows with NA
flattened.tb = flattened.tb[complete.cases(flattened.tb),]
flattened.tb$x = (flattened.tb$x-1)/N
flattened.tb$y = (flattened.tb$y-1)/N
flattened.tb$z = 1 - flattened.tb$x - flattened.tb$y

ggtern(data = flattened.tb, aes(x=x,y=y,z=z)) +
  geom_point(size=1, aes(color=W12)) +
  theme_bw() +
  scale_color_gradient2(low = "green", mid = "yellow", high = "red")

Here is what I got:

I want to get something like the following using ggtern:

My question is: How can I get something like the second figure using ggtern?

Edit 1: Sorry for the typo in the file name. I fixed the filename. The data file contains too much data points for me to directly paste them here.

The 2nd figure was produced by a 3rd-party Matlab package ternplot. I want a ternary contour plot that has discrete lines rather than the heatmap in my first figure. To be more specific, I want to specify a list of contour lines such as W12=0.05,0.1,0.15,.... I have played with geom_density_tern and geom_interpolate_tern for hours but still have no clue how to get what I want.

The MATLAB code is:

[HCl, Hha, cax] = terncontour(X,Y,1-X-Y,data,[0.01,0.1,0.2,0.3,0.4,0.5]);

where X,Y,1-X-Y specify the coordinate on the plot, data stores the values and the vector specifies the values of the contours.

@Hack-R, I addressed your first two comments in my latest edit. — wdg, Jul 02 '16 at 13:29
OK great thanks. Don't worry about it for this question, but just so that you understand for future reference, we don't exactly want you to paste the data per se, but either the `dput` of the data or if that's too long then a link to the `dput` of the data on GitHub or PasteBin (etc) **or** even better just make up new example data or use a dataset that's built in to your package (`data()`). — Hack-R, Jul 02 '16 at 13:36
@Hack-R, I read that article thoroughly. That's not what I want. I went through the website ggtern.com as well. I couldn't find an example that is related to my case. In my case, I have exactly one value for every point in the whole space. — wdg, Jul 02 '16 at 13:45
OK, how about tline, lline, and rline? No good? If you went through the website and documentation and didn't find anything, then it might not be do-able with this package. Though it seems to me like you could create new binary variables in your data based on the values of W12 and plot those as lines. I just did that with the .15 threshold for instance. It may also be useful to provide your MATLAB code. — Hack-R, Jul 02 '16 at 13:52
The reason for the rollback is that after people start answering SO policy is to freeze the question from potentially invalidating changes (i.e. some people spent a lot of time working for you for free, so you don't want to invalidate that work with later changes to the question). I added back the MATLAB code and feel free to add other stuff like that, but please don't change the part regarding what you're trying to create. We don't know how many people may have been working on this for a couple of hours. — Hack-R, Jul 02 '16 at 14:26
I'm voting to close this question as off-topic because the file link is dead, and the problem now doesn't contain a [mcve] — Bhargav Rao, Feb 16 '18 at 04:40

Hack-R · Answer 1 · 2016-07-02T14:19:31.550

This doesn't look as beautiful as your example, but hopefully it gets you significantly closer to where you want to be:

flattened.tb$a <- 0
flattened.tb$a[flattened.tb$W12 > 0.04 & flattened.tb$W12 < .05] <- 1

flattened.tb$b <- 0
flattened.tb$b[flattened.tb$W12 > 0.05 & flattened.tb$W12 < .06] <- 1

flattened.tb$c <- 0
flattened.tb$c[flattened.tb$W12 > 0.07 & flattened.tb$W12 < .08] <- 1

flattened.tb$d <- 0
flattened.tb$d[flattened.tb$W12 > 0.09 & flattened.tb$W12 < .1] <- 1


options("tern.discard.external" = F)   
ggtern(data = flattened.tb, aes(x, y, z)) +
  geom_line(aes(a),color="red",linetype=1) + 
  geom_line(aes(b),color="blue",linetype=1) +
  geom_line(aes(c),color="yellow",linetype=1) +
  geom_line(aes(d),color="green",linetype=1) +
  theme_bw()

Plot just needs a prettying up. I can't say which data regions will look best for plotting.

Nicholas Hamilton · Accepted Answer · 2016-07-05T02:12:16.507

WDG, I have made a few small changes to ggtern, for better handling this type of modelling, which has just been submitted to CRAN, so should be available over the next day or so. In the interim, you can download from source from my BitBucket account: https://bitbucket.org/nicholasehamilton/ggtern

Anyway, here is the source, which will work from ggtern version 2.1.2.

I have included the points underneath (with a mild alpha value) so one can observe how representative the interpolation geometry has been:

library(ggtern)
library(reshape2)

N=90
trans.prob = as.matrix(read.table("~/Downloads/N90_p_0.350_eta_90_W12.dat",fill=TRUE))
colnames(trans.prob) = NULL

# flatten trans.prob for ternary plot
flattened.tb = melt(trans.prob,varnames = c("x","y"),value.name = "W12")
# delete rows with NA
flattened.tb   = flattened.tb[complete.cases(flattened.tb),]
flattened.tb$x = (flattened.tb$x-1)/N
flattened.tb$y = (flattened.tb$y-1)/N
flattened.tb$z = 1 - flattened.tb$x - flattened.tb$y

############### MODIFIED CODE BELOW ###############

#Remove the (trivially) Negative Concentrations
flattened.tb = subset(flattened.tb,z >= 0)

#Plot a series of plots in increasing polynomial degree
plots = lapply(seq(3,18,by=3),function(x){
  degree = x
  breaks = seq(0.025,0.575,length.out = 10)
  base   = ggtern(data = flattened.tb, aes(x=x,y=y,z=z)) +
    geom_point(size=1, aes(color=W12),alpha=0.05) +
    geom_interpolate_tern(aes(value=W12,color=..level..),
                          base = 'identity',method = glm,
                          formula = value ~ polym(x,y,degree = degree,raw=T),
                          n = 150, breaks = breaks) + 
    theme_bw() +
    theme_legend_position('topleft') + 
    scale_color_gradient2(low = "green", mid = "yellow", high = "red",
                          midpoint = mean(range(flattened.tb$W12)))+
    labs(title=sprintf("Polynomial Degree %s",degree))
  base
})

#Arrange the plots using grid.arrange
png("~/Desktop/output.png",width=700,height=900)
  grid.arrange(grobs = plots,ncol=2)
garbage <- dev.off()

This produces the following output:

For the sake of producing a diagram closer to the colours and orientation as the sample matlab contour plot, try the following:

plots = lapply(seq(3,18,by=3),function(x){
  degree = x
  breaks = seq(0.025,0.575,length.out = 10)
  base   = ggtern(data = flattened.tb, aes(x=z,y=y,z=x)) +
    geom_point(size=1, aes(color=W12),alpha=0.05) +
    geom_interpolate_tern(aes(value=W12,color=..level..),
                          base = 'identity',method = glm,
                          formula = value ~ polym(x,y,degree = degree,raw=T),
                          n = 150, breaks = breaks) + 
    theme_bw() +
    theme_legend_position('topleft') + 
    scale_color_gradient2(low = "darkblue", mid = "green", high = "darkred",
                          midpoint = mean(range(flattened.tb$W12)))+
    labs(title=sprintf("Polynomial Degree %s",degree))
  base
})
png("~/Desktop/output2.png",width=700,height=900)
  grid.arrange(grobs = plots,ncol=2)
garbage <- dev.off()

This produces the following output:

ggtern contour plot in R

2 Answers2

Linked