Question

我有一个Shiny应用程序，其中selectInput的更改会导致radioButtons组中用户可用的选项发生变化。根据{{3}}，

可以使用selected=character(0)清除所选项目。

但是，正如下面的例子所示，这似乎不起作用。如果您在更改输入时在控制台中观看消息，则会看到当前颜色＆＃39;永远不会返回null状态。此外，如果你选择红色＆＃39;然后切换到＆＃39; a＆＃39;到＆＃39; b＆＃39;，价值从＆＃39; 1＆＃39;到＆＃39; 4＆＃39;好像你选择了红色＆＃39;再次。这不是实际应用中的理想行为 - ＆＃39;价值＆＃39;只应在用户进行选择后更改。

有关纠正此事的任何建议吗？

library(shiny)

df <- data.frame(letter = c('a', 'a', 'a', 'b', 'b', 'b'),
                 color = c('red', 'blue', 'green', 'red', 'purple', 'orange'),
                 value = 1:6)

ui <- shinyUI(fluidPage(
  tableOutput('show_df'),
  selectInput('letter', 'Pick a letter', choices = c('a', 'b')),
  radioButtons('color', 'Pick a color', choices = NULL, selected = character(0))
))

server <- shinyServer(function(input, output, session) {

  output$show_df <- renderTable(df)

  observe({
    current_letter <- input$letter
    message(paste('Current letter is:', current_letter))
    updateRadioButtons(session,
                       'color',
                       choices = df$color[df$letter == current_letter],
                       selected = character(0))
  })

  observe({
    current_color <- input$color
    message(paste('Current color is:', current_color))
  })

  observe({
    current_value <- df$value[df$letter == input$letter & df$color == input$color]
    message(paste('Current value is:', current_value))
  })

}) 

shinyApp(ui = ui, server = server)

Answer 1

我发现了问题。似乎updateRadioButtons更改了小部件但它没有更新input$color中的值，因此即使未选中所有单选按钮，所选的最后一个值仍然存在。由于您的上一位观察者使用color和letter的值，当用户更改letter的值时，观察者也会使用color的值（其中是最后一个）。即使您使用renderUI，问题仍然存在。

以下是您的代码修改，1）它使用stringsAsFactors = FALSE的数据框，2）它隔离input$letter（您也可以使用obsereEvent），3）它添加一个按钮可以随时显示颜色值，因此您可以确认即使更新单选按钮，input$color仍然使用最后一个值。

library(shiny)

df <- data.frame(letter = c('a', 'a', 'a', 'b', 'b', 'b'),
                 color = c('red', 'blue', 'green', 'red', 'purple', 'orange'),
                 value = 1:6, stringsAsFactors = FALSE)

ui <- shinyUI(fluidPage(
  tableOutput('show_df'),
  selectInput('letter', 'Pick a letter', choices = c('a', 'b')),
  radioButtons('color', 'Pick a color', choices = NULL, selected = character(0)),
  actionButton("test", "showColor")
))

server <- shinyServer(function(input, output, session) {

  output$show_df <- renderTable(df)

  observe({
    current_letter <- input$letter
    message(paste('Current letter is:', current_letter))
    updateRadioButtons(session,
                       'color',
                       choices = df$color[df$letter == current_letter],
                       selected = character(0))
  })

  observe({
    current_color <- input$color
    message(paste('Current color is:', current_color))
  })

  observe({
    current_value <- df$value[df$letter == isolate(input$letter) & df$color == input$color]
    message(paste('Current value is:', current_value))
  })

  observeEvent(input$test, {
    message(">>>color:", input$color)
  })  

}) 

shinyApp(ui = ui, server = server)

Answer 2

正如前面的答案所解释的那样，即使重置单选按钮，input$color也不会更新。

一种解决方案是使用可由两个不同观察者改变的颜色的第三个反应变量。以下是：1）显示原始问题的图形，2）reactiveValues + observeEvent，以及3）显示解决方案的图形。

注1：故障排除文本已添加到代码中，以显示闪亮界面上的输出。注2：图形是用早期的解决方案制作的。原帖有一个额外的条件if / then声明。

library(shiny)

df <- data.frame(letter = c('a', 'a', 'a', 'b', 'b', 'b'),
                 color = c('red', 'blue', 'green', 'red', 'purple', 'orange'),
                 value = 1:6)

ui <- shinyUI(fluidPage(
  tableOutput('show_df'),
  selectInput('letter', 'Pick a letter', choices = c('a', 'b')),
  radioButtons('color', label = 'Pick a color', 
                choices = NULL, selected = character(0)),
  HTML("Troubleshooting:"), br(),
  verbatimTextOutput("troubleshooting")
))

server <- shinyServer(function(input, output, session) {

  output$show_df <- renderTable(df)

  observe({
    current_letter <- input$letter
    message(paste('Current letter is:', current_letter))
    updateRadioButtons(session,
                       'color',
                       choices = as.character(df$color[df$letter == current_letter]), 
                       selected = character(0))
   })

  myColor <- reactiveValues(current = NULL) #Create a reactiveValue
  #Define two observers that each can change the reactiveValue
  observeEvent(input$letter, {  
    myColor$current <- NULL
  })
  observeEvent(input$color, { 
    myColor$current <- input$color 
  })
  myValue <- reactive(df$value[df$letter == input$letter & df$color == myColor$current])

  observe({
    current_color <- input$color
    message(paste('Current color is:', current_color))
  })

  observe({
    current_value <- myValue()
    message(paste('Current value is:', current_value))
  })

  output$troubleshooting <- renderPrint({ list(
                              paste("current letter:", input$letter),
                              paste("current color:", input$color),
                              #Reactive color not originally included in pics.
                              paste("current reactive color:", myColor$current),  
                              paste("current value:", myValue() )
                                               )
                                       })

}) 

shinyApp(ui = ui, server = server)

结果：更改字母时，第一个observeEvent返回NULL，有效地重置最终值。 input$color仍未重置。当observeEvent发生变化时，第二个input$color会返回颜色。

Answer 3

我同意，问题似乎是你无法重置输入变量input $ color。例如。在下面的示例程序中，您无法执行两次相同的操作。

        ui <- fluidPage (
        sidebarLayout(
            sidebarPanel ( uiOutput('uiRadioButtons')),
            mainPanel    (uiOutput('action'))
        )) 
    server <- function(input, output) {
        output$uiRadioButtons <- renderUI({ radioButtons (inputId='actionId', label='action:', choices = c ('a', 'b', 'c'), selected=character(0)) })
        n  <- 0
        observe({
            actionId <- input$actionId
            n <<- n+1
            if (!is.null(actionId)) {
                if (actionId=='a')  output$action  <- renderText (paste (n, "action A"))
                if (actionId=='b')  output$action  <- renderText (paste (n, "action B"))
                if (actionId=='c')  output$action  <- renderText (paste (n, "action C"))
                output$uiRadioButtons <- renderUI({ radioButtons (inputId='actionId', label='action:', choices = c ('a', 'b', 'c'), selected=character(0)) })
            } else                  output$action  <- renderText ("actionId equals NULL")
        })
}
shinyApp (ui = ui, server = server)

作为替代方案，如果您无法将输入变量重置为NULL，则可以选择显示并直接处理的虚拟值，并替换为常规选项。这显示在下面的修改样本中。

    ui <- fluidPage (
    sidebarLayout(
        sidebarPanel (
            # radioButtons (inputId='objectId', label='selct object:', choices = c ('o1', 'o2', 'o3'), inline = TRUE),
            uiOutput('uiRadioButtons')
        ),
        mainPanel    (uiOutput('action'))
    )
)
server <- function(input, output) {
    showActions <- function() {
        output$uiRadioButtons <- renderUI ({ radioButtons (inputId='actionId', label='action:', choices = c ('a', 'b', 'c'), selected=character(0)) })
    }
    showActions()
    n  <- 0
    observe({
        actionId <- input$actionId
        n <<- n+1
        if (!is.null(actionId)) {
            if (actionId=='dummy')  showActions ()
            else {
                if (actionId=='a')  output$action  <- renderText (paste (n, "action A"))
                if (actionId=='b')  output$action  <- renderText (paste (n, "action B"))
                if (actionId=='c')  output$action  <- renderText (paste (n, "action C"))
                output$uiRadioButtons <- renderUI({ radioButtons (inputId='actionId', label='action:', choices = 'dummy') })
            }
        } else                  output$action  <- renderText ("actionId equals NULL")

    })
}
shinyApp (ui = ui, server = server)

但是，对于远程应用程序，此解决方案可能太慢。在这种情况下，使用额外的“无”选项（请参阅radiobuttons帮助）或额外的actionButton并观察该按钮。希望RStudio能够实现重置适用输入变量的选项。

闪亮的updateRadioButtons无法清除所选项目

3 个答案: