sammo3182 / drhutools

Commonly used functions and files for social science research
Other
1 stars 2 forks source link

Chinese map function #5

Open sammo3182 opened 2 months ago

sammo3182 commented 2 months ago

Create a function to draw dots or polygons in a Chinese map.

  1. Functionalize the following codes
  2. Enable drawing points and polygons in the map
  3. Enable drawing maps for different levels of unit (city, province)

e.g.,

goodChinaMap(data = XXXX, unit = c("city", "province"), shape = c("points", "polygons"), saveDir = "XXX", ...)

Reference code

p_load(
  leaflet,
  leafletCN,
  htmlwidgets,
  webshot2, 
  regioncode
)

# background ---------------------------------------------------------------------

plot_prov <- data.frame( # has to be a data.frame rather than tibble or other classes
  name = regionNames("china")
)

plot_prov <- cgss1021 |> 
  filter(year == 2010) |> 
  select(prov, mandarinSpeak, mandarinListen) |> 
  group_by(prov) |> 
  summarise(value_speak = mean(mandarinSpeak, na.rm = TRUE),
         value_listen = mean(mandarinListen, na.rm = TRUE)) |> 
  ungroup() |> 
  right_join(plot_prov, by = c("prov" = "name"))

plot_prov_speak <- select(plot_prov, prov, value_speak) |> 
  rename(value = value_speak) |> 
  as.data.frame()
plot_prov_listen <- select(plot_prov, prov, value_listen) |> 
  rename(value = value_listen) |> 
  as.data.frame()

# 还有很多其他参数设置,类似 leaflet::leaflet
plot_speak <- geojsonMap(plot_prov_speak, 
           mapName = "china", 
           palette = gb_pal(palette = "main", reverse = TRUE)(2), 
           colorMethod = "bin", 
           legendTitle = "Speaking")

plot_listen <- geojsonMap(plot_prov_listen, 
           mapName = "china", 
           palette = gb_pal(palette = "main", reverse = TRUE)(2), 
           colorMethod = "bin", 
           legendTitle = "Listening")

ls_map <- list(speak = plot_prov_speak, listen = plot_prov_listen) |> 
  map2(c("Speaking", "Listening"),
    \(data, name){
      geojsonMap(data, 
           mapName = "china", 
           palette = gb_pal(palette = "main", reverse = TRUE)(2), 
           colorMethod = "numeric", 
           legendTitle = name,
           domain = range(c(plot_prov_speak$value, plot_prov_listen$value), na.rm = TRUE))
    }
  )

walk2(ls_map, c("speak", "listen"), \(plot, suffix) {
  html_plot <- tempfile(fileext = ".html") # save the html to a temporary file

  saveWidget(plot, html_plot, selfcontained = FALSE)

  name_file <- paste0("map_", suffix, ".png")

  webshot(
    html_plot,
    vheight = 900,
    # high enough to show Indonesia
    expand = c(-170, 0, 0, -100),
    # truncate the unnecessary neighbor countries
    file = here("output", name_file)
  )
})
WaitingJoyce commented 1 month ago

[Uploading goodchinesemap_0.1.0.tar.gz…]()