Язык R и его применение в биоинформатике

class: center, middle, inverse, title-slide

# Язык R и его применение в биоинформатике
### Анна Валяева
### 07.10.2022

---

# Векторизация

Многие функции в R приспособлены к работе с векторами и итерации по элементам вектора. Благодаря этому нам не нужно лишний раз писать циклы.

.pull-left[

```r
1:5 * 2
```

```
[1]  2  4  6  8 10
```

```r
1:5 > 3
```

```
[1] FALSE FALSE FALSE  TRUE  TRUE
```
]

.pull-right[

```r
vec <- 1:5
out_vec <- c()

for (i in 1:length(vec)) {
  out_vec[i] = vec[i] * 2
}

out_vec
```

```
[1]  2  4  6  8 10
```
]

---
# Как избегать циклов?

Можно использовать функции из семейства `apply`:

- `apply()`
- `lapply()`
- `sapply()`
- `tapply()`

---
# Как избегать циклов?

Если нужно применить функцию к элементам некоторого списка, то используйте `map` из пакета **{purrr}** (входит в **{tidyverse}**).

```r
# вместо
for (i in 1:3){
  f(i)
}

# или
list(f(1), f(2), f(3))

# нужно всего лишь...
map(1:3, f)
```

.pull-left[

```r
library(purrr)
# library(tidyverse)
```
]

.pull-right[
<img src="data:image/png;base64,#img/purrr/purrr.png" width="35%" style="display: block; margin: auto;" />
]

---
# Семейство функций map

.pull-left[

```r
cube <- function(x) x ** 3

map(1:3, cube)
```

```
[[1]]
[1] 1

[[2]]
[1] 8

[[3]]
[1] 27
```
]

--
.pull-right[
<img src="data:image/png;base64,#img/purrr/map.png" width="100%" style="display: block; margin: auto;" />
]

---
# Разные map_

- Простой `map()` всегда возвращает list.
- Если вы уверены, что ваш результат подходит под определение вектора (данные одного типа), используйте `map_`:

- `map_chr`
  - `map_lgl`
  - `map_int`
  - `map_dbl`

```r
map_dbl(1:3, cube)
```

```
[1]  1  8 27
```

---
# Разные map_

```r
map_chr(mtcars, typeof)
```

```
     mpg      cyl     disp       hp     drat       wt     qsec       vs 
"double" "double" "double" "double" "double" "double" "double" "double" 
      am     gear     carb 
"double" "double" "double" 
```

```r
map_lgl(mtcars, is.double)
```

```
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 
```

```r
map_int(mtcars, n_distinct)
```

```
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
  25    3   27   22   22   29   30    2    2    3    6 
```

---
# Anonymous functions / lambda functions

```r
# Если забыли про n_distinct из dplyr:
map_dbl(mtcars, function(x) length(unique(x)))
```

```
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
  25    3   27   22   22   29   30    2    2    3    6 
```

```r
# Лень писать так много. Так проще:
map_dbl(mtcars, ~ length(unique(.x)))
```

```
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
  25    3   27   22   22   29   30    2    2    3    6 
```

---
# map_df

- `map_dfr` - это `map()` + `bind_rows()`
- `map_dfc` - это `map()` + `bind_cols()`

```r
input_files <- c("file1.csv", "file2.csv", "file3.csv")
```
--
.pull-left[

```r
file1 <- read_csv("file1.csv")
file2 <- read_csv("file2.csv")
file3 <- read_csv("file3.csv")

file <- bind_rows(file1, file2, file3)
```
]

--
.pull-right[

```r
file <- map_dfr(input_files, read_csv)
```
]

---
# map ❤️ списки

```r
x <- list(
  list(-1, x = 1, y = c(2), z = "a"),
  list(-2, x = 4, y = c(5, 6), z = "b"),
  list(-3, x = 8, y = c(9, 10, 11)))

map_dbl(x, "x") # по имени элемента
```

```
[1] 1 4 8
```

```r
map_dbl(x, list("y", 1)) # по позиции
```

```
[1] 2 5 9
```

```r
map_chr(x, "z", .default = NA) 
```

```
[1] "a" "b" NA 
```

---
# Аргументы функции

.pull-left[

```r
x <- list(1:5, c(1:10, NA))

# Не очень
map_dbl(x, ~ mean(.x, na.rm = TRUE))
```

```
[1] 3.0 5.5
```

```r
# Получше
map_dbl(x, mean, na.rm = TRUE)
```

```
[1] 3.0 5.5
```
]

.pull-right[
<img src="data:image/png;base64,#img/purrr/map-arg.png" width="100%" style="display: block; margin: auto;" />

]

---
# map2

- Если нужно итерировать и по элементам списка, и по вектору аргумента функции.

```r
xs <- map(1:8, ~ runif(10))
ws <- map(1:8, ~ rpois(10, 5) + 1)

map2_dbl(xs, ws, weighted.mean, na.rm = TRUE)
```

```
[1] 0.5223693 0.5402174 0.2793727 0.5177526 0.5010280 0.5140166 0.5045199
[8] 0.4797214
```

---
# pmap

- Когда не хватает `map2`, а нужен `map3` или даже `map4`...
- Нужно подать список всех аргументов функции.
- `map2(x, y, f)` - то же, что и `pmap(list(x, y), f)`.

```r
pmap_dbl(list(xs, ws), weighted.mean)
```

```
[1] 0.5223693 0.5402174 0.2793727 0.5177526 0.5010280 0.5140166 0.5045199
[8] 0.4797214
```

---
# imap

- `imap(x, f)` - то же, что и `map2(x, seq_along(x), f)` или `map2(x, names(x), f)`

```r
# .y - это название элемента списка
# .x - элемент списка
x <- map(1:6, ~ sample(1000, 10))
imap_chr(x, ~ paste0("The highest value of ", .y, " is ", max(.x)))
```

```
[1] "The highest value of 1 is 793" "The highest value of 2 is 976"
[3] "The highest value of 3 is 982" "The highest value of 4 is 678"
[5] "The highest value of 5 is 948" "The highest value of 6 is 789"
```

---
# `walk`

.pull-left[

```r
ggplots <- list(gg1, gg2, gg3)
output_files <- c("plot1.png", "plot2.png", "plot3.png")

walk2(output_files, ggplots, ggsave)
```
]

.pull-right[
<img src="data:image/png;base64,#img/purrr/walk.png" width="50%" style="display: block; margin: auto;" />

]

---
# Семейство функций reduce

`reduce()` берет на вход вектор длины n и возвращает вектор длины 1, применяя функцию к элементам вектора попарно.

Удобно, если надо объединить несколько датафреймов.

.pull-left[

```r
# вместо
f(f(f(1, 2), 3), 4)

# нужно всего лишь...
reduce(1:4, f)
```
]

.pull-right[
<img src="data:image/png;base64,#img/purrr/reduce-arg.png" width="80%" style="display: block; margin: auto;" />
]

---
# reduce2

Если нужно, например, объединить несколько датафреймов, но использовать разные переменные, по которым делать объединение.

---
# Отслеживать и ловить ошибки

- `safely()` возвращает список из двух элементов: 
  - `result` нужный результат или NULL если была ошибка,
  - `error` error object или NULL, если ошибки не было.

- `possibly()` позволяет использовать default value, если возникает ошибка.

- `quietly()` выдает result, output, messages и warnings.

---
# `safely`

```r
# можно воспринимать safely() как наречие, а функцию log() как глагол
safe_log <- safely(log)
str(safe_log(10))
```

```
List of 2
 $ result: num 2.3
 $ error : NULL
```

```r
str(safe_log("a"))
```

```
List of 2
 $ result: NULL
 $ error :List of 2
  ..$ message: chr "non-numeric argument to mathematical function"
  ..$ call   : language .Primitive("log")(x, base)
  ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
```

---
# safely

`safely()` удобно использовать вместе с `map`.

```r
x <- list(1, 10, "a")
y <- x %>% map(safely(log))
str(y)
```

```
List of 3
 $ :List of 2
  ..$ result: num 0
  ..$ error : NULL
 $ :List of 2
  ..$ result: num 2.3
  ..$ error : NULL
 $ :List of 2
  ..$ result: NULL
  ..$ error :List of 2
  .. ..$ message: chr "non-numeric argument to mathematical function"
  .. ..$ call   : language .Primitive("log")(x, base)
  .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
```

---
# safely

Можно отделить результаты от ошибок.

```r
y <- transpose(y)
str(y)
```

```
List of 2
 $ result:List of 3
  ..$ : num 0
  ..$ : num 2.3
  ..$ : NULL
 $ error :List of 3
  ..$ : NULL
  ..$ : NULL
  ..$ :List of 2
  .. ..$ message: chr "non-numeric argument to mathematical function"
  .. ..$ call   : language .Primitive("log")(x, base)
  .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
```

Затем определить элементы, которые вызвали ошибку.

```r
is_ok <- y$error %>% map_lgl(is_null)
x[!is_ok]
```

```
[[1]]
[1] "a"
```

---
# possibly

Позволяет использовать default value, если возникает ошибка.

```r
x <- list(1, 10, "a")
x %>% map_dbl(possibly(log, otherwise = NA_real_))
```

```
[1] 0.000000 2.302585       NA
```

---
# quietly

`quietly` собирает не ошибки, а предупреждения и сообщения.

```r
x <- list(1, -1)
x %>% map(quietly(log)) %>% str()
```

```
List of 2
 $ :List of 4
  ..$ result  : num 0
  ..$ output  : chr ""
  ..$ warnings: chr(0) 
  ..$ messages: chr(0) 
 $ :List of 4
  ..$ result  : num NaN
  ..$ output  : chr ""
  ..$ warnings: chr "NaNs produced"
  ..$ messages: chr(0) 
```

---
# Что почитать про функции и purrr

- [Functions Chapter in R4DS](https://r4ds.had.co.nz/functions.html)

- [Functions Chapter in Advanced R](https://adv-r.hadley.nz/functions.html)

- [purrr cheatsheet](https://github.com/rstudio/cheatsheets/blob/master/purrr.pdf)

- [Functional Chapter in Advanced R](https://adv-r.hadley.nz/functionals.html)

- [purrr tutorial by Jenny Bryan](https://jennybc.github.io/purrr-tutorial/index.html)

- Картинки, иллюстрирующие принцип работы функций из **purrr**, взяты из 'Advanced R' by Hadley Wickham.

---
# Градиенты

- `scale_color_gradient`
- `scale_color_gradient2`
- `scale_color_gradientn`

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), size = 3) +
* scale_color_gradient(low = "blue", high = "red")
```

---
# Градиенты: breaks & labels

- `scale_color_gradient`
- `scale_color_gradient2`
- `scale_color_gradientn`

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), size = 3) +
  scale_color_gradient(low = "blue", high = "red",
*   breaks = c(30, 40, 50, 60), limits = c(30, 60))
```

---
# Цветовые палитры

## R пакеты

- {ggplot2} - viridis
- {RColorBrewer}
- [{tvthemes}](https://github.com/Ryo-N7/tvthemes)
- [{ggsci}](https://cran.r-project.org/web/packages/ggsci/vignettes/ggsci.html)
- [{MetBrewer}](https://github.com/BlakeRMills/MetBrewer/tree/main)
- [{wesanderson}](https://github.com/karthik/wesanderson)
- ...

## Сайты

- [coolors.co](https://coolors.co/)
- ...

---
# Цветовые палитры

### viridis

- `scale_color_viridis_c` для непрерывных переменных
- `scale_color_viridis_d` для дискретных переменных
- `scale_color_viridis_b` для бинированных переменных

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), size = 3) +
* scale_color_viridis_c()
```

---
# Цветовые палитры

## RColorBrewer

- `scale_color_brewer` для дискретных переменных
- `scale_color_distiller` для непрерывных переменных

---
# Цветовые палитры

## RColorBrewer

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), size = 3) +
* scale_color_distiller(palette = "RdYlBu", direction = -1)
```

---
# Несколько легенд

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
* geom_point(aes(color = bill_length_mm, shape = species), size = 3) +
  guides(
*   shape = guide_legend(order = 1, title = "Species"),
*   color = guide_colorbar(order = 2, title = "Bill length (mm)")) +
  scale_color_gradient(low = "blue", high = "red")
```

---
# Несколько легенд

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm, shape = species), size = 3) + 
  guides(
    shape = guide_legend(order = 1, title = "Species"),
*   color = "none") +
  scale_color_gradient(low = "blue", high = "red")
```

---
# Несколько легенд

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm, shape = species), size = 3) + 
  guides(
*   shape = guide_legend(order = 1, title = "Species", reverse = TRUE),
    color = "none") + 
  scale_color_gradient(low = "blue", high = "red")
```

---
# Цвет по условию

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm > 50), size = 3)
```

---
# Цвет по условию...

```r
penguins %>% 
  mutate(bill_group = case_when(
    (bill_length_mm < 45) ~ "small",
    (bill_length_mm >= 55) ~ "large",
    TRUE ~ "medium")) %>% 
  ggplot(aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_group), size = 3)
```

---
# Цвет по условию...

---
# Подписи

```r
sample_10 <- slice_sample(penguins, n = 10)

ggplot(sample_10, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), alpha = 0.5, size = 3) +
  # Наследует aes X и Y
  geom_text(mapping = aes(label = island), size = 5) 
```

---
# Подписи с {ggrepel}

```r
ggplot(sample_10, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), alpha = 0.5, size = 3) +
  ggrepel::geom_text_repel(mapping = aes(label = island), size = 5) 
```

---
# Подписи с {ggrepel}

```r
ggplot(sample_10, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), alpha = 0.5, size = 3) +
  ggrepel::geom_label_repel(mapping = aes(label = island), size = 5) 
```

---
# Аннотация с {ggforce}

```r
drop_na(penguins, bill_length_mm, bill_depth_mm) %>% 
  ggplot(aes(bill_length_mm, bill_depth_mm)) + 
  ggforce::geom_mark_ellipse(aes(fill = species, label = species)) +
  geom_point() + theme(legend.position = "none") +
  scale_x_continuous(expand = expansion(mult = .4)) +
  scale_y_continuous(expand = expansion(mult = .4))
```

---
class: top, center
background-image: url("data:image/png;base64,#img/ggplot2/ggext.png")
background-size: contain

# Ggplot2 extensions

## https://exts.ggplot2.tidyverse.org/

---
# Шрифты

Пакеты: {showtext}, {extrafont}, ...

Чтобы сработало в RMarkdown: `{r fig.showtext=TRUE}`

```r
library(showtext)
## Загрузить шрифты из Google fonts (https://fonts.google.com/)
font_add_google("Gochi Hand", "gochi")
font_add_google("Schoolbell", "bell")

## Использовать showtext автоматически
showtext_auto()

ggplot(penguins, aes(bill_length_mm, bill_depth_mm, color = species)) + 
  geom_point() +
  labs(x = "Bill length (mm)", y = "Bill depth (mm)", 
       title = "Penguins from Antarctics") +
  theme(
    text =  element_text(family = "bell", size = 14),
    plot.title = element_text(family = "gochi", size = rel(1.6), hjust = 0.5))
```

---
# Комбинирование графиков

[Patchwork manual](https://patchwork.data-imaginist.com/index.html)
[Cowplot manual](https://cran.r-project.org/web/packages/cowplot/vignettes/introduction.html)

```r
library(patchwork)

p1 <- ggplot(penguins) + geom_point(aes(bill_length_mm, bill_depth_mm, color = species))
p2 <- ggplot(penguins) + geom_density(aes(body_mass_g, fill = species))

*p1 + p2 +
  plot_annotation(
    tag_levels = 'A',
    title = "Penguins from {palmerpenguins}",
    subtitle = "These 2 plots reveal yet-untold secrets about our beloved dataset",
    caption = "Data: {palmerpenguins}. 2022-03-18")
```

---
# Комбинирование графиков

```r
*p1 + p2 +
  plot_annotation( 
    tag_levels = 'A', 
    title = "Penguins from {palmerpenguins}",
    subtitle = "These 2 plots reveal yet-untold secrets about our beloved dataset", 
    caption = "Data: {palmerpenguins}. 2022-03-18") 
```

---
# Zoom: xlim & ylim

```r
ggplot(penguins, aes(x = body_mass_g, y = flipper_length_mm)) + 
  geom_point(aes(color = bill_length_mm), size = 3) +
  scale_color_gradient(low = "blue", high = "red") +
* xlim(2000, 5000) + ylim(170, 200)
```

---
# Безопасный zoom

---
# Линия тренда

```r
ggplot(penguins, aes(bill_length_mm, bill_depth_mm, color = species)) +
  geom_point() +
* geom_smooth(method = "lm", se = FALSE)
```

---
# Zoom

.pull-left[

### Плохо

```r
ggplot(penguins, aes(bill_length_mm, bill_depth_mm, color = species)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
* xlim(30, 50) + ylim(15, 20)
```

]

.pull-right[

### Хорошо

```r
ggplot(penguins, aes(bill_length_mm, bill_depth_mm, color = species)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
* coord_cartesian(xlim = c(30, 50), ylim = c(15, 20))
```

]

---
# Дополнительные линии

- `geom_abline`
- `geom_hline`
- `geom_vline`

---
# ggpubr

## Результаты статистических тестов

```r
library(ggpubr)
ggbarplot(penguins, x = "species", y = "flipper_length_mm", fill = "species", add = "mean_sd") +
  stat_compare_means(method = "anova")
```

---
# Lollipop plot

```r
ggplot(penguins, aes( 
    x = as.numeric(rownames(penguins)),
    y = body_mass_g, color = species)) +
* ggalt::geom_lollipop() +
  theme(legend.position = "none", axis.text.x = element_text(angle = 30, hjust = 1)) 
```

---
# Raincloud plot

```r
ggplot(drop_na(penguins), 
       aes(x = species, y = body_mass_g, color = species)) +
  # половинка violin
  ggdist::stat_halfeye(
    adjust = 0.5, width = 0.6, .width = 0,
    justification = -0.2, point_colour = NA) +
  # боксплот
  geom_boxplot(width = 0.2, outlier.shape = NA) +
  # точки
  gghalves::geom_half_point(side = "l", range_scale = 0.5, alpha = 0.3)
```

---
# Ridgeline plot

```r
ggplot(penguins, 
       aes(x = body_mass_g, y = species, fill = species)) +
  ggridges::geom_density_ridges(alpha = 0.7) 
```

---
# Круговая диаграмма

```r
penguins %>% 
  count(island) %>% 
  ggplot(aes(x = "", y = n, fill = island)) +
  geom_bar(stat = "identity", width = 1, color="white") +
  coord_polar("y", start = 0)
```

---
# Тепловая карта

- `geom_tile` из **ggplot2**
- `heatmap.2` из **gplots**
- `pheatmap` из **pheatmap** <svg aria-hidden="true" role="img" viewBox="0 0 576 512" style="height:1em;width:1.12em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#b74f6f;overflow:visible;position:relative;"><path d="M280.37 148.26L96 300.11V464a16 16 0 0 0 16 16l112.06-.29a16 16 0 0 0 15.92-16V368a16 16 0 0 1 16-16h64a16 16 0 0 1 16 16v95.64a16 16 0 0 0 16 16.05L464 480a16 16 0 0 0 16-16V300L295.67 148.26a12.19 12.19 0 0 0-15.3 0zM571.6 251.47L488 182.56V44.05a12 12 0 0 0-12-12h-56a12 12 0 0 0-12 12v72.61L318.47 43a48 48 0 0 0-61 0L4.34 251.47a12 12 0 0 0-1.6 16.9l25.5 31A12 12 0 0 0 45.15 301l235.22-193.74a12.19 12.19 0 0 1 15.3 0L530.9 301a12 12 0 0 0 16.9-1.6l25.5-31a12 12 0 0 0-1.7-16.93z"/></svg>
- `Heatmap` из **ComplexHeatmap** <svg aria-hidden="true" role="img" viewBox="0 0 576 512" style="height:1em;width:1.12em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#b74f6f;overflow:visible;position:relative;"><path d="M280.37 148.26L96 300.11V464a16 16 0 0 0 16 16l112.06-.29a16 16 0 0 0 15.92-16V368a16 16 0 0 1 16-16h64a16 16 0 0 1 16 16v95.64a16 16 0 0 0 16 16.05L464 480a16 16 0 0 0 16-16V300L295.67 148.26a12.19 12.19 0 0 0-15.3 0zM571.6 251.47L488 182.56V44.05a12 12 0 0 0-12-12h-56a12 12 0 0 0-12 12v72.61L318.47 43a48 48 0 0 0-61 0L4.34 251.47a12 12 0 0 0-1.6 16.9l25.5 31A12 12 0 0 0 45.15 301l235.22-193.74a12.19 12.19 0 0 1 15.3 0L530.9 301a12 12 0 0 0 16.9-1.6l25.5-31a12 12 0 0 0-1.7-16.93z"/></svg>

```r
head(lemurs)
```

```
# A tibble: 6 x 6
  name           sex   weight_1 weight_2 weight_3 birth_type
  <chr>          <chr>    <dbl>    <dbl>    <dbl> <chr>     
1 Nosferatu      M         2860     2505     2930 wild      
2 Poe            M         2700     2610     2680 wild      
3 Samantha       F         2242     2360     2415 wild      
4 Annabel Lee    F          944     1180     1689 captive   
5 Mephistopheles M         2760     2520     2620 wild      
6 Endora         F         2600     2360     2645 wild      
```

---
# `geom_tile`

```r
lemurs %>% pivot_longer(cols = starts_with("weight"), names_to = "weight") %>% 
  ggplot() + scale_fill_gradient(low = "white", high = "orange") +
* geom_tile(aes(x = weight, y = name, fill = value))
```

---
# Heatmap

## Нужна матрица

```r
lemurs <- drop_na(lemurs)
lemurs_mtx <- lemurs %>% select(where(is.numeric)) %>% as.matrix()
rownames(lemurs_mtx) <- lemurs$name
lemurs_mtx_sc <- t(scale(t(lemurs_mtx)))

lemurs_mtx[1:5,]
```

```
               weight_1 weight_2 weight_3
Nosferatu          2860     2505     2930
Poe                2700     2610     2680
Samantha           2242     2360     2415
Annabel Lee         944     1180     1689
Mephistopheles     2760     2520     2620
```

---
# pheatmap

```r
library(pheatmap)

pheatmap(lemurs_mtx, cluster_cols = FALSE, cluster_rows = TRUE)
```

---
# pheatmap

```r
pheatmap(lemurs_mtx, scale = "row", cluster_cols = FALSE, cluster_rows = TRUE)
```

---
# Аннотации

```r
ann <- lemurs %>% select(sex, birth_type) %>% as.data.frame()
rownames(ann) <- lemurs$name

# color scheme
ann_color <- list(sex = c("M" = "#06d6a0", "F" = "#ef476f"),
                  birth_type = c("wild" = "#95b8d1", "captive" = "#b8e0d2"))
```

---
# pheatmap

```r
pheatmap(lemurs_mtx,
         cluster_cols = FALSE, cluster_rows = TRUE,
         annotation_row = ann, annotation_colors = ann_color)
```

---
# ComplexHeatmap

```r
library(ComplexHeatmap)

*Heatmap(lemurs_mtx_sc, name = "Z-score")
```

---
# ComplexHeatmap - цвета

```r
col_fun <- circlize::colorRamp2(c(-2, 0, 2), c("purple", "white", "red"))

Heatmap(lemurs_mtx_sc, name = "Z-score", 
*       col = col_fun, column_title = "Purple-Red palette")
```

---
# Дендрограммы

```r
Heatmap(lemurs_mtx_sc, name = "Z-score", col = col_fun, 
*       cluster_rows = FALSE, cluster_columns = FALSE,
        column_title = "No clustering")
```

---
# Дендрограммы

```r
Heatmap(lemurs_mtx_sc, name = "Z-score", col = col_fun, 
*       row_dend_side = "right",
*       row_dend_width = unit(3, "cm"),
        column_title = "No clustering")
```

---
# Аннотации

```r
ra <- rowAnnotation(sex = ann$sex, birth_type = ann$birth_type,
  col = list(sex = c("M" = "#06d6a0", "F" = "#ef476f"),
             birth_type = c("wild" = "#95b8d1", "captive" = "#b8e0d2")))
```

---
# Аннотации

```r
Heatmap(lemurs_mtx_sc, name = "Z-score", col = col_fun, 
        column_title = "Column annotation",
        right_annotation = ra) 
```

---
# Диаграмма Венна <svg aria-hidden="true" role="img" viewBox="0 0 576 512" style="height:1em;width:1.12em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#b74f6f;overflow:visible;position:relative;"><path d="M280.37 148.26L96 300.11V464a16 16 0 0 0 16 16l112.06-.29a16 16 0 0 0 15.92-16V368a16 16 0 0 1 16-16h64a16 16 0 0 1 16 16v95.64a16 16 0 0 0 16 16.05L464 480a16 16 0 0 0 16-16V300L295.67 148.26a12.19 12.19 0 0 0-15.3 0zM571.6 251.47L488 182.56V44.05a12 12 0 0 0-12-12h-56a12 12 0 0 0-12 12v72.61L318.47 43a48 48 0 0 0-61 0L4.34 251.47a12 12 0 0 0-1.6 16.9l25.5 31A12 12 0 0 0 45.15 301l235.22-193.74a12.19 12.19 0 0 1 15.3 0L530.9 301a12 12 0 0 0 16.9-1.6l25.5-31a12 12 0 0 0-1.7-16.93z"/></svg>

- `VennDiagram` из {VennDiagram}
- `euler` из {eulerr}
- {ggvenndiagram}

---
# Upset plot <svg aria-hidden="true" role="img" viewBox="0 0 576 512" style="height:1em;width:1.12em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#b74f6f;overflow:visible;position:relative;"><path d="M280.37 148.26L96 300.11V464a16 16 0 0 0 16 16l112.06-.29a16 16 0 0 0 15.92-16V368a16 16 0 0 1 16-16h64a16 16 0 0 1 16 16v95.64a16 16 0 0 0 16 16.05L464 480a16 16 0 0 0 16-16V300L295.67 148.26a12.19 12.19 0 0 0-15.3 0zM571.6 251.47L488 182.56V44.05a12 12 0 0 0-12-12h-56a12 12 0 0 0-12 12v72.61L318.47 43a48 48 0 0 0-61 0L4.34 251.47a12 12 0 0 0-1.6 16.9l25.5 31A12 12 0 0 0 45.15 301l235.22-193.74a12.19 12.19 0 0 1 15.3 0L530.9 301a12 12 0 0 0 16.9-1.6l25.5-31a12 12 0 0 0-1.7-16.93z"/></svg>

Когда слишком много множеств для диаграммы Венна.

- `upset` из {UpSetR}
- `UpSet` из {ComplexHeatmap}

---
# Подготовка к КР

- На всякий случай проверьте доступ к RStudio на kodomo.

- Писать контрольную работу можно только очно со своей группой.

- Оформление контрольной работы: **Ivanov_KR1.R**.

- При манипуляции с данными используйте средства **{tidyverse}**!