具有大数据框过滤器的错误和 R shiny 中的视图
Bugs with large dataframe filters & view in R shiny
我正在尝试制作一个具有相互依赖性 selectInput() 的闪亮应用程序，它似乎在 "little" 数据帧上运行良好，但在 "large" 数据帧上崩溃。
这是我的示例，有两个数据框：首先，您可以使用两个数据框启动应用程序，只需注释您不想在输出中显示的那个。
性能有问题，我必须使用 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 函数
的错误
我用 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)
我找到了另一个具有 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)
我正在尝试制作一个具有相互依赖性 selectInput() 的闪亮应用程序，它似乎在 "little" 数据帧上运行良好，但在 "large" 数据帧上崩溃。
这是我的示例，有两个数据框：首先，您可以使用两个数据框启动应用程序，只需注释您不想在输出中显示的那个。
性能有问题，我必须使用 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 函数
我用 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)
我找到了另一个具有 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)