閃亮的應用程序無法在Shinyapps.io上運行，但可以在rstudio中使用

Question

該應用程序當前托管在以下閃亮應用程序上： https ://njed.shinyapps.io/race_seg_gap_map/

沒有錯誤消息（我檢查了Shinyapp日志），內存使用率未超過100mb。

單擊復選框時，點不會顯示，地圖也不會更新。

這一切在rstudio中都可以正常工作。

這是閃亮的應用程序代碼：

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)
# })

Answer 1

在第一個observeEvent()添加req(selected.school()$lat) observeEvent()解決了該問題。

通過查看Chrome控制台中的錯誤（顯示有關NULL值的錯誤），我能夠進行故障排除。

該錯誤僅在托管后才浮出水面，我認為是因為處理時間不同-在我的本地計算機上，數據生成速度更快（或順序不同），因此需要經緯度的功能始終具有數據。 使用req可以確保在產生selected.school df之前，觀察功能不會運行。

我不知道Shiny / rstudio是否具有更人性化的調試/方式來查看此類錯誤。