Замените наблюдайте за событием (), чтобы восстановить автоматическую c функциональность в блестящем приложении - PullRequest
Новая
       26

Замените наблюдайте за событием (), чтобы восстановить автоматическую c функциональность в блестящем приложении

0 голосов
/ 09 марта 2020

У меня есть блестящее приложение ниже, в котором я использую actionbutton «Обновление», чтобы обновить варианты последней группы флажков «Показывать тикеры для визуалов:», когда я выбираю их из 1-й группы флажков «Текущий выбор (ы)». ):». Проблема в том, что я хочу избавиться от actionbutton и сделать выбор и обновление автоматически. Я использовал observeEvent() для этого, но я не уверен, как заменить их для достижения описанной выше функциональности. 

#app
library(shiny)
library(shinyWidgets)

server <- function(input, output,session) {
  ## Pickerbox Ticker Selection ----
  output$str <- renderUI({
    pickerInput(
      inputId = "strategy",
      label = HTML("<p><span style='color: black'>Select Strategies (Max of 8):</span></p>"),
      width = "100%",
      choices =c("VOO","VO", "VIOO","df","fg"),
      selected = c("VOO","VO", "VIOO"),
      multiple = TRUE
      )
  })


  ## Checkbox Inputs ---- 

  #selected tickers
  output$check_group_buttons <- renderUI({
    prettyCheckboxGroup(
      inputId = "checked_tickers",
      selected = input$strategy[1:length(input$strategy)],
      label = HTML("<p><span style='color: black'>Current Selection(s):</span></p>"),
      choices = input$strategy[1:length(input$strategy)],
      #direction = "vertical",
      inline = TRUE,
      icon = icon("check-square-o"),
      status = "success",
      outline = TRUE,
      animation = "pulse"
    )
  })

  #display tickers
  output$check_group_buttons2 <- renderUI({
    prettyCheckboxGroup(
      inputId = "checked_tickers_to_chart",
      label = HTML("<p><span style='color: black'>Display Tickers for Visuals:</span></p>"),
      selected = input$strategy[1:length(input$strategy)],
      choices =  input$strategy[1:length(input$strategy)],
      inline = TRUE,
      icon = icon("check-square-o"),
      status = "success",
      outline = TRUE,
      animation = "pulse"
    )
  })


  ## Display Tickers ----
  observeEvent(input$update_tickers_for_picker,{
    updatePrettyCheckboxGroup(session = session,
                              inputId = "checked_tickers_to_chart",
                              choices = input$strategy,
                              selected = input$strategy,
                              prettyOptions = list(
                                icon = icon("check-square-o"),
                                status = "success",
                                outline = TRUE,
                                animation = "jelly")
    )

  })
  #Managed update of universe selections
  updated_tickers_for_picker <- eventReactive(input$update_tickers_for_picker,{
    input$checked_tickers
  })

  observeEvent(input$update_tickers_for_picker,{
    updatePickerInput(session = session,
                      inputId = "strategy",
                      choices = c("VOO","VO", "VIOO","df","fg"),
                      selected = updated_tickers_for_picker()
    )

  })
}

ui <- fluidPage(
  sidebarPanel(
    uiOutput("str", width = 6),

    uiOutput("check_group_buttons"),
    actionButton(inputId = "update_tickers_for_picker",
                 label = "Update",icon = icon("play-circle"),
                 style="color: #fff; background-color: #198dc7; border-color: #222d32; border-radius: 70px"),
    uiOutput("check_group_buttons2")
  ),

          mainPanel(

          ))

shinyApp(ui = ui, server = server)

1 Ответ

1 голос
/ 09 марта 2020

Вы ищете что-то подобное? Этот пример взят из блестящей справки по UpdateCheckboxGroupInput.

. Трюк, к которому нужно стремиться, - это использование observe в качестве реактивной среды для наблюдения за первой группой флажков.

Поместите это на свой сервер, ближе к концу. 

...
 #Managed update of universe selections
 observe({
    updated_tickers_for_picker <- input$checked_tickers

    if (is.null(updated_tickers_for_picker))
      updated_tickers_for_picker <- character(0)

    updatePrettyCheckboxGroup(session = session,
                             inputId = "checked_tickers_to_chart",
                             choices = updated_tickers_for_picker,
                             selected = updated_tickers_for_picker,
                             prettyOptions = list(
                               icon = icon("check-square-o"),
                               status = "success",
                               outline = TRUE,
                               animation = "jelly"),
                             inline= TRUE
    )
 })
...
...