Add further R grading examples

* Example: search all returned results for a specific value
* Example: specific feedback for a certain condition message

docs/exercises/grading.qmd

@@ -43,3 +43,47 @@ if (!is.function(.result)) {
 }
 ```
 
+## Find any result in learner output
+
+Write R code that returns 2468 somewhere, even invisibly:
+
+```{webr}
+#| caption: Sample Exercise 2
+#| exercise: example_2
+123
+invisible(2468)
+456
+```
+
+```{webr}
+#| exercise: example_2
+#| check: true
+results <- Filter(\(x) inherits(x, "result"), .evaluate_result)
+if(is.null(Find(\(x) x$value == 2468, results))) {
+  list(correct = FALSE, message = "Incorrect, sorry.")
+} else {
+  list(correct = TRUE, message = "Correct!")
+}
+```
+
+## Feedback for a specific learner error
+
+```{webr}
+#| caption: Sample Exercise 3
+#| exercise: example_3
+123 + "456"
+```
+
+```{webr}
+#| exercise: example_3
+#| check: true
+errors <- Filter(\(x) inherits(x, "error"), .evaluate_result)
+this_error <- Filter(\(x) x$message == "non-numeric argument to binary operator", errors)
+if (length(this_error) > 0) {
+  list(
+    correct = FALSE,
+    type = "info",
+    message = "Be careful! In R you cannot add a number and a character string!"
+  )
+}
+```

live-runtime/src/scripts/R/setup.R

@@ -23,29 +23,22 @@ options(pager = function(files, ...) {
 options("webr.evaluate.handler" = evaluate::new_output_handler(
   value = function(x, visible) {
     knit_options = list(screenshot.force = FALSE)
-    knit_print.df <- function (x) {
-      method <- getOption("webr.render.df")
-      if (method == "kable") {
-        knitr::knit_print(knitr::kable(x))
-      } else if (method == "paged-table") {
-        knitr::knit_print(rmarkdown::paged_table(x))
-      } else if (method == "gt") {
-        knitr::knit_print(gt::gt(x))
-      } else if (method == "gt-interactive") {
-        knitr::knit_print(x |> gt::gt() |> gt::opt_interactive())
-      } else if (method == "reactable") {
-        knitr::knit_print(reactable::reactable(x), options = knit_options)
-      } else {
-        knitr::knit_print(x, options = knit_options)
-      }
-    }
-
     res <- if (visible) {
-      withVisible(if ("data.frame" %in% class(x)) {
-        knit_print.df(x)
-      } else {
-        knitr::knit_print(x, options = knit_options)
-      })
+      withVisible(
+        knitr::knit_print(
+          if (inherits(x, "data.frame")) {
+            switch(
+              getOption("webr.render.df"),
+              "kable" = knitr::kable(x),
+              "paged-table" = markdown::paged_table(x),
+              "gt" = gt::gt(x),
+              "gt-interactive" = gt::opt_interactive(gt::gt(x)),
+              "reactable" = reactable::reactable(x),
+              x
+            )
+          } else x,
+        options = knit_options)
+      )
     } else list(value = x, visible = FALSE)
     class(res) <- "result"
     res