r - 在 R/Rmarkdown 中同步两个传单 map

Question

JS 传单允许 two maps to be synchronized 。请参阅同步传单 map 示例 here 。

我想在 R 中实现同步传单 map ，特别是在 Rmarkdown/knitr 中实现同步传单 map 。

最好， map 应水平相邻显示(就像 example 中一样)。

这是我想要同步的两个 map 的最小 Rmarkdown (.Rmd) 示例。 该解决方案不必基于 mapview 包。任何解决方案都值得欢迎(-:

---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---

```{r SETUP, include=FALSE}
library("mapview")
library("sp")

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

```{r MAPS}
mapView(meuse, zcol="copper")@map # MAP 1
mapview(meuse, zcol="soil")@map # MAP 2
```

Answer 1

这里有一种同步两个传单 map 的方法，但不幸的是它在 RStudio Viewer 中不起作用。这在 Chrome 和 Firefox 中确实有效。有很多方法可以使其更加稳健。我尝试在下面的 R 代码中添加注释来解释发生的情况。

---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---

```{r SETUP, include=FALSE}
#  get the latest htmlwidgets
#   devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")

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

```{r MAPS}
mapView(meuse, zcol="copper")@map # MAP 1
mapview(meuse, zcol="soil")@map # MAP 2
```

```{r}
#  crudely add the leaflet-sync plugin
#   attachDependency with the rawgit gave me
#   errors so just do this for now
#   could easily add to a package
#   or make a mini package to import this
#   dependency
tags$script(
  type="text/javascript",
  src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)
```

```{r}
# this is one of the new htmlwidgets methods
#  to add some code after all htmlwidgets are rendered
#  this is very useful since we need all htmlwidgets rendered
#  before we can sync
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
  document.querySelectorAll(".leaflet"),
  function(ldiv){
    return HTMLWidgets.find("#" + ldiv.id);
  }
);

// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
```

以下是我们如何用直接的 R 代码完成同样的事情。

#  http://stackoverflow.com/questions/36373842/synchronizing-two-leaflet-maps-in-r-rmarkdown

#  get the latest htmlwidgets
#   devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")

# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")@map # MAP 1
map2 <- mapview(meuse, zcol="soil")@map # MAP 2

tagList(
  tags$head(tags$script(
    type="text/javascript",
    src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
  )),
  map1,
  map2,
  onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
  document.querySelectorAll(".leaflet"),
  function(ldiv){
    return HTMLWidgets.find("#" + ldiv.id);
  }
);

// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
  )
) %>%
  browsable

如果您想要并排使用，这是完成的基本方法。我们可以利用 shiny::fluidPage、fluidRow 和 column 来获取 boostrap，但是 css/js 对于并排放置来说确实很重。

#  get the latest htmlwidgets
#   devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("shiny")
library("mapview")
library("sp")

# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")@map # MAP 1
map2 <- mapview(meuse, zcol="soil")@map # MAP 2

tagList(
  tags$head(tags$script(
    type="text/javascript",
    src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
  )),
  tags$div(style="display:inline;width:50%;float:left;",map1),
  tags$div(style="display:inline;width:50%;float:left;",map2),
  onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
  document.querySelectorAll(".leaflet"),
  function(ldiv){
    return HTMLWidgets.find("#" + ldiv.id);
  }
);

// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
  )
) %>%
  browsable