r - 使用 geom_smooth 进行对数插值

Question

我正在努力使用 geom_smooth 来创建几何平滑线。下面我报告代码:

library(ggplot2)

#DATAFRAME
RawData <- data.frame("Time" = c(0, 4, 8, 24, 28, 32, 0, 4, 8, 24, 28, 32), "Curing" = c(0, 28.57, 56.19, 86.67, 89.52, 91.42, 0, 85.71, 93.33, 94.28, 97.62, 98.09), "Grade" = c("Product A", "Product A", "Product A", "Product A", "Product A", "Product A", "Product B", "Product B", "Product B", "Product B", "Product B", "Product B"))
attach(RawData)

#GRAPH
Graph <- ggplot(data=RawData, aes(x=`Time`, y=`Curing`, col=Grade)) + geom_point(aes(color = Grade), shape = 1, size = 2.5) + geom_smooth(level=0.50, span = 0.9999999999) + scale_color_manual(values=c('#f92410','#644196')) + xlab("Tempo espresso in ore") + ylab("% Di reticolazione") + labs(color='') + theme(legend.justification = "top")
Graph + geom_rug(aes(color = Grade))

获取此图(对不起我的重叠文字):

我得到了一张适合红线的图表，但在蓝线上有一个 Not Acceptable 驼峰。我想要一条类似于我在淡蓝色上绘制的曲线的拟合曲线。

我的想法是制作一个具有对数函数的 geom_smooth，但我做不到，而且在 stackoverflow 中浏览我找不到解决方案。有人知道我该怎么做吗？我的意思是:

• 添加一个对数平滑函数，也许 y~ a + b*log(x) 应该可以工作；
• 使平滑线穿过数据点的任何其他方式；

Answer 1

要将数据拟合到 geom_smooth 中的特定模型，您可以使用 nls。例如，为了适应 y ~ a + b * log(x) 你可以这样做:

ggplot(data=RawData, aes(x=`Time`, y=`Curing`, col=Grade)) +
  geom_point(aes(color = Grade), shape = 1, size = 2.5) + 
  geom_smooth(method = nls, formula = y ~ a + b * log(x + 0.1),
              method.args = list(start = list(a = 1, b = 10)), se = F) + 
  scale_color_manual(values=c('#f92410','#644196')) +
  xlab("Tempo espresso in ore") + 
  ylab("% Di reticolazione") + 
  labs(color='') + 
  theme(legend.justification = "top") +
  geom_rug(aes(color = Grade))

但是，对于这些特定数据，似乎可以通过 y ~ a * atan(b * x) 获得一条漂亮的曲线。这也保证会通过点 [0, 0]，这似乎是您的模型所需要的。

ggplot(data=RawData, aes(x=`Time`, y=`Curing`, col=Grade)) +
  geom_point(aes(color = Grade), shape = 1, size = 2.5) + 
  geom_smooth(method = nls, formula = y ~ a * atan(b * x),
              method.args = list(start = list(a = 10, b = 5)), se = F) + 
  scale_color_manual(values=c('#f92410','#644196')) +
  xlab("Tempo espresso in ore") + 
  ylab("% Di reticolazione") + 
  labs(color='') + 
  theme(legend.justification = "top") +
  geom_rug(aes(color = Grade))