Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
})
}
)
@JPHUNTER

This comment has been minimized.

Copy link

@JPHUNTER JPHUNTER commented Dec 2, 2018

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

This comment has been minimized.

Copy link

@dwhdai 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

This comment has been minimized.

Copy link
Owner Author

@MarkEdmondson1234 MarkEdmondson1234 commented Apr 12, 2020

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