闪亮的传单地图功能没有响应

Posted 2023-03-24

【中文标题】闪亮的传单地图功能没有响应

【英文标题】：Shiny Leaflet Map function not responding

【发布时间】：2021-12-30 12:26:44

【问题描述】：

我创建了一个海洋哺乳动物搁浅图，以便在更改日期范围和选择不同物种时做出响应。代码“有效”，但当滑块输入日期范围更改地图上的圆圈没有响应时，地图功能没有正确响应。我会很感激任何建议，因为在搜索和查看了许多其他类似的代码后我不知所措。

App.r

rm(list=ls()) 

#Libraries
library(shiny)
library(base)
library(tidyverse)
library(shinythemes)
library(dplyr)
library(ggmap)
library(maps)
library(mapdata)
library(leaflet)
library(leaflet.extras)
library(glue)
library(DT)
library(lubridate)

wdir=setwd(getwd())

options(shiny.reactlog = TRUE)

source("~/scs-docker/rserver/scripts-habs/HAB_Bulletin/Stranding_Data/Stranding_Data/Map_function.R")

#Read in Stranding Data
Stranding_Data = read_csv("~/scs-docker/rserver/scripts-habs/HAB_Bulletin/Stranding_Data/Stranding_Data/All_Strandings_2019-2021.csv")

#Clean up stranding data 
Stranding_Data2 = Stranding_Data %>%
  drop_na(Strand_Date) %>% #remove lines with no data 
  drop_na(Common_Name) %>% 
  #remove sea birds 
  filter(Common_Name != "Pacific loon",
         Common_Name != "Brandts cormorant",
         Common_Name != "Double-crested cormorant",
         Common_Name != "Western Grebe",
         Common_Name != "Common Loon",
         Common_Name != "Black-Vented Shearwater") %>% 
  select(Program,Strand_Date,Common_Name,Scientific_Name,Age_Class,Sex,Stranding_County,Stranding_City, Latitude,Longitude)

endDate = as.Date(max(Stranding_Data2$Strand_Date))
startDate = endDate - 30
minDate = as.Date(min(Stranding_Data2$Strand_Date))

# Define UI for application
ui <- fluidPage( #fillPage
  theme = shinytheme("cerulean"),
  # Application title
  titlePanel("Suspect Domoic Acid Marine Mammal Strandings", 
             windowTitle = "SCCOOS"),
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      sliderInput(inputId = "Strand_Date",
                  label = "Stranding Date",
                  width = '100%',
                  min = minDate,
                  max = endDate,
                  value = c(startDate, endDate)),  
      # selectInput(
      #   inputId = "Program",
      #   label = "Stranding Center",
      #   choices = list("The Marine Mammal Center" = "TMMC",
      #                  "Channel Islands Marine Wildlife Institute" = "CIMWI",
      #                            "California Wildlife Center" = "CWC",
      #                            "Marine Animal Rescue" = "MAR",
      #                            "Marine Mammal Care Center Los Angeles" = "MMCC-LA",
      #                            "Pacific Marine Mammal Center"= "PMMC",
      #                            "SeaWorld San Diego"= "SeaWorld")),
      selectInput( #selectInput checkboxGroupInput
        inputId = "Common_Name",
        label= "Species",
        choices=sort(unique(Stranding_Data2$Common_Name)),
        multiple = T,
        selected = "California Sea Lion"),
      h6("Disclaimer: These are suspected marine mammal strandings due to domoic acid (DA) toxicosis. Species exposed to DA often result in seizures, epilepsy, cardiomyopathy, and death depending upon the ingested dose. Neuroscopy are required to confirm cases of DA toxicosis.", align = "left")
    ),
    
    # Show a map of the generated distribution and table of data 
    mainPanel(
      tabsetPanel(
        type = "tabs",
        tabPanel("Map", leafletOutput(outputId = "mymap", height = 600)), #height = "1000px", width = "100%" #height=1000
        tabPanel("Table",DT::dataTableOutput("mytable", height = 600))
      )
    )
  )
)

server <- function(input, output, session) 
  
  #create map
  output$mymap <- renderLeaflet(
    #leaflet function to create the basemap 
    Stranding_Map(Stranding_Data2)
  ) 
  
  observe(
    #leafletproxy function for circles 
    Add_Circles(Stranding_Data2, 
                group=input$Common_Name, 
                daterange = input$Strand_Date)
  )
  
  #create table
  output$mytable = DT::renderDataTable(
    
    daterange = input$Strand_Date
    endDate = daterange[2]
    startDate = daterange[1]
    
    Stranding_Data2 %>% 
       filter(Common_Name %in% input$Common_Name,
              Strand_Date>=startDate & Strand_Date<=endDate) 
    
    datatable(Stranding_Data2) 
  )


# Run the application 
shinyApp(ui = ui, server = server)

绞合图函数

Stranding_Map = function(data) 
  
  species_name = c("California Sea Lion", 
                   "Northern Fur Seal",
                   "Guadalupe Fur Seal",
                   "Common Bottlenose Dolphin",
                   "Short-Beaked Common Dolphin",
                   "Striped dolphin",
                   "North Pacific Right Whale",
                   "Gray Whale")
  my_palette = c("#FF0000FF", "#FFBF00FF", "#80FF00FF", "#00FF40FF", "#00FFFFFF", "#0040FFFF", "#8000FFFF", "#FF00BFFF")
  #previewColors(colorFactor(my_palette, levels = species_Name), species_Name)
  factpal = colorFactor(palette=my_palette, domain=species_name)
  
  leaflet() %>%
    addProviderTiles(providers$Esri.OceanBasemap) %>%
    setView(lng = -122, lat = 38, zoom = 5) %>%
    addLegend(
      pal= factpal,
      values = species_name, 
      opacity = 1,
      position = "topright",
      title="Species Name",
      layerId  = "color-legend")


Add_Circles = function(data, group, daterange) 
  
  endDate = daterange[2]
  startDate = daterange[1]
  
  data = data %>% 
    filter(Common_Name %in% group,
           Strand_Date>=startDate & Strand_Date<=endDate)
  
  Common_Name = c("California Sea Lion", "Northern Fur Seal","Guadalupe Fur Seal",
                   "Common Bottlenose Dolphin","Short-Beaked Common Dolphin","Striped dolphin",
                   "North Pacific Right Whale","Gray Whale")
  my_palette = c("#FF0000FF", "#FFBF00FF", "#80FF00FF", "#00FF40FF", "#00FFFFFF", "#0040FFFF", "#8000FFFF", "#FF00BFFF")
  factpal2 = colorFactor(palette=my_palette, levels=Common_Name)
  
  leafletProxy("mymap") %>% 
    addCircleMarkers(data=data,  
                     color= ~factpal2(Common_Name),
                     fillOpacity = 1,
                     weight = 0.5,
                     stroke= 'none',
                     label=paste(
                       data$Strand_Date,",",
                       "Rehab Center:",data$Program,",",
                       data$Common_Name,""),
                       #"County:",data$Stranding_County,",",
                       #"City:",data$Stranding_City,""),
                     popup=paste(
                       "Stranding Date:",data$Strand_Date,"<br>",
                       "Rehab Center:", data$Program,"<br>",
                       "Species:", data$Common_Name,"<br>",
                       "County:", data$Stranding_County,"<br>",
                       "City:", data$Stranding_City,"<br>"),
                     lng=~Longitude, 
                     lat=~Latitude) 

【问题讨论】：

如果可能的话，我很想提供帮助，但我无法运行您拥有的代码，因为我没有您的 csv。您是否可以发布部分数据，或者只是创建一个显示问题的假数据框以便其他人可以测试它？谢谢！

您有Stranding_Data2 %>% filter...，在过滤后没有存储结果...您的意思是Stranding_Data2 <- Stranding_Data2 %>% filter...？

【参考方案1】：

通过更新我的服务器功能解决了我的错误！感谢您的建议！

  server <- function(input, output, session) 
  
  #create map
  output$mymap <- renderLeaflet(
    #leaflet function to create the basemap 
    daterange = input$Strand_Date
    endDate = daterange[2]
    startDate = daterange[1]
    print(startDate)
    print(input$endDate)
    print(input$Common_name)
    x = Stranding_Data2 %>%
      filter(Common_Name %in% input$Common_Name,
              Strand_Date>=startDate & Strand_Date<=endDate)
    Stranding_Map(x)
  ) 
  
  observe(
    #leafletproxy function for circles 
    Add_Circles(Stranding_Data2, 
                group=input$Common_Name, 
                daterange = input$Strand_Date)
  )
  
  #create table
  output$mytable = DT::renderDataTable(
    daterange = input$Strand_Date
    endDate = daterange[2]
    startDate = daterange[1]
    print(startDate)
    print(input$endDate)
    print(input$Common_name)
    x = Stranding_Data2 %>%
      filter(Common_Name %in% input$Common_Name,
             Strand_Date>=startDate & Strand_Date<=endDate)
  )