R/calc_gpa.R

Defines functions calc_gpa

Documented in calc_gpa

#' Calculate Student GPA for a Given Year
#'
#' @description
#' Calculates a student's GPA (and the number of classes contributing to GPA) for a given year.
#'
#' @param ... year to be passed to the \code{\link{fetch_grades}} function
#' @param include_school logical. if TRUE, will include the student's school in the output
#' @param type type of gpa ("weighted" or "unweighted") to calculate
#'
#' @return
#' @export
#'
#' @importFrom magrittr %>%
#'
#' @examples \dontrun{
#' calc_gpa(2018, include_school = TRUE, type = "weighted")
#' }
calc_gpa <- function(..., include_school = TRUE, type = c("weighted", "unweighted")) {

  if (!is.logical(include_school)) {
    rlang::abort(paste0("`include_school` must be logical, not ", typeof(include_school)))
  }

  if (!type %in% c("weighted", "unweighted")) {
    rlang::abort(paste0("`type` must be either 'weighted' or 'unweighted', not ", type))
  }

  #fetching grades
  grds <- ccpsr::fetch_grades(..., secondary_only = TRUE)

  tmp <- grds %>%
    dplyr::filter(mark_name %in% c("Final Grade", "Fall Final Grade", "Spring Final Grade"),
                  !(term_code %in% c("Q4", "S1", "S2", "SS2")),
                  !(mark %in% c("P", "N", "NC", "AW", "W", "I"))) %>%
    dplyr::left_join(ccpsr::grading_lookup, by = c("mark" = "Letter"))

  tmp <- if (type == "weighted") {

    tmp %>%
      dplyr::mutate(gp = dplyr::case_when(
        academic_type %in% c("AP", "IB") | stringr::str_detect(course_id, "^DE") ~ AP_IB_DE,
        academic_type == "H" ~ Honors,
        TRUE ~ Regular
      ))

  } else {

    tmp %>%
      dplyr::rename(gp = Regular)
  }

  if (include_school == TRUE) {
    tmp %>%
      dplyr::group_by(sch_yr, student_id, school_code) %>%
      dplyr::summarize(gpa = mean(gp),
                       n_gpa_class = dplyr::n()) %>%
      dplyr::ungroup()
  } else {
    tmp %>%
      dplyr::group_by(sch_yr, student_id) %>%
      dplyr::summarize(gpa = mean(gp),
                       n_gpa_class = dplyr::n()) %>%
      dplyr::ungroup()
  }

}
ekholme-ccps/ccpsr documentation built on Aug. 17, 2021, 10:01 p.m.