非線形モデルでのグループ化変数の使用に関して質問があります。nls()関数は因子変数を許可しないため、モデルの適合に対する因子の効果をテストできるかどうかを判断するのに苦労していました。「季節化されたvon Bertalanffy」成長モデルをさまざまな成長処理(魚の成長に最も一般的に適用)に適合させたい例を以下に示します。魚が育った湖と与えられた食物の効果をテストしたい(ちょうど人工的な例)。私はこの問題の回避策に精通しています-陳らによって概説されているように、プールされたデータにフィットするモデルと個別のフィットを比較するF検定を適用します。(1992)(ARSS-「残差平方和の分析」)。つまり、以下の例では、
Rでnlme()を使用してこれを行う簡単な方法があると思いますが、私は問題に直面しています。まず、グループ化変数を使用することにより、自由度は個別のモデルのフィッティングで得られるよりも高くなります。第二に、グループ化変数をネストできません。問題がどこにあるのかわかりません。nlmeまたは他の方法を使用したヘルプは大歓迎です。以下は私の人工的な例のコードです:
###seasonalized von Bertalanffy growth model
soVBGF <- function(S.inf, k, age, age.0, age.s, c){
S.inf * (1-exp(-k*((age-age.0)+(c*sin(2*pi*(age-age.s))/2*pi)-(c*sin(2*pi*(age.0-age.s))/2*pi))))
}
###Make artificial data
food <- c("corn", "corn", "wheat", "wheat")
lake <- c("king", "queen", "king", "queen")
#cornking, cornqueen, wheatking, wheatqueen
S.inf <- c(140, 140, 130, 130)
k <- c(0.5, 0.6, 0.8, 0.9)
age.0 <- c(-0.1, -0.05, -0.12, -0.052)
age.s <- c(0.5, 0.5, 0.5, 0.5)
cs <- c(0.05, 0.1, 0.05, 0.1)
PARS <- data.frame(food=food, lake=lake, S.inf=S.inf, k=k, age.0=age.0, age.s=age.s, c=cs)
#make data
set.seed(3)
db <- c()
PCH <- NaN*seq(4)
COL <- NaN*seq(4)
for(i in seq(4)){
age <- runif(min=0.2, max=5, 100)
age <- age[order(age)]
size <- soVBGF(PARS$S.inf[i], PARS$k[i], age, PARS$age.0[i], PARS$age.s[i], PARS$c[i]) + rnorm(length(age), sd=3)
PCH[i] <- c(1,2)[which(levels(PARS$food) == PARS$food[i])]
COL[i] <- c(2,3)[which(levels(PARS$lake) == PARS$lake[i])]
db <- rbind(db, data.frame(age=age, size=size, food=PARS$food[i], lake=PARS$lake[i], pch=PCH[i], col=COL[i]))
}
#visualize data
plot(db$size ~ db$age, col=db$col, pch=db$pch)
legend("bottomright", legend=paste(PARS$food, PARS$lake), col=COL, pch=PCH)
###fit growth model
library(nlme)
starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)
#fit to pooled data ("small model")
fit0 <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c),
data=db,
start=starting.values
)
summary(fit0)
#fit to each lake separatly ("large model")
fit.king <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c),
data=db,
start=starting.values,
subset=db$lake=="king"
)
summary(fit.king)
fit.queen <- nls(size ~ soVBGF(S.inf, k, age, age.0, age.s, c),
data=db,
start=starting.values,
subset=db$lake=="queen"
)
summary(fit.queen)
#analysis of residual sum of squares (F-test)
resid.small <- resid(fit0)
resid.big <- c(resid(fit.king),resid(fit.queen))
df.small <- summary(fit0)$df
df.big <- summary(fit.king)$df+summary(fit.queen)$df
F.value <- ((sum(resid.small^2)-sum(resid.big^2))/(df.big[1]-df.small[1])) / (sum(resid.big^2)/(df.big[2]))
P.value <- pf(F.value , (df.big[1]-df.small[1]), df.big[2], lower.tail = FALSE)
F.value; P.value
###plot models
plot(db$size ~ db$age, col=db$col, pch=db$pch)
legend("bottomright", legend=paste(PARS$food, PARS$lake), col=COL, pch=PCH)
legend("topleft", legend=c("soVGBF pooled", "soVGBF king", "soVGBF queen"), col=c(1,2,3), lwd=2)
#plot "small" model (pooled data)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100))
pred <- predict(fit0, tmp)
lines(tmp$age, pred, col=1, lwd=2)
#plot "large" model (seperate fits)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100), lake="king")
pred <- predict(fit.king, tmp)
lines(tmp$age, pred, col=2, lwd=2)
tmp <- data.frame(age=seq(min(db$age), max(db$age),,100), lake="queen")
pred <- predict(fit.queen, tmp)
lines(tmp$age, pred, col=3, lwd=2)
###Can this be done in one step using a grouping variable?
#with "lake" as grouping variable
starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)
fit1 <- nlme(model = size ~ soVBGF(S.inf, k, age, age.0, age.s, c),
data=db,
fixed = S.inf + k + c + age.0 + age.s ~ 1,
group = ~ lake,
start=starting.values
)
summary(fit1)
#similar residuals to the seperatly fitted models
sum(resid(fit.king)^2+resid(fit.queen)^2)
sum(resid(fit1)^2)
#but different degrees of freedom? (10 vs. 21?)
summary(fit.king)$df+summary(fit.queen)$df
AIC(fit1, fit0)
###I would also like to nest my grouping factors. This doesn't work...
#with "lake" and "food" as grouping variables
starting.values <- c(S.inf=140, k=0.5, c=0.1, age.0=0, age.s=0)
fit2 <- nlme(model = size ~ soVBGF(S.inf, k, age, age.0, age.s, c),
data=db,
fixed = S.inf + k + c + age.0 + age.s ~ 1,
group = ~ lake/food,
start=starting.values
)
参照:Chen、Y.、Jackson、DAおよびHarvey、HH、1992。魚の成長データのモデル化におけるvon Bertalanffyと多項式関数の比較。49、6:1228-1235。