Question

这真的让我转圈了。

我正在研究一个R脚本，该脚本加载一个数据帧并使用该数据帧中的字段填充selectizeInput的层次结构集。例如。每个输入代表上一个输入的子集。每个子区域包含多个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)

来自已过滤数据帧的多个updateSelectizeInput

1 个答案: