Question

我下面有与selectizeInput相关的代码。
我正在尝试更新两个输入，但是出了点问题，只更新了第一个值
有任何想法吗？
寻求帮助

library(shiny)
library(DT)
    ui <- navbarPage(
      title = "Interaction with Table Cells", id = "x0",

      tabPanel(
        "Table", DT::dataTableOutput("x1"),
        selectizeInput("s1", "speed", choices = cars %>% pull(speed) %>% unique()),
        uiOutput("s2")
      )
    )
    server <- function(session, input, output) {
      # add CSS style 'cursor: pointer' to the 0-th column (i.e. row names)
      output$x1 <- DT::renderDataTable({
        datatable(
          cars,
          selection = "none", class = "cell-border strip hover"
        ) %>% formatStyle(0, cursor = "pointer")
      })

      output$s2 <- renderUI({
        selectizeInput("s2", "dist", choices = cars %>% filter(speed == input$s1) %>%
          pull(dist) %>% unique())
      })

      observeEvent(input$x1_cell_clicked, {
        info <- input$x1_cell_clicked
        # do nothing if not clicked yet, or the clicked cell is not in the 1st column
        if (is.null(info$value) || info$col != 0) {
          return()
        }

        updateSelectizeInput(session, "s1", selected = cars[info$row, "speed"])
        updateSelectizeInput(session, "s2", selected = cars[info$row, "dist"])
      })
    }

    shinyApp(ui, server)

Answer 1

您对发亮的反应性有疑问。

当您说仅第一个值被更新时，情况并非如此。相反。 s2按以下顺序更新两次：

第一个在

之后

updateSelectizeInput(session, "s2", selected = cars[info$row, "dist"])

被称为。

第二，因为input$s2在更新input$s1之后依赖于input$s1的值。

第二次，s2仅取决于当前s1可用的所有选择。因此，将显示第一个值，不会强制调用updateSelectizeInput(s2...)时选择的值。

要解决此问题，您可以创建一个反应变量values$s2_selected，该变量存储s2的指定值。我们删除第二个updateSelectize，仅使用由s1的更改引起的s2的重新验证。同时，我们使用存储的指定选择作为s2的选择选项。

示例代码：

library(shiny)
library(DT)
library(dplyr)
ui <- navbarPage(
  title = "Interaction with Table Cells", id = "x0",

  tabPanel(
    "Table", DT::dataTableOutput("x1"),
    selectizeInput("s1", "speed", choices = cars %>% pull(speed) %>% unique()),
    uiOutput("s2")
  )
)
server <- function(session, input, output) {
  values<-reactiveValues()
  values$s2_selected<-""
  # add CSS style 'cursor: pointer' to the 0-th column (i.e. row names)
  output$x1 <- DT::renderDataTable({
    datatable(
      cars,
      selection = "none", class = "cell-border strip hover"
    ) %>% formatStyle(0, cursor = "pointer")
  })

  output$s2 <- renderUI({
    choices<-cars %>% filter(speed == input$s1) %>%
      pull(dist) %>% unique()
    if(isolate(values$s2_selected)%in%choices){
      selected=isolate(values$s2_selected)
    }
    else{
      selected<-choices[1]
    }
    selectizeInput("s2", "dist", choices = choices,selected=selected)
  })

  observeEvent(input$x1_cell_clicked, {
    info <- input$x1_cell_clicked
    # do nothing if not clicked yet, or the clicked cell is not in the 1st column
    if (is.null(info$value) || info$col != 0) {
      return()
    }
    values$s2_selected<-cars[info$row, "dist"]
    updateSelectizeInput(session, "s1", selected = cars[info$row, "speed"])
  })
}

shinyApp(ui, server)

闪亮的updateSelectizeInput返回错误的值

1 个答案: