我无法使用Leaflet包让弹出窗口在我的Shiny应用程序中工作。该应用程序也使用shinydashboard包。我基本上复制了SuperZip示例中的代码。该示例在本地工作正常,但不在我的应用程序中。在我的server.R
文件下方。
有什么可能导致问题的线索?
谢谢!
library(shiny)
library(leaflet)
function(input, output, session) {
mapp <- createLeafletMap(session, "map")
# Filter the dataset
visit_data_f <- reactive({
s <- as.POSIXct(input$period[1], format = "%Y-%m-%d")
e <- as.POSIXct(input$period[2], format = "%Y-%m-%d")
hour(s) <- 23; minute(s) <- 59; second(s) <- 59;
hour(e) <- 23; minute(e) <- 59; second(e) <- 59;
d <- filter(visit_data, started_on >= s, started_on <= e)
if (input$district != "Tous") {
d <- filter(d, district == input$district)
}
d
})
geo_data <- reactive({
data <- visit_data_f()
data$site_code <- factor(data$site_code)
# Sync lag
d <- data.frame(sync_lag(data, "site_code"))
d <- cbind(rownames(d), d)
colnames(d) <- c("site_code", "sync_lag")
d <- mutate(d, sync_lag = round(as.numeric(sync_lag), 2))
d <- arrange(d, site_code)
# Consults
consults <- data.frame(table(data$site_code))
colnames(consults) <- c("site_code", "n_consults")
consults <- arrange(consults, site_code)
d <- mutate(d, n_consults = consults$n_consults)
# Coordinates
d <- merge(d, locations_data, by.x = "site_code", by.y = "site_code")
d <- filter(d, !is.na(latitude))
d$id <- seq(1:nrow(d))
d
})
session$onFlushed(once = TRUE, function() {
paintObs <- observe({
data <- geo_data()
mapp$clearShapes()
mapp$clearMarkers()
if (input$geo_data == "position") {
mapp$addMarker(data$latitude, data$longitude)
} else if (input$geo_data == "n_consults") {
radius <- data$n_consults
mapp$addCircle(data$latitude, data$longitude, radius * 5, data$id, list(stroke = F, fill = T, fillOpacity = 0.4))
} else {
radius <- data$sync_lag
mapp$addCircle(data$latitude, data$longitude, radius * 150, data$id, list(stroke = F, fill = T, fillOpacity = 0.4))
}
})
session$onSessionEnded(paintObs$suspend)
})
showInfoPopup <- function(id, lat, lng) {
content <- paste("CSPS :", id)
mapp$showPopup(lat, lng, content, id)
}
clickObs <- observe({
mapp$clearPopups()
event <- input$mapp_shape_click
if (is.null(event)) {
print("-- NULL")
return()
}
isolate({
showInfoPopup(event$id, event$lat, event$lng)
})
})
session$onSessionEnded(clickObs$suspend)
}