R/getCycles.R

In NCRN/NPSForVeg: Data anaylsis and graphing for NPS forest vegetation monitoring.

#' @include  NPSForVeg_Class_def.R
#' @title getCycles
#'
#' @importFrom dplyr %>% filter rowwise
#' @importFrom rlang !!! quo
#'
#' @description Gets the cycles \code{data.frame} from one or more \code{NPSForVeg} objects.
#'
#' @param object Either a data.frame like that stored in the \code{Cycles} slot, an \code{NPSForVeg} object or a list of such objects.
#' @param cycles A vector of cycle codes. Will only return data from those cycles.
#' @param years  A length 1 numeric vector containing one or more years. Will only return cycles that include those years.
#'
#' @return Either a \code{data.frame} or a \code{list} containing the contents of the "Cycles" slot for one or more \code{NPSForVeg} objects.
#'
#' @details  When the "object" is a \code{data.frame} or a single \code{NPSForVeg} object this function will return the \code{data.frame} in
#' the "Cycles" \code{slot}. This \code{data.frame} will be filtered as specified in the other arguments. When "object" is a \code{list}
#' then a \code{list} is returned. Each element of the \code{list} will be the filtered \code{data.frame} from "Cycles" \code{slot} from
#' the input \code{NPForVeg} objects.
#'
#' @examples
#' \dontrun{
#' ncrn <- importNCRN("C:/Data")
#' latest_data <- getCycles(ncrn, cycles = 5)
#'
#' }
#'
#' @export

setGeneric(name="getCycles",function(object,cycles=NA,years=NA){standardGeneric("getCycles")},signature=c("object") )


setMethod(f="getCycles", signature=c(object="list"),
          function(object,cycles,years){

            return(lapply(object, getCycles, cycles, years))
})


setMethod(f="getCycles", signature=c(object="NPSForVeg"),
          function(object,cycles,years){

            return( getCycles(object@Cycles, cycles, years) )
})


setMethod(f="getCycles", signature=c(object="data.frame"),
          function(object,cycles, years){

  ## function to check if vector of years x is in range of years y
  CycleCheck<-function(x,y){
    any(sapply(X=x, FUN= `%in%`, y))
  }

  ## create "filt" which will hold all of the filters to be applied
  filt<-list(quo(Cycle %in% cycles),  # numeirc code for cycle
    quo(CycleCheck(years, YearStart:YearEnd) )#cycle(s) whcich contain the given year
  )

  ## get rid of filters that the user does not want
  filt<-filt[c(all(!is.na(cycles)),all(!is.na(years)))]

  ## filter data or just return the data.frame if there are no filters
  return( if(length(filt)>0) object %>% rowwise %>% filter(!!!filt) %>% as.data.frame else object)

})