R/add_mgmt.R

In aj-sykes92/soilc.ipcc: The IPCC (2019) Tier 2 Steady-State Method for Soil Carbon

#################################################################################
# helper functions to be passed as arguments to the build_soil_input() function #
#################################################################################

#' @title Add a crop management object
#' @description To be used as an argument to the \code{build_soil_input()} function. Creates an
#' object containing crop management information and checks it for correct format and values.
#' Arguments should be vectors of matching length, or of length 1.
#' @param crop A character vector indicating the crop type. See \code{names(crop_fractions)} for
#' possible options.
#' @param yield_tha A numeric vector indicating crop yield in tonnes fresh weight ha^-1.
#' @param frac_remove A numeric vector indicating the fraction of crop residues removed, values
#' between 0 and 1.
#' @param frac_renew A numeric vector indicating the fraction of the crop renewed annually, values
#' between 0 and 1. Equal to 1 for annual crops, 1 / renewal period in years for perennial crops.
#' @examples
#' add_crop(crop = c("wheat", "barley"),
#'          yield_tha = c(7.5, 8.1),
#'          frac_remove = c(0.3, 0.4),
#'          frac_renew = c(1, 1))
#' @export
add_crop <- function(crop, yield_tha, frac_remove, frac_renew) {

  # checks
  if (any(!(crop %in% names(crop_agrc)))) stop("Crop(s) unknown")
  if (any(yield_tha < 0)) stop("Crop yield (yield_tha) must be a positive number")
  if (any(!between(frac_remove, 0, 1))) stop("Residue removal fraction (frac_remove) must be between 0 and 1") # nolint
  if (any(!between(frac_renew, 0, 1))) stop("Annual renewal fraction (frac_renew) must be between 0 and 1") # nolint

  # object
  add <- list(
    crop = crop,
    yield_tha = yield_tha,
    frac_remove = frac_remove,
    frac_renew = frac_renew
  )

  # assign class
  class(add) <- c("crop", class(add))

  return(add)
}

#' @title  Add a manure management object
#' @description To be used as an argument to the \code{build_input()} function. Creates an object
#' containing crop management information and checks it for correct format and values. Arguments
#' should be vectors of matching length, or of length 1.
#' @param livestock_type A character vector indicating the livestock type from which the manure is
#' derived. See \code{names(man_fractions)} for possible options.
#' @param n_rate A numeric vector indicating the manure application rate, in kg nitrogen ha^-1.
#' @examples
#' add_manure(livestock_type = c("beef_cattle", "swine"),
#'            n_rate = c(47, 52))
#' @export
add_manure <- function(livestock_type, n_rate) {

  # checks
  if (any(!(livestock_type %in% names(man_fractions)))) stop("Livestock type(s) unknown")
  if (any(n_rate < 0)) stop("Manure nitrogen application rate must be a positive number")

  # object
  add <- list(
    livestock_type = livestock_type,
    n_rate = n_rate
  )

  # assign class
  class(add) <- c("manure", class(add))

  return(add)
}

#' @title  Add a custom management object
#' @description To be used as an argument to the \code{build_input()} function. Creates an object
#' containing custom management information and checks it for correct format and values. Arguments
#' should be vectors of matching length, or of length 1.
#' @param om_input A numeric vector indicating dry organic matter inputs, in tonnes ha^-1.
#' @param c_input A numeric vector indicating carbon inputs, in tonnes ha^-1.
#' @param n_input A numeric vector indicating nitrogen inputs, in tonnes ha^-1.
#' @param lignin_input A numeric vector indicating lignin inputs, in tonnes ha^-1.
#' @importFrom purrr map_lgl
#' @examples
#' add_custom(om_input = c(6.1, 5.2),
#'            c_input = c(3.1, 2.9),
#'            n_input = c(0.06, 0.05),
#'            lignin_input = c(0.32, 0.29))
#' @export
add_custom <- function(om_input, c_input, n_input, lignin_input) {

  # object
  add <- list(
    om_input = om_input,
    c_input = c_input,
    n_input = n_input,
    lignin_input = lignin_input
  )

  # checks
  if (any(map_lgl(add, ~any(.x < 0)))) stop("All inputs must be a positive number")

  # assign class
  class(add) <- c("custom", class(add))

  return(add)
}

#' @title Add a grassland management object
#' @description To be used as an argument to the \code{build_soil_input()} function. Creates an
#' object containing grassland production information and checks it for correct format and values.
#' Arguments should be vectors of matching length, or of length 1.
#' @param yield_t_dm_ha A numeric vector indicating grassland forage yield in tonnes dry matter
#' hectare-1^.
#' @param res_t_dm_ha A numeric vector indicating grassland residue biomass in tonnes dry matter
#' hectare-1^.
#' @param root_t_dm_ha A numeric vector indicating grassland root biomass in tonnes dry matter
#' hectare-1^.
#' @examples
#' add_grass(yield_t_dm_ha = c(7.5, 8.1),
#'           res_t_dm_ha = c(2.7, 3.1),
#'           root_t_dm_ha = c(7.4, 7.9))
#' @export
add_grass <- function(yield_t_dm_ha, res_t_dm_ha, root_t_dm_ha) {

  # object
  add <- list(
    yield_t_dm_ha = yield_t_dm_ha,
    res_t_dm_ha = res_t_dm_ha,
    root_t_dm_ha = root_t_dm_ha
  )

  # checks
  if (any(map_lgl(add, ~any(.x < 0)))) stop("All inputs must be a positive number")

  # assign class
  class(add) <- c("grass", class(add))

  return(add)
}