Commit f9153d45 authored by Georges Kunstler's avatar Georges Kunstler
Browse files

start global analysis and look at shannon

parent 1bffcab2
#!/usr/bin/env Rscript
source("R/analysis/glmer.output-fun.R")
files <- list.files("output/glmer", recursive=TRUE, full.names =TRUE, pattern = "glmer.results.global.rds")
out <- lapply(files, summarise.glmer.output.list)
names(out) <- lapply(lapply(files,files.details),function(x) paste(as.vector(x[-6]),collapse="_"))
saveRDS(out,file='output/glmer.global.std.list.out.rds')
names.param <- unique(unlist(lapply(out,function(list.res) names(list.res$glmer.summary$fixed.coeff.E))))
DF.results <- do.call("rbind",lapply(out,fun.format.in.data.frame,names.param=names.param))
DF.results$id <- paste(DF.results$set,DF.results$ecocode,sep=".")
saveRDS(DF.results,file='output/glmer.global.std.DF.rds')
#!/usr/bin/env Rscript #!/usr/bin/env Rscript
source("R/analysis/glmer.output-fun.R") source("R/analysis/glmer.output-fun.R")
files <- list.files("output/glmer", recursive=TRUE, full.names =TRUE, pattern = "rds") files <- list.files("output/glmer", recursive=TRUE, full.names =TRUE, pattern = "glmer.results.rds")
out <- lapply(files, summarise.glmer.output.list) out <- lapply(files, summarise.glmer.output.list)
names(out) <- lapply(lapply(files,files.details),function(x) paste(as.vector(x[-6]),collapse="_")) names(out) <- lapply(lapply(files,files.details),function(x) paste(as.vector(x[-6]),collapse="_"))
saveRDS(out,file='output/glmer.list.out.rds') saveRDS(out,file='output/glmer.list.out.rds')
......
...@@ -56,7 +56,7 @@ fun.call.glmer.and.save <- function(formula,df.lmer,path.out){ ...@@ -56,7 +56,7 @@ fun.call.glmer.and.save <- function(formula,df.lmer,path.out){
end <- Sys.time() end <- Sys.time()
print(end - Start) print(end - Start)
print(summary(glmer.output)) print(summary(glmer.output))
saveRDS(glmer.output,file=file.path(path.out, "glmer.results.no.std.rds")) saveRDS(glmer.output,file=file.path(path.out, "glmer.results.global.rds"))
} }
run.glmer <- function (model.file, trait, set, ecoregion, run.glmer <- function (model.file, trait, set, ecoregion,
...@@ -92,10 +92,10 @@ output.dir.glmer <- function (model, trait, set, ecoregion,type.filling) { ...@@ -92,10 +92,10 @@ output.dir.glmer <- function (model, trait, set, ecoregion,type.filling) {
# Function to prepare data for lmer # Function to prepare data for lmer
#============================================================ #============================================================
load.and.prepare.data.for.glmer <- function(trait, set, ecoregion, load.and.prepare.data.for.glmer <- function(trait, set, ecoregion,
min.obs, sample.size, type.filling, min.obs, sample.size, type.filling,
base.dir = "output/processed/"){ base.dir = "output/processed/"){
### load data ### load data
data.tree.tot <- read.csv(file.path(base.dir, set,ecoregion,"data.tree.tot.no.std.csv"), stringsAsFactors = FALSE) data.tree.tot <- read.csv(file.path(base.dir, set,ecoregion,"data.tree.tot.global.csv"), stringsAsFactors = FALSE)
fun.data.for.glmer(data.tree.tot,trait,type.filling=type.filling) fun.data.for.glmer(data.tree.tot,trait,type.filling=type.filling)
} }
...@@ -105,14 +105,14 @@ fun.select.data.for.analysis <- function(data.tree,abs.CWM.tntf,perc.neigh,BATOT ...@@ -105,14 +105,14 @@ fun.select.data.for.analysis <- function(data.tree,abs.CWM.tntf,perc.neigh,BATOT
data.tree <- subset(data.tree,subset=(!is.na(data.tree[["dead"]])) & data.tree <- subset(data.tree,subset=(!is.na(data.tree[["dead"]])) &
(!is.na(data.tree[["D"]])) ) (!is.na(data.tree[["D"]])) )
## remove tree with zero ## remove tree with zero
data.tree <- subset(data.tree,subset=data.tree[["D"]]>9.9) data.tree <- subset(data.tree,subset=data.tree[["D"]]>9.9)
## select species with missing traits ## select species with missing traits
data.tree <- data.tree[(!is.na(data.tree[[abs.CWM.tntf]]) & data.tree <- data.tree[(!is.na(data.tree[[abs.CWM.tntf]]) &
!is.na(data.tree[[BATOT]])),] !is.na(data.tree[[BATOT]])),]
# select species with minimum obs # select species with minimum obs
data.tree <- subset(data.tree,subset=data.tree[["sp"]] %in% data.tree <- subset(data.tree,subset=data.tree[["sp"]] %in%
names(table(factor(data.tree[["sp"]])))[table(factor(data.tree[["sp"]]))>min.obs]) names(table(factor(data.tree[["sp"]])))[table(factor(data.tree[["sp"]]))>min.obs])
# select obs abov min perc.neigh # select obs abov min perc.neigh
data.tree <- subset(data.tree,subset=data.tree[[perc.neigh]] > min.perc.neigh & !is.na(data.tree[[perc.neigh]])) data.tree <- subset(data.tree,subset=data.tree[[perc.neigh]] > min.perc.neigh & !is.na(data.tree[[perc.neigh]]))
return(data.tree) return(data.tree)
} }
...@@ -159,6 +159,7 @@ sumTnBn <- data.tree[[CWM.tn]]*data.tree[[BATOT]] ...@@ -159,6 +159,7 @@ sumTnBn <- data.tree[[CWM.tn]]*data.tree[[BATOT]]
sumTfBn <- data.tree[[tf]]*data.tree[[BATOT]] sumTfBn <- data.tree[[tf]]*data.tree[[BATOT]]
sumTnTfBn.diff <- sumTnBn-sumTfBn sumTnTfBn.diff <- sumTnBn-sumTfBn
sumBn <- data.tree[[BATOT]] sumBn <- data.tree[[BATOT]]
return(data.frame(dead=dead, return(data.frame(dead=dead,
logD=logD, logD=logD,
species.id=species.id, species.id=species.id,
...@@ -176,12 +177,14 @@ return(data.frame(dead=dead, ...@@ -176,12 +177,14 @@ return(data.frame(dead=dead,
# that will be used in a simple linear model # that will be used in a simple linear model
#============================================================ #============================================================
fun.data.for.glmer <- function(data.tree,trait,min.obs=10,type.filling='species') { fun.data.for.glmer <- function(data.tree,trait,min.obs=10,type.filling='species') {
if(! trait %in% c("SLA", "Leaf.N","Seed.mass","SLA","Wood.density","Max.height")) stop("need trait to be in SLA Leaf.N Seed.mass SLA Wood.density or Max.height ") if(! trait %in% c("SLA", "Leaf.N","Seed.mass","SLA","Wood.density","Max.height"))
stop("need trait to be in SLA Leaf.N Seed.mass SLA Wood.density or Max.height ")
# get vars names # get vars names
CWM.tn <- paste(trait,"CWM",'fill',"log",sep=".") CWM.tn <- paste(trait,"CWM",'fill',sep=".")
abs.CWM.tntf <- paste(trait,"abs.CWM",'fill',"log",sep=".") abs.CWM.tntf <- paste(trait,"abs.CWM",'fill',sep=".")
tf <- paste(trait,"focal",sep=".") tf <- paste(trait,"focal",sep=".")
BATOT <- "BATOT.log" BATOT <- "BATOT"
perc.neigh <- paste(trait,"perc",type.filling,sep=".") perc.neigh <- paste(trait,"perc",type.filling,sep=".")
data.tree <- fun.select.data.for.analysis(data.tree,abs.CWM.tntf,perc.neigh,BATOT,min.obs) data.tree <- fun.select.data.for.analysis(data.tree,abs.CWM.tntf,perc.neigh,BATOT,min.obs)
#= DATA LIST FOR JAGS #= DATA LIST FOR JAGS
......
#!/usr/bin/env Rscript
source("R/analysis/lmer.output-fun.R")
source("R/analysis/lmer.run.nolog.R")
## LOOP OVER FILES AND NOT SCAN ALL FILES
sets <- c('BCI','Canada','France','Fushan','NVS','Paracou',
'Spain','US','Swiss','Sweden','NSW','Mbaiki','Luquillo','Japan')
traits <- c("SLA", "Wood.density","Max.height","Leaf.N","Seed.mass")
type.filling <- 'species'
files <- c()
for (set in sets){
ecoregions <- get.ecoregions.for.set(set)
for (ecoregion in ecoregions){
for (trait in traits){
for (model in c(model.files.lmer.Tf.1,model.files.lmer.Tf.2)){
source(model, local = TRUE)
model.obj <- load.model()
pathout <- output.dir.lmer(model=model.obj$name, trait,
set, ecoregion,type.filling)
files <- c(files,file.path(pathout,"results.global.nolog.rds"))
}
}
}
}
out <- lapply(files, summarise.lmer.output.list)
names(out) <- lapply(lapply(files,files.details),
function(x) paste(as.vector(x[names(x) != 'file']),
collapse="_"))
### remove missing
out <- out[!unlist(lapply(out,FUN=function(x) is.null(x$lmer.summary)))]
saveRDS(out,file='output/lmer.list.out.global.std.nolog.rds')
names.param <- unique(unlist(lapply(out,
function(list.res) names(list.res$lmer.summary$fixed.coeff.E))))
DF.results <- do.call("rbind",lapply(out, fun.format.in.data.frame,
names.param = names.param))
DF.results$id <- paste(DF.results$set, DF.results$ecocode, sep=".")
saveRDS(DF.results,file='output/lmer.global.std.nolog.DF.rds')
...@@ -7,7 +7,7 @@ source("R/analysis/lmer.run.nolog.all.R") ...@@ -7,7 +7,7 @@ source("R/analysis/lmer.run.nolog.all.R")
traits <- c("SLA", "Wood.density","Max.height","Leaf.N","Seed.mass") traits <- c("SLA", "Wood.density","Max.height","Leaf.N","Seed.mass")
type.filling <- 'species' type.filling <- 'species'
files <- c() files <- c()
for (trait in trait){ for (trait in traits){
for(model in c(model.files.lmer.Tf.1,model.files.lmer.Tf.2)){ for(model in c(model.files.lmer.Tf.1,model.files.lmer.Tf.2)){
source(model, local = TRUE) source(model, local = TRUE)
model.obj <- load.model() model.obj <- load.model()
......
This diff is collapsed.
...@@ -191,7 +191,8 @@ return(df.res) ...@@ -191,7 +191,8 @@ return(df.res)
## function to compute ratio of variance explained by a trait variable over the variance explained by the BATOT ## function to compute ratio of variance explained by a trait variable over the variance explained by the BATOT
fun.ratio.var.fixed.effect <- function(DF.results){ fun.ratio.var.fixed.effect <- function(DF.results){
mat.ratio <- DF.results[,c('sumTnTfBn.abs.VAR','sumTfBn.VAR','sumTnBn.VAR','effect.response.var')]/ mat.ratio <- DF.results[,c('sumTnTfBn.abs.VAR','sumTfBn.VAR','sumTnBn.VAR',
'effect.response.var')]/
DF.results[,'sumBn.VAR'] DF.results[,'sumBn.VAR']
names(mat.ratio) <- c('abs.dist','Response','Effect','Effect.Response') names(mat.ratio) <- c('abs.dist','Response','Effect','Effect.Response')
return(mat.ratio) return(mat.ratio)
...@@ -199,19 +200,26 @@ return(mat.ratio) ...@@ -199,19 +200,26 @@ return(mat.ratio)
### FUNCTION TO REPORT BEST MODEL PER ECOREGION AND TRAITS ### FUNCTION TO REPORT BEST MODEL PER ECOREGION AND TRAITS
fun.AIC <- function(id2.one,DF.results){ fun.AIC <- function(id2.one,DF.results){
models <- c('lmer.LOGLIN.nocomp.Tf', 'lmer.LOGLIN.simplecomp.Tf','lmer.LOGLIN.HD.Tf', models <- c('lmer.LOGLIN.nocomp.Tf', 'lmer.LOGLIN.simplecomp.Tf',
'lmer.LOGLIN.E.Tf','lmer.LOGLIN.R.Tf','lmer.LOGLIN.ER.Tf','lmer.LOGLIN.AD.Tf') 'lmer.LOGLIN.HD.Tf',
best <- as.vector(DF.results[DF.results$id2==id2.one,c('id2','trait','set','ecocode','filling','MAT','MAP','model')])[which.min(DF.results$AIC[DF.results$id2==id2.one]),] 'lmer.LOGLIN.E.Tf','lmer.LOGLIN.R.Tf','lmer.LOGLIN.ER.Tf',
'lmer.LOGLIN.AD.Tf')
best <- as.vector(DF.results[DF.results$id2==id2.one,c('id2','trait','set',
'ecocode','filling','MAT','MAP','model')])[
which.min(DF.results$AIC[DF.results$id2==id2.one]),]
AIC.all <- as.vector(DF.results[DF.results$id2==id2.one,c('AIC')]) AIC.all <- as.vector(DF.results[DF.results$id2==id2.one,c('AIC')])
names(AIC.all) <- as.vector(DF.results[DF.results$id2==id2.one,c('model')]) names(AIC.all) <- as.vector(DF.results[DF.results$id2==id2.one,c('model')])
AIC.all <- AIC.all[models]-min(AIC.all) AIC.all <- AIC.all[models]-min(AIC.all)
res <- data.frame((best),t(AIC.all)) res <- data.frame((best),t(AIC.all))
names(res) <- c('id2','trait','set','ecocode','filling','MAT','MAP','best.model',paste('AIC',models,sep='.')) names(res) <- c('id2','trait','set','ecocode','filling','MAT','MAP',
'best.model',paste('AIC',models,sep='.'))
return(res) return(res)
} }
fun.AICc <- function(id2.one,DF.results){ fun.AICc <- function(id2.one,DF.results){
models <- c('lmer.LOGLIN.nocomp.Tf', 'lmer.LOGLIN.simplecomp.Tf','lmer.LOGLIN.HD.Tf','lmer.LOGLIN.E.Tf','lmer.LOGLIN.R.Tf','lmer.LOGLIN.ER.Tf','lmer.LOGLIN.AD.Tf') models <- c('lmer.LOGLIN.nocomp.Tf', 'lmer.LOGLIN.simplecomp.Tf',
'lmer.LOGLIN.HD.Tf','lmer.LOGLIN.E.Tf','lmer.LOGLIN.R.Tf',
'lmer.LOGLIN.ER.Tf','lmer.LOGLIN.AD.Tf')
Deviance.all <- DF.results[DF.results$id2==id2.one,'deviance'] Deviance.all <- DF.results[DF.results$id2==id2.one,'deviance']
names(Deviance.all) <- DF.results[DF.results$id2==id2.one,'model'] names(Deviance.all) <- DF.results[DF.results$id2==id2.one,'model']
Deviance.all <- Deviance.all[models] Deviance.all <- Deviance.all[models]
...@@ -293,43 +301,104 @@ print(tapply(df.selected[['AIC.simplecomp']]<0, ...@@ -293,43 +301,104 @@ print(tapply(df.selected[['AIC.simplecomp']]<0,
fun.plot.param.error.bar <- function(df.selected,var.x,param,small.bar,col.vec){ fun.plot.param.error.bar <- function(df.selected,var.x,param,small.bar,col.vec){
segments( df.selected[[var.x]],df.selected[[param]] - 1.96*df.selected[[paste(param,"Std.Error",sep=".")]], segments( df.selected[[var.x]],df.selected[[param]] - 1.96*df.selected[[paste(
df.selected[[var.x]],df.selected[[param]] + 1.96*df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec) param,"Std.Error",sep=".")]],
segments( df.selected[[var.x]]-small.bar,df.selected[[param]] - 1.96*df.selected[[paste(param,"Std.Error",sep=".")]], df.selected[[var.x]],df.selected[[param]] + 1.96*df.selected[[paste(
df.selected[[var.x]]+small.bar,df.selected[[param]] - 1.96*df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec) param,"Std.Error",sep=".")]],col=col.vec)
segments( df.selected[[var.x]]-small.bar,df.selected[[param]] + 1.96*df.selected[[paste(param,"Std.Error",sep=".")]], segments( df.selected[[var.x]]-small.bar,df.selected[[param]] - 1.96*
df.selected[[var.x]]+small.bar,df.selected[[param]] + 1.96*df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec) df.selected[[paste(param,"Std.Error",sep=".")]],
} df.selected[[var.x]]+small.bar,df.selected[[param]] - 1.96*
df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec)
fun.plot.all.param.x.y.c <- function(model.selected,trait.name,DF.results,var.x,params, segments( df.selected[[var.x]]-small.bar,df.selected[[param]] + 1.96*
small.bar,threshold.delta.AIC,col.vec,col.set=TRUE,...){ df.selected[[paste(param,"Std.Error",sep=".")]],
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,model.selected=model.selected,threshold.delta.AIC=threshold.delta.AIC) df.selected[[var.x]]+small.bar,df.selected[[param]] + 1.96*
if(col.set) {col.vec2 <- col.vec[unclass(df.selected[['set']])]}else{col.vec2 <- 1} df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec)
ylim <- range(c(df.selected[[params[1]]] - 1.96*df.selected[[paste(params[1],"Std.Error",sep=".")]], }
df.selected[[params[1]]] + 1.96*df.selected[[paste(params[1],"Std.Error",sep=".")]]),na.rm=TRUE)
fun.plot.all.param.x.y.c <- function(model.selected,trait.name,DF.results,var.x,
params,small.bar,threshold.delta.AIC,
col.vec,col.set=TRUE,ylim=NA,
ylim.same=FALSE,add.name = FALSE, ...){
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,
model.selected=model.selected,
threshold.delta.AIC=threshold.delta.AIC)
if(col.set) {col.vec2 <- col.vec[unclass(df.selected[['set']])]}else{
col.vec2 <- 1}
if(!ylim.same) {ylim <- range(c(df.selected[[params[1]]] - 1.96*
df.selected[[paste(params[1],"Std.Error",sep=".")]],
df.selected[[params[1]]] + 1.96*
df.selected[[paste(params[1],"Std.Error",sep=".")]]),na.rm=TRUE)}
plot(df.selected[[var.x]],df.selected[[params[1]]],col=col.vec2,ylim=ylim,...) plot(df.selected[[var.x]],df.selected[[params[1]]],col=col.vec2,ylim=ylim,...)
fun.plot.param.error.bar(df.selected,var.x,param=params[1],small.bar,col=col.vec2) if (add.name) text(df.selected[[var.x]], df.selected[[params[1]]],
} labels = paste(df.selected[['set']],
df.selected[['ecocode']]), cex = 0.5, pos = 2)
fun.plot.param.error.bar(df.selected,var.x,param=params[1],
fun.plot.all.param.boxplot <- function(model.selected,trait.name,DF.results,params,small.bar,...){ small.bar,col=col.vec2)
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,model.selected=model.selected) }
fun.plot.param.error.bar.std <- function(df.selected,var.x,param,small.bar,col.vec){
segments( df.selected[[var.x]],df.selected[[param]] + df.selected[['sumBn']] - 1.96*df.selected[[paste(
param,"Std.Error",sep=".")]],
df.selected[[var.x]],df.selected[[param]] + df.selected[['sumBn']] + 1.96*df.selected[[paste(
param,"Std.Error",sep=".")]],col=col.vec)
segments( df.selected[[var.x]]-small.bar,df.selected[[param]] + df.selected[['sumBn']] - 1.96*
df.selected[[paste(param,"Std.Error",sep=".")]],
df.selected[[var.x]]+small.bar,df.selected[[param]] + df.selected[['sumBn']] - 1.96*
df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec)
segments( df.selected[[var.x]]-small.bar,df.selected[[param]] + df.selected[['sumBn']] + 1.96*
df.selected[[paste(param,"Std.Error",sep=".")]],
df.selected[[var.x]]+small.bar,df.selected[[param]] + df.selected[['sumBn']] + 1.96*
df.selected[[paste(param,"Std.Error",sep=".")]],col=col.vec)
}
fun.plot.all.param.x.y.std <- function(model.selected,trait.name,
DF.results,var.x,
params,small.bar,threshold.delta.AIC,
col.vec,col.set=TRUE,ylim=NA,
ylim.same=FALSE,add.name = FALSE, ...){
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,
model.selected=model.selected,
threshold.delta.AIC=threshold.delta.AIC)
if(col.set) {col.vec2 <- col.vec[unclass(df.selected[['set']])]}else{
col.vec2 <- 1}
plot(df.selected[[var.x]],df.selected[[params[1]]] + df.selected[['sumBn']],
col = col.vec2, ...)
if (add.name) text(df.selected[[var.x]],
df.selected[[params[1]]] + df.selected[['sumBn']],
labels = paste(df.selected[['set']],
df.selected[['ecocode']]), cex = 0.5, pos = 2)
fun.plot.param.error.bar.std(df.selected,var.x,param=params[1],
small.bar,col=col.vec2)
}
fun.plot.all.param.boxplot <- function(model.selected,trait.name,DF.results,
params,small.bar,...){
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,
model.selected=model.selected)
if(length(params)>1){ if(length(params)>1){
DF.t <- data.frame(param=rep(names(params),each=nrow(df.selected)),value=c(df.selected[[params[1]]],df.selected[[params[2]]])) DF.t <- data.frame(param=rep(names(params),each=nrow(df.selected)),value=c(
df.selected[[params[1]]],df.selected[[params[2]]]))
boxplot(DF.t[['value']]~DF.t[['param']],...) boxplot(DF.t[['value']]~DF.t[['param']],...)
}else{ }else{
boxplot(df.selected[[params[1]]],...) boxplot(df.selected[[params[1]]],...)
} }
} }
fun.plot.all.param.er.diff.MAP <- function(model.selected,trait.name,DF.results,...){ fun.plot.all.param.er.diff.MAP <- function(model.selected,trait.name,
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,model.selected=model.selected) DF.results,...){
df.selected <- fun.select.ecoregions.trait(DF.results,trait.name=trait.name,
model.selected=model.selected)
plot(df.selected[['MAP']],df.selected[['sumTnBn']]-df.selected[['sumTfBn']],...) plot(df.selected[['MAP']],df.selected[['sumTnBn']]-df.selected[['sumTfBn']],...)
} }
fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,express,...){ fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,
express,...){
ncols = length(traits) ncols = length(traits)
nrows = length(models) nrows = length(models)
list.models <- as.list(names(models)) list.models <- as.list(names(models))
...@@ -347,7 +416,8 @@ fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,e ...@@ -347,7 +416,8 @@ fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,e
if(i==nrows) if(i==nrows)
mtext(var.x, side=1, line =4) mtext(var.x, side=1, line =4)
if(j==1) if(j==1)
mtext(paste('Effect size',list.models[i]), side=2, line =4,cex=0.9) mtext(paste('Effect size',list.models[i]), side=2, line =4,
cex=0.9)
if(i==nrows & j==ncols) if(i==nrows & j==ncols)
legend('topright',legend=levels(DF.results$set),pch=16, legend('topright',legend=levels(DF.results$set),pch=16,
col=col.vec,bty='n',ncol=2) col=col.vec,bty='n',ncol=2)
...@@ -355,7 +425,8 @@ fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,e ...@@ -355,7 +425,8 @@ fun.plot.panel.lmer.res.x.y <- function(models,traits,DF.results,var.x,var.y.l,e
} }
fun.plot.panel.lmer.res.boxplot <- function(models,traits,DF.results,var.y,express,...){ fun.plot.panel.lmer.res.boxplot <- function(models,traits,DF.results,var.y,
express,...){
ncols = length(traits) ncols = length(traits)
nrows = length(models) nrows = length(models)
list.models <- as.list(names(models)) list.models <- as.list(names(models))
...@@ -369,12 +440,14 @@ fun.plot.panel.lmer.res.boxplot <- function(models,traits,DF.results,var.y,expre ...@@ -369,12 +440,14 @@ fun.plot.panel.lmer.res.boxplot <- function(models,traits,DF.results,var.y,expre
if(i==1 ) if(i==1 )
mtext(traits[j], side=3, line =1) mtext(traits[j], side=3, line =1)
if(j==1) if(j==1)
mtext(paste("Effect size", list.models[i],sep=" "), side=2, line =4,cex=0.9) mtext(paste("Effect size", list.models[i],sep=" "), side=2,
line =4,cex=0.9)
} }
} }
fun.plot.panel.lmer.res.boxplot.compare <- function(models,traits,DF.results,var.y,express,...){ fun.plot.panel.lmer.res.boxplot.compare <- function(models,traits,DF.results,
var.y,express,...){
ncols = length(traits) ncols = length(traits)
list.models <- as.list(names(models)) list.models <- as.list(names(models))
names(list.models) <- rep('model',length(list.models)) names(list.models) <- rep('model',length(list.models))
...@@ -389,7 +462,10 @@ fun.plot.panel.lmer.res.boxplot.compare <- function(models,traits,DF.results,var ...@@ -389,7 +462,10 @@ fun.plot.panel.lmer.res.boxplot.compare <- function(models,traits,DF.results,var
} }
} }
fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,list.params,threshold.delta.AIC,small.bar=10,...){ fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,
list.params,threshold.delta.AIC,
small.bar=10,ylim=NA,
ylim.same=FALSE,...){
ncols = length(traits) ncols = length(traits)
nrows = length(models) nrows = length(models)
par(mfrow = c(nrows, ncols), mar = c(2,2,1,1), oma = c(4,4,4,1) ) par(mfrow = c(nrows, ncols), mar = c(2,2,1,1), oma = c(4,4,4,1) )
...@@ -400,10 +476,13 @@ fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,list ...@@ -400,10 +476,13 @@ fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,list
## DF.results$sumTnTfBn.abs <- DF.results$sumTnTfBn.abs/2 ## DF.results$sumTnTfBn.abs <- DF.results$sumTnTfBn.abs/2
for(i in 1:nrows) for(i in 1:nrows)
for(j in 1:ncols){ for(j in 1:ncols){
fun.plot.all.param.x.y.c(models[i],traits[j],DF.results,var.x,params=list.params[[i]], try(fun.plot.all.param.x.y.c(models[i],traits[j],DF.results,var.x,
params=list.params[[i]],
small.bar=small.bar, small.bar=small.bar,
threshold.delta.AIC=threshold.delta.AIC,col.vec=col.vec,col.set=TRUE,...) threshold.delta.AIC=threshold.delta.AIC,
abline(h=0,lty=3) col.vec=col.vec,col.set=TRUE,
ylim=ylim,ylim.same=ylim.same,...))
try(abline(h=0,lty=3))
if(length(list.params[[i]])>1) if(length(list.params[[i]])>1)
legend("topright",names(list.params[[i]]), legend("topright",names(list.params[[i]]),
pch=rep(1,length(list.params[[i]])), pch=rep(1,length(list.params[[i]])),
...@@ -414,9 +493,9 @@ fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,list ...@@ -414,9 +493,9 @@ fun.plot.panel.lmer.parameters.c <- function(models,traits,DF.results,var.x,list
mtext(var.x, side=1, line =4) mtext(var.x, side=1, line =4)
if(j==1) if(j==1)
mtext(paste('param',names(models)[i]), side=2, line =4,cex=1) mtext(paste('param',names(models)[i]), side=2, line =4,cex=1)
## if(i==nrows & j==ncols) if(i==nrows & j==ncols)
## legend('topright',legend=levels(DF.results$set),pch=16, legend('bottomright',legend=levels(DF.results$set),pch=16,
## col=col.vec,bty='n',ncol=2) col=col.vec,bty='n',ncol=2)
} }
} }
...@@ -439,3 +518,25 @@ fun.plot.panel.lmer.parameters.boxplot <- function(models,traits,DF.results,list ...@@ -439,3 +518,25 @@ fun.plot.panel.lmer.parameters.boxplot <- function(models,traits,DF.results,list
} }
} }
## create a data base from the global data
fun.merge.results.global <- function(list.res,
names.param = c( "(Intercept)", "Tf",
"logD", "sumBn", "sumTnBn",
"sumTfBn", "sumTnTfBn.abs",
"sumTnTfBn.diff")){
df.details <- data.frame(list.res$files.details[1:4],
list.res$lmer.summary[1:6])
fun.rep.df <- function(x, df = df.details) df
n_rep <- nrow(list.res$lmer.summary$ecocode.BLUP)
dat.t <- data.frame(matrix(rep(NA,n_rep * length(names.param)), nrow = n_rep,
ncol = length(names.param)))
names(dat.t) <- c(names.param)
dat.t[, match(names(list.res$lmer.summary$ecocode.BLUP), names(dat.t))] <-
list.res$lmer.summary$ecocode.BLUP
df.res <- data.frame(ecocode = rownames(list.res$lmer.summary$ecocode.BLUP),
do.call( "rbind", lapply(1:n_rep, fun.rep.df)),
dat.t)
return(df.res)
}
#### function to analyse lmer output for GLOBAL ANALYSIS
library(lme4)
read.lmer.output <- function(file.name){
tryCatch(readRDS(file.name), error=function(cond)return(NULL)) # Choose a return value in case of error
}
summarise.lmer.output <- function(x){
list( nobs = nobs(x),
R2m =Rsquared.glmm.lmer(x)$Marginal,
R2c =Rsquared.glmm.lmer(x)$Conditional,
AIC = AIC(x),
deviance = deviance(x),
conv=x@optinfo$conv,
effect.response.var=variance.fixed.glmm.lmer.effect.and.response(x),
fixed.coeff.E=fixef(x),
fixed.coeff.Std.Error=sqrt(diag(vcov(x))),
fixed.var=variance.fixed.glmm.lmer(x),
ecocode.BLUP=coef(x)$ecocode.i)
}
summarise.lmer.output.all.list <- function(f ){
output.lmer <- read.lmer.output(f)
if(!is.null(output.lmer)){
res <- list(files.details=files.details.all(f),
lmer.summary=summarise.lmer.output( output.lmer))
}else{
res <- NULL
}
return(res)
}
files.details.all <- function(x){
s <- data.frame(t(strsplit(x, "/", fixed=TRUE)[[1]]), stringsAsFactors= FALSE)
names(s) <- c("d1", "d2", "set", "trait", "filling"