繁体   English   中英

拟合游戏的一阶导数和置信区间

[英]First derivative and confidence intervals from fitted gam

我创建了可在此处获得的模拟数据

我的数据与动物随时间的生长有关,并具有以下变量:

read.csv(test.csv, header = T)
test$sex_t0 <- factor(test$sex_t0)
test$tagged <- factor(test$tagged)
test$scale_id <- factor(test$scale_id)

colnames(test)
[1] "weight_t" "age.x"    "sex_t0"   "tagged"   "scale_id"

test$scale_id是唯一标识符

test$tagged表示动物是否有耳标 (1) 或没有 (0)

test$sex_t0表示动物是雄性 (m) 还是雌性 (f)

test$age.x是动物的年龄

test$weight_t代表每只动物在六个不同时间点的体重测量值,NA 显示动物已从研究中移除

使用这些数据,我在mgcv拟合了以下 gam

gam1 <- gam(weight_t ~ 
+                tagged + 
+                sex_t0 +
+                s(age.x, by = sex_t0, k = 5) + 
+                s(scale_id, bs = "re") + 
+                s(age.x, scale_id, bs = "re"), 
+            data = test, 
+            method = "REML")

这个 gam 包括对taggedsex_t0离散固定效应,通过时间s(age.x, by = sex_t0, k = 5)对性别进行单独的平滑函数,对个体s(scale_id, bs = "re")的随机截距和一个个人通过时间s(age.x, scale_id, bs = "re")随机斜率。

我现在想计算并绘制标记和未标记动物以及雄性和雌性动物随时间/年龄变化的生长变化率。 这将显示动物在某些年龄是否生长得更快。 为此,我们可以从拟合的 gam 中计算样条函数的一阶导数。 Gavin Simpson 在这里这里有两篇很棒的博客文章。 还有一个从一个非常简单的装GAM计算一阶导数的一个例子在这里 但是,我很难遵循这些示例,并且似乎无法找到一个示例,其中有人从更复杂的游戏中计算出一阶导数,该游戏还包括随机效应 - 非常感谢任何帮助

编辑:我设法从他的 GitHub 页面这里加载了 Gavin Simpson derivSimulCI()函数,它“为加性模型中样条项的一阶导数生成后验模拟”。 但是,这给了我一个尚未解决的错误。

library(devtools)
tmpf <- tempfile()
download.file("https://gist.githubusercontent.com/gavinsimpson/ca18c9c789ef5237dbc6/raw/295fc5cf7366c831ab166efaee42093a80622fa8/derivSimulCI.R",
              tmpf, method = "auto")
source(tmpf)

fd <- derivSimulCI(gam1, samples = 10000)
Error in Summary.factor(c(2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L,  : 
  ‘min’ not meaningful for factors 

traceback()给出以下

7.
stop(gettextf("%s not meaningful for factors", sQuote(.Generic))) 
6.
Summary.factor(structure(c(2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L,  ... at C:\Users\taggarp\AppData\Local\Temp\Rtmp0u2MEM\file8b14519e163a#8
5.
seq(min(x), max(x) - (2 * eps), length = n) at C:\Users\taggarp\AppData\Local\Temp\Rtmp0u2MEM\file8b14519e163a#8
4.
FUN(X[[i]], ...) 
3.
lapply(X = X, FUN = FUN, ...) 
2.
sapply(model.frame(mod)[, m.terms, drop = FALSE], function(x) seq(min(x), 
    max(x) - (2 * eps), length = n)) at C:\Users\taggarp\AppData\Local\Temp\Rtmp0u2MEM\file8b14519e163a#8
1.
derivSimulCI(wt9, samples = 10000) 

我设法使用 gratia 包找到了答案......

library(gratia)

# Calculate and plot growth rate for male and female pythons across ages
# Extract first derivatives for smooths of age.x by sex_t0
fd <- fderiv(gam1, newdata = pred.dat,  term = "age.x")

# Calculate 95% confidence intervals for deriviatives
ci <- confint(fd, type = "confidence")

# Attach deriviatives and confidence intervals to pred.dat for plotting
fd.plot1 <- cbind(pred.dat, ci)

ggplot(fd.plot1, aes(x = age.x, y = est, colour = sex_t0, fill = sex_t0)) + 
  geom_line(size = 1.2) + 
  geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.2, colour = NA) + 
  scale_colour_manual(labels = c("Female", "Male"), values = c("#F8766D", "#00BFC4")) +
  scale_fill_manual(labels = c("Female", "Male"), values = c("#F8766D", "#00BFC4")) +
  theme_classic() + 
  theme(axis.title.x = element_text(face = "bold", size = 14), 
        axis.title.y = element_text(face = "bold", size = 14), 
        axis.text.x = element_text(size = 12), 
        axis.text.y = element_text(size = 12),
        legend.text = element_text(size = 12), legend.title = element_blank()) + 
  xlab("Age (days since hatch)") + 
  ylab("Growth rate (g/day)")

在此处输入图片说明

我认为不可能为标记和未标记的动物产生类似的数字,因为在gam1没有这样的平滑

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM