时间戳

首页 > 解决方案 > 来自过滤数据帧的多个 updateSelectizeInput

r - 来自过滤数据帧的多个 updateSelectizeInput

问题描述

这让我真的在兜圈子。

我正在开发一个 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)
    })

标签： rdataframeshinyreactive

解决方案

由于我无权访问您的数据，因此我以 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)

推荐阅读