Термоточки в Российской Федерации

пример исследования термоточек зарегистированных на территории Российской Федерации

Обновлено May 27, 2021 12 мин. для прочтения R

Термоточка - это зарегистрированное в момент пролета спутника значительное повышение температуры на поверхности земли, в сравнении с соседними участками. В России температурные аномалии регистрируются системой Информационной системой дистанционного мониторинга Федерального агентства лесного хозяйства (ИСДМ-Рослесхоз). Каждая термоточка имеет собственный регистрационный номер. Мониторинг термоточек в режиме реального времени можно посмотреть, например, на сайтах СКАНЭКС, NASA FIRMS Fire map или Информационной системы дистанционного мониторинга Федерального агентства лесного хозяйства.

Мы рассмотрим и проанализируем открытые данные Зарегистрированные термические точки на территории Российской Федерации доступные на соответствующей странице МЧС России.

Исходные данные

Подключим необходимые библиотеки.

library(tidyverse)
library(magrittr)
library(maps)
library(gganimate)
library(gt)

Загрузим данные и рассмотрим их структуру.

df

## # A tibble: 646,828 x 6
##        id dt           lon   lat type_id type_name                   
##     <dbl> <date>     <dbl> <dbl>   <dbl> <chr>                       
##  1 573822 2012-01-01  132.  43.4       3 Горение мусора              
##  2 573819 2012-01-01  132.  43.4       3 Горение мусора              
##  3 573818 2012-01-01  134.  42.9       4 Сжигание порубочных остатков
##  4 573823 2012-01-02  131.  42.9       4 Сжигание порубочных остатков
##  5 573824 2012-01-02  132.  43.1      11 Не подтверждено             
##  6 576488 2012-03-13  105.  50.5      11 Не подтверждено             
##  7 576478 2012-03-13  132.  47.9       9 Природный пожар             
##  8 576497 2012-03-13  132.  47.9       9 Природный пожар             
##  9 576479 2012-03-13  132.  47.9       9 Природный пожар             
## 10 576487 2012-03-13  104.  50.4       2 Техногенный пожар           
## # … with 646,818 more rows

Данные представляют собой таблицу датированную с 2012-01-01 по 2021-04-07, содержащую 646 828 записей. В таблице имеются следующие поля:

id – уникальный номер термоточки;
dt – дата;
lon – долгота;
lat – широта;
type_id и type_name – тип термоточки.

Наибольшее количество термоточек приходится на лесные пожары:

count(df, type_name, sort = TRUE) %>% 
  rename(количество       = n,
         `тип термоточки` = type_name) %>% 
  mutate(процент    = paste0(round(100*количество/sum(количество), 2), "%"),
         количество = format(количество, big.mark = " ")) %>% 
  gt() %>%  
  tab_options(
    column_labels.border.top.color = "white",
    column_labels.border.top.width = px(3),
    column_labels.border.bottom.color = "black",
    table_body.hlines.color = "white",
    table.border.bottom.color = "white",
    table.border.bottom.width = px(3)
  ) %>% 
  tab_source_note(md("**Таблица**: @materov <br>  **Данные**: открытые данные МЧС России"))

тип термоточки	количество	процент
Лесной пожар	222 787	34.44%
Неконтролируемый пал	131 056	20.26%
Контролируемый пал	92 015	14.23%
Природный пожар	86 243	13.33%
Не подтверждено	61 738	9.54%
Сжигание порубочных остатков	25 260	3.91%
Технологический процесс	12 644	1.95%
Горение мусора	9 027	1.4%
Сжигание мусора	4 441	0.69%
Техногенный пожар	1 454	0.22%
Торфяной пожар	163	0.03%
Таблица: @materov Данные: открытые данные МЧС России

Добавим вспомогательные переменные, представляющие собой год и месяц.

df <-
df %>% 
  mutate(month = lubridate::month(dt, label = T),
         year  = lubridate::year(dt))

Наибольшее количество термоточек наблюдалось в 2020 году, что возможно связано с улучшением системы мониторинга (цвет столбцов указывает на группировку по близким значениям):

df %>% 
  count(., year, sort = TRUE) %>% 
  ggplot(., aes(x = n, fill = n,
                y = fct_reorder(factor(year), n))) + 
  geom_col(color = "white") +
  scale_x_continuous(labels = function(x) format(x, big.mark = " ", scientific = FALSE)) +
  hrbrthemes::theme_ipsum_rc(grid = "X") +
  labs(x = "", y = "", 
       caption = "открытые данные МЧС России") +
  viridis::scale_fill_viridis(direction = -1, option = "plasma") +
  theme(legend.position = "none")

Рисунок 1: Количество наблюдаемых термоточек в РФ с 2012 по начало 2021 г.

Очевидно, что наибольшее количество термоточек приходится на летние и весенние месяцы:

df %>% 
  group_by(dt, month) %>% 
  summarise(count = n()) %>% 
  ggplot(aes(x = dt, y = count, color = factor(month))) + geom_point(alpha = 0.7) +
  hrbrthemes::theme_ft_rc() +
  labs(color = "месяц:", x = "", y = "") +
  guides(color = guide_legend(nrow = 2, override.aes = list(size = 3))) +
  scale_x_date(date_breaks = "12 months",
               date_labels = "%Y") +
  scale_y_continuous(labels = function(x) format(x, big.mark = " ", scientific = FALSE),
                     breaks = seq(0, 4000, by = 500)) +
  theme(legend.position = "bottom")

Рисунок 2: Количество термоточек зарегистрированных в Российской Федерации

Пример распределения термоточек по категориям показан ниже. Здесь была использована библиотека ggstream для визуализации.

library(ggstream)

df_subset <- df %>% filter(year %in% c("2019", "2020"))

df_subset %>% 
  count(., dt, type_name) %>% 
  rename(`тип:` = type_name) %>% 
  ggplot(aes(x = dt, y = n, fill = `тип:`, label = `тип:`, color = `тип:`)) + geom_stream() +
  scale_colour_manual(values = paletteer::paletteer_d("dutchmasters::pearl_earring", direction = -1) %>% colorspace::darken(.8)) +
  scale_fill_manual(  values = paletteer::paletteer_d("dutchmasters::pearl_earring", direction = -1) %>% colorspace::lighten(.2)) +
  scale_x_date(date_breaks = "4 months",
               date_labels = "%b %Y") +
  hrbrthemes::theme_ipsum(grid = "X") +
  theme(legend.position = "bottom") +
  labs(x = "", y = "")

Рисунок 3: Количество термоточек зарегистрированных в Российской Федерации в 2019-2020 гг.

Также, количественную характеристику по термоточкам можно посмотреть с помощью диаграмм размаха.

df %>% 
  count(dt, year) %>% 
  ggplot(aes(x = factor(year), y = n)) + geom_boxplot() +
  scale_y_continuous(labels = function(x) format(x, big.mark = " ", scientific = FALSE),
                     breaks = seq(0, 4000, by = 500)) + 
  labs(x = "", y = "")

Рисунок 4: Диаграммы размаха, характеризующие количество термоточек зарегистрированных в Российской Федерации

Географическое распределение термоточек

Рассмотрим географическое расположение термоточек на карте РФ по сезонам. Наибольшее количество явлений наблюдалось на юге РФ и на территории Сибири и Дальнего Востока. Подложка представляет собой toner-background-карту загруженную с помощью библиотеки ggmap.

library(ggmap)
ru <- c(left = 20, bottom = 41.28413, right = 180, top = 80)
map <- get_stamenmap(ru, zoom = 5, maptype = "toner-background")

df <-
df %>% 
  mutate(
    season = case_when(
      month == "янв" ~ "зима",
      month == "фев" ~ "зима",
      month == "мар" ~ "весна",
      month == "апр" ~ "весна",
      month == "май" ~ "весна",
      month == "июн" ~ "лето",
      month == "июл" ~ "лето",
      month == "авг" ~ "лето",
      month == "сен" ~ "осень",
      month == "окт" ~ "осень",
      month == "ноя" ~ "осень",
      month == "дек" ~ "зима"
    )
  )

ggmap(map) +
  geom_point(data = df, 
             alpha = 0.015, size = 0.4, 
             aes(lon, lat), color = "red") + 
  labs(x = "", y = "")

Рисунок 5: Географическое расположение термоточек зарегистрированных в Российской Федерации за период с 2012 по начало 2021 года

ggmap(map) +
  geom_point(data = df, 
             alpha = 0.015, size = 0.4, 
             aes(lon, lat, color = factor(season))) + 
  labs(x = "", y = "", color = "сезон:") + 
  viridis::scale_color_viridis(option = "turbo", discrete = T) +
  silgelib::theme_plex() +
  theme(legend.position = "none") +
  facet_wrap(~factor(season) %>% 
               fct_relevel("зима", "весна", "лето", "осень"))

Рисунок 6: Географическое расположение термоточек зарегистрированных в Российской Федерации за период с 2012 по начало 2021 года

Отметим широту и долготу, на которых наблюдалось наибольшее количество точек.

library(patchwork)

# долгота
p1 <-
df %>% 
  ggplot(aes(lon)) + geom_histogram(bins = 100) +
  scale_x_continuous(breaks = seq(round(min(df$lon))-20, round(max(df$lon))+20, by = 20)) +
  geom_vline(xintercept = 133, linetype = "dashed", color = "red") +
  scale_y_continuous(labels = function(x) format(x, big.mark = " ", scientific = FALSE),
                     breaks = seq(0, 50000, by = 10000)) +
  silgelib::theme_plex() +
  labs(x = "долгота", y = "")

# широта
p2 <-
df %>% 
  ggplot(aes(lat)) + geom_histogram(bins = 100) +
  scale_x_continuous(breaks = seq(round(min(df$lat))-21, round(max(df$lat))+21, by = 5)) +
  geom_vline(xintercept = 51.5, linetype = "dashed", color = "red") +
  geom_vline(xintercept = 55.3, linetype = "dashed", color = "red") +
  geom_vline(xintercept = 63, linetype = "dashed", color = "red") +
  scale_y_continuous(labels = function(x) format(x, big.mark = " ", scientific = FALSE),
                     breaks = seq(0, 50000, by = 5000)) +
  silgelib::theme_plex() +
  labs(x = "широта", y = "") 

p1 / p2

Рисунок 7: Широта и долгота, на которых наблюдалось наибольшее количество термоточек

Выделим полученные характеристики и нанесем их на модельную карту, где плотности показаны с помощью гексогональной структуры.

df %>% 
  ggplot(aes(lon, lat)) + 
  borders("world", regions = "Russia", fill = "grey80") +
  geom_hex(alpha = 0.7, bins = 60) +
  viridis::scale_fill_viridis(option = "plasma", limits = c(0,6300)) +
  silgelib::theme_plex() +
  theme(line = element_blank()) +
  scale_x_continuous(breaks = seq(round(min(df$lon))-20, round(max(df$lon))+20, by = 20)) +
  labs(x = "\nдолгота", y = "широта\n",
       fill = "количество\nтермоточек") +
  geom_vline(xintercept = 133,  linetype = "dashed", color = "black", size = 0.75) +
  geom_hline(yintercept = 51.5, linetype = "dashed", color = "black", size = 0.75) +
  geom_hline(yintercept = 55.3, linetype = "dashed", color = "black", size = 0.75) +
  geom_hline(yintercept = 63,   linetype = "dashed", color = "black", size = 0.75)

Рисунок 8: Выделены широта и долгота, на которых наблюдалось наибольшее количество термоточек

Покажем, как были распределены термоточки по годам.

df %>% 
  ggplot(aes(lon, lat)) + 
  borders("world", regions = "Russia", fill = "grey80") +
  geom_hex(alpha = 0.7, bins = 50) +
  coord_fixed(ratio = 2.5) +
  viridis::scale_fill_viridis(option = "plasma", limits = c(0,4000), breaks = seq(0, 4000, by = 1000)) +
  silgelib::theme_plex() +
  theme(line = element_blank(), 
        axis.title.x = element_blank(),
        axis.text.x  = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y  = element_blank(),
        axis.ticks.y = element_blank(),
        legend.key.size = unit(.5,"cm"),
        legend.key.width = unit(1.4,"cm"),
        legend.position = "bottom") +
  labs(x = "\nдолгота", y = "широта\n",
       fill = "количество термоточек:") + facet_wrap(~factor(year))

Рисунок 9: Распределение термоточек по годам

Рассмотрим распределение термоточек по месяцам, например, для лесных и природных пожаров.

df %>% 
  filter(type_name %in% c("Лесной пожар", "Природный пожар") ) %>% 
  ggplot(aes(lon, lat)) + 
  borders("world", regions = "Russia", fill = "grey80") +
  geom_hex(alpha = 0.7, bins = 50) +
  coord_fixed(ratio = 2.5) +
  viridis::scale_fill_viridis(option = "plasma", limits = c(0,3000), breaks = seq(0, 3000, by = 1000)) +
  silgelib::theme_plex() +
  theme(line = element_blank(), 
        axis.title.x = element_blank(),
        axis.text.x  = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y  = element_blank(),
        axis.ticks.y = element_blank(),
        legend.key.size = unit(.5,"cm"),
        legend.key.width = unit(1.2,"cm"),
        legend.position = "bottom") +
  #scale_color_continuous() +
  labs(x = "\nдолгота", y = "широта\n",
       fill = "количество термоточек:") + facet_wrap(~factor(month))

Рисунок 10: Распределение термоточек по месяцам для лесных и природных пожаров

Рассмотрим распределение термоточек по категориям.

df %>% 
  ggplot(aes(lon, lat)) + 
  borders("world", regions = "Russia", fill = "grey80") +
  geom_hex(alpha = 0.7, bins = 50) +
  coord_fixed(ratio = 2.5) +
  viridis::scale_fill_viridis(option = "plasma", limits = c(0,7000), breaks = seq(0, 7000, by = 1000)) +
  silgelib::theme_plex() +
  theme(line = element_blank(), 
        axis.title.x = element_blank(),
        axis.text.x  = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y  = element_blank(),
        axis.ticks.y = element_blank(),
        legend.key.size = unit(.5,"cm"),
        legend.key.width = unit(2,"cm"),
        legend.position = "bottom") +
  #scale_color_continuous() +
  labs(x = "\nдолгота", y = "широта\n",
       fill = "количество термоточек:") + facet_wrap(~factor(type_name))

Рисунок 11: Распределение термоточек по категориям.

Для отображения динамики распространения точек, зарегистрированных как пожары в 2019-2020 годах, воспользуемся анимацией.

Сначала отобразим основу как статическую карту.

df_fires <- df %>% 
  filter(year %in% c("2019", "2020"),
         type_name %in% c("Лесной пожар", "Природный пожар"))

map_anim <-
ggmap(map) +
  geom_point(data = df_fires, 
             size = 0.5, alpha = 0.7,
             aes(lon, lat, color = as.factor(month))) +
  labs(x = "", y = "", color = "месяц:") +
  guides(color = guide_legend(nrow = 2, override.aes = list(size = 2, alpha = 1))) +
  silgelib::theme_plex() +
  theme(line = element_blank(), 
        axis.title.x = element_blank(),
        axis.text.x  = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.y  = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = "bottom")

map_anim

Рисунок 12: Лесные и природные пожары на территории РФ в 2019-2020 годах

Непосредственно анимация (показано недельное изменение) реализована в библиотеке gganimate.

map_anim <- 
  map_anim +
  transition_time(dt) + 
  labs(title = "Дата пожара: {frame_time}") +
  # необходимо для более плавного перехода
  shadow_wake(wake_length = 0.1, alpha = FALSE)

# fps позволяет регулировать скорость анимации
animate(map_anim, height = 600, width = 900, res = 140, fps = 2)

Рисунок 13: Анимация, показывающая распространение лесных и природных пожаров на территории РФ в 2019-2020 годах

Заключение

В статье показаны некоторые основные характеристики связанные с термоточками, фиксируемыми в Российской Федерации. Основу базового анализа составили инструменты для работы с картографическими данными на языке программирования R.

rstats геоданные