函数 mixed.model.B (GAMM)
function mixed.model.B (GAMM)
有没有人用过这个功能
"mixed.model.B"
?如果是,我可以找到哪个包?
这个在data.zip段,数据是leukemia.txt。
注意:我正在使用指定的库:
library(nlme)
library(ggplot2)
library(GGally)
library(splines)
library(nlme)
library(fields)
library(lattice)
require(ISLR)
library(grid)
library(dplyr)
library(MASS)
library(mgcv)
library(latticeExtra)
library(fields)
查看下面的代码:
attach(leukemia)
X=model.matrix(height~factor(treatment)*age)
treatment=factor(treatment)
MM=mixed.model.B(age,min(age)-0.5,max(age)+0.5,40,3,2,type="Eilers")
Z=MM[[2]]
Id=factor(rep(1,length(height)))
Z.block4=list(treatment=pdIdent(~Z-1),case=pdSymm(~age))
data.fr <- groupedData(height ~ X[,-1] | Id, data = data.frame(height,X,Z,case,age))
model4 <- lme(height~X[,-1],data=data.fr,random=Z.block4)
## Fitted individual trends for the smooth random intercept and slope model by treatment
b4 <- xyplot(fitted(fit4.gamm$lme) ~ age|factor(treatment),groups=case,col=tim.colors(length(unique(leukemia$case))),
lwd=1,pch=19,data=leukemia,main="Treatment",cex=.35,type="a")
a2 + as.layer(b4)
在您列出的 link 中,有一个 link 下载 R 文件:
http://halweb.uc3m.es/esp/Personal/personas/durban/esp/web/cursos/Maringa/gam-markdown/Gams-code.R
第349行,作者构建函数,我复制如下:
# Mixed model representation of B-splines (using svd)
mixed.model.B<-function(x,xl,xr,ndx,bdeg,pord,type="Eilers"){
Bbasis=bspline(x,xl,xr,ndx,bdeg)
B <- Bbasis$B
m=ncol(B)
D=diff(diag(m),differences=pord)
if(type=="Eilers"){
Z <- B%*%t(D)%*%solve(D%*%t(D))
}else if(type=="SVD"){ print("SVD method")
P.svd=svd(t(D)%*%D)
U=(P.svd$u)[,1:(m-pord)]
d=(P.svd$d)[1:(m-pord)]
Delta=diag(1/sqrt(d))
Z=B%*%U%*%Delta
}
X=NULL
for(i in 0:(pord-1)){
X=cbind(X,x^i)
}
output <- list(X=X,Z=Z)
return(output)
}
有没有人用过这个功能
"mixed.model.B"
?如果是,我可以找到哪个包?
这个在data.zip段,数据是leukemia.txt。 注意:我正在使用指定的库:
library(nlme)
library(ggplot2)
library(GGally)
library(splines)
library(nlme)
library(fields)
library(lattice)
require(ISLR)
library(grid)
library(dplyr)
library(MASS)
library(mgcv)
library(latticeExtra)
library(fields)
查看下面的代码:
attach(leukemia)
X=model.matrix(height~factor(treatment)*age)
treatment=factor(treatment)
MM=mixed.model.B(age,min(age)-0.5,max(age)+0.5,40,3,2,type="Eilers")
Z=MM[[2]]
Id=factor(rep(1,length(height)))
Z.block4=list(treatment=pdIdent(~Z-1),case=pdSymm(~age))
data.fr <- groupedData(height ~ X[,-1] | Id, data = data.frame(height,X,Z,case,age))
model4 <- lme(height~X[,-1],data=data.fr,random=Z.block4)
## Fitted individual trends for the smooth random intercept and slope model by treatment
b4 <- xyplot(fitted(fit4.gamm$lme) ~ age|factor(treatment),groups=case,col=tim.colors(length(unique(leukemia$case))),
lwd=1,pch=19,data=leukemia,main="Treatment",cex=.35,type="a")
a2 + as.layer(b4)
在您列出的 link 中,有一个 link 下载 R 文件: http://halweb.uc3m.es/esp/Personal/personas/durban/esp/web/cursos/Maringa/gam-markdown/Gams-code.R
第349行,作者构建函数,我复制如下:
# Mixed model representation of B-splines (using svd)
mixed.model.B<-function(x,xl,xr,ndx,bdeg,pord,type="Eilers"){
Bbasis=bspline(x,xl,xr,ndx,bdeg)
B <- Bbasis$B
m=ncol(B)
D=diff(diag(m),differences=pord)
if(type=="Eilers"){
Z <- B%*%t(D)%*%solve(D%*%t(D))
}else if(type=="SVD"){ print("SVD method")
P.svd=svd(t(D)%*%D)
U=(P.svd$u)[,1:(m-pord)]
d=(P.svd$d)[1:(m-pord)]
Delta=diag(1/sqrt(d))
Z=B%*%U%*%Delta
}
X=NULL
for(i in 0:(pord-1)){
X=cbind(X,x^i)
}
output <- list(X=X,Z=Z)
return(output)
}