Skip to content

Instantly share code, notes, and snippets.

@MarkEdmondson1234
Last active November 21, 2020 00:09
Show Gist options
  • Save MarkEdmondson1234/7e56ee7ac5caa74224327489b0849e61 to your computer and use it in GitHub Desktop.
Save MarkEdmondson1234/7e56ee7ac5caa74224327489b0849e61 to your computer and use it in GitHub Desktop.
Shiny modules for creating dynamic SelectInputs
library(shiny)
#' Safe subset
#'
#' @param df Dataframe
#' @param column One name of column to subset within
#' @param subset Vector of entries in column to subset to
#'
#' If column not in df, returns back the df
safeSubset <- function(df, column, subset){
testthat::expect_is(df, "data.frame")
testthat::expect_is(column, "character")
testthat::expect_equal(length(column), 1)
if(!is.null(subset)){
testthat::expect_is(subset, "character")
} else {
message("Subset is NULL, returning original")
out <- df
}
message(" # subsetting # original rows: ",nrow(df) ," column:", column, " by ", paste(subset, collapse = ", "))
col <- df[[column]]
if(!is.null(col)){
out <- df[col %in% subset,]
message("Subset rows: ", nrow(out))
} else {
message("Column not found:", column)
out <- df
}
out
}
#' Dynamical Update of a selectInput
#'
#' Shiny Module: useage details at \link{dynamicSelect}
#'
#' @param id shiny id
#'
#' @return dynamicSelectInput
#' @export
dynamicSelectInput <- function(id, label, multiple = FALSE){
ns <- shiny::NS(id)
shiny::selectInput(ns("dynamic_select"), label,
choices = NULL, multiple = multiple, width = "100%")
}
#' Dynamical Update of a selectInput
#'
#' Shiny Module
#'
#' Use via \code{callModule(dynamicSelect, "name_select", the_data, "cyl")}
#'
#' @param input shiny input
#' @param output shiny output
#' @param session shiny session
#' @param the_data data.frame containing column of choices
#' @param column The column to select from
#' @param default_select The choices to select on load
#'
#' @seealso \link{dynamicSelectInput}
#'
#' @return the_data filtered to the choice
#' @export
dynamicSelect <- function(input, output, session, the_data, column, default_select = NULL){
ns <- session$ns
## update input$dynamic_select
observe({
shiny::validate(
shiny::need(the_data(),"Fetching data")
)
dt <- the_data()
testthat::expect_is(dt, "data.frame")
testthat::expect_is(column, "character")
choice <- unique(dt[[column]])
updateSelectInput(session, "dynamic_select",
choices = choice,
selected = default_select)
})
new_data <- reactive({
shiny::validate(
shiny::need(input$dynamic_select,"Select data"),
shiny::need(the_data(), "Waiting for data")
)
sd <- the_data()
selected <- input$dynamic_select
## will return sd even if column is NULL
safeSubset(sd, column, selected)
})
return(new_data)
}
### Useage
shinyApp(
ui = fluidPage(
dynamicSelectInput("cyl_select", "Cyl filter", multiple = TRUE),
dynamicSelectInput("dis_select", "Disp filter", multiple = TRUE),
tableOutput("table")
),
server = function(input, output, session){
the_data <- reactive({
mtcars
})
cyl_filter <- shiny::callModule(dynamicSelect, "cyl_select", the_data, "cyl", default_select = 4)
## cyl_filter is then filtered by disp
disp_filter <- shiny::callModule(dynamicSelect, "dis_select", cyl_filter, "disp", default_select = cyl_filter()$disp)
output$table <- renderTable({
table <- disp_filter()
save(table, file = "testTable.RData")
table
})
}
)
@J-O-H-N-P-A-U-L
Copy link

Hi Mark,

I came across this gist while looking into setting up unit tests for my shiny apps and was immediately drawn to your use of testthat:: tests implemented directly into your modules (very clever approach!)

May I ask, how do you run these unit tests? Are they only executed at application start-up during your development phase or are you running an automated test suite over them as well?

If the latter is true, would you mind sharing your setup?

Thanks,

JP

@dwhdai
Copy link

dwhdai commented Apr 12, 2020

I would be interested to know this as well. This is the first time I've seen tests integrated within a Shiny app.

@MarkEdmondson1234
Copy link
Author

Sorry @JPHUNTER I didn't get git notifications until recently :)

@dwhdai - its not that sophisticated, its only checking the input data and these days I would use assert_that() instead. If you want reactive tests then AFAIK the only way is to use the library shinytest

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment