如何通过点值而不是R中的点密度来平滑三元图？

Question

我使用R＆＃39; ggtern包来创建一个可爱的三元图，其中显示了我使用模拟模型生成的一些数据。我在这篇文章中附上一个情节，向你展示情节的样子，但我没有足够的声誉来做到这一点。相反，我将粘贴下面的代码，可以复制我的情节的所有基本功能。作为免责声明，我对ggplot图片非常陌生，所以我确定我的代码很乱。

我的问题非常简单（我认为） - 我如何修改我的代码以平滑＆＃34; Fruit Set＆＃34; （make1df$Value），从而揭示数据的整体模式/趋势？我甚至想到一些简单的事情，即加权平均值，所有相邻点甚至可以满足要求。到目前为止，我只能弄清楚如何平滑点的密度而不是与这些点相关的值（使用stat_smooth2d()之类的函数等）。

请注意，我在下面提供的内容是假数据;＆＃34;这不是我如何生成我实际打算绘制的数据。下面使用的compositions函数位于partitions包中。

代码：

library(plyr) # for rename
library(ggtern) # for ggtern
library(partitions) # for compositions
make1 = as.matrix(compositions(50, 3, include.zero=TRUE))
make1 = t(make1)
make1df = as.data.frame(make1)
make1df = rename(make1df, c("V1"="H", "V2"="B", "V3"="S"))
seq1 = seq(from=0.24, to=0.41, length=1326)
make1df$Value = rep(0, 1326)
for (i in 1:1326) {
  make1df$Value[i] = seq1[i] + rnorm(1, 0, 0.03)
}

ggtern(make1df, aes(H, B, S)) +
  geom_point(aes(colour=make1df$Value), size=4.5) + 
  scale_colour_gradient(low = "pink", high = "darkblue") +
  theme_bw() + 
  theme(axis.tern.text=element_text(size=24), 
        axis.tern.showtitles=FALSE, 
        axis.tern.arrow.text=element_text(size=22),
        axis.tern.arrow=element_line(size=1.5, color="black"), 
        axis.tern.vshift=unit(3, "line"),
        legend.title = element_text(size=24),
        legend.text = element_text(size = 24), 
        legend.key.size = unit(3.5, "lines")) +
  labs(x = "% HONEY BEES",y = "% BUMBLE BEES", z = "% SMALL BEES", 
       colour="MEAN \nFRUIT SET")

Answer 1

我认为您必须首先在ggtern来电之外计算加权平均值。

您必须适当地计算平均值。 在这里，我只是假设（可能不正确，三元坐标让我头脑发热！）：

• (h, s, b)的邻居是(h, s +-1, b -+1)，(h +-1, s -+1, b)和(h +-1, s, b -+1)（其中+-和-+的顺序相反，所以如果它是s+1然后它必须是b-1，以便坐标全部添加到同一个常量。
• 您的make1df 仅中包含有效的三元坐标（即H+S+B对所有坐标都是常量）
• 加权平均值取自(h, s, b)加上之前定义的邻居。
• 请注意，如果您的(h, s, b)值是连续的（例如(.5, .5, 49)之类的值），则先前定义的“邻域”是(h, s, b)

让我再次提到三元坐标是我的头脑，所以你可能需要相应地调整上面的定义。

因此，首先添加一列wAvg，我们在其中查找每个坐标的邻居并计算平均值Value。 abs(H-h) <= 1等是查找(h,s,b)距离1内坐标的技巧/简写。 Value[...]抓取这些邻居的Values，mean计算平均值。 mapply只是确保我们为每一行执行此操作。我在这里使用mutate的唯一原因是为了节省大量的make1df$。

# calculate avg
make1df <- mutate(make1df, wAvg=mapply(function (h, b, s) {
  # includes (h,b,s) & its neighbours
  mean(Value[abs(H-h)<= 1 & abs(S-s) <= 1 & abs(B-b) <= 1])
}, H, B, S))

然后你做了你的情节，wAvg而不是colour而不是Value。 （注意：您可以aes(colour=wAvg)而不是aes(colour=make1df$wAvg)）：

ggtern(make1df, aes(H, B, S)) +
  geom_point(aes(colour=wAvg), size=4.5) + 
  scale_colour_gradient(low = "pink", high = "darkblue") +
  theme_bw() + 
  theme(axis.tern.text=element_text(size=24), 
        axis.tern.showtitles=FALSE, 
        axis.tern.arrow.text=element_text(size=22),
        axis.tern.arrow=element_line(size=1.5, color="black"), 
        axis.tern.vshift=unit(3, "line"),
        legend.title = element_text(size=24),
        legend.text = element_text(size = 24), 
        legend.key.size = unit(3.5, "lines")) +
  labs(x = "% HONEY BEES",y = "% BUMBLE BEES", z = "% SMALL BEES", 
       colour="MEAN \nFRUIT SET")

如果你想增加'邻域'半径，你只需将1更改为新半径。