R/lhc_analysis_netlogo.R

#' Analyses Netlogo simulations generated for a latin-hypercube based sensitivity analysis
#'
#' Takes each parameter value set generated by the hypercube in turn, and
#' analyses the Netlogo simulation results.  For each parameter set, there
#' will be n simulation results. This method goes through these results,
#' producing a file containing the median of each output measure for each
#' of the n runs. Thus, if a Netlogo simulation was replicated 10 times,
#' the median file will contain 10 medians for each simulation output measure.
#' Once this has been created, the user should run
#' \code{lhc_generateLHCSummary}, \code{lhc_generatePRCoEffs}, and
#' \code{lhc_graphMeasuresForParameterChange} as per analysing any data
#' in spartan that was not generated by Netlogo
#'
#' @param FILEPATH Directory where either the simulation runs can be found
#' @param LHCSAMPLE_RESULTFILENAME Name of the result file generated by Netlogo, for a LHC parameter sample.
#' @param SPARTAN_PARAMETER_FILE Location of the file output by the latin-hypercube sampling method, containing the parameters on which this experiment was performed
#' @param NUMSAMPLES The number of parameter subsets that were generated in the LHC design
#' @param MEASURES Array containing the names of the Netlogo output measures which are used to analyse the simulation.
#' @param LHC_ALL_SIM_RESULTS_FILE Name of the LHC Summary file to be generated. Contains each parameter set alongside the result gained when the simulation was run under that criteria.
#' @param TIMESTEP The timestep of the Netlogo simulation being analysed
#'
#' @export
lhc_process_netlogo_result <- function(FILEPATH, LHCSAMPLE_RESULTFILENAME,
                                       SPARTAN_PARAMETER_FILE, NUMSAMPLES,
                                       MEASURES, LHC_ALL_SIM_RESULTS_FILE,
                                       TIMESTEP) {

  # Read in the spartan parameter file
  tryCatch(
  {
    lhc_table <- read_from_csv(file.path(FILEPATH,SPARTAN_PARAMETER_FILE))

    ALL_SIM_MEDIAN_RESULTS <- NULL

    for (SAMPLE in 1:NUMSAMPLES) {
        message(paste("Processing LHC Results for Sample: ", SAMPLE, sep = ""))

        # Read in result file, skipping lines 1-6 as this info is not required
        nl_result <- read.csv(paste(FILEPATH, "/", SAMPLE, "/",
                                    LHCSAMPLE_RESULTFILENAME, SAMPLE,
                                    ".csv", sep = ""), sep = ",",
                              skip = 6, check.names = FALSE)

        # ORDER IT BY RUN FOR EFFICIENCY LATER
        nl_result_ordered <- nl_result[order(nl_result[, 1]), ]

        TIMESTEP_RESULTS <- subset(nl_result_ordered,
                                   nl_result_ordered["[step]"] == TIMESTEP)

        # Create results for sample
        # As Netlogo gives option for replicates there may be more than 1 result
        # Summary method takes care of that
        # Set up number of parameter rows:
        param_set <- lhc_table[SAMPLE, ]

        # Make duplicates of the parameters to match the number of replicate runs
        PARAMS <- NULL
        for (paramval in 1:ncol(param_set)) {
          PARAMS <- cbind(PARAMS, param_set[[paramval]])
        }

        DUP_PARAMS <- NULL
        for (r in 1:nrow(TIMESTEP_RESULTS) - 1) {
          DUP_PARAMS <- rbind(DUP_PARAMS, PARAMS)
        }

        # Now add results for each netlogo run
        for (RESPONSE in 1:length(MEASURES)) {
          DUP_PARAMS <- cbind(DUP_PARAMS,
                              TIMESTEP_RESULTS[MEASURES[RESPONSE]][, 1])
        }

        ALL_SIM_MEDIAN_RESULTS <- rbind(ALL_SIM_MEDIAN_RESULTS, DUP_PARAMS)
    }

    # Output if results not blank
    if (!is.null(ALL_SIM_MEDIAN_RESULTS)) {
      colnames(ALL_SIM_MEDIAN_RESULTS) <- cbind(t(names(lhc_table)),
                                                t(MEASURES))
      write_data_to_csv(ALL_SIM_MEDIAN_RESULTS, file.path(FILEPATH, LHC_ALL_SIM_RESULTS_FILE))
      message(paste("Writing Median Results to CSV File: ", file.path(FILEPATH, LHC_ALL_SIM_RESULTS_FILE), sep = ""))
    }
  },
  error=function(cond) {
    message("Error in finding files required for Spartan Netlogo Analysis")
    message("Spartan Function Terminated")
  },
  warning=function(cond) {
    message("Error in finding files required for Spartan Netlogo Analysis")
    message("Spartan Function Terminated")
  })
}
kalden/spartan documentation built on May 31, 2019, 11:52 p.m.