R中的ggtern等高线图[关闭]答案

【问题标题】：ggtern contour plot in R [closed]R中的ggtern等高线图[关闭]
【发布时间】：2016-07-02 12:23:11
【问题描述】：

我有这个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：抱歉文件名中的拼写错误。我修复了文件名。数据文件包含的数据点太多，我无法直接将它们粘贴到此处。

第二个图是由第 3 方 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 存储值，向量指定等高线的值。

【问题讨论】：

@Hack-R，我在最近的编辑中提到了你的前两个 cmets。
好的，非常感谢。不要担心这个问题，但只是为了让您理解以供将来参考，我们并不完全希望您粘贴数据本身，而是数据的dput 或者如果太长那么链接到 GitHub 或 PasteBin (etc) 上数据的dput或更好的是，只需编写新的示例数据或使用包中内置的数据集 (data())。跨度>
@Hack-R，我彻底阅读了那篇文章。那不是我想要的。我也浏览了 ggtern.com 网站。我找不到与我的案例相关的示例。就我而言，我对整个空间中的每个点都只有一个值。
好的，tline、lline 和 rline 怎么样？不好？如果您浏览了网站和文档但没有找到任何东西，那么这个包可能无法使用。尽管在我看来，您可以根据 W12 的值在数据中创建新的二进制变量并将其绘制为线条。例如，我只是用 0.15 的阈值做到了这一点。提供您的 MATLAB 代码也可能很有用。
回滚的原因是，在人们开始回答 SO 政策后，将冻结问题以防止可能导致无效的更改（即，有些人花了很多时间免费为您工作，所以您不想要通过以后对问题的更改使该工作无效）。我添加了 MATLAB 代码并随意添加其他类似的内容，但请不要更改有关您要创建的内容的部分。我们不知道有多少人为此工作了几个小时。

标签： r plot ggplot2 ggtern

【解决方案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()

这会产生以下输出：

【讨论】：

【解决方案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()

情节只需要美化一下。我不能说哪些数据区域最适合绘图。

【讨论】：