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

Question

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

BarChart代码（也许这是一个问题因为我使用的是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

也许有点晚，但这是一个解决方案。 addPopups()中的library(leaflet)函数似乎能够处理.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：嵌入网格， ggplot2 或基于交互式 hatmlwidgets 的图表。
• popupImage：嵌入本地或远程（网络）图片

目前仅适用于 mapview 的开发版本，可以安装：

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

这是输出。