R/Hagglund_1981_si_to_bonitet.R

In Silviculturalist/forester: Forest Science and Forestry

#' Smoothed Productivity estimates in m^3sk (cu.m.) from Hägglund 1981.
#'
#' @description Smoothed productivity estimates in m3sk from Hägglund 1981.
#' @param H100 Estimated stand top height at 100 years age. e.g. [forester::Hagglund_1972_northern_Sweden_Height_trajectories_Spruce()],[forester::Hagglund_1973_southern_Sweden_Height_trajectories_Spruce()],[forester::Hagglund_1974_Sweden_height_trajectories_Pine()]
#' @param main_species Main species, one of: 'Picea abies', or 'Pinus sylvestris'
#' @param vegetation Vegetation class [forester::Sweden_vegetation_types()]
#' @param altitude Metres above sea level.
#' @param county Swedish county [forester::county_sweden()]
#' @return Estimates the mean volume growth in m3sk / ha yr-1 at the time of culmination (or if late culmination, at 150yrs of age)
#' @export
#' @details
#'
#'  This function conveniently chooses the appropriate function.
#'
#'  Productive potential as a function of site index
#'
#'  a - Spruce, southern Sweden.
#'
#'  b - Spruce, middle Sweden, herb types, grass types and ground without field layer.
#'
#'  c - Spruce, middle Sweden, bilberry type and worse.
#'
#'  d - Spruce, northern Sweden, herb types, grass types and ground without field layer.
#'
#'  e - Spruce, northern Sweden, bilberry type and worse.
#'
#'  f - Pine, southern and middle Sweden as well as lowlands of northern Sweden.
#'
#'  g - Pine, northern Sweden, more than 200 meters above sea level.


Hagglund_1981_si_to_bonitet <- function(H100, main_species, vegetation, altitude, county){
  stopifnot(is.numeric(H100))
  stopifnot(H100>0)

  F1 <- 0.72 + (H100/130)
  F2 <- 0.70 + (H100/100)

 #Spruce
  if(main_species=="Picea abies"){
    #Northern Sweden
    if(county %in% c("Norrbottens lappmark",
                     "Norrbottens kustland",
                     "Västerbottens lappmark",
                     "Västerbottens kustland",
                     "Västernorrland - Ångermanlands landskap",
                     "Västernorrland - Medelpads landskap",
                     "Jämtland - Jämtlands landskap",
                     "Jämtland - Härjedalens landskap",
                     "Kopparberg - Sälen-Idre")){

      #herb types, grass types, ground without field layer.
      if(vegetation <=9){
        fun <- "d"
        #bilberry type and worse.
      } else if(vegetation>9){
        fun <- "e"
      }



      #Middle Sweden
    } else if(county%in% c("Kopparberg - övriga",
                           "Gävleborg - Hälsinglands landskap",
                           "Gävleborg - övriga",
                           "Kopparberg - övriga",
                           "Värmland")){
      #herb types, grass types and ground without field layer.
      if(vegetation <=9){
        fun <- "b"
        #bilberry type and worse.
      } else if(vegetation>9){
        fun <- "c"
      }


        #Southern Sweden
    } else {
      fun <- "a"

    }
  } else if(main_species=="Pinus sylvestris"){

    #Northern Sweden, altitude 200 masl and above.
    if(county %in% c("Norrbottens lappmark",
                     "Norrbottens kustland",
                     "Västerbottens lappmark",
                     "Västerbottens kustland",
                     "Västernorrland - Ångermanlands landskap",
                     "Västernorrland - Medelpads landskap",
                     "Jämtland - Jämtlands landskap",
                     "Jämtland - Härjedalens landskap",
                     "Kopparberg - Sälen-Idre") & altitude>=200){
      fun <- "g"
    } else {
      fun <- "f"
    }


  }





  if(fun=="a"){

    bon <- (0.57207 + (0.22166 * H100) + (0.0050164 * (H100^2)))*F1

  } else if (fun=="b"){

    bon <- (1.28417 + (0.31060* H100) + (0.0020048 * (H100^2)))*F1

  } else if (fun=="c"){

    bon <- (-0.42289 + (0.17735* H100) + (0.0050580 * (H100^2)))*F1

  } else if (fun=="d"){

    bon <- (-0.75761 + (0.24393* H100) + (0.0014564 * (H100^2)))*F2

  } else if (fun=="e"){

    bon <- (-0.59224 + (0.21765* H100) + (0.0011391 * (H100^2)))*F2

  } else if (fun=="f"){

    bon <- (-0.39456 + (0.16469* H100) + (0.0047191 * (H100^2)))*F2

  } else if (fun=="g"){

    bon <- (0.099227 + (0.067873* H100) + (0.0066316 * (H100^2)))*F2

  } else {
    stop(paste0(fun," is an unrecognised function. Please use one between a & g."), call.=F)
  }

  return(bon)

}