Домашнее задание №6
ФББ - R - 2023
Георгий Муравьёв
Задание 1
Задание 1.1
Из набора данных msleep отберите столбцы, согласно
следующим заданиям.
- Отберите колонку
nameи колонки, названия которых начинаются на “sleep” или оканчиваются на “wt” - Отберите колонки с названиями из вектора
c("name", "genus", "vore", "order", "conservation") - Отберите все колонки, содержащие числовые значения
- Пересортируйте колонки так, чтобы в начале шли столбцы
conservationиsleep_total
msleep %>%
select(name, starts_with("sleep"), ends_with("wt")) %>% #отберём
glimpse() #проверим, что отобрались правильные столбцы## Rows: 83
## Columns: 6
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greater short…
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10.1, 3.0, 5.…
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, 0.6, 0.8, 0…
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.3833333, NA…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07000, 0.…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490, 0.045…msleep %>%
select(c("name", "genus", "vore", "order", "conservation")) %>% #отберём
glimpse() #проверим, что отобрались правильные столбцы## Rows: 83
## Columns: 5
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greater shor…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "Bos", "Bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomorpha", "Art…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…msleep %>%
select(where(is.numeric)) %>% #отберём
glimpse() #проверим, что отобрались правильные столбцы## Rows: 83
## Columns: 6
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10.1, 3.0, 5.…
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, 0.6, 0.8, 0…
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.3833333, NA…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.9, 21.0, 18…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07000, 0.…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490, 0.045…msleep %>%
select(conservation, sleep_total, everything()) %>% #отберём
glimpse() #проверим, что отобрались правильные столбцы## Rows: 83
## Columns: 11
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10.1, 3.0, 5…
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greater shor…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "Bos", "Bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomorpha", "Art…
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, 0.6, 0.8, …
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.3833333, N…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.9, 21.0, 1…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07000, 0…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490, 0.04…Задание 1.2
Ранее чтобы трансформировать за раз несколько столбцов использовались
функции mutate_all, mutate_at и
mutate_if. Сейчас их все заменяет комбинация простого
mutate и функции across. Стоит иметь ввиду, что в таком
случае столбцы модифицируются, а не создаются новые (но можно создавать
и новые).
- Транформируйте все-все столбцы с помощью
tolower- функции, которая переводит весь текст (так ли это?) в строчные буквы. - Трансформируйте тем же образом только текстовые столбцы (characters).
- Трансформируйте столбцы, названия которых содержат слово “sleep”: переведите часы в минуты.
- Создайте новые столбцы, в которых все значения, выраженные в часах будут переведены в минуты.
- Логарифмируйте все числовые значения - трансформируйте уже существующие столбцы.
- Одновременно с переводом часов в минуты, логарифмируйте все числовые значения и создайте для транформированных значений новые колонки.
msleep %>%
mutate(across(everything(), tolower)) %>% #эта функция лох позорный числа тоже превращает в сТрОчНыЕ бУкВы
glimpse()## Rows: 83
## Columns: 11
## $ name <chr> "cheetah", "owl monkey", "mountain beaver", "greater shor…
## $ genus <chr> "acinonyx", "aotus", "aplodontia", "blarina", "bos", "bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "carnivora", "primates", "rodentia", "soricomorpha", "art…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…
## $ sleep_total <chr> "12.1", "17", "14.4", "14.9", "4", "14.4", "8.7", "7", "1…
## $ sleep_rem <chr> NA, "1.8", "2.4", "2.3", "0.7", "2.2", "1.4", NA, "2.9", …
## $ sleep_cycle <chr> NA, NA, NA, "0.133333333", "0.666666667", "0.766666667", …
## $ awake <chr> "11.9", "7", "9.6", "9.1", "20", "9.6", "15.3", "17", "13…
## $ brainwt <chr> NA, "0.0155", NA, "0.00029", "0.423", NA, NA, NA, "0.07",…
## $ bodywt <chr> "50", "0.48", "1.35", "0.019", "600", "3.85", "20.49", "0…msleep %>%
mutate(across(where(is.character), tolower)) %>% #что-бы функция делала то, что мы хотим, нужен костыль
glimpse()## Rows: 83
## Columns: 11
## $ name <chr> "cheetah", "owl monkey", "mountain beaver", "greater shor…
## $ genus <chr> "acinonyx", "aotus", "aplodontia", "blarina", "bos", "bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "carnivora", "primates", "rodentia", "soricomorpha", "art…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10.1, 3.0, 5…
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, 0.6, 0.8, …
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.3833333, N…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.9, 21.0, 1…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07000, 0…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490, 0.04…msleep %>%
mutate(across(contains("sleep"), ~ .x *60)) %>%
glimpse()## Rows: 83
## Columns: 11
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greater shor…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "Bos", "Bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomorpha", "Art…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…
## $ sleep_total <dbl> 726, 1020, 864, 894, 240, 864, 522, 420, 606, 180, 318, 5…
## $ sleep_rem <dbl> NA, 108, 144, 138, 42, 132, 84, NA, 174, NA, 36, 48, 42, …
## $ sleep_cycle <dbl> NA, NA, NA, 8, 40, 46, 23, NA, 20, NA, NA, 13, NA, 7, NA,…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.9, 21.0, 1…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07000, 0…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490, 0.04…msleep %>%
mutate(across(contains("sleep"), ~ .x *60, .names = "{.col}_in_min")) %>%
glimpse()## Rows: 83
## Columns: 14
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greate…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "Bos"…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi",…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomorpha"…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA,…
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10.1, …
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, 0.6,…
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.3833…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.9, 2…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, 0.07…
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20.490…
## $ sleep_total_in_min <dbl> 726, 1020, 864, 894, 240, 864, 522, 420, 606, 180, …
## $ sleep_rem_in_min <dbl> NA, 108, 144, 138, 42, 132, 84, NA, 174, NA, 36, 48…
## $ sleep_cycle_in_min <dbl> NA, NA, NA, 8, 40, 46, 23, NA, 20, NA, NA, 13, NA, …msleep %>%
mutate(across(where(is.numeric), log)) %>%
glimpse()## Rows: 83
## Columns: 11
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Greater shor…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "Bos", "Bra…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "herbi", "carn…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomorpha", "Art…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu", NA, "dome…
## $ sleep_total <dbl> 2.493205, 2.833213, 2.667228, 2.701361, 1.386294, 2.66722…
## $ sleep_rem <dbl> NA, 0.58778666, 0.87546874, 0.83290912, -0.35667494, 0.78…
## $ sleep_cycle <dbl> NA, NA, NA, -2.0149030, -0.4054651, -0.2657032, -0.958850…
## $ awake <dbl> 2.476538, 1.945910, 2.261763, 2.208274, 2.995732, 2.26176…
## $ brainwt <dbl> NA, -4.1669153, NA, -8.1456296, -0.8603831, NA, NA, NA, -…
## $ bodywt <dbl> 3.9120230, -0.7339692, 0.3001046, -3.9633163, 6.3969297, …msleep %>%
mutate(across(contains("sleep"), ~ .x *60, .names = "{.col}_in_min")) %>%
mutate(across(where(is.numeric), log, .names = "log_{.col}")) %>%
glimpse()## Rows: 83
## Columns: 23
## $ name <chr> "Cheetah", "Owl monkey", "Mountain beaver", "Gr…
## $ genus <chr> "Acinonyx", "Aotus", "Aplodontia", "Blarina", "…
## $ vore <chr> "carni", "omni", "herbi", "omni", "herbi", "her…
## $ order <chr> "Carnivora", "Primates", "Rodentia", "Soricomor…
## $ conservation <chr> "lc", NA, "nt", "lc", "domesticated", NA, "vu",…
## $ sleep_total <dbl> 12.1, 17.0, 14.4, 14.9, 4.0, 14.4, 8.7, 7.0, 10…
## $ sleep_rem <dbl> NA, 1.8, 2.4, 2.3, 0.7, 2.2, 1.4, NA, 2.9, NA, …
## $ sleep_cycle <dbl> NA, NA, NA, 0.1333333, 0.6666667, 0.7666667, 0.…
## $ awake <dbl> 11.9, 7.0, 9.6, 9.1, 20.0, 9.6, 15.3, 17.0, 13.…
## $ brainwt <dbl> NA, 0.01550, NA, 0.00029, 0.42300, NA, NA, NA, …
## $ bodywt <dbl> 50.000, 0.480, 1.350, 0.019, 600.000, 3.850, 20…
## $ sleep_total_in_min <dbl> 726, 1020, 864, 894, 240, 864, 522, 420, 606, 1…
## $ sleep_rem_in_min <dbl> NA, 108, 144, 138, 42, 132, 84, NA, 174, NA, 36…
## $ sleep_cycle_in_min <dbl> NA, NA, NA, 8, 40, 46, 23, NA, 20, NA, NA, 13, …
## $ log_sleep_total <dbl> 2.493205, 2.833213, 2.667228, 2.701361, 1.38629…
## $ log_sleep_rem <dbl> NA, 0.58778666, 0.87546874, 0.83290912, -0.3566…
## $ log_sleep_cycle <dbl> NA, NA, NA, -2.0149030, -0.4054651, -0.2657032,…
## $ log_awake <dbl> 2.476538, 1.945910, 2.261763, 2.208274, 2.99573…
## $ log_brainwt <dbl> NA, -4.1669153, NA, -8.1456296, -0.8603831, NA,…
## $ log_bodywt <dbl> 3.9120230, -0.7339692, 0.3001046, -3.9633163, 6…
## $ log_sleep_total_in_min <dbl> 6.587550, 6.927558, 6.761573, 6.795706, 5.48063…
## $ log_sleep_rem_in_min <dbl> NA, 4.682131, 4.969813, 4.927254, 3.737670, 4.8…
## $ log_sleep_cycle_in_min <dbl> NA, NA, NA, 2.079442, 3.688879, 3.828641, 3.135…Задание 1.3
Отберите строки из набора данных msleep по следующим
запросам.
- Оставьте только те строки, в которых все строковые значения не равны
NA. - Оставьте только те строки, где
name,genusилиorderначинаются на P. - Найдите тех животных, у которых значения
sleep_totalиawakeпримерно равны - отличаются максимум на 1 час.
msleep %>% head(3) #было## # A tibble: 3 × 11
## name genus vore order conservation sleep_total sleep_rem sleep_cycle awake
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Cheetah Acin… carni Carn… lc 12.1 NA NA 11.9
## 2 Owl mo… Aotus omni Prim… <NA> 17 1.8 NA 7
## 3 Mounta… Aplo… herbi Rode… nt 14.4 2.4 NA 9.6
## # ℹ 2 more variables: brainwt <dbl>, bodywt <dbl>msleep %>%
filter(if_all(where(is.character), ~ !is.na(.x))) %>%
head(3) #стало## # A tibble: 3 × 11
## name genus vore order conservation sleep_total sleep_rem sleep_cycle awake
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Cheetah Acin… carni Carn… lc 12.1 NA NA 11.9
## 2 Mounta… Aplo… herbi Rode… nt 14.4 2.4 NA 9.6
## 3 Greate… Blar… omni Sori… lc 14.9 2.3 0.133 9.1
## # ℹ 2 more variables: brainwt <dbl>, bodywt <dbl>msleep %>%
filter(if_any(c("name", "genus", "order"), ~ grepl("^P", .x)))## # A tibble: 31 × 11
## name genus vore order conservation sleep_total sleep_rem sleep_cycle awake
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Owl m… Aotus omni Prim… <NA> 17 1.8 NA 7
## 2 Three… Brad… herbi Pilo… <NA> 14.4 2.2 0.767 9.6
## 3 Grivet Cerc… omni Prim… lc 10 0.7 NA 14
## 4 Asian… Elep… herbi Prob… en 3.9 NA NA 20.1
## 5 Horse Equus herbi Peri… domesticated 2.9 0.6 1 21.1
## 6 Donkey Equus herbi Peri… domesticated 3.1 0.4 NA 20.9
## 7 Patas… Eryt… omni Prim… lc 10.9 1.1 NA 13.1
## 8 Galago Gala… omni Prim… <NA> 9.8 1.1 0.55 14.2
## 9 Pilot… Glob… carni Ceta… cd 2.7 0.1 NA 21.4
## 10 Human Homo omni Prim… <NA> 8 1.9 1.5 16
## # ℹ 21 more rows
## # ℹ 2 more variables: brainwt <dbl>, bodywt <dbl>#в идеальном мире оно должно работать одинаково, но в реальном мире существует R, поэтому оставлю оба варианта
msleep %>%
filter(near(sleep_total, awake, tol = 1))## # A tibble: 1 × 11
## name genus vore order conservation sleep_total sleep_rem sleep_cycle awake
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Cheetah Acin… carni Carn… lc 12.1 NA NA 11.9
## # ℹ 2 more variables: brainwt <dbl>, bodywt <dbl>msleep %>%
filter(abs(sleep_total - awake) <= 1)## # A tibble: 6 × 11
## name genus vore order conservation sleep_total sleep_rem sleep_cycle awake
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Cheetah Acin… carni Carn… lc 12.1 NA NA 11.9
## 2 Chinch… Chin… herbi Rode… domesticated 12.5 1.5 0.117 11.5
## 3 Domest… Felis carni Carn… domesticated 12.5 3.2 0.417 11.5
## 4 House … Mus herbi Rode… nt 12.5 1.4 0.183 11.5
## 5 Deer m… Pero… <NA> Rode… <NA> 11.5 NA NA 12.5
## 6 Arctic… Vulp… carni Carn… <NA> 12.5 NA NA 11.5
## # ℹ 2 more variables: brainwt <dbl>, bodywt <dbl>Задание 1.4
Сгруппируйте датафрейм по переменной vore и посчитайте
средние и максимальные значения по всем числовым признакам.
msleep %>%
group_by(vore) %>%
summarise(across(where(is.numeric), list(mean = mean, max = max), na.rm = TRUE))## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(where(is.numeric), list(mean = mean, max = max), na.rm =
## TRUE)`.
## ℹ In group 1: `vore = "carni"`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
##
## # Previously
## across(a:b, mean, na.rm = TRUE)
##
## # Now
## across(a:b, \(x) mean(x, na.rm = TRUE))## # A tibble: 5 × 13
## vore sleep_total_mean sleep_total_max sleep_rem_mean sleep_rem_max
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 carni 10.4 19.4 2.29 6.6
## 2 herbi 9.51 16.6 1.37 3.4
## 3 insecti 14.9 19.9 3.52 6.1
## 4 omni 10.9 18 1.96 4.9
## 5 <NA> 10.2 13.7 1.88 2.7
## # ℹ 8 more variables: sleep_cycle_mean <dbl>, sleep_cycle_max <dbl>,
## # awake_mean <dbl>, awake_max <dbl>, brainwt_mean <dbl>, brainwt_max <dbl>,
## # bodywt_mean <dbl>, bodywt_max <dbl>Задание 2
Воспользуйтесь набором данных starwars - он доступен из пакета tidyverse. Этот набор данных содержит информацию о персонажах вселенной Звездных Войн (взглянить в справку о датасете, чтобы узнать детали).
Посчитайте в скольки фильмах появлялся каждый из персонажей, а также определите был ли он героем эпизода “Новая надежда” (A New Hope). Поскольку столбец films (а также столбцы vehicles и starships) являются не просто столбцами, а столбцами-списками (list columns), то есть представляют из себя не обычные простые вектора, а списки. Столбец films можно представить как список, в котором каждый элемент - это значение в каждой следующей строке датафрейма, и элемент этого списка является строковым вектором. Из-за такой сложной структуры столбца для работы с ним имеет смысл использовать функции семейства map (они отлично справляются со списками). Map можно (и нужно) использовать при создании новых столбцов (с информацией о количестве фильмов и т.д.) с помощью mutate.
После того, как вы справились с подсчетами, оставьте только персонажей, которые были в эпизоде “Новая надежда” и постройте график дотплот с помощью geom_point(), который бы показывал, какие персонажи разных рас (species) в скольких фильмах появлялись. По оси X - число фильмов, по Y - раса (species), каждая точка - один персонаж. Цветом точки продублируйте информацию о расе, размером точки - число фильмов. Подпишите каждую точку - добавьте на график имена персонажей.
Сделайте график понятным (подпишите названия осей, добавьте название и т.д.) и визуально приятным.
starwars %>%
mutate(n_films = map_int(films, length),
a_new_hope = map_lgl(films, ~ "A New Hope" %in% .x)) %>%
filter(a_new_hope == TRUE) %>%
ggplot() +
aes(x = n_films,
y = species,
colour = species,
size = n_films) +
geom_point() +
ggrepel::geom_text_repel(mapping = aes(label = name), size = 3) +
labs(x = "Number of films",
y = "Species",
title = "The characters of STARWARS: A NEW HOPE") +
theme(legend.position = "none")
Задание 3
Скачайте данные про лемуров (lemurs.zip) - https://github.com/kirushka/datasets/raw/main/splitted%20datasets/lemurs.zip. Скачайте и разархивируйте файл в свою рабочую директорию (для этого использовать R не нужно, делайте это как вам привычнее). В папке weights лежат таблицы с 3-мя измерениями веса разных лемуров. Данные по каждому лемуру содержатся в своем файле. Прочитайте эти данные и объедините их в один датафрейм. Не потеряйте информацию об имени лемура (содержится в названии файла).
Объедините данные о весе лемуров с более обширными данными с их биографическими данными - они содержатся в файле lemur_info.csv.
С помощью линейной диаграммы изобразите изменение массы тела лемуров (отберите только тех лемуров, для которых есть данные по всем трем временным точкам измерения массы тела). Цветом линий отобразите пол животных.
Сделайте график понятным (подпишите названия осей, добавьте название и т.д.) и визуально приятным.
lemur_info <- read_csv("./lemurs/lemur_info.csv", show_col_types = FALSE)
fucking_func <- function(name) {
read_tsv(paste("./lemurs/weights/", name, ".tsv", sep=""), show_col_types = FALSE) %>%
mutate(name = name) #%>%
#pivot_wider(names_from = weight_date, values_from = weight) без этого неудобно читать таблицу глазами, зато легче строиь график
}
file <- map_dfr(lemur_info$name, fucking_func)
lemur_info %>%
left_join(file, by = "name") %>%
drop_na() %>%
ggplot() +
aes(x = weight_date,
y = weight,
colour = sex,
group = name) +
geom_line() +
geom_point() +
labs(x = "Measurement number",
y = "Body mass (g)") +
scale_x_discrete(labels=c('1', '2', '3')) +
theme(legend.position = "top")
Задание 4
Задание 4.1
В этом и последующих заданиях вы будете использовать датасет, полученный в результате секвенирования РНК единичных клеток. Вам понадобятся объединенная таблица с экспрессиями (каунтами) разных генов и таблица с метаданными. Эти данные можно скачать в виде zip по ссылке https://raw.githubusercontent.com/kirushka/datasets/main/scrna.zip. Разархивируйте файл в свою рабочую директорию (для этого использовать R не нужно, делайте это как вам привычнее).
Датасет состоит из нескольких частей:
- в папке counts - таблицы с экспрессией генов (таблица с каунтами) - всего 13714 гена x 600 клеток. В каждом файле данные по 100 клеткам. Столбец gene содержит символьные обозначения генов, названия остальных столбцов - это идентификаторы индивидуальных клеток.
- cells_metadata.tsv - метаданные - аннотация клеток по типам.
Создайте список фалов с таблицами с каунтами и, используя
map, прочитайте все файлы в один датафрейм (соединяя
индивидуальные датафреймы по столбцам - из 6 датафреймов размера 13714 х
101 у вас должен получиться одни датафрейм размера 13714 х 601).
Старайтесь не самостоятельно задавать названия нужных файлов, а
например, пользоваться функциями, которые выдают названия всех или не
всех файлов в директории.
Выведите названия всех столбцов, содержащих тип данных
character.
Если использованный вами подход привел к тому, что у вас появилось несколько дублирующихся столбцов с названиями генов, то отберите для дальнейшей работы только один столбец с именами генов и все столбцы с каунтами.
Сохраните полученный датафрейм в текстовый файл.
file <- map_dfc(list.files("./scrna/counts", full.names = TRUE), read_tsv, show_col_types = FALSE)## New names:
## • `gene` -> `gene...1`
## • `gene` -> `gene...102`
## • `gene` -> `gene...203`
## • `gene` -> `gene...304`
## • `gene` -> `gene...405`
## • `gene` -> `gene...506`file %>%
select(where(is.character)) %>%
colnames() #этот нехороший R действительно сделал не то, что я хотел и сделал дубликаты столбца генов. Почему он настолько неюзер-френдли?## [1] "gene...1" "gene...102" "gene...203" "gene...304" "gene...405"
## [6] "gene...506"file %>%
transmute(gene = gene...1, across(!where(is.character))) %>%
write_tsv("./scrna/counts.tsv")Задание 4.2
Прочитайте полученный в предыдущем задании датафрейм и метаданные к
нему (лежат рядом с папкой counts/).
Используя датафрейм с метаданными о клетках, случайным образом отберите по 25 клеток каждого типа (B cells, T cells и Monocytes).
Используя подвыборку, состоящую из отобранных клеток, удалите из данных экспрессии гены, которые имеют значение 0 во всех клетках. Посчитайте среднюю экспрессию и стандартное отклонение экспрессии для каждого гена (это может занять некоторое время). Оставьте только те гены, у которых средняя экспрессия выше 0.1. Возьмите 100 генов с самой вариабельной экспрессией (высоким стандартным отклонением) и случайным образом выберите 25 генов. Сохраните полученный датафрейм в текстовый файл.
Не бойтесь разбивать это задание на несколько шагов и записывать промежуточные результаты в отдельные переменные.
В итоге у вас должен получиться датасет из 75 клеток и 25 генов.
cells_metadata <- read_tsv("./scrna/cells_metadata.tsv", show_col_types = FALSE)
df <- read_tsv("./scrna/counts.tsv", show_col_types = FALSE)
set.seed(666)
selected_cells <- cells_metadata %>%
group_by(cell_type) %>%
sample_n(25)
df %>%
select(gene, selected_cells$cell_id) %>%
filter(if_any(where(is.numeric), ~ !(.x==0))) %>%
rowwise() %>% #без этого костыля R считает абсолютно никому не нужное среднее и отклонение по АБСОЛЮТНО ВСЕМ ячейкам
mutate(
avg_expression = mean(c_across(where(is.numeric)), na.rm = TRUE),
sd_expression = sd(c_across(where(is.numeric)), na.rm = TRUE)) %>%
filter(avg_expression > 0.1) %>%
arrange(desc(sd_expression)) %>%
head(100) %>%
ungroup() %>% #а без этого костыля R думает, что у него не одна таблица из 100 строк, а 100 таблиц из одной строки и поэтому не может сделать выборку
sample_n(25) %>%
select(!avg_expression:sd_expression) %>% #таки удалим столбцы в которых мы считали среднее и отклонение
write_tsv("./scrna/selected_counts.tsv")
#отобранное похоже на правду, сделал почти всё одним конвейром, чтобы не захламлять память, а то RStudio хочет съесть непозволительно много оперативкиЗадание 4.3
Прочитайте датасет из 75 клеток и 25 генов, полученный в предыдущем задании. Также вам понадобятся метаданные.
Выберите 2 любых гена из вашего датасета и постройте точковую диаграмму, показывающую экспрессию этих генов в отобранных клетках. Цветом отобразите уровень экспрессии любого гена (используйте градиент) и формой точек укажите тип клеток (cell_type).
Для создания такого графика вам необходимо будет привести данные в
нужный формат (используйте функции
pivot_longer/pivot_wider) и объединить
датафрейм со значениями экспрессии генов и метаданными.
Сохраните график.
selected_counts <- read_tsv("./scrna/selected_counts.tsv", , show_col_types = FALSE)
selected_counts %>%
pivot_longer(cols = -gene, names_to = "cell_id", values_to = "expression") %>%
left_join(cells_metadata, by = "cell_id") %>%
pivot_wider(names_from = gene, values_from = expression) %>%
#возьму гены как в примере, чтобы по графиу понять точно ли код делает то, что я ожидаю
#а нет не возьму, я же не знаю, какой seed был в примере (коротко о воспроизводимости эксперимета)
#грусто, что нельзя приисвоить значение нескольким переменным, распаковав каккую нибудь структуру вроде кортежа в Python
ggplot() +
aes(x = TMSB4X,
y = RPS6,
colour = MYL6,
shape = cell_type) +
geom_point() +
scale_color_gradient(low = "blue", high = "red")