diff --git a/19-modules.Rmd b/19-modules.Rmd index 060a3dd..a1d6928 100644 --- a/19-modules.Rmd +++ b/19-modules.Rmd @@ -152,7 +152,7 @@ server <- function(input, output, session) { - `histogramApp()` creates a complete app for interactive experimentation and more formal testing. -## Exercise 1 {-} +## Group 1: Exercise 1 {-} **Why is it good practice to put a module in its own file in the R/ directory? What do you need to do to make sure it’s loaded by your Shiny app?** @@ -172,7 +172,7 @@ sourceDir <- function(path, trace = TRUE, ...) { } ``` -## Exercise 2 {-} +## Group 1: Exercise 2 {-} **The following module UI includes a critical mistake. What is it and why will it cause problems?** @@ -186,7 +186,7 @@ histogramUI <- function(id) { } ``` -## Exercise 2 {-} +## Group 1: Exercise 2 {-} We need to use the `shiny::NS()` function to define the ids. @@ -202,7 +202,7 @@ histogramUI <- function(id) { ``` -## Exercise 3 {-} +## Group 1: Exercise 3 {-} **The following module generates a new random number every time you click go:** @@ -222,7 +222,7 @@ randomServer <- function(id) { } ``` -## Exercise 3 {-} +## Group 1: Exercise 3 {-} **Create an app that displays four copies of this module on a single page. Verify that each module is independent.** @@ -244,11 +244,11 @@ server <- function(input, output, session) { shinyApp(ui, server) ``` -## Exercise 3 (Shinylive) {-} +## Group 1: Exercise 3 (Shinylive) {-} -## Exercise 3 {-} +## Group 1: Exercise 3 {-} **How could you change the return value of randomUI() to make the display more attractive?** @@ -267,7 +267,7 @@ randomUI <- function(id, title) { } ``` -## Exercise 3 {-} +## Group 1: Exercise 3 {-} **How could you change the return value of randomUI() to make the display more attractive?** @@ -285,7 +285,7 @@ ui <- page_fluid( ) ``` -## Exercise 3 (Shinylive) {-} +## Group 1: Exercise 3 (Shinylive) {-} @@ -681,6 +681,124 @@ histogramApp <- function() { +## Group 2: Exercise 1 {-} + +**Rewrite `selectVarServer()` so that both data and filter are reactive. Then use it with an app function that lets the user pick the dataset with the dataset module and filtering function using `inputSelect()`. Give the user the ability to filter numeric, character, or factor variables.** + +1. Start changing the `selectVarServer()`. + +```{r eval=FALSE} +selectVarServer <- function(id, + data, + # Now filter is reactive + filter = reactive(is.numeric)) { + + + stopifnot(is.reactive(data)) + # Now filter is reactive + stopifnot(is.reactive(filter)) + + + moduleServer(id, function(input, output, session) { + + # We want to update the selector every time the data() or filter() change + observe({ + # We need to have the filter before calling find_vars + req(filter()) + updateSelectInput(session, "var", choices = find_vars(data(), filter())) + }) + + list( + name = reactive(input$var), + value = reactive(data()[[input$var]]) + ) + }) +} +``` + +## Group 2: Exercise 1 {-} + +2. To make the prior changes work we need to create a new module to: + + - Add a selector in the UI. + +```{r eval=FALSE} +coltypeUI <- function(id) { + selectInput(NS(id, "col_type"), "Select Type of Columns", + choices = c("numeric","character","factor")) +} +``` + +## Group 2: Exercise 1 {-} + +2. To make the prior changes work we need to create a new module to: + + - Return the filter function as a reactive value. + +```{r eval=FALSE} +coltypeServer <- function(id, data) { + moduleServer(id, function(input, output, session) { + + # (OPTIONAL) + # I just want to see the col types available in the data to explore + + # Listing all valid col types in the data() + col_type_options <- reactive({ + sapply(data(), function(x){ + if(is.numeric(x)) return("numeric") + if(is.character(x)) return("character") + if(is.factor(x)) return("factor") + }) |> + unique() + }) + + # Update based on available available columns + observeEvent(col_type_options(),{ + updateSelectInput(session, "col_type", choices = col_type_options()) + }) + + + # (NEEDED PART) + + # Selecting function to return + reactive({ + switch(input$col_type, + "numeric" = is.numeric, + "character" = is.character, + "factor" = is.factor) + }) + } + ) +} +``` + + +## Group 2: Exercise 1 {-} + + +3. Update the module app to pass the reactive filter created. + +```{r eval=FALSE} +server <- function(input, output, session) { + data <- datasetServer("data") + + # Extracting the filter function as reactive value + fun_col_type <- coltypeServer("col_type", data) + + # Passing the reactive filter to the report + x <- selectVarServer("var", data, fun_col_type) + + histogramServer("hist", x$value, x$name) +} +``` + + +## Group 2: Exercise 1 (Shinylive) {-} + + + + + ## Links to examples {-} Two versions of a simple app based on Tidy Tuesday data: