使用R中的Weibull链接函数对数据建模

Question

我正在尝试模拟一些遵循S形曲线关系的数据。在我的工作领域（心理物理学）中，Weibull函数通常用于模拟这种关系，而不是概率。

我正在尝试使用R创建一个模型，并且正在努力学习语法。我知道我需要使用vglm()包中的VGAM函数，但我无法得到合理的模型。这是我的数据：

# Data frame example data
dframe1 <- structure(list(independent_variable = c(0.3, 0.24, 0.23, 0.16, 
0.14, 0.05, 0.01, -0.1, -0.2), dependent_variable = c(1, 1, 
1, 0.95, 0.93, 0.65, 0.55, 0.5, 0.5)), .Names = c("independent_variable", 
"dependent_variable"), class = "data.frame", row.names = c(NA, 
-9L))

以下是dframe1中的数据图：

library(ggplot2)

# Plot my original data
ggplot(dframe1, aes(independent_variable, dependent_variable)) + geom_point()

这应该能够通过Weibull函数建模，因为数据符合S形曲线关系。以下是我对数据进行建模并生成代表性图表的尝试：

library(VGAM)

# Generate model
my_model <- vglm(formula = dependent_variable ~ independent_variable, family = weibull, data = dframe1)

# Create a new dataframe based on the model, so that it can be plotted
model_dframe <- data.frame(dframe1$independent_variable, fitted(my_model))

# Plot my model fitted data
ggplot(model_dframe, aes(dframe1.independent_variable, fitted.my_model.)) + geom_point()

如您所见，这根本不代表我的原始数据。我要么错误地生成我的模型，要么我错误地生成了我的模型图。我做错了什么？

注意：我已编辑此问题以使其更易理解;以前我一直在使用错误的函数（weibreg()）。因此，下面的一些评论可能没有意义。 .....

Answer 1

这是我的解决方案，bbmle。

数据：

dframe1 <- structure(list(independent_variable = c(0.3, 0.24, 0.23, 0.16, 
0.14, 0.05, 0.01, -0.1, -0.2), dependent_variable = c(1, 1, 
1, 0.95, 0.93, 0.65, 0.55, 0.5, 0.5)), .Names = c("independent_variable", 
"dependent_variable"), class = "data.frame", row.names = c(NA, 
-9L))

根据定义构造一个从0.5到1.0的累积Weibull：

wfun <- function(x,shape,scale) {
    (1+pweibull(x,shape,scale))/2.0
}

dframe2 <- transform(dframe1,y=round(40*dependent_variable),x=independent_variable)

使用二项式变化拟合Weibull（对数标度相关参数）：

library(bbmle)
m1 <- mle2(y~dbinom(prob=wfun(exp(a+b*x),shape=exp(logshape),scale=1),size=40),
     data=dframe2,start=list(a=0,b=0,logshape=0))

生成预测：

pframe <- data.frame(x=seq(-0.2,0.3,length=101))
pframe$y <- predict(m1,pframe)

png("wplot.png")
with(dframe2,plot(y/40~x))
with(pframe,lines(y/40~x,col=2))
dev.off()

Answer 2

您也可以使用drc-package（剂量 - 反应建模）。

对于这种模型我实际上是一个菜鸟，但是它会以某种方式帮助它......

这里我安装了一个四参数Weibull，具有渐近线的固定参数（否则上面的渐近线会稍微大一些，不知道这对你来说是不是一个问题）。由于收敛问题，我还必须变换自变量（+0.2），使其>> = 0。

require(drc)
# four-parameter Weibull with fixed parameters for the asymptote, added +0.2 to IV to overcome convergence problems
mod <- drm(dependent_variable ~ I(independent_variable+0.2), 
           data = dframe1, 
           fct = W1.4(fixed = c(NA, 0.5, 1, NA)))

# predicts
df2 <- data.frame(pred = predict(mod, newdata = data.frame(idenpendent_variable = seq(0, 0.5, length.out=100))), 
                  x = seq(0, 0.5, length.out=100))

ggplot() + 
  geom_point(data = dframe1, aes(x = independent_variable + 0.2, y = dependent_variable)) +
  geom_line(data = df2, aes(x = x, y = pred))

但我同意Ben Bolker认为其他型号可能更适合。

我只知道这些来自生态毒理学的模型（剂量反应模型，其中一个人对浓度感兴趣，我们有50％的死亡率[= EC50]）。

<强>更新 一个四参数对数逻辑模型也很合适（较小的AIC和RSE然后是weibull）： 我再次在这里修改了渐近线参数并转换了IV。

# four-parameter log-logistic with fixed parameters for the asymptote, added +0.2 to IV to overcome convergence problems
mod1 <- drm(dependent_variable ~ I(independent_variable+0.2), 
           data = dframe1, 
           fct = LL2.4(fixed=c(NA, 0.5, 1, NA)))
summary(mod1)

# predicts
df2 <- data.frame(pred = predict(mod1, newdata = data.frame(idenpendent_variable = seq(0, 0.5, length.out=100))), 
                  x = seq(0, 0.5, length.out=100))

ggplot() + 
  geom_point(data = dframe1, aes(x = independent_variable + 0.2, y = dependent_variable)) +
  geom_line(data = df2, aes(x = x, y = pred))

Answer 3

好的，我刚刚遇到这几个月，但你也可以使用 来自psyphy包的mafc.cloglog链接和glm。如果是x 跟随cloglog然后log（x）将遵循weibull心理测量功能。 与上述回应一样的问题是 您需要比例正确的试验次数。 我只是将它设置为100所以它将给出整数次试验 但你应该修复这个以对应你的数字 实际使用过。这是执行此操作的代码。

dframe1 <- structure(list(independent_variable = c(0.3, 0.24, 0.23, 0.16, 
0.14, 0.05, 0.01, -0.1, -0.2), dependent_variable = c(1, 1, 
1, 0.95, 0.93, 0.65, 0.55, 0.5, 0.5)), .Names = c("independent_variable", 
"dependent_variable"), class = "data.frame", row.names = c(NA, 
-9L))

library(psyphy)

plot(dependent_variable ~ independent_variable, dframe1)
fit <- glm(dependent_variable ~ exp(independent_variable), 
    binomial(mafc.cloglog(2)), 
    data = dframe1, 
    weights = rep(100, nrow(dframe1)))  # assuming 100 observations per point
xx <- seq(-0.2, 0.3, len = 100)
pred <- predict(fit, newdata = data.frame(independent_variable = xx), type = "response")
lines(xx, pred)