Add checking methods: check_code, check_result, and test_result (…

…rstudio#10) - Broken. Needs to be fixed

* Fix rstudio#7, rstudio#8: Compare user and solution based on expressions

* ignore all html tutorial files

* roxygen version

* white space

* add `result` to convey results from grading

* rename strict_check.R to check_strict.R and upgrade how function is handled

* add a check_result method and partially generalize grade_learnr

* use check_code vs check_strict

* check result should not check code

* add checkmate helpers

* pull out praise and encourage and make random helper methods

* make sure grading_code is called from envir_result

* copy extra args

* report error an error occured while checking answer

* add helper methods for getting user and solution code

* add a results fn

* add a `test_result` method

* if the tutorial is trying to be run from not inside rstudio IDE, browse the URL

* open file _url_ if rstudio isn't available

* update grading-demo doc

* do not require solution code

* more documentation

* Update DESCRIPTION

Use GPL-3 (cuz shiny). Add learnr remote to get at `envir_prep`

* the pkg is grader not teachr

* documentation and passing R cmd check.  Tests still fail

* pass tests

* white space

* fix tests

* don't use tidyverse in tests

* result message should be "" if NULL is supplied. helps with printing

* make sure error result message is a character

* correct the order

* use glue_data over glue

* todo solved

* use answer not found obj

* tests for ex checking methods

* documentation

* ignore all the things

* use travis

* use codecov

* use pkgdown

* update description

* use a readme with a bunch of badges

* evaluate all *-check code except for the last value.  Evaluate that like normal.  Move all code inside trycatch

* add custom check code example

* Require testthat for checkmate expect_* methods

* use github links in description

* update authors

* bump learnr version

* `results` does not exist anymore

* add `grader_args`/`learnr_args` and use `graded()` for computed result

* import %||% from rlang

* add possible correct/incorrect methods

* document

.Rbuildignore

@@ -1,2 +1,8 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^inst/tutorials/*/*.html$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^\.travis\.yml$
+^codecov\.yml$

.gitignore

@@ -30,3 +30,5 @@ NEXT_STEPS.Rmd
 tmp
 */rsconnect/
 inst/tutorials/*/rsconnect/
+inst/tutorials/*/*.html
+docs/*

.travis.yml

@@ -0,0 +1,51 @@
+# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
+
+language: r
+sudo: false
+cache: packages
+
+notifications:
+  email:
+    on_success: change
+    on_failure: change
+
+jobs:
+  include:
+    - stage: "R CMD check"
+      name: "Old Release"
+      r: oldrel
+
+
+    - name: "Release"
+      r: release
+      after_success:
+        # code coverage
+        - Rscript -e 'if(!require("covr")) install.packages("covr")'
+        - Rscript -e 'covr::codecov()'
+
+
+    - name: "Devel"
+      r: devel
+
+
+    - stage: "Deploy"
+      name: "pkgdown"
+      r: release
+      if: |
+        branch IN (master, travis, grade_exercise_answer) AND \
+        type = push AND \
+        repo = rstudio-education/grader
+      before_deploy: # build site and copy over files
+        - Rscript -e 'if(!require("pkgdown")) install.packages("pkgdown")'
+        - Rscript -e 'pkgdown::build_site()'
+      deploy:
+        provider: pages # github pages
+        local-dir: docs # deploy from docs folder
+        skip-cleanup: true # keep pkgdown output
+        keep-history: false # overwrite all git history
+        on:
+          # deploy on any branch as condition is done above
+          all_branches: true
+        github-token:
+          secure:
+            "BuNSl2Tp1GGS2ikn0zTzqUXu9bC6KaQBOYV6G8y8msidJAj/1M1sjhLO8BmP4moQ7XsoxAG1Zd+pvuE+vWVIQ/A7oMZU/WXQiymLtUXajSM4lj6+RwK9OS4/BiXia0B1rEUUmUJbX4C+yRBKHU9prNcuyZhG7RO6DTJPwodspL2ABPf4yap1Dfptj3O0ZheziC4NqPqndSGdjZos6sgvIGjEUNfjXQmBv9irpSfpZmzMzWNQvnkF9aCnsgxNcjLwClY73EfJTq3z9FN9EGpk8gRw+M2mhIKwT3N2P6XB4BCHtlIgXCw2TwwJpmuj1qLm2JvUdWx3LfBidxcv5pd9PKQffoYkdaOsX00kImEZtxH4xMCAzsKALLa4B8JyMls7lwEZsEAyU6JYDBraWIXM7s1GOu2lTcqQBpRk6bFU46FGaFfNglPgYbynP3PwGo12W+UsXK6LvuvnbfQKsNzXE2t7WEuMDOQraBU3NoZSQUwX37bAL28Iq5Vyx6XpgwHcayY+vRkNTZXGd7HK/refdhecpAAWi5SRx8I2ExEZ+9qFpw0KijWA2yJ/ksCfSX85EcIZka8PfvSgYYZWzcnD1iuHB+sLb6074h5ePJ+YIQRjZJAeXrOiyHHvmXRfKXUvPymX99VkSiqbVEFMfIendeMw6AcYynP+6WI+pqRf6EQ="

DESCRIPTION

@@ -2,15 +2,19 @@ Package: grader
 Type: Package
 Title: Tools for "grading" student exercises in learnr tutorials
 Version: 0.1.0
-Author: Garrett Grolemund
-Maintainer: Garrett Grolemund <[email protected]>
-Description: Learn more about learnr tutorials at rstudio.github.io/learnr/
-License: MIT
+Author@R: c(
+  person("Garrett", "Grolemund", role = c("aut", "cre"), email = "[email protected]"),
+  person("Barret", "Schloerke", role = c("aut"), email = "[email protected]"),
+  person(family = "RStudio, Inc.", role = c("cph", "fnd")),
+  person(family = "Ajax.org B.V.", role=c("ctb", "cph"), comment= "Ace library")
+  )
+Description:
+  Pairing with the 'learnr' R package, 'grader' provides multiple methods to grade 'learnr' exercises.  To learn more about 'learnr' tutorials, please visit <http://rstudio.github.io/learnr/>.
+License: GPL-3
 Encoding: UTF-8
 LazyData: true
-Suggests: testthat
-RoxygenNote: 6.0.1
-Imports: 
+RoxygenNote: 6.1.1
+Imports:
     purrr,
     crayon,
     clisymbols,
@@ -20,6 +24,12 @@ Imports:
     glue,
     knitr,
     callr,
-    learnr,
+    learnr (>= 0.9.2.9001),
     stringr,
-    readr
+    readr,
+    checkmate,
+    testthat
+Remotes:
+  rstudio/learnr
+URL: https://rstudio-education.github.io/grader/, https://rstudio.github.io/learnr/, https://github.com/rstudio-education/grader
+BugReports: https://github.com/rstudio-education/grader/issues

NAMESPACE

@@ -1,8 +1,24 @@
 # Generated by roxygen2: do not edit by hand
 
 export(add_tutorial)
+export(check_code)
+export(check_result)
+export(correct)
+export(get_code)
+export(get_solution_code)
+export(get_user_code)
 export(grade_learnr)
+export(graded)
 export(grading_demo)
-export(strict_check)
+export(incorrect)
+export(is_rrect)
+export(random_encourage)
+export(random_praise)
+export(result)
+export(test)
+export(test_result)
 export(test_solutions)
+export(tests)
 export(view_tutorial)
+importFrom(rlang,"%||%")
+importFrom(utils,browseURL)

R/check_code.R

@@ -0,0 +1,138 @@
+#' Check code structure
+#'
+#' \code{check_code()} compares user code to a solution (i.e. model code) and
+#' describes the first way that the user code differs. If the user code exactly
+#' matches the solution, \code{check_code()} returns a customizable success
+#' message.
+#'
+#' \code{check_code()} provides a *strict* check in that the user code must
+#' exactly match the solution. It is not enough for the user code to be
+#' equivalent to the solution code (e.g. to return the same result as the
+#' solution).
+#'
+#' You can provide solution code for \code{check_code()} to use in two ways:
+#'
+#' 1. Pass code as a character string or a quoted expression to the solution
+#' argument of \code{check_code()}
+#'
+#' 2. Make a "-solution" code chunk for the exercise to be checked in a learnr
+#' document. There is no need to supply a solution argument for
+#' \code{check_code()} if you call it from the "-check" chunk of the same
+#' exercise. Likewise, there is no need to supply a user argument when you call
+#' \code{check_code()} from a learnr document (learnr will provide the code
+#' that the student submits when it runs \code{check_code()}.
+#'
+#' For best results, name all arguments provided in the solution code.
+#'
+#' @param correct A character string to display if the student answer matches
+#'   the solution code.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = TRUE, message = NULL)}.
+#' @param incorrect A character string to display if the student answer matches
+#'   the solution code.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = FALSE, message = "<STRING>")} where message is the error found while comparing the user solution to the known solution.
+#' @param solution (Optional) solution code surrounded by \code{quote()},
+#'   \code{rlang::quo()}, or provided as a character string.
+#' @param user (Optional) student code to check against the solution surrounded
+#'   by \code{quote()}, \code{rlang::quo()}, or provided as a character string.
+#'
+#' @return a \code{grader_result} structure from \code{\link{result}}.
+#'   If the student answer differs from the
+#'   solution code, the message will describe the first way that the answer
+#'   differs, and it will ask the student to try again. If the answer matches
+#'   the solution code, the message will be the content of the \code{success}
+#'   argument.
+#'
+#' @export
+#' @examples
+#' \dontrun{grading_demo()}
+check_code <- function(
+  correct = "{random_praise()} Correct!",
+  incorrect = "{message} {random_encourage()}",
+  grader_args = list(), # provided by `grade_learnr`
+  learnr_args = list() # provided by `grade_learnr`
+) {
+  chkm8_single_character(correct)
+  chkm8_single_character(incorrect)
+
+  user <- grader_args$user_quo
+  solution <- grader_args$solution_quo
+
+  is_same_info <- code_is_same(user, solution)
+
+  if (is_same_info$correct) {
+    return(
+      graded(
+        correct = TRUE,
+        message = glue::glue_data(
+          list(
+            correct = TRUE,
+            message = NULL
+          ),
+          correct
+        )
+      )
+    )
+  }
+
+  message <- glue::glue_data(
+    list(
+      correct = FALSE,
+      message = is_same_info$message
+    ),
+    incorrect
+  )
+  if (uses_pipe(user)) {
+    message <- glue::glue_data(
+      list(
+        user = user,
+        message = message
+      ),
+      "I see that you are using pipe operators (e.g. %>%), ",
+      "so I want to let you know that this is how I am interpretting your code ",
+      "before I check it:\n\n{deparse(unpipe_all(user))}\n\n{message}"
+    )
+  }
+
+  return(
+    graded(
+      correct = FALSE,
+      message = message
+    )
+  )
+}
+
+
+
+code_is_same <- function(user = NULL, solution = NULL) {
+
+  # Sometimes no solution is provided, but that
+  # means there is nothing to check against
+  if (is.null(solution)) {
+    stop("No solution is provided for this exercise.")
+  }
+
+    # Sometimes no user code is provided,
+  # that means there is nothing to check
+  if (is.null(user)) {
+    stop("I didn't receive your code. Did you write any?")
+  }
+
+  # MUST call user first to avoid "poisoning" the envir with solution information
+  user_code <- rlang::get_expr(user)
+  solution_code <- rlang::get_expr(solution)
+
+  # Correct answers are all alike
+  if (suppressWarnings(user_code == solution_code)) {
+    return(graded(correct = TRUE, message = NULL))
+  }
+
+  message <- detect_mistakes(user, solution)
+  if (is.null(message)) {
+    # found no errors
+    return(graded(correct = TRUE, message = NULL))
+  }
+
+  return(
+    graded(correct = FALSE, message = message)
+  )
+}

R/check_result.R

@@ -0,0 +1,66 @@
+
+#' Check result of exercise code
+#'
+#' \code{check_result()} compares the final result of the user code to known \code{results}.
+#' If the user result exactly matches a known \code{result}, \code{check_result}
+#' returns the matching message value.
+#'
+#' @param results A \code{\link{results}} object that contains possible \code{\link{result}} values to compare against.
+#' @param correct A character string to display if the student answer matches
+#'   a known answer.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = TRUE, message = "<result message>")}. where message is the matched result message.
+#' @param incorrect A character string to display if the student answer matches
+#'   a known answer.
+#'   This character string will be run through \code{glue::\link[glue]{glue_data}} with \code{list(correct = FALSE, message = "<result message>")}. where message is the matched result message.
+#' @param empty_msg A character string to display as a message if the user code is NULL.
+#' @param ... ignored
+#' @param user (Optional) student code to check against the \code{results} surrounded
+#'   by \code{quote()}, \code{rlang::quo()}, or provided as a character string.
+#'
+#' @return a \code{grader_result} structure from \code{\link{result}} containing a formatted \code{correct} or \code{incorrect} message.
+#'
+#' @export
+#' @examples
+#' \dontrun{grading_demo()}
+check_result <- function(
+  ...,
+  correct = "{paste0(random_praise(), if (nchar(message) > 0) \" \", message)}",
+  incorrect = "{paste0(message, if(nchar(message) > 0) \" \", random_encourage())}",
+  empty_msg = "I did not notice a result. Does your code return one?",
+  grader_args = list(), # provided by `grade_learnr`
+  learnr_args = list() # provided by `grade_learnr`
+) {
+  results <- list(...)
+  chkm8_item_class(results, "grader_result")
+  chkm8_single_character(correct)
+  chkm8_single_character(incorrect)
+  chkm8_single_character(empty_msg)
+
+  if (!any(vapply(results, `[[`, logical(1), "correct"))) {
+    stop("At least one correct result must be provided")
+  }
+
+  user_answer <- learnr_args$last_value
+
+  # init final answer as not found
+  final_result <- graded(correct = FALSE, "Answer not found")
+  for (resu in results) {
+    if (identical(resu$x, user_answer)) {
+      final_result <- resu
+      break
+    }
+  }
+
+  message <- glue::glue_data(
+    list(
+      correct = final_result$correct,
+      message = final_result$message
+    ),
+    {if (final_result$correct) correct else incorrect}
+  )
+
+  return(graded(
+    correct = final_result$correct,
+    message = message
+  ))
+}

R/checkmate.R

@@ -0,0 +1,11 @@
+
+chkm8_class <- checkmate::assert_class
+chkm8_item_class <- function(x, class, name = checkmate::vname(x)) {
+  lapply(seq_along(x), function(i) {
+    chkm8_class(x[[i]], class, .var.name = paste0(name, "[[", i, "]]"))
+  })
+}
+
+chkm8_single_character <- function(x, name = checkmate::vname(x)) {
+  checkmate::assert_character(x, null.ok = TRUE, len = 1, any.missing = FALSE, .var.name = name)
+}