library(tidyverse)
library(sf)
library(leaflet)
library(mapview)sessionInfo()## R version 4.1.2 (2021-11-01)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19043)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Japanese_Japan.932 LC_CTYPE=Japanese_Japan.932
## [3] LC_MONETARY=Japanese_Japan.932 LC_NUMERIC=C
## [5] LC_TIME=Japanese_Japan.932
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] mapview_2.10.0 leaflet_2.0.4.1 sf_1.0-4 forcats_0.5.1
## [5] stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4 readr_2.1.0
## [9] tidyr_1.1.4 tibble_3.1.6 ggplot2_3.3.5 tidyverse_1.3.1
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.2 sass_0.4.0 jsonlite_1.7.2 modelr_0.1.8
## [5] bslib_0.3.1 assertthat_0.2.1 stats4_4.1.2 sp_1.4-6
## [9] cellranger_1.1.0 yaml_2.2.1 pillar_1.6.4 backports_1.3.0
## [13] lattice_0.20-45 glue_1.5.0 digest_0.6.28 rvest_1.0.2
## [17] colorspace_2.0-2 htmltools_0.5.2 pkgconfig_2.0.3 broom_0.7.10
## [21] raster_3.5-2 haven_2.4.3 webshot_0.5.2 scales_1.1.1
## [25] satellite_1.0.4 terra_1.4-20 tzdb_0.2.0 proxy_0.4-26
## [29] generics_0.1.1 ellipsis_0.3.2 withr_2.4.2 cli_3.1.0
## [33] magrittr_2.0.1 crayon_1.4.2 readxl_1.3.1 evaluate_0.14
## [37] fs_1.5.0 fansi_0.5.0 xml2_1.3.2 class_7.3-19
## [41] tools_4.1.2 hms_1.1.1 lifecycle_1.0.1 munsell_0.5.0
## [45] reprex_2.0.1 compiler_4.1.2 jquerylib_0.1.4 e1071_1.7-9
## [49] rlang_0.4.12 classInt_0.4-3 units_0.7-2 grid_4.1.2
## [53] rstudioapi_0.13 htmlwidgets_1.5.4 crosstalk_1.2.0 leafem_0.1.6
## [57] base64enc_0.1-3 rmarkdown_2.11 gtable_0.3.0 codetools_0.2-18
## [61] DBI_1.1.1 R6_2.5.1 lubridate_1.8.0 knitr_1.36
## [65] fastmap_1.1.0 utf8_1.2.2 KernSmooth_2.23-20 stringi_1.7.5
## [69] Rcpp_1.0.7 vctrs_0.3.8 png_0.1-7 dbplyr_2.1.1
## [73] tidyselect_1.1.1 xfun_0.28Sys.time()## [1] "2022-01-20 22:02:00 JST"ここでは適当な建物データ（100個）をつかう
data <- read_sf("sample-bldgs.gml") %>%
st_set_crs(6668)
head(data)## Simple feature collection with 6 features and 10 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: 141.3199 ymin: 43 xmax: 141.3716 ymax: 43.07363
## Geodetic CRS: JGD2011
## # A tibble: 6 x 11
## fid gml_id lfSpanFr lfSpanTo devDate orgGILvl orgMDId vis type name
## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 堅ろ~ <NA>
## 2 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 堅ろ~ <NA>
## 3 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 普通~ <NA>
## 4 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 堅ろ~ <NA>
## 5 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 普通~ <NA>
## 6 2021090~ K17_508~ 2021-09~ <NA> 2021-0~ 2500 <NA> <NA> 堅ろ~ <NA>
## # ... with 1 more variable: geometryProperty <POLYGON [arc_degree]>data_ext_list <- data[1:100,] %>%
st_transform(4326) %>%
dplyr::select() %>%
dplyr::mutate(group = rep(1:10,10)) %>%
split(.$group)
str(data_ext_list,1)## List of 10
## $ 1 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 2 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 3 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 4 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 5 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 6 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 7 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 8 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 9 : sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"
## $ 10: sf [10 x 2] (S3: sf/tbl_df/tbl/data.frame)
## ..- attr(*, "sf_column")= chr "geometryProperty"
## ..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA
## .. ..- attr(*, "names")= chr "group"まとめてleafletオブジェクトにしておく
map_list <-
purrr::map(
data_ext_list,
~leaflet(.x) %>%
addTiles() %>%
addPolygons()
)map_list[[1]]files_path <-paste0("map", as.character(1:10), ".png")
files_path## [1] "map1.png" "map2.png" "map3.png" "map4.png" "map5.png" "map6.png"
## [7] "map7.png" "map8.png" "map9.png" "map10.png"webshot::install_phantomjs()を予め実行しておく必要がある。
purrr::map2(
map_list, files_path,
~mapview::mapshot(.x, file = .y, vwidth = 640, vheight = 480,
remove_controls = c("zoomControl", "layersControl", "homeButton"))
)