Домашнее задание №7

Дорогой дневник, мне не подобрать слов, чтобы описать боль и унижение, которые я испытал сегодня и во все остальные дни, потраченные на выполнение дз, моя жизнь поломана навсегда… R выдаёт ошибки настолько случайным образом, что сначала он пишет:

Error in `map()`:
ℹ In index: 1.
Caused by error in `year == x`:
! comparison (==) is possible only for atomic and list types
Backtrace:
 1. purrr::map(c(2019, 2020, 2021), fuck)
 9. base::file(., year == x)

Но ежели скопировать код в новый чанк и перезапустить, то он работает. А ещё в любой момент он может разучиться переименовывать столбцы:

Ошибка в rename(., winter = "January-March", summer = "July-September") :
  неиспользованные аргументы (winter = "January-March", summer = "July-September")

Что исправляется только конопкой Session -> Restart R. Полагаю, что это происходит только лишь потому, что R крайне удобен при обработке табличных данных. И я уже промолчу про непредсказуемый синтаксис, в котором, по всей видимости, не регламентировано употребление кавычек, а также очень странно реализованые функции соединения таблиц, ведущие к такому удвоению столбцов, при котором в аккурат половина заполнены NA, ибо они были лишь в одной таблице, а по сему не имели потребности быть удвоенными. Но что самое печальное, так это то, что при поиске в Интернете кода для построения графика регулярно появляются реализации, содержащие import matplotlib.pyplot as plt хотя я явно указываю, что мне нужен R…

Задание 1

Прочитайте данные о динамике количества семей медоносных пчел в разных штатах США. Они доступны по ссылке https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-11/colony.csv

Изучите датасет!

Что в нем есть:

year - год,
months - квартал года,
state - штат США, либо страна США целиком (“United States”), либо другие страны (“Other States”),
colony_n - число пчелиных семей на начало квартала этого года,
colony_max - максимальное число семей в этом квартале года,
colony_lost - число погибших пчелиных семей,
colony_lost_pct - процент семей, которые погибли за этот квартал,
colony_added - число новых семей,
colony_reno - число обновленных семей,
colony_reno_pct - процент обновленных семей.

Постройте график lollipop plot, показывающий количество семей пчел в разных штатах США на начало 2015 года. Удобнее будет расположить штаты по вертикальной оси, а число семей - по горизонтальной оси. Поработайте над оформлением графика: добавьте заголовок графику, подпишите названия осей, добавьте на график цвета.

Сохраните график.

colony <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-11/colony.csv")

## Rows: 1222 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): months, state
## dbl (8): year, colony_n, colony_max, colony_lost, colony_lost_pct, colony_ad...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

fucking_plot_1 <- colony %>% 
  filter(year == 2015, months == "January-March", !(state %in% c("United States", "Other States"))) %>% 
  ggplot() +
  aes(x = colony_n,
      y = fct_reorder(fct(state), colony_n),
      colour = as.integer(fct_reorder(fct(state), colony_n))) + #сделаю так, потому что не смог найти, как сделать градиент как в образце. Другие нагугленные примеры на R просто падают с ошибкой, а пример на python здесь не особо актуалнен.
  geom_lollipop(horizontal = TRUE) +
  scale_x_log10(labels =  scales::label_math(format = log10)) +
  labs(title = "Number of honey bee colonies at the beginning of the year 2015",
       x = element_blank(),
       y = element_blank()) +
  scale_color_gradient(low = "blue", high = "red") +
  theme(legend.position = "none")
ggsave("./1.png", plot = fucking_plot_1)

## Saving 7 x 5 in image

## Warning: Using the `size` aesthetic with geom_segment was deprecated in ggplot2 3.4.0.
## ℹ Please use the `linewidth` aesthetic instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

fucking_plot_1

Задание 2

Воспользуйтесь тем же набором данных про пчел, что и в задании 1. Постройте график, который бы показывал, сколько пчелиных семей погибало в течение зимних (January-March) и летних месяцев (July-September) по всем США (удалите из данных 2021 год, так как наблюдения по нему неполные). Можно было бы использовать группированную столбчатую диаграмму для создания такого графика, однако лучше такие данные (два числа - за зиму и лето - которые мы хотим сравнивать) визуализировать с помощью точек, соединенных линией, показывающей разницу между ними (Cleveland dotplot, см. пример графика в google форме). Задайте для зимних и летних значений числа погибших пчелиных семей разные цвета и разукрасьте линии, соединяющие точки, в зависимости от того, летом или зимой погибло больше семей в этом году. Подпишите названия осей, добавьте название графика.

qqq <- colony %>% 
  filter(year != 2021) %>% 
  #вот дальше вообще не понимаю, что должно произойти, даже ChatGPT каккую-то охинею пишет. Лучше в Excel графики строить. Вот честно. Даже если у меня что-то получится комментарий я удалять не буду.
  filter(months %in% c("January-March", "July-September")) %>% 
  filter(state == "United States")
  # я не можу. Эти соеденительные линии нельзя просто в фоторедакторе добавить?
start <- qqq %>% 
  pivot_wider(names_from = months, values_from = colony_lost) %>%
  rename(winter = "January-March", summer = "July-September") %>% #какой же всратый костыль
  filter(!is.na(winter))
# если бы это был не R я бы прошёлся циклом по строкам и сохранил бы словарь зимнего количества и словарь летнего количества,
# а потом бы сделал словарь с кортежами координат и построил график, но здесь не надо думать,
# надо просто писать рандомные функции, пока случайно не получится график
end <- qqq %>% 
  pivot_wider(names_from = months, values_from = colony_lost) %>%
  rename(winter = "January-March", summer = "July-September") %>% #какой же всратый костыль
  filter(!is.na(summer))
lines <- left_join(start, end, by = "year") %>% 
#зачем нужны все эти функции соединения, если они выдают нечто, что нельзя назвать цензурно? Я бы вручную это быстрее сделал...
  ggplot() +
  geom_segment(aes(x = winter.x, #очередной костыль
               y = year,
               xend = summer.y, #и это костыль
               yend = year,
               colour = winter.x > summer.y),
               lwd = 1) +
    scale_colour_discrete(breaks=c(FALSE, TRUE),
                        labels=c('Winter', 'Summer'),
                        type = c("blue", "red"))+
  geom_point(
             aes(x = winter.x,
      y = year),
      colour = "blue") +
  geom_point(
             aes(x = summer.y,
      y = year),
      colour = "red") +
  labs(x = "Number of lost bee colonies",
       y = "Year") +
  theme(legend.position = "top",
        legend.title = element_blank())
ggsave("./2.png", plot = lines)

## Saving 7 x 5 in image

lines

#finally абсолютно нечитаемый график, зато похоже на образец

Задание 3

Воспользуйтесь тем же набором данных про пчел, что и в задании 1. Постройте тепловую карту, которая бы показывала процент погибших семей (colony_lost_pct) по разным штатам в течение времени. Постройте дендрограмму для штатов. А также разбейте штаты на 4 группы по количеству семей на начало 2015 года (можно разбить на квартили, например, с помощью функции cut_number()). Добавьте эту информацию в качестве аннотации на тепловую карту.

#Пока я делал это задание R всеми способами пытыался меня убедить что он в принципе не способен строить теплокарты
colony_mtx <- colony %>% 
  filter(!(state %in% c("United States", "Other States"))) %>% 
  drop_na() %>% #Ё*АННЫЙ НАСВАЙ!!! Если убрать с ошибкой падает pheatmap, а если оставить то rownames...
  #можно я вручную сделаю нормальную таблицу без всех этих кривых столбоцов и NA, а потом дам на вход pheatmap?
  transmute(state = state, time = paste(year, months, sep = " "), colony_lost_pct = colony_lost_pct) %>%
  pivot_wider(names_from = time, values_from = colony_lost_pct, id_cols = state) %>% 
  select(where(is.numeric)) %>%
  as.matrix()
rownames(colony_mtx) <- unique(drop_na(filter(colony, !(state %in% c("United States", "Other States"))))$state)
graf <- pheatmap(colony_mtx, cluster_cols = FALSE, cluster_rows = TRUE,
         color = colorRampPalette(c("red", "yellow"))(50))
         #annotation_row = as.data.frame(cut_number(colony_mtx, n = 4), rownames(colony_mtx))) #б*я, вообще не понимаю как это должно работать, поэтому не буду разбивать на квантили, а то скоро вместо ошибки R напишет "Идите на х*й. Я такое тоже не умею"
#серые ячейки -- это, вероятно NA, которые каким-то образом самозародились...
#P.S. R точно подходит для построения теплокарт?
ggsave("./3.png", graf)

## Saving 7 x 5 in image

graf

Задание 4

Отрисуйте диаграмму Венна, которая бы показывала количества штатов, которые потеряли более 20% пчелиных семей (colony_lost_pct) в 2019, 2020 и 2021 годах. То есть множествами, которые вы сравниваете, будут 3 списка штатов - каждый для своего года.

Сохраните график.

#как известо появление ошибок в R крайне непредсказуемо. На столько, что если выполнить код вручную три раза он работает.
#А если обернуть в функцию, то не работает. Магия.
#fuck <- function(x) {
#  colony %>% 
#    filter(!(state %in% c("United States", "Other States"))) %>% 
#    drop_na() %>% 
#    filter(colony_lost_pct > 20) %>% 
#    filter(year == x) %>% 
#    pull(state)
#}
#map(c(2019, 2020, 2021), fuck)
#А ведь я реально верил, что получу список и сразу передам его на вход ggVennDiagram, но R возразил: "Много хочешь".

set_2019 <-  colony %>% 
    filter(!(state %in% c("United States", "Other States"))) %>% 
    drop_na(colony_lost_pct) %>% 
    filter(colony_lost_pct > 20) %>% 
    filter(year == 2019) %>% 
    pull(state)
set_2020 <-  colony %>% 
    filter(!(state %in% c("United States", "Other States"))) %>% 
    drop_na(colony_lost_pct) %>% 
    filter(colony_lost_pct > 20) %>% 
    filter(year == 2020) %>% 
    pull(state)
set_2021 <-  colony %>% 
    filter(!(state %in% c("United States", "Other States"))) %>% 
    drop_na(colony_lost_pct) %>% 
    filter(colony_lost_pct > 20) %>% 
    filter(year == 2021) %>% 
    pull(state)
plot <- ggVennDiagram(list(set_2019, set_2020, set_2021), category.names = c("2019", "2020", "2021"),
                      colour = "black", lwd = 0.8, lty = 1) + #эта строчка должна менять обводку у кругов, но в R как обычно ничто не работает правильно
  scale_fill_gradient(low = "white", high = "tomato2")
ggsave("./4.png", plot)

## Saving 7 x 5 in image

plot

#так блэт. Откуда обводка и почему числа отличаются от образца? Ни с тем, ни с другим не знаю как бороться...
#UPD. Оказывается не всё и не всегда нужно проверять на наличие NA. Обводка всё ещё осталась...

Задание 5

Используйте график Upset для того, чтобы показать количества штатов, которые потеряли более 20% пчелиных семей (colony_lost_pct) за все года наблюдений.

Сохраните график.

#ЛОЛ. Я скопировал функцию в этот чанк и она заработала. Видимо генерация ошибок в R основана на истинно случайных числах
fuck <- function(x) {
  colony %>% 
    filter(!(state %in% c("United States", "Other States"))) %>% 
    drop_na(colony_lost_pct) %>% 
    filter(colony_lost_pct > 20) %>% 
    filter(year == x) %>% 
    pull(state)
}
sets <- map(unique(pull(colony, year)), fuck)
names(sets) <- unique(pull(colony, year))

www <- upset(fromList(sets), 
      order.by = "freq",
      sets.bar.color = c("#e29578", "#ffddd2", "#f1faee", "#e63946", "#fb8500"),
      main.bar.color = "#147d4b", matrix.color = "#147d4b", shade.color = "#ffc700"
      )
#ggsave("./5.png", www) ах да, как я мог забыть, что R очень удобен при построении графиков, поэтому не умеет их сохранять
png("./5.png")
www
dev.off()

## png 
##   2

www

Домашнее задание №7

ФББ - R - 2023

Георгий Муравьёв

Задание 1

Задание 2

Задание 3

Задание 4

Задание 5