R/mortality.R

In bmcnellis/RSFIA: FIA Tree Mortality Analysis

#' @include generics.R
#' @include nc_helper.R
#'
#' @title nc_helper extension that stores mortality variables
#'
#' @author Brandon McNellis
#'
#' @name mortality
#' @rdname mortality
NULL
#'
#' An S4 class for FIA mortality
#'
#' @rdname mortality
mortality <- setClass(
  'mortality',
  slots = list(
  ),
  contains = 'nc_helper'
)
#' @export
setValidity('mortality', function(object) {
  errors <- character()

  # returns
  if (length(errors) == 0) {
    TRUE
  } else {
    errors
  }
})
#' @rdname mortality
#' @export
setMethod('initialize',
          signature(.Object = 'mortality'),
          function (.Object, ...) {
            params <- list(...)

            # returns
            .Object <- callNextMethod()
            mt <- validObject(.Object)
            if (isTRUE(mt)) {
              return(.Object)
            } else {
              return(mt)
            }
          }
)
#' @rdname response
#' @export
setMethod('FillArray',
          signature(object = 'mortality'),
          function(object, df, nc = NULL) {
            validObject(object)
            stopifnot(inherits(object, 'mortality'))

            if (is.null(nc)) {
              fname <- paste0(object@nc_dir, '/', object@file_name)
              nc <- ncdf4::nc_open(fname, write = T)
            }

            # Makes sure input data lines up
            vars <- object@variables
            c0 <- data.frame(CoordVecsToList(object@coords), object@sample, stringsAsFactors = F)
            c1 <- df[, c('lon', 'lat')]
            c1_df <- data.frame(c1, seq(nrow(c1)), stringsAsFactors = F)
            c1_df <- dplyr::left_join(c0, c1_df, by = c('lon', 'lat'))
            colnames(c1_df) <- c('lon', 'lat', 'sample', 'nrow')
            df0 <- df[c1_df$nrow, c('time', vars)]
            df0$sample <- object@sample

            if (length(vars) == 0) {
              stop('missing variables?')
            }

            callNextMethod(object = object, df = df0, nc = nc)

            ncdf4::nc_close(nc)
            return(object)
          }
)
#' @rdname mortality
#' @export
setMethod('GetMeta',
          signature(class = 'mortality'),
          function (class, ...) {

            vars_out <- character()
            pref <- c('Animal', 'Disease', 'Fire', 'Harvest', 'Insect', 'Other', 'Vegetation', 'Weather')
            suff <- c('_frac_of_ndead', '_ndead', '_rate_wrt_ntree')

            v0 <- as.vector(outer(pref, suff, paste0))

            v1 <- c(
              "mort_rate",
              "non_beet_mort_rate",
              "non_fire_mort_rate",
              "non_harv_fire_beet_mort_rate",
              "non_harv_fire_mort_rate",
              "non_harv_mort_rate"
            )

            vars_out <- append(vars_out, v0)
            vars_out <- append(vars_out, v1)

            return(vars_out)

          }
)