rplotggplot2triplot

shaded triplot in r


I could figure out triplot using package klaR. .......

   require(klaR)

triplot(label = c("1, 2 or 3", "4 or 5", "6"), 
    main = "die rolls: probabilities", pch = 17)

I want to plot shaded triplot, so that I can show where particular point falls into which class.

Are there any package (developed or underdevelopment) to do this ? Or we can tweak the available packages to achieve this ?

enter image description here

Edits: in response to the answer below:

xpoint <- matrix(c(0, 0, 10,  0, 10, 0, 10,0,0, 10,10, 0, 10,0,10, 0,0, 10, 0,10,10, 10,10,10), ncol =3, byrow= TRUE)
xp <- t(apply(xpoint,1,tern2cart))
points(xp[,1], y = xp[,2], type = "p", col = "green", pch = "*", cex = 4)
text(xp[,1]-0.01,xp[,2]-0.01)
> xpoint 


       [,1] [,2] [,3]
    [1,]    0    0   10
    [2,]    0   10    0
    [3,]   10    0    0
    [4,]   10   10    0
    [5,]   10    0   10
    [6,]    0    0   10
    [7,]    0   10   10
    [8,]   10   10   10

enter image description here


Solution

  • So (as for the answer I gave for this question), I am not able to provide you with an answer using triplot (since I don't know what referential this function is using to plot the diagram) but here is a solution from scratch:

    #First draw the empty ternary diagram:
    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,0,labels="1, 2 or 3",pos=1)
    text(1,0,labels="6",pos=1)
    text(0.5,sqrt(3)/2,labels="4 or 5",pos=3)
    
    #The following function is for transforming ternary coordinates into cartesian coordinates:
    tern2cart <- function(coord){
        coord[1]->x
        coord[2]->y
        coord[3]->z
        x+y+z->tot
        x/tot -> x
        y/tot -> y
        z/tot -> z
        (2*y + z)/(2*(x+y+z)) -> x1
        sqrt(3)*z/(2*(x+y+z)) -> y1
        return(c(x1,y1))
        }
    
    #Here are your zones:
    green.zone<-matrix(c(0,0,100,40,0,60,0,40,60,0,0,100),nrow=4,byrow=TRUE)
    blue.zone<-matrix(c(30,10,60,30,40,30,0,70,30,0,40,60,30,10,60),nrow=5,byrow=TRUE)
    purple.zone<-matrix(c(90,0,10,100,0,0,30,70,0,30,40,30,50,40,10,90,0,10),nrow=6,byrow=TRUE)
    red.zone<-matrix(c(30,40,30,30,70,0,0,100,0,0,70,30,30,40,30),nrow=5,byrow=TRUE)
    yellow.zone<-matrix(c(90,0,10,40,0,60,30,10,60,30,40,30,50,40,10,90,0,10),nrow=6,byrow=TRUE)
    
    #Then transformed into cartesian coordinates:
    t(apply(green.zone,1,tern2cart))->green
    t(apply(blue.zone,1,tern2cart))->blue
    t(apply(purple.zone,1,tern2cart))->purple
    t(apply(red.zone,1,tern2cart))->red
    t(apply(yellow.zone,1,tern2cart))->yellow
    
    #And plotted:
    polygon(green,col="green",border=NULL)
    polygon(blue,col="blue",border=NULL)
    polygon(purple,col="purple",border=NULL)
    polygon(red,col="red",border=NULL)
    polygon(yellow,col="yellow",border=NULL)
    
    #And finally the grid:
    a<-seq(0.9,0.1, by=-0.1)
    b<-rep(0,9)
    c<-seq(0.1,0.9,by=0.1)
    grid<-data.frame(x=c(a, b, c, a, c, b),y=c(b, c, a, c, b, a),z=c(c, a, b, b, a, c))
    t(apply(grid,1,tern2cart)) -> grid.tern
    cbind(grid.tern[1:27,],grid.tern[28:54,])->grid
    apply(grid,1,function(x){segments(x0=x[1],y0=x[2],x1=x[3],y1=x[4],lty=2,col="grey80")})
    

    You can obviously wrap this up into a function if you need to...

    enter image description here

    Edit: with labels

    paste(seq(10,90,by=10),"%")->lab
    text(grid.tern[9:1,],paste(lab,"\n(1, 2 or 3)"),col="grey80",cex=0.7, pos=2)
    text(grid.tern[18:10,],paste(lab,"\n(4 or 5)"),col="grey80",cex=0.7, pos=4)
    text(grid.tern[27:19,],paste(lab,"\n(6)"),col="grey80",cex=0.7, pos=1)
    

    enter image description here

    And with data plotted on the diagram

    df<-data.frame('1, 2 or 3'=c(10,33.3,50,100), '6'=c(0,33.3,50,0), '4 or 5'=c(90,33.3,0,0))
    df
      X1..2.or.3   X6 X4.or.5
    1       10.0  0.0    90.0
    2       33.3 33.3    33.3
    3       50.0 50.0     0.0
    4      100.0  0.0     0.0
    
    t(apply(df, 1, tern2cart)) -> df.tern
    points(df.tern, pch="*", cex=3)
    

    enter image description here