Search code examples
rleafletplumber

Leafpop Popupgraph doens't work with Plumber - R


if I run my code without plumber function, the popupgraph does work well. but if I run with plumber function, I receive error 404 of web. Any idea how to resolve this? to popupgraph works with plumber api?


library(dplyr)
library(ggplot2)
library(plotly)
library(leaflet)
library(htmltools)
library(leafpop)
library(leafem)
library(plumber)
library(htmlwidgets)

#* Return interactive plot 
#* @serializer htmlwidget
#* @get /map

function(){

  dataset <- data.frame(station = c('CARATORIA', 'CENTRO', 'FONTE GRANDE', 'ILHA DO PRINCIPE',
                                    'MOSCOSO', 'PIEDADE', 'SANTA CLARA', 'VILA RUBIM'),
                        lon = c(-40.35804, -40.34229, -40.33978, -40.35260, -40.34895,
                                -40.34157, -40.34717, -40.34976),
                        lat = c(-20.31472, -20.32030, -20.31325, -20.32188, -20.31468,
                                -20.31404, -20.31850, -20.31958),
                        value_no2 = c(23.93333, 123.06250, 40.00000, 10.93750, 46.38462,
                                      36.66667, 27.69231, 56.00000),
                        value_pm10 = c(10.238095, NaN, 13.842105, 9.318182, 17.842105,
                                       NaN, 9.000000, 15.333333))
                        
                         
   my_list <- list()  
   loop<-for (i in unique(dataset$station)) {
       name <- dataset %>% filter(station == i)
       plot <- ggplot(name, aes(x = value_no2, y = station)) + 
          geom_col()+labs(title = i)
       my_list[[i]] <- plot
    }
                        
                        
    my_list2 <- list()  
    loop<-for (i in unique(dataset$station)) {
       name <- dataset %>% filter(station == i)
        plot <- ggplot(name, aes(x = value_pm10, y = station)) + 
           geom_col()+labs(title = i)
        my_list2[[i]] <- plot
    }
                        
    list_comb <- list()
    list_comb[[1]] <- my_list
    list_comb[[2]] <- my_list2
                        
    test <- list()
    grafico_correto <- for (i in 1:max(length(my_list),length(my_list2))){
       test[[i]] <- subplot(do.call( rbind, list_comb)[,i], nrows = 2)
    }
          
    leaflet() %>%
       addTiles() %>%
       addCircleMarkers(data = dataset, ~lon,~lat, popup = popupGraph(test, type = "html"))
                        
}

Without Plumber function:

Without Plumber function: Popup does work

With Plumber function:

With Plumber function: Popup error 404


Solution

  • Plumber does not know how to route /popup_graphs/<tmp_file>. This particular plot reference other objects using an iframe. I added an endpoint to tell plumber how to route these requests.

    Edit : I looked at the source code for popupGraph and you can just mount a static assets path to precomputed popup so it is as fast as it can be.

    library(dplyr)
    library(ggplot2)
    library(plotly)
    library(leaflet)
    library(htmltools)
    library(leafpop)
    library(leafem)
    library(plumber)
    library(htmlwidgets)
    
    dataset <- data.frame(station = c('CARATORIA', 'CENTRO', 'FONTE GRANDE', 'ILHA DO PRINCIPE',
                                      'MOSCOSO', 'PIEDADE', 'SANTA CLARA', 'VILA RUBIM'),
                          lon = c(-40.35804, -40.34229, -40.33978, -40.35260, -40.34895,
                                  -40.34157, -40.34717, -40.34976),
                          lat = c(-20.31472, -20.32030, -20.31325, -20.32188, -20.31468,
                                  -20.31404, -20.31850, -20.31958),
                          value_no2 = c(23.93333, 123.06250, 40.00000, 10.93750, 46.38462,
                                        36.66667, 27.69231, 56.00000),
                          value_pm10 = c(10.238095, NaN, 13.842105, 9.318182, 17.842105,
                                         NaN, 9.000000, 15.333333))
    
    
    my_list <- list()
    loop<-for (i in unique(dataset$station)) {
      name <- dataset %>% filter(station == i)
      plot <- ggplot(name, aes(x = value_no2, y = station)) +
        geom_col()+labs(title = i)
      my_list[[i]] <- plot
    }
    
    
    my_list2 <- list()
    loop<-for (i in unique(dataset$station)) {
      name <- dataset %>% filter(station == i)
      plot <- ggplot(name, aes(x = value_pm10, y = station)) +
        geom_col()+labs(title = i)
      my_list2[[i]] <- plot
    }
    
    list_comb <- list()
    list_comb[[1]] <- my_list
    list_comb[[2]] <- my_list2
    
    test <- list()
    grafico_correto <- for (i in 1:max(length(my_list),length(my_list2))){
      test[[i]] <- subplot(do.call( rbind, list_comb)[,i], nrows = 2)
    }
    
    p <- leaflet() %>%
      addTiles() %>%
      addCircleMarkers(data = dataset, ~lon,~lat, popup = popupGraph(test, type = "html"))
    
    #* Return interactive plot
    #* @serializer htmlwidget
    #* @get /map
    function(){
      p
    }
    
    #* @plumber
    function(pr) {
      pr_static(pr, "/popup_graphs", file.path(tempdir(), "popup_graphs"))
    }