我有一个使用 Leadflet.extras::addHeatmap 的功能闪亮应用程序,但是当我尝试添加 leafletProxy 来帮助性能时,它会使应用程序崩溃并抛出错误 - 警告:调度错误:无效的地图参数 [没有可用的堆栈跟踪]
我也尝试过使用observeEvent
#packages
require(shinyWidgets)
require(shiny)
require(tidyverse)
require(httr)
require(sf)
require(rgdal)
require(leaflet)
require(leaflet.extras)
require(maps)
#datasets
accleddata <- structure(list(event_date = structure(c(18098, 18098, 18098,
18098, 18098, 18098), class = "Date"), latitude = c(32.3754,
32.9243, 30.912, 30.2108, 32.4104, 35.6911), longitude = c(15.0925,
75.1357, 75.8537, 74.9452, 61.4593, -0.6417), fatalities = c(0,
0, 0, 0, 0, 0)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
langs <- structure(list(Tweet.date = structure(c(1558224000, 1558224000,
1558224000, 1558224000, 1558828800, 1558828800), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), Language = structure(c(4L, 4L, 3L,
4L, 3L, 4L), .Label = c("#meta +lang", "ar", "en", "fr"), class = "factor"),
Relevant.tweets = structure(c(78L, 49L, 6L, 104L, 101L, 41L
), .Label = c("#indicator +num +tweets", "1", "101", "103",
"105", "1076", "1077", "10827", "10949", "116", "11853",
"12164", "12179", "12671", "13", "134", "137", "14283", "14617",
"15", "150", "15198", "15255", "15849", "160", "1604", "16286",
"16899", "170", "172", "17406", "178", "182", "18557", "196",
"2", "20", "204", "206", "20887", "21", "22", "23", "230",
"231", "2360", "24", "2428", "243", "25063", "25400", "2723",
"28", "28955", "29", "3", "30", "31", "31706", "3302", "33258",
"3378", "344", "3669", "37", "38", "3815", "388", "39", "4",
"4005", "403", "41", "415", "418", "4238", "426", "43", "4431",
"4464", "4466", "4473", "4476", "45", "46", "4712", "474",
"4868", "4913", "5", "50147", "5074", "5096", "52", "540",
"54798", "55", "55905", "561", "57", "5984", "5999", "6",
"60", "6091", "6137", "6192", "6289", "6323", "6393", "6687",
"676", "7", "70", "7058", "72", "7233", "7284", "7359", "76",
"7606", "7662", "7680", "7708", "78", "79", "7900", "7976",
"7983", "8", "8020", "803", "8102", "88", "8935", "9", "92",
"935", "95", "96", "9680", "98", "988"), class = "factor"),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "1", class = "factor")), row.names = c(NA,
6L), class = "data.frame")
#app
ui <- fluidPage(
titlePanel("Attacks Against Education - Data from AIDR and ACCLED"),
sidebarLayout(
sidebarPanel(top = 10, right = 5,
sliderInput("daterange", "Select Week Starting",
as.Date(min(accleddata$event_date)),
as.Date(max(accleddata$event_date)),
value = min(accleddata$event_date),
step = 7,
animate = animationOptions(interval = 1000, loop = TRUE)
)
),
mainPanel(
leafletOutput("myheatmap"),
br(), br(),
plotOutput("plot"))
)
)
# server
server <- function(input, output) {
##reactive statements
reactive_data_chrono <- reactive({
accleddata %>%
filter(event_date == input$daterange[1])
})
reactive_plot_data <- reactive({
langs %>%
filter(Tweet.date == input$daterange[1])
})
#leaflet render
output$myheatmap <- renderLeaflet({
leaflet(height = 600) %>%
addProviderTiles(provider = "OpenStreetMap.HOT") %>%
addHeatmap(data = accleddata, radius = 15, blur = 25)
})
######the observe statement that messing up everything:
observe(leafletProxy("myheatmap", data = reactive_data_chrono() %>%
clearHeatmap() %>%
addHeatmap(map = myheatmap, radius = 15, blur = 25)) %>%
fitBounds(fitBounds(lng1 = ~min(longitude), lat1 = ~min(latitude),
lng2 = ~max(latitude), lat2 = ~max(latitude)))
)
#mybarplot
output$plot <- renderPlot({
ggplot(reactive_plot_data(), aes(group, fill = Language)) +
geom_bar(position = "fill", width = 0.2) +
scale_fill_manual(values = c('#053C5E', '#25A18E', '#388697', '#388374'),
labels = c('Arabic', 'English', 'French')
) +
labs(title = '% Breakdown of Tweet language', x = 'Language Breakdown', y = "") +
coord_flip() +
theme(
plot.background = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.title = element_text(family = 'Gotham', size = 18, hjust = 0.5, vjust = -5),
legend.title = element_blank(),
legend.position = "bottom",
legend.spacing.x = unit(0.2, 'cm'),
#axis.title.x = element_blank(),
axis.text.x = element_text(size = 16, family = 'Gotham')
) + guides(fill = guide_legend(reverse = TRUE))
}, height = 200)
}
# Run it
shinyApp(ui = ui, server = server)
错误 - 警告:调度错误:无效的映射参数 [没有可用的堆栈跟踪]
请编辑您的评论如下:
observe({
req(input$myheatmap)
leafletProxy("myheatmap", data = reactive_data_chrono() %>%
clearHeatmap() %>%
addHeatmap(map = myheatmap, radius = 15, blur = 25)) %>%
fitBounds(fitBounds(lng1 = ~min(longitude), lat1 = ~min(latitude),
lng2 = ~max(latitude), lat2 = ~max(latitude)))
})
基本上,
leafletProxy()
在创建之前就在寻找"myheatmap"
,因此出现了req()
。