Question

我正在编写一个应用程序，其中的单选按钮仅应在选择特定的selectInput时出现。可以了然后，他们应该进一步过滤数据集。但是现在我遇到的问题是，当我选择按钮时，会收到错误消息

听http://127.x.x.x:xxxx
  警告：[[：下标错误   范围
   45：updateRadioButtons
   44：   [/Users/x/Desktop/R2/app.R#61]。

这是我的代码，带有示例数据框。

     override var prefersStatusBarHidden: Bool {
      return true
     }

Answer 1

那这里发生了什么？

   choices = df %>%
   filter(group == input$selected_group) %>%
   select(group) %>%
   .[[1]]

您使用一个空值进行过滤，该值将生成一个带有nrow = 0的数据帧。 select语句会将您的data.frame强制为一个向量，最后得到一个长度为0的向量。

因此，您只希望观察者在选项卡不为空时触发。

observe({
    if(is.null(input$selected_tab == FALSE))
    updateSelectInput(
        session,
        'selected_subgroup',
        choices = df %>%
            filter(tab == input$selected_tab) %>%
            select(subgroup) %>%
            arrange(subgroup) %>%
            .[[1]]
    )
})

一般来说，我不喜欢这种以这种方式更新UI的方式，因为它通常会导致崩溃。您是否熟悉使用renderUI和uiOutput进行服务器端渲染？控制在UI中显示和不显示的内容很多。

tab <- sort(rep(c('typeA','typeB'), 500))
group <- sort(rep(c('AA', 'BB', 'CC', 'DD'), 250))
subgroup <- sort(rep(LETTERS[seq(from = 1, to = 10)], 100))
year <- rep(seq(1996,1999), 250)
relValue <- rnorm(1000, 10, 5)
df <- data.frame(tab, group, subgroup, year, relValue, stringsAsFactors = FALSE)

dfBackup <- df


library(shiny)
library(plotly)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
    sidebarPanel(
        #uiOutput("selected_tab_UI")
        selectInput(inputId = 'selected_tab', label = 'tab', choices = '') ,
        #uiOutput("selected_subgroup_UI")
        selectInput(inputId = 'selected_subgroup', label = 'subgroup', choices = ''),
        #uiOutput("selected_group_UI")
        hr(),
        conditionalPanel(
            condition = "input.selected_tab != 'typeA'",
            radioButtons(inputId = 'selected_group', label = 'group', choices = '')
        )
    ),
    mainPanel(
        plotlyOutput("graph")
    )
)

unique(df[df$tab == "typeA", ]$subgroup)
# unique(df[df$tab == "typeB", ]$subgroup)

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

    observe({
        updateSelectInput(session,
                          'selected_tab',
                          choices = unique(df$tab))
    })

    observeEvent(input$selected_tab, {
        req(input$selected_tab)

        updateSelectInput(
            session,
            'selected_subgroup',
            choices = unique(df[df$tab == input$selected_tab, ]$subgroup)
        )
    })



    observeEvent(c(input$selected_tab, input$selected_subgroup), {
        req(input$selected_tab)
        req(input$selected_subgroup)

        if (input$selected_tab != 'typeA'){
            updateRadioButtons(session,
                               'selected_group',
                               choices = unique(df[df$subgroup == input$selected_subgroup, ]$group)
            )
        }
    })

    plotdata <- reactive({df[df$subgroup == input$selected_subgroup,]}) #df$group == input$selected_group & 

    output$graph <- renderPlotly({
        plotdata() %>%
            plot_ly %>%
            ggplot()+
            geom_bar(mapping = aes(x = year, y = relValue), stat = 'identity', position = 'dodge', fill = '#6cb6ff')
    })
}

shinyApp(ui,server)

与观察者相比，我更喜欢observerEvent，因为它们仅在事件实际触发时才触发。无论如何，看看renderUI：-）

R Shiny中的updateRadioButtons不触发事件

1 个答案: