使用传单库在弹出窗口中绘制条形图

Question

快速提问。 我在 sql server 中有一些数据已加载到 RStudio 中。我已经为数据制作了一个条形图，现在我正在使用传单库并使用纬度和经度在地图上绘制一个点。当用户单击该点时，我希望能够使用弹出窗口在其中显示条形图。

条形图代码（可能这是一个问题，因为我正在使用 googleVis 库，所以不确定我是否可以在弹出窗口中使用它。但这是我可以制作和需要的最合适的条形图 - 其他建议可能会有所帮助我还不是 R 库的专业人士）

Switzerland <- sqlQuery(con, "sql query")
SwitzerlandChart <- gvisBarChart(Switzerland, options = list(height=200))

对于图表的代码是：

m <- leaflet() %>%
  addTiles() %>%  # Add default OpenStreetMap map tiles
  addCircles(lng=8.498868, lat=46.9221, popup=paste(plot(SwitzerlandChart)))

当我运行此代码时，它会打开一个网页来查看我的条形图。 然后我运行以下命令：

m #Prints the graph

这会在所需位置打印带有点的图形，但弹出窗口会显示一个网页，而不是只有我可以打开。

我希望能够在弹出窗口中绘制条形图。

希望有人能帮忙

Answer 1

可能有点晚了，但这里有一个解决方案。 library(leaflet) 中的 addPopups() 函数似乎能够处理 .svg 文件。因此，您可以简单地使用svg() 保存您的绘图，然后使用readLines() 再次读取它。这是一个使用 library(mapview) 的可重现示例：

library(lattice)
library(mapview)
library(sp)

data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")

clr <- rep("grey", length(meuse))

fldr <- tempfile()
dir.create(fldr)

pop <- lapply(seq(length(meuse)), function(i) {

  clr[i] <- "red"
  p <- xyplot(meuse$cadmium ~ meuse$copper, 
              col = clr, pch = 20, alpha = 0.7)

  svg(filename = paste(fldr, "test.svg", sep = "/"), 
      width = 250 * 0.01334, height = 250 * 0.01334)
  print(p)
  dev.off()

  tst <- paste(readLines(paste(fldr, "test.svg", sep = "/")), collapse = "")

  return(tst)

})

mapview(meuse, popup = pop, cex = "cadmium")

您会看到每个弹出窗口都是一个散点图。至于leaflet 的例子，请考虑：

content <- pop[[1]]
leaflet() %>% addTiles() %>%
  addPopups(-122.327298, 47.597131, content,
            options = popupOptions(closeButton = FALSE)
  )

如果您需要交互式绘图，您可以查看library(gridSVG)，它能够生成交互式 svg 绘图，例如lattice 或 ggplot2 地块。

更新：

library(mapview) 现在为此指定了功能：

• popupGraph：嵌入 lattice、ggplot2 或基于交互式 hatmlwidgets 的绘图。
• popupImage：嵌入本地或远程（网络）图像

这目前仅在 ma​​pview 的开发版本中可用，可以安装：

devtools::install_github("environmentalinformatics-marburg/mapview", ref = "develop"

Answer 2

这可能也有点晚了，但这里有一个完整的传单实现。我首先创建了绘图，然后使用 popupGraph 函数将其添加进去。

# make a plot of the two columns in the dataset
p <- xyplot(Home ~ Auto, data = Jun, col = "orange", pch = 20, cex = 2)

# make one for each data point
p <- mget(rep("p", length(Jun)))

# color code it so that the corresponding points are dark green
clr <- rep("orange", length(Jun))
p <- lapply(1:length(p), function(i) {
  clr[i] <- "dark green"
  update(p[[i]], col = clr)
})


# now make the leaflet map
m1 <- leaflet() %>%
  addTiles() %>%
  setView(lng = -72, lat = 41, zoom = 8) %>%


  # add the markers for the Jun dataset
  # use the popupGraph function
  addCircleMarkers(data = Jun, lat = ~Lat, lng = ~Lon,
                   color = ~beatCol(BeatHomeLvl), popup = popupGraph(p),
                   radius = ~sqrt(BeatHome*50), group = 'Home - Jun') %>%


  # layer control
  addLayersControl(
    overlayGroups = c('Home - Jun'
    ),
    options = layersControlOptions(collapsed = F)
  ) %>%



  # legend for compare to average

  addLegend('bottomright', pal = beatCol, values = last$BeatTotalLvl,
            title = 'Compare<br>Quote Count to<br>3Mos State Avg',
            opacity = 1)

m1

这是输出。