R/generateOutputList.R

Defines functions genOutputList

Documented in genOutputList

#' Generate list of outputs
#'
#' This function pulls data generated by \code{recoverySim} from a given
#' directory and binds it into a list. Each first order list element consists
#' of a single scenario (i.e. one OM and one MP). The second order list
#' elements depend on whether CU-specific, aggregate, or aggregate time series
#' data are extracted.
#'
#' @importFrom here here
#'
#' @param dirName A character vector representing the directory to pull data
#' from.
#' @param subDirName An optional character vector used to specify a single
#' subdirectory within \code{dirName} to pull data from.
#' @param selectedCUs An optional character vector of CU names used to subset
#' output data if CU-specific data are being pulled (i.e. \code{agg = FALSE}).
#' @param agg A logical stating whether aggregate (\code{TRUE}; default) or
#' CU-specific (\code{FALSE}) data should be pulled.
#' @param aggTS A logical stating whether aggregate summary performance metric
#' data (\code{FALSE}; default) or aggregate time series data (\code{TRUE})
#' should be pulled.
#' @return Returns a list of output data of length equal to the number of unique
#' scenarios within a directory.
#'
#' @examples
#' TO BE COMPLETED
#'
#' @export
genOutputList <- function(dirName, subDirName = NULL, selectedCUs = NULL,
                          agg = TRUE, aggTS = FALSE) {
  dirPath <- ifelse(is.null(subDirName), dirName, paste(dirName, subDirName,
                                                        sep="/"))

  if (agg == TRUE) {
    if (aggTS == TRUE) {
      arrayNames <- list.files(paste(here("outputs/simData"), dirPath, sep="/"),
                               pattern="\\Series.RData$")
      if (is.null(arrayNames)) {
        warning("Necessary output data missing")
      }
      aggList <- list()
      for(i in 1:length(arrayNames)){ #make list of lists!
        aggList[[i]] <- readRDS(paste(here("outputs/simData"), dirPath,
                                      arrayNames[i], sep="/"))
      }
      names(aggList) <- arrayNames
      return(aggList)
    } else {
      listNames <- list.files(paste(here::here("outputs/simData"), dirPath,
                                    sep="/"),
                              pattern="*aggDat.csv")
      if (is.null(listNames)) {
        warning("Necessary output data missing")
      }
      aggList <- list()
      for(i in 1:length(listNames)){
        aggList[[i]] <- read.csv(paste(here::here("outputs/simData"), dirPath,
                                       listNames[i], sep="/"))
      }
      names(aggList) <- listNames
      return(aggList)
    }
  }

  if (agg == FALSE) {
    dfNames <- list.files(paste(here("outputs/simData"), dirPath, sep="/"),
                          pattern="\\cuDat.RData$")
    if (is.null(dfNames)) {
      warning("Necessary output data missing")
    }
    cuList <- list()
    newNames <- NULL
    for(i in 1:length(dfNames)){ #make list of lists!
      cuList[[i]] <- readRDS(paste(here("outputs/simData"), dirPath, dfNames[i],
                                   sep="/"))
      #identify and assign truncated name to CU-specific list
      newName <- unlist(strsplit(dfNames[i], "_cuDat"))[1]
      newNames <- c(newNames, newName)
    }
    names(cuList) <- newNames

    if (is.null(selectedCUs) == FALSE) { #subset CU list based on input vector
      cuNumbers <- which(cuList[[1]][["stkName"]] %in% selectedCUs)
      cuList <- lapply(cuList, function(lst) {
        tempList <- vector("list", length = length(lst))
        tempList[1:5] <- lst[c("opMod", "keyVar", "plotOrder", "manProc",
                               "hcr")]
        for (i in 6:length(lst)) {
          if (is.matrix(lst[[i]]) == TRUE){
            temp <- lst[[i]][, cuNumbers]
          }
          if (is.vector(lst[[i]]) == TRUE){
            temp <- lst[[i]][cuNumbers]
          }
          tempList[[i]] <- temp
        }
        names(tempList) <- names(lst)
        return(tempList)
      })
    }
    return(cuList)
  }
}
CamFreshwater/samSim documentation built on Sept. 25, 2023, 10:22 a.m.