R/organizeBinnedSpreadSkill.R

In Weiming-Hu/RAnEnExtra: Extra functions for RAnEn

#  "`-''-/").___..--''"`-._
# (`6_ 6  )   `-.  (     ).`-.__.`)   WE ARE ...
# (_Y_.)'  ._   )  `._ `. ``-..-'    PENN STATE!
#   _ ..`--'_..-_/  /--'_.' ,'
# (il),-''  (li),'  ((!.-'
#
#
# Author: Weiming Hu <weiming@psu.edu>
#         Geoinformatics and Earth Observation Laboratory (http://geolab.psu.edu)
#         Department of Geography and Institute for CyberScience
#         The Pennsylvania State University
#

#' RAnEnExtra::organizeBinnedSpreadSkill
#'
#' RAnEnExtra::organizeBinnedSpreadSkill organize the verification results into a flat table format
#' so that it is easy to plot with ggplot.
#'
#' @author Weiming Hu \email{weiming@@psu.edu}
#'
#' @param results The results from RAnEnExtra::verify. It should be a list. This function can only
#' parse verification generated by the metric `BinnedSpreadSkill`; any other metrics will be ignored.
#'
#' @return A data frame
#'
#' @md
#' @export
organizeBinnedSpreadSkill <- function(results) {

  stopifnot(is.list(results))
  df <- data.frame()

  for (method in names(results)) {
    if ('BinnedSpreadSkill' %in% names(results[[method]])) {
      df_single <- data.frame(Spread = results[[method]]$BinnedSpreadSkill$spread.skill.res[, 1],
                              RMSE = results[[method]]$BinnedSpreadSkill$spread.skill.res[, 2],
                              Method = method,
                              Metric = 'BinnedSpreadSkill')

      if (all(!is.na(results[[method]]$BinnedSpreadSkill$boot.res))) {

        # Boot has been working correctly
        df_single$RMSE_floor <- results[[method]]$BinnedSpreadSkill$boot.res[2, ]
        df_single$RMSE_ceiling <- results[[method]]$BinnedSpreadSkill$boot.res[3, ]
      } else {

        if (any(!is.na(results[[method]]$BinnedSpreadSkill$boot.res))) {
          warn <- paste('You may be boot = TRUE for the method', method, ' but some entries are NA. Intervals are ignored!')
          warning(warn)
        }

        df_single$RMSE_floor <- NA
        df_single$RMSE_ceiling <- NA
      }

      df <- rbind(df, df_single)
    }
  }

  # Remove columns that only contain NA values
  if (all(is.na(df$RMSE_ceiling))) df$RMSE_ceiling <- NULL
  if (all(is.na(df$RMSE_floor))) df$RMSE_floor <- NULL

  return(df)
}