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

class: center, middle, inverse, title-slide

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

---

# Столбчатая диаграмма

.pull-left[

По умолчанию `position = "stack"`

```r
ggplot(penguins, aes(x = species, fill = sex)) +
  geom_bar(color = "#F4F1BB", width = 0.8) +
  scale_fill_manual(values = c("#ED6A5A", "#9BC1BC")) +
  theme_minimal()
```

<img src="data:image/png;base64,#figs/geom_barplot_stack-1.png" width="100%" style="display: block; margin: auto;" />
]

.pull-right[

Можно поменять на `position = "dodge"`

```r
ggplot(penguins, aes(x = species, fill = sex)) +
  geom_bar(
    color = "#F4F1BB", width = 0.8,
*   position = "dodge") +
  scale_fill_manual(values = c("#ED6A5A", "#9BC1BC")) +
  theme_minimal()
```

<img src="data:image/png;base64,#figs/geom_barplot_dodge-1.png" width="100%" style="display: block; margin: auto;" />
]

---
# Стековая столбчатая диаграмма

`position = "fill"` преобразует каунты в доли/проценты

```r
ggplot(penguins, aes(x = species, fill = island)) +
  geom_bar(
    color = "#F4F1BB", width = 0.8,
*   position = "fill") +
* scale_y_continuous(labels = scales::percent) +
  scale_fill_manual(values = c("#ED6A5A", "#F4F1BB", "#9BC1BC")) +
  theme_minimal()
```

---
# Столбчатая диаграмма

Если уже есть столбец с числами, которые хотим изобразить, то нужно использовать `geom_bar(stat = "identity")` или `geom_col()`.

```r
penguins %>% 
  count(species, year) %>% 
  ggplot(aes(x = species, y = n, fill = as_factor(year))) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = c("#ED6A5A", "#F4F1BB", "#9BC1BC")) +
  theme_minimal()
```

---
# Добавление текста

```r
penguins %>% count(species, year) %>% 
  ggplot(aes(x = species, y = n, fill = as_factor(year))) +
  geom_col(position = "dodge") +
* geom_text(
*   aes(label = n, y = n + 2, group = as_factor(year)),
*   position = position_dodge(width = .9)) +
  scale_fill_manual(values = c("#ED6A5A", "#F4F1BB", "#9BC1BC")) +
  theme_minimal()
```

---
# Столбчатая диаграмма, изображающая статистики

```r
ggplot(penguins, aes(x = species, y = flipper_length_mm)) +
* geom_bar(stat = "summary", fun = "mean")
```

---
# Добавление величины ошибки

```r
penguins_stat <- penguins %>% 
* group_by(species) %>%
* summarise(
*   avg_flipper_mm = mean(flipper_length_mm, na.rm = TRUE),
*   min_flipper_mm = avg_flipper_mm - sd(flipper_length_mm, na.rm = TRUE),
*   max_flipper_mm = avg_flipper_mm + sd(flipper_length_mm, na.rm = TRUE))

penguins_stat
```

```
# A tibble: 3 x 4
  species   avg_flipper_mm min_flipper_mm max_flipper_mm
  <chr>              <dbl>          <dbl>          <dbl>
1 Adelie              190.           183.           196.
2 Chinstrap           196.           189.           203.
3 Gentoo              217.           211.           224.
```

---
# Добавление величины ошибки

```r
ggplot(penguins_stat) +
  geom_bar(aes(x = species, y = avg_flipper_mm, fill = species),
*          stat = "identity") +
* geom_errorbar(aes(x = species, ymin = min_flipper_mm, ymax = max_flipper_mm), width = 0.2)
```

---
## Альтернатива - пакет ggpubr

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

---
# ggplot2

---
# Длинный и широкий формат

- Из широкого в длинный - `pivot_longer`
- Из длинного в широкий - `pivot_wider`

---
# Широкий формат

```r
relig_income
```

```
# A tibble: 18 x 11
   religion `<$10k` `$10-20k` `$20-30k` `$30-40k` `$40-50k` `$50-75k` `$75-100k`
   <chr>      <dbl>     <dbl>     <dbl>     <dbl>     <dbl>     <dbl>      <dbl>
 1 Agnostic      27        34        60        81        76       137        122
 2 Atheist       12        27        37        52        35        70         73
 3 Buddhist      27        21        30        34        33        58         62
 4 Catholic     418       617       732       670       638      1116        949
 5 Don’t k~      15        14        15        11        10        35         21
 6 Evangel~     575       869      1064       982       881      1486        949
 7 Hindu          1         9         7         9        11        34         47
 8 Histori~     228       244       236       238       197       223        131
 9 Jehovah~      20        27        24        24        21        30         15
10 Jewish        19        19        25        25        30        95         69
11 Mainlin~     289       495       619       655       651      1107        939
12 Mormon        29        40        48        51        56       112         85
13 Muslim         6         7         9        10         9        23         16
14 Orthodox      13        17        23        32        32        47         38
15 Other C~       9         7        11        13        13        14         18
16 Other F~      20        33        40        46        49        63         46
17 Other W~       5         2         3         4         2         7          3
18 Unaffil~     217       299       374       365       341       528        407
# ... with 3 more variables: $100-150k <dbl>, >150k <dbl>,
#   Don't know/refused <dbl>
```

---
# Pivot_longer

Для построения графиков с **{ggplot2}**, работы с группами категорий.

```r
relig_income %>% 
  pivot_longer(!religion, names_to = "income", values_to = "count")
```

```
# A tibble: 180 x 3
   religion income             count
   <chr>    <chr>              <dbl>
 1 Agnostic <$10k                 27
 2 Agnostic $10-20k               34
 3 Agnostic $20-30k               60
 4 Agnostic $30-40k               81
 5 Agnostic $40-50k               76
 6 Agnostic $50-75k              137
 7 Agnostic $75-100k             122
 8 Agnostic $100-150k            109
 9 Agnostic >150k                 84
10 Agnostic Don't know/refused    96
# ... with 170 more rows
```

---
# Длинный формат

```r
fish_encounters
```

```
# A tibble: 114 x 3
   fish  station  seen
   <fct> <fct>   <int>
 1 4842  Release     1
 2 4842  I80_1       1
 3 4842  Lisbon      1
 4 4842  Rstr        1
 5 4842  Base_TD     1
 6 4842  BCE         1
 7 4842  BCW         1
 8 4842  BCE2        1
 9 4842  BCW2        1
10 4842  MAE         1
# ... with 104 more rows
```

---
# Pivot_wider

Для построения тепловых карт.

```r
fish_encounters %>% 
  pivot_wider(names_from = fish, values_from = seen)
```

```
# A tibble: 11 x 20
   station `4842` `4843` `4844` `4845` `4847` `4848` `4849` `4850` `4851` `4854`
   <fct>    <int>  <int>  <int>  <int>  <int>  <int>  <int>  <int>  <int>  <int>
 1 Release      1      1      1      1      1      1      1      1      1      1
 2 I80_1        1      1      1      1      1      1      1      1      1      1
 3 Lisbon       1      1      1      1      1      1     NA     NA     NA     NA
 4 Rstr         1      1      1      1     NA      1     NA      1     NA     NA
 5 Base_TD      1      1      1      1     NA     NA     NA      1     NA     NA
 6 BCE          1      1      1     NA     NA     NA     NA      1     NA     NA
 7 BCW          1      1      1     NA     NA     NA     NA      1     NA     NA
 8 BCE2         1      1      1     NA     NA     NA     NA     NA     NA     NA
 9 BCW2         1      1      1     NA     NA     NA     NA     NA     NA     NA
10 MAE          1      1      1     NA     NA     NA     NA     NA     NA     NA
11 MAW          1      1      1     NA     NA     NA     NA     NA     NA     NA
# ... with 9 more variables: 4855 <int>, 4857 <int>, 4858 <int>, 4859 <int>,
#   4861 <int>, 4862 <int>, 4863 <int>, 4864 <int>, 4865 <int>
```

---
# 3 aes - 3 столбца

```r
drop_na(penguins, sex) %>% ggplot() +
  geom_boxplot(aes(x = species, y = bill_length_mm, fill = sex))
```

---
# Длинный формат

.pull-left[

```r
penguins %>% 
* pivot_longer(cols = c(bill_length_mm, bill_depth_mm)) %>%
  select(species, name, value) 
```

```
# A tibble: 688 x 3
   species name           value
   <chr>   <chr>          <dbl>
 1 Adelie  bill_length_mm  39.1
 2 Adelie  bill_depth_mm   18.7
 3 Adelie  bill_length_mm  39.5
 4 Adelie  bill_depth_mm   17.4
 5 Adelie  bill_length_mm  40.3
 6 Adelie  bill_depth_mm   18  
 7 Adelie  bill_length_mm  NA  
 8 Adelie  bill_depth_mm   NA  
 9 Adelie  bill_length_mm  36.7
10 Adelie  bill_depth_mm   19.3
# ... with 678 more rows
```

]

.pull-right[

```r
penguins %>% 
* pivot_longer(cols = c(bill_length_mm, bill_depth_mm)) %>%
  ggplot() +
  geom_boxplot(aes(x = species, y = value, fill = name))
```

<img src="data:image/png;base64,#figs/long-format-2-pl-1.png" width="80%" style="display: block; margin: auto;" />
]

---
# Facets

```r
drop_na(penguins, sex) %>% 
  pivot_longer(cols = c(bill_length_mm, bill_depth_mm)) %>% 
  ggplot() +
  geom_boxplot(aes(x = sex, y = value, fill = name)) +
* facet_wrap(~ species) +
* theme(legend.position = "none")
```

---
# Названия панелек

```r
drop_na(penguins, sex) %>% 
  pivot_longer(cols = c(bill_length_mm, bill_depth_mm)) %>% 
  ggplot() +
  geom_boxplot(aes(x = sex, y = value, fill = name)) +
  facet_wrap(~ species, 
*   labeller = as_labeller(c("Adelie" = "Адели",
*                            "Chinstrap" = "Антарктический",
*                            "Gentoo" = "Субантарктический"))) +
  theme(legend.position = "none")
```

---
class: inverse, center, middle

# Функции

---
# Функции

- Если вы заметили, что несколько раз используете один и тот же код, то запишите его в функцию.

```r
df <- tibble(
  a = 1:10,
  b = rnorm(10),
  c = runif(10))

# возведем все столбцы в куб
df$a <- df$a ** 3
df$b <- df$b * 3
df$c <- df$c **3
```

---
# Функции

- Если вы заметили, что несколько раз используете один и тот же код, то запишите его в функцию.

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

cube(x = 2)
```

```
[1] 8
```

```r
df$a <- cube(df$a)
df$b <- cube(df$b)
df$c <- cube(df$c)
```

---
# Функции

Нужно придумать:

- **имя** функции. Оно не должно совпадать с именами функций из базового R или пакетов, которые вы используете. В идеале оно отражает смысл вашей функции.

```r
# не делайте так!
mean <- function(x) { sum(x) }
```

- список **параметров**, которые функция принимает на вход. Например, `function(x, y, z)`.

- сам код, выполняющий работу, который вы записываете в **тело** функции внутри `{...}`.

```r
smart_name <- function(input1, input2, param3) {
  ...
  body
  ...
}
```

---
# Функции

- У функции может быть 0 или несколько параметров.
- Функция может возвращать максимум 1 объект.

```r
# ничего не требует
say_hello <- function() {
  print("hello!")
}

# ничего не возвращает
save_res <- function(df) {
  df = df[df$pval < 0.05, c(1,3:5)]
  write.csv(df, "path-to-file.csv")
}
```

---
# Взглянуть на код функции

И на свою функцию посмотреть:

```r
cube
```

```
function(x) {
  x ** 3
}
<bytecode: 0x000000001666e198>
```

И на чужую:

```r
xor
```

```
function (x, y) 
{
    (x | y) & !(x & y)
}
<bytecode: 0x0000000024f05dd0>
<environment: namespace:base>
```

---
# Return

- Функция возвращает результат последнего выражения либо то, что указано как `return(...)`.

.pull-left[

```r
cube_or_not <- function(x) {
  x ** 3
}

cube_or_not(2)
```
]

.pull-right[

```r
cube_or_not <- function(x) {
  return(x * 3)
  x ** 3
}

cube_or_not(2)
```
]

---
.pull-left[
## Implicit return

```r
check_sign_i <- function(x) {
  # check if x is positive
  if (x > 0) {
    "positive"
  }
  # check if x is negative
  else if (x < 0) {
    "negative"
  }
  # check if x is not positive nor negative
  else {
    "zero"
  }
}

check_sign_i(10)
```

```
[1] "positive"
```
]

.pull-right[
## Explicit return

```r
check_sign_e <- function(x) {
  # check if x is positive
  if (x > 0) {
    return("positive")
  }
  # check if x is negative
  else if (x < 0) {
    return("negative")
  }
  # check if x is not positive nor negative
  else {
    return("zero")
  }
}

check_sign_e(10)
```

```
[1] "positive"
```
]

---
# Выполнение кода по условию

```r
if (condition) {
  # что делать, когда condition = TRUE
} else {
  # что делать, когда condition = FALSE
}
```

Логическое выражение `condition` должно возвращать либо TRUE, либо FALSE.

---
# Выполнение кода по условию

Логическое выражение `condition` должно возвращать либо TRUE, либо FALSE.

- Если `condition` - это вектор, то будет предупреждение:

```r
if (c(TRUE, FALSE)) {}
```

```
Warning in if (c(TRUE, FALSE)) {: the condition has length > 1 and only the
first element will be used
```

```
NULL
```

- Если `condition` - это пропущенное значение, то будет ошибка:

```r
if (NA) {}
```

```
Error in if (NA) {: missing value where TRUE/FALSE needed
```

---
# Несколько условий

```r
if (this) {
  # делай это
} else if (that) {
  # делай что-то другое
} else {
  # делай что-то третье
}
```

Не путайте `else if () {...}` с `ifelse()`.

---
# Несколько условий

Если условий слишком много, то в них можно запутаться. Тогда лучше использовать другие подходы. Например, использовать `switch()`.

```r
centre <- function(x, type) {
  switch(type,
         mean = mean(x),
         median = median(x),
         trimmed = mean(x, trim = .1),
         stop("Unknown central tendency!"))
}
```

.pull-left[

```r
set.seed(123)
x <- rnorm(10)
centre(x, "mean")
```

```
[1] 0.07462564
```
]

.pull-right[

```r
centre(x, "median")
```

```
[1] -0.07983455
```

```r
centre(x, "trimmed")
```

```
[1] 0.03703159
```

```r
centre(x, "mode")
```

```
Error in centre(x, "mode"): Unknown central tendency!
```
]

---
# Параметры

Через параметры на вход функции передаются **данные** или какие-то **детали**. Обычно данные передаются первому параметру. В таком случае эту функцию будет легко использовать с ` %>% `.

Для параметров можно задать значение по умолчанию:

```r
centre <- function(x, type = "mean") {
  switch(type,
         mean = mean(x),
         median = median(x),
         trimmed = mean(x, trim = .1),
         stop("Unknown central tendency!"))
}

centre(rnorm(10))
```

```
[1] 0.208622
```

Если при вызове функции вы заменяете значение по умолчанию, то указывайте название параметра (не надейтесь только на позицию). Так всем будет понятнее.

---
# Названия параметров

Идеи для названий параметров:

- `x, y, z` - вектора,
- `w` - вектор весов,
- `df` - датафрейм,
- `i, j` - индексы (строки и столбцы),
- `n` - длина или число строк,
- `p` - число столбцов.

---
# Провека формата входных данных

В каком случае нужно остановиться.

.pull-left[

## if + stop

```r
cube <- function(x) {
* if (!is.numeric(x)) {
*   stop("`x` must be numeric")
*   }
  x ** 3
}

cube("twelve")
```

```
Error in cube("twelve"): `x` must be numeric
```
]

.pull-left[

## stopifnot

```r
cube <- function(x) {
* stopifnot(is.numeric(x))
  x ** 3
}

cube("twelve")
```

```
Error in cube("twelve"): is.numeric(x) is not TRUE
```
]

---
# Multiple returns

Чтобы функция возвращала несколько объектов, нужно эти объекты возвращать в виде списка.

```r
return_two_and_four <- function(){
  list(2, 4)
}

return_two_and_four()
```

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

[[2]]
[1] 4
```

---
# Локальные переменные

`x` внутри функции (в ее среде) и вне функции (в глобальной среде) существуют независимо.

```r
x <- 1000

add_ten <- function(x){
  x + 10
}

add_ten(32)
```

```
[1] 42
```

```r
x
```

```
[1] 1000
```

---
# Глобальные переменные

Изнутри функции можно переписать глобальную переменную с помощью оператора ` <<- `.

```r
x <- 1000

add_ten <- function(x){
  x <<- 32
  x + 10
}

add_ten(32)
```

```
[1] 42
```

```r
x
```

```
[1] 32
```

---
# Глобальные переменные

Если R не нашел переменную в среде функции, то он будет искать ее в глобальной среде.

```r
y <- 1000

add_ten <- function(){
  y + 10
}

add_ten()
```

```
[1] 1010
```

---
class: inverse, center, middle

# Работа с табличными данными

---
# Работа с табличными данными

Очень широкий датафрейм про лемуров из Duke Lemur Center.

Как привести его к форме `name`-`weight_1`-`weight_2`-`weight_3`?

```r
lemurs_weights_wide
```

```
# A tibble: 3 x 52
  weight_date Agatha Angelique `Annabel Lee` `Ardrey-A` Ardrey `Bellatrix-A`
  <chr>        <dbl>     <dbl>         <dbl>      <dbl>  <dbl> <lgl>        
1 weight_1      1060      2920           944         98   3000 NA           
2 weight_2      1860      2940          1180         98   2780 NA           
3 weight_3      2000       209          1689         95    666 NA           
# ... with 45 more variables: Bellatrix-B <lgl>, Bellatrix-C <lgl>,
#   Bellatrix <dbl>, Blue Devil <dbl>, Caliban <dbl>, Claudia <dbl>,
#   Cruella <dbl>, Damien <lgl>, Elphaba <dbl>, Endora <dbl>, Goblin <dbl>,
#   Grendel <dbl>, Hitchcock <dbl>, Ichabod <dbl>, Imp <lgl>, Kali <dbl>,
#   Kambana <lgl>, Loki <lgl>, Lucrezia <dbl>, Medea <dbl>, Medusa <dbl>,
#   Mephistopheles <dbl>, Merlin <dbl>, Morticia <dbl>, Niffy <lgl>,
#   Norman Bates <dbl>, Nosferatu <dbl>, Ozma-A <dbl>, Ozma <dbl>, ...
```

---
# Работа с табличными данными

Как привести его к форме `name`-`weight_1`-`weight_2`-`weight_3`?

```
# A tibble: 51 x 4
   name        weight_1 weight_2 weight_3
   <chr>          <dbl>    <dbl>    <dbl>
 1 Agatha          1060     1860     2000
 2 Angelique       2920     2940      209
 3 Annabel Lee      944     1180     1689
 4 Ardrey-A          98       98       95
 5 Ardrey          3000     2780      666
 6 Bellatrix-A       NA       NA       NA
 7 Bellatrix-B       NA       NA       NA
 8 Bellatrix-C       NA       NA       NA
 9 Bellatrix        585     2760     2460
10 Blue Devil      1330     1820     2460
# ... with 41 more rows
```

---
# Работа с табличными данными

Как привести его к форме `name`-`weight_1`-`weight_2`-`weight_3`?

```r
lemurs_weights <- lemurs_weights_wide %>% 
  pivot_longer(-weight_date) %>% 
  pivot_wider(names_from = weight_date, values_from = value)

lemurs_weights
```

---
## Как еще можно указать множество столбцов?

- Использовать информацию о типе данных: `where(is.character)`, ...

```r
lemurs_weights_wide %>% 
* pivot_longer(!where(is.character)) %>%
  pivot_wider(names_from = weight_date, values_from = value)

lemurs_weights_wide %>% 
* pivot_longer(where(is.logical) | where(is.numeric)) %>%
  pivot_wider(names_from = weight_date, values_from = value)
```

---
## Как еще можно указать множество столбцов?

- `starts_with("pattern")` - начинается с "pattern"
- `ends_with("pattern")` - заканчивается на "pattern"
- `contains("pattern")` - содержит подслово "pattern"
- `matches("pattern")` - находится по регулярному выражению "pattern"

```r
lemurs_weights %>% select(starts_with("weight")) %>% head(1)
```

```
# A tibble: 1 x 3
  weight_1 weight_2 weight_3
     <dbl>    <dbl>    <dbl>
1     1060     1860     2000
```

```r
lemurs_weights %>% select(matches("*_[12]")) %>% head(1)
```

```
# A tibble: 1 x 2
  weight_1 weight_2
     <dbl>    <dbl>
1     1060     1860
```

---
## Как еще можно указать множество столбцов?

- `num_range()` - поиск по общему префиксу среди столбцов с некой нумерацией

```r
lemurs_weights %>% 
  select(num_range("weight_", c(1,3))) %>% # prefix, numeric range
  head(1) 
```

```
# A tibble: 1 x 2
  weight_1 weight_3
     <dbl>    <dbl>
1     1060     2000
```

---
## Как еще можно указать множество столбцов?

- Использовать информацию о позиции столбца

```r
lemurs_weights %>% select(1, num_range("weight_", c(1,3))) %>% head(1)
```

```
# A tibble: 1 x 3
  name   weight_1 weight_3
  <chr>     <dbl>    <dbl>
1 Agatha     1060     2000
```

---
## Как еще можно указать множество столбцов?

- Добавить условие по значениям в столбцах

```r
lemurs_weights %>% 
  select(where(~ is.numeric(.) && max(., na.rm=TRUE) > 3000)) %>% 
  head(1)
```

```
# A tibble: 1 x 1
  weight_3
     <dbl>
1     2000
```

Устаревшее:

```r
lemurs_weights %>% 
  select_if(~ is.numeric(.) && max(., na.rm=TRUE) > 3000)
```

---
## Как еще можно указать множество столбцов?

- Использовать вектор с названиями нужных столбцов и `all_of()` или `any_of()`.

```r
weight_cols <- paste("weight", 1:4, sep = "_")
```

.pull-left[

```r
lemurs_weights %>% 
  select(all_of(weight_cols)) 
```

```
Error: Can't subset columns that don't exist.
x Column `weight_4` doesn't exist.
```
]

.pull-right[

```r
lemurs_weights %>% 
  select(any_of(weight_cols)) %>% 
  head(1)
```

```
# A tibble: 1 x 3
  weight_1 weight_2 weight_3
     <dbl>    <dbl>    <dbl>
1     1060     1860     2000
```
]

---
# Трансформация таблиц

Задача: по 3 взвешиваниям посчитать средний вес каждого лемура.

```r
lemurs_weights
```