简体   繁体   中英

Shiny app doesn't work on shinyapps.io, but works in rstudio

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM