观察(leafletProxy导致Shinyapp崩溃

时间:2019-08-20 09:50:50

标签: r shiny leaflet

我有一个使用Leadflet.extras :: addHeatmap的运行正常的Shiny应用程序,但是,当我尝试添加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)

错误-警告:发送错误:无效的地图参数[无可用的堆栈跟踪]

1 个答案:

答案 0 :(得分:1)

请如下修改观察值:

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