Динамические фильтры блестящего приложения с одинаковыми/общими уровнями

Я пытаюсь создать приложение с 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)
Стоит ли изучать PHP в 2026-2027 годах?
Стоит ли изучать PHP в 2026-2027 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
0
268
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Несколько проблем, которые я заметил:

  • у вас может быть несколько факторов/выборов для каждой переменной, поэтому вам нужно использовать %in% вместо == для фильтрации
  • для брендов вы установили selected = NULL, поэтому бренд не был выбран по умолчанию
  • в общем, рекомендуется создавать элементы пользовательского интерфейса в части ui и обновлять их с помощью updatePickerInput вместо использования renderUI, потому что тогда весь рендеринг должен выполняться на стороне сервера, что может замедлить работу приложения (особенно если у вас есть несколько параллельных пользователей, так как обслуживается только одним R процессом

Вот мое мнение:

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)

Здравствуй Старя, спасибо за ответ! Отличная штука, решает мою проблему. Если можно, просто дополнительный комментарий/вопрос? Есть ли способ сделать общие значения линий (a,b,c) для зданий A и C независимыми факторами/уровнями?

RCS 16.12.2020 17:49

извини, я не понимаю, что ты имеешь в виду. Вы хотите извлечь буквы в «A1», «C1» и т. д. как собственную переменную?

starja 16.12.2020 17:55

Извините, я не был ясен. Для кадра данных, который у меня есть для здания A1, строки «a», «b» и «c». То же самое для корпуса «С1». Когда мы выбираем эти два здания в фильтре, линейный фильтр получает варианты «a», «b» и «c», которые имеют одинаковое обозначение для обоих зданий, несмотря на то, что они разные. Итак, мой вопрос заключается в том, возможно ли иметь уровни с одинаковыми именами, но при этом иметь возможность различать их, то есть «а», «а», «б», «б», «с», «с».

RCS 16.12.2020 19:35

Я думаю, что невозможно иметь разные уровни факторов с одним и тем же именем. Если вы хотите разделить их, вы можете подумать о 1.) дать им разные имена с самого начала или 2.) сделать разные входные данные для линий для каждого выбранного здания (однако тогда это усложняет ситуацию)

starja 16.12.2020 22:39

Другие вопросы по теме