Change names for portability. Reworking of 02a_base, and addition of recording/checking functions

Author: phgrosjean

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BioDataScience
 Type: Package
-Version: 0.1.2
+Version: 0.2.0
 Title: A Series of Learnr Documents for Biological Data Science
 Description: Interactive documents using learnr for studying biological data science.
 Authors@R: c(
@@ -10,7 +10,7 @@ Authors@R: c(
   email = "guyliann.engels@umons.ac.be"))
 Maintainer: Philippe Grosjean <phgrosjean@sciviews.org>
 Depends: R (>= 3.3.0)
-Imports: learnr, httr, jsonlite, remotes
+Imports: learnr, httr, jsonlite, remotes, svMisc, mongolite
 Suggests: SciViews, ggplot2, ggpubr, data.io, flow, chart, covr, knitr, testthat
 License: CC BY-SA 4.0
 Encoding: UTF-8

NAMESPACE

@@ -1,14 +1,22 @@
 # Generated by roxygen2: do not edit by hand
 
+export(checker_sdd)
+export(record_sdd)
 export(run)
+export(send_mail_sdd)
 importFrom(httr,GET)
 importFrom(httr,authenticate)
 importFrom(httr,content)
 importFrom(httr,parse_url)
 importFrom(httr,status_code)
+importFrom(jsonlite,base64_dec)
+importFrom(jsonlite,base64_enc)
 importFrom(jsonlite,fromJSON)
 importFrom(learnr,run_tutorial)
+importFrom(mongolite,mongo)
 importFrom(remotes,install_github)
+importFrom(svMisc,list_to_json)
 importFrom(utils,compareVersion)
+importFrom(utils,create.post)
 importFrom(utils,packageVersion)
 importFrom(utils,select.list)

R/BioDataScience-package.R

@@ -11,7 +11,9 @@
 #'
 #' @importFrom learnr run_tutorial
 #' @importFrom httr content status_code parse_url authenticate GET
-#' @importFrom jsonlite fromJSON
-#' @importFrom utils compareVersion packageVersion select.list
+#' @importFrom jsonlite fromJSON base64_dec base64_enc
+#' @importFrom utils compareVersion packageVersion select.list create.post
 #' @importFrom remotes install_github
+#' @importFrom svMisc list_to_json
+#' @importFrom mongolite mongo
 NULL

R/checker_sdd.R

@@ -0,0 +1,41 @@
+#' A default checker that just aknowledge submission
+#'
+#' @param label The label for the learnr exercice.
+#' @param user_code The code submitted by the user.
+#' @param check_code The code to check against.
+#' @param envir_result The environment for results.
+#' @param evaluate_result Result from evaluation of the code.
+#' @param ... Additional parameters.
+#'
+#' @description Check code submitted during an exercice. This version just
+#' acknowledges reception of the submission. This function is used internally
+#' by the tutorials and is not intended for the end-user.
+#'
+#' @return A list with components `message`, `correct` and `location`.
+#' @export
+#' @seealso [run()]
+#' @keywords utilities
+#' @concept record events from the BioDataScience package
+checker_sdd <- function(label, user_code, check_code, envir_result,
+evaluate_result, ...) {
+  list(message = "Your answer is recorded!", correct = TRUE, location = "append")
+}
+#Use: tutorial_options(exercise.checker = checker_sdd)
+#
+# Later, we would do something like this:
+#library(checkr)
+#tutorial_options(exercise.checker = checkr::check_for_learnr)
+#check_two_plus_two <- function(USER_CODE) {
+#  code <- for_checkr(USER_CODE)
+#  # The messages
+#  m1 <- "Correct!"
+#  m2 <- "You should use the '+' operator."
+#  m3 <- "Another error."
+#  m4 <- "Again another error message."
+#
+#  result <- line_where(code,
+#                      passif(Z == "+"),
+#                      failif(Z == "", m3),
+#                      failif(TRUE, m4))
+#  result
+#}

R/record_sdd.R

@@ -0,0 +1,71 @@
+#' Record results on a centralized database
+#'
+#' @param tutorial_id The identifier of the tutorial.
+#' @param tutorial_version The version of the tutorial.
+#' @param user_id The user identifier for this learnr process.
+#' @param event The event that triggers the record, like `exercise_submission`
+#' or `question_submission`
+#' @param data A JSON field with event-dependent data content.
+#'
+#' @description Record tutorial submissions in a centralized database. The
+#' function is used by learnr tutorials and is not for end-users.
+#'
+#' @return Nothing. The function is used for its side-effects.
+#' @export
+#' @seealso [run()]
+#' @keywords utilities
+#' @concept record events from the BioDataScience package
+record_sdd <- function(tutorial_id, tutorial_version, user_id, event, data) {
+  bds_file <- "~/.local/share/R/learnr/biodatascience"
+  add_file_base64 <- function(entry, file) {
+    str <- gsub("\n", "", base64_enc(serialize(entry, NULL)))
+    dir.create(dirname(file), showWarnings = FALSE, recursive = TRUE)
+    cat(str, "\n", file = file, append = TRUE)
+  }
+  user_name <- suppressWarnings(system("git config user.name",
+    intern = TRUE, ignore.stderr = TRUE))
+  user_email <- suppressWarnings(system("git config user.email",
+    intern = TRUE, ignore.stderr = TRUE))
+  #user_full_id <- paste(user_id, user_name, user_email, sep = "/")
+  date <- Sys.time()
+  label <- data$label
+  if (is.null(label)) label <- ""
+  data$label <- NULL
+  correct <- data$correct
+  if (is.null(correct)) {
+    correct <- data$feedback$correct
+    if (is.null(correct))
+      correct <- ""
+  }
+  data$correct <- NULL
+  entry <- data.frame(date = date, tutorial = tutorial_id,
+    version = tutorial_version, user = user_id, user_name = user_name,
+    user_email = user_email, label = label, correct = correct, event = event,
+    data = list_to_json(data))
+  if (correct == "") {
+    add_file_base64(entry, file = bds_file)
+    return()
+  }
+  # Once http request with stitch will be available, we could do something like
+  #https://stitch.mongodb.com/api/client/v2.0/app/sdd-relay-aizkd/service/sdd-http/incoming_webhook/webhook0
+  m <- try(mongo("ex01",
+    #url = "mongodb://sdd:sdd@ds125388.mlab.com:25388/sdd-test")$insert(entry)
+    url = "mongodb://sdd:sdd@sdd-umons-shard-00-00-umnnw.mongodb.net:27017,sdd-umons-shard-00-01-umnnw.mongodb.net:27017,sdd-umons-shard-00-02-umnnw.mongodb.net:27017/test?ssl=true&replicaSet=sdd-umons-shard-0&authSource=admin"),
+    silent = TRUE)
+  if (!inherits(m, "try-error") &&
+      m$run(command = "{\"ping\": 1}", simplify = TRUE)$ok == 1) {
+    m$insert(entry)
+    # If there is something in the biodatascience file, inject it also now
+    if (file.exists(bds_file)) {
+      dat <- readLines(bds_file)
+      unlink(bds_file)
+      if (length(dat))
+        for (i in 1:length(dat))
+          m$insert(unserialize(base64_dec(dat[i])))
+    }
+    m$disconnect()
+  } else {# MongoDB database not available... save locally
+    add_file_base64(entry, file = bds_file)
+  }
+}
+# Use: options(tutorial.event_recorder = record_sdd)

R/run.R

@@ -10,16 +10,18 @@
 #' @description Start the learnr R engine in the current R session with the
 #' selected tutorial.
 #'
-#' @return If `tutorial` is not provided, a list of available tutorials.
+#' @return If `tutorial` is not provided, in interactive mode with `ask = TRUE`,
+#' you have to select one in a list, and in non interactive mode, or
+#' `ask = FALSE`, it returns the list of all available tutorials.
 #' @export
 #' @seealso [run_tutorial()]
 #' @keywords utilities
 #' @concept run interactive learnr documents from the BioDataScience package
 #' @examples
-#' # To list the available tutorials:
+#' # To start from a list of available tutorials:
 #' run()
 #' \dontrun{
-#' run("module02a_nuage_de_points")
+#' run("02b_nuage_points")
 #' }
 run <- function(tutorial, ..., update = ask, ask = interactive()) {
   # devtools:::github_GET() and dependencies are not exported.

R/send_mail_sdd.R

@@ -0,0 +1,43 @@
+#' Send your BioDataScience submissions by email
+#'
+#' @param file The file that contains your submissions information.
+#'
+#' @description Your submissions are send to a central database. However, in
+#' case that database is not accessible, the data is stored locally. This
+#' function uses your plain email to send your records. Note that, once the
+#' email is created, the local version of your records is reset. So, if you
+#' finally decide to NOT send the eamil, these records are lost (in this case,
+#' call your teachers to recover them, if you have to.)
+#'
+#' @return The data are returned invisibly.
+#' @export
+#' @seealso [run()]
+#' @keywords utilities
+#' @concept run interactive learnr documents from the BioDataScience package
+#' @examples
+#' # To start from a list of available tutorials:
+#' run()
+#' \dontrun{
+#' run("02b_nuage_points")
+#' }
+send_mail_sdd <- function(file = "~/.local/share/R/learnr/biodatascience") {
+  if (file.exists(file)) {
+    data <- readLines(file)
+    file.rename(file, paste0(file, ".bak")) # One backup, just in case!
+    create.post("Dear BioDataScience user,
+
+Send this email without changing recipient, title and bottom of the message
+to record your tutorial activities.
+
+Thanks,
+
+The BioDataScience Team
+",
+      description = "post", info = data,
+      subject = "sdd-umons", address = "sdd@sciviews.org")
+    invisible(data)
+  } else {
+    message("Nothing to send to the BioDataScience database")
+    invisible(character(0))
+  }
+}