我已经使用 nlme 拟合了一个模型,但我认为残差看起来不够好,所以我正在尝试通过
fit.nlme6 <- update(fit.nlme5, weights = varPower())
我明白了Error: Singularity in backsolve at level 0, block 1
。我尝试了其他我认为没有多大意义的课程,并尝试了各种forms = ~
and fixed
。所有这些都带有相同的错误消息,有时带有额外的警告消息。
这是残差。我认为varPower
应该可以完美地工作,那为什么不呢?
残差:
更多信息,fit.nlme5
是适合具有三个参数的 beta 生长函数的模型,w.max
(最大生物量)、t.e
(生长结束时刻)和t.m
(最大生长时刻)。模型看起来像这样
fit.nlme5 <- update(fit.nlme4, fixed = list(t.e ~ trt + ground + trt:ground, w.max + t.m ~ 1),
start = c(cfsTD[1:4], rep(0,2) ,cfsTD[5:6]))
在两个位置(地面)有三个处理(trt)。在残差固定后,我将运行一些对比来比较不同位置的处理。
这是数据https://dl.dropbox.com/u/21080842/cobsgddv8.txt
并且代码需要到达最终模型:
#You'll need these functions
## Implementing the beta growth function from (Yin et al 2003)
bgfInit <- function(mCall, LHS, data){
xy <- sortedXyData(mCall[["time"]], LHS, data)
if(nrow(xy) < 4){
stop("Too few distinct input values to fit a bgf")
}
w.max <- max(xy[,"y"])
t.e <- NLSstClosestX(xy, w.max)
t.m <- NLSstClosestX(xy, w.max/2)
value <- c(w.max, t.e, t.m)
names(value) <- mCall[c("w.max","t.e","t.m")]
value
}
bgf <- function(time, w.max, t.e, t.m){
.expr1 <- t.e / (t.e - t.m)
.expr2 <- (time/t.e)^.expr1
.expr3 <- (1 + (t.e - time)/(t.e - t.m))
.value <- w.max * .expr3 * .expr2
## Derivative with respect to t.e
.exp1 <- ((time/t.e)^(t.e/(t.e - t.m))) * ((t.e-time)/(t.e-t.m) + 1)
.exp2 <- (log(time/t.e)*((1/(t.e-t.m) - (t.e/(t.e-t.m)^2) - (1/(t.e - t.m)))))*w.max
.exp3 <- (time/t.e)^(t.e/(t.e-t.m))
.exp4 <- w.max * ((1/(t.e-t.m)) - ((t.e - time)/(t.e-t.m)^2))
.exp5 <- .exp1 * .exp2 + .exp3 * .exp4
## Derivative with respect to t.m
.ex1 <- t.e * (time/t.e)^((t.e/(t.e - t.m))) * log(time/t.e) * ((t.e - time)/(t.e -
t.m) + 1) * w.max
.ex2 <- (t.e - time) * w.max * (time/t.e)^(t.e/(t.e-t.m))
.ex3 <- (t.e - t.m)^2
.ex4 <- .ex1 / .ex3 + .ex2 / .ex3
.actualArgs <- as.list(match.call()[c("w.max", "t.e", "t.m")])
## Gradient
if (all(unlist(lapply(.actualArgs, is.name)))) {
.grad <- array(0, c(length(.value), 3L), list(NULL, c("w.max",
"t.e", "t.m")))
.grad[, "w.max"] <- .expr3 * .expr2
.grad[, "t.e"] <- .exp5
.grad[, "t.m"] <- .ex4
dimnames(.grad) <- list(NULL, .actualArgs)
attr(.value, "gradient") <- .grad
}
.value
}
SSbgf <- selfStart(bgf, initial = bgfInit, c("w.max", "t.e", "t.m"))
#Now for the data and fitting
grow<-read.table("cobsgddv8.txt", header=T)
library(nlme)
grow10<-subset(grow, grow$year == "2010")
grow10$EU<- with(grow10, factor(ground):factor(plot))
grow10G<-groupedData(mass ~ gdd | EU, data=grow10)
fit.beta.10 <- nlsList(mass ~ SSbgf(gdd, w.max, t.e, t.m), data = grow10G)
fit.nlme.10<-nlme(fit.beta.10, random=pdDiag(w.max ~1))
cfs <- fixef(fit.nlme.10)
fit.nlme2 <- update(fit.nlme.10, fixed = list(t.e ~ trt, w.max + t.m ~ 1),
start = c(cfs[2], rep(0,2), cfs[c(1,3)]))
cfsT <- fixef(fit.nlme2)
fit.nlme3 <- update(fit.nlme.10, fixed = list(t.e ~ ground, w.max + t.m ~ 1),
start = c(cfs[2], rep(0,1), cfs[c(1,3)]))
cfsG <- fixef(fit.nlme3)
fit.nlme4 <- update(fit.nlme.10, fixed = list(t.e ~ trt + ground, w.max + t.m ~ 1),
start = c(cfsT[1:2], cfsG[1:2], cfs[c(1,3)]))
cfsTD <- fixef(fit.nlme4)
fit.nlme5 <- update(fit.nlme4, fixed = list(t.e ~ trt + ground + trt:ground, w.max +
t.m ~ 1),
start = c(cfsTD[1:4], rep(0,2) ,cfsTD[5:6]))
fit.nlme6 <- update(fit.nlme5, weights = varPower())