isolate function with reactive object base on dplyr shiny

Question

I created a simple shiny app. The goal is to create a histogram with options to manipulate the plot for each dataset. The problem is that when I change a dataset application first show me empty plot and then present a correct plot. To understand the problem I add renderText which show me a number of rows in getDataParams dataset. It seems to me that isolate function should be a solution but I tried several configurations, apparently I still do not understand this function.

library(lazyeval)
library(dplyr)
library(shiny)
library(ggplot2)

data(iris)
data(diamonds)

ui <- fluidPage(
      column(3,
             selectInput("data", "", choices = c('', 'iris', 'diamonds')),
             uiOutput('server_cols'),
             uiOutput("server_cols_fact"),
             uiOutput("server_params")
      ),
      column(9,
             plotOutput("plot"),
             textOutput('text')

      )
)

server <- function(input, output) {
      data <- reactive({
            switch(input$data, diamonds = diamonds, iris = iris)
      })

      output$server_cols <- renderUI({
            validate(need(input$data != "", "Firstly select a dataset."))
            data <- data()
            nam <- colnames(data)
            selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
      })

      output$server_cols_fact <- renderUI({

            req(input$data)

            data <- data(); nam <- colnames(data)
            selectizeInput('cols_fact', "Choose a fill columns:",
                           choices = nam[sapply(data, function(x) is.factor(x))])
      })

      output$server_params <- renderUI({

            req(input$cols_fact)

            data <- isolate(data()); col_nam <- input$cols_fact
            params_vec <- unique(as.character(data[[col_nam]]))
            selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec,
                           selected = params_vec, multiple = TRUE)

      })

      getDataParams <- reactive({

            df <- isolate(data())
            factor_col <- input$cols_fact
            col_diverse <- eval(factor_col)

            criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse))
            df <- df %>%
                  filter_(criteria) %>%
                  mutate_each_(funs(factor), factor_col)
      })

      output$text <- renderText({
            if(!is.null(input$cols)) {
                  print(nrow(getDataParams()))
            }
      })
      output$plot <- renderPlot({
            if (!is.null(input$cols)) {

                  var <- eval(input$cols)
                  print('1')

                  diversifyData <- getDataParams()
                  factor_col <- input$cols_fact
                  print('2')

                  plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) +
                        geom_histogram(color = 'white', binwidth = 1)

                  print('3')
            }
            plot

      })

}

shinyApp(ui, server)

Answer 1

Here is an answer that features quite minimal changes and gives probably some deeper insights into how to control reactivity in future projects.

Your program logic features some decisions of the kind "do A if B, but not if C". But it approaches them brutally, by repeating "do A if B" until finally "not C" is true. To be more precise: You want your getDataParams to be renewed (action A) if input$cols changes (action B), but it throws errors if input$params has not changed yet (condition C).

Okay, now to the fix: We use a feature of observeEvent to evaluate if getDataParams should be recalculated. Lets read (source):

Both observeEvent and eventReactive take an ignoreNULL parameter that affects behavior when the eventExpr evaluates to NULL (or in the special case of an actionButton, 0). In these cases, if ignoreNULL is TRUE, then an observeEvent will not execute and an eventReactive will raise a silent validation error.

So the change is basically one command. Change

getDataParams <- reactive({ ... })

to

getDataParams <- eventReactive({
    if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){
      NULL
    }else{
      if(all(input$params %in% data()[[input$cols_fact]])){
        1
      }else{
        NULL
      }
    }, { ... }, ignoreNULL = TRUE)

Here we check if input$cols_fact is a valid column name and if input$params has already been assigned and if so, we check if input$params is a valid list of factors for the given column. This feature was mainly designed, I suppose, to check if some element exists (input$something returning NULL if it's not defined), but we abuse it for logic evaluation and return NULL in one case and 1 (or something not NULL) in the other.

In contrast to logical tests inside the reactive environment, getDataReactive won't be changed or won't trigger change events at all, if the condition is not met.

Note: This is the minimal solution I found. With this tool and/or other changes, the code can still be fairly improved.

Full Code below.

Greetings!

library(lazyeval)
library(dplyr)
library(shiny)
library(ggplot2)

data(iris)
data(diamonds)

ui <- fluidPage(
      column(3,
             selectInput("data", "", choices = c('', 'iris', 'diamonds')),
             uiOutput('server_cols'),
             uiOutput("server_cols_fact"),
             uiOutput("server_params")
      ),
      column(9,
             plotOutput("plot"),
             textOutput('text')

      )
)

server <- function(input, output) {
      data <- reactive({
            switch(input$data, diamonds = diamonds, iris = iris)
      })

      output$server_cols <- renderUI({
            validate(need(input$data != "", "Firstly select a dataset."))
            data <- data()
            nam <- colnames(data)
            selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
      })

      output$server_cols_fact <- renderUI({

            req(input$data)

            data <- data(); nam <- colnames(data)
            selectizeInput('cols_fact', "Choose a fill columns:",
                           choices = nam[sapply(data, function(x) is.factor(x))])
      })

      output$server_params <- renderUI({

            req(input$cols_fact)

            data <- isolate(data()); col_nam <- input$cols_fact
            params_vec <- unique(as.character(data[[col_nam]]))
            selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec,
                           selected = params_vec, multiple = TRUE)

      })

      getDataParams <- eventReactive({
        if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){
          NULL
        }else{
          if(all(input$params %in% data()[[input$cols_fact]])){
            1
          }else{
            NULL
          }
        }, { 
            df <- isolate(data())
            factor_col <- input$cols_fact
            col_diverse <- eval(factor_col)

            criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse))
            df <- df %>%
                  filter_(criteria) %>%
                  mutate_each_(funs(factor), factor_col)
      }, ignoreNULL = TRUE)

      output$text <- renderText({
            if(!is.null(input$cols)) {
                  print(nrow(getDataParams()))
            }
      })
      output$plot <- renderPlot({
            if (!is.null(input$cols)) {

                  var <- eval(input$cols)
                  print('1')

                  diversifyData <- getDataParams()
                  factor_col <- input$cols_fact
                  print('2')

                  plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) +
                        geom_histogram(color = 'white', binwidth = 1)

                  print('3')
            }
            plot

      })

}

shinyApp(ui, server)

Answer 2

To best explaining the flow - I create a picture that explain how the plot get refresh as below:

• So, with no isolate code, you will any change in any change on any control on the code will trigger the change to the control on the end of arrow. In this case which end up result the plot refresh 5 times.
• With the isolate code in your code from above post, you already eliminate two small arrow.
• To avoid the case you mentioned with when Choose a fill columns, you need to eliminate the big arrow that I highlighted by isolate the input$cols_fact in output$plot <- renderPlot{...} reactive.
• With this you still have the plot refresh two time when choose data table but I think it acceptable as you need the plot to re-active when you do Choose numeric columns

Hope this answer your questions! Having fun playing arround with Shiny!