r - 带有大型数据框过滤器的错误和 R 中的视图

Question

我正在尝试使用 interdependant 制作一个闪亮的应用程序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函数的错误

score 2 · Accepted Answer

我用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)

score 1 · Accepted Answer

我找到了另一个具有uiOutputandrenderUI功能的选项，虽然不是很好的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)

r - 带有大型数据框过滤器的错误和 R 中的视图

2 回答 2

Related

Reference