Search code examples
rplotternaryinterpolation

Ternary plot and filled contour


Users, I'd like to have some tips for a ternaryplot ("vcd").

I have this dataframe:

a <- c(0.1, 0.5, 0.5, 0.6, 0.2, 0, 0, 0.004166667, 0.45) 
b <- c(0.75,0.5,0,0.1,0.2,0.951612903,0.918103448,0.7875,0.45)
c <- c(0.15,0,0.5,0.3,0.6,0.048387097,0.081896552,0.208333333,0.1) 
d <- c(500,2324.90,2551.44,1244.50, 551.22,-644.20,-377.17,-100, 2493.04) 
df <- data.frame(a, b, c, d)

and I'm building a ternary plot:

ternaryplot(df[,1:3], df$d)

How can I map the continuous variable d, obtaining a result similar to this one?

enter image description here


Solution

  • This is probably not the most elegant way to do this but it works (from scratch and without using ternaryplot though: I couldn't figure out how to do it).

    a<- c (0.1, 0.5, 0.5, 0.6, 0.2, 0, 0, 0.004166667, 0.45) 
    b<- c (0.75,0.5,0,0.1,0.2,0.951612903,0.918103448,0.7875,0.45)
    c<- c (0.15,0,0.5,0.3,0.6,0.048387097,0.081896552,0.208333333,0.1) 
    d<- c (500,2324.90,2551.44,1244.50, 551.22,-644.20,-377.17,-100, 2493.04) 
    df<- data.frame (a, b, c)
    
    
    # First create the limit of the ternary plot:
    plot(NA,NA,xlim=c(0,1),ylim=c(0,sqrt(3)/2),asp=1,bty="n",axes=F,xlab="",ylab="")
    segments(0,0,0.5,sqrt(3)/2)
    segments(0.5,sqrt(3)/2,1,0)
    segments(1,0,0,0)
    text(0.5,(sqrt(3)/2),"c", pos=3)
    text(0,0,"a", pos=1)
    text(1,0,"b", pos=1)
    
    # The biggest difficulty in the making of a ternary plot is to transform triangular coordinates into cartesian coordinates, here is a small function to do so:
    tern2cart <- function(coord){
        coord[1]->x
        coord[2]->y
        coord[3]->z
        x+y+z -> tot
        x/tot -> x  # First normalize the values of x, y and z
        y/tot -> y
        z/tot -> z
        (2*y + z)/(2*(x+y+z)) -> x1 # Then transform into cartesian coordinates
        sqrt(3)*z/(2*(x+y+z)) -> y1
        return(c(x1,y1))
        }
    
    # Apply this equation to each set of coordinates
    t(apply(df,1,tern2cart)) -> tern
    
    # Intrapolate the value to create the contour plot
    resolution <- 0.001
    require(akima)
    interp(tern[,1],tern[,2],z=d, xo=seq(0,1,by=resolution), yo=seq(0,1,by=resolution)) -> tern.grid
    
    # And then plot:
    image(tern.grid,breaks=c(-1000,0,500,1000,1500,2000,3000),col=rev(heat.colors(6)),add=T)
    contour(tern.grid,levels=c(-1000,0,500,1000,1500,2000,3000),add=T)
    points(tern,pch=19)
    

    enter image description here