Adapt to the new database scheme (h5p + learnr + shiny -> events)

Author: phgrosjean

.Rbuildignore

@@ -22,3 +22,4 @@ Makefile
 ^CODE_OF_CONDUCT\.md$
 ^revdep$
 data-raw
+rsconnect

.gitignore

@@ -31,6 +31,9 @@ vignettes/*.pdf
 *_cache/
 /cache/
 
+# RSconnect
+rsconnect/
+
 # Temporary files created by R markdown
 *.utf8.md
 *.knit.md

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: learnitprogress
 Type: Package
-Version: 0.9.0
+Version: 0.10.0
 Title: Report Student Progress in 'LearnIt::R' Courses
 Description: A Shiny app that connects to you LRS ("Learning Record Store"
   database, as created and managed by the 'learnitdown' package) and displays a
@@ -33,7 +33,7 @@ License: MIT + file LICENSE
 URL: https://github.com/learnitr/learnitprogress, https://learnitr.github.io/learnitprogress/
 BugReports: https://github.com/learnitr/learnitprogress/issues
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 Encoding: UTF-8
 Language: en-US

NEWS.md

@@ -1,3 +1,7 @@
+# learnitprogress 0.10.0
+
+-   Update code for new database structure (h5p + shiny + learnr -> events).
+
 # learnitprogress 0.9.0
 
 -   Code developed so far is now placed in the {learnitprogress} package.

R/class.R

@@ -83,9 +83,9 @@ class_aa <- function(aa, url = getOption("learnitr.lrs_url"), as.json = FALSE,
   if (isTRUE(as.json)) {
     switch(aa,
       sdd1mq1 = ,
-      sdd1cq1 = '{ "$regex": "^A0[1-6][^A]", "$options": "" }',
+      sdd1cq1 = '{ "$regex": "^A0[1-5][^A]", "$options": "" }',
       sdd1mq2 = ,
-      sdd1cq2 = '{ "$regex": "^A(0[7-9])|(1[0-2])[^A]", "$options": "" }',
+      sdd1cq2 = '{ "$regex": "^A(0[6-9])|(10)[^A]", "$options": "" }',
       sdd1mq3 = ,
       sdd1cq3 = '{ "$regex": "^A(0[1-9])|(1[0-2])[^A]", "$options": "" }',
       sdd2mq1 = ,
@@ -95,17 +95,17 @@ class_aa <- function(aa, url = getOption("learnitr.lrs_url"), as.json = FALSE,
       #sdd2cq3 = '{ "$regex": "^B(09)|(1[0-2])[^A]", "$options": "" }',
       sdd2mq3 = ,
       sdd2cq3 = '{ "$regex": "^B(0[1-9])|(10)[^A]", "$options": "" }',
-      sdd3mq1 = '{ "$regex": "^C0[1-6][^A]", "$options": "" }',
-      sdd3mq3 = '{ "$regex": "^C0[1-6][^A]", "$options": "" }',
-      sdd4mq1 = '{ "$regex": "^D0[1-6][^A]", "$options": "" }',
+      sdd3mq1 = '{ "$regex": "^C0[1-5][^A]", "$options": "" }',
+      sdd3mq3 = '{ "$regex": "^C0[1-5][^A]", "$options": "" }',
+      sdd4mq1 = '{ "$regex": "^D0[1-5][^A]", "$options": "" }',
       #sdd5mq1 = '{ "$regex": "^E0[1-4][^A]", "$options": "" }',
       stop("Not implemented for this aa"))
   } else {
     switch(aa,
       sdd1mq1 = ,
-      sdd1cq1 = "^A0[1-6][^A]",
+      sdd1cq1 = "^A0[1-5][^A]",
       sdd1mq2 = ,
-      sdd1cq2 = "^A(0[7-9])|(1[0-2])[^A]",
+      sdd1cq2 = "^A(0[6-9])|(10)[^A]",
       sdd1mq3 = ,
       sdd1cq3 = "^A(0[1-9])|(1[0-2])[^A]",
       sdd2mq1 = ,
@@ -114,9 +114,9 @@ class_aa <- function(aa, url = getOption("learnitr.lrs_url"), as.json = FALSE,
       sdd2cq2 = "^B(0[6-9])|(10)[^A]",
       sdd2mq3 = ,
       sdd2cq3 = "^B(0[1-9])|(10)[^A]",
-      sdd3mq1 = "^C0[1-6][^A]",
-      sdd3mq3 = "^C0[1-6][^A]",
-      sdd4mq1 = "^D0[1-6][^A]",
+      sdd3mq1 = "^C0[1-5][^A]",
+      sdd3mq3 = "^C0[1-5][^A]",
+      sdd4mq1 = "^D0[1-5][^A]",
       #sdd5mq1 = "^E0[1-4][^A]",
       stop("Not implemented for this aa"))
   }
@@ -127,7 +127,7 @@ class_aa <- function(aa, url = getOption("learnitr.lrs_url"), as.json = FALSE,
 #' @rdname class_logins
 #' @param email The email of the student
 user_login <- function(email, url = getOption("learnitr.lrs_url")) {
-  # Make xsure email is in lowercase
+  # Make sure email is in lowercase
   email <- tolower(email)
   # Get the login associated with a given email address
   # In case we have several login, return the most recent one

R/progression.R

@@ -97,17 +97,18 @@ shiny_prog <- function(user_login, class_logins, class_aa, class_data = NULL,
 # Get Learnr data for a whole class
 learnr_class_prog <- function(class_logins, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_learnr <- try(mongolite::mongo("learnr", url = url), silent = TRUE)
+  mdb_learnr <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_learnr, "try-error"))
     stop("Error: impossible to connect to the learnr database")
 
-  if (!mdb_learnr$count(paste0('{ "login": ', class_logins, ',
+  if (!mdb_learnr$count(paste0('{ "type" : "learnr", "login": ', class_logins, ',
     "app": ', class_aa, ', "max": { "$gt": 0 },
     "verb": { "$in": ["answered", "submitted"] } }')))
     return(NULL)
 
   part1 <- mdb_learnr$aggregate(paste0('[ {
   "$match": {
+    "type" : "learnr",
     "login": ', class_logins, ',
     "app": ', class_aa, ',
     "max": { "$gt": 0 },
@@ -139,6 +140,7 @@ learnr_class_prog <- function(class_logins, class_aa,
   # raw_score_avg
   part2 <- mdb_learnr$aggregate(paste0('[ {
   "$match": {
+    "type" : "learnr",
     "login": ', class_logins, ',
     "app": ', class_aa, ',
     "max": { "$gt": 0 },
@@ -177,17 +179,18 @@ learnr_class_prog <- function(class_logins, class_aa,
 # Get learnrs progression for one student
 learnr_user_prog <- function(user_login, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_learnr <- try(mongolite::mongo("learnr", url = url), silent = TRUE)
+  mdb_learnr <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_learnr, "try-error"))
     stop("Error: impossible to connect to the learnr database")
 
-  if (!mdb_learnr$count(paste0('{ "login": "', user_login, '",
+  if (!mdb_learnr$count(paste0('{ "type" : "learnr", "login": "', user_login, '",
     "app": ', class_aa, ', "max": { "$gt": 0 },
     "verb": { "$in": ["answered", "submitted"] } }')))
     return(NULL)
 
   mdb_learnr$aggregate(paste0('[ {
   "$match": {
+    "type" : "learnr",
     "login": "', user_login, '",
     "app": ', class_aa, ',
     "max": { "$gt": 0 },
@@ -218,16 +221,17 @@ learnr_user_prog <- function(user_login, class_aa,
 # Get H5P data for a whole class
 h5p_class_prog <- function(class_logins, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_h5p <- try(mongolite::mongo("h5p", url = url), silent = TRUE)
+  mdb_h5p <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_h5p, "try-error"))
     stop("Error: impossible to connect to the H5P database")
 
-  if (!mdb_h5p$count(paste0('{ "login": ', class_logins, ',
+  if (!mdb_h5p$count(paste0('{ "type" : "h5p", "login": ', class_logins, ',
     "app": ', class_aa, ' }')))
     return(NULL)
 
   part1 <- mdb_h5p$aggregate(paste0('[ {
   "$match": {
+    "type" : "h5p",
     "login": ', class_logins, ',
     "app": ', class_aa, '
   }
@@ -253,6 +257,7 @@ h5p_class_prog <- function(class_logins, class_aa,
 
   part2 <- mdb_h5p$aggregate(paste0('[ {
   "$match": {
+    "type" : "h5p",
     "login": ', class_logins, ',
     "app": ', class_aa, ',
     "verb": "answered",
@@ -306,16 +311,17 @@ h5p_class_prog <- function(class_logins, class_aa,
 # Get progression in H5P exercises for one student
 h5p_user_prog <- function(user_login, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_h5p <- try(mongolite::mongo("h5p", url = url), silent = TRUE)
+  mdb_h5p <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_h5p, "try-error"))
     stop("Error: impossible to connect to the H5P database")
 
-  if (!mdb_h5p$count(paste0('{ "login": "', user_login, '",
+  if (!mdb_h5p$count(paste0('{ "type" : "h5p", "login": "', user_login, '",
     "app": ', class_aa, ' }')))
     return(NULL)
 
   part1 <- mdb_h5p$aggregate(paste0('[ {
   "$match": {
+    "type" : "h5p",
     "login": "', user_login, '",
     "app": ', class_aa, '
   }
@@ -334,7 +340,7 @@ h5p_user_prog <- function(user_login, class_aa,
   }
 } ]'))
 
-  if (!mdb_h5p$count(paste0('{ "login": "', user_login, '",
+  if (!mdb_h5p$count(paste0('{ "type" : "h5p", "login": "', user_login, '",
     "app": ', class_aa, ', "verb": "answered", "max": { "$gt": 0 } }'))) {
     # Fake data because the student did not answered to anything yet
     n <- nrow(part1)
@@ -343,6 +349,7 @@ h5p_user_prog <- function(user_login, class_aa,
   } else {
     part2 <- mdb_h5p$aggregate(paste0('[ {
   "$match": {
+    "type" : "h5p",
     "login": "', user_login, '",
     "app": ', class_aa, ',
     "verb": "answered",
@@ -389,7 +396,7 @@ h5p_user_prog <- function(user_login, class_aa,
 # Get Shiny apps data for a whole class
 shiny_class_prog <- function(class_logins, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_shiny <- try(mongolite::mongo("shiny", url = url), silent = TRUE)
+  mdb_shiny <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_shiny, "try-error"))
     stop("Error: impossible to connect to the shiny database")
 
@@ -398,12 +405,13 @@ shiny_class_prog <- function(class_logins, class_aa,
   #  "$cond": [ { "$in": ["$verb", ["evaluated"] ] }, "$max", null ]
   #} },
 
-  if (!mdb_shiny$count(paste0('{ "login": ', class_logins, ',
+  if (!mdb_shiny$count(paste0('{ "type" : "shiny", "login": ', class_logins, ',
     "app": ', class_aa, ' }')))
     return(NULL)
 
   mdb_shiny$aggregate(paste0('[ {
   "$match": {
+    "type" : "shiny",
     "login": ', class_logins, ',
     "app": ', class_aa, '
   }
@@ -432,16 +440,17 @@ shiny_class_prog <- function(class_logins, class_aa,
 # Get the progression in Shiny apps for one student
 shiny_user_prog <- function(user_login, class_aa,
     url = getOption("learnitr.lrs_url")) {
-  mdb_shiny <- try(mongolite::mongo("shiny", url = url), silent = TRUE)
+  mdb_shiny <- try(mongolite::mongo("events", url = url), silent = TRUE)
   if (inherits(mdb_shiny, "try-error"))
     stop("Error: impossible to connect to the shiny database")
 
-  if (!mdb_shiny$count(paste0('{ "login": "', user_login, '",
+  if (!mdb_shiny$count(paste0('{ "type" : "shiny", "login": "', user_login, '",
     "app": ', class_aa, ' }')))
     return(NULL)
 
   mdb_shiny$aggregate(paste0('[ {
   "$match": {
+    "type" : "shiny",
     "login": "', user_login, '",
     "app": ', class_aa, '
   }

R/report_progress.R

@@ -39,7 +39,7 @@ report_progress <- function(email, second.course = FALSE, course = NULL,
 
   # In user iemail, I have a lowercase version, but I need -
   # email instead
-  user$iemail <- user$email
+  #No! user$iemail <- user$email
   encode_param <- function(param, data = user) {
     value <- URLencode(as.character(data[[param]]), reserved = TRUE)
     paste0(param, "=", value)
@@ -82,6 +82,7 @@ report_progress <- function(email, second.course = FALSE, course = NULL,
     browseURL(url)
   invisible(url)
 }
+
 #' @export
 #' @rdname report_progress
 run_progress_report <- function(port = 3260) {

R/url.R

@@ -2,6 +2,9 @@
 
 #' Check student profile to identify it from URL's parameters
 #'
+#' @description
+#' Check if a GitHub user profile exists by checking its homepage.
+#'
 #' @param profile Profile data gathered from the LRS
 #' @param url_profile Profile data gathered from the URL
 #'
@@ -47,7 +50,8 @@ check_profile <- function(profile, url_profile) {
 
 #' URL parameters used to identify a student
 #'
-#' # Get the list of required parameters to identify a student from the URL.
+#' @description
+#' Get the list of required parameters to identify a student from the URL.
 #'
 #' @return A character vector with the list of parameters
 #' @details

inst/WORDLIST

@@ -14,6 +14,7 @@ iref
 iurl
 LearnIt
 learnitdown
+learnitprogress
 Learnr
 learnr
 learnrs

inst/shiny/progress-report/app.R

@@ -1,5 +1,5 @@
 # Individual student's progress report for BioDataScience-Course at UMONS
-# Version 3.0.0, Copyright (c), 2021-2024, Philippe Grosjean & Guyliann Engels
+# Version 3.1.0, Copyright (c), 2021-2024, Philippe Grosjean & Guyliann Engels
 #
 # TODO:
 # - Rework to allow using outside of SDD context
@@ -15,14 +15,15 @@
 #date_query_def <- '"date": { "$gt": "2022-09-18 00:00:00.000000" }, '
 
 library(shiny)
+suppressMessages(library(DT))
 #library(shinyjs)
 library(shinybusy)
 library(shinythemes)
 #library(shinyFeedback)
 library(RCurl)
 library(mongolite)
 #library(PKI)
-library(dplyr)
+suppressMessages(library(dplyr))
 library(ggplot2)
 library(cowplot)
 library(fs)
@@ -37,13 +38,9 @@ options(learnitr.lrs_url = getOption("learnitr.lrs_url",
   default = Sys.getenv("LEARNITR_LRS_URL",
     unset = "mongodb://127.0.0.1/sdd")))
 
-mdb_h5p <- mongolite::mongo('h5p', url = getOption("learnitr.lrs_url"))
+# Test connection to the database
+mdb_h5p <- mongolite::mongo('events', url = getOption("learnitr.lrs_url"))
 mdb_h5p$disconnect()
-mdb_learnr <- mongolite::mongo('learnr', url = getOption("learnitr.lrs_url"))
-mdb_learnr$disconnect()
-mdb_shiny <- mongolite::mongo('shiny', url = getOption("learnitr.lrs_url"))
-mdb_shiny$disconnect()
-
 
 # The Shiny app -----------------------------------------------------------
 
@@ -87,7 +84,7 @@ ui <- fluidPage(theme = shinytheme("lumen"),
         h4("Grilles de correction des projets GitHub"),
         htmlOutput("gridMessage"), # Message specific for the correction grids
         selectInput("gridSelect", " ", c()),
-        dataTableOutput("gridTable"),
+        DTOutput("gridTable"),
 
         tags$a("Page d'aide",
           href = "https://wp.sciviews.org/progress-report")
@@ -165,7 +162,8 @@ server <- function(input, output, session) {
 
          } else {# Our app will be in state #3, create the progress report now
            user$login <- user_profile$login
-           user$email <- user_profile$email
+           #user$email <- user_profile$email
+           user$email <- user_data['iemail']
 
            # Get data for the learnrs and the Github activity
            if (is.null(user$course)) {
@@ -426,7 +424,7 @@ server <- function(input, output, session) {
     } else ""
   })
 
-  output$gridTable <- renderDataTable({
+  output$gridTable <- renderDT({
     grid <- input$gridSelect
     if (!is.null(grid) && !is.na(grid) && grid != "") {
       tab <- try(read.csv(grid))