Предотвращение преждевременной оценки Shiny selectInput при обновлении реактивного графика - PullRequest
1 голос
/ 24 апреля 2020

Я работаю над приложением Shiny, которое генерирует различные графики и позволяет пользователям изменять параметры графика. Для этого я использую комбинацию функций selectInput, numericInput и checkboxInput после графика (conditionalPanel). Я упаковал код так, чтобы data.frame, используемый для графика, вычислялся реактивно (чтобы обеспечить гибкую поднаборку перед построением графика). Все отлично работает, но когда я хочу обновить некоторые графические параметры (например, цвета для использования через selectInput), код ломается, потому что он оценивается преждевременно, прежде чем я выберу все необходимые цвета (то есть, когда нужно 4 цвета, код ломается сразу после выбора первого цвета).

Я знаю о debounce функции, чтобы задержать оценку, но я не хочу использовать ее, потому что:

  • Мне нравится мгновение изменения в графике при обновлении других параметров
  • Выбор цветов может занять некоторое время, поэтому трудно установить заранее заданный интервал времени / времени задержки

Одним из решений может быть добавьте условное обозначение actionButton (вместе с другими графическими параметрами) для регулирования срабатывания значений реактивного входа (см. ниже). Это не идеально, потому что после изменения параметров мне нужно нажать на обновление, чтобы обновить график. Кроме того, я не уверен, как это будет работать, потому что km_graph уже является реактивным объектом графика. В качестве альтернативы, есть ли решение для регулирования selectInput специально, чтобы до тех пор, пока все цвета не были выбраны, оно не оценивалось?

Я прочитал несколько постов по этой проблеме, но не смог найти решение, которое работает с дизайн моего кода. Я попытаюсь написать разделы моих ui и server, чтобы дать представление о том, что я пытаюсь сделать:

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


    })

Полный представитель

    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)

            })

        }
    )

Спасибо за понимание!

1 Ответ

1 голос
/ 24 апреля 2020

Я не уверен на 100%, что полностью понял, но вы можете, например, передать ввод plot_colors в реактивную переменную, которая вызывается кнопкой действия «Применить цвета»?

(вам нужно добавить multiple = TRUE в аргументы selectizeInput)

Вот пример кода, основанного на вашем представлении:

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)

    })



  }
)

Если вы выбрали «красный», «черный» и "синий", тогда размер вашей переменной plot_colors равен 3. Итак, график отображается.

...