带有大型数据框过滤器的错误和 R 中的视图
Posted
技术标签:
【中文标题】带有大型数据框过滤器的错误和 R 中的视图【英文标题】：Bugs with large dataframe filters & view in R shiny 【发布时间】：2019-12-19 18:01:53 【问题描述】：我正在尝试用相互依赖的selectInput() 制作一个闪亮的应用程序，它似乎在“小”数据帧上工作正常，但在“大”数据帧上崩溃。
这是我的示例，带有两个数据框：首先，您可以使用两个数据框启动应用程序，只需注释您不想在输出中显示的那个。
是性能问题，我必须使用 data.table 吗？还是updateSelectInput() 函数问题？
谢谢
library(shiny)
library(dplyr)
library(DT)
# df <- tibble(LETTERS = rep(LETTERS, 2), Numbers = as.character(1:52),
# letters = paste(LETTERS, Numbers, sep = ""))
df <- tibble(LETTERS = rep(LETTERS, 1000), Numbers = as.character(1:(26*1000)),
letters = paste(LETTERS, Numbers, sep = ""))
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(width=3,
selectInput("filter1", "Filter 1", multiple = TRUE, choices = c(unique(df$LETTERS))),
selectInput("filter2", "Filter 2", multiple = TRUE, choices = c(unique(df$Numbers))),
selectInput("filter3", "Filter 3", multiple = TRUE, choices = c(unique(df$letters)))),
mainPanel(
DT::dataTableOutput("tableprint")
)
)
)
server <- function(input, output, session)
goButton <- reactive(
# Data
df1 <- df
if (length(input$filter1))
df1 <- df1[which(df1$LETTERS %in% input$filter1),]
# Update selectInput choices based on the filtered data. Update 'selected' to reflect the user input.
updateSelectInput(session, "filter3", choices = c("All", df1$letters), selected = input$filter3)
updateSelectInput(session, "filter2", choices = c("All", df1$Numbers), selected = input$filter2)
if (length(input$filter2))
df1 <- df1[which(df1$Numbers %in% input$filter2),]
updateSelectInput(session, "filter3", choices = c("All", df1$letters), selected = input$filter3)
updateSelectInput(session, "filter1", choices = c("All", df1$LETTERS), selected = input$filter1)
if (length(input$filter3))
df1 <- df1[which(df1$letters %in% input$filter3),]
updateSelectInput(session, "filter1", choices = c("All", df1$LETTERS), selected = input$filter1)
updateSelectInput(session, "filter2", choices = c("All", df1$Numbers), selected = input$filter2)
datatable(df1)
)
output$tableprint <- DT::renderDataTable(
goButton()
)
shinyApp(ui, server)
我使用textOutput() 函数尝试了相同的示例来显示输出数据框的维度并遇到一些问题，我认为这是updateSelectInput 函数的错误
【问题讨论】：
问题一般是selectInputs。他们似乎无法处理这么多的选择。如果需要，可以使用 DT 中的过滤器选项。如果你愿意，我可以发布一个解决方案？
感谢@EliBerkow，我知道 DT 包中的过滤器选项。就我而言，应用程序因大数据框而崩溃，您如何改进reactive 功能？交易
【参考方案1】：
我用 shinyWidgets 包中的 pickerInputs 替换了您的 selectInputs，它运行得更快 - 它并不快，但它可以工作。我做了一些其他的改变，比如启动时不更新：
library(shiny)
library(dplyr)
library(DT)
library(shinyWidgets)
# df <- tibble(LETTERS = rep(LETTERS, 2), Numbers = as.character(1:52),
# letters = paste(LETTERS, Numbers, sep = ""))
df <- tibble(LETTERS = rep(LETTERS, 1000), Numbers = as.character(1:(26*1000)),
letters = paste(LETTERS, Numbers, sep = ""))
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(width=3,
pickerInput("filter1", "Filter 1", multiple = TRUE, choices = unique(df$LETTERS), options = list(`actions-box` = TRUE)),
pickerInput("filter2", "Filter 2", multiple = TRUE, choices = unique(df$Numbers), options = list(`actions-box` = TRUE)),
pickerInput("filter3", "Filter 3", multiple = TRUE, choices = unique(df$letters), options = list(`actions-box` = TRUE))),
mainPanel(
DT::dataTableOutput("tableprint")
)
)
)
server <- function(input, output, session)
goButton <- reactive(
# Data
df1 <- df
if(length(input$filter1)+length(input$filter2)+length(input$filter3) == 0)
if(!is.null(isolate(input$tableprint_rows_current)))
updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
return(df1)
if (length(input$filter1))
df1 <- df1[which(df1$LETTERS %in% input$filter1),]
# Update selectInput choices based on the filtered data. Update 'selected' to reflect the user input.
updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
if (length(input$filter2))
df1 <- df1[which(df1$Numbers %in% input$filter2),]
updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
if (length(input$filter3))
df1 <- df1[which(df1$letters %in% input$filter3),]
updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
return(df1)
)
output$tableprint <- DT::renderDataTable(
datatable(goButton())
)
shinyApp(ui, server)
【讨论】：
谢谢 Eli，它更好，但仍然没有我想要的快。我想我会选择级联selectInput 来做这种类型的应用程序。
我找到了另一个选项，但代码不是很好，因为我写了所有的可能性你觉得呢？谢谢
它有效，但我明白你的意思 - 它真的很乱【参考方案2】：
我发现uiOutput 和renderUI 函数的另一个选项，不像updateSelectInput 解决方案那样漂亮，但它有效
df <- structure(list(Continent = c("Africa", "Africa", "Asia", "Asia",
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia",
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"Oceania", "Oceania", "Oceania", "Oceania", "Oceania", "Oceania",
"Oceania", "Oceania", "Oceania", "Oceania", "Oceania", "Oceania",
"Oceania", "Oceania", "South America", "South America", "South America",
"South America", "South America", "South America", "South America",
"South America", "South America", "South America", "South America",
"South America"), Country = c("Algeria", "Angola", "India", "India",
"India", "India", "India", "India", "India", "India", "Cambodia",
"Iraq", "Israel", "Japan", "Jordan", "Pakistan", "Philippines",
"Qatar", "Belgium", "Bosnia and Herzegovina", "Bulgaria", "Croatia",
"Cyprus", "Czech Republic", "Denmark", "Estonia", "Finland",
"France", "Georgia", "Monaco", "Montenegro", "Netherlands", "Norway",
"Poland", "Portugal", "Romania", "San Marino", "Serbia", "Slovakia",
"Slovenia", "Spain", "Sweden", "Switzerland", "United States",
"United States", "United States", "United States", "United States",
"United States", "United States", "United States", "United States",
"United States", "United States", "United States", "United States",
"United States", "Panama", "Saint Kitts and Nevis", "Saint Lucia",
"Saint Vincent and the Grenadines", "Trinidad and Tobago", "Australia",
"Fiji", "Kiribati", "Marshall Islands", "Micronesia", "Nauru",
"New Zealand", "Palau", "Papua New Guinea", "Samoa", "Solomon Islands",
"Tonga", "Tuvalu", "Vanuatu", "Argentina", "Bolivia", "Brazil",
"Chile", "Colombia", "Ecuador", "Guyana", "Paraguay", "Peru",
"Suriname", "Uruguay", "Venezuela"), State = c("State_Algeria",
"State_Angola", "Andhra Pradesh", "Arunachal Pradesh", "Assam",
"Bihar", "Chhattisgarh", "Goa", "Gujarat", "Haryana", "State_Cambodia",
"State_Iraq", "State_Israel", "State_Japan", "State_Jordan",
"State_Pakistan", "State_Philippines", "State_Qatar", "State_Belgium",
"State_Bosnia and Herzegovina", "State_Bulgaria", "State_Croatia",
"State_Cyprus", "State_Czech Republic", "State_Denmark", "State_Estonia",
"State_Finland", "State_France", "State_Georgia", "State_Monaco",
"State_Montenegro", "State_Netherlands", "State_Norway", "State_Poland",
"State_Portugal", "State_Romania", "State_San Marino", "State_Serbia",
"State_Slovakia", "State_Slovenia", "State_Spain", "State_Sweden",
"State_Switzerland", "Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "District of Columbia",
"Florida", "Georgia", "Hawaii", "Idaho", "Iowa", "State_Panama",
"State_Saint Kitts and Nevis", "State_Saint Lucia", "State_Saint Vincent and the Grenadines",
"State_Trinidad and Tobago", "State_Australia", "State_Fiji",
"State_Kiribati", "State_Marshall Islands", "State_Micronesia",
"State_Nauru", "State_New Zealand", "State_Palau", "State_Papua New Guinea",
"State_Samoa", "State_Solomon Islands", "State_Tonga", "State_Tuvalu",
"State_Vanuatu", "State_Argentina", "State_Bolivia", "State_Brazil",
"State_Chile", "State_Colombia", "State_Ecuador", "State_Guyana",
"State_Paraguay", "State_Peru", "State_Suriname", "State_Uruguay",
"State_Venezuela"), Population = c(436315, 322788, 84665533,
1382611, 31169272, 103804637, 25540196, 1457723, 60383628, 25353081,
943256, 91267, 536097, 420799, 287888, 980889, 792094, 702230,
334450, 118410, 515967, 398281, 659918, 216675, 133583, 176648,
131878, 941740, 860759, 783373, 188232, 835066, 59606, 992782,
377751, 720217, 982980, 56697, 644305, 391579, 352490, 143215,
90170, 817644, 743157, 572583, 595467, 749073, 527312, 914680,
843229, 978792, 589096, 705171, 750524, 579311, 566931, 800722,
427156, 753354, 153684, 557458, 987445, 675226, 115191, 664896,
619308, 274021, 363655, 85848, 66679, 513121, 427450, 985883,
250922, 406122, 379940, 790470, 300293, 106926, 383729, 851993,
860519, 607444, 776975, 961911, 769912, 979218)), row.names = c(NA, -88L), class = c("tbl_df", "tbl", "data.frame"))
library(shiny)
library(readxl)
library(shinydashboard)
library(dplyr)
library(DT)
is.not.null <- function(x) !is.null(x)
header <- dashboardHeader(
title = "Test",
dropdownMenu(type = "notifications",
notificationItem(
text = "RAS",
icon("cog", lib = "glyphicon")
)
)
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Data", tabName = "ShowData", icon = icon("dashboard")),
menuItem("Summary", tabName = "ShowSummary", icon = icon("bar-chart-o"))
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "ShowData",
DT::dataTableOutput("table")
),
tabItem(tabName = "ShowSummary",
box(width =3,
h3("Test"),
helpText("Please Continent, Country and State Combition"),
uiOutput("continent"),
uiOutput("country"),
uiOutput("state")
),
box(width =9,
DT::dataTableOutput("table_subset")
)
)
)
)
ui = dashboardPage(
header,
sidebar,
body
)
################################################
################################################
server = shinyServer(function(input,output)
data <- bind_rows(replicate(5500, df, simplify = FALSE))
output$table <- DT::renderDataTable(
if(is.null(data))return()
DT::datatable(data, options = list(scrollX = T))
)
output$continent <- renderUI(
selectInput(inputId = "Continent", "Select Continent",choices = c("all", var_continent()), multiple = T)
)
output$country <- renderUI(
selectInput(inputId = "Country", "Select Country",choices = c("all", var_country()), multiple = T)
)
output$state <- renderUI(
selectInput(inputId = "State", "Select State",choices = c("all", var_state()), multiple = T)
)
var_continent <- reactive(
file1 <- data
if(is.null(data))return()
as.list(c("all", unique(file1$Continent)))
)
continent_function <- reactive(
file1 <- data
continent <- input$Continent
continent <<- input$Continent
if (is.null(continent))
return(file1)
else
file2 <- file1 %>%
filter(Continent %in% continent)
return (file2)
)
var_country <- reactive(
file1 <- continent_function()
continent <- input$Continent
file2 <- data
if(is.null(continent))
as.list(unique(file2$Country))
else
as.list(unique(file1$Country))
)
country_function <- reactive(
file1 <- data
country <- input$Country
country <<- input$Country
if (is.null(country))
return(file1)
else
file2 <- file1 %>%
filter(Country %in% country)
return (file2)
)
var_state <- reactive(
file1 <- country_function()
country <- input$Country
file2 <- data
if(is.null(country))
as.list(unique(file2$State))
else
as.list(unique(file1$State))
)
state_function <- reactive(
file1 <- data
state <- input$State
state <<- input$State
if (is.null(state))
return(file1)
else
file2 <- file1 %>%
filter(State %in% state)
return (file2)
)
df <- reactive(
file1 <- data
continent <- input$Continent
country <- input$Country
state <- input$State
if (is.null(continent) & is.not.null(country) & is.not.null(state))
file2 <- file1 %>%
filter(Country %in% country, State %in% state)
else if (is.null(country) & is.not.null(continent) & is.not.null(state))
file2 <- file1 %>%
filter(State %in% state, Continent %in% continent)
else if (is.null(state) & is.not.null(country) & is.not.null(continent))
file2 <- file1 %>%
filter(Country %in% country, Continent %in% continent)
else if (is.null(continent) & is.null(country) & is.not.null(state))
file2 <- file1 %>%
filter(State %in% state)
else if (is.null(continent) & is.null(state) & is.not.null(country))
file2 <- file1 %>%
filter(Country %in% country)
else if (is.null(country) & is.null(state) & is.not.null(continent))
file2 <- file1 %>%
filter(Continent %in% continent)
else
file2 <- file1 %>%
filter(Country %in% country, State %in% state, Continent %in% continent)
file2
)
output$table_subset <- DT::renderDataTable(
# validate(
# need(input$Continent, 'Check that'),
# need(input$Country, 'Please choose :)')
# need(input$State, 'Please choose :D')
# )
DT::datatable(df(), options = list(scrollX = T))
)
)
shinyApp(ui, server)
【讨论】：
看来效果不错！我个人更喜欢 shinyWidgets::pickerInput 因为它有 Select All/Deselect All 按钮，这些按钮更整洁，但您的示例有效 感谢您的建议，是否可以在pickerInput 中搜索，例如如果我在国家输入中写“a”，它应该显示“澳大利亚”，“奥地利”，...？
是的，添加`live-search` = TRUE如下library("shiny") library("shinyWidgets") ui <- fluidPage( br(), pickerInput( inputId = "p1", label = "Select all option", choices = rownames(mtcars), multiple = TRUE, options = list(`actions-box` = TRUE, `live-search` = TRUE) ) ) server <- function(input, output, session) shinyApp(ui = ui, server = server)
查看此处***.com/questions/57485223/… 和此处查看所有选项rdrr.io/cran/shinyWidgets/man/pickerOptions.html。另一种方法是写actionsBox = TRUE 和liveSearch = TRUE
谢谢如果你想更新回复，我接受你的;)以上是关于带有大型数据框过滤器的错误和 R 中的视图的主要内容，如果未能解决你的问题，请参考以下文章