Commit 299a2610 authored by Georges Kunstler's avatar Georges Kunstler
Browse files

first version working with dplyr for NFI and removed CAT for the moment

parent c2c1adae
......@@ -134,18 +134,6 @@ fun.weighted.mean.trait <- function(BA, T, select) {
return(as.vector(T[select, 3])) }
}
## compute the weighted mean from traits by cat here not divided by BATOT
fun.weighted.mean.trait.by.cat <- function(cat.select, T.cat, BA, T, select) {
res <- 0
if (sum(T.cat[select, 4] == cat.select) > 0){
select.t <- row.names(T.cat[select, ])[T.cat[select, 4] == cat.select]
if(length(select.t)>1) {
res <- as.vector(sum(BA[select.t] * T[select.t, 3]))}
if(length(select.t) == 1) {
res <- as.vector(BA[select.t] * T[select.t, 3]) }
}
return(res)
}
fun.perc.genus <- function(select, T){
sum(!is.na(T[select, 2]))/length(select)
......@@ -160,31 +148,18 @@ fun.perc.species <- function(select, T){
fun.weighted.mean.4.types <- function(BA, trait.list, trait.sp.focal) {
select.BA.no0 <- names(BA)[BA > 0]
CWM.tn <- fun.weighted.mean.trait(BA, trait.list[, 1:3], select.BA.no0)
CWM.tn.cat.vec <- unlist(lapply(1:3,
fun.weighted.mean.trait.by.cat,
trait.list,
BA,
trait.list[, 1:3],
select.BA.no0))
#abs dist
CWM.abs.tdist <-
fun.weighted.mean.trait(BA,
abs(trait.sp.focal-trait.list[, 1:3]),
select.BA.no0)
CWM.abs.tdist.cat.vec <- unlist(lapply(1:3,
fun.weighted.mean.trait.by.cat,
trait.list,
BA,
abs(trait.sp.focal-trait.list[, 1:3]),
select.BA.no0))
# compute percentage of traits obs
perc.genus <- fun.perc.genus(select.BA.no0, trait.list)
perc.species <- fun.perc.species(select.BA.no0, trait.list)
## to do add percentage EV and angio adn compute per type
return(c(CWM.tn, CWM.abs.tdist, perc.genus, perc.species,
CWM.tn.cat.vec, CWM.abs.tdist.cat.vec))
return(c(CWM.tn, CWM.abs.tdist, perc.genus, perc.species))
}
## function compute the 4 CWM and tf for one traits
......@@ -195,9 +170,9 @@ format.one.trait.CWM <- function(trait.list, sp.num, BA) {
if(sum(BA>0)>0) {
res.vec <- fun.weighted.mean.4.types(BA, trait.list,
trait.sp.focal) }
else { res.vec <- rep(0, 10) }
else { res.vec <- rep(0, 4) }
}
else { res.vec <- rep(NA, 10) }
else { res.vec <- rep(NA, 4) }
return(c(trait.sp.focal, cat.sp.focal, res.vec))
}
......@@ -369,7 +344,8 @@ fun.CWM.traits.all.XY.census <- function(census, obs.id, xy.table, diam,
res.l <-lapply(unique.census, FUN=fun.CWM.traits.all.XY.l, census=census,
obs.id=obs.id, xy.table= xy.table,
diam=diam, sp=sp, data.TRAITS=data.TRAITS, Rlim= Rlim)
res <- do.call("rbind", res.l)
require(dplyr)
res <- rbind_all(res.l)
res <- res[match(obs.id, res[, "obs.id"]), ]
return(res)
}
......@@ -414,6 +390,10 @@ fun.merged.DT <- function(data.1, data.2, by.var){
return(data.merged)
}
fun.fill.missing.traits <- function(data){
data <- mutate(data,
Leaf.N.genus = ifelse(is.na(Leaf.N.mean),
......@@ -447,24 +427,54 @@ data <- mutate(data,
mean(Seed.mass.mean, na.rm = TRUE),
Seed.mass.mean)
)
return(data)
}
fun.CWM.traits.all.plot.census.dplyr <- function(data,data.TRAITS){
require(dplyr)
data <- tbl_df(data)
data <- mutate(data,
plot.c = paste(plot, census, sep ='_'),
BA.w = BA.fun(D, weights))
# merge traits
data <- left_join(data, data.TRAITS, by = 'sp')
data <- fun.fill.missing.traits(data)
# compute CWM abs
data.CWM.abs <- data %>% group_by(plot.c) %>%
do(fun.CWM.abs.all(.)) %>%
ungroup() %>% select(-plot.c)
data <- left_join(data, data.CWM.abs, by = 'obs.id')
fun.order.colums <- function(data){
data <- mutate(data,
Leaf.N.focal = Leaf.N.focal,
Leaf.N.CWM.fill = Leaf.N.CWM.fill,
Leaf.N.perc.genus = Leaf.N.perc.genus,
Leaf.N.perc.species = Leaf.N.perc.species,
Seed.mass.focal = Seed.mass.focal,
Seed.mass.CWM.fill = Seed.mass.CWM.fill,
Seed.mass.perc.genus = Seed.mass.perc.genus,
Seed.mass.perc.species = Seed.mass.perc.species,
SLA.focal = SLA.focal,
SLA.CWM.fill = SLA.CWM.fill,
SLA.perc.genus = SLA.perc.genus,
SLA.perc.species = SLA.perc.species,
Wood.density.focal = Wood.density.focal,
Wood.density.CWM.fill = Wood.density.CWM.fill,
Wood.density.perc.genus = Wood.density.perc.genus,
Wood.density.perc.species = Wood.density.perc.species,
Max.height.focal = Max.height.focal,
Max.height.CWM.fill = Max.height.CWM.fill,
Max.height.perc.genus = Max.height.perc.genus,
Max.height.perc.species = Max.height.perc.species
)
return(data)
}
fun.CWM.abs.trait <- function(trait, data){
trait <- paste(trait, 'mean', sep = '.')
perc.BA <- data[['BA.w']]/sum(data[['BA.w']])
res <- apply(perc.BA*abs(outer(data[[trait]], data[[trait]], '-')), 2, mean)
return(res)
}
fun.CWM.abs.all <- function(df, traits = c("Leaf.N", "Seed.mass", "SLA",
"Wood.density", "Max.height")){
names.abs <- paste(traits, "abs.CWM.fill", sep = '.')
df.res <- as.data.frame(lapply(traits, fun.CWM.abs.trait, data = df))
names(df.res) <- names.abs
df.res[['obs.id']] <- df[['obs.id']]
return(df.res)
}
fun.CWM.Tn <- function(data){
# comput CWM and perc
data.plot<- group_by(data, plot.c) %>%
summarise(
......@@ -509,7 +519,11 @@ fun.CWM.traits.all.plot.census.dplyr <- function(data,data.TRAITS){
Wood.density.CWM.fill = (Wood.density.CWM.fill - BA.w*Wood.density.mean)/BATOT,
Max.height.CWM.fill = (Max.height.CWM.fill - BA.w*Max.height.mean)/BATOT,
Seed.mass.CWM.fill = (Seed.mass.CWM.fill - BA.w*Seed.mass.mean)/BATOT)
# set trait to NA for species with missing species
return(data)
}
fun.traits.focal <- function(data){
data <- data %>%
mutate(
Leaf.N.focal = ifelse(is.na(Leaf.N.genus) |
......@@ -536,25 +550,33 @@ fun.CWM.traits.all.plot.census.dplyr <- function(data,data.TRAITS){
select(-Leaf.N.mean, -SLA.mean,
-Wood.density.mean, -Max.height.mean,
-Seed.mass.mean)
return(data)
}
fun.CWM.abs.trait <- function(trait, data){
trait <- paste(trait, 'mean', sep = '.')
perc.BA <- data[['BA.w']]/sum(data[['BA.w']])
res <- apply(perc.BA*abs(outer(data[[trait]], data[[trait]], '-')), 2, mean)
return(res)
}
fun.CWM.abs.all <- function(df, traits = c('SLA', 'Leaf.N',
'Wood.density', 'Max.height',
'Seed.mass')){
names.abs <- paste(traits, "abs.CWM.fill", sep = '.')
df.res <- as.data.frame(lapply(traits, fun.CWM.abs.trait, data = df))
names(df.res) <- names.abs
df.res[['obs.id']] <- df[['obs.id']]
return(df.res)
fun.CWM.traits.all.plot.census.dplyr <- function(data,data.TRAITS){
require(dplyr)
data <- tbl_df(data)
data <- mutate(data,
plot.c = paste(plot, census, sep ='_'),
BA.w = BA.fun(D, weights))
# merge traits
data <- left_join(data, data.TRAITS, by = 'sp')
data <- fun.fill.missing.traits(data)
# compute CWM Tn and BATOT
data <- fun.CWM.Tn(data)
# compute CWM abs
data.CWM.abs <- data %>% group_by(plot.c) %>%
do(fun.CWM.abs.all(.)) %>%
ungroup() %>% select(-plot.c)
data <- left_join(data, data.CWM.abs, by = 'obs.id')
# set trait to NA for species with missing species
data <- fun.traits.focal(data)
data <- fun.order.colums(data)
return(data)
}
##### function to generate data in good format per ecoregion
......@@ -648,7 +670,8 @@ for (i in unique(data$ecocode)){
data.tree = data.t,
data.TRAITS=data.TRAITS,
Rlim = Rlim, xy.name = xy.name)
data.CWM <- do.call(rbind, list.CWM.data)
require(dplyr)
data.CWM <- rbind_all(list.CWM.data)
### create data frame and merge
data.merged <- fun.merged.DT(data.t, data.CWM, "obs.id")
## REMOVE TREE IN BUFFER ZONE
......@@ -656,7 +679,7 @@ for (i in unique(data$ecocode)){
cat("dim after buffer tree removed", dim(data.merged),
'vs ', dim(data.t), "\n")
## add Phylo.group and Pheno.T to the data
data.merged <- merge(data.merged,
data.merged <- left_join((data.merged,
data.TRAITS[, c("sp", "Phylo.group",
"Pheno.T", 'LeafType.T')],
by="sp")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment