Leafpop Popupgraph不适用于Plumber -R

Question

如果我不使用管道工函数来运行代码，那么popupgraph确实工作得很好。但是如果我使用plumber函数运行，我收到web的错误404。你知道怎么解决这个问题吗？要使用管道工api的popupgraph作品？

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: Popup does work

使用管道工功能：

With Plumber function: Popup error 404

Answer 1

管道工不知道如何布线/popup_graphs/<tmp_file>。此特定绘图使用iframe引用其他对象。我添加了一个端点来告诉plumber如何路由这些请求。

编辑:我查看了popupGraph的源代码，您可以将静态资源路径挂载到预计算弹出窗口，这样它就会尽可能快。

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