Ваш коллега собрал данные о том, сколько людей появилось на своих рабочих местах в лаборатории за прошедшую неделю. Давайте изобразим эти данные в виде столбчатой диаграммы. Подпишите график, оси, добавьте цвета, поиграйте с дизайном. Обратите внимание, что дни недели на графике должны идти в правильном порядке (постарайтесь добиться этого самым кратким способом).
lab_people <- tibble(
day = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"),
n_people = c(3, 1, 11, 2, 5, 1, 0))
lab_people %>%
ggplot() +
aes(x = factor(day, levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")),
y = n_people) +
geom_bar(stat="identity", fill = "purple") +
labs(x = "Day of week", y = "Number of people", title = "People in lab")
Соседней лаборатории понравился эксперимент вашего коллеги и они тоже решили собрать данные о количестве людей на рабочих местах в разные дни. Теперь у вас есть данные из двух лабораторий, давайте их визуализируем на одном графике с помощью столбчатой диаграммы. Подпишите график, оси, добавьте цвета, поиграйте с дизайном. Дни недели на графике должны быть указаны в правильном порядке.
lab_people2 <- tibble(
lab = c("Great R Visualizations Lab", "The Neighbour's Lab"),
Monday = c(3, 5),
Tuesday = c(1, 9),
Wednesday = c(11, 7),
Thursday = c(2, 4),
Friday = c(5, 5),
Saturday = c(1, 4),
Sunday = c(0, 1))
lab_people2 %>%
pivot_longer(cols = c(Monday:Sunday), names_to = "day", values_to = "n_people") %>%
ggplot() +
aes(x = factor(day, levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")),
y = n_people,
fill = lab) +
geom_bar(stat="identity", position = "dodge") +
labs(x = "Day of week", y = "Number of people", title = "People in lab")
Прочитайте датасет про исчезнувшие виды растений по ссылке https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-08-18/plants.csv.
Изучите датасет!
Что в нем есть:
Больше информации о датасете по ссылке: https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-08-18/readme.md.
Постройте столбчатую диаграмму числа исчезнувших видов цветковых растений и не-цветковых растений на каждом континенте.
Пояснения:
forcats
.fucking_plants <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-08-18/plants.csv")
## Rows: 500 Columns: 24
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): binomial_name, country, continent, group, year_last_seen, red_list...
## dbl (18): threat_AA, threat_BRU, threat_RCD, threat_ISGD, threat_EPM, threat...
##
## ℹ 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_plants %>%
mutate(continent = fct_reorder(
continent, country, .fun = n_distinct, na.rm = TRUE, .desc = TRUE)) %>% #кажется, это должно расположить континенты в
#порядке убывания стран, но т.к. я в принципе
#не понимаю логику работы R это может не сработать
mutate(group = fct_other(factor(group), keep = "Flowering Plant", other_level = "Non-flowering plants")) %>%
filter(red_list_category == "Extinct") %>%
count(continent, group) %>%
ggplot() +
aes(x = fct_infreq(continent),
y = n,
fill = group) +
geom_bar(stat="identity", position = "dodge") +
scale_fill_manual(values = c("yellow", "green")) + #можно было бы сделать менее токсичный цвета, но график должен передавать
#боль, ощущаемую при выполнении д/з
labs(x = "Continent", y = "Number of extinct species", title = "Extinct plants") +
theme(legend.position = "top",
legend.title = element_blank()
)
Загрузите датасет, содержащий динамику использования сои в пищевой и непищевой промышленности за несколько последних десятков лет. Ссылка для скачивания: https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-04-06/soybean_use.csv.
Изучите датасет! Про него можно прочитать дополнительно, например, здесь: https://github.com/rfordatascience/tidytuesday/blob/master/data/2021/2021-04-06/readme.md.
Информация про датасет:
Отберите для анализа данные только по 6 континентам:
c("Africa", "Europe", "Asia", "Northern America", "South America", "Australia & New Zealand")
,
за 33 года - 1981-2013. Нарисуйте столбчатую диаграмму, которая бы
изображала среднее количество сои по трем типам промышленности,
использованной за 33 года на всех 6 обитаемых континентах. Изобразите
разброс 3/4 SD (чтобы линии разброса выровнялись со столбцами, возможно,
вам понадобится параметр
position = position_dodge(width = 0.9)
). Отсортируйте
континенты по среднему количеству сои, использованной во всех областях
промышленности за исследуемый период. Логарифмируйте ось Y с помощью
подходящей функции scale_y_*
. Измените формат числовых
подписей по оси Y.
Добавьте осознанные названия осей. Поверните названия континентов,
чтобы они отображались целиком, на 45 градусов. Уберите название легенды
и поменяйте цвета (например, на
c("#ffb4a2", "#e5989b", "#b5838d")
) и названия категорий
промышленности в легенде (чтобы было более приятно читать).
soybean <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-04-06/soybean_use.csv")
## Rows: 9897 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): entity, code
## dbl (4): year, human_food, animal_feed, processed
##
## ℹ 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.
soybean %>%
filter(entity %in% c("Africa", "Europe", "Asia", "Northern America", "South America", "Australia & New Zealand")) %>%
filter(year %in% 1981:2013) %>%
mutate(total = human_food + animal_feed + processed) %>%
pivot_longer(cols = c(human_food:processed), names_to = "type", values_to = "mass") %>%
ggplot() +
aes(x = fct_reorder(entity, total, .fun = mean, na.rm = TRUE, .desc = TRUE),
y = mass,
fill = type) +
geom_bar(stat = "summary", fun = "mean", position = "dodge") +
stat_summary(fun = mean,
fun.max = function(x) mean(x) + 0.75*sd(x),
fun.min = function(x) mean(x) - 0.75*sd(x),
geom = "errorbar", width = 0.5, position = position_dodge(width = 0.9)) +
scale_y_log10(labels = scales::label_number()) +
labs(x = element_blank(), y = "Average soy mass (t)", title = "Soybean use") +
scale_fill_manual(values = c("#ffb4a2", "#e5989b", "#b5838d"), labels=c('animal feed', 'human food', 'processed')) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.title = element_blank()
)
Напишите функцию, которая бы рассчитывала ядерно-цитоплазматическое соотношение (“N:C” или “karyoplasmic” ratio) по формуле \(\frac{NucleusVol}{CellVol}\), где NucleusVol - объем ядра (мкм3), CellVol - объем клетки (мкм3).
На небольшом примере продемонстрируйте работу этой функции.
NC_ratio <- function(NucleusVol, CellVol) {
NucleusVol / CellVol
}
NC_ratio(5, 15) #в натуре работает
## [1] 0.3333333
Прочитайте данные по размерам ядер и клеток разных организмов из разнообразных таксономических групп, они находятся по ссылке https://raw.githubusercontent.com/kirushka/datasets/main/NC_ratio.csv. Эти данные взяты из статьи Malerba et al. 2021.
В прочитанном датафрейме 4 столбца:
Используя функцию, которую вы создали в предыдущем задании, посчитайте ядерно-цитоплазматическое соотношение (“N:C” или “karyoplasmic” ratio) для каждого организма - запишите результат в новый столбец.
Также преобразуйте строковый столбец SpeciesGroup в столбец с факторами. Отсортируйте уровни фактора по убыванию медианного значения NC ratio.
df <- read_csv("https://raw.githubusercontent.com/kirushka/datasets/main/NC_ratio.csv")
## Rows: 1060 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): SpeciesGroup, Species
## dbl (2): NucleusVol, CellVol
##
## ℹ 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.
df_sorted <- df %>%
mutate(karyoplasmic_ratio = NC_ratio(df$NucleusVol, df$CellVol)) %>%
mutate(SpeciesGroup = fct_reorder(fct(SpeciesGroup), karyoplasmic_ratio, .fun = median, na.rm = TRUE, .desc = TRUE))
По модифицированному датафрейму постройте точковую диаграмму, на которой по оси X отложен объем клеток, по оси Y - NC ratio, цветом показана таксономическая группа.
Добавьте на график линии тренда, построенные с помощью линейной
регрессии, для каждой таксономической группы с помощью
geom_smooth(method = "lm")
.
Чтобы использовать на графиках “математические” обозначения,
греческие буквы и т.п., например, в подписях осей, можно использовать
функцию expression
, которой подать на вход все выражение
без кавычек. Например, так:
ggplot(...) + labs(x = expression(Cell~volume~(mu*m^3)))
.
Для настройки “tick labels”, т.е. подписей интервалов на осях, можно
использовать пакет scales. Например,
scale_x_log10(labels = scales::label_math(format = log10))
преобразит подписи по оси X в формат вида \(10^{log10(x)}\). Поэкспериментируйте и с
другими вариантами отображения этих подписей.
Поменяйте цветовую палитру графика.
df_sorted %>%
ggplot() +
aes(x = CellVol,
y = karyoplasmic_ratio,
colour = SpeciesGroup) +
geom_point() +
geom_smooth(method = "lm") +
labs(x = expression(Cell~volume~(mu*m^3)),
y = "N:C ratio") +
scale_x_log10(labels = scales::label_math(format = log10)) +
scale_y_log10(labels = scales::label_math(format = log10))
## `geom_smooth()` using formula = 'y ~ x'
#P.S. забавно, что для нуклеоидов бактерий видно глазами два кластера, котрые дадут хорошую регрессию
Разделите график из задания 4.3 на “панельки” с помощью
facet_wrap
, так чтобы каждая таксономическая группа
оказалась на своем графике.
df_sorted %>%
ggplot() +
aes(x = CellVol,
y = karyoplasmic_ratio,
colour = SpeciesGroup) +
geom_point() +
geom_smooth(method = "lm") +
labs(x = expression(Cell~volume~(mu*m^3)),
y = "N:C ratio") +
scale_x_log10(labels = scales::label_math(format = log10)) +
scale_y_log10(labels = scales::label_math(format = log10)) +
facet_wrap(vars(SpeciesGroup)) +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
Напишите несколько функций для моделирования подбрасывания кубика.
Напишите функцию, которая возвращает результат подбрасывания одного “честного” шестигранного кубика. Продемонстрируйте работу функции. Нужно ли устанавливать seed?
cub <- function() {
sample(1:6, 1, , replace = TRUE)
}
set.seed(42) #seed нужно устанавливать для воспроизводимости
cub()
## [1] 1
Напишите функцию, которая возвращает результат подбрасывания двух “честных” шестигранных кубиков. Продемонстрируйте работу функции.
double_cub <- function() {
sample(1:6, 2, , replace = TRUE)
}
set.seed(42)
double_cub()
## [1] 1 5
Напишите функцию, которая возвращает результат подбрасывания нескольких “честных” шестигранных кубиков. Число кубиков задается параметром n. Продемонстрируйте работу функции.
n_cub <- function(n) {
sample(1:6, n, , replace = TRUE)
}
set.seed(42)
n_cub(10)
## [1] 1 5 1 1 2 4 2 2 1 4
Напишите функцию, которая возвращает результат подбрасывания “честного” кубиков с заданным числом граней. Число граней задается параметром sides. Продемонстрируйте работу функции.
supercub <- function(sides) {
sample(1:sides, 1,, replace = TRUE)
}
set.seed(666)
supercub(32)
## [1] 30
Напишите функцию, которая возвращает результат подбрасывания нескольких “честного” кубиков с заданным числом граней. Число граней задается параметром sides (пусть по умолчанию оно будет равно 6). Число кубиков задается параметром n. Продемонстрируйте работу функции.
n_supercub <- function(n, sides=6) {
sample(1:sides, n, replace = TRUE)
}
set.seed(666)
n_supercub(10, 32)
## [1] 30 30 32 11 27 28 14 5 9 12