Leafpop Popupgraph doens't work with Plumber - R

[vinicius.bodart]

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()
    graph <- 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"))
                        
}

it's OK if I run withou plumber function.

but, with plumber function I receive error 404 in popup on web

[meztez]

Reposted from stackoverflow

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

[vinicius.bodart]

YEP. is perfect. thank you so much again