diff --git a/R/FUN.TRY.R b/R/FUN.TRY.R index b331511784598c0cf8151879e0e5e3dda6138c46..fe88a61992c03cbb7eac2762dbace3c4c18dcf5f 100644 --- a/R/FUN.TRY.R +++ b/R/FUN.TRY.R @@ -288,3 +288,62 @@ fun.extract.format.sp.traits.TRY <- function(sp, sp.syno.table, data) { } + +fun.extract.format.sp.traits.TRY <- function(sp, sp.syno.table, data,name.match.sp="Latin_name_syn",name.match.traits="Latin_name") { + ## check syno data if not create a table with column syno repating the species + + ### test data sp and sp.syno.table match + if (sum(!(sp %in% sp.syno.table[["sp"]])) > 0) + stop("not same species name in sp and sp.syno.table") + if (sum((sp.syno.table[[name.match.sp]] %in% data[[name.match.traits]])) == + 0) + stop("not a single similar species name in sp and Traits data") + ## traits to extract + traits <- c("Leaf.N", "Seed.mass", + "SLA", "Wood.Density") + + ### NEED TO ADD TEST IF SD available in the data + if(sum(grepl("sd",names(data)))>0) SD.TF <- TRUE + + ## check traits available +traits.mean <- names(data)[(names(data) %in% paste(traits,"mean",sep="."))] +if (SD.TF) traits.sd <- names(data)[(names(data) %in% paste(traits,"sd",sep="."))] + + #### TO CHANGE HERE !!!! + res.list <- lapply(sp, FUN = fun.species.traits, species.table = sp.syno.table, + traits = traits, data = data) + names(res.list) <- sp + + ##### TRANSFORM LIST IN A TABLE + extract.species.try <- fun.turn.list.in.DF(sp, res.list) + + ##### TODO ADD A TEST OF GOOD EXTRACTION OF TRAITS + test.num <- sample((1:length(sp))[!is.na(extract.species.try[["SLA.mean"]])],1) + + if( extract.species.try[test.num,"SLA.mean"] != fun.species.traits(sp[test.num], species.table = sp.syno.table, + traits = traits, data = data)$mean[grep("SLA",traits)]) stop('traits value not good for the species in extraction from TRY') + ############### add mean sd of species or genus if we want to use that + sd.vec.sp <- readRDS(file = "./data/process/sd.vec.sp.rds") + sd.vec.genus <- readRDS(file = "./data/process/sd.vec.genus.rds") + + sd.names <- paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.Density"), + "sd", sep = ".") + genus.names <- paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.Density"), + "genus", sep = ".") + ### add columns + extract.species.try.2 <- data.frame(extract.species.try, + extract.species.try[,sd.names], stringsAsFactors =FALSE) + + ## update value + sd.names.1 <- paste(sd.names, 1, sep = ".") + for (i in 1:length(sd.names.1)) { + extract.species.try.2[[sd.names.1[i]]][!extract.species.try.2[[genus.names[i]]]] <- sd.vec.sp[i] + extract.species.try.2[[sd.names.1[i]]][extract.species.try.2[[genus.names[i]]]] <- sd.vec.genus[i] + } + data.frame.TRY <- data.frame(sp = sp, Latin_name = sp.syno.table[["Latin_name_syn"]], + extract.species.try.2, stringsAsFactors =FALSE) + if (sum(!data.frame.TRY[["sp"]] == sp) > 0) + stop("Wrong order of species code") + return(data.frame.TRY) +} + diff --git a/merge.data.BCI.R b/merge.data.BCI.R index f23adfc8be77406a49e0425f375c43b44f45f6b7..2c93036a16131ee8a187758976bfcd3a28db9e1c 100644 --- a/merge.data.BCI.R +++ b/merge.data.BCI.R @@ -72,6 +72,8 @@ data.trait$HEIGHT_SEM <- data.trait$HEIGHT_N <- data.trait$HEIGHT_AVG <- NULL # 20:21)], by = "Latin", all.x = T) +## NO NEED TO MERGE NEED TO DECIDE STANDARD STRUCTURE FOR TRAITS AS TRY !! + ########################################## FORMAT INDIVIDUAL TREE DATA data.bci <- data.bci[order(data.bci[["TreeID"]]),] data.bci$Date1 <- as.Date(data.bci$Date1) @@ -80,6 +82,9 @@ data.bci$Date2 <- as.Date(data.bci$Date2) # data.bci$yr2 <- format(strptime(data.bci$Date2, format = '%Y-%m-%d'),'%Y') data.bci$year <- as.numeric(difftime(data.bci$Date2, data.bci$Date1, units = "weeks")/52) ## Not rounded data.bci$obs.id <- apply(data.bci[,c("TreeID","Census")],1,paste,collapse="_") +data.bci$treeid <- data.bci$TreeID +data.bci$x <- data.bci$gx +data.bci$y <- data.bci$gy ## change unit and names of variables to be the same in all data for the tree data.bci$G <- 10 * (data.bci$DBH1 - data.bci$DBH1)/data.bci$year ## diameter growth in mm per year - BASED ON UNROUNDED YEARS @@ -87,7 +92,6 @@ data.bci$D <- data.bci[["DBH1"]] data.bci$plot <- data.bci[["Quadrat"]] ## plot code? data.bci$htot <- NA data.bci$sp.name <- data.bci$Latin -data.bci$weights <- 1/(pi*(0.5*data.bci$D/100)^2) ###################### ECOREGION bci has only 1 eco-region ###################### PERCENT DEAD variable percent dead/cannot do with since dead variable is @@ -101,10 +105,10 @@ data.bci <- merge(data.bci, data.frame(plot = names(perc.dead), perc.dead = perc table(data.bci$dead) data.bci <- data.bci[data.bci$dead == 0,] -vec.abio.var.names <- c("MAT", "MAP") ## MISSING +## vec.abio.var.names <- NA ## MISSING vec.basic.var <- c("treeid", "sp", "sp.name", "plot", "D", "G", "dead", "year", "htot", "x", "y", "perc.dead") -data.tree <- subset(data.bci, select = c(vec.basic.var, vec.abio.var.names)) +data.tree <- subset(data.bci, select = c(vec.basic.var)) ############################################## COMPUTE MATRIX OF COMPETITION INDEX WITH SUM OF BA PER SPECIES IN EACH PLOT in ############################################## m^2/ha without the target species