Я пытаюсь создать приложение с 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)





Несколько проблем, которые я заметил:
%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)
извини, я не понимаю, что ты имеешь в виду. Вы хотите извлечь буквы в «A1», «C1» и т. д. как собственную переменную?
Извините, я не был ясен. Для кадра данных, который у меня есть для здания A1, строки «a», «b» и «c». То же самое для корпуса «С1». Когда мы выбираем эти два здания в фильтре, линейный фильтр получает варианты «a», «b» и «c», которые имеют одинаковое обозначение для обоих зданий, несмотря на то, что они разные. Итак, мой вопрос заключается в том, возможно ли иметь уровни с одинаковыми именами, но при этом иметь возможность различать их, то есть «а», «а», «б», «б», «с», «с».
Я думаю, что невозможно иметь разные уровни факторов с одним и тем же именем. Если вы хотите разделить их, вы можете подумать о 1.) дать им разные имена с самого начала или 2.) сделать разные входные данные для линий для каждого выбранного здания (однако тогда это усложняет ситуацию)
Здравствуй Старя, спасибо за ответ! Отличная штука, решает мою проблему. Если можно, просто дополнительный комментарий/вопрос? Есть ли способ сделать общие значения линий (a,b,c) для зданий A и C независимыми факторами/уровнями?