4 Работа с картами пакет leaflet

4.1 Визуализация с leaflet

Для начала включим библиотеку:

library("tidyverse")
library("leaflet")

и скачаем датасет:

df <- read_csv("https://tinyurl.com/yzfgony9")

Мы можем нарисовать точки, полученные из кладбища

• в Стародубе:

df %>% 
  filter(place == "Стародуб") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code)

• в Бешенковичах:

df %>% 
  filter(place == "Бешенковичи") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code)

Используя предыдущий код постройте карту кладбища в Рашкове.

4.2 Раскраска на основании переменной

Мы можем раскрасить наши точки на основании гендерной пренадлежности усопшего:

pal_gender <- colorFactor("Set1", domain = df$gender)
df %>% 
  filter(place == "Стародуб") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code,
             color  = ~pal_gender(gender)) %>% 
  addLegend(pal = pal_gender,
            values = ~gender,
            title = "")

Зеленых точек n достаточно много, можно попробовать их убрать:

df %>% 
  filter(place == "Стародуб",
         gender != "n") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code,
             color  = ~pal_gender(gender)) %>% 
  addLegend(pal = pal_gender,
            values = ~gender,
            title = "")

Попробуем нарисовать кладбище в Бешенковичах и посмотрим, где расположены надгробия с тегами роженица:

df %>% 
  mutate(labour = str_detect(tags, "роды"),
         labour = ifelse(is.na(labour), FALSE, labour)) ->
  df

pal_labour <- colorFactor("Set1", domain = c(TRUE, FALSE), ordered = TRUE)

df %>%   
  filter(place == "Бешенковичи") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code,
             color  = ~pal_labour(labour)) %>% 
  addLegend(pal = pal_labour,
            values = ~labour,
            title = "Распределение рожениц")

Убитые, оставляем?

df %>% 
  mutate(kadosh = str_detect(tags, "(кадош)|(погром)|(убит)"),
         kadosh = ifelse(is.na(kadosh), FALSE, kadosh)) ->
  df

pal_kadosh <- colorFactor("Set1", domain = c(TRUE, FALSE), ordered = TRUE)

df %>%   
  filter(place == "Рашков") %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code,
             color  = ~pal_kadosh(kadosh)) %>% 
  addLegend(pal = pal_kadosh,
            values = ~kadosh,
            title = "Распределение убитых")

Цветом можно задавать не только категориальны данные, но и числовые:

pal_year <- colorNumeric("BrBG", domain = df$year)

df %>%   
  filter(place == "Стародуб",
         !is.na(year),
         !is.na(latitude)) %>% 
  leaflet() %>% 
  addTiles() %>% 
  addCircles(lng = ~longitude,
             lat = ~latitude,
             stroke = NA, 
             radius = 1,
             fillOpacity = 1, 
             label = ~tombstone_code,
             color  = ~pal_year(year)) %>% 
  addLegend(pal = pal_year,
            values = ~year,
            title = "Распределение по годам")

4.3 Динамическое отображение переменной

Попробуем нарисовать кладбище в Рашков и посмотрим в динамике, как оно заполнялось:

df %>%   
  filter(place == "Рашков",
         !is.na(year)) %>% 
  group_by(tombstone_code) %>% 
  mutate(id = 1:n()) %>% 
  filter(id == 1) %>% 
  ungroup() %>% 
  mutate(value = 1) %>% 
  arrange(-year) %>% 
  pivot_wider(names_from = year, values_from = value, values_fill = 0) %>% 
  pivot_longer(values_to = "value", names_to = "year", `1710`:`1980`) %>% 
  group_by(tombstone_code, id) %>% 
  mutate(value = cumsum(value)) ->
  rsh_sum

library(leaflet.minicharts)
  
leaflet() %>% 
  addTiles() %>% 
  addLegend(pal = pal_gender,
            values = rsh_sum$gender,
            title = "") %>% 
  addMinicharts(lng = rsh_sum$longitude,
                lat = rsh_sum$latitude,
                chartdata = rsh_sum$value,
                time = as.double(rsh_sum$year), 
                fillColor = pal_gender(rsh_sum$gender),
                width = 7)