├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── encode.R ├── extract.R ├── learnrhash-package.R └── shiny.R ├── README.Rmd ├── README.md ├── inst ├── demo_bad_logic.Rmd ├── demo_bad_ui.Rmd ├── demo_iframe.Rmd ├── demo_min.Rmd ├── demo_state.Rmd ├── demo_types.Rmd ├── example.rds └── svg │ ├── clipboard.svg │ └── cursor.svg ├── learnrhash.Rproj ├── man ├── decode_obj.Rd ├── encode_obj.Rd ├── extract.Rd ├── figures │ ├── decode.gif │ └── encode.gif ├── learnr_elements.Rd └── reexports.Rd └── tests ├── testthat.R └── testthat ├── test-encode.R └── test-extract.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.github$ 4 | ^LICENSE\.md$ 5 | ^README\.Rmd$ 6 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - master 5 | pull_request: 6 | branches: 7 | - master 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: macOS-latest 14 | steps: 15 | - uses: actions/checkout@v2 16 | - uses: r-lib/actions/setup-r@master 17 | - name: Install dependencies 18 | run: | 19 | install.packages(c("remotes", "rcmdcheck")) 20 | remotes::install_deps(dependencies = TRUE) 21 | shell: Rscript {0} 22 | - name: Check 23 | run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error") 24 | shell: Rscript {0} 25 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: master 4 | 5 | name: pkgdown 6 | 7 | jobs: 8 | pkgdown: 9 | runs-on: macOS-latest 10 | env: 11 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: r-lib/actions/setup-r@master 16 | 17 | - uses: r-lib/actions/setup-pandoc@master 18 | 19 | - name: Query dependencies 20 | run: | 21 | install.packages('remotes') 22 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 23 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 24 | shell: Rscript {0} 25 | 26 | - name: Cache R packages 27 | uses: actions/cache@v1 28 | with: 29 | path: ${{ env.R_LIBS_USER }} 30 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 31 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 32 | 33 | - name: Install dependencies 34 | run: | 35 | remotes::install_deps(dependencies = TRUE) 36 | install.packages("pkgdown") 37 | shell: Rscript {0} 38 | 39 | - name: Install package 40 | run: R CMD INSTALL . 41 | 42 | - name: Deploy package 43 | run: | 44 | git config --local user.email "actions@github.com" 45 | git config --local user.name "GitHub Actions" 46 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | inst/*.html 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: learnrhash 2 | Type: Package 3 | Title: Tools for hashing learnr sessions 4 | Version: 0.2.0 5 | Authors@R: 6 | c(person(given = "Colin", 7 | family = "Rundel", 8 | role = c("aut", "cre"), 9 | email = "rundel@gmail.com"), 10 | person(given = "Mine", 11 | family = "Cetinkaya-Rundel", 12 | role = "aut", 13 | email = "mine@rstudio.com") 14 | ) 15 | Description: This package provides tools for the hashing of learnr sessions. 16 | The resulting hashes are presented as base64 encoded strings which can easily 17 | be copied into a web form, LMS submission tool, etc. 18 | License: MIT + file LICENSE 19 | Encoding: UTF-8 20 | LazyData: true 21 | Imports: 22 | learnr (> 0.10.1), 23 | shiny, 24 | base64enc, 25 | dplyr, 26 | tidyr, 27 | purrr, 28 | clipr, 29 | rlang, 30 | tibble, 31 | magrittr 32 | Roxygen: list(markdown = TRUE) 33 | RoxygenNote: 7.1.2 34 | Suggests: 35 | testthat 36 | Depends: 37 | R (>= 3.5.0) 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: Colin Rundel 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 Colin Rundel 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(decode_obj) 5 | export(decoder_logic) 6 | export(decoder_ui) 7 | export(default_ui) 8 | export(encode_obj) 9 | export(encoder_logic) 10 | export(encoder_ui) 11 | export(extract_exercises) 12 | export(extract_hash) 13 | export(extract_questions) 14 | export(iframe_ui) 15 | importFrom(magrittr,"%>%") 16 | importFrom(rlang,.data) 17 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # learnrhash (development version) 2 | 3 | # learnrhash 0.2.0 4 | 5 | * Use learnr's new functionality for sharing state (#14) 6 | 7 | * Cleaned up included demo Rmds 8 | 9 | 10 | # learnrhash 0.1.1 11 | 12 | * Added a `NEWS.md` file to track changes to the package. 13 | 14 | * Added `strip_output` argument to `encoder_logic` to help keep hash sizes down. 15 | 16 | * Added javascript support for selecting and copying hash to clipboard. 17 | -------------------------------------------------------------------------------- /R/encode.R: -------------------------------------------------------------------------------- 1 | #' Encode an R object into hashed text 2 | #' 3 | #' @param obj R object 4 | #' @param compress Compression method. 5 | #' 6 | #' @export 7 | encode_obj = function(obj, compress = c("bzip2", "gzip", "xz", "none")) { 8 | compress = match.arg(compress) 9 | 10 | raw = serialize(obj, NULL) 11 | comp_raw = memCompress(raw, type = compress) 12 | 13 | base64enc::base64encode(comp_raw) 14 | } 15 | 16 | #' Decode hashed text into an R object 17 | #' 18 | #' @param txt Hashed text. 19 | #' @param compress Compression method. 20 | #' 21 | #' @export 22 | decode_obj = function(txt, compress = c("bzip2", "gzip", "xz", "none")) { 23 | compress = match.arg(compress) 24 | 25 | if (txt == "") 26 | return(list()) 27 | 28 | res = try({ 29 | comp_raw = base64enc::base64decode(txt) 30 | raw = memDecompress(comp_raw, type = compress) 31 | unserialize(raw) 32 | }, silent = TRUE) 33 | 34 | if (inherits(res, "try-error")) 35 | res = list() 36 | 37 | res 38 | } 39 | -------------------------------------------------------------------------------- /R/extract.R: -------------------------------------------------------------------------------- 1 | #' @rdname extract 2 | #' @name extract 3 | #' 4 | #' @title Extract hash contents 5 | #' 6 | #' @description 7 | #' The following are helper functions for extracting data from hashed learnr solutions. 8 | #' 9 | #' * `extract_hash` - extracts the contents of the hashes into label, type, answer, correct, and timestamp columns 10 | #' 11 | #' * `extract_questions` - extracts the contents of the hashes for answered questions. 12 | #' 13 | #' * `extract_exercises` - extracts the contents of the hashes for answered exercises. 14 | #' 15 | #' @param df Data Frame. A data frame containing hash in a character column. 16 | #' @param hash Character. The name of the column containing the hashes 17 | #' 18 | NULL 19 | 20 | fix_empty_state_obj = function(obj) { 21 | if (length(obj) == 0) { 22 | list( 23 | list( 24 | id = NA_character_, 25 | type = NA_character_, 26 | data = NULL 27 | ) 28 | ) 29 | } else { 30 | obj 31 | } 32 | } 33 | 34 | #' @rdname extract 35 | #' @export 36 | extract_hash = function(df, hash = "hash") { 37 | d = df %>% 38 | dplyr::rename(hash = .data[[hash]]) %>% 39 | dplyr::mutate( 40 | hash = lapply(.data[[hash]], learnrhash::decode_obj), 41 | hash = lapply(.data[[hash]], fix_empty_state_obj) 42 | ) %>% 43 | tidyr::unnest_longer(.data[[hash]]) %>% 44 | tidyr::unnest_wider(.data[[hash]]) %>% 45 | dplyr::relocate(.data[["label"]], .before="type") 46 | 47 | if (is.null(d[["data"]])) 48 | d$data = list(NULL) 49 | 50 | d 51 | } 52 | 53 | #' @rdname extract 54 | #' @export 55 | extract_exercises = function(df, hash = "hash") { 56 | extract_hash(df, hash) %>% 57 | dplyr::filter(.data[["type"]] == "exercise") 58 | } 59 | 60 | #' @rdname extract 61 | #' @export 62 | extract_questions = function(df, hash = "hash") { 63 | extract_hash(df, hash) %>% 64 | dplyr::filter(.data[["type"]] == "question") 65 | } 66 | -------------------------------------------------------------------------------- /R/learnrhash-package.R: -------------------------------------------------------------------------------- 1 | #' @importFrom rlang .data 2 | NULL 3 | 4 | #' @importFrom magrittr %>% 5 | #' @export 6 | magrittr::`%>%` 7 | -------------------------------------------------------------------------------- /R/shiny.R: -------------------------------------------------------------------------------- 1 | #' @rdname learnr_elements 2 | #' @name learnr_elements 3 | #' 4 | #' @title Learnr addon elements 5 | #' 6 | #' @description 7 | #' The following are addon element for learnr tutorials that enable the encoding and 8 | #' decoding of hashed learnr solutions. 9 | #' 10 | #' Note that when including these functions in a learnr Rmd document it is necessary that 11 | #' the logic functions, `*_logic()`, be included in an R chunk where `context="server"` as 12 | #' they interact with the underlying Shiny functionality. Conversely, any of the ui functions, 13 | #' `*_ui()`, must *not* be included in an R chunk with a `context`. Both types of functions 14 | #' have been written to provide useful feedback if they detect they are in the wrong R chunk 15 | #' type. 16 | #' 17 | NULL 18 | 19 | #' @rdname learnr_elements 20 | #' @export 21 | decoder_logic = function() { 22 | p = parent.frame() 23 | check_server_context(p) 24 | 25 | local({ 26 | shiny::observeEvent( 27 | input$decode, 28 | { 29 | output$decode_submissions = shiny::renderText( 30 | learnrhash:::obj_to_text(learnrhash::decode_obj(input$decode_text)) 31 | ) 32 | } 33 | ) 34 | }, envir = p) 35 | } 36 | 37 | #' @rdname learnr_elements 38 | #' @export 39 | decoder_ui = function() { 40 | check_not_server_context(parent.frame()) 41 | 42 | shiny::tags$div( 43 | shiny::textAreaInput("decode_text", "Hash to decode"), 44 | shiny::actionButton("decode", "Decode!"), 45 | shiny::tags$br(), 46 | shiny::tags$br(), 47 | shiny::tags$h4("Submission:"), 48 | wrapped_verbatim_text_output("decode_submissions") 49 | ) 50 | } 51 | 52 | #' @rdname learnr_elements 53 | #' 54 | #' @param strip_output Exercises save their output as html, for exercises 55 | #' that result in plots these can result in very large hashes. The option allows 56 | #' this information to be removed to keep hash sizes more manageable. 57 | #' 58 | #' @export 59 | encoder_logic = function(strip_output = FALSE) { 60 | p = parent.frame() 61 | check_server_context(p) 62 | 63 | # Make this var available within the local context below 64 | assign("strip_output", strip_output, envir = p) 65 | 66 | 67 | # Evaluate in parent frame to get input, output, and session 68 | local({ 69 | encoded_txt = shiny::eventReactive( 70 | input$hash_generate, 71 | { 72 | # shiny::getDefaultReactiveDomain()$userData$tutorial_state 73 | state = learnr:::get_tutorial_state() 74 | shiny::validate(shiny::need(length(state) > 0, "No progress yet.")) 75 | 76 | user_state = purrr::map_dfr(state, identity, .id = "label") 77 | user_state = dplyr::group_by(user_state, .data$label, .data$type, .data$correct) 78 | user_state = dplyr::summarize( 79 | user_state, 80 | answer = list(.data$answer), 81 | timestamp = dplyr::first(.data$timestamp), 82 | .groups = "drop" 83 | ) 84 | user_state = dplyr::relocate(user_state, .data$correct, .before = .data$timestamp) 85 | 86 | learnrhash::encode_obj(user_state) 87 | } 88 | ) 89 | 90 | output$hash_output = shiny::renderText(encoded_txt()) 91 | 92 | }, envir = p) 93 | } 94 | 95 | #' @rdname learnr_elements 96 | #' @param url Link url to use. 97 | #' @export 98 | default_ui = function(url = "http://google.com") { 99 | shiny::div( 100 | "If you have completed this tutorial and are happy with all of your", 101 | "solutions, please click the button below to generate your hash and", 102 | "submit it using the following link:", 103 | shiny::tags$br(), 104 | shiny::tags$h3( 105 | shiny::tags$a(url, href=url, target="_blank") 106 | ), 107 | shiny::tags$br() 108 | ) 109 | } 110 | 111 | #' @rdname learnr_elements 112 | #' @param src Source of the iframe. 113 | #' @param ... Other iframe attributes, e.g. height and width 114 | #' @export 115 | iframe_ui = function(src = "http://google.com", ...) { 116 | shiny::div( 117 | shiny::tags$iframe(src = src, ...), 118 | shiny::tags$br() 119 | ) 120 | } 121 | 122 | #' @rdname learnr_elements 123 | #' 124 | #' @param ui_before Shiny ui elements to include before the hash ui 125 | #' @param ui_after Shiny ui elements to include after the hash ui, 126 | #' 127 | #' @details For either of the ui parameters you can wrap multiple 128 | #' shiny elements together with `shiny::div`. 129 | #' 130 | #' @export 131 | encoder_ui = function(ui_before = default_ui(), ui_after = NULL) { 132 | check_not_server_context(parent.frame()) 133 | 134 | shiny::tags$div( 135 | class = "encoder_ui", 136 | ui_before, 137 | shiny::fixedRow( 138 | shiny::column( 139 | width = 3, 140 | shiny::actionButton("hash_generate", "Generate", title = "Generate hash") 141 | ), 142 | shiny::column(width = 7), 143 | shiny::column( 144 | width = 2, 145 | shiny::tags$div( 146 | class = "btn-group btn-group-sm pull-right", 147 | role = "group", 148 | `aria-label` = "Clipboard buttons", 149 | 150 | shiny::tags$button( 151 | id="hash_select", class="btn btn-default", type="button", 152 | title = "Select hash", 153 | cursor_svg("16px") 154 | ), 155 | 156 | shiny::tags$span(class="btn-separator"), 157 | 158 | shiny::tags$button( 159 | id="hash_copy", class="btn btn-default", type="button", 160 | title = "Copy hash to clipboard", 161 | clipboard_svg("16px") 162 | ) 163 | ) 164 | ), 165 | style = "padding-bottom: 0.5em;" 166 | ), 167 | #shiny::tags$br(), 168 | wrapped_verbatim_text_output("hash_output", TRUE), 169 | shiny::tags$br(), 170 | ui_after, 171 | encoder_clipboard_js() 172 | ) 173 | } 174 | 175 | cursor_svg = function(height) { 176 | shiny::HTML( paste0( 177 | '' 188 | ) ) 189 | } 190 | 191 | clipboard_svg = function(height) { 192 | shiny::HTML( paste0( 193 | '' 204 | ) ) 205 | } 206 | 207 | 208 | encoder_clipboard_js = function() { 209 | list( 210 | shiny::tags$script( shiny::HTML( 211 | "selectText = function(node) { 212 | node = document.getElementById(node); 213 | 214 | if (document.body.createTextRange) { 215 | const range = document.body.createTextRange(); 216 | range.moveToElementText(node); 217 | range.select(); 218 | } else if (window.getSelection) { 219 | const selection = window.getSelection(); 220 | const range = document.createRange(); 221 | range.selectNodeContents(node); 222 | selection.removeAllRanges(); 223 | selection.addRange(range); 224 | } else { 225 | console.warn('Could not select text in node: Unsupported browser.'); 226 | } 227 | }" 228 | ) ), 229 | 230 | shiny::tags$script( shiny::HTML( 231 | "document.getElementById('hash_select').addEventListener('click', function(e) { 232 | e.preventDefault(); 233 | 234 | selectText('hash_output'); 235 | });" 236 | ) ), 237 | 238 | shiny::tags$script( shiny::HTML( 239 | "document.getElementById('hash_copy').addEventListener('click', function(e) { 240 | e.preventDefault(); 241 | 242 | selectText('hash_output'); 243 | document.execCommand('copy'); 244 | });" 245 | ) ) 246 | ) 247 | } 248 | 249 | 250 | 251 | 252 | 253 | 254 | wrapped_verbatim_text_output = function(outputId, placeholder = FALSE) { 255 | x = shiny::verbatimTextOutput(outputId, placeholder) 256 | x$attribs$style = "white-space: pre-wrap;" 257 | 258 | x 259 | } 260 | 261 | 262 | 263 | is_server_context = function(.envir) { 264 | # We are in the server context if there are the follow: 265 | # * input - input reactive values 266 | # * output - shiny output 267 | # * session - shiny session 268 | # 269 | # Check context by examining the class of each of these. 270 | # If any is missing then it will be a NULL which will fail. 271 | 272 | inherits(.envir$input, "reactivevalues") & 273 | inherits(.envir$output, "shinyoutput") & 274 | inherits(.envir$session, "ShinySession") 275 | } 276 | 277 | check_not_server_context = function(.envir) { 278 | if (is_server_context(.envir)) { 279 | calling_func = deparse(sys.calls()[[sys.nframe()-1]]) 280 | 281 | err = paste0( 282 | "Function `", calling_func,"`", 283 | " must *not* be called from an Rmd chunk where `context = \"server\"`" 284 | ) 285 | 286 | # The following seems to be necessary - since this is in the server context 287 | # it will not run at compile time 288 | shiny::stopApp() 289 | 290 | stop(err, call. = FALSE) 291 | } 292 | } 293 | 294 | check_server_context = function(.envir) { 295 | if (!is_server_context(.envir)) { 296 | calling_func = deparse(sys.calls()[[sys.nframe()-1]]) 297 | 298 | err = paste0( 299 | "Function `", calling_func,"`", 300 | " must be called from an Rmd chunk where `context = \"server\"`" 301 | ) 302 | 303 | stop(err, call. = FALSE) 304 | } 305 | } 306 | 307 | obj_to_text = function(obj) { 308 | text = utils::capture.output(print(obj)) 309 | 310 | paste(text, collapse="\n") 311 | } 312 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | ```{r setup, echo=FALSE} 6 | library(tibble) 7 | ``` 8 | 9 | # learnrhash 10 | 11 | 12 | [![R build status](https://github.com/rundel/learnrhash/workflows/R-CMD-check/badge.svg)](https://github.com/rundel/learnrhash/actions) 13 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 14 | 15 | 16 | ## Installation 17 | 18 | This package is still in the early stages of development and currently is only available from GitHub. To install the development version run the following: 19 | 20 | ```r 21 | # install.packages("devtools") 22 | devtools::install_github("rundel/learnrhash") 23 | ``` 24 | 25 | ## Usage 26 | 27 | This package is meant to provide addition tools for collection student answers to [learnr](https://rstudio.github.io/learnr/) tutorials. 28 | The package does not transmit the answers in any way, but instead provides a convenient method to generate a compressed text based representation that can be easily copied and pasted. The students can then submit these solutions by pasting this "hash" into an online web form (e.g. Google Forms, Microsoft Forms, etc.) or a learning management system quiz or assignment tool. 29 | 30 | To enable this functionality, all you need to do is include the following in a learnr Rmd document: 31 | ```` 32 | ## Submit 33 | 34 | `r ''````{r context="server"} 35 | learnrhash::encoder_logic() 36 | ``` 37 | 38 | `r ''````{r encode, echo=FALSE} 39 | learnrhash::encoder_ui() 40 | ``` 41 | ```` 42 | which results in the Submit topic appearing in the tutorial with all of the necessary shiny logic and ui inserted, as shown below. 43 | 44 | ![Encode solutions](man/figures/encode.gif) 45 | 46 | In the example above a url for http://localhost given, this value can be replaced with whatever link you would like to use for submission. 47 | All the students will need to do is to paste the generated hash into a text response field on whatever web form you choose to use. 48 | 49 | ## Working with Hashes 50 | 51 | The expectation is that after students submit their solutions you will be able to obtain some tabular representation of these results that can be read into R as a data frame. 52 | The package includes a simple example of this type of data which is loaded as follows 53 | 54 | ```{r} 55 | example = readRDS(system.file("example.rds", package="learnrhash")) 56 | example 57 | ``` 58 | 59 | Currently the package provides two functions for extracting question solutions and exercise solutions from these hashed data, for both functions the only required argument is the name of the column containing the hashed solutions 60 | 61 | To extract the all submissions use, 62 | ```{r} 63 | learnrhash::extract_hash(example) 64 | ``` 65 | 66 | and to get just the exercises, 67 | ```{r} 68 | learnrhash::extract_exercises(example) 69 | ``` 70 | or questions, 71 | ```{r} 72 | learnrhash::extract_questions(example) 73 | ``` 74 | 75 | If you would like to experiment with this decoding and extraction while writing your tutorial you can also include decoding logic and ui elements into the tutorial in a similar way that the encoder was included. 76 | Simply add the following lines into your Rmd, 77 | ```` 78 | ## Decode 79 | 80 | `r ''````{r context="server"} 81 | learnrhash::decoder_logic() 82 | ``` 83 | 84 | `r ''````{r encode, echo=FALSE} 85 | learnrhash::decoder_ui() 86 | ``` 87 | ```` 88 | ![Decode solutions](man/figures/decode.gif) 89 | 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # learnrhash 3 | 4 | 5 | 6 | [![R build 7 | status](https://github.com/rundel/learnrhash/workflows/R-CMD-check/badge.svg)](https://github.com/rundel/learnrhash/actions) 8 | [![Lifecycle: 9 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 10 | 11 | 12 | ## Installation 13 | 14 | This package is still in the early stages of development and currently 15 | is only available from GitHub. To install the development version run 16 | the following: 17 | 18 | ``` r 19 | # install.packages("devtools") 20 | devtools::install_github("rundel/learnrhash") 21 | ``` 22 | 23 | ## Usage 24 | 25 | This package is meant to provide addition tools for collection student 26 | answers to [learnr](https://rstudio.github.io/learnr/) tutorials. The 27 | package does not transmit the answers in any way, but instead provides a 28 | convenient method to generate a compressed text based representation 29 | that can be easily copied and pasted. The students can then submit these 30 | solutions by pasting this “hash” into an online web form (e.g. Google 31 | Forms, Microsoft Forms, etc.) or a learning management system quiz or 32 | assignment tool. 33 | 34 | To enable this functionality, all you need to do is include the 35 | following in a learnr Rmd document: 36 | 37 | ## Submit 38 | 39 | ```{r context="server"} 40 | learnrhash::encoder_logic() 41 | ``` 42 | 43 | ```{r encode, echo=FALSE} 44 | learnrhash::encoder_ui() 45 | ``` 46 | 47 | which results in the Submit topic appearing in the tutorial with all of 48 | the necessary shiny logic and ui inserted, as shown below. 49 | 50 | ![Encode solutions](man/figures/encode.gif) 51 | 52 | In the example above a url for given, this value can 53 | be replaced with whatever link you would like to use for submission. All 54 | the students will need to do is to paste the generated hash into a text 55 | response field on whatever web form you choose to use. 56 | 57 | ## Working with Hashes 58 | 59 | The expectation is that after students submit their solutions you will 60 | be able to obtain some tabular representation of these results that can 61 | be read into R as a data frame. The package includes a simple example of 62 | this type of data which is loaded as follows 63 | 64 | ``` r 65 | example = readRDS(system.file("example.rds", package="learnrhash")) 66 | example 67 | ``` 68 | 69 | ## # A tibble: 2 × 3 70 | ## student student_id hash 71 | ## 72 | ## 1 Colin 20000 QlpoOTFBWSZTWeVuJ2oAA0d/gP/7aAhoC7BViyIOyr/v/+BAAcACsAS7C1… 73 | ## 2 Mine 10000 QlpoOTFBWSZTWYeyPVYAA0x/gP/7aAhoC7BVgyIOyr/v/+BAAcACsAdqC1… 74 | 75 | Currently the package provides two functions for extracting question 76 | solutions and exercise solutions from these hashed data, for both 77 | functions the only required argument is the name of the column 78 | containing the hashed solutions 79 | 80 | To extract the all submissions use, 81 | 82 | ``` r 83 | learnrhash::extract_hash(example) 84 | ``` 85 | 86 | ## # A tibble: 10 × 5 87 | ## student student_id id type data 88 | ## 89 | ## 1 Colin 20000 code exercise_submission 90 | ## 2 Colin 20000 code2 exercise_submission 91 | ## 3 Colin 20000 details question_submission 92 | ## 4 Colin 20000 not_a_planets question_submission 93 | ## 5 Colin 20000 planets question_submission 94 | ## 6 Mine 10000 code exercise_submission 95 | ## 7 Mine 10000 code2 exercise_submission 96 | ## 8 Mine 10000 details question_submission 97 | ## 9 Mine 10000 not_a_planets question_submission 98 | ## 10 Mine 10000 planets question_submission 99 | 100 | and to get just the exercises, 101 | 102 | ``` r 103 | learnrhash::extract_exercises(example) 104 | ``` 105 | 106 | ## # A tibble: 4 × 5 107 | ## student student_id id type data 108 | ## 109 | ## 1 Colin 20000 code exercise_submission 110 | ## 2 Colin 20000 code2 exercise_submission 111 | ## 3 Mine 10000 code exercise_submission 112 | ## 4 Mine 10000 code2 exercise_submission 113 | 114 | or questions, 115 | 116 | ``` r 117 | learnrhash::extract_questions(example) 118 | ``` 119 | 120 | ## # A tibble: 6 × 5 121 | ## student student_id id type data 122 | ## 123 | ## 1 Colin 20000 details question_submission 124 | ## 2 Colin 20000 not_a_planets question_submission 125 | ## 3 Colin 20000 planets question_submission 126 | ## 4 Mine 10000 details question_submission 127 | ## 5 Mine 10000 not_a_planets question_submission 128 | ## 6 Mine 10000 planets question_submission 129 | 130 | If you would like to experiment with this decoding and extraction while 131 | writing your tutorial you can also include decoding logic and ui 132 | elements into the tutorial in a similar way that the encoder was 133 | included. Simply add the following lines into your Rmd, 134 | 135 | ## Decode 136 | 137 | ```{r context="server"} 138 | learnrhash::decoder_logic() 139 | ``` 140 | 141 | ```{r encode, echo=FALSE} 142 | learnrhash::decoder_ui() 143 | ``` 144 | 145 | ![Decode solutions](man/figures/decode.gif) 146 | -------------------------------------------------------------------------------- /inst/demo_bad_logic.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - Bad Logic" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-bad-logic" 7 | version: 1.0 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(learnr) 12 | options(tutorial.event_recorder = learnr:::debug_event_recorder) 13 | ``` 14 | 15 | ## Question 16 | 17 | ```{r planets, echo=FALSE} 18 | learnr::question( 19 | "Which planet do we live on?", 20 | answer("Mars", correct = FALSE), 21 | answer("Earth", correct = TRUE), 22 | answer("Saturn", correct = FALSE), 23 | allow_retry = TRUE 24 | ) 25 | ``` 26 | 27 | ## Submit 28 | 29 | 35 | 36 | ```{r} 37 | learnrhash::encoder_logic() 38 | ``` 39 | 40 | ```{r} 41 | learnrhash::encoder_ui() 42 | ``` 43 | 44 | -------------------------------------------------------------------------------- /inst/demo_bad_ui.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - Bad UI" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-bad-ui" 7 | version: 1.0 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(learnr) 12 | ``` 13 | 14 | ## Question 15 | 16 | ```{r planets, echo=FALSE} 17 | question( 18 | "Which planet do we live on?", 19 | answer("Mars", correct = FALSE), 20 | answer("Earth", correct = TRUE), 21 | answer("Saturn", correct = FALSE), 22 | allow_retry = TRUE 23 | ) 24 | ``` 25 | 26 | ## Submit 27 | 28 | 34 | 35 | ```{r context="server"} 36 | learnrhash::encoder_logic() 37 | learnrhash::encoder_ui() 38 | ``` 39 | 40 | -------------------------------------------------------------------------------- /inst/demo_iframe.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - Minimal" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-iframe" 7 | version: 1.0 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(learnr) 12 | ``` 13 | 14 | ## Question 15 | 16 | ```{r planets, echo=FALSE} 17 | question( 18 | "Which planet do we live on?", 19 | answer("Mars", correct = FALSE), 20 | answer("Earth", correct = TRUE), 21 | answer("Saturn", correct = FALSE), 22 | allow_retry = TRUE 23 | ) 24 | ``` 25 | 26 | ## Submit 27 | 28 | ```{r context="server"} 29 | learnrhash::encoder_logic() 30 | ``` 31 | 32 | Note the following may not show in RStudio's viewer, try opening it in your browser to see the full iframe. 33 | 34 | ```{r encode, echo=FALSE} 35 | learnrhash::encoder_ui( 36 | ui_before = shiny::div( 37 | "If you have completed this tutorial and are happy with all of your", 38 | "solutions, please click the button below to generate your hash and", 39 | "submit it using the following form:", 40 | shiny::tags$br() 41 | ), 42 | ui_after = learnrhash::iframe_ui( 43 | src = "https://docs.google.com/forms/d/e/1FAIpQLSdzre-kmqNje64ZCK7VsXHWKSVdGNOjSUwU1IZaCWs_vL_yuQ/viewform?embedded=true", 44 | width="640px", height= "800px", frameborder="0", marginheight="0", marginwidth="0" 45 | ) 46 | ) 47 | ``` 48 | 49 | -------------------------------------------------------------------------------- /inst/demo_min.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - Minimal" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-minimal" 7 | version: 1.0 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(learnr) 12 | ``` 13 | 14 | ## Question 15 | 16 | ```{r planets, echo=FALSE} 17 | question( 18 | "Which planet do we live on?", 19 | answer("Mars", correct = FALSE), 20 | answer("Earth", correct = TRUE), 21 | answer("Saturn", correct = FALSE), 22 | allow_retry = TRUE 23 | ) 24 | ``` 25 | 26 | 27 | ## Exercise 28 | 29 | ```{r code, exercise=TRUE} 30 | plot(rnorm(100), rnorm(100)) 31 | ``` 32 | 33 | ## Submit 34 | 35 | ```{r context="server"} 36 | learnrhash::encoder_logic() 37 | ``` 38 | 39 | ```{r encode, echo=FALSE} 40 | learnrhash::encoder_ui() 41 | ``` 42 | 43 | ## Decode 44 | 45 | ```{r context="server"} 46 | learnrhash::decoder_logic() 47 | ``` 48 | 49 | ```{r decode, echo=FALSE} 50 | learnrhash::decoder_ui() 51 | ``` 52 | -------------------------------------------------------------------------------- /inst/demo_state.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - state" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-state" 7 | version: 1.1 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | library(learnr) 12 | ``` 13 | 14 | ## Question 15 | 16 | ```{r planets, echo=FALSE} 17 | learnr::question( 18 | "Which planet do we live on?", 19 | answer("Mars", correct = FALSE), 20 | answer("Earth", correct = TRUE), 21 | answer("Saturn", correct = FALSE), 22 | allow_retry = TRUE 23 | ) 24 | ``` 25 | 26 | ## Check State 27 | 28 | ```{r context="server"} 29 | shiny::observeEvent( 30 | input$get_state, 31 | { 32 | objs = learnr:::get_tutorial_state() 33 | 34 | output$state = shiny::renderText( 35 | paste( 36 | capture.output(str(objs)), 37 | collapse = "\n" 38 | ) 39 | ) 40 | invisible() 41 | } 42 | ) 43 | ``` 44 | 45 | ```{r state, echo=FALSE} 46 | shiny::actionButton("get_state", "Get State") 47 | shiny::br() 48 | shiny::br() 49 | learnrhash:::wrapped_verbatim_text_output("state") 50 | ``` 51 | -------------------------------------------------------------------------------- /inst/demo_types.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "learnrhash - Question Types" 3 | output: learnr::tutorial 4 | runtime: shiny_prerendered 5 | tutorial: 6 | id: "demo-types" 7 | version: 1.0 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | 12 | library(learnr) 13 | knitr::opts_chunk$set(echo = FALSE) 14 | knitr::opts_chunk$set(exercise.checker = gradethis::grade_learnr) 15 | ``` 16 | 17 | 18 | ```{r context="server", echo = FALSE} 19 | options(tutorial.event_recorder = learnr:::debug_event_recorder) 20 | 21 | learnrhash::encoder_logic() 22 | ``` 23 | 24 | 25 | ## Details 26 | 27 | ```{r details} 28 | question_text( 29 | "Student Name:", 30 | answer(NULL, correct = TRUE), 31 | incorrect = "Ok", 32 | try_again_button = "Modify your answer", 33 | allow_retry = TRUE 34 | ) 35 | ``` 36 | 37 | 38 | ## Fixed-response questions 39 | 40 | ```{r planets} 41 | question( 42 | "Which planet do we live on?", 43 | answer("Mars", correct = FALSE), 44 | answer("Earth", correct = TRUE), 45 | answer("Saturn", correct = FALSE), 46 | allow_retry = TRUE 47 | ) 48 | ``` 49 | 50 | ## Multiple-response questions 51 | 52 | ```{r not_a_planets} 53 | question( 54 | "Which of the following are planets?", 55 | answer("Mars", correct = TRUE), 56 | answer("Earth", correct = TRUE), 57 | answer("Saturn", correct = TRUE), 58 | answer("Pluto", correct = FALSE), 59 | allow_retry = TRUE 60 | ) 61 | ``` 62 | 63 | ## Code 64 | 65 | ```{r code, exercise=TRUE} 66 | 1+1 67 | ``` 68 | 69 | ## Code - gradethis 70 | 71 | ```{r code2, exercise=TRUE} 72 | 1+1 73 | ``` 74 | 75 | ```{r code2-check} 76 | gradethis::grade_result( 77 | gradethis::pass_if(~ TRUE, "Submitted!"), 78 | glue_correct = "{.message}" 79 | ) 80 | ``` 81 | 82 | ## Submit 83 | 84 | ```{r encoder, echo=FALSE} 85 | learnrhash::encoder_ui() 86 | ``` 87 | 88 | 89 |


90 | 91 | ```{r context='server', echo=FALSE} 92 | learnrhash::decoder_logic() 93 | ``` 94 | 95 | ```{r decoder, echo=FALSE} 96 | learnrhash::decoder_ui() 97 | ``` 98 | 99 | 100 | -------------------------------------------------------------------------------- /inst/example.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rundel/learnrhash/be00e49fd90386c7d322eb1e6749a98a67d2554e/inst/example.rds -------------------------------------------------------------------------------- /inst/svg/clipboard.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /inst/svg/cursor.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /learnrhash.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/decode_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/encode.R 3 | \name{decode_obj} 4 | \alias{decode_obj} 5 | \title{Decode hashed text into an R object} 6 | \usage{ 7 | decode_obj(txt, compress = c("bzip2", "gzip", "xz", "none")) 8 | } 9 | \arguments{ 10 | \item{txt}{Hashed text.} 11 | 12 | \item{compress}{Compression method.} 13 | } 14 | \description{ 15 | Decode hashed text into an R object 16 | } 17 | -------------------------------------------------------------------------------- /man/encode_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/encode.R 3 | \name{encode_obj} 4 | \alias{encode_obj} 5 | \title{Encode an R object into hashed text} 6 | \usage{ 7 | encode_obj(obj, compress = c("bzip2", "gzip", "xz", "none")) 8 | } 9 | \arguments{ 10 | \item{obj}{R object} 11 | 12 | \item{compress}{Compression method.} 13 | } 14 | \description{ 15 | Encode an R object into hashed text 16 | } 17 | -------------------------------------------------------------------------------- /man/extract.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{extract} 4 | \alias{extract} 5 | \alias{extract_hash} 6 | \alias{extract_exercises} 7 | \alias{extract_questions} 8 | \title{Extract hash contents} 9 | \usage{ 10 | extract_hash(df, hash = "hash") 11 | 12 | extract_exercises(df, hash = "hash") 13 | 14 | extract_questions(df, hash = "hash") 15 | } 16 | \arguments{ 17 | \item{df}{Data Frame. A data frame containing hash in a character column.} 18 | 19 | \item{hash}{Character. The name of the column containing the hashes} 20 | } 21 | \description{ 22 | The following are helper functions for extracting data from hashed learnr solutions. 23 | \itemize{ 24 | \item \code{extract_hash} - extracts the contents of the hashes into label, type, answer, correct, and timestamp columns 25 | \item \code{extract_questions} - extracts the contents of the hashes for answered questions. 26 | \item \code{extract_exercises} - extracts the contents of the hashes for answered exercises. 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /man/figures/decode.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rundel/learnrhash/be00e49fd90386c7d322eb1e6749a98a67d2554e/man/figures/decode.gif -------------------------------------------------------------------------------- /man/figures/encode.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rundel/learnrhash/be00e49fd90386c7d322eb1e6749a98a67d2554e/man/figures/encode.gif -------------------------------------------------------------------------------- /man/learnr_elements.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shiny.R 3 | \name{learnr_elements} 4 | \alias{learnr_elements} 5 | \alias{decoder_logic} 6 | \alias{decoder_ui} 7 | \alias{encoder_logic} 8 | \alias{default_ui} 9 | \alias{iframe_ui} 10 | \alias{encoder_ui} 11 | \title{Learnr addon elements} 12 | \usage{ 13 | decoder_logic() 14 | 15 | decoder_ui() 16 | 17 | encoder_logic(strip_output = FALSE) 18 | 19 | default_ui(url = "http://google.com") 20 | 21 | iframe_ui(src = "http://google.com", ...) 22 | 23 | encoder_ui(ui_before = default_ui(), ui_after = NULL) 24 | } 25 | \arguments{ 26 | \item{strip_output}{Exercises save their output as html, for exercises 27 | that result in plots these can result in very large hashes. The option allows 28 | this information to be removed to keep hash sizes more manageable.} 29 | 30 | \item{url}{Link url to use.} 31 | 32 | \item{src}{Source of the iframe.} 33 | 34 | \item{...}{Other iframe attributes, e.g. height and width} 35 | 36 | \item{ui_before}{Shiny ui elements to include before the hash ui} 37 | 38 | \item{ui_after}{Shiny ui elements to include after the hash ui,} 39 | } 40 | \description{ 41 | The following are addon element for learnr tutorials that enable the encoding and 42 | decoding of hashed learnr solutions. 43 | 44 | Note that when including these functions in a learnr Rmd document it is necessary that 45 | the logic functions, \verb{*_logic()}, be included in an R chunk where \code{context="server"} as 46 | they interact with the underlying Shiny functionality. Conversely, any of the ui functions, 47 | \verb{*_ui()}, must \emph{not} be included in an R chunk with a \code{context}. Both types of functions 48 | have been written to provide useful feedback if they detect they are in the wrong R chunk 49 | type. 50 | } 51 | \details{ 52 | For either of the ui parameters you can wrap multiple 53 | shiny elements together with \code{shiny::div}. 54 | } 55 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/learnrhash-package.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{\%>\%} 7 | \title{Objects exported from other packages} 8 | \keyword{internal} 9 | \description{ 10 | These objects are imported from other packages. Follow the links 11 | below to see their documentation. 12 | 13 | \describe{ 14 | \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} 15 | }} 16 | 17 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(learnrhash) 3 | 4 | test_check("learnrhash") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-encode.R: -------------------------------------------------------------------------------- 1 | test_that("test list objects", { 2 | test = list( 3 | a = 1, 4 | b = list( 5 | c = list(d = 1), 6 | e = 3 7 | ) 8 | ) 9 | 10 | test_base64 = encode_obj(test) 11 | 12 | # Allowed Chracters A-Z, a-z, 0-9, +, /, = 13 | expect_true(grepl("[A-Za-z0-9+/=]+", test_base64)) 14 | expect_identical(test, decode_obj(test_base64)) 15 | }) 16 | 17 | test_that("test vectors", { 18 | a = 1 19 | b = "A" 20 | c = TRUE 21 | 22 | expect_identical(a, decode_obj(encode_obj(a))) 23 | expect_identical(b, decode_obj(encode_obj(b))) 24 | expect_identical(c, decode_obj(encode_obj(c))) 25 | }) 26 | 27 | test_that("test compression", { 28 | test = list( 29 | a = 1, 30 | b = list( 31 | c = list(d = 1), 32 | e = 3 33 | ) 34 | ) 35 | 36 | test_bzip = encode_obj(test, "bzip2") 37 | test_gzip = encode_obj(test, "gzip") 38 | test_none = encode_obj(test, "none") 39 | 40 | expect_identical(test, decode_obj(test_bzip, "bzip2")) 41 | #expect_error(decode_obj(test_bzip, "gzip")) 42 | #expect_error(decode_obj(test_bzip, "none")) 43 | 44 | expect_identical(test, decode_obj(test_gzip, "gzip")) 45 | #expect_error(decode_obj(test_gzip, "bzip2")) 46 | #expect_error(decode_obj(test_gzip, "none")) 47 | 48 | expect_identical(test, decode_obj(test_none, "none")) 49 | #expect_error(decode_obj(test_none, "bzip2")) 50 | #expect_error(decode_obj(test_none, "gzip")) 51 | }) 52 | 53 | test_that("test empty", { 54 | expect_identical(decode_obj(""), list()) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-extract.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("test extract w/ good data", { 3 | 4 | # Example state object from demo-types.Rmd 5 | df = tibble::tribble( 6 | ~student, ~student_id, ~hash, 7 | "Colin", 20000, "QlpoOTFBWSZTWeVuJ2oAA0d/gP/7aAhoC7BViyIOyr/v/+BAAcACsAS7C1CSk0JpmpNqep5Mk2hB6Q0AMRkZDRo0ESgk0mjCm0jJoNBoaGgA08o0aMgc0xMmTRhMExNMAmAQwRgRgEoqeo9NEmGjEaAmAjEwg0yGIYF8pU0k7G+6BUtHSYxJJAJFL6W5UCrilRyWGtmw1GqpSrRJBA2fT+uz/VuOlmnCp4+XqtIastNWKVwhhEJEy0ph5bKdX76SO3aH4vv11oDoiPXx7wYJ2rpgkR114rTC4VgPPe2auPKXtfRNHr4GunJmVN1GCKmeCpSIHcg02pekubiVKwzZNyJSzWNoZ2YNzeaVxhkzFsjDjLuDMsB3QAaoKRAQgSDILEEKQAGsUkkBDNEUDo7R7DmKBZUuTggyhKAOSpFKKbDUcMznhknT1b5jnNEVveZw8iU2FziM2DEcgUkIFeHApF7yYcts1w6NFnAXyrns4VMbVAj5+ikGl5l2aeMcGZeiZkCD42EJkRt00Oxd/moXKnwDA2aNZwnCazkZ0noMoXDAMyZag5BSiAyj+2n9ckRFzQU56GQFjr81nKKKKXicMDScxOZx+1IMUARqneOUqlfxj0oqY2Kwv4yK9XCwrJRwmMP4ZUPr8nVF81IqijfkoqaPuQxMTFCXkQjCh5oNBwPE08iZLunbRHarIjFlSuhBELCwQ6xqiCDc8mjSZ0oF2r9qtAn2KAK+si1CpdcVvJQ83qPIkJUvo+A0FFgCqET1auDXhFLaTCdCrHWGMkObrqmDiZSYLB1p0cHC48TlpTzFrYzTmTkLaDEGkrnoBL4Txz6UhvWMRyEwUbGdhK5CPkSUnJN8DQbg9bz/kGEDb6dUZIpb/i7kinChIcrcTtQ=", 8 | "Mine", 10000, "QlpoOTFBWSZTWYeyPVYAA0x/gP/7aAhoC7BVgyIOyr/v/+BAAcACsAdqC1CSU0AIaGBRk0D1BoAA0ANNAiUEmgmE1MTEANDQ0AMmjRoyBzAJgJkYARiYmEwmCGmJpgJSTUn4RJiY9RkNRiBppiMBMI0YJfKV1k7W+gCpaBrcYEkgEil9bcqtTFKjkstbNhqNQGlWgSKB8P69H+5/vgOxmzy42PP11kN3NTdxSreOEGkTLSmHJZTr/fUR2dIfi+yvcEHVFOzj3AwTdumCQXbXhtMLhWA817Z648he19U1ezea68hnAdCMUVNMRSkQOCDTpS9oXMyXKwz3zRKWawtDi1NMjgaWlcsMdBbIw4y7gzNAdwQGoikEEIEgyCwBCkQBrFJFQ0QVA59p7TlKBZUuTfgyhKAOSpFKKfY2HDNJtknV17THSaHP6mgMpUN521jPb7y6FkYBcntpIbZJzHhjNzdOnzpm0XcN+RZT6UCPj5LQcWNiyVSk4UrxTXhB7+xCXo/frgs5olfDEMFmcGm6pAmJiBeRXA9h4dgMCRCRwRoYwgOw/WeTtsqianWhjX1OmNvZ52RsMMMb5AODUcBSeA/FMMoAlVn8TqhUP6B6gWSVleXaCOvNCxmKCcTMbBrR9ftKquPRFscr83Fc4fnQyZMoStFgxW84HBgB4y1TrHsqfrlizkZo0pYgrkFuMIwXuUsgNseThxlwYwKJrYQTmT4ZtJFqFXNOpL6Yl4DAQJUvo8BgKFRhVCs3xsyg1wiidIhlVS38Va8By9tUwcTKTBYO8nRv8LjxOWlNha2M1508JbUOBhM5sYl4JBz0pjMSoCOQWKGQOokUp3DyumrFtoNRiPY835BhA6fVsjJFLf8XckU4UJCHsj1W" 9 | ) 10 | 11 | 12 | all = extract_hash(df, "hash") 13 | qs = extract_questions(df, "hash") 14 | exs = extract_exercises(df, "hash") 15 | 16 | expect_equal(dim(all), c(10,5)) 17 | expect_equal(dim(qs), c(6,5)) 18 | expect_equal(dim(exs), c(4,5)) 19 | }) 20 | 21 | test_that("test extract w/ blank entry", { 22 | 23 | df = tibble::tribble( 24 | ~student, ~student_id, ~hash, 25 | "Colin", 20000, "QlpoOTFBWSZTWeVuJ2oAA0d/gP/7aAhoC7BViyIOyr/v/+BAAcACsAS7C1CSk0JpmpNqep5Mk2hB6Q0AMRkZDRo0ESgk0mjCm0jJoNBoaGgA08o0aMgc0xMmTRhMExNMAmAQwRgRgEoqeo9NEmGjEaAmAjEwg0yGIYF8pU0k7G+6BUtHSYxJJAJFL6W5UCrilRyWGtmw1GqpSrRJBA2fT+uz/VuOlmnCp4+XqtIastNWKVwhhEJEy0ph5bKdX76SO3aH4vv11oDoiPXx7wYJ2rpgkR114rTC4VgPPe2auPKXtfRNHr4GunJmVN1GCKmeCpSIHcg02pekubiVKwzZNyJSzWNoZ2YNzeaVxhkzFsjDjLuDMsB3QAaoKRAQgSDILEEKQAGsUkkBDNEUDo7R7DmKBZUuTggyhKAOSpFKKbDUcMznhknT1b5jnNEVveZw8iU2FziM2DEcgUkIFeHApF7yYcts1w6NFnAXyrns4VMbVAj5+ikGl5l2aeMcGZeiZkCD42EJkRt00Oxd/moXKnwDA2aNZwnCazkZ0noMoXDAMyZag5BSiAyj+2n9ckRFzQU56GQFjr81nKKKKXicMDScxOZx+1IMUARqneOUqlfxj0oqY2Kwv4yK9XCwrJRwmMP4ZUPr8nVF81IqijfkoqaPuQxMTFCXkQjCh5oNBwPE08iZLunbRHarIjFlSuhBELCwQ6xqiCDc8mjSZ0oF2r9qtAn2KAK+si1CpdcVvJQ83qPIkJUvo+A0FFgCqET1auDXhFLaTCdCrHWGMkObrqmDiZSYLB1p0cHC48TlpTzFrYzTmTkLaDEGkrnoBL4Txz6UhvWMRyEwUbGdhK5CPkSUnJN8DQbg9bz/kGEDb6dUZIpb/i7kinChIcrcTtQ=", 26 | "Mine", 10000, "QlpoOTFBWSZTWYeyPVYAA0x/gP/7aAhoC7BVgyIOyr/v/+BAAcACsAdqC1CSU0AIaGBRk0D1BoAA0ANNAiUEmgmE1MTEANDQ0AMmjRoyBzAJgJkYARiYmEwmCGmJpgJSTUn4RJiY9RkNRiBppiMBMI0YJfKV1k7W+gCpaBrcYEkgEil9bcqtTFKjkstbNhqNQGlWgSKB8P69H+5/vgOxmzy42PP11kN3NTdxSreOEGkTLSmHJZTr/fUR2dIfi+yvcEHVFOzj3AwTdumCQXbXhtMLhWA817Z648he19U1ezea68hnAdCMUVNMRSkQOCDTpS9oXMyXKwz3zRKWawtDi1NMjgaWlcsMdBbIw4y7gzNAdwQGoikEEIEgyCwBCkQBrFJFQ0QVA59p7TlKBZUuTfgyhKAOSpFKKfY2HDNJtknV17THSaHP6mgMpUN521jPb7y6FkYBcntpIbZJzHhjNzdOnzpm0XcN+RZT6UCPj5LQcWNiyVSk4UrxTXhB7+xCXo/frgs5olfDEMFmcGm6pAmJiBeRXA9h4dgMCRCRwRoYwgOw/WeTtsqianWhjX1OmNvZ52RsMMMb5AODUcBSeA/FMMoAlVn8TqhUP6B6gWSVleXaCOvNCxmKCcTMbBrR9ftKquPRFscr83Fc4fnQyZMoStFgxW84HBgB4y1TrHsqfrlizkZo0pYgrkFuMIwXuUsgNseThxlwYwKJrYQTmT4ZtJFqFXNOpL6Yl4DAQJUvo8BgKFRhVCs3xsyg1wiidIhlVS38Va8By9tUwcTKTBYO8nRv8LjxOWlNha2M1508JbUOBhM5sYl4JBz0pjMSoCOQWKGQOokUp3DyumrFtoNRiPY835BhA6fVsjJFLf8XckU4UJCHsj1W", 27 | "Empty", 0, encode_obj(list()) 28 | ) 29 | 30 | 31 | all = extract_hash(df, "hash") 32 | qs = extract_questions(df, "hash") 33 | exs = extract_exercises(df, "hash") 34 | 35 | expect_equal(dim(all), c(11,5)) # Bad shows up with NAs and NULLs 36 | expect_equal(dim(qs), c(6,5)) # Dropped since no answers here 37 | expect_equal(dim(exs), c(4,5)) 38 | }) 39 | 40 | 41 | test_that("test extract w/ empty data", { 42 | df = tibble::tibble( 43 | student = "Colin", 44 | student_id = 20000, 45 | hash = encode_obj(list()) 46 | ) 47 | 48 | all = extract_hash(df, "hash") 49 | qs = extract_questions(df, "hash") 50 | exs = extract_exercises(df, "hash") 51 | 52 | expect_equal(dim(all), c(1,5)) 53 | expect_true(all(c("student","student_id", "id", "type", "data") == names(all))) 54 | 55 | 56 | df2 = tibble::tibble( 57 | student = c("Colin", "Mine"), 58 | student_id = c(20000, 10000), 59 | hash = encode_obj(list()) 60 | ) 61 | 62 | all2 = extract_hash(df2, "hash") 63 | qs2 = extract_questions(df2, "hash") 64 | exs2 = extract_exercises(df2, "hash") 65 | 66 | 67 | expect_equal(dim(all2), c(2,5)) 68 | expect_true(all(c("student","student_id", "id", "type", "data") == names(all2))) 69 | }) 70 | 71 | 72 | --------------------------------------------------------------------------------