From b9810928e8e04862aea65fba29b4d843bbe2f30a Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 15 Apr 2021 17:06:12 +0000 Subject: [PATCH 1/5] Update Readme --- README.md | 48 +----------------------------------------------- 1 file changed, 1 insertion(+), 47 deletions(-) diff --git a/README.md b/README.md index 9657bbc88..c9d59de1b 100644 --- a/README.md +++ b/README.md @@ -1,48 +1,2 @@ -## learnr: Interactive tutorials for R - - -[![R build status](https://github.com/rstudio/learnr/workflows/R-CMD-check/badge.svg)](https://github.com/rstudio/learnr) -[![CRAN status](https://www.r-pkg.org/badges/version/learnr)](https://CRAN.R-project.org/package=learnr) -[![learnr downloads per month](http://cranlogs.r-pkg.org/badges/learnr)](http://www.rpackages.io/package/learnr) -[![DOI](https://zenodo.org/badge/71377580.svg)](https://zenodo.org/badge/latestdoi/71377580) -
[![RStudio community](https://img.shields.io/badge/community-teaching-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/c/teaching) -[![RStudio community](https://img.shields.io/badge/community-learnr-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/new-topic?title=&category_id=13&tags=learnr&body=%0A%0A%0A%20%20--------%0A%20%20%0A%20%20%3Csup%3EReferred%20here%20by%20%60learnr%60%27s%20GitHub%3C/sup%3E%0A&u=barret) - - -The **learnr** package makes it easy to turn any [R -Markdown](http://rmarkdown.rstudio.com) document into an interactive -tutorial. Tutorials consist of content along with interactive components -for checking and reinforcing understanding. Tutorials can include any or -all of the following: - -1. Narrative, figures, illustrations, and equations. - -2. Videos (supported services include YouTube and Vimeo). - -3. Code exercises (R code chunks that users can edit and execute - directly). - -4. Quiz questions. - -5. Interactive Shiny components. - -You can find documentation on using the **learnr** package here: - - -## FAQ - -#### Error: Deployment Dependencies Not Found - -If your tutorial contains broken code within exercises for users to fix, the CRAN version of [`packrat`](https://github.com/rstudio/packrat/) will not find all of your dependencies to install when the tutorial is deployed. To deploy tutorials containing broken exercise code, install the development version of `packrat`. This version of `packrat` is able to find dependencies per R chunk, allowing for *broken* R chunks within the tutorial file. - -``` r -devtools::install_github("rstudio/packrat") -``` - -#### IE / Edge Support - -`learnr` does not actively support IE11 and Edge. - -- [IE11 not receiving major updates](https://support.microsoft.com/en-us/help/17454/lifecycle-faq-internet-explorer), so I am not pursuing support for IE11. -- [Edge is adopting chromium](https://blogs.windows.com/windowsexperience/2018/12/06/microsoft-edge-making-the-web-better-through-more-open-source-collaboration/). Once updated, Edge *should* work out of the box with many more R packages (including `learnr`) and websites. +Atorus Research fork of https://github.com/rstudio/learnr \ No newline at end of file From bdd89da96fe97cf4bc87847d4efe13abbffa816f Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 15 Apr 2021 17:08:58 +0000 Subject: [PATCH 2/5] revert readme --- README.md | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index c9d59de1b..2ff6eb2a6 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,48 @@ -Atorus Research fork of https://github.com/rstudio/learnr \ No newline at end of file +## learnr: Interactive tutorials for R + + +[![R build status](https://github.com/rstudio/learnr/workflows/R-CMD-check/badge.svg)](https://github.com/rstudio/learnr) +[![CRAN status](https://www.r-pkg.org/badges/version/learnr)](https://CRAN.R-project.org/package=learnr) +[![learnr downloads per month](http://cranlogs.r-pkg.org/badges/learnr)](http://www.rpackages.io/package/learnr) +[![DOI](https://zenodo.org/badge/71377580.svg)](https://zenodo.org/badge/latestdoi/71377580) +
[![RStudio community](https://img.shields.io/badge/community-teaching-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/c/teaching) +[![RStudio community](https://img.shields.io/badge/community-learnr-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/new-topic?title=&category_id=13&tags=learnr&body=%0A%0A%0A%20%20--------%0A%20%20%0A%20%20%3Csup%3EReferred%20here%20by%20%60learnr%60%27s%20GitHub%3C/sup%3E%0A&u=barret) + + +The **learnr** package makes it easy to turn any [R +Markdown](http://rmarkdown.rstudio.com) document into an interactive +tutorial. Tutorials consist of content along with interactive components +for checking and reinforcing understanding. Tutorials can include any or +all of the following: + +1. Narrative, figures, illustrations, and equations. + +2. Videos (supported services include YouTube and Vimeo). + +3. Code exercises (R code chunks that users can edit and execute + directly). + +4. Quiz questions. + +5. Interactive Shiny components. + +You can find documentation on using the **learnr** package here: + + +## FAQ + +#### Error: Deployment Dependencies Not Found + +If your tutorial contains broken code within exercises for users to fix, the CRAN version of [`packrat`](https://github.com/rstudio/packrat/) will not find all of your dependencies to install when the tutorial is deployed. To deploy tutorials containing broken exercise code, install the development version of `packrat`. This version of `packrat` is able to find dependencies per R chunk, allowing for *broken* R chunks within the tutorial file. + +``` r +devtools::install_github("rstudio/packrat") +``` + +#### IE / Edge Support + +`learnr` does not actively support IE11 and Edge. + +- [IE11 not receiving major updates](https://support.microsoft.com/en-us/help/17454/lifecycle-faq-internet-explorer), so I am not pursuing support for IE11. +- [Edge is adopting chromium](https://blogs.windows.com/windowsexperience/2018/12/06/microsoft-edge-making-the-web-better-through-more-open-source-collaboration/). Once updated, Edge *should* work out of the box with many more R packages (including `learnr`) and websites. \ No newline at end of file From e332e5047313811511729c64f22aae4792035ac4 Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 15 Apr 2021 17:15:11 +0000 Subject: [PATCH 3/5] Add hybrid storage function --- R/storage.R | 169 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 169 insertions(+) diff --git a/R/storage.R b/R/storage.R index 679430df2..c7171e7eb 100644 --- a/R/storage.R +++ b/R/storage.R @@ -498,3 +498,172 @@ no_storage <- function() { remove_all_objects = function(tutorial_id, tutorial_version, user_id) {} ) } + +# Storage for storing in browser and restoring from filesystem if cookies are cleared +hybrid_storage <- function(session, dir, compress = TRUE) { + + # helpers to transform ids into valid filesystem paths + id_to_filesystem_path <- function(id) { + id <- gsub("..", "", id, fixed = TRUE) + utils::URLencode(id, reserved = TRUE, repeated = TRUE) + } + id_from_filesystem_path <- function(path) { + utils::URLdecode(path) + } + + # get the path to storage (ensuring that the directory exists) + storage_path <- function(tutorial_id, tutorial_version, user_id) { + path <- file.path(dir, + id_to_filesystem_path(user_id), + id_to_filesystem_path(tutorial_id), + id_to_filesystem_path(tutorial_version)) + if (!utils::file_test("-d", path)) + dir.create(path, recursive = TRUE) + path + } + + # helper to form a unique tutorial context id (note that we don't utilize the user_id + # as there is no concept of server-side user in client_storage, user scope is 100% + # determined by connecting user agent) + tutorial_context_id <- function(tutorial_id, tutorial_version) { + paste(tutorial_id, tutorial_version, sep = "-") + } + + # get a reference to the session object cache for a gvien tutorial context + object_store <- function(context_id) { + + # create session objects on demand + session_objects <- learnr:::read_request(session, "tutorial.session_objects") + if (is.null(session_objects)) { + # MS Update: if the session object + session_objects <- new.env(parent = emptyenv()) + learnr:::write_request(session, "tutorial.session_objects", session_objects) + } + + # create entry for this context on demand + if (!exists(context_id, envir = session_objects)) + assign(context_id, new.env(parent = emptyenv()), envir = session_objects) + store <- get(context_id, envir = session_objects) + + # return reference to the store + store + } + + list( + + type = "hybrid", + + save_object = function(tutorial_id, tutorial_version, user_id, object_id, data, disk_write = TRUE) { + + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + objects_path <- storage_path(tutorial_id, tutorial_version, user_id) + + assign(object_id, data, envir = store) + + tryCatch({ + # broadcast to client + session$sendCustomMessage("tutorial.store_object", list( + context = context_id, + id = object_id, + data = jsonlite::base64_enc(serialize(data, connection = NULL)) + )) + }, error = function(e) { + warning(paste0("Error In client save broadcast", e)) + }) + + + # Save to disk storage + if(dir.exists(file.path(storage_path(tutorial_id, tutorial_version, user_id)))) { + object_path <- file.path(storage_path(tutorial_id, tutorial_version, user_id), + paste0(id_to_filesystem_path(object_id), ".rds")) + saveRDS(data, file = object_path, compress = compress) + } + }, + + + get_object = function(tutorial_id, tutorial_version, user_id, object_id) { + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + if (exists(object_id, envir = store)) + get(object_id, envir = store) + else + NULL + }, + + get_objects = function(tutorial_id, tutorial_version, user_id) { + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + objects <- list() + + # If there is only one thing in the client storage, its just the most + # recent viewed page and the browser cookies may have been cleared. + # Restore them from disk if available + if (length(ls(store)) == 1) { + objects_path <- storage_path(tutorial_id, tutorial_version, user_id) + for (object_path in list.files(objects_path, pattern = utils::glob2rx("*.rds"))) { + + object <- readRDS(file.path(objects_path, object_path)) + object_id <- sub("\\.rds$", "", id_from_filesystem_path(object_path)) + objects[[length(objects) + 1]] <- object + + ## Write out to cookies + objects_path <- storage_path(tutorial_id, tutorial_version, user_id) + + # save the object to our in-memory store + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + assign(object_id, object, envir = store) + + # broadcast to client + tryCatch({ + session$sendCustomMessage("tutorial.store_object", list( + context = context_id, + id = object_id, + data = jsonlite::base64_enc(serialize(object, connection = NULL)) + )) + }, error = function(e){ + warning(paste0("Failed to restore Cookies", e)) + }) + } + } else { + for (object in ls(store)){ + objects[[length(objects) + 1]] <- get(object, envir = store) + } + } + objects + }, + + remove_all_objects = function(tutorial_id, tutorial_version, user_id) { + # remove on client side + tryCatch({ + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + rm(list = ls(store), envir = store) + + }, error = function(e) { + warning(paste0("Failed to remove client storage ", e)) + }) + + # Remove on server side + tryCatch({ + objects_path <- storage_path(tutorial_id, tutorial_version, user_id) + unlink(objects_path, recursive = TRUE) + }, error = function(e){ + warning("Failed to remove disk storage") + }) + + }, + + # function called from initialize to prime object storage from the browser db + initialize_objects_from_client = function(tutorial_id, tutorial_version, user_id, objects) { + print("Initializing from client") + context_id <- tutorial_context_id(tutorial_id, tutorial_version) + store <- object_store(context_id) + for (object_id in names(objects)) { + data <- unserialize(base64_dec(objects[[object_id]])) + assign(object_id, data, envir = store) + } + } + ) +} From e56485d226303142cfeb14a8d795ce67643f911d Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 15 Apr 2021 21:04:48 +0000 Subject: [PATCH 4/5] add hybrid_storage --- NEWS.md | 1 + R/storage.R | 6 +++--- tests/testthat/test-storage.R | 35 ++++++++++++++++++++++++++++++++++- 3 files changed, 38 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index adfd6f4bd..f757349bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,7 @@ learnr (development version) * Previously, when a question submission was reset, it would be recorded as a `"question_submission"` event with the value `reset=TRUE`. Now it a separate event, `"reset_question_submission"`. ([#398](https://github.com/rstudio/learnr/pull/398)) * Added a new `polyglot` tutorial to learnr. This tutorial displays mixing R, python, and sql exercises. See [`run_tutorial("polyglot", "learnr")`](https://learnr-examples.shinyapps.io/polyglot) for a an example. ([#397](https://github.com/rstudio/learnr/pull/397)) * Text throughout the learnr interface can be customized or localized using the new `language` argument of `tutorial()`. Translations for English and French are provided and contributes will be welcomed. Read more about these features in `vignette("multilang", package = "learnr")`. ([#456](https://github.com/rstudio/learnr/pull/456), [#479](https://github.com/rstudio/learnr/pull/479)) +* Added a new storage helper function. Hybrid storage combines the client and filesystem storage methods by using the client's cookies to restore data when available, and turning to the filesystem when they are not. This combines the speed of restoring locally with the persistence of storing on a filesystem. ## Minor new features and improvements diff --git a/R/storage.R b/R/storage.R index c7171e7eb..c0b6a7614 100644 --- a/R/storage.R +++ b/R/storage.R @@ -533,11 +533,11 @@ hybrid_storage <- function(session, dir, compress = TRUE) { object_store <- function(context_id) { # create session objects on demand - session_objects <- learnr:::read_request(session, "tutorial.session_objects") + session_objects <- read_request(session, "tutorial.session_objects") if (is.null(session_objects)) { # MS Update: if the session object session_objects <- new.env(parent = emptyenv()) - learnr:::write_request(session, "tutorial.session_objects", session_objects) + write_request(session, "tutorial.session_objects", session_objects) } # create entry for this context on demand @@ -599,7 +599,7 @@ hybrid_storage <- function(session, dir, compress = TRUE) { # If there is only one thing in the client storage, its just the most # recent viewed page and the browser cookies may have been cleared. # Restore them from disk if available - if (length(ls(store)) == 1) { + if (length(ls(store)) <= 1) { objects_path <- storage_path(tutorial_id, tutorial_version, user_id) for (object_path in list.files(objects_path, pattern = utils::glob2rx("*.rds"))) { diff --git a/tests/testthat/test-storage.R b/tests/testthat/test-storage.R index 4d43eb106..bbb7b97fa 100644 --- a/tests/testthat/test-storage.R +++ b/tests/testthat/test-storage.R @@ -12,4 +12,37 @@ test_that("objects cna be saved into filesystem storage", { obj <- fs$get_object("tutorial_id", "tutorial_version", "user_id", "object_id") expect_equal(obj, "data") fs$remove_all_objects("tutorial_id", "tutorial_version", "user_id") -}) \ No newline at end of file +}) + + +## Commented out because "testServer" can not test anyhting that uses 'session$request' + +# td <- tempdir() +# +# server <- function(input, output, session){} +# +# testServer(server, { +# hs <- hybrid_storage(session, td) +# context_id <- tutorial_context_id(tutorial_id, tutorial_version) +# store <- object_store(context_id) +# +# hs$save_object("tutorial_id", "tutorial_version", "user_id", "object_id", "data") +# +# # Object is saved in both locations +# stopifnot(length(list.files(td)) == 1) +# stopifnot(length(ls(store)) == 1) +# stopifnot(identical( +# hs$get_object("tutorial_id", "tutorial_version", "user_id", "object_id"), +# "data" +# )) +# +# # Object is removed from cookies but is still present in filesystem +# client_storage(session)$remove_all_objects("tutorial_id", "tutorial_version", "user_id") +# stopifnot(length(ls(store)) == 0) +# stopifnot(length(list.files(td)) == 1) +# +# # When objects are pulled in, they are also stored in +# objs <- hs$get_objects("tutorial_id", "tutorial_version", "user_id") +# stopifnot(identical(objs, list("data"))) +# stopifnot(length(ls(store)) == 1) +# }) From e5424ea0b63e7b47bae7964d77a20566a75e01b7 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 26 Apr 2021 15:21:12 +0000 Subject: [PATCH 5/5] Add in reconciliation for differences between disk and client storage --- R/storage.R | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/R/storage.R b/R/storage.R index c0b6a7614..45043d203 100644 --- a/R/storage.R +++ b/R/storage.R @@ -595,20 +595,20 @@ hybrid_storage <- function(session, dir, compress = TRUE) { context_id <- tutorial_context_id(tutorial_id, tutorial_version) store <- object_store(context_id) objects <- list() + objects_path <- storage_path(tutorial_id, tutorial_version, user_id) - # If there is only one thing in the client storage, its just the most - # recent viewed page and the browser cookies may have been cleared. - # Restore them from disk if available - if (length(ls(store)) <= 1) { - objects_path <- storage_path(tutorial_id, tutorial_version, user_id) - for (object_path in list.files(objects_path, pattern = utils::glob2rx("*.rds"))) { + for(file in list.files(objects_path, pattern = utils::glob2rx("*.rds"))) { + obj_name <- tools::file_path_sans_ext(file) - object <- readRDS(file.path(objects_path, object_path)) - object_id <- sub("\\.rds$", "", id_from_filesystem_path(object_path)) - objects[[length(objects) + 1]] <- object + # If item isn't in current store + if(!exists(obj_name, envir = store)) { + + if(obj_name == client_state_object_id) next - ## Write out to cookies objects_path <- storage_path(tutorial_id, tutorial_version, user_id) + object <- readRDS(file.path(objects_path, file)) + object_id <- sub("\\.rds$", "", id_from_filesystem_path(file)) + objects[[length(objects) + 1]] <- object # save the object to our in-memory store context_id <- tutorial_context_id(tutorial_id, tutorial_version) @@ -625,12 +625,15 @@ hybrid_storage <- function(session, dir, compress = TRUE) { }, error = function(e){ warning(paste0("Failed to restore Cookies", e)) }) + + # Item is found in current store + } else { + objects[[length(objects) + 1]] <- get(obj_name, envir = store) } - } else { - for (object in ls(store)){ - objects[[length(objects) + 1]] <- get(object, envir = store) - } + } + + objects },