"2016-10-21 11:22:10 CST"
上午对8801fs去掉hs的M3和M4做了模型比较，具体代码如下：
# --------
Sys.time()
# [1] "2016-10-21 08:26:31 CST"
setwd("D:/Sync/Dlm_wk/8801M3M4/data")
library(asreml)
pincalc<-dget("D:/Sync/R/pin.R")
options(digits = 3)
load("D:/Sync/Dlm_wk/8801M3M4/data/dlm.8801.RData")
str(df.rm.self)
# 'data.frame': 1251 obs. of 26 variables:
# $ TreeId : int 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 ...
# $ Mum : Factor w/ 12 levels "1","2","3","4",..: 10 10 10 10 10 10 10 10 10 10 ...
# $ Dad : Factor w/ 12 levels "1","2","3","4",..: 7 7 7 7 7 7 7 7 7 7 ...
# $ Com : chr "107" "107" "107" "107" ...
# $ Comb : Factor w/ 38 levels "CF29RC13","CF29RC402",..: 29 29 29 29 29 29 29 29 29 29 ...
# $ Dr : Factor w/ 3 levels "-1","0","1": 3 3 3 3 3 3 3 3 3 3 ...
# $ Tree : int NA 123 NA 107 NA 120 104 122 118 121 ...
# $ Fam : int 84 84 84 84 84 84 84 84 84 84 ...
# $ Rep : int 1 1 1 1 1 1 1 1 1 1 ...
# $ Row : int 41 41 41 42 42 42 43 43 44 44 ...
# $ Col : int 52 53 55 51 54 55 52 54 51 53 ...
# $ Plot : Factor w/ 250 levels "","1CHaoF29Y11",..: 42 42 42 42 42 42 42 42 42 42 ...
# $ h05 : num 15.5 15 15.5 16.5 17.5 15.8 17.2 17.2 15.5 16.1 ...
# $ d05 : num 14.5 16 13 13.3 13.4 14.7 18.3 17.3 14.5 14.8 ...
# $ v05 : num 0.326 0.384 0.262 0.292 0.314 ...
# $ h14 : num NA 19.9 NA 20.7 NA 20.8 23.2 23.1 19.2 21.6 ...
# $ d14 : num NA 20.2 NA 15.9 NA 19.1 23.1 24 17.1 17.4 ...
# $ v14 : num NA 0.812 NA 0.523 NA ...
# $ delta.h: num NA 4.9 NA 4.2 NA 5 6 5.9 3.7 5.5 ...
# $ delta.d: num NA 4.2 NA 2.6 NA 4.4 4.8 6.7 2.6 2.6 ...
# $ delta.v: num NA 0.428 NA 0.231 NA ...
# $ dr : num 1 1 1 1 1 1 1 1 1 1 ...
# $ d1 : num 1 1 1 1 1 1 1 1 1 1 ...
# $ d2 : num 0 0 0 0 0 0 0 0 0 0 ...
# $ check : Factor w/ 1 level "1": 1 1 1 1 1 1 1 1 1 1 ...
# $ l : chr "0" "0" "0" "0" ...
df.rm.self$Com<-factor(df.rm.self$Com)
df.rm.self$dr<-factor(df.rm.self$dr)
X<-names(df.rm.self) [13:21]<-c("H05","DBH05","V05","H14","DBH14","V14","HI","DI","VI")
# dlm.asreml <- function(df) {
# names(data)
# [1] "TreeId" "Mum" "Dad" "Com" "Comb" "Dr" "Tree" "Fam" "Rep"
# [10] "Row" "Col" "Plot" "H05" "DBH05" "V05" "H14" "DBH14" "V14"
# [19] "HI" "DI" "VI" "dr" "d1" "d2" "check" "l"
bv<-matrix(nrow=nrow(bv.i),ncol=length(X)) # create an empty matrix for bv
for (i in 1:length(X)){
data.i<-df.rm.self[, X[i]]
df<-df.rm.self
fix.only <- asreml(data.i~1+Rep,data = df,
na.method.X='include')
fix.gca <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad), # + Comb + Comb:Dr+Plot,
na.method.X='include')
fix.gca.com <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com, # + Comb:Dr+Plot,
na.method.X='include')
fix.gca.com.recip <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com + Com:dr, # +Plot,
na.method.X='include')
full <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com + Com:dr+Plot,
na.method.X='include')
# save wald
w<-wald(full)
names(w)[1]<-X[i]
write.table(w,"wald.csv",sep=',',quote=F,append=T)
# save lrt
a<-lrt(fix.only, fix.gca, fix.gca.com, fix.gca.com.recip, full)
# str(a)
names(a)[1]<-X[i]
write.table(a,"lrt.csv",sep=',',quote=F,append=T)
# save fitted plot
# plot.name<-paste0(X[i],"fit.wmf")
# win.metafile(plot.name,5,5,pointsize = 16,family = "serif")
# # par(mar=c(.1,.1,.1,.1))
# plot(full,main=X[i])
# dev.off()
# save variance
var.i<-summary(full)$varcomp
names(var.i)[1]<-X[i]
write.table(var.i,file="var.csv",sep=",",quote=F,append=T)
# save random effects
bv.i<-coef(full)$random
bv.i<-as.data.frame(bv.i)
# names(bv.i)[1]<-X[i]
# head(bv.i)
bv[,i]<- bv.i$effect
# bv<-as.matrix(bv)
# save h2
hi2<-pincalc(full, h2 ~ 4*V1/(2*V1 + V2 + V3+ V4+V5)) ###Narrow-sense heritability
names(hi2)[1]<-X[i]
H2<-pincalc(full, h2 ~ 4*(V1+V2)/(2*V1 + V2 + V3+ V4+V5)) ###broad-sense heritability
write.table(hi2,file="h2.csv",sep=",",quote=F,append=T)
write.table(H2,file="h2.csv",sep=",",quote=F,append=T)
}
colnames(bv)<-X
rownames(bv)<-rownames(bv.i)
write.table(bv,"bv.csv",sep = ',')
# ---M4-1
df.rm.self.M4.1<-df.rm.self[df.rm.self$dr==1,]
df.rm.self.M4.2<-df.rm.self[df.rm.self$dr!=1,]
bv<-matrix(nrow=nrow(bv.i),ncol=length(X)) # create an empty matrix for bv
for (i in 1:length(X)){
data.i<-df.rm.self.M4.1[, X[i]]
df<-df.rm.self.M4.1
fix.only <- asreml(data.i~1+Rep,data = df,
na.method.X='include')
fix.gca <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad), # + Comb + Comb:Dr+Plot,
na.method.X='include')
fix.gca.com <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com, # + Comb:Dr+Plot,
na.method.X='include')
fix.gca.com.recip <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com + Com:dr, # +Plot,
na.method.X='include')
full <- asreml(data.i~1+Rep, data=df,
random = ~ Mum+ and(Dad)+ Com + Com:dr+Plot,
na.method.X='include')
# save wald
w<-wald(full)
names(w)[1]<-X[i]
write.table(w,"wald.csv",sep=',',quote=F,append=T)
# save lrt
a<-lrt(fix.only, fix.gca, fix.gca.com, fix.gca.com.recip, full)
# str(a)
names(a)[1]<-X[i]
write.table(a,"lrt.csv",sep=',',quote=F,append=T)
# save fitted plot
plot.name<-paste0(X[i],"fit.wmf")
win.metafile(plot.name,5,5,pointsize = 16,family = "serif")
# par(mar=c(.1,.1,.1,.1))
plot(full,main=X[i])
dev.off()
# save variance
var.i<-summary(full)$varcomp
names(var.i)[1]<-X[i]
write.table(var.i,file="var.csv",sep=",",quote=F,append=T)
# save random effects
bv.i<-coef(full)$random
bv.i<-as.data.frame(bv.i)
# names(bv.i)[1]<-X[i]
# head(bv.i)
bv[,i]<- bv.i$effect
# bv<-as.matrix(bv)
# save h2
hi2<-pincalc(full, h2 ~ 4*V1/(2*V1 + V2 + V3+ V4+V5)) ###Narrow-sense heritability
names(hi2)[1]<-X[i]
H2<-pincalc(full, h2 ~ 4*(V1+V2)/(2*V1 + V2 + V3+ V4+V5)) ###broad-sense heritability
write.table(hi2,file="h2.csv",sep=",",quote=F,append=T)
write.table(H2,file="h2.csv",sep=",",quote=F,append=T)
}
colnames(bv)<-X
rownames(bv)<-rownames(bv.i)
write.table(bv,"bv.csv",sep = ',')
save(df.rm.self,df.rm.self.M4.1,df.rm.self.M4.2,file = "8801.m3.m4.rdata")
Sys.time()
# [1] "2016-10-21 11:22:10 CST"