使用R中的ggtern制作轮廓图

Question

我有一个数据文件data file，其中包含足够的数据点，可以在三角图中绘制“热力图”（实际上不是真正的热力图，只是具有足够数据点的散点图）。

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")

以下是我得到的内容：

我想使用ggtern得到如下所示的图形：

我的问题是：我该如何使用ggtern得到类似第二个图形的东西？

编辑1：文件名中有错别字，非常抱歉。我已经更正了文件名。数据文件包含太多数据点，无法直接在此处粘贴。

第二个图形是由第三方Matlab软件包ternplot生成的。我想要一个具有离散线条而不是热力图的三元等高线图。更具体地说，我想指定一系列等高线，例如W12=0.05,0.1,0.15,...。我已经尝试了geom_density_tern和geom_interpolate_tern几个小时，但仍然不知道如何得到我想要的结果。

Matlab代码如下：

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

其中X，Y，1-X-Y指定了图表上的坐标，data存储数值，向量指定等高线的值。

- wdg

---

@Hack-R，我在最新的编辑中回应了你的前两条评论。 - wdg

好的，非常感谢。对于这个问题不用担心，但是为了以后的参考，请理解我们并不希望您直接粘贴数据，而是要求提供数据的 dput 格式，如果太长可以提供数据在 GitHub 或 PasteBin 上的链接，或者更好的方法是使用内置于您的软件包中的示例数据或数据集（data()）。 - Hack-R

@Hack-R，我仔细阅读了那篇文章。那不是我想要的。我也浏览了ggtern.com网站。我找不到与我的情况相关的示例。在我的情况下，整个空间中每个点都有一个确切的值。 - wdg

好的，tline、lline和rline怎么样？不行吗？如果你已经浏览了网站和文档，但没有找到任何信息，那么可能无法使用这个软件包完成。虽然在我看来，您可以根据W12的值在数据中创建新的二进制变量，并将其绘制为线条。例如，我刚刚使用了0.15的阈值。提供您的MATLAB代码也可能很有用。 - Hack-R

回滚的原因是，人们开始回答后，SO政策是冻结问题，以防止潜在的无效更改（即有些人为您免费工作了很长时间，因此您不希望通过稍后对问题进行更改来使该工作失效）。我添加了MATLAB代码，并随意添加其他类似的内容，但请不要更改有关您正在尝试创建的部分。我们不知道可能有多少人已经花了几个小时在这上面工作。 - Hack-R

我投票将此问题标记为离题，因为文件链接已失效，而且问题现在不包含 [mcve]。 - Bhargav Rao

Answer 1

WDG，我对ggtern进行了一些小改动，以更好地处理这种建模类型。已经提交到CRAN，并且应该在接下来的一天左右可用。在此期间，您可以从我的BitBucket帐户下载源代码： https://bitbucket.org/nicholasehamilton/ggtern 无论如何，以下是源代码，它将在ggtern版本2.1.2中起作用。

我还加入了点（使用轻微的alpha值），以便可以观察插值几何形状的代表性。

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()

这将产生以下输出：

为了获得更接近样本matlab等高线图的颜色和方向的图表，请尝试以下操作：

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()

这将产生以下输出：

- Nicholas Hamilton

Answer 2

这可能比您的示例看起来不太美观，但希望它可以使您更接近您想要的目标：

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()

图形只需要美化一下。我无法确定哪些数据区域最适合绘制。

- Hack-R