Ternary cốt truyện và điền đường viền

Question

Người dùng, tôi muốn có một số lời khuyên cho một ternaryplot ("vcd").

Tôi có dataframe này:

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) 

và tôi đang xây dựng một cốt truyện ternary:

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

Làm thế nào tôi có thể lập bản đồ các biến liên tục d, lấy một kết quả tương tự như thế này?

Answer 1

Đây có lẽ không phải là cách thanh lịch nhất để làm điều này nhưng nó hoạt động (từ đầu và không sử dụng ternaryplot mặc dù: Tôi không thể tìm ra cách để làm điều đó).

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) 

Answer 2

Rất cám ơn gợi ý của bạn, đây là kết quả cuối cùng của tôi:

#Rename header 
names(SI) [6] <- "WATER%" 
names(SI) [7] <- "VEGETATION%" 
names(SI) [8] <- "SOIL%" 

#pdf(file="prova_ternary12.pdf", width = 5, height =5) 
##++++++++++++++++++++++++++++++ 
install.packages("colourschemes", repos="http://R-Forge.R-project.org") 
library(colourschemes) 
rs = rampInterpolate (limits =c(-0.8 , 0.8), 
         ramp = c("red4", "red", "orangered", "orange", "darkgoldenrod1", "white", 
           "cyan2", "blue", "darkblue", "blueviolet", "purple3")) 
rs(-0.8) 
rs(-0.6000) 
rs(-0.4) 
rs(-0.2) 
rs(0) 
rs(0.2) 
rs(0.4) 
rs(0.6000) 
rs(0.8000) 



#++++++++++++++++++++++++++++++ 

#TERNARYPLOT (vcd) 
library(vcd) 
png(file="ternary.png", width=800, height=800) 
ternaryplot(
    SI[,6:8], 
    bg = "lightgray", 
    grid_color = "black", 
    labels_color = "black", 
    dimnames_position = c("corner"), 
    #dimnames = 10, 
    newpage = T, 
    #dimnames_color = "green", 
    border = "black", 
    pop=T, 
    #SI$MEAN_b2b6.tm, 
    col=rs(SI$MEAN_b2b6.TM_V2), 
    #col = ifelse(SI$MEAN_b1b6.tm > 0, "blue", "#cd000020"), 
    pch=13, cex=.4, prop_size = F, 
    labels = c("outside"), 
    #size=SI$MEAN_b1b6.tm, 
    main="b4b6 -TM data-") 

Answer 3

tôi cần thiết để giải quyết một vấn đề tương tự, đó là một phần các chất xúc tác cho viết một gói như là một phần mở rộng cho ggplot2, cho các sơ đồ ternary. Gói này có sẵn trên CRAN.

đầu ra cho vấn đề này:

Mã để xây dựng các Trên

#Orignal Data as per Question 
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.10) 
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) 

#For labelling each point. 
df$id <- 1:nrow(df) 

#Build Plot 
ggtern(data=df,aes(x=c,y=a,z=b),aes(x,y,z)) + 
    stat_density2d(geom="polygon", 
       n=400, 
       aes(fill=..level.., 
       weight=d, 
       alpha=abs(..level..)), 
       binwidth=100) + 
    geom_density2d(aes(weight=d,color=..level..), 
       n=400, 
       binwidth=100) + 
    geom_point(aes(fill=d),color="black",size=5,shape=21) + 
    geom_text(aes(label=id),size=3) + 
    scale_fill_gradient(low="yellow",high="red") + 
    scale_color_gradient(low="yellow",high="red") + 
    theme_tern_rgbw() + 
    theme(legend.justification=c(0,1), legend.position=c(0,1)) + 
    guides(fill = guide_colorbar(order=1), 
     alpha= guide_legend(order=2), 
     color="none") + 
    labs( title= "Ternary Plot and Filled Contour", 
     fill = "Value, V",alpha="|V - 0|") 

#Save Plot 
ggsave("TernFilled.png") 

Answer 4

câu trả lời trước của tôi sử dụng ước tính mật độ. Đây là một sử dụng hồi quy tuyến tính.

df <- data.frame(a, b, c, d) 
ggtern(df,aes(a,c,b)) + 
    geom_interpolate_tern(aes(value=d,fill=..level..), 
         binwidth=500, 
         colour="white") + 
    geom_point(aes(fill=d),color="black",shape=21,size=3) + 
    scale_fill_gradient(low="yellow",high="red") + 
    theme(legend.position=c(0,1),legend.justification=c(0,1)) + 
    labs(fill="Value, d")