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



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

应用程序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) 
}

通过更新服务器功能解决了我的错误!谢谢你的建议!

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

最新更新