In matt-dray/tidyquiz: A Tidyverse Quiz

# Set chunk options
knitr::opts_chunk$set(echo = FALSE)

# Get packages
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(learnr))
suppressPackageStartupMessages(library(pacman))
suppressPackageStartupMessages(library(shiny))

# Character vector of tidyverse package names (and try to protect from rogue
# characters in package name; happened with readxl)
tidy_pkgs <- tidyverse_packages() %>%  # calls character vector
  str_replace("\n", "") %>%  # remove newline
  str_replace(">=", "") %>%  # remove greater than or equal to
  str_replace("[:punct:]", "")  # remove punctuation

# Install and load full set of tidyverse packages
# (character.only to read elements of character vector, not object name)
p_load(char = tidy_pkgs, character.only = TRUE)

# Tibble where each row is a package-function combination
tidy_funs <-
  tidy_pkgs %>% 
  enframe(name = NULL, value = "package") %>% 
  mutate(functions = map(package, ~p_functions(.x, character.only = TRUE))) %>% 
  unnest()

Can you select the correct package for the named tidyverse function?

1. Click 'Get Question'
2. Make your guess and 'Submit Answer'
3. Click 'Start Over' in menu pane (reveal on mobile by tapping 'Tidyquiz')
4. Go back to step 1

# This chunk contains a Shiny action button
# A click will generate a new question

actionButton("goButton", "Get Question")

# This chunk attempts to builds the text output that can be passed later to the
# quiz() and answer() functions

# Generate a random seed value based on current system time
# This will be used in the reactive events below

seed <- eventReactive(
  input$goButton,
  {
    seed_temp <- as.numeric(Sys.time())
    return(seed_temp)
  }
)

# Get function name for subject of question

fun_name <- eventReactive(
  input$goButton,
  { 
    seed_val <- seed()
    set.seed(seed_val)  # user-selected value is seed value
    fun_sample <- sample_n(tidy_funs, 1)  # random row from package-functions tibble
    fun_name <- select(fun_sample, functions) %>% pull()  # just the function name
    return(fun_name)
  }
)
output$fun_name_out <- renderText({
  paste0("The function `", fun_name(), "` is from which tidyverse package?")
})

# Get correct answer

ans_correct <- eventReactive(
  input$goButton,
  { 
    seed_val <- seed()
    set.seed(seed_val)  # same seed value as above
    fun_sample <- sample_n(tidy_funs, 1)  # same row as for fun_name as above
    ans_correct <- select(fun_sample, package) %>% pull()  # now take package name
    return(ans_correct)
  }
)
output$ans_correct_out <- renderText({ paste0("{", ans_correct(), "}") })

# Get wrong answer 1 of 3
ans_wrong1 <- eventReactive(
  input$goButton,
  { 
    # Recreate ans_correct so we don't set it as a wrong answer as well
    seed_val <- seed()
    set.seed(seed_val)
    fun_sample <- sample_n(tidy_funs, 1)
    fun_name <- select(fun_sample, functions) %>% pull()
    ans_correct <- select(fun_sample, package) %>% pull()
    # Also get packages that have a function with the same name as ans_correct
    # so we don't see these as a wrong answer as well
    dup_lookup <-  filter(tidy_funs, functions == fun_name) %>% pull(package)
    # Slightly alter the seed to generate a wrong answer
    set.seed(seed_val + 1)
    ans_wrong1 <- tidy_funs %>%
      distinct(package) %>%  # get unique packages
      filter(!package %in% c(dup_lookup)) %>%  # ignore packages with ans_correct
      sample_n(1) %>%  # choose a remaining package name at random
      pull()  # to character
    return(ans_wrong1)
  }
)
output$ans_wrong1_out <- renderText({ paste0("{", ans_wrong1(), "}") })

# Get wrong answer 2 of 3
# Code as for wrong answer 1, but seed different

ans_wrong2 <- eventReactive(
  input$goButton,
  { 
    # Recreate ans_correct so we don't set it as a wrong answer as well
    seed_val <- seed()
    set.seed(seed_val)
    fun_sample <- sample_n(tidy_funs, 1)
    fun_name <- select(fun_sample, functions) %>% pull()
    ans_correct <- fun_sample %>% select(package) %>% pull()
    # Also get packages that have a function with the same name as ans_correct
    # so we don't see these as a wrong answer as well
    dup_lookup <-  filter(tidy_funs, functions == fun_name) %>% pull(package)
    # Slightly alter the seed to generate a wrong answer
    set.seed(seed_val + 2)  # needs to be a different seed to ans_wrong1
    wrong1 <- ans_wrong1()
    ans_wrong2 <- tidy_funs %>%
      distinct(package) %>%
      filter(!package %in% c(dup_lookup, wrong1)) %>%  # also exclude pre-selected wrong answer
      sample_n(1) %>% 
      pull()
    return(ans_wrong2)
  }
)
output$ans_wrong2_out <- renderText({ paste0("{", ans_wrong2(), "}") })

# Get wrong answer 3 of 3
# Code as for wrong answers 1 and 2 above, but seed different

ans_wrong3 <- eventReactive(
  input$goButton,
  { 
    # Recreate ans_correct so we don't set it as a wrong answer as well
    seed_val <- seed()
    set.seed(seed_val)
    fun_sample <- sample_n(tidy_funs, 1)
    fun_name <- select(fun_sample, functions) %>% pull()
    ans_correct <- fun_sample %>% select(package) %>% pull()
    # Also get packages that have a function with the same name as ans_correct
    # so we don't see these as a wrong answer as well
    dup_lookup <-  filter(tidy_funs, functions == fun_name) %>% pull(package)
    # Slightly alter the seed to generate a wrong answer
    set.seed(seed_val + 3)  # needs to be a different seed to ans_wrong1
    wrong1 <- ans_wrong1()
    wrong2 <- ans_wrong2()
    ans_wrong3 <- tidy_funs %>%
      distinct(package) %>%
      filter(!package %in% c(dup_lookup, wrong1, wrong2)) %>%  # also exclude pre-selected wrong answer
      sample_n(1) %>%
      pull()
    return(ans_wrong3)
  }
)
output$ans_wrong3_out <- renderText({ paste0("{", ans_wrong3(), "}") })

quiz(
  caption = "Question ",
  question(
    text = as.character(textOutput("fun_name_out")),
    answer(as.character(textOutput("ans_correct_out")), correct = TRUE),
    answer(as.character(textOutput("ans_wrong1_out"))),
    answer(as.character(textOutput("ans_wrong2_out"))),
    answer(as.character(textOutput("ans_wrong3_out"))),
    random_answer_order = TRUE
  )
)

Made with {learnr}, the tidyverse and {pacman}.

Read a blogpost about this.

matt-dray/tidyquiz documentation built on Sept. 3, 2021, 8:14 a.m.