多组的箱线图和回归曲线

Question

我想绘制图来比较不同组树的生长情况。

library(MASS)
library(datasets)
library(ggplot2)
library(plyr)
library(grofit)

# Create groups as areas
Loblolly$Area = round(as.integer(as.character((Loblolly$Seed)))/10)
# factors for boxplot
Loblolly$fArea = factor(Loblolly$Area)
Loblolly$fAge  = factor(Loblolly$age)

# Regression curve fitting
fHeight <- nls(height ~ gompertz(age,as,x1,x2), start=list(as=60,x1=1,x2=10), 
               data = ddply(Loblolly, c("age"), summarise, height = mean(height))
)

# A separate data frame for draw the fitted curves
age <- 1:25
lHeight <- predict(fHeight, list(age=age))
dfLine <- data.frame(age, lHeight)

ggplot(data=Loblolly, aes(x=fAge, y=height, fill=fArea)) +
  geom_jitter(colour="lightgray") +
  geom_boxplot() 

我可以创建这样的箱线图：

但我想为每个 fArea 组拟合单独的拟合曲线，并将这些曲线放置在箱线图上。

当我使用“填充”选项将参数组呈现为箱线图时，我不能使用另一个 data.frame 来覆盖“geom_line”。

如何将拟合的 gompertz 函数呈现为每个组的 geom_line？

Answer 1

由于每个fArea 的age 值相同，因此每个fArea 的拟合线将与您的模型现在的状态相同。如果您希望每组有不同的拟合，则需要首先根据fArea 拟合单独的模型。有很多方法可以做到这一点，一个例子是here。这会将每个组的模型存储在列表中。

我最终制作了汇总数据集，因此它按fArea 排序，这使我更容易将fArea 的预测添加到Lob2。

# Make a summary dataset, ordered by fArea
Lob2 = ddply(Loblolly, .(fArea, age), summarize, height = mean(height))

# Function to fit the model by group
f = function(s) nls(height ~ gompertz(age,as,x1,x2), start=list(as=60,x1=1,x2=10), 
               data =  Lob2, subset = Lob2$fArea == s)

# Fit the model by group, save as a list
mods = sapply(levels(Lob2$fArea), f, simplify = FALSE)

然后我使用lapply 对列表中的每个模型进行预测，使用预测拟合中使用的数据（这是predict 中的默认值）并将这些添加到Lob2。这种方法的一个缺点（在我看来，无论如何）是我添加预测的数据集的顺序很重要，所以我必须小心。

Lob2$lHeight = unlist(lapply(mods, predict))

在 x 轴上有一个因子的图形中添加连续线有点尴尬。我发现this link 显示了如何做到这一点。但是，这种方法会使拟合曲线的平滑度不如理想曲线。也许跳过箱线图并用fArea 为点着色是一个合理的选择？

ggplot(data = Loblolly, aes(x = fAge, y = height, fill = fArea)) +
  geom_jitter(colour="lightgray") +
  geom_boxplot() +
  geom_line(data = Lob2, aes(x = as.numeric(ordered((age)), y = lHeight, color = fArea))

编辑以添加来自另一个数据集的预测

这是根据模型列表中的新数据集进行预测的一种方法。因为您想分别绘制每个fArea 模型，所以将fArea 保留在新数据集中很方便。我再次按fArea 整理新数据集。

# Predict with new data.frame (keeping in order by fArea again)
newdat = expand.grid(age = 1:25, fArea = levels(Lob2$fArea))

现在我再次使用lapply，遍历fArea 中的每个level，并使用newdat 的适当子集从每个fArea 模型中进行预测。我将预测添加到newdat 以方便绘图。数据集必须按fArea 排序，这样才能在编码时正常工作。

newdat$lHeight = unlist(lapply(levels(Lob2$fArea), function(x) {
    predict(mods[[x]], newdata = newdat[newdat$fArea == x,]) } ))

您可能会发现很难将其绘制为 x 轴顶部的连续线，x 轴是基于 6 个值的因子 - 这就是为什么我专注于仅对您的原始数据进行预测的原因。另一种方法是去掉箱线图并通过分组变量为点和线着色。

ggplot(data = Loblolly, aes(x = age, y = height, color = fArea)) +
  geom_point(position = position_jitter(width = .5)) +
  geom_line(data = newdat, aes(y = lHeight))