Общественный контроль экологического мониторинга: R, R и ещё раз R!
Download as ODP, PDF0 likes459 views
Документ обсуждает результаты мониторинга качества воздуха в Кривом Роге, где в 2015 году выбросы составили 315,4 тыс. тонн. Описываются автоматизированные посты для измерения загрязнений и используются различные инструменты для анализа данных, такие как R и ggplot2. Также упоминаются планы на будущее, включая получение открытых данных и освоение интерактивной графики.
![Мониторинг качества воздуха в Кривом Роге
●
4 автоматизированных поста на
балансе города
●
3 автоматизированных поста на
балансе «АрселорМиттал Кривой Рог»
●
5 постов — Лаборатория наблюдений
за состоянием атмосферного воздуха
г.Кривой Рог
●
1 пост — Госсанэпидемслужба
●
1 пост — Южный ГОК
●
2 поста — Северный ГОК
●
1 пост — Центральный ГОК
●
1 пост — Ингулецкий ГОК
●
4 поста — «Кривбассжелезорудком»
●
2 поста - «Евраз Сухая Балка»
●
1 пост — Криворожский завод горного
оборудования
●
1 пост — ГП «Криворожская
теплоцентраль»
●
Всего: 7 автоматизованных постов
19 неавтоматизованных постов
[данные — Криворожский исполком]
4](https://image.slidesharecdn.com/vystupkrr2016-03-15-160324073835/85/R-R-R-4-320.jpg)
![7Импорт шрифтов в R
> library(extrafont)
Registering fonts with R
> font_import()
Importing fonts may take a few minutes, depending on the number of fonts and the
speed of the system. Continue? [y/n] y
Scanning ttf files in /usr/share/fonts/ ...
Extracting .afm files from .ttf files...
...
У кого установлен TeX/LaTeX — будет купаться в роскоши гарнитур!](https://image.slidesharecdn.com/vystupkrr2016-03-15-160324073835/85/R-R-R-7-320.jpg)
![11Интерполяция метеоданных по коротким интервалам времени
> library(zoo)
> KrR_point_met$wd[is.na(KrR_point_met$wd)] <- -9999
> seq.time <-
zoo(order.by=(as.POSIXct(seq(min(KrR_point_met$time.posCT.Kiev),
max(KrR_point_met$time.posCT.Kiev), by=600)))) #с шагом 600 секунд!
> mer.meteo <- merge(zoo(x = KrR_point_met[c(11:15, 17)], order.by =
unique(KrR_point_met$time.posCT.Kiev)), seq.time)
> approx.meteo <- round(na.approx(mer.meteo),0)
> zooToDf <- function(z) {
df <- as.data.frame(z)
df$Date <- time(z)
rownames(df) <- NULL
df <- df[,c(ncol(df), 1:(ncol(df)-1))]
return(df)
}
> approx.meteo.df <- zooToDf(approx.meteo)](https://image.slidesharecdn.com/vystupkrr2016-03-15-160324073835/85/R-R-R-11-320.jpg)
![12Пересчёт направлений ветров в румбы
и объединение с таблицей мониторинга воздуха
> tbl_df(approx.meteo.df) %>% mutate(DD.meteo.from = ordered(
ifelse((wd >= 168.75 & wd < 191.25 & ws > 0), "S",
ifelse((wd >= 191.25 & wd < 213.75 & ws > 0), "SSW",
ifelse((wd >= 213.75 & wd < 236.25 & ws > 0), "SW",
ifelse((wd >= 236.25 & wd < 258.75 & ws > 0), "WSW",
ifelse((wd >= 258.75 & wd < 281.25 & ws > 0), "W",
ifelse((wd >= 281.25 & wd < 303.75 & ws > 0), "WNW",
ifelse((wd >= 303.75 & wd < 326.25 & ws > 0), "NW",
ifelse((wd >= 326.25 & wd < 348.75 & ws > 0), "NNW",
ifelse((wd >= 348.75 & wd <= 360), "N",
ifelse((wd >= 0 & wd < 11.25 & ws > 0), "N",
ifelse((wd >= 11.25 & wd < 33.75 & ws > 0), "NNE",
ifelse((wd >= 33.75 & wd < 56.25 & ws > 0), "NE",
ifelse((wd >= 56.25 & wd < 78.75 & ws > 0), "ENE",
ifelse((wd >= 78.75 & wd < 101.25 & ws > 0), "E",
ifelse((wd >= 101.25 & wd < 123.75 & ws > 0), "ESE",
ifelse((wd >= 123.75 & wd < 146.25 & ws > 0), "SE",
ifelse((wd >= 146.25 & wd < 168.75 & ws > 0), "SSE",
ifelse((wd < 0 & ws > 0), "VRB", "CALM"
)))))))))))))))))), levels=c("N","NNE","NE",
"ENE", "E", "ESE", "SE", "SSE", "S", "SSW", "SW", "WSW",
"W", "WNW", "NW", "NNW", "VRB", "CALM"))) -> approx.meteo.df
> atmo2 <- left_join(atmo2, approx.meteo.df[, c(2:9)])
Joining by 'time.posCT.Kiev'](https://image.slidesharecdn.com/vystupkrr2016-03-15-160324073835/85/R-R-R-12-320.jpg)
Общественный контроль экологического мониторинга: R, R и ещё раз R!
- 1. ОБЩЕСТВЕННЫЙ КОНТРОЛЬ ЭКОЛОГИЧЕСКОГО МОНИТОРИНГА: R, R и ещё раз R! Василенко Евгений datastory.org.ua 82geka@gmail.com
- 2. 2Кривой Рог: вид изнутри Фото: Алексей Кущ По информации Управления экологии Криворожского горисполкома: в 2015 году выбросы в атмосферу города составили 315,4 тыс.тонн... примерно по 480 кг на каждого жителя
- 3. 3Кривой Рог: вид сверху Длина видимой части дымового шлейфа — более 90 км!
- 4. Мониторинг качества воздуха в Кривом Роге ● 4 автоматизированных поста на балансе города ● 3 автоматизированных поста на балансе «АрселорМиттал Кривой Рог» ● 5 постов — Лаборатория наблюдений за состоянием атмосферного воздуха г.Кривой Рог ● 1 пост — Госсанэпидемслужба ● 1 пост — Южный ГОК ● 2 поста — Северный ГОК ● 1 пост — Центральный ГОК ● 1 пост — Ингулецкий ГОК ● 4 поста — «Кривбассжелезорудком» ● 2 поста - «Евраз Сухая Балка» ● 1 пост — Криворожский завод горного оборудования ● 1 пост — ГП «Криворожская теплоцентраль» ● Всего: 7 автоматизованных постов 19 неавтоматизованных постов [данные — Криворожский исполком] 4
- 5. Первичные данные (ПАО «АрселорМиттал Кривой Рог») 1) измерения не синхронные 2) пропуски измерений 3) временные интервалы не выдержаны Набивка данных в полуручном режиме Данные за ноябрь 2014 - март 2015 года 14 полей * 32615 записей = 456610 значений 5
- 6. Используемые инструменты 6 ● R + Rstudio — базовая среда ● magrittr — «туннелирование» функций (%>%) ● tidyr — преобразование таблиц ● dplyr — компиляция, усреднение, суммирование ● ggplot2 — графика ● stationaRy — получение метеорологических данных ● zoo — обработка временных рядов (интерполяция) ● scales — настройки отображения различных шкал на графике ● extrafont — разовый импорт шрифтов в R ● Debian GNU/Linux — единственная и незаменимая! > atmo2 <- read.csv("vozd_monitoring_KrR_fact_2.csv", header = T, sep = ";", dec = ",")#загружаем таблицу данных мониторинга воздуха > atmo2$time.posCT.Kiev <- as.POSIXct(as.character(atmo2$date.time.original), format = "%d/%m/%Y %H:%M:%S", tz = "Europe/Kiev")#создаём поле в формате POSIXct
- 7. 7Импорт шрифтов в R > library(extrafont) Registering fonts with R > font_import() Importing fonts may take a few minutes, depending on the number of fonts and the speed of the system. Continue? [y/n] y Scanning ttf files in /usr/share/fonts/ ... Extracting .afm files from .ttf files... ... У кого установлен TeX/LaTeX — будет купаться в роскоши гарнитур!
- 8. 8Получение метеорологических данных > library(stationaRy) > library(magrittr) > met_stations <- get_isd_stations() > write.table(met_stations, "met_stations.csv", sep = ";")# просматриваем список метеостанций во внешнем файле. Более 27 тыс. метеостанций > KrR_point_met <- get_isd_stations() %>% select_isd_station(name = "LOZUVATKA INTL") %>% get_isd_station_data(startyear = 2005, endyear = 2016) > KrR_point_met$time.posCT.UTC <- as.POSIXct(format(KrR_point_met$time), tz="UTC") > KrR_point_met$time.posCT.Kiev <- as.POSIXct(format(KrR_point_met$time.posCT.UTC, tz="Europe/Kiev", usetz=TRUE)) Данные после импорта с сервера NOAA нужно проверять! Возможны «обрывы связи»
- 9. 9Проблема нестыковки интервалов Мониторинг воздуха № п.п. Значение Время 1 25,7 00:00 2 37,8 00:20 3 NA 00:40 4 96,6 01:00 5 43,8 01:20 6 33,3 01:40 7 12,1 02:00 8 10,7 02:20 9 9,4 02:40 10 10,4 03:00 ... ... ... n 27,8 23:40 Метеоданные (METAR) № п.п. Значение Время 1 240 00:00 2 250 00:30 3 250 01:00 4 250 01:30 5 260 02:00 6 270 02:30 7 270 03:00 8 250 03:30 9 240 04:00 10 230 04:30 ... ... ... n 230 23:30 ? ? ? ?
- 10. 10Проблема решается вычислением промежуточных значений метеоданных (интерполяцией) Мониторинг воздуха № п.п. Значение Время 1 25,7 00:00 2 37,8 00:20 3 NA 00:40 4 96,6 01:00 5 43,8 01:20 6 33,3 01:40 7 12,1 02:00 8 10,7 02:20 9 9,4 02:40 10 10,4 03:00 ... ... ... n 27,8 23:40 Метеоданные (METAR) № п.п. Значение Время 1 240 00:00 2 243,3(3) 00:10 3 246,6(6) 00:20 4 250 00:30 5 250 00:40 6 250 00:50 7 250 01:00 8 250 01:10 9 250 01:20 10 250 01:30 ... ... ... n ... 23:40
- 11. 11Интерполяция метеоданных по коротким интервалам времени > library(zoo) > KrR_point_met$wd[is.na(KrR_point_met$wd)] <- -9999 > seq.time <- zoo(order.by=(as.POSIXct(seq(min(KrR_point_met$time.posCT.Kiev), max(KrR_point_met$time.posCT.Kiev), by=600)))) #с шагом 600 секунд! > mer.meteo <- merge(zoo(x = KrR_point_met[c(11:15, 17)], order.by = unique(KrR_point_met$time.posCT.Kiev)), seq.time) > approx.meteo <- round(na.approx(mer.meteo),0) > zooToDf <- function(z) { df <- as.data.frame(z) df$Date <- time(z) rownames(df) <- NULL df <- df[,c(ncol(df), 1:(ncol(df)-1))] return(df) } > approx.meteo.df <- zooToDf(approx.meteo)
- 12. 12Пересчёт направлений ветров в румбы и объединение с таблицей мониторинга воздуха > tbl_df(approx.meteo.df) %>% mutate(DD.meteo.from = ordered( ifelse((wd >= 168.75 & wd < 191.25 & ws > 0), "S", ifelse((wd >= 191.25 & wd < 213.75 & ws > 0), "SSW", ifelse((wd >= 213.75 & wd < 236.25 & ws > 0), "SW", ifelse((wd >= 236.25 & wd < 258.75 & ws > 0), "WSW", ifelse((wd >= 258.75 & wd < 281.25 & ws > 0), "W", ifelse((wd >= 281.25 & wd < 303.75 & ws > 0), "WNW", ifelse((wd >= 303.75 & wd < 326.25 & ws > 0), "NW", ifelse((wd >= 326.25 & wd < 348.75 & ws > 0), "NNW", ifelse((wd >= 348.75 & wd <= 360), "N", ifelse((wd >= 0 & wd < 11.25 & ws > 0), "N", ifelse((wd >= 11.25 & wd < 33.75 & ws > 0), "NNE", ifelse((wd >= 33.75 & wd < 56.25 & ws > 0), "NE", ifelse((wd >= 56.25 & wd < 78.75 & ws > 0), "ENE", ifelse((wd >= 78.75 & wd < 101.25 & ws > 0), "E", ifelse((wd >= 101.25 & wd < 123.75 & ws > 0), "ESE", ifelse((wd >= 123.75 & wd < 146.25 & ws > 0), "SE", ifelse((wd >= 146.25 & wd < 168.75 & ws > 0), "SSE", ifelse((wd < 0 & ws > 0), "VRB", "CALM" )))))))))))))))))), levels=c("N","NNE","NE", "ENE", "E", "ESE", "SE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "VRB", "CALM"))) -> approx.meteo.df > atmo2 <- left_join(atmo2, approx.meteo.df[, c(2:9)]) Joining by 'time.posCT.Kiev'
- 13. 13Откуда поступают загрязнения: ggplot2: geom_boxplot > tbl_df(atmo2) %>% filter(dust != "NA") %>% select(nazva, DD.meteo.from, dust) %>% ggplot(aes(y = dust, x = DD.meteo.from, fill = nazva)) + geom_boxplot() + stat_summary(fun.y = median, geom = "line", aes(group = 2), colour = "red", size = 2) + stat_summary(fun.data = give.n, geom = "text", fun.y = median, angle = 270, size = 3, colour = "slateblue4") + scale_y_continuous(limits=c(0, 0.75)) + ... (оформление) + #детальнее — на слайде 20 facet_grid(.~nazva)
- 14. 14Откуда поступают загрязнения: ggplot2: geom_boxplot
- 15. 15«Календарные диаграммы» (метеоусловия): ggplot2: geom_tile > tbl_df(KrR_point_met) %>% ... (подготовка данных: работа пакетов dplyr и tidyr детальнее — на странице http://www.datastory.org.ua/?p=598) %>% ggplot(aes(monthweek, weekday.order, fill = mean.tmp.value)) + geom_tile(colour = "gray15") + facet_grid(year~month.order) + scale_fill_gradient2(name = "...", limits = c(0.0, 100.0), low = "red4", mid = "orange2", high = "royalblue", midpoint = 50.0) + scale_x_continuous(breaks=seq(1, 6, 1)) + ... (оформление) + #детальнее — на слайде 20 geom_text(aes(label = mean.tmp.value), vjust = 0.5, family = "Droid Sans", size = 2.5, colour = "darkred")
- 16. 16«Календарные диаграммы» (метеоусловия): ggplot2: geom_tile
- 17. 17«Календарные диаграммы» (загрязнение воздуха): ggplot2: geom_tile
- 18. 18Графики единичных значений загрязнения воздуха: ggplot2 + scales: geom_point + scale_x_datetime > tbl_df(atmo2) %>% ... (подготовка данных: работа пакетов dplyr и tidyr) %>% ggplot(aes(time.posCT.Kiev, NO)) + geom_point(stat="identity", colour = "darkred", size = 3.5) + geom_hline(aes(yintercept = c(0.4, 0.06), colour = c("blue", "green")), linetype=c("dashed", "dotdash"), size = 1.2, show_guide = TRUE) + labs(y = "...", x = "...", title = "...") + scale_color_manual(values=c("#00008B", "#458B00"), name="...", labels=c("...", "...")) + scale_x_datetime(breaks = date_breaks("2880 mins"), labels = date_format("%d %b %H:%M", tz = "Europe/Kiev"), minor_breaks = date_breaks("720 min")) + ... (оформление) #детальнее — на слайде 20
- 19. 19Графики единичных значений загрязнения воздуха: ggplot2 + scales: geom_point + scale_x_datetime Ответ ГСЧС: «...описанный инцидент попадает под определение ''чрезвычайная ситуация техногенного характера''...»
- 20. Дополнительное оформление графиков: ggplot2 > ggplot(aes(x = ..., y = ...)) + geom_point(...) + labs(y = "...", x = "...", title = "...") + theme(text = element_text(family = "Droid Serif", face = "italic", size = 14, colour = "firebrick4", lineheight = 0.9), legend.position = "bottom", legend.text = element_text(family = "Droid Serif", face = "italic", size = 14, colour = "firebrick4", lineheight = 0.8, angle = 0), axis.text.x = element_text(colour = "gray15", face="bold", size= 12, angle = 270, vjust = 0.5, hjust = 1), axis.text.y = element_text(colour = "gray15", face="bold", size= 12, angle = 0, vjust = 0.5, hjust = 1), axis.ticks = element_line(colour = "orange", size = 0.2), plot.background = element_rect(fill = "gray95"), panel.grid.major = element_line(colour = "orange", size = 0.2), panel.grid.minor = element_line(colour = "gray90"), panel.background = element_rect(fill="gray95")) 20 Из-за различий в начертаниях гарнитур — размеры символов приходится подбирать индивидуально!
- 21. Планы на будущее 1) ждём с нетерпением данных мониторинга воздуха Криворожским горисполкомом в форме открытых данных 2) освоение интерактивной графики 3) обработка данных дистанционного зондирования Земли средствами R 4) общение и обмен опытом! 21
- 22. СПАСИБО ЗА ВНИМАНИЕ! «Экологический совет Криворожья» ecorada.org ecorada.kr@gmail.com Василенко Евгений datastory.org.ua 82geka@gmail.com 22
Editor's Notes
- #2: Проверить перевод до этого слайда