来自过滤数据帧的多个 updateSelectizeInput

Question

这个真的让我绕圈子。

我正在编写一个 R 脚本，该脚本加载一个数据帧并使用数据帧中的字段来填充selectizeInput 的分层集。例如。每个输入都代表前一个输入的子集。每个 SubRegion 包含多个 LCC，每个 LCC 包含多个 ENB，依此类推。

当用户在任何输入中选择一个值时，该值将用于过滤数据框，并且所有其他 selectizeInputs 都需要从过滤后的数据中更新。

第一个输入（SubRegionInput）似乎工作正常，但每次我尝试让它响应和/或过滤任何其他输入（例如，将input$LCCInput 添加到观察块）时，它们都会被填充几秒钟，然后空白。 我怀疑答案很简单和/或我正在做一些非常愚蠢的事情，但我是一个没有正式 R 培训的彻头彻尾的黑客，所以可能缺少一些非常基本的东西（如果很抱歉的话）。

以下是部分代码（抱歉，我无法将其全部包含在内，但这是为了工作，我无法分享我正在做的事情的细节）。

注意事项 当前的输出只是为了让我在开发这部分代码时可以看到发生了什么。 我现在知道它只设置为过滤一个值......我尝试做的所有事情都失败了，所以我包含了迄今为止我拥有的最实用的代码。

ui <- fluidPage(

   # Application title
   titlePanel("KPI DrillDown"),

   # Sidebar with a slider input for number of bins 
   fluidRow(
     selectizeInput("SubRegionInput", "SubRegion", SubRegionList ,selected = NULL, multiple = TRUE),
     selectizeInput("LCCInput", "LCC", LCCList,selected = NULL, multiple = TRUE),
     selectizeInput("ENBIDInput", "ENBID", ENBIDList,selected = NULL, multiple = TRUE),
     selectizeInput("SiteNumInput", "SiteNumber", SiteNumberList,selected = NULL, multiple = TRUE),
     selectizeInput("SiteNameInput", "SiteName", SiteNameList,selected = NULL, multiple = TRUE),
     selectizeInput("LNCELInput", "LNCell", LNCellList,selected = NULL, multiple = TRUE),
     selectizeInput("SectorInput", "Sector", SectorList,selected = NULL, multiple = TRUE),

      mainPanel(
         #plotOutput("distPlot")
        verbatimTextOutput("SubRegionText"),
        verbatimTextOutput("LCCText"),
         verbatimTextOutput("view")
      )
   )
)

server <- function(input, output) {


  observe({
    input$SubRegionInput
    temp <- SiteInfo[SiteInfo$SITE_SUB_REGION %in% input$SubRegionInput, ]
    thisLCCList = sort(temp$BACKHAUL_LCC[!is.na(temp$BACKHAUL_LCC)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                          , inputId = "LCCInput"
                          , choices = thisLCCList
                          , selected= NULL)
    thisENBIDList = sort(temp$ENODEB_ID[!is.na(temp$ENODEB_ID)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "ENBIDInput"
                         , choices = thisENBIDList
                         , selected= NULL)
    thisSiteNumberList = sort(temp$SITE_NUMBER[!is.na(temp$SITE_NUMBER)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "SiteNumInput"
                         , choices = thisSiteNumberList
                         , selected= NULL)
    thisSiteNameList = sort(temp$SITE_NAME[!is.na(temp$SITE_NAME)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "SiteNameInput"
                         , choices = thisSiteNameList
                         , selected= NULL)
    thisLNCellList = sort(temp$SECTOR_NUMBER[!is.na(temp$SECTOR_NUMBER)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "LNCELInput"
                         , choices = thisLNCellList
                         , selected= NULL)
    thisSectorList = sort(temp$Sector[!is.na(temp$Sector)])
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "SectorInput"
                         , choices = thisSectorList
                         , selected= NULL)
   output$view<- renderPrint(temp)
    })

Answer 1

由于我无权访问您的数据，因此我以 mtcars 为例。 首先，由于您有很多过滤器，我建议创建一个搜索或更新按钮，这就是我在代码中所做的。提取所有 selectizeInputs 后，我只使用 dplyr 进行了一次过滤。我必须手动更改所有空搜索参数以全选以避免过滤到 NA。

总的来说，我认为您的代码的问题是您一次观察到太多的 updateSelectizeInputs。我确实尝试使用您的方式重新创建，而我最终只能更新单个 selectizeInput，而其他 selectizeInputs 不可选择。

希望这种方法适合您的数据。

代码：

library(shiny)
library(dplyr)
library(DT)

data <- mtcars
SubRegionList <- unique(data$cyl)
LCCList <- unique(data$gear)
ENBIDList <- unique(data$am)
SiteNumberList <- unique(data$vs)
# Define UI 
ui <- fluidPage(

    # Application title
    titlePanel("KPI DrillDown"),

    # Sidebar with a slider input for number of bins 
    fluidRow(
        selectizeInput("SubRegionInput", "SubRegion/cyl", SubRegionList ,selected = NULL, multiple = TRUE),
        uiOutput("LCCInput"),
        uiOutput("ENBIDInput"),
        uiOutput("SiteNumInput"),
        uiOutput("Search"),

        mainPanel(
            verbatimTextOutput("view")
        )
    )
)

# Define server logic required 
server <- function(input, output, session) {
    SiteInfo <- data
    # temp <- ""
    observe({
        if (!is.null(input$SubRegionInput)){
            subRegionSelected <- input$SubRegionInput
            ## Create a temp dataset with the selected sub regions.
            temp <- SiteInfo[SiteInfo$cyl %in% subRegionSelected, ]

            ## Push the newly created selectizeInput to UI
            output$LCCInput <- renderUI({
                selectizeInput("LCCInput", "LCC/gear", unique(temp$gear), selected = NULL, multiple = TRUE)
            })
            output$ENBIDInput <- renderUI({
                selectizeInput("ENBIDInput", "ENBID/am", unique(temp$am),selected = NULL, multiple = TRUE)
            })
            output$SiteNumInput <- renderUI({
                selectizeInput("SiteNumInput", "SiteNumber/vs", unique(temp$vs), selected = NULL, multiple = TRUE)
            })
            output$Search <- renderUI({
                actionButton("Search", "Search")
            })

            ## Function that linked to the actionButton
            display <- eventReactive(input$Search,{
                temp <- SiteInfo[SiteInfo$cyl %in% input$SubRegionInput, ]
                # ## manually change all the empty searching parameter to select all in order to avoid filtering to NA
                LCC <- input$LCCInput
                if (is.null(input$LCCInput)){LCC <- unique(temp$gear)}
                ENBID <- input$ENBIDInput
                if (is.null(input$ENBIDInput)){EBVID <- unique(temp$am)}
                SiteNum <- input$SiteNumInput
                if (is.null(input$SiteNumInput)){LCC <- unique(temp$vs)}

                ## Dplyr::filter data
                temp <- temp %>% 
                    filter(gear %in% LCC & am %in% ENBID & vs %in% SiteNum)
                temp
            })

            ## Run the actionButton
            output$view <- renderPrint({
                display()
            })

        } else {
            ## Display waht the data looks like when no Sub Region is selected 
            output$view<- renderPrint(data)
        }
    })


}

# Run the application 
shinyApp(ui = ui, server = server)