CODEWITHSUNDEEP
rshinyscheduling
statechular
statechular

Reputation: 273

R Shiny: How to update an input object before a reactive statement gets executed

I am building an explorative visual app based on the awesome R Shiny package. One thing the app will do is to read a real-valued "measurement" column and display a boxplot of those measurement values. In addition, there is an optional selectInput widget that allows the user to select a group variable to dive into. The group variable basically contains the names of columns having categorical values, e.g. gender (Female vs Male), country (US, CA, and etc). So if "gender" is selected from the group selectInput, the app will display two boxplots, one for the female and the other for the male.

To give the user the flexibility of focusing on certain categories, say only the female, I came up with the checkboxGroupInput that is only shown when group variable is selected with both choices and selected being initially set to all the categories of the group variable. So for instance, when the user only wants to see the boxplot of the female, he/she can easily un-check the check box of the male and the boxplot of the male get removed while that of the female remains.

Following warmoverflow's suggestion, here is a reproducible toy example

# global setup
library(shiny)
library(ggplot2)
library(dplyr)
set.seed(12345)
dummy_data <- data.frame(
    Value = c(rnorm(50), 2 + rnorm(50)),
    Gender = c(rep('Female', 50), rep('Male', 50)),
    Country = c(rep('US', 50), rep('CA', 50)),
    stringsAsFactors = FALSE
)

# ui function
ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput('group', 'Group',
                        c('Choose'='', setdiff(names(dummy_data), 'Value'))),
            uiOutput('group_select')
        ),
        mainPanel(plotOutput('box_plot'))
    )
)

# server function
server <- function(input, output) {

    # the group level select/unselect widget
    output$group_select <- renderUI({
        req(input$group)
        data <- dummy_data
        group_levels <- unique(data[[input$group]])
        conditionalPanel(
            condition = "input.group != ''",
            checkboxGroupInput('group_select', input$group,
                               choices = group_levels, selected = group_levels)
        )
    })

    # filter the data if group variable is selected
    data_to_plot <- reactive({
        data <- dummy_data
        if(!(is.null(input$group) || input$group == '')) {
            data <- data %>% 
                mutate_(group_ = input$group) %>%
                filter(group_ %in% input$group_select)
        } else {
            data$group_ <- as.factor(rep.int(1, nrow(data)))
        }
        return(data)
    })

    # show the boxplot
    output$box_plot <- renderPlot({
        data <- data_to_plot()
        validate(
            need(!(is.null(data) || nrow(data) == 0),
                 'There are no data to plot!')
        )
        ggplot(data = data, aes(factor(group_), Value)) + geom_boxplot()
    })
}

shinyApp(ui = ui, server = server)

Well, the code works but reactive statement runs twice unnecessarily, once when input$group gets updated and another when input$group_select gets updated as you can notice the error message "There are no data to plot!" when you select "Gender" from the group drop-down list. So my question is: is there a way to ensure the following execution order:

  1. input$group is updated ->
  2. input$group_select gets updated ->
  3. reactive gets (re)executed with both updated input$group and input$group_select

I have spent almost an entire day searching for solution to little avail.

The difficulty of it as pointed out by Roger Day is that the input update functions are ordinarily not reactive and thus (based on my experiments and understanding) get executed later than reactive statements. Or if there is a way to make input update function reactive, priority value can be applied to alter the execution order in the desirable way.

Any input is greatly appreciated! Sorry for the long description!

Upvotes: 3

Views: 7526

Answers (2)

Travis Smith
Travis Smith

Reputation: 1

Try grouping both inputs into a debounce statement like so:

trig <- debounce(reactive({list(
    a = input$a,
    b = input$b
)}), 500)
observeEvent(trig(),{print('triggered')})
reactive({
    ins <- trig()
    #Code that does stuff goes here 
    #reference the inputs using ins$a or ins$b
})

You may have to tweak the timing, and if the update takes too long you may still double update.

Upvotes: -1

statechular
statechular

Reputation: 273

I think I have found a solution. The direction mentioned in UnnamedUser and warmoverflow is right. The overall idea is to create a reactive value to represent, or more precisely speaking to monitor, the group categories selected by the user and to detect any changes in both group variable (use observe) and group variable selected categories (use observe) and then modify the reactive value accordingly by adding the following block of code in the server function.

# use a reactive value to represent group level selection
group_selects <- reactiveValues(value = NULL)
observe({
    input$group
    if(is.null(input$group) || input$group == '')
        group_selects$value <- NULL
    else {
        data <- dummy_data
        group_selects$value <- unique(data[[input$group]])
    }
})
observe({
    input$group_select
    group_selects$value <- input$group_select
})

And then use group_selects$value to substitute input$group_select in the data manipulation block

# filter the data if group variable is selected
data_to_plot <- reactive({
    data <- dummy_data
    if(!(is.null(input$group) || input$group == '')) {
        req(group_selects$value)                        # To prevent unnecessary re-run
        data <- data %>% 
            mutate_(group_ = input$group) %>%
            filter(group_ %in% group_selects$value)     # Replaced input$group_select
    } else {
        data$group_ <- as.factor(rep.int(1, nrow(data)))
    }
    return(data)
})

Upvotes: 2

Related Questions