文章/答案/技术大牛

发布

社区首页 >问答首页 >动态过滤相同/公共级别的闪亮应用程序

问动态过滤相同/公共级别的闪亮应用程序
EN

Stack Overflow用户

提问于 2020-12-15 16:13:29

回答 1查看 206关注 0票数 0

我正在尝试一个带有3个动态过滤器的应用程序，其中每个过滤器都是前一个过滤器的子集。

然而，我取得了部分成功，因为对于某些数据，我有类似的级别/因素，这似乎导致了我的过滤器结果出现问题。

我似乎想不出如何解决"Spot“属性的公共级别问题。

有人有任何反馈吗？

谢谢!

我的应用程序：

library(rstudioapi)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(shinyWidgets)
library(readxl)
library(DT)
library(devtools)
library(dplyr)
library(tidyr)
library(tidyverse)
library(rgl)
library(rglwidget)


col_1 <- c("A1","A1","A1", "A2", "A2", "B1", "B2", "C1","C1","C1")
col_2 <- c("a",  "b", "c", "d", "e", "a", "b", "a",  "b", "c")
col_3 <- c("Benz",  "Audi", "Renault", "Ferrari", "Porsche", "Mercedes", "Benz", "Benz",  "Audi", "Renault")

data_1 <- data.frame(col_1, col_2, col_3, stringsAsFactors = TRUE)
colnames(data_1) <- c("Building", "Spot", "Car")

server <- function(input, output, session) {
  
  filterCars <- reactive({
    filterCar <- data_1
    filterCar <- droplevels.data.frame(filterCar)
    return(filterCar)
  })
  
  filterBuilding <- reactive({
    unique(as.character(filterCars()$Building))
  })
  
  output$filterBuilding <- renderUI({
    pickerInput(inputId = 'filter_Building', 'Building',
                choices = sort(filterBuilding()),
                multiple = TRUE,
                width = "1250px",
                options = list(`actions-box` = TRUE),
                selected = sort(as.character(filterCars()$Building)))
  })
  
  # # Subset dynamically the previous reactive filter #
  datasub1 <- reactive({
    data_1[data_1$Building == input$filter_Building,]
  })
  
  filterSpot <- reactive({
    unique(as.character(datasub1()$Spot))
  })
  
  output$filterSpot <- renderUI({
    pickerInput(inputId = 'filter_Spot', 'Spot',
                choices = sort(filterSpot()),
                multiple=TRUE,
                width = "1250px",
                options = list(`actions-box` = TRUE),
                selected = sort(as.character(filterCars()$Spot)))
  })
  
  # Subset dynamically the previous reactive filter #
  datasub2 <- reactive({
    data_1[data_1$Spot == input$filter_Spot,]
  })

  filterBrand <- reactive({
    unique(as.character(datasub2()$Car))
  })

  output$filterBrand <- renderUI({
    pickerInput(inputId = 'filter_Brand', 'ID',
                choices = sort(filterBrand()),
                multiple = TRUE,
                width = "1250px",
                selected = NULL,
                options = list("max-options" = 4, `actions-box` = TRUE))
  })
  
  
   output$databaseCars <- DT::renderDT({

    #  Subset for plotly reactivity
    Filter1 <- droplevels.data.frame(data_1)
    Filter2 <- filter(Filter1,
                      Filter1$Building %in% input$filter_Building,
                      Filter1$Spot %in% input$filter_Spot,
                      Filter1$Car %in% input$filter_Brand)

    # Plot
    datatable(Filter2,
              filter="none",
              selection="none",
              escape=FALSE,
              rownames = FALSE,
              # colnames = c("", ""),
              autoHideNavigation = TRUE,
              style = 'bootstrap4',
              options = list(searching = FALSE, # remove search option
                             ordering = FALSE, # remove sort option
                             paging = FALSE,  # remove paging
                             info = FALSE # remove bottom information
              )) %>%
      formatStyle(columns = 1, fontWeight = 'bold', `text-align` = 'left') # text to bold and lign left in first column
  })
  
}

# User Interface
ui <- fluidPage(
  
  mainPanel(
    
    fluidRow(
      column(12,
             uiOutput("filterBuilding")
      )),
    
    fluidRow(
      column(12,
             uiOutput("filterSpot")
      )),
    
    fluidRow(
      column(12,
             uiOutput("filterBrand")
      )),
    
    p(DTOutput('databaseCars'))
  )
)

shinyApp(ui, server)

filter

shiny

subset

dynamic

回答 1

Stack Overflow用户

回答已采纳

发布于 2020-12-15 17:38:37

我发现了几个问题：

每个变量可以有几个因素/选择，因此您需要使用%in%而不是==来过滤品牌的
，您已经设置了selected = NULL，因此在默认的
中没有选择任何品牌，因此建议在ui部分中创建UI元素并使用updatePickerInput更新它们，而不是使用renderUI，因为所有呈现都必须在服务器端完成，这可以减缓应用程序的速度(特别是如果您有几个并行用户，因为只有一个R处理H 213提供服务)。

以下是我的看法：

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


col_1 <- c("A1","A1","A1", "A2", "A2", "B1", "B2", "C1","C1","C1")
col_2 <- c("a",  "b", "c", "d", "e", "a", "b", "a",  "b", "c")
col_3 <- c("Benz",  "Audi", "Renault", "Ferrari", "Porsche", "Mercedes", "Benz", "Benz",  "Audi", "Renault")

data_1 <- data.frame(col_1, col_2, col_3, stringsAsFactors = TRUE)
colnames(data_1) <- c("Building", "Spot", "Car")

server <- function(input, output, session) {
  
  filterCars <- reactive({
    filterCar <- data_1
    filterCar <- droplevels.data.frame(filterCar)
    return(filterCar)
  })
  
  
  filterBuilding <- reactive({
    unique(as.character(filterCars()$Building))
  })
  
  observeEvent(filterBuilding(), {
    updatePickerInput(session,
                      "filter_Building",
                      choices = filterBuilding(),
                      selected = sort(filterBuilding()))
  })
  
  # # Subset dynamically the previous reactive filter #
  datasub1 <- reactive({
    data_1[data_1$Building %in% input$filter_Building,]
  })
  
  filterSpot <- reactive({
    unique(as.character(datasub1()$Spot))
  })
  
  observeEvent(filterSpot(), {
    updatePickerInput(session,
                      "filter_Spot",
                      choices = sort(filterSpot()),
                      selected = sort(filterSpot()))
  })
  
  # Subset dynamically the previous reactive filter #
  datasub2 <- reactive({
    # browser()
    data_1[data_1$Spot %in% input$filter_Spot,]
  })
  
  filterBrand <- reactive({
    unique(as.character(datasub2()$Car))
  })
  
  observeEvent(filterBrand(), {
    updatePickerInput(session,
                      "filter_Brand",
                      choices = sort(filterBrand()),
                      selected = sort(filterBrand()))
  })
  
  
  output$databaseCars <- DT::renderDT({
    
    #  Subset for plotly reactivity
    Filter1 <- droplevels.data.frame(data_1)
    Filter2 <- filter(Filter1,
                      Filter1$Building %in% input$filter_Building,
                      Filter1$Spot %in% input$filter_Spot,
                      Filter1$Car %in% input$filter_Brand)
    
    # Plot
    datatable(Filter2,
              filter="none",
              selection="none",
              escape=FALSE,
              rownames = FALSE,
              # colnames = c("", ""),
              autoHideNavigation = TRUE,
              style = 'bootstrap4',
              options = list(searching = FALSE, # remove search option
                             ordering = FALSE, # remove sort option
                             paging = FALSE,  # remove paging
                             info = FALSE # remove bottom information
              )) %>%
      formatStyle(columns = 1, fontWeight = 'bold', `text-align` = 'left') # text to bold and lign left in first column
  })
  
}

# User Interface
ui <- fluidPage(
  
  mainPanel(
    
    fluidRow(
      column(12,
             pickerInput(inputId = 'filter_Building', 'Building',
                         choices = NULL,
                         multiple = TRUE,
                         width = "1250px",
                         options = list(`actions-box` = TRUE),
                         selected = NULL)
      )),
    
    fluidRow(
      column(12,
             pickerInput(inputId = 'filter_Spot', 'Spot',
                         choices = NULL,
                         multiple=TRUE,
                         width = "1250px",
                         options = list(`actions-box` = TRUE),
                         selected = NULL)
      )),
    
    fluidRow(
      column(12,
             pickerInput(inputId = 'filter_Brand', 'ID',
                         choices = NULL,
                         multiple = TRUE,
                         width = "1250px",
                         selected = NULL,
                         options = list("max-options" = 4, `actions-box` = TRUE))
      )),
    
    p(DTOutput('databaseCars'))
  )
)

shinyApp(ui, server)

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/65309601

复制

相似问题

问动态过滤相同/公共级别的闪亮应用程序
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问动态过滤相同/公共级别的闪亮应用程序EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问动态过滤相同/公共级别的闪亮应用程序
EN