R/biomassTree.R
In hansoleorka/skogR: Norske skogfunksjoner (Norwegian Forestry Functions)
Defines functions
biomassTree
Documented in
biomassTree
#' BIOMASS FUNCTIONS
#'
#' Single-tree biomass functions for spruce, pine and birch.
#'
#' @name biomassTree
#'
#' @param d Numerical vector with diameter at breast height (cm)
#' @param h Numerical vector with tree heights (m)
#' @param sp Numerical vector with tree species (1 = Norway spruce, 2 = Scots Pine, 3 = Birch)
#' @param components String vector specifying which biomass components to return:
#'
#' \itemize{
#' \item \bold{sb} Biomass of stem bark
#' \item \bold{sw} Stem wood biomass
#' \item \bold{st} Total stem biomass (independent model including sw and sb)
#' \item \bold{fl} Foliage biomass
#' \item \bold{cr} Crown biomass
#' \item \bold{br} Branch biomass (sum of predictions of cr + fl)
#' \item \bold{db} Biomass of dead branches
#' \item \bold{su} Stump biomass
#' \item \bold{rf} Biomass of fine roots
#' \item \bold{rc} Biomass of coarse roots
#' \item \bold{rs} Biomass of roots (sum of predictions of rc + rf)
#' \item \bold{sr} Biomass of stump-root system
#' \item \bold{ab} Total aboveground biomass (sum of predictions of sw + sb + cr + su + db)
#' \item \bold{bg} Total belowground biomass (using Petersson & Ståhl 2006)
#' \item \bold{tb} Total tree biomass (sum of predictions of ab + bg)
#'
#'
#' \item \bold{all} All the above components
#' }
#'
#' @return A data frame with the dry weight biomass (kg) for the specified components. Column names and order will be the same as in components.
#'
#' @note \code{h} is optional. Functions with diameter as the only expl. variable will be used if h is not given. \cr\cr
#' According to FAO the stump is included in the above-ground biomass. \bold{su} is subtracted from the below-ground biomass
#' calculated using Petterson & Ståhl's function, since this initially includes the stump. \cr\cr
#' \bold{su} and \bold{sr} are for birch calculated using the function for pine. \cr\cr
#' \bold{fl}, \bold{rf} and \bold{rc} are for birch calculated as \bold{sw}*f, where f is a factor derived from ??
#'
#' @references Marklund, L.G., 1988. Biomass functions for pine,
#' spruce and birch in Sweden (Report No. 45). Swedish University of Agricultural Sciences, Umeå.
#' @references Petersson, H. & Ståhl, G. 2006. Functions for below-ground biomass of Pinus sylvestris, Picea abies, Betula pendula and Betula pubescens in Sweden.
#' Scandinavian Journal of Forest Research 21(Suppl 7): 84-93
#' @references FAO, 2010. Global Forest Resources Assessement 2010 - Terms and definitions.
#' Food and Agriculture Organization of the United Nations Working paper 144/E.
#'
#' @author Marius Hauglin & Ole Martin Bollandsås (2013-2017) \email{marius.hauglin@@gmail.com}
#' @export
biomassTree<-function(d,h=NA,sp,components=c('all')){
# test data consistency
if (length(sp) != 1 & length(sp) != length(d))stop('sp not of length one, or same length as d.')
if (length(sp) == 1) sp<-rep(sp,length(d))
if (!is.na(h[1])) {
includeheights<-TRUE
if (length(h) != length(d)) stop ('d and h not of the same length.')
} else {includeheights<-FALSE}
# create logical variables from components string vector
br<-db<-fl<-cr<-su<-rf<-rc<-rs<-sb<-sr<-sw<-st<-ab<-bg<-tb<- FALSE
for (i in components) eval( parse(text=paste0("if ('",i,"' %in% components) ",i," <- TRUE")) )
if ('all' %in% components) br<-db<-fl<-cr<-su<-rf<-rc<-rs<-sb<-sr<-sw<-st<-ab<-bg<-tb<- TRUE
# Template functions
dfun<-function(dAdd,dCoef,const) exp(const+dCoef*(d/(d+dAdd)))
dhfun<-function(dAdd,dCoef,hCoef,lnhCoef,const)exp(const+dCoef*(d/(d+dAdd))+hCoef*h+lnhCoef*log(h))
if (includeheights){
# spruce
cr_1<- dhfun(13,10.9708,-0.0124,-0.4923,-1.2063)
db_1<- dhfun(18,3.6518,0.0493,1.0129,-4.6351)
sw_1<- dhfun(14,7.2309,0.0355,0.7030,-2.3032)
fl_1<-dhfun(12,9.7809,0,-0.4873,-1.8551)
sb_1<-dhfun(15,8.3089,0.0147,0.2295,-3.4020)
st_1<-dhfun(14,7.4690,0.0289,0.6828,-2.1702)
# pine
cr_2<- dhfun(10,13.3955,0,-1.1955,-2.5413)
db_2<- dhfun(10,7.1270,-0.0465,1.1060,-5.8926)
sw_2<- dhfun(14,7.6066,0.0200,0.8658,-2.6864)
fl_2<-dhfun(7,12.1095,0.0413,-1.5650,-3.4781)
sb_2<-dhfun(16,7.2482,0,0.4487,-3.2765)
st_2<-dhfun(13,7.5939,0.0151,0.8799,-2.6768)
# birch
sw_3<- dhfun(11,8.1184,0,0.9783,-3.3045)
db_3<- dhfun(30,11.2872,-0.3081,2.6821,-6.6237)
sb_3<-dhfun(14,8.3019,0,0.7433,-4.0778)
st_3<-dhfun(7,8.2827,0.0393,0.5772,-3.5686)
} else {
# spruce
db_1<- dfun(18,9.9550,-4.3308)
sw_1<- dfun(14,11.4873,-2.2471)
cr_1<- dfun(13,8.5242,-1.2804)
fl_1<-dfun(12,7.8171,-1.9602)
sb_1<-dfun(15,9.8364,-3.3912)
st_1<-dfun(14,11.3341,-2.0571)
# pine
cr_2<- dfun(10,9.1015,-2.8604)
sw_2<-dfun(14,11.4219,-2.2184)
db_2<- dfun(10,9.5938,-5.3338)
fl_2<-dfun(7,7.77681,-3.7983)
sb_2<-dfun(16,8.8489,-2.9748)
st_2<-dfun(13,11.3264,-2.3388)
# birch
sw_3<- dfun(11,10.8109,-2.3327)
db_3<- dfun(5,7.9266,-5.9507)
sb_3<-dfun(14,10.3876,-3.2518)
st_3<-dfun(8,11.0735,-3.0932)
}
# likt for både d og d+h
# spruce
sr_1<-dfun(14,10.5381,-2.4447) # Not h
su_1<-dfun(17,10.6686,-3.3645)# Not h
rc_1<-dfun(8,13.3703,-6.3851) # Not h
rf_1<-dfun(12,7.6283,-2.5706) # Not h
# pine
sr_2<-dfun(12,11.1106,-3.3913) # Not h
su_2<-dfun(15,11.0481,-3.9657) # Not h
rc_2<-dfun(9,13.2902,-6.3413) # Not h
rf_2<-dfun(10,8.8795,-3.8375) # Not h
# birch
cr_3<- dfun(10,10.2806,-3.3633) # Not h
su_3<-su_2 # bruker funksjon for furu
fl_3<-sw_3 * 0.011/0.52 # faktor fra ?
rf_3<-sw_3 * 0.042/0.52 # faktor fra ?
rc_3<-sw_3 * 0.042/0.52 # faktor fra ?
sr_3<-sr_2 # bruker funksjon for furu
# under jorden - Petterson & Ståhl
bg_1<-(exp((0.32308^2) / 2 + 4.58761 + (d*10) / ((d*10) + 138) * 10.44035))/1000 # Petterson og Sthål 2006 Root limit 2 mm
bg_2<-(exp((0.35449^2) / 2 + 3.44275 + (d*10) / ((d*10) + 113) * 11.06537))/1000
bg_3<-(exp((0.36266^2) / 2 + 6.1708 + (d*10) / ((d*10) + 225) * 10.01111))/1000
bg_1<-bg_1-su_1
# Calculate combined components
for (i in 1:3){
eval( parse(text=paste0('bg_',i,'<-bg_',i,'-su_',i)) )
eval( parse(text=paste0('br_',i,'<-cr_',i,'-fl_',i)) )
eval( parse(text=paste0('rs_',i,'<-rc_',i,'+rf_',i)) )
eval( parse(text=paste0('ab_',i,'<-sw_',i,'+sb_',i,'+cr_',i,'+db_',i,'+su_',i)) )
eval( parse(text=paste0('tb_',i,'<-ab_',i,'+bg_',i)) )
}
# Subset according to species
if ('all' %in% components) {
out.colums<-c('br','db','fl','cr','su','rf','rc','rs','sb','sr','sw','st','ab','bg','tb')
} else {out.colums<-components}
out<-data.frame(matrix(nrow=length(d),ncol=length(out.colums)))
colnames(out)<-out.colums
for (i in out.colums) {
eval( parse(text=paste0('out$',i,'[sp == 1]<-',i,'_1[sp == 1]')) )
eval( parse(text=paste0('out$',i,'[sp == 2]<-',i,'_2[sp == 2]')) )
eval( parse(text=paste0('out$',i,'[sp == 3]<-',i,'_3[sp == 3]')) )
}
return(out)
} # End biomasseTree function
hansoleorka/skogR documentation built on Sept. 3, 2024, 11:26 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions biomassTree
Documented in biomassTree
#' BIOMASS FUNCTIONS
#'
#' Single-tree biomass functions for spruce, pine and birch.
#'
#' @name biomassTree
#'
#' @param d Numerical vector with diameter at breast height (cm)
#' @param h Numerical vector with tree heights (m)
#' @param sp Numerical vector with tree species (1 = Norway spruce, 2 = Scots Pine, 3 = Birch)
#' @param components String vector specifying which biomass components to return:
#'
#' \itemize{
#' \item \bold{sb} Biomass of stem bark
#' \item \bold{sw} Stem wood biomass
#' \item \bold{st} Total stem biomass (independent model including sw and sb)
#' \item \bold{fl} Foliage biomass
#' \item \bold{cr} Crown biomass
#' \item \bold{br} Branch biomass (sum of predictions of cr + fl)
#' \item \bold{db} Biomass of dead branches
#' \item \bold{su} Stump biomass
#' \item \bold{rf} Biomass of fine roots
#' \item \bold{rc} Biomass of coarse roots
#' \item \bold{rs} Biomass of roots (sum of predictions of rc + rf)
#' \item \bold{sr} Biomass of stump-root system
#' \item \bold{ab} Total aboveground biomass (sum of predictions of sw + sb + cr + su + db)
#' \item \bold{bg} Total belowground biomass (using Petersson & Ståhl 2006)
#' \item \bold{tb} Total tree biomass (sum of predictions of ab + bg)
#'
#'
#' \item \bold{all} All the above components
#' }
#'
#' @return A data frame with the dry weight biomass (kg) for the specified components. Column names and order will be the same as in components.
#'
#' @note \code{h} is optional. Functions with diameter as the only expl. variable will be used if h is not given. \cr\cr
#' According to FAO the stump is included in the above-ground biomass. \bold{su} is subtracted from the below-ground biomass
#' calculated using Petterson & Ståhl's function, since this initially includes the stump. \cr\cr
#' \bold{su} and \bold{sr} are for birch calculated using the function for pine. \cr\cr
#' \bold{fl}, \bold{rf} and \bold{rc} are for birch calculated as \bold{sw}*f, where f is a factor derived from ??
#'
#' @references Marklund, L.G., 1988. Biomass functions for pine,
#' spruce and birch in Sweden (Report No. 45). Swedish University of Agricultural Sciences, Umeå.
#' @references Petersson, H. & Ståhl, G. 2006. Functions for below-ground biomass of Pinus sylvestris, Picea abies, Betula pendula and Betula pubescens in Sweden.
#' Scandinavian Journal of Forest Research 21(Suppl 7): 84-93
#' @references FAO, 2010. Global Forest Resources Assessement 2010 - Terms and definitions.
#' Food and Agriculture Organization of the United Nations Working paper 144/E.
#'
#' @author Marius Hauglin & Ole Martin Bollandsås (2013-2017) \email{marius.hauglin@@gmail.com}
#' @export
biomassTree<-function(d,h=NA,sp,components=c('all')){
# test data consistency
if (length(sp) != 1 & length(sp) != length(d))stop('sp not of length one, or same length as d.')
if (length(sp) == 1) sp<-rep(sp,length(d))
if (!is.na(h[1])) {
includeheights<-TRUE
if (length(h) != length(d)) stop ('d and h not of the same length.')
} else {includeheights<-FALSE}
# create logical variables from components string vector
br<-db<-fl<-cr<-su<-rf<-rc<-rs<-sb<-sr<-sw<-st<-ab<-bg<-tb<- FALSE
for (i in components) eval( parse(text=paste0("if ('",i,"' %in% components) ",i," <- TRUE")) )
if ('all' %in% components) br<-db<-fl<-cr<-su<-rf<-rc<-rs<-sb<-sr<-sw<-st<-ab<-bg<-tb<- TRUE
# Template functions
dfun<-function(dAdd,dCoef,const) exp(const+dCoef*(d/(d+dAdd)))
dhfun<-function(dAdd,dCoef,hCoef,lnhCoef,const)exp(const+dCoef*(d/(d+dAdd))+hCoef*h+lnhCoef*log(h))
if (includeheights){
# spruce
cr_1<- dhfun(13,10.9708,-0.0124,-0.4923,-1.2063)
db_1<- dhfun(18,3.6518,0.0493,1.0129,-4.6351)
sw_1<- dhfun(14,7.2309,0.0355,0.7030,-2.3032)
fl_1<-dhfun(12,9.7809,0,-0.4873,-1.8551)
sb_1<-dhfun(15,8.3089,0.0147,0.2295,-3.4020)
st_1<-dhfun(14,7.4690,0.0289,0.6828,-2.1702)
# pine
cr_2<- dhfun(10,13.3955,0,-1.1955,-2.5413)
db_2<- dhfun(10,7.1270,-0.0465,1.1060,-5.8926)
sw_2<- dhfun(14,7.6066,0.0200,0.8658,-2.6864)
fl_2<-dhfun(7,12.1095,0.0413,-1.5650,-3.4781)
sb_2<-dhfun(16,7.2482,0,0.4487,-3.2765)
st_2<-dhfun(13,7.5939,0.0151,0.8799,-2.6768)
# birch
sw_3<- dhfun(11,8.1184,0,0.9783,-3.3045)
db_3<- dhfun(30,11.2872,-0.3081,2.6821,-6.6237)
sb_3<-dhfun(14,8.3019,0,0.7433,-4.0778)
st_3<-dhfun(7,8.2827,0.0393,0.5772,-3.5686)
} else {
# spruce
db_1<- dfun(18,9.9550,-4.3308)
sw_1<- dfun(14,11.4873,-2.2471)
cr_1<- dfun(13,8.5242,-1.2804)
fl_1<-dfun(12,7.8171,-1.9602)
sb_1<-dfun(15,9.8364,-3.3912)
st_1<-dfun(14,11.3341,-2.0571)
# pine
cr_2<- dfun(10,9.1015,-2.8604)
sw_2<-dfun(14,11.4219,-2.2184)
db_2<- dfun(10,9.5938,-5.3338)
fl_2<-dfun(7,7.77681,-3.7983)
sb_2<-dfun(16,8.8489,-2.9748)
st_2<-dfun(13,11.3264,-2.3388)
# birch
sw_3<- dfun(11,10.8109,-2.3327)
db_3<- dfun(5,7.9266,-5.9507)
sb_3<-dfun(14,10.3876,-3.2518)
st_3<-dfun(8,11.0735,-3.0932)
}
# likt for både d og d+h
# spruce
sr_1<-dfun(14,10.5381,-2.4447) # Not h
su_1<-dfun(17,10.6686,-3.3645)# Not h
rc_1<-dfun(8,13.3703,-6.3851) # Not h
rf_1<-dfun(12,7.6283,-2.5706) # Not h
# pine
sr_2<-dfun(12,11.1106,-3.3913) # Not h
su_2<-dfun(15,11.0481,-3.9657) # Not h
rc_2<-dfun(9,13.2902,-6.3413) # Not h
rf_2<-dfun(10,8.8795,-3.8375) # Not h
# birch
cr_3<- dfun(10,10.2806,-3.3633) # Not h
su_3<-su_2 # bruker funksjon for furu
fl_3<-sw_3 * 0.011/0.52 # faktor fra ?
rf_3<-sw_3 * 0.042/0.52 # faktor fra ?
rc_3<-sw_3 * 0.042/0.52 # faktor fra ?
sr_3<-sr_2 # bruker funksjon for furu
# under jorden - Petterson & Ståhl
bg_1<-(exp((0.32308^2) / 2 + 4.58761 + (d*10) / ((d*10) + 138) * 10.44035))/1000 # Petterson og Sthål 2006 Root limit 2 mm
bg_2<-(exp((0.35449^2) / 2 + 3.44275 + (d*10) / ((d*10) + 113) * 11.06537))/1000
bg_3<-(exp((0.36266^2) / 2 + 6.1708 + (d*10) / ((d*10) + 225) * 10.01111))/1000
bg_1<-bg_1-su_1
# Calculate combined components
for (i in 1:3){
eval( parse(text=paste0('bg_',i,'<-bg_',i,'-su_',i)) )
eval( parse(text=paste0('br_',i,'<-cr_',i,'-fl_',i)) )
eval( parse(text=paste0('rs_',i,'<-rc_',i,'+rf_',i)) )
eval( parse(text=paste0('ab_',i,'<-sw_',i,'+sb_',i,'+cr_',i,'+db_',i,'+su_',i)) )
eval( parse(text=paste0('tb_',i,'<-ab_',i,'+bg_',i)) )
}
# Subset according to species
if ('all' %in% components) {
out.colums<-c('br','db','fl','cr','su','rf','rc','rs','sb','sr','sw','st','ab','bg','tb')
} else {out.colums<-components}
out<-data.frame(matrix(nrow=length(d),ncol=length(out.colums)))
colnames(out)<-out.colums
for (i in out.colums) {
eval( parse(text=paste0('out$',i,'[sp == 1]<-',i,'_1[sp == 1]')) )
eval( parse(text=paste0('out$',i,'[sp == 2]<-',i,'_2[sp == 2]')) )
eval( parse(text=paste0('out$',i,'[sp == 3]<-',i,'_3[sp == 3]')) )
}
return(out)
} # End biomasseTree function
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.