#' Wood product amounts
#'
#' Estimation of the biomass (kg/ha) or volume (m3/ha) corresponding to wood products obtained from a set of plots, given a tree list of cuts
#'
#' @param x A data frame with tree records in rows and columns 'Species', 'DBH' (in cm), 'H' (in m) and 'N' (ha-1)
#' @param productDestination Data frame of product destination by species and diameter class
#' @param variable Either 'biomass' (default) or 'volume'
#' @param ... Additional parameters for \code{\link{IFNbiomass}} or \code{\link{IFNvolume}}
#'
#'
#' @details Calls either \code{\link{IFNbiomass}} or \code{\link{IFNvolume}} using diameter classes and then translates the result into products
#' using table \code{productDestination}. Biomass values include different products, stumps as well as fine (leaves, needles, bark), medium (branches) and coarse (stems) slash.
#' Volume values refer to coarse slash (stems) and the volume of different products.
#'
#' @name IFNproducts
#' @return Function \code{IFNproducts} returns a data frame with the biomass (kg/ha) or volume (m3/ha) of products (as well as that of slash), assuming trees have been felled down.
#'
#' @examples
#' data(exampleTreeData)
#' data(defaultProductsCAT)
#'
#' # Translation into product biomass (kg dry/ha)
#' IFNproducts(exampleTreeData, defaultProductsCAT)
#'
#' # Translation into product volume (m3/ha)
#' IFNproducts(exampleTreeData, defaultProductsCAT, variable = "volume")
IFNproducts<-function(x, productDestination, variable = "biomass",...) {
variable = match.arg(variable, c("biomass", "volume"))
DBHclasslimits = seq(2.5,102.5, by=5)
DBHmid = seq(5,100, by=5)
sp_vec = as.character(productDestination$species)
ss = strsplit(sp_vec, split=",")
products = names(productDestination)[-c(1:4)]
if(variable=="biomass") destination = c("stumps","coarse_slash","medium_slash", "fine_slash", products)
else destination = c("slash", products)
getStemProductProps<-function(sp, DC) {
sprows = which(unlist(lapply(ss, function(x){sp %in% x})))
if(length(sprows)==0) return(NULL)
DCs = productDestination$DC[sprows]
if(length(sprows)==1) return(as.list(productDestination[sprows,-c(1:3)]))
if(DC %in% DCs) return(as.list(productDestination[which(DCs==DC),-c(1:3)]))
return(as.list(productDestination[which(DCs==max(DCs)),-c(1:3)]))
}
translateBiomassToDestiny<-function(Bs) {
Bs$DBHmid = DBHmid[as.numeric(Bs$DBHclass)]
Bs$DBHmid[is.na(Bs$DBHmid)] = 100
res = data.frame(matrix(0, nrow=nrow(Bs), ncol = length(destination)))
names(res)<- destination
row.names(res)<-1:nrow(res)
#Set missing values to zero
Bs$Roots[is.na(Bs$Roots)] = 0
Bs$Needles[is.na(Bs$Needles)] = 0
Bs$Leaves[is.na(Bs$Leaves)] = 0
Bs$Bark[is.na(Bs$Bark)] = 0
Bs$Branches[is.na(Bs$Branches)] = 0
Bs$Stem[is.na(Bs$Stem)] = 0
#assign
res$stumps =Bs$Roots
res$fine_slash = Bs$Leaves + Bs$Needles + Bs$Bark + Bs$Branches
res$medium_slash = Bs$Bark + Bs$Branches
for(i in 1:nrow(Bs)) {
p = getStemProductProps(Bs$Species[i], Bs$DBHmid[i])
if(!is.null(p)) {
res[i,"coarse_slash"] = Bs$Stem[i]*as.numeric(p["slash"])
res[i, products] = Bs$Stem[i]*(1-as.numeric(p["slash"]))*as.numeric(p[products])
}
}
return(res)
}
translateVolumeToDestiny<-function(Vs) {
Vs$DBHmid = DBHmid[as.numeric(Vs$DBHclass)]
Vs$DBHmid[is.na(Vs$DBHmid)] = 100
res = data.frame(matrix(0, nrow=nrow(Vs), ncol = length(destination)))
names(res)<- destination
row.names(res)<-1:nrow(res)
#assign
for(i in 1:nrow(Vs)) {
p = getStemProductProps(Vs$Species[i], Vs$DBHmid[i])
if(!is.null(p)) {
res[i,"slash"] = Vs$VCC[i]*as.numeric(p["slash"])
res[i, products] = Vs$VCC[i]*(1-as.numeric(p["slash"]))*as.numeric(p[products])
}
}
return(res)
}
isSteps = "Step" %in% names(x)
if(isSteps) {
steps = unique(x$Step)
numSteps = length(steps)
res = NULL
res_ha = NULL
for(i in 1:length(steps)) {
if(variable == "biomass") {
Bs = IFNbiomass(x[x$Step==steps[i],], DBHclasses = DBHclasslimits, ...)
prodi = translateBiomassToDestiny(Bs)
y = cbind(Bs[,1:6], prodi)
res_i = y%>% dplyr::group_by(ID, Species, Name, SpeciesAllom, NameAllom) %>%
dplyr::summarize_at(destination, sum, na.rm=T) %>%
tibble::add_column(Step = steps[i], .before = "Species")
} else {
Vs = IFNvolume(x[x$Step==steps[i],], DBHclasses = DBHclasslimits, ...)
prodi = translateVolumeToDestiny(Vs)
y = cbind(Vs[,1:4], prodi)
res_i = y%>% dplyr::group_by(ID, Species, Name) %>%
dplyr::summarize_at(destination, sum, na.rm=T) %>%
tibble::add_column(Step = steps[i], .before = "Species")
}
if(is.null(res)) {
res = res_i
} else {
res = dplyr::bind_rows(res, res_i)
}
}
} else {
if(variable=="biomass") {
Bs = IFNbiomass(x, DBHclasses = DBHclasslimits, ...)
prod = translateBiomassToDestiny(Bs)
y = cbind(Bs[,1:6], prod)
res = y%>% dplyr::group_by(ID, Species, Name, SpeciesAllom, NameAllom) %>%
dplyr::summarize_at(destination, sum, na.rm=T)
} else {
Vs = IFNvolume(x, DBHclasses = DBHclasslimits, ...)
prod = translateVolumeToDestiny(Vs)
y = cbind(Vs[,1:4], prod)
res = y%>% dplyr::group_by(ID, Species, Name) %>%
dplyr::summarize_at(destination, sum, na.rm=T)
}
}
return(as.data.frame(res))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.