R/extract_grade_row.R

In adamblake/nbsimplegrader_companion: A Companion Package to the nbsimplgrader Jupyter Extension

#' Extract a grade row from a notebook
#'
#' Find all cells marked as nbsimplegrader responses and extract them into a
#' grade row that can be merged with other grade rows to make a grade sheet.
#'
#' @section TODO:2 Username should be stored in the notebook metadata instead
#'
#' @param notebook A notebook as parsed by \code{\link{read_notebook}}.
#'
#' @return A \code{\link{tibble}} with one observation and the following variables:
#'  - **username**: The username associated with the notebook.
#'  - **file_path**: The \code{\link{path_file}} of the notebook.
#'  - **last_edit**: The date-time of the last edit to the notebook.
#'  - **R_*n***: The user's response to response item ***n***.
#'  - **S_*n***: A blank column created next to each **R_*n*** where the score can be marked.
#'
#' @export
#' @md
extract_grade_row <- function(notebook) {
  # extract the responses
  responses <- notebook %>%
    tidyr::hoist("metadata", editable = "editable") %>%
    tidyr::hoist("metadata", deletable = "deletable") %>%
    tidyr::hoist("metadata", response = c("nbsimplegrader", "response")) %>%
    tidyr::hoist("metadata", multiple_choice = c('nbsimplegrader', 'multiple_choice')) %>%
    tidyr::hoist("metadata", mc_value = c("nbsimplegrader", "value")) %>%
    dplyr::mutate_at(c("editable", "deletable"), ~ifelse(is.na(.x), TRUE, FALSE)) %>%
    dplyr::mutate_at('multiple_choice', ~ifelse(is.na(.x), FALSE, TRUE)) %>%
    dplyr::mutate_at("response", ~ifelse(is.na(.x), FALSE, response)) %>%
    dplyr::mutate_at('mc_value', ~LETTERS[.x + 1]) %>%
    dplyr::filter_at('response', dplyr::any_vars(.)) %>%
    {ifelse(.$multiple_choice, .$mc_value, .$source)}

  # make a grade row
  c(username = stringr::str_split(attr(notebook, 'file_path'), "_")[[1]][[1]],
    file_path = attr(notebook, 'file_path'),
    last_edit = attr(notebook, 'last_edit'),
    responses %>%
      purrr::imap(function(response, index) {
        n <- sprintf(paste0("%0", 2L, "d"), index)
        purrr::set_names(c(response, NA), paste0(c("R_", "S_"), n))
      }) %>%
      purrr::flatten()
  ) %>%
    dplyr::as_tibble()
}