R/grade_scale.R

In adsteen/gradr:

##' Returns a grade scale object
##'
##' @details The data frame this function is looking for needs to be able to accomodate all numeric grades, so it contains one numeric column for grades (starting with -Inf and ending in +Inf) and one column for cutoffs HMMM THAT DOESN'T SEEM LIKE IT WILL WORK
##' @param grade_scale A data frame containing the grade cutoffs and corresponding letter grades
##' @return a grade scale
##' @export
##'
grade_scale <- function(grade.cutoffs=NULL, grade.labels=NULL) {
  # TURNING THIS INTO A CONSTRUCTOR FUNCTION
  # browser()
  # Calling the function with no arguments will return Steen's default grade scale
  if(is.null(grade.cutoffs) & is.null(grade.labels)) {
    grade.cutoffs <- c(-Inf, 60, 70, 76, 80, 83, 86, 90, 93, Inf)
    grade.labels=c("F", "D", "C", "C+","B-", "B", "B+", "A-", "A")
    grade_scale <- list("grade.cutoffs" = grade.cutoffs, "grade.labels" = grade.labels)
    class(grade_scale) <- "grade_scale"
    return(grade_scale) # I think this is a flow control error but whatever
  }

  ########
  # Check inputs
  ########

  # Check whether grade.cutoffs and grade labels are vectors of appropriate length
  is.vec.grade.cutoffs <- is.vector(grade.cutoffs) & length(grade.cutoffs) >= 2
  is.vec.grade.labels <- is.vector(grade.labels) & length(grade.labels) >= 1
  good.lengths <- length(grade.cutoffs) - grade.labels == 1

  # Issue errors if the lengths or forms aren't right
  if(!is.vec.grade.cutoffs) {
    stop("grade.cutoffs isn't a vector, but it should be.")
  }
  if(!is.vec.grade.labels) {
    stop("grade.labels isn't a vector, but it should be.")
  }
  if(!good.lengths) {
    stop("grade.cutoffs must be 1 element longer than grade.labels, otherwise the grade binning won't work.")
  }

  # Issue warnings if the first and last values of grade.cutoffs aren't inf
  # I should probably do this when I assign grades, not here, but whatever
  if((min(grade.cutoffs) != -Inf) | (max(grade.cutoffs) != Inf)) {
    warning("grade.cutoffs should start with -Inf and end with Inf, otherwise some values may not be graded")
  }

  ###########
  # Create grade_scale object
  ###########

  grade_scale <- list("grade.cutoffs" = grade.cutoffs, "grade.labels" = grade.labels)
  class(grade_cutoffs) <- "grade_scale"

  grade_scale
}