I have overloaded Shiny with data so much so to where when I run the app it says 'listening on ...' in my console but does not respond to any of the buttons in my app.
When I comment out a few tabs, the code runs. However, for work I want to have all of the tabs... I have tried deleting my history and clearing .Rdata but that did not work. I don't know what else to do.
I guess my question is what is the 'max' amount of data that shiny can uphold?
Better yet, does anyone have any insight into how to manage all of this data without shiny crashing? I am almost to the point of creating two separate apps, but my boss really wants just one app. I am desperate!!!
I have
here is my code:
ui <- fluidPage(
titlePanel(title = "SHFB Partner Program Information"),
tabsetPanel(
tabPanel(
title = "Days of Operation",
sidebarLayout(
sidebarPanel(selectInput(inputId = "selectDay",
label = "Days of Operation",
choices = c(
"Monday" = "Monday",
"Tuesday" = "Tuesday",
"Wednesday" = "Wednesday",
"Thursday" = "Thursday",
"Friday" = "Friday",
"Saturday" = "Saturday",
"Sunday" = "Sunday")
),
p("Double click on the county of interest by it's name to view just that county."),
p("The table below shows the partner programs open on the selected day, as well as the other days of the week they are opened."),
h3("Distance Calculator"),
textInput(inputId = "addr1",
label = h4("Enter the first address:"),
value = ""),
textInput(inputId = "addr2",
label = h4("Enter the second address:"),
value = ""),
p("Please include the cities and states in the addresses, separated by commas."),
p("For example: 1834 Wake Forest Road, WS, NC"),
h3(textOutput("value")),
width = 2
),
mainPanel(
plotlyOutput("plotDays"),
tableOutput("table")
)
)
),
tabPanel(
title = "Impoverished Information",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "houseORind",
label = "Number of individuals or households served?",
choices = c("Individual" = "Individual",
"Household" = "Household")),
uiOutput("secondSelection"),
selectInput(inputId = "selectVarTract",
label = "2021 Census Burrow Tract Information",
choices = c("Number of People Impoverished" = "NumbImpoverished",
"People Per Tract" = "PeoplePerTract",
"Percent Impoverished" = "PercImpov",
"Percent Using SNAP" = "PercentWithSNAP")),
uiOutput("linkCensus"),
h3("Distance Calculator"),
textInput(inputId = "addr1",
label = h4("Enter the first address:"),
value = ""),
textInput(inputId = "addr2",
label = h4("Enter the second address:"),
value = ""),
p("Please include the cities and states in the addresses, separated by commas."),
p("For example: 1834 Wake Forest Road, WS, NC"),
h3(textOutput("value")),
width = 3
),
mainPanel(
p("The white census tract in Guilford, Tract 9801, does not have data on the US Census Bureau website."),
plotlyOutput("plot")
)
)
),
tabPanel(
title = "SNAP Information",
sidebarLayout(
sidebarPanel(
uiOutput("linkSNAP"),
width = 2
),
mainPanel(
plotlyOutput("SNAPdiffPlot"),
tableOutput("tabGuidelines")
),
)
),
tabPanel(
title = "Food Desert Information",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "selectVarLALI",
label = "Low Income and Low Access",
choices = c("1 mile for urban areas and 10 miles for rural areas" = "LILATracts_1And10",
"1/2 mile for urban areas and 10 miles for rural areas" = "LILATracts_halfAnd10",
"1 mile for urban areas and 20 miles for rural areas" = "LILATracts_1And20")),
selectInput(inputId = "selectVarInd",
label = "Number of Individuals Served",
choices = c("Unique" = "Individuals_Unique",
"Duplicated" = "Individuals_Dup")),
uiOutput("link"),
width = 3
),
mainPanel(
plotlyOutput("la1"))
)
),
# tabPanel(
# title = "Pounds Distributed to Each County",
# plotlyOutput("poundsCountyPlot")
# ),
tabPanel(
title = "Pounds Distributed to Each Partner Program",
plotlyOutput("pounds_plot")
)
)
)
server <- function(input, output) {
national_guidelines2023 <- data.frame(Persons = c(1, 2, 3, 4, 5, 6, 7, 8),
PovertyGuidelines = c("$14,580", "$19,720", "$24,860", "$30,000", "$35,140", "$40,280", "$45,420", "$50,560"))
output$tabGuidelines <- renderTable(national_guidelines2023)
output$secondSelection <- renderUI({
if (input$houseORind == "Household") {
selectInput(inputId = "selectVar",
label = "Number of Households Served",
choices = c("Unique" = "Households_Unique",
"Duplicated" = "Households_Dup"))
}
else if (input$houseORind == "Individual") {
selectInput(inputId = "selectVarInd",
label = "Number of Individuals Served",
choices = c("Unique" = "Individuals_Unique",
"Duplicated" = "Individuals_Dup"))
}
})
monday <- subset(master_list, (!is.na(master_list$Monday)))
tuesday <- subset(master_list, (!is.na(master_list$Tuesday)))
wednesday <- subset(master_list, (!is.na(master_list$Wednesday)))
thursday <- subset(master_list, (!is.na(master_list$Thursday)))
friday <- subset(master_list, (!is.na(master_list$Friday)))
saturday <- subset(master_list, (!is.na(master_list$Saturday)))
sunday <- subset(master_list, (!is.na(master_list$Sunday)))
monday$Hours <- monday$Monday
tuesday$Hours <- tuesday$Tuesday
wednesday$Hours <- wednesday$Wednesday
thursday$Hours <- thursday$Thursday
friday$Hours <- friday$Friday
saturday$Hours <- saturday$Saturday
sunday$Hours <- sunday$Sunday
monday$Info <- paste0(
"\nName: ", monday$Name,
"\nAddress: ", monday$Address,
"\nCounty: ", monday$County,
"\nHours: ", monday$Hours
)
tuesday$Info <- paste0(
"\nName: ", tuesday$Name,
"\nAddress: ", tuesday$Address,
"\nCounty: ", tuesday$County,
"\nHours: ", tuesday$Hours
)
wednesday$Info <- paste0(
"\nName: ", wednesday$Name,
"\nAddress: ", wednesday$Address,
"\nCounty: ", wednesday$County,
"\nHours: ", wednesday$Hours
)
thursday$Info <- paste0(
"\nName: ", thursday$Name,
"\nAddress: ", thursday$Address,
"\nCounty: ",thursday$County,
"\nHours: ", thursday$Hours
)
friday$Info <- paste0(
"\nName: ", friday$Name,
"\nAddress: ", friday$Address,
"\nCounty: ", friday$County,
"\nHours: ", friday$Hours
)
saturday$Info <- paste0(
"\nName: ", saturday$Name,
"\nAddress: ", saturday$Address,
"\nCounty: ", saturday$County,
"\nHours: ", saturday$Hours
)
sunday$Info <- paste0(
"\nName: ", sunday$Name,
"\nAddress: ", sunday$Address,
"\nCounty: ", sunday$County,
"\nHours: ", sunday$Hours
)
datasetInput <- reactive({
if (input$selectDay == "Monday"){
dataset <- monday
}
else if (input$selectDay == "Tuesday"){
tuesday <- tuesday %>%
group_by(County)
dataset <- tuesday
}
else if (input$selectDay == "Wednesday"){
dataset <- wednesday
}
else if (input$selectDay == "Thursday"){
dataset <- thursday
}
else if (input$selectDay == "Friday"){
dataset <- friday
}
else if (input$selectDay == "Saturday"){
dataset <- saturday
}
else if (input$selectDay == "Sunday"){
dataset <- sunday
}
return(dataset)
})
output$plotDays <- renderPlotly({
plot <- ggplot() +
geom_sf(data = nc_counties, aes(color = NAME)) +
geom_sf(data = datasetInput(), aes(label = Info, fill = Service)) +
theme_minimal() +
scale_color_discrete(name = "County Names and Services") +
scale_fill_discrete(name = " ")
ggplotly(plot, tooltip = "label") %>%
layout(height = 410)
})
output$table <- renderTable({
tab = cbind(datasetInput()$Name, datasetInput()$County, datasetInput()$Monday, datasetInput()$Tuesday, datasetInput()$Wednesday, datasetInput()$Thursday,
datasetInput()$Friday, datasetInput()$Saturday, datasetInput()$Sunday)
colnames(tab) <- c("Name", "County", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
return(tab)
})
url<- a("Food Access Research Atlas", href="https://www.ers.usda.gov/data-products/food-access-research-atlas")
urlCensus <- a("US Census Bureau", href = "https://data.census.gov/table?t=Income+and+Poverty:Official+Poverty+Measure:Poverty&g=050XX00US37001$1400000,37003$1400000,37005$1400000,37009$1400000,37027$1400000,37033$1400000,37057$1400000,37059$1400000,37067$1400000,37081$1400000,37097$1400000,37151$1400000,37157$1400000,37169$1400000,37171$1400000,37193$1400000,37197$1400000")
urlSNAP <- a("US Census Bureau", href = "https://data.census.gov/table?t=SNAP/Food+Stamps&g=050XX00US37001$1400000,37003$1400000,37005$1400000,37009$1400000,37027$1400000,37033$1400000,37057$1400000,37059$1400000,37067$1400000,37081$1400000,37097$1400000,37151$1400000,37157$1400000,37169$1400000,37171$1400000,37189$1400000,37193$1400000,37197$1400000&tid=ACSST5Y2021.S2201&mode=results")
output$link <- renderUI({
tagList("Source:", url)
})
output$linkCensus <- renderUI({
tagList("Source:", urlCensus)
})
output$linkSNAP <- renderUI({
tagList("Source:", urlSNAP)
})
output$plot <- renderPlotly({
if (input$houseORind == "Individual") {
plot <- ggplot()+
geom_sf(data = full_pov_census_data, aes_string(fill = input$selectVarTract)) +
geom_sf(data = link2feed_partner_data, aes_string(size = input$selectVarInd, alpha = 1, label = "Individual_Info")) +
ggtitle("Individual Data") +
scale_fill_distiller(palette = "Spectral", name = "Tract Data from the US Census Burrow") +
scale_color_continuous(name = "Individuals Served Last Quarter")
ggplotly(plot, tooltip = "label") %>%
layout(height = 800, width = 1200)
}
else if (input$houseORind == "Household") {
plot <- ggplot()+
geom_sf(data = full_pov_census_data, aes_string(fill = input$selectVarTract)) +
geom_sf(data = link2feed_partner_data, aes_string(size = input$selectVar, alpha = 1, label = "Household_Info")) +
ggtitle("Household Data") +
scale_fill_distiller(palette = "Spectral", name = "Tract Data from the US Census Burrow") +
scale_color_continuous(name = "Households Served Last Quarter")
ggplotly(plot, tooltip = "label") %>%
layout(height = 800, width = 1200) %>%
style(hoveron="fills")
}
})
output$SNAPdiffPlot <- renderPlotly({
plot <- ggplot() +
geom_sf(data = SNAPPovDiff, aes(fill = PovSNAPDifference, label = Info)) +
scale_fill_viridis_c(option = "A", name = "Percent Differences") +
ggtitle("Percent Differences between Impoverished and Percent using SNAP")
ggplotly(plot, tooltip = "label") %>%
style(hoveron="fills") %>%
layout(height = 800)
})
output$pounds_plot <- renderPlotly({
pounds_plot <- ggplot() +
geom_sf(data = full_pov_census_data, aes(fill = NumbImpoverished)) +
geom_point(data = pounds_by_prog, aes(x = Longitude, y = Latitude, size = Pounds, alpha = 1, label = Info)) +
ggtitle("Pounds Distributed by SHFB to Partner Programs Q1 2023",
subtitle = "During the First Quarter 2023") +
scale_fill_distiller(palette = "Spectral", name = "Pounds Distributed")
ggplotly(pounds_plot, tooltip = "Info") %>%
style(hoveron = "points")
})
output$la1 <- renderPlotly({
plot <- ggplot() +
geom_sf(data = lowAccessAndTractData, aes_string(fill = input$selectVarLALI)) +
geom_sf(data = link2feed_partner_data, aes_string(size = input$selectVarInd, alpha = 1, label = "Individual_Info")) +
xlab("Longitude") +
ylab("Latitude") +
scale_fill_distiller(palette = "Spectral") +
scale_color_continuous(name = "Individuals Served") + guides(alpha = FALSE) +
theme_minimal() +
theme(legend.position = "none")
ggplotly(plot, tooltip = "label") %>%
layout(title = list(text = paste0('<br>',
'Matching Selected Census Criteria: Red = True, Blue = False, Gray = NA',
'<br>')),
height = 800)
})
output$poundsCountyPlot <- renderPlotly ({
plot <- ggplot() +
geom_sf(data = nc_counties, aes(fill = PoundsDistributed, label = Info)) +
ggtitle("Pounds Distributed to Each County")
ggplotly(plot, tooltip = "label") %>%
style(hoveron="fills")
})
output$value <- renderText({
req(input$addr1, input$addr2)
meters <- gmapsdistance(origin = input$addr1,
destination = input$addr2,
mode = "driving",
key = ("KEY"))$Distance
miles <- meters/1609.34
#return(miles)
paste("Distance: ", round(miles,3), " miles")
})
}
shinyApp(ui, server)
you made mine much better