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)
# })
sanitize.errorsset toFALSEyou may miss errors like uncommon packages that are not installed on the server. You can putoptions(shiny.sanitize.errors=FALSE)in your code and see if you at least get a better message.