The app is currently hosted on shinyapps here: https://njed.shinyapps.io/race_seg_gap_map/
There is no error message (I checked shinyapp logs) and memory usage doesn't go above 100mb.
The points don't display and the map doesn't update when clicking the checkboxes.
This all works fine in rstudio.
Here's the shiny app code:
library(shiny)
library(leaflet)
library(dplyr)
library(leaflet.extras)
load('shiny_app_seg_gap.RData')
tags$head(tags$link(rel="shortcut icon", href="/www/noun_equals_133889.png"))
tags$style(type = "text/css", "html, body {width:100%;height:100%}")
ui <- shinyUI(navbarPage("NJ Residential Racial Segregation & Student-Teacher Gaps",
theme = "bootstrap.css",
tabPanel("Map",
div(class="outer",
leafletOutput("map", width = "100%", height = "100%"), #
absolutePanel(id = "controls", class = "panel panel-default",
style="opacity: 1",
fixed = TRUE,
draggable = TRUE, top = "10%", left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto", cursor = "move",
br(),
htmlOutput("district_selector"), #add selectinput boxs
htmlOutput("school_selector"),
actionButton("clear", "Clear School Markers"),
checkboxInput("togglelatinx", tags$span("Latinx", style = "color: #11FF04;font-size: 15pt"), value = TRUE),
checkboxInput("togglewhite", tags$span("White", style = "color: #F40000;font-size: 15pt"), value = TRUE),
checkboxInput("toggleblack", tags$span("Black", style = "color: #0456FF;font-size: 15pt"), value = TRUE),
h4("1 Dot = 750 People"),
br(),
h4("Click on school markers for more info")
)
)
),
tabPanel("About",
fluidRow(
column(12,
wellPanel(
includeMarkdown("about.md"))
)
)
)
))
server <- shinyServer(function(input, output, session) {
# icon.ion <- makeAwesomeIcon(icon = 'apple',
# library='glyphicon')
# greenLeafIcon <- makeIcon(
# iconUrl = "http://leafletjs.com/examples/custom-icons/leaf-green.png",
# iconWidth = 38, iconHeight = 95,
# iconAnchorX = 22, iconAnchorY = 94,
# shadowUrl = "http://leafletjs.com/examples/custom-icons/leaf-shadow.png",
# shadowWidth = 50, shadowHeight = 64,
# shadowAnchorX = 4, shadowAnchorY = 62
# )
observeEvent(input$clear, {
proxy <- leafletProxy('map')
proxy %>%
clearGroup(group = schools$school_name)
})
output$district_selector = renderUI({ #creates District select box object called in ui
selectInput(inputId = "district", #name of input
label = "District:", #label displayed in ui
choices = unique.districts,
selected = "Newark City")
})
output$school_selector = renderUI({#creates County select box object called in ui
data_available = schools[schools$district_name == input$district, "school_name"]
#creates a reactive list of available counties based on the State selection made
selectInput(inputId = "school", #name of input
label = "School:", #label displayed in ui
choices = unique(data_available), #calls list of available counties
selected = "Ann Street School")
})
# weight.adjust <- reactive({
#
# # req(input$map_zoom)
#
# if(!is.null(input$map_zoom)) new_zoom <- input$map_zoom
#
# if (new_zoom < 7) {
# .1
# } else if (new_zoom >= 7 & new_zoom < 10){
# 1
# } else if (new_zoom >= 10){
# 3
# }
#
# })
selected.school <- reactive({
if (!is.null(input$school)){
schools[schools$school_name == input$school,]
}
})
output$map <- renderLeaflet({
leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
addMapPane(name = "underdots", zIndex = 410) %>%
addMapPane(name = "maplabels", zIndex = 420) %>% # higher zIndex rendered on topaddProviderTiles("CartoDB.PositronNoLabels", options = tileOptions(minZoom = 7, maxZoom = 13)) %>%
addProviderTiles("CartoDB.PositronNoLabels",
options = providerTileOptions(
updateWhenZooming = FALSE, # map won't update tiles until zoom is done
updateWhenIdle = TRUE ) # map won't load new tiles when panning
) %>%
addProviderTiles("CartoDB.PositronOnlyLabels",
options = leafletOptions(pane = "maplabels")) %>%
setView(schools[schools$school_name == "Ann Street School",]$lng + 0.02, schools[schools$school_name == "Ann Street School",]$lat, zoom = 13)
# addMiniMap(position = "bottomright", zoomLevelOffset = -5, tiles = "CartoDB")
})
observeEvent(input$school, {
proxy <- leafletProxy('map')
proxy %>%
# clearGroup(group = schools$school_name) %>%
addAwesomeMarkers(data = selected.school(),
icon = icon.ion,
lat = ~lat, lng = ~lng,
# icon=greenLeafIcon,
# weight= 15, fillOpacity = 1, stroke = FALSE,
group = selected.school()$school_name,
# color="black",#pal(td2$LifeExpectencyValue),
# labelOptions = labelOptions(noHide = T),
popup = paste0("<u>", selected.school()$school_name,"</u>", "<br>",
"Black Students: ", selected.school()$Percent_Black_Students,"%", "<br>",
"Black Teachers: ", selected.school()$Percent_Black_Teachers,"%", "<br>",
"Latinx Students: ", selected.school()$Percent_Latinx_Students,"%", "<br>",
"Latinx Teachers: ", selected.school()$Percent_Latinx_Teachers,"%", "<br>",
"White Students: ", selected.school()$Percent_White_Students,"%", "<br>",
"White Teachers: ", selected.school()$Percent_White_Teachers,"%"
)) %>%
setView(selected.school()$lng + 0.02, selected.school()$lat, zoom = 13)
})
observeEvent(input$togglewhite , { #| weight.adjust()
proxy <- leafletProxy('map') #Always clear the race first on the observed event
proxy %>% clearGroup(group = "White") #If checked
if (input$togglewhite){
race.dots.all <- filter(race.dots.all, group == "White") #Filter for the specific group
proxy %>% addCircles(group = race.dots.all$group, #Add the specific group's markers
race.dots.all$lng,
race.dots.all$lat,
weight=4.5,
fill = TRUE,
color = '#F40000',
fillOpacity = 0.5
)
}
})
#Repeat for the other groups
observeEvent(input$toggleblack, {
proxy <- leafletProxy('map')
proxy %>% clearGroup(group = "Black")
if (input$toggleblack){
race.dots.all <- filter(race.dots.all, group == "Black")
proxy %>% addCircles(group = race.dots.all$group,
race.dots.all$lng,
race.dots.all$lat,
weight=4.5,
fill = TRUE,
color = '#0456FF',
fillOpacity = 0.5
)
}
})
observeEvent(input$togglelatinx, {
proxy <- leafletProxy('map')
proxy %>% clearGroup(group = "Latinx")
if (input$togglelatinx){
race.dots.all <- filter(race.dots.all, group == "Latinx")
proxy %>% addCircles(group = race.dots.all$group,
race.dots.all$lng,
race.dots.all$lat,
weight=4.5,
fill = TRUE,
color = '#11FF04',
fillOpacity = 0.5
)
}
})
})
shinyApp(ui, server)
#
# library(profvis)
# app <-
# profvis({
#
# runApp(app)
# })
Adding req(selected.school()$lat)
within the first observeEvent()
solved the issue.
I was able to troubleshoot by looking at the errors in Chrome's console, which showed an error about a NULL value.
The error only reared its ugly head when hosted, I think because of a difference in processing time -- on my local machine, the data was generated faster (or in a different order) and so the function requiring the lat/lng always had the data. Using the req
ensures that the observe function doesn't run until the selected.school df has been produced.
I wonder whether shiny/rstudio has more user-friendly debugging/ways to see this kind of error.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.