#r #shiny
Вопрос:
Я уже публиковал вариант этого сценария с другими проблемами, которые теперь были решены, но я все еще имею дело с последней проблемой, связанной с возможностью приложений обрабатывать большие наборы данных.
Если я запускаю все локально, все работает нормально. Немного медленный и запаздывающий, но справляется с работой. Проблема возникает, когда я отправляю его на свой Блестящий сервер.
Во время успешного развертывания вы заметите, что при выполнении следующих действий вы получите сообщение об ошибке:
- Переместите ползунок возрастного диапазона с 18-20 на 18-45
- Переместите ползунок порога оценки с 35 на 0.
Если вы сделаете это, это должно выдать следующее сообщение об ошибке:
Как я могу лучше оптимизировать свой сценарий, чтобы справиться с этим? Я предполагаю, что это связано с размером набора данных, с которым я работаю (3 строки), но в прошлом я использовал другие блестящие приложения с большими наборами данных, которые отлично работают.
Во-первых, вот воспроизводимые данные в global.R
файле:
library(dbplyr) library(dplyr) library(shiny) library(DT) df lt;- read.csv("https://raw.githubusercontent.com/datacfb123/testdata/main/canonical_df2.csv") d lt;- df n lt;- 12 df lt;- do.call("rbind", replicate(n, d, simplify = FALSE))
Затем server.R
файл:
server lt;- function(input, output, session){ observeEvent(input$data1, { if (input$data1 != "All") { updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1]))) } else { updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county))) } }, priority = 2) observeEvent(c(input$data1, input$data2), { if (input$data2 != "All") { updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2]))) } else { if (input$data1 != "All") { updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1]))) } else { updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city))) } } }, priority = 1) filtered_data lt;- reactive({ temp_data lt;- df if (input$data1 != "All") { temp_data lt;- temp_data[temp_data$state == input$data1, ] } if (input$data2 != "All") { temp_data lt;- temp_data[temp_data$county == input$data2, ] } if (input$data3 != "All") { temp_data lt;- temp_data[temp_data$city == input$data3, ] } if (input$data4 != "All") { temp_data lt;- temp_data[temp_data$demo == input$data4, ] } if (input$data5 != "All") { temp_data lt;- temp_data[temp_data$registration_status == input$data5, ] } temp_data %gt;% filter(temp_data$age gt;= input$age[1] amp; temp_data$age lt;= input$age[2] amp; temp_data$turnout_score gt;= input$score) }) output$table lt;- renderDT( filtered_data() %gt;% select(unique_id, first_name, last_name, phone) ) output$download lt;- downloadHandler( filename = function() { paste("universe", "_", date(), ".csv", sep="") }, content = function(file) { write.csv(filtered_data() %gt;% select(unique_id, first_name, last_name, phone) %gt;% distinct_all(), file, row.names = FALSE) } ) }
And finally, the ui.R
file:
ui lt;- fluidPage( titlePanel("Sample"), sidebarLayout( sidebarPanel( selectInput("data1", "Select State", choices = c("All", unique(df$state))), selectInput("data2", "Select County", choices = NULL), selectInput("data3", "Select City", choices = NULL), selectInput("data4", "Select Demo", choices = c("All", unique(df$demo))), selectInput("data5", "Select Registration Status", choices = c("All", unique(df$registration_status))), sliderInput("age", label = h3("Select Age Range"), 18, 45, value = c(18, 20), round = TRUE, step = 1), sliderInput("score", label = h3("Select Score Minimum"), min = 0, max = 100, value = 35), downloadButton("download", "Download Data") ), mainPanel( DTOutput("table") ) ))