Atakan
Atakan

Reputation: 446

Preventing Shiny selectInput from evaluating prematurely when updating a reactive plot

I am working on a Shiny app that generates various plots and allows users to change graphing parameters. For this, I'm using a combination of selectInput, numericInput, and checkboxInput functions after the plot is generated (conditionalPanel). I packaged the code so that the data.frame used for the graph is calculated reactively (to allow flexible subsetting before plotting). Everything works great, but when I want to update some graphing parameters (such as colors to use via selectInput), the code breaks down because it evaluates prematurely before I select all the necessary colors (i.e. when there are 4 colors needed, code breaks right after selecting the first color).

I know about debounce function to delay evaluation, but I don't want to use it because:

One solution can be to add an actionButton shown conditionally (along with other graphing parameters) to regulate the firing of the reactive input values (see below). This is not ideal because after changing parameters, I need to click on update to renew the graph. Also, I'm not sure how this would even work because the km_graph is already a reactive plot object. Alternatively, is there a solution for regulating selectInput specifically so that until all the colors selected, it is not evaluated?

I read several posts on this issue but I couldn't find a solution that works with the design of my code. I will try to write sections of my ui and server to give an idea of what I'm trying to do:

ui.R



# ...

 mainPanel(
                                  
                 plotOutput("km_graph"),
                 
                 # Conditional panel prompted only after the km_graph is generated             
                 conditionalPanel(
                     
                     condition = "output.km_graph" ,
                     
                     
                     checkboxInput("km_risk", label="Show risk table", F),
                     
                     selectInput("km_medline", label = "Mark median survival", 
                                 selected = "hv",
                                 choices = c("None" = "none",
                                             "Horizontal-Vertical" = "hv",
                                             "Vertical" = "v",
                                             "Horizontal" = "h")),
                     sliderInput("km_xlim", label="days", value = 6000, min = 10, max=10000),
                     selectInput("km_pal", "Select colors", multiple = T, 
                                 selectize = T, 
                                 selected = "jco",
                                 choices = list(`Pre-made palettes` = list("npg","aaas", "lancet", "jco", 
                                                                           "ucscgb", "UChicago", 
                                                                           "simpsons", "rickandmorty")
                                                 `Individual colors` = as.list(color_choices)) 
                                 )

# Need to find a way to prevent evaluating before all the colors are selected for km_pal

# Maybe another actionButton() here to update graph after all the parameters are selected?

server.R


#...
# km_results() is the reactive object containing survival analysis results
# km_dat() is the reactive data frame used in the analyses

output$km_graph <- renderPlot({
                                      

        survminer::ggsurvplot(km_results(), data = km_dat(), 
                   pval = input$km_pval,
                   pval.method = input$km_pval,
                   risk.table = input$km_risk, 
                   conf.int = input$km_confint,
                   surv.median.line = input$km_medline,
                   break.time.by = input$km_breaktime,  
                   legend="right",
                   xlim=c(0, input$km_xlim),
                   palette = input$km_pal)     ###### This breaks due to premature evaluation
              
        
    })

Full Reprex

    shinyApp(
        ui = basicPage(
            
            selectInput("dat", "Select data", 
                        selected = "iris", choices = c("iris")),
            
            actionButton("go", "Go!"),

            plotOutput("plot"),
            
            conditionalPanel(
                
                h3("graphing options"),
                
                condition = "output.plot",
                
                checkboxInput("plot_point", "Show points", T),
                
                selectizeInput("plot_colors", "Select colors", selected="jco",
                               choices = list(`premade`=list("jco", "npg"),
                                              `manual`=list("red", "black", "blue")))
                
            )
            
        ),
        
        server = function(input, output) {
            
            dat <- reactive({
                
                if(input$dat == "iris") iris
                
            })
            
           output$plot <- renderPlot({
               
               req(input$go)
            
            ggpubr::ggscatter(dat(), "Sepal.Length", "Sepal.Width",
                              color="Species", palette=input$plot_colors)
                
            })
            
        }
    )
    

Thanks for the insights!

Upvotes: 3

Views: 593

Answers (1)

Jrm_FRL
Jrm_FRL

Reputation: 1423

I'm not 100% sure I fully understood, but you could for example pass the plot_colors input in a reactive variable that is triggered by an action button "Apply colors" ?

(you need to add multiple = TRUE in the selectizeInput's arguments)

Here is an example of code based on your reprex:

shinyApp(
  ui = basicPage(

    selectInput("dat", "Select data", 
                selected = "iris", choices = c("iris")),

    actionButton("go", "Go!"),

    plotOutput("plot"),

    conditionalPanel(

      h3("graphing options"),

      condition = "output.plot",

      checkboxInput("plot_point", "Show points", T),

      selectizeInput("plot_colors", 
                     "Select colors", 
                     selected="jco",
                     multiple = TRUE,
                     choices = list(`premade`=list("jco", "npg"),
                                    `manual`=list("red", "black", "blue"))),

      actionButton(inputId = "apply", label = "Apply colors")

    )

  ),

  server = function(input, output) {

    dat <- reactive({

      if(input$dat == "iris") iris

    })

    params_curve <- shiny::eventReactive(eventExpr = input$apply, 
                                         {
                                           return(list(colors = input$plot_colors))
                                         },
                                         ignoreNULL = F, 
                                         ignoreInit = F
    )

    output$plot <- renderPlot({

      req(input$go)

      ggpubr::ggscatter(dat(), "Sepal.Length", "Sepal.Width",
                        color="Species", palette=params_curve()$colors)

    })



  }
)

If you select "red", "black", and "blue", then the dimension of your plot_colors variable is 3. So, the plot is rendered.

Upvotes: 1

Related Questions