trait-fun.R 17.4 KB
Newer Older
1
################# FUNCTION TO EXTRACT DECTED OUTLIER AND FORMAT TRY DATA Georges Kunstler
2
############################################ 14/06/2013
davidcoomes's avatar
davidcoomes committed
3
### just testing this out! ##############
Georges Kunstler's avatar
Georges Kunstler committed
4

5

6
### install all unstallled packages
7
source("R/packages.R")
Georges Kunstler's avatar
Georges Kunstler committed
8
check_packages(c("MASS", "doParallel","mvoutlier","plyr","gdata"))
Georges Kunstler's avatar
Georges Kunstler committed
9

Georges Kunstler's avatar
Georges Kunstler committed
10
11
12
13
14
15
16
17
18
19
20
21
22
23


## fun detect outlier
fun.detect.outlier <- function(x.na){
    x <- x.na[!is.na(x.na)]
    x.num <- (1:length(x.na))[!is.na(x.na)]
    TF.vec <- rep(FALSE, length(x.na))
 fit.dist <- fitdistr((na.omit(x)), "normal")
 high.bound <- fit.dist$estimate["mean"] + 2 * (fit.dist$estimate["sd"] + 
 fit.dist$sd["sd"])
 low.bound <- fit.dist$estimate["mean"] - 2 * (fit.dist$estimate["sd"] + fit.dist$sd["sd"])
       TF.vec[x.num[(x) > high.bound | (x) < low.bound]] <- TRUE
return(TF.vec)
}
24
## outlier detection based on Kattage et al 2011
Georges Kunstler's avatar
Georges Kunstler committed
25
26
27
28
29
30
31
32
##' Detection of univar outlier based on method of Kattge et al. 2011
##'
##' 
##' @title 
##' @param x.na 
##' @param log 
##' @return TRUE FALSE vector to identify outlier TRUE : outlier
##' @author Kunstler
33
34
fun.out.TF2 <- function(x.na, log = TRUE) {
    if (log) {
Georges Kunstler's avatar
Georges Kunstler committed
35
        TF.vec <- fun.detect.outlier(log10(x.na))
36
    } else {
Georges Kunstler's avatar
Georges Kunstler committed
37
        TF.vec <- fun.detect.outlier((x.na))
38
39
    }
    return((TF.vec))
Georges Kunstler's avatar
Georges Kunstler committed
40
41
}

42
43
44
45
######################## FUNCTION TO COMPUTE QUANTILE FOR HEIGHT
f.quantile <- function(x, ind, probs) {
    quantile(x[ind], probs = probs, na.rm = TRUE)
}
Georges Kunstler's avatar
Georges Kunstler committed
46

47
f.quantile.boot2 <- function(x, R, probs = 0.99) {
48
    require(boot, quietly=TRUE)
49
50
51
52
53
54
    if (length(na.exclude(x)) > 0) {
        quant.boot <- boot(x, f.quantile, R = R, probs = probs)
        return(c(mean = mean(quant.boot$t), sd = sd(quant.boot$t), nobs = length(na.exclude(x))))
    } else {
        return(c(mean = NA, sd = NA, nobs = NA))
    }
55
}
Georges Kunstler's avatar
Georges Kunstler committed
56

57
58
59
60
61
##################### FUNcCTION TO COMPUTE MEAN SD AND NOBS WITH OR WITHOUT OUTLIER
fun.mean.sd.nobs.out <- function(x, i) {
    if (length(x) > 50) {
        ## if more than 50 obs remove outlier
        outlier <- fun.out.TF2(x.na = x, log = TRUE)
62
            res.temp <- c(mean((x[!outlier])), sd((x[!outlier])), length(x[!outlier]))
63
        
64
    } else {
65
            res.temp <- c(mean((x)), sd((x)), length(x))
66
67
68
    }
    return(res.temp)
}
69

70
## TRY mean no experimental data
Georges Kunstler's avatar
Georges Kunstler committed
71
72
73
74
75
76
77
fun.mean.per.sp.noexp <- function(i,data,species.syno){
x <- data[[i]][data$Latin_name %in% species.syno & (!is.na(data[[i]])) & 
                  (!data[["TF.exp.data"]])]
res.temp <- fun.mean.sd.nobs.out(x, i)
names(res.temp) <- c('mean','sd','nobs')
return(data.frame(t(res.temp),exp=FALSE,genus=FALSE))
}
78
## TRY mean with experimental data
Georges Kunstler's avatar
Georges Kunstler committed
79
80
81
82
83
84
fun.mean.per.sp.exp <- function(i,data,species.syno){
x <- data[[i]][data$Latin_name %in% species.syno & (!is.na(data[[i]]))]
res.temp <- fun.mean.sd.nobs.out(x, i)
names(res.temp) <- c('mean','sd','nobs')
return(data.frame(t(res.temp),exp=TRUE,genus=FALSE))
}
85
## Genus mean if species not available
Georges Kunstler's avatar
Georges Kunstler committed
86
87
88
89
90
91
92
fun.mean.per.genus.exp <- function(i,data,genus){
x <- data[[i]][grepl(genus, data$Latin_name, fixed = TRUE) & 
                  (!is.na(data[[i]]))]
res.temp <- fun.mean.sd.nobs.out(x, i)
names(res.temp) <- c('mean','sd','nobs')
return(data.frame(t(res.temp),exp=TRUE,genus=TRUE))
}
93
## apply noexp exp or genus depending on the available data
Georges Kunstler's avatar
Georges Kunstler committed
94
fun.mean.if.sp.exp.genus <- function(i,data,species.syno){
95
    res.temp <- data.frame(mean=NA,sd=NA,nobs=NA,exp=NA,genus=FALSE)
Georges Kunstler's avatar
Georges Kunstler committed
96
        if (sum((data$Latin_name%in% species.syno) & !is.na(data[[i]])) > 0) {
97
            ## if data for this species or syno 
Georges Kunstler's avatar
Georges Kunstler committed
98
            if (sum((data$Latin_name %in% species.syno) & (!is.na(data[[i]])) & 
99
                (!data[["TF.exp.data"]])) > 0) {
100
                #if data with out experiments
Georges Kunstler's avatar
Georges Kunstler committed
101
                res.temp <- fun.mean.per.sp.noexp(i,data,species.syno)
102
103
            } else {
                ### include experimental data
Georges Kunstler's avatar
Georges Kunstler committed
104
                res.temp <- fun.mean.per.sp.exp(i,data,species.syno)
105
106
107
            }
        } else {
            ### compute data at genus level if no data for the species
Georges Kunstler's avatar
Georges Kunstler committed
108
            genus <- unique(sub(" .*", "", species.syno))
Georges Kunstler's avatar
Georges Kunstler committed
109
            if (sum(grepl(genus, data$Latin_name) & (!is.na(data[[i]]))) > 0) {
Georges Kunstler's avatar
Georges Kunstler committed
110
                res.temp <- fun.mean.per.genus.exp(i,data,genus)
111
112
            }
        }
Georges Kunstler's avatar
Georges Kunstler committed
113
        return(res.temp)
Georges Kunstler's avatar
Georges Kunstler committed
114
    }
Georges Kunstler's avatar
Georges Kunstler committed
115
116
117
118
119
120
121

################################### extract mean sd per species or genus added species synonyme
fun.species.traits <- function(species.code, species.table, col.sp = "sp", col.sp.syno = "Latin_name_syn", 
    traits, data) {
    species.syno <- species.table[species.table[[col.sp]] == species.code, col.sp.syno]
    DF <- do.call("rbind",lapply(traits,fun.mean.if.sp.exp.genus,data,species.syno))
    return(list(mean = DF[["mean"]], sd = DF$sd, exp = DF$exp, genus = DF$genus, nobs = DF$nobs))
Georges Kunstler's avatar
Georges Kunstler committed
122
123
124
}


125
126
127
128
####################### FUNCTIONS TO Manipulate species names
fun.get.genus <- function(x) gsub(paste(" ", gsub("^([a-zA-Z]* )", "", x), sep = ""), 
    "", x, fixed = TRUE)
trim.trailing <- function(x) sub("\\s+$", "", x)
Georges Kunstler's avatar
Georges Kunstler committed
129

130

Georges Kunstler's avatar
Georges Kunstler committed
131
132
133
134
135
fun.compute.mean.genus <- function(latin_name,data,var){
 genus <- unique(sub(" .*", "", latin_name))
return(fun.mean.per.genus.exp(var,data,genus)[,c(1,2,5)])
}

136
#################################################################################
137
####################################### FUN TO EXTRACT FOR A GIVEN DATA BASE
138

139
### function top turn teh result of lapply from a list to a data frame with good structure
140
141
142
143
144
145
146
fun.turn.list.in.DF <- function(sp, res.list) {
    data.mean <- t(sapply(sp, FUN = function(i, res.list) res.list[[i]]$mean, res.list = res.list))
    data.sd <- t(sapply(sp, FUN = function(i, res.list) res.list[[i]]$sd, res.list = res.list))
    data.exp <- t(sapply(sp, FUN = function(i, res.list) res.list[[i]]$exp, res.list = res.list))
    data.genus <- t(sapply(sp, FUN = function(i, res.list) res.list[[i]]$genus, res.list = res.list))
    data.nobs <- t(sapply(sp, FUN = function(i, res.list) res.list[[i]]$nobs, res.list = res.list))
    ## create data.frame withh all observation
147
148
    extract.species.try <- data.frame(sp,data.mean, data.sd, data.exp, data.genus, data.nobs, stringsAsFactors =FALSE)
    names(extract.species.try) <- c("sp",paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.density"), "mean", sep = "."),
Georges Kunstler's avatar
Georges Kunstler committed
149
150
151
152
                                    paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.density"), "sd", sep = "."),
                                    paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.density"), "exp", sep = "."),
                                    paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.density"), "genus", sep = "."),
                                    paste(c("Leaf.N", "Seed.mass", "SLA", "Wood.density"), "nobs", sep = "."))
153
    return(extract.species.try)
154
155
}

156
157
158
##########################
##### FUNCTION TO EXTRACT TRY DATA FOR A SPECIES NEED TO DOCUMENT 
fun.extract.format.sp.traits.TRY <- function(sp, sp.syno.table, data) {  
159
    ### test data sp and sp.syno.table match
Georges Kunstler's avatar
Georges Kunstler committed
160
    require(gdata)
161
162
    sp.syno.table[["Latin_name_syn"]]  <- trim(sp.syno.table[["Latin_name_syn"]] )
    data[["Latin_name"]] <- trim(data[["Latin_name"]])
Georges Kunstler's avatar
Georges Kunstler committed
163
164
    sp.syno.table[["Latin_name_syn"]][is.na(sp.syno.table[["Latin_name_syn"]])] <- "missing"
    sp.syno.table[["Latin_name"]][is.na(sp.syno.table[["Latin_name"]])] <- "missing"
165
166
    if (sum(!(sp %in% sp.syno.table[["sp"]])) > 0) 
        stop("not same species name in sp and sp.syno.table")
Georges Kunstler's avatar
Georges Kunstler committed
167
    if (sum((sp.syno.table[["Latin_name_syn"]] %in% data[["Latin_name"]])) == 
168
169
        0) 
        stop("not a single similar species name in sp and TRY")
170
    ## traits to extract
Georges Kunstler's avatar
Georges Kunstler committed
171
    traits <- c("Leaf.N", "Seed.mass", "SLA", "Wood.density")
172
    # lapply to extract
173
    res.list <- lapply(sp, FUN = fun.species.traits, species.table = sp.syno.table, 
174
                       traits = traits, data = data)
175
    names(res.list) <- sp 
176
    ##### TRANSFORM LIST INTO A TABLE
177
    extract.species.try <- fun.turn.list.in.DF(sp , res.list)
178
    ##### TEST OF GOOD EXTRACTION OF TRAITS
Georges Kunstler's avatar
Georges Kunstler committed
179
     test.num <- sample((1:length(sp))[!is.na(extract.species.try[["SLA.mean"]])],1)
180
    if( all.equal(extract.species.try[test.num,"SLA.mean"] ,
181
       fun.species.traits(sp[test.num], species.table = sp.syno.table, 
182
        traits = traits, data = data)$mean[grep("SLA",traits)])!=TRUE)
183
        stop('traits value not good for the  species in extraction from TRY')
Georges Kunstler's avatar
Georges Kunstler committed
184
## keep only a subset of var
185
186
187
188
    vars.keep <- c( "Leaf.N.mean","Seed.mass.mean", "SLA.mean","Wood.density.mean",
               "Leaf.N.sd","Seed.mass.sd","SLA.sd","Wood.density.sd",
               "Leaf.N.genus","Seed.mass.genus", "SLA.genus" ,
               "Wood.density.genus")
Georges Kunstler's avatar
Georges Kunstler committed
189
    extract.species.try <- subset(extract.species.try,select=vars.keep)
190
    data.frame.TRY <- data.frame(sp = sp, Latin_name = sp.syno.table[["Latin_name_syn"]], 
Georges Kunstler's avatar
Georges Kunstler committed
191
        extract.species.try, stringsAsFactors =FALSE)
192
193
194
    if (sum(!data.frame.TRY[["sp"]] == sp) > 0) 
        stop("Wrong order of species code")
    return(data.frame.TRY)
195
196
}

197

Georges Kunstler's avatar
Georges Kunstler committed
198
199
200
201
202
##############################
##############################
### NO TRY TRAITS
### function to return mean and sd of traits per species or at genus level in a single line data.frame

203
204
205
206
207
208
209
210
fun.sp.mean.noTRY <- function(traits.mean.t,Latin_name,data,name.match.traits){
        mean.vec <-mean( (data[data[[name.match.traits]] %in% Latin_name,traits.mean.t]))
        genus.vec <- FALSE
        sd.vec <- NA
        return(data.frame(mean=mean.vec,genus=genus.vec,sd=sd.vec))
    }

fun.genus.mean.noTRY <- function(traits.mean.t,Latin_name,data,name.match.traits){
Georges Kunstler's avatar
Georges Kunstler committed
211
212
       genus <- sub(" .*", "", Latin_name)
       genus.species <- sub(" .*", "", data[[name.match.traits]])
213
214
215
216
217
       mean.vec <-mean( (data[genus.species %in% genus,traits.mean.t]))
       genus.vec <- TRUE
       sd.vec <- NA
       return(data.frame(mean=mean.vec,genus=genus.vec,sd=sd.vec))
    }
Georges Kunstler's avatar
Georges Kunstler committed
218

219
220
221
222
223
224
225
fun.sp.or.genus.mean.noTRY <- function(traits.mean.t,Latin_name,data.tot,name.match.traits){
if(sum(!is.na(data.tot[[traits.mean.t]]))>0){    
   data <- data.tot[!is.na(data.tot[[traits.mean.t]]),]
    if(Latin_name %in% data[[name.match.traits]] ){
        res <- fun.sp.mean.noTRY(traits.mean.t,Latin_name,data,name.match.traits)
    }else{## do genus mean
        res <- fun.genus.mean.noTRY(traits.mean.t,Latin_name,data,name.match.traits)
Georges Kunstler's avatar
Georges Kunstler committed
226
227
    }
 }else{
228
      res <- data.frame(mean=NA,genus=NA,sd=NA)
Georges Kunstler's avatar
Georges Kunstler committed
229
 }
230
231
232
return(res)
}   

233
234
fun.spe.traits.notry <-  function(Latin_name,data.tot,traits.mean,traits.sd,
                                  name.match.traits="Latin_name",SD.TF){
235
236
237
238
239
require(gdata)
Latin_name <- trim(Latin_name)
data.tot[[name.match.traits]] <- trim(data.tot[[name.match.traits]])
DF.temp <- do.call("rbind",lapply(traits.mean,fun.sp.or.genus.mean.noTRY,Latin_name,data.tot,name.match.traits))
mean.vec <- DF.temp$mean
Georges Kunstler's avatar
Georges Kunstler committed
240
names(mean.vec) <-  traits.mean
241
sd.vec <- DF.temp$sd
Georges Kunstler's avatar
Georges Kunstler committed
242
names(sd.vec) <-  traits.sd
243
genus.vec <- DF.temp$genus
Georges Kunstler's avatar
Georges Kunstler committed
244
names(genus.vec) <-  sub("sd","genus",traits.sd)
Georges Kunstler's avatar
Georges Kunstler committed
245
extract.species.traits <- data.frame(t(mean.vec),t(sd.vec),t(genus.vec), stringsAsFactors = FALSE)
Georges Kunstler's avatar
Georges Kunstler committed
246
247
248
249
250
251
252
253
254
return(extract.species.traits)
}



###########
### FUNCTION TO EXTRACT ALL SPECIES 

fun.extract.format.sp.traits.NOT.TRY <- function(sp, Latin_name, data,name.match.traits="Latin_name") {
Georges Kunstler's avatar
Georges Kunstler committed
255
require(plyr)
Georges Kunstler's avatar
Georges Kunstler committed
256
    ### test data sp and sp.syno.table match
Georges Kunstler's avatar
Georges Kunstler committed
257
    if (sum((Latin_name %in% data[[name.match.traits]])) == 
Georges Kunstler's avatar
Georges Kunstler committed
258
259
260
261
        0) 
        stop("not a single similar species name in sp and Traits data")
    ## traits to extract
    traits <- c("Leaf.N", "Seed.mass", 
262
        "SLA", "Wood.density","Max.height")
Georges Kunstler's avatar
Georges Kunstler committed
263
264
265
266
267

    ### NEED TO ADD TEST IF SD available in the data
    if(sum(grepl("sd",names(data)))>0) SD.TF <- TRUE


Georges Kunstler's avatar
Georges Kunstler committed
268
269
270
traits.mean <- paste(traits,"mean",sep=".")
traits.genus <- paste(traits,"genus",sep=".")
if (SD.TF)     traits.sd <-  paste(traits,"sd",sep=".")
Georges Kunstler's avatar
Georges Kunstler committed
271

Georges Kunstler's avatar
Georges Kunstler committed
272
273
## extract data
extract.species.traits <- rbind.fill(lapply(Latin_name,FUN=fun.spe.traits.notry ,data,traits.mean,traits.sd,name.match.traits,SD.TF))
Georges Kunstler's avatar
Georges Kunstler committed
274

Georges Kunstler's avatar
Georges Kunstler committed
275
276
    data.frame.TRAITS <- data.frame(sp = sp, Latin_name=Latin_name , 
        extract.species.traits, stringsAsFactors =FALSE)
Georges Kunstler's avatar
Georges Kunstler committed
277
    if (sum(!data.frame.TRAITS[["sp"]] == sp) > 0) 
Georges Kunstler's avatar
Georges Kunstler committed
278
        stop("Wrong order of species code")
Georges Kunstler's avatar
Georges Kunstler committed
279
    return(data.frame.TRAITS)
Georges Kunstler's avatar
Georges Kunstler committed
280
281
}

282
283
## FUNCTION TO GET angio /confi genus is enough FROM TRY and Zanne
fun.get.cat.var.from.try <- function(sp,data.traits,try.cat,Pheno.Zanne){
Georges Kunstler's avatar
Georges Kunstler committed
284
 if (is.na(data.traits[data.traits$sp==sp,"Latin_name"])) data.traits[data.traits$sp==sp,"Latin_name"] <- "missing"
285
286
287
288
289
290
291
292
293
 if(sum(data.traits[data.traits$sp==sp,"Latin_name"] == try.cat$AccSpeciesName)>0){
     if(sum(data.traits[data.traits$sp==sp,"Latin_name"] ==
                           Pheno.Zanne$Binomial)>0){
            data.res <- data.frame(sp=sp,
                       Latin_name=data.traits[data.traits$sp==sp,"Latin_name"],
                       Phylo.group=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"PhylogeneticGroup"][1],
                       Pheno.T=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"LeafPhenology"][1],
Georges Kunstler's avatar
Georges Kunstler committed
294
295
                       LeafType.T=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"LeafType"][1],
296
297
298
299
300
301
302
303
304
305
                       Pheno.Z=Pheno.Zanne[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           Pheno.Zanne$Binomial,'Phenology'][1] ,
                       stringsAsFactors=FALSE)
        }else{
            data.res <- data.frame(sp=sp,
                       Latin_name=data.traits[data.traits$sp==sp,"Latin_name"],
                       Phylo.group=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"PhylogeneticGroup"][1],
                       Pheno.T=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"LeafPhenology"][1],
Georges Kunstler's avatar
Georges Kunstler committed
306
307
                       LeafType.T=try.cat[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           try.cat$AccSpeciesName,"LeafType"][1],
308
309
310
311
312
313
314
315
                       Pheno.Z=NA ,
                       stringsAsFactors=FALSE)
        }
 }else{
     if(sum(data.traits[data.traits$sp==sp,"Latin_name"] ==
                           Pheno.Zanne$Binomial)>0){
            data.res <- data.frame(sp=sp,
                       Latin_name=data.traits[data.traits$sp==sp,"Latin_name"],
Georges Kunstler's avatar
Georges Kunstler committed
316
                       Phylo.group=NA,
317
                       Pheno.T=NA,
Georges Kunstler's avatar
Georges Kunstler committed
318
                       LeafType.T=NA,
319
320
321
322
323
324
                       Pheno.Z=Pheno.Zanne[data.traits[data.traits$sp==sp,"Latin_name"] ==
                           Pheno.Zanne$Binomial,'Phenology'][1] ,
                       stringsAsFactors=FALSE)
        }else{
            data.res <- data.frame(sp=sp,
                       Latin_name=data.traits[data.traits$sp==sp,"Latin_name"],
Georges Kunstler's avatar
Georges Kunstler committed
325
                       Phylo.group=NA,
326
                       Pheno.T=NA,
Georges Kunstler's avatar
Georges Kunstler committed
327
                       LeafType.T=NA,
328
329
330
331
                       Pheno.Z=NA ,
                       stringsAsFactors=FALSE)
        }
 }    
Georges Kunstler's avatar
Georges Kunstler committed
332
333
334
335
336
337
338
339

## if missing value for Phylo.group check genus
    if(is.na(data.res$Phylo.group)) {
      genus <- sub(" .*", "", data.traits[data.traits$sp==sp,"Latin_name"])
      genus.vec <- sub(" .*", "", try.cat$AccSpeciesName)
      data.res$Phylo.group <- try.cat[genus == genus.vec,"PhylogeneticGroup"][1]
    }
  return(data.res)    
340
}
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364


## change factor of categorical variable try

fun.change.factor.pheno.try <- function(data.cat.extract){
data.cat.extract[data.cat.extract$Pheno.T=='deciduous'
                 & !is.na(data.cat.extract$Pheno.T),'Pheno.T'] <- 'D'
data.cat.extract[data.cat.extract$Pheno.T=='evergreen'
                 & !is.na(data.cat.extract$Pheno.T),'Pheno.T'] <- 'EV'
data.cat.extract[data.cat.extract$Pheno.T=='deciduous/evergreen'
                 & !is.na(data.cat.extract$Pheno.T),'Pheno.T'] <- 'D_EV'
return(data.cat.extract)
}

fun.change.factor.angio.try <- function(data.cat.extract){
data.cat.extract[data.cat.extract$Phylo.group=='Angiosperm_Magnoliid'
                 & !is.na(data.cat.extract$Phylo.group),'Phylo.group'] <- 'Angiosperm'
data.cat.extract[data.cat.extract$Phylo.group=='Angiosperm_Eudicotyl'
                 & !is.na(data.cat.extract$Phylo.group),'Phylo.group'] <- 'Angiosperm'
data.cat.extract[data.cat.extract$Phylo.group=='Angiosperm_Monocotyl'
                 & !is.na(data.cat.extract$Phylo.group),'Phylo.group'] <- 'Angiosperm'
return(data.cat.extract)
}

Georges Kunstler's avatar
Georges Kunstler committed
365
366
367
368
369
370
371
372
373
fun.change.factor.leaftype.try <- function(data.cat.extract){
data.cat.extract[data.cat.extract$LeafType.T=='broadleaved'
                 & !is.na(data.cat.extract$LeafType.T),'LeafType.T'] <- 'broadleaved'
data.cat.extract[data.cat.extract$LeafType.T!='broadleaved'
                 & !is.na(data.cat.extract$LeafType.T),'LeafType.T'] <- 'No.broadleaved'
return(data.cat.extract)
}


374
375
376
377
378
# fill missing TRY deciduous/evergreen by Zanne
fun.fill.pheno.try.with.zanne <- function(data.cat.extract){
data.cat.extract[is.na(data.cat.extract$Pheno.T),'Pheno.T'] <- data.cat.extract[is.na(data.cat.extract$Pheno.T),'Pheno.Z']
return(data.cat.extract)
}
Georges Kunstler's avatar
Georges Kunstler committed
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

## compute perc of traits cover per species
fun.compute.perc.cover.one.trait <- function(trait, data) {
t.mean <- paste(trait,"mean",sep=".")
t.genus <- paste(trait,"genus",sep=".")
sp.perc <- sum(!is.na(data[[t.mean]]) & !data[[t.genus]])/nrow(data)
genus.perc <- sum(!is.na(data[[t.mean]]))/nrow(data)
return( c(sp.perc=sp.perc,genus.perc=genus.perc) )
}

#### function to combine nontry with try data
fun.combine.nontry.and.try <- function(trait, data1, data2) {
t.mean <- paste(trait,"mean",sep=".")
t.genus <- paste(trait,"genus",sep=".")
for (i in 1:length(t.mean)) {
    data1[is.na(data1[[t.mean[i]]]),
          c(t.mean[i],t.genus[i])] <- data2[is.na(data1[[t.mean[i]]]),
                                            c(t.mean[i],t.genus[i])]
    }

return( data1 )
}