2

I have the following sample app and I need to be able to switch inputs for multiple_choice_1_source OR multiple_choice_2_type without breaking the app and hiding submit_request_button_ui and ColnamesInput when the inputs from change. Basically, the user should be able to revise the inputs after clicking the "submit" button and the app should reset to its previous state.

What I have tried:

shinyjs() - this just hides and does not clear the inputs. This means that once I press the submit_request_button then any change made to multiple_choice_2_type is still processed and reacted upon. In the actual app, I have the submit tied to very large tables. I want to prevent the fetch for selected_data() from re-running and clear and hide the elements that were created in the first two choices.

reactive - I tried to make the observers listen to some reactive triggers that take dependencies from more than one input. I used user_input_rv to store the values etc but this fails as the observers are triggered more than once, so when I click the submit button, the if statements within the reactive({}) are triggered twice, essentially downloading each dataset more than once. Also it fails.

isolate - I have not been able to make this work. I tried multiple combinations of isolate with no success.

library(shiny)
library(tidyverse)


ui <- fluidPage(

   selectizeInput(inputId ='multiple_choice_1_source',
                  choices = c("db1","db2","db3","db4"), # like this because we want the selected to be blank on initialisation
                  label = "1. Select source",
                  multiple = FALSE,
                  size = 10,
                  width = '100%'
   )

   ,uiOutput(outputId="multiple_choice_2_type_ui")
   ,uiOutput(outputId="submit_request_button_ui")
   ,uiOutput(outputId="ColnamesInput")
)


server <- function(input, output)
{

   user_input_rv =  reactiveValues(

      source_picked             = NULL,
      last_used_source          = NULL,

      type_picked               = NULL,
      series_picked             = NULL,
      last_used_series          = NULL,

      selected_data             = NULL,
      final_selection           = NULL
   )

   observeEvent(input$multiple_choice_1_source, {

      user_input_rv$source_picked <- input$multiple_choice_1_source

      #change data loaded under type picked.
      user_input_rv$type_picked <-
         if (        input$multiple_choice_1_source == "db1"){ paste0(colnames(mtcars))
         } else if ( input$multiple_choice_1_source == "db2"){ paste0(colnames(diamonds))
         } else if ( input$multiple_choice_1_source == "db3"){ NULL
         } else if ( input$multiple_choice_1_source == "db4"){ NULL
         }

      output$multiple_choice_2_type_ui <- renderUI({

         selectizeInput( inputId = 'multiple_choice_2_type',
                         choices = paste(user_input_rv$type_picked),
                         label= "2. Select type",
                         multiple = TRUE,
                         size = 10,
                         width = '100%',
                         options = list( placeholder = 'Type',
                                         maxItems =1
                         )
         )
      })

   }) #first observeEvent for source type and data load.

   observeEvent(input$multiple_choice_2_type,{

      output$submit_request_button_ui <- renderUI({

            actionButton(
               inputId = "submit_request_button",
               label = " Get data "
         )
      })
   })#second observeEvent for submit_request_button_ui

   observeEvent(input$submit_request_button, {

      selected_data <- reactive({

         if( input$multiple_choice_1_source =="db1"){

             mtcars


         } else if ( input$multiple_choice_1_source == "db1")                 {

         diamonds


         } else if ( input$multiple_choice_1_source == "db3")      { NULL

         } else if ( input$multiple_choice_1_source == "db4"){ NULL
         }



      })

      user_input_rv$series_picked <- input$multiple_choice_2_type

      user_input_rv$selected_data <- selected_data()


            min_cols <- as.integer(1) # default 1
            max_cols <- as.integer(length(colnames(selected_data())))
            #print(max_cols)


            #this renderUI creates the right-hand side column of the app COLUMNS
            output$ColnamesInput <-  renderUI({

               lapply(min_cols:max_cols, function(z) {

                  column(width = 3,
                         offset = 0,
                            selectInput( inputId = paste0("cols","_",z),
                                         label = paste(input$multiple_choice_2_type,": ",colnames(selected_data())[z]),
                                         choices = unique(selected_data()[[z]]),
                                         multiple = TRUE
                            ) #selectizeInput

                  )

               })#lapply inner

            }) #renderUI for columns

   }) #third observeEvent for data selection and customisation

}

shinyApp(ui = ui, server = server)
4
  • Have you tried using eventReactive?
    – SBista
    Jan 25, 2018 at 11:19
  • Yes, but I only tried replacing the reactive for selected_data()
    – J. Doe.
    Jan 25, 2018 at 11:28
  • If you want the values to only be changed when you press submit button, then why are you using reactive expression or reactiveValues?
    – SBista
    Jan 25, 2018 at 11:44
  • Good question - summarizes how comfortable I am with shiny reactivity...
    – J. Doe.
    Jan 25, 2018 at 12:14

1 Answer 1

1

Here is a the code in which I have removed the reactive expression from and used a local variable selected_data instead.

  observeEvent(input$submit_request_button, {

    # selected_data <- reactive({

      # browser()
    selected_data <- NULL

      if( input$multiple_choice_1_source =="db1"){

        selected_data <- mtcars


      } else if ( input$multiple_choice_1_source == "db1")                 {

        selected_data <- diamonds


      } else if ( input$multiple_choice_1_source == "db3")      { selected_data <- NULL

      } else if ( input$multiple_choice_1_source == "db4"){selected_data <-   NULL
      }



    # })

    user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)

    user_input_rv$selected_data <- selected_data


    min_cols <- as.integer(1) # default 1
    max_cols <- as.integer(length(colnames(selected_data)))
    #print(max_cols)


    #this renderUI creates the right-hand side column of the app COLUMNS
    output$ColnamesInput <-  renderUI({

      lapply(min_cols:max_cols, function(z) {

        column(width = 3,
               offset = 0,
               selectInput( inputId = paste0("cols","_",z),
                            label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
                            choices = unique(selected_data[[z]]),
                            multiple = TRUE
               ) #selectizeInput

        )

      })#lapply inner

    }) #renderUI for columns

  }) #third observeEvent for data selection and customisation

Now when you change the select input options the ColnamesInput do not get triggered. It gets triggered only after you click the submit button.

[EDIT]:

Might not be the best method, but I think I am able to achieve what you wanted. Also, I have taken the liberty on using the reactiveValue that was already defined in your server. Have a look at the modified server code below:

server <- function(input, output)
{
  user_input_rv =  reactiveValues(

    source_picked             = NULL,
    last_used_source          = NULL,

    type_picked               = NULL,
    series_picked             = NULL,
    last_used_series          = NULL,

    selected_data             = NULL,
    final_selection           = NULL
  )



  observeEvent(input$multiple_choice_1_source, {


    user_input_rv$source_picked <- input$multiple_choice_1_source

    ###Start: To check if the source changed#########
    if(!is.null(user_input_rv$last_used_source))
    {
      if(user_input_rv$last_used_source != user_input_rv$source_picked)
      {
        shinyjs::hide("ColnamesInput")
        user_input_rv$last_used_source = user_input_rv$source_picked
      }
    }else
    {
      user_input_rv$last_used_source = user_input_rv$source_picked
    }
    ###End: To check if the source changed#########


    #change data loaded under type picked.
    user_input_rv$type_picked <-
      if (        input$multiple_choice_1_source == "db1"){ paste0(colnames(mtcars))
      } else if ( input$multiple_choice_1_source == "db2"){ paste0(colnames(diamonds))
      } else if ( input$multiple_choice_1_source == "db3"){ NULL
      } else if ( input$multiple_choice_1_source == "db4"){ NULL
      }

    output$multiple_choice_2_type_ui <- renderUI({

      selectizeInput( inputId = 'multiple_choice_2_type',
                      choices = paste(user_input_rv$type_picked),
                      label= "2. Select type",
                      multiple = TRUE,
                      size = 10,
                      width = '100%',
                      options = list( placeholder = 'Type',
                                      maxItems =1
                      )
      )
    })

  }) #first observeEvent for source type and data load.

  observeEvent(input$multiple_choice_2_type,{


    ###Start: To check if the series changed######### 
    user_input_rv$series_picked <- input$multiple_choice_2_type

    if(!is.null(user_input_rv$last_used_series))
    {
      if(user_input_rv$last_used_series != user_input_rv$series_picked)
      {
        shinyjs::hide("ColnamesInput")
        user_input_rv$last_used_series = user_input_rv$series_picked
      }
    }else
    {
      user_input_rv$last_used_series = user_input_rv$series_picked
    }
    ###End: To check if the series changed#########

    output$submit_request_button_ui <- renderUI({

      actionButton(
        inputId = "submit_request_button",
        label = " Get data "
      )
    })
  })#second observeEvent for submit_request_button_ui

  observeEvent(input$submit_request_button, {

    # selected_data <- reactive({

      # browser()
    shinyjs::show("ColnamesInput")
    selected_data <- NULL

      if( input$multiple_choice_1_source =="db1"){

        selected_data <- mtcars


      } else if ( input$multiple_choice_1_source == "db1")                 {

        selected_data <- diamonds


      } else if ( input$multiple_choice_1_source == "db3")      { selected_data <- NULL

      } else if ( input$multiple_choice_1_source == "db4"){selected_data <-   NULL
      }



    # })

    user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)

    user_input_rv$selected_data <- selected_data


    min_cols <- as.integer(1) # default 1
    max_cols <- as.integer(length(colnames(selected_data)))
    #print(max_cols)


    #this renderUI creates the right-hand side column of the app COLUMNS
    output$ColnamesInput <-  renderUI({

      lapply(min_cols:max_cols, function(z) {

        column(width = 3,
               offset = 0,
               selectInput( inputId = paste0("cols","_",z),
                            label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
                            choices = unique(selected_data[[z]]),
                            multiple = TRUE
               ) #selectizeInput

        )

      })#lapply inner

    }) #renderUI for columns

  }) #third observeEvent for data selection and customisation

}

Hope it helps!

3
  • Thank you @SBista . The problem is that ColnamesInput remains visible when the choices for the two selectizes change. I need to hide them.
    – J. Doe.
    Jan 25, 2018 at 12:03
  • @J.Doe., I have edited the code to achieve what you wanted. Have a look. Hope it helps!
    – SBista
    Jan 25, 2018 at 13:18
  • Thank you @SBista . It gets the job done. I think it's as efficient as it can be made to be. I was on the right track with those reactiveValues at the top but I had failed more than once. Where you got it 100% right was the nested if statement. Thank you again!
    – J. Doe.
    Jan 25, 2018 at 14:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.