ggtern等高線プロットin R

Question

私はこれを持っています。これは三面図にヒートマップをプロットするのに十分なデータポイントを持っています。ここで

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を使って2番目の数字のようなものを得るにはどうすればいいですか？

編集1：ファイル名の入力ミスがあります。ファイル名を修正しました。 データファイルに含まれるデータポイントが多すぎるため、ここに直接貼り付けることはできません。

第2図は、サードパーティのMatlabパッケージternplotによって作成されたものです。私は最初の図のヒートマップではなく、別々の線を持つ3値の等高線図が必要です。具体的には、等高線のリストをW12=0.05,0.1,0.15,...のように指定したいと思います。私はgeom_density_ternとgeom_interpolate_ternで何時間も遊んでいますが、私が望むものを手に入れる方法はまだありません。

MATLABコードは：

X,Y,1-X-Yは、プロット上の座標 data格納値とベクトルが輪郭の値を指定する指定

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

。

Answer 1

WDG、私はちょうどCRANに提出された、優れたハンドリングのために、モデリングのこのタイプをggternするためにいくつかの小さな変更を加えているので、次の日やそこらで利用可能であるべきです。その間に、私のBitBucketアカウントからソースからダウンロードすることができます：https://bitbucket.org/nicholasehamilton/ggtern

とにかく、ggternバージョン2.1.2で動作するソースがあります。

私は一方が補間ジオメトリがされたかの代表的な観察することができる（軽度のアルファ値を有する）の下の点が含まれている：

：

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

これは次の出力を生成します。

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

プロットだけprettyingを必要とします。どのデータ領域がプロットするのが最適かはわかりません。