18 Решения заданий

##Начало работы в R {#solution_begin}

• Разделите 9801 на 9.

9801/9

[1] 1089

• Посчитайте логарифм от 8912162342 по основанию 6.

log(2176782336, 6)

[1] 12

• Теперь натуральный логарифм 10 и умножьте его на 5.

log(10)*5

[1] 11.51293

• С помощью функции sin() посчитайте \(\sin (\pi), \sin \left(\frac{\pi}{2}\right), \sin \left(\frac{\pi}{6}\right)\).

Значение \(\pi\) - зашитая в R константа (pi).

sin(pi)

[1] 1.224647e-16

sin(pi/2)

[1] 1

sin(pi/6)

[1] 0.5

##Создание векторов {#solution_new_vecs}

• Создайте вектор из значений 2, 30 и 4000.

c(2, 30, 4000)

[1]    2   30 4000

• Создайте вектор от 1 до 20.

1:20

 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20

• Создайте вектор от 20 до 1.

20:1

 [1] 20 19 18 17 16 15 14 13 12 11 10  9  8  7  6  5  4  3  2  1

Функция sum() возвращает сумму элементов вектора на входе. Посчитайте сумму первых 100 натуральных чисел (т.е. всех целых чисел от 1 до 100).

sum(1:100)

[1] 5050

• Создайте вектор от 1 до 20 и снова до 1. Число 20 должно присутствовать только один раз!

c(1:20, 19:1)

 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 19 18 17 16 15
[26] 14 13 12 11 10  9  8  7  6  5  4  3  2  1

• Создайте вектор значений 5, 4, 3, 2, 2, 3, 4, 5:

c(5:2, 2:5)

[1] 5 4 3 2 2 3 4 5

• Создайте вектор 2, 4, 6, … , 18, 20.

seq(2, 20, 2)

 [1]  2  4  6  8 10 12 14 16 18 20

• Создайте вектор 0.1, 0.2, 0.3, …, 0.9, 1.

seq(0, 1, 0.1)

 [1] 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0

• 2020 год — високосный. Следующий високосный год через 4 года — это будет 2024 год. Составьте календарь всех високосных годов XXI века, начиная с 2020 года.

2100 год относится к XXI веку, а не к XXII.

seq(2020, 2100, 4)

 [1] 2020 2024 2028 2032 2036 2040 2044 2048 2052 2056 2060 2064 2068 2072 2076
[16] 2080 2084 2088 2092 2096 2100

• Создайте вектор, состоящий из 20 повторений “Хэй!”

rep("Хэй!", 20)

 [1] "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!"
[11] "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!" "Хэй!"

• Как я и говорил, многие функции, работающие с одним значением на входе, так же прекрасно работают и с целыми векторами. Попробуйте посчитать квадратный корень чисел от 1 до 10 с помощью функции sqrt() и сохраните результат в векторе roots.

roots <- sqrt(1:10)
roots

 [1] 1.000000 1.414214 1.732051 2.000000 2.236068 2.449490 2.645751 2.828427
 [9] 3.000000 3.162278

• Давайте убедимся, что это действительно квадратные корни. Для этого возведите все значения вектора roots в квадрат!

roots ^ 2

 [1]  1  2  3  4  5  6  7  8  9 10

• Если все верно, то того же самого можно добиться поэлементным умножением вектора roots на себя.

roots * roots

 [1]  1  2  3  4  5  6  7  8  9 10

• *Создайте вектор из одной единицы, двух двоек, трех троек, …. , девяти девяток.

rep(1:9, 1:9)

 [1] 1 2 2 3 3 3 4 4 4 4 5 5 5 5 5 6 6 6 6 6 6 7 7 7 7 7 7 7 8 8 8 8 8 8 8 8 9 9
[39] 9 9 9 9 9 9 9

18.1 Приведение типов

• Сделайте вектор vec1, в котором соедините 3, а также значения "Мой" и "вектор".

vec1 <- c(3, "Мой", "вектор")
vec1

[1] "3"      "Мой"    "вектор"

• Попробуйте вычесть TRUE из 10.

10 - TRUE

[1] 9

• Соедините значение 10 и TRUE в вектор vec2.

vec2 <- c(10, TRUE)
vec2

[1] 10  1

• Соедините вектор vec2 и значение "r":

c(vec2, "r")

[1] "10" "1"  "r" 

• Соедините значения 10, TRUE, "r" в вектор.

c(10, TRUE, "r")

[1] "10"   "TRUE" "r"   

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

• Создайте вектор p, состоящий из значений 4, 5, 6, 7, и вектор q, состоящий из 0, 1, 2, 3.

p <- 4:7
p

[1] 4 5 6 7

q <- 0:3
q

[1] 0 1 2 3

• Посчитайте поэлементную сумму векторов p и q:

p + q

[1]  4  6  8 10

• Посчитайте поэлементную разницу p и q:

p - q

[1] 4 4 4 4

• Поделите каждый элемент вектора p на соответствующий ему элемент вектора q:

О, да, Вам нужно делить на 0!

p / q

[1]      Inf 5.000000 3.000000 2.333333

• Возведите каждый элемент вектора p в степень соответствующего ему элемента вектора q:

p ^ q

[1]   1   5  36 343

• Умножьте каждое значение вектора p на 10.

p * 10

[1] 40 50 60 70

• Создайте вектор квадратов чисел от 1 до 10:

(1:10)^2

 [1]   1   4   9  16  25  36  49  64  81 100

• Создайте вектор 0, 2, 0, 4, … , 18, 0, 20.

1:20 * 0:1

 [1]  0  2  0  4  0  6  0  8  0 10  0 12  0 14  0 16  0 18  0 20

• Создайте вектор 1, 0, 3, 0, 5, …, 17, 0, 19, 0.

1:20 * 1:0

 [1]  1  0  3  0  5  0  7  0  9  0 11  0 13  0 15  0 17  0 19  0

• *Создайте вектор, в котором будут содержаться первые 20 степеней двойки.

2 ^ (1:20)

 [1]       2       4       8      16      32      64     128     256     512
[10]    1024    2048    4096    8192   16384   32768   65536  131072  262144
[19]  524288 1048576

• *Создайте вектор из чисел 1, 10, 100, 1000, 10000:

10 ^ (0:4)

[1]     1    10   100  1000 10000

• *Посчитать сумму последовательности \(\frac{1}{1 \cdot 2}+\frac{1}{2 \cdot 3}+\frac{1}{3 \cdot 4}+\ldots+\frac{1}{50 \cdot 51}\).

sum(1 / (1:50 * 2:51))

[1] 0.9803922

• *Посчитать сумму последовательности \(\frac{1}{2^{0}}+\frac{1}{2^{1}}+\frac{1}{2^{2}}+\frac{1}{2^{3}}+\ldots \frac{1}{2^{20}}\).

sum(1 / 2 ^ (0:20))

[1] 1.999999

• *Посчитать сумму последовательности \(1+\frac{4}{3}+\frac{7}{9}+\frac{10}{27}+\frac{13}{81}+\ldots+\frac{28}{19683}\).

sum((3 * (1:10) - 2) / 3 ^ (0:9))

[1] 3.749174

• *Сколько чисел из последовательности \(1+\frac{4}{3}+\frac{7}{9}+\frac{10}{27}+\frac{13}{81}+\ldots+\frac{28}{19683}\) больше чем 0.5?

sum((3 * (1:10) - 2) / 3 ^ (0:9) > 0.5)

[1] 3

18.3 Индексирование векторов

• Создайте вектор troiki со значениями 3, 6, 9, …, 24, 27.

troiki <- seq(3, 27, 3)
troiki

[1]  3  6  9 12 15 18 21 24 27

• Извлеките 2, 5 и 7 значения вектора troiki.

troiki[c(2, 5, 7)]

[1]  6 15 21

• Извлеките предпоследнее значение вектора troiki.

troiki[length(troiki) - 1]

[1] 24

• Извлеките все значения вектора troiki кроме предпоследнего:

troiki[-(length(troiki) - 1)]

[1]  3  6  9 12 15 18 21 27

Создайте вектор vec3:

vec3 <- c(3, 5, 2, 1, 8, 4, 9, 10, 3, 15, 1, 11)

• Найдите второй элемент вектора vec3.

vec3[2]

[1] 5

• Верните второй и пятый элемент вектора vec3.

vec3[c(2, 5)]

[1] 5 8

• Попробуйте извлечь сотое значение вектора vec3:

vec3[100]

[1] NA

• Верните все элементы вектора vec3 кроме второго элемента.

vec3[-2]

 [1]  3  2  1  8  4  9 10  3 15  1 11

• Верните все элементы вектора vec3 кроме второго и пятого элемента.

vec3[c(-2, -5)]

 [1]  3  2  1  4  9 10  3 15  1 11

• Найдите последний элемент вектора vec3.

vec3[length(vec3)]

[1] 11

• Верните все значения вектора vec3 кроме первого и последнего.

vec3[c(-1, -length(vec3))]

 [1]  5  2  1  8  4  9 10  3 15  1

• Найдите все значения вектора vec3, которые больше 4.

vec3[vec3 > 4]

[1]  5  8  9 10 15 11

• Найдите все значения вектора vec3, которые больше 4, но меньше 10.

Если хотите сделать это в одну строчку, то вам помогут логические операторы!

vec3[vec3 > 4 & vec3 < 10]

[1] 5 8 9

• Найдите все значения вектора vec3, которые меньше 4 или больше 10.

vec3[vec3 < 4 | vec3 > 10]

[1]  3  2  1  3 15  1 11

• Возведите в квадрат каждое значение вектора vec3.

vec3 ^ 2

 [1]   9  25   4   1  64  16  81 100   9 225   1 121

• *Возведите в квадрат каждое значение вектора на нечетной позиции и извлеките корень из каждого значения на четной позиции вектора vec3.

Извлечение корня - это то же самое, что и возведение в степень 0.5.

vec3 ^ c(2, 0.5)

 [1]  9.000000  2.236068  4.000000  1.000000 64.000000  2.000000 81.000000
 [8]  3.162278  9.000000  3.872983  1.000000  3.316625

• Создайте вектор 2, 4, 6, … , 18, 20 как минимум 2 новыми способами.

Знаю, это задание может показаться бессмысленным, но это очень базовая операция, с помощью которой можно, например, разделить данные на две части. Чем больше способов Вы знаете, тем лучше!

(1:20)[c(FALSE,TRUE)]

 [1]  2  4  6  8 10 12 14 16 18 20

#(1:10)*2

##Работа с пропущенными значениями {#solution_na}

• Создайте вектор vec4 со значениями 300, 15, 8, 2, 0, 1, 110:

vec4 <- c(300, 15, 8, 20, 0, 1, 110)
vec4

[1] 300  15   8  20   0   1 110

• Замените все значения vec4, которые больше 20 на NA.

vec4[vec4 > 20] <- NA

• Проверьте полученный вектор vec4:

vec4

[1] NA 15  8 20  0  1 NA

• Посчитайте сумму vec4 с помощью функции sum(). Ответ NA не считается!

sum(vec4, na.rm = TRUE)

[1] 44

18.4 Матрицы

• Создайте матрицу 4х4, состоящую из единиц. Назовите ее M1.

M1 <- matrix(rep(1, 16), ncol = 4)
M1

     [,1] [,2] [,3] [,4]
[1,]    1    1    1    1
[2,]    1    1    1    1
[3,]    1    1    1    1
[4,]    1    1    1    1

• Поменяйте все некрайние значения матрицы M1 (то есть значения на позициях [2,2], [2,3], [3,2] и [3,3]) на число 2.

M1[2:3, 2:3] <- 2
M1

     [,1] [,2] [,3] [,4]
[1,]    1    1    1    1
[2,]    1    2    2    1
[3,]    1    2    2    1
[4,]    1    1    1    1

• Выделите второй и третий столбик из матрицы M1.

M1[,2:3]

     [,1] [,2]
[1,]    1    1
[2,]    2    2
[3,]    2    2
[4,]    1    1

• Сравните (==) вторую колонку и вторую строчку матрицы M1.

M1[,2] == M1[2,]

[1] TRUE TRUE TRUE TRUE

• *Создайте таблицу умножения (9х9) в виде матрицы. Сохраните ее в переменную mult_tab.

mult_tab <- matrix(rep(1:9, rep(9,9))*(1:9), nrow = 9)
mult_tab

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    1    2    3    4    5    6    7    8    9
 [2,]    2    4    6    8   10   12   14   16   18
 [3,]    3    6    9   12   15   18   21   24   27
 [4,]    4    8   12   16   20   24   28   32   36
 [5,]    5   10   15   20   25   30   35   40   45
 [6,]    6   12   18   24   30   36   42   48   54
 [7,]    7   14   21   28   35   42   49   56   63
 [8,]    8   16   24   32   40   48   56   64   72
 [9,]    9   18   27   36   45   54   63   72   81

#Еще
#outer(1:9, 1:9, "*")
#1:9 %o% 1:9

• *Из матрицы mult_tab выделите подматрицу, включающую в себя только строчки с 6 по 8 и столбцы с 3 по 7.

mult_tab[6:8, 3:7]

     [,1] [,2] [,3] [,4] [,5]
[1,]   18   24   30   36   42
[2,]   21   28   35   42   49
[3,]   24   32   40   48   56

• *Создайте матрицу с логическими значениями, где TRUE, если в этом месте в таблице умножения (mult_tab) двузначное число и FALSE, если однозначное.

Матрица - это почти вектор. К нему можно обращаться с единственным индексом.

mult_tab >= 10

       [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9]
 [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 [2,] FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE
 [3,] FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [4,] FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [5,] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [6,] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [7,] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [8,] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
 [9,] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE

• *Создайте матрицу mult_tab2, в которой все значения tab меньше 10 заменены на 0.

mult_tab2 <- mult_tab
mult_tab2[mult_tab < 10] <- 0
mult_tab2

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    0    0    0    0    0    0    0    0    0
 [2,]    0    0    0    0   10   12   14   16   18
 [3,]    0    0    0   12   15   18   21   24   27
 [4,]    0    0   12   16   20   24   28   32   36
 [5,]    0   10   15   20   25   30   35   40   45
 [6,]    0   12   18   24   30   36   42   48   54
 [7,]    0   14   21   28   35   42   49   56   63
 [8,]    0   16   24   32   40   48   56   64   72
 [9,]    0   18   27   36   45   54   63   72   81

18.5 Списки

Дан список list1:

list1 = list(numbers = 1:5, letters = letters, logic = TRUE)
list1

$numbers
[1] 1 2 3 4 5

$letters
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"

$logic
[1] TRUE

• Найдите первый элемент списка list1. Ответ должен быть списком длиной один.

list1[1]

$numbers
[1] 1 2 3 4 5

• Теперь найдите содержание первого элемента списка list1 двумя разными способами. Ответ должен быть вектором.

list1[[1]]

[1] 1 2 3 4 5

list1$numbers

[1] 1 2 3 4 5

• Теперь возьмите первый элемент содержания первого элемента списка list1. Ответ должен быть вектором.

list1[[1]][1]

[1] 1

• Создайте список list2, содержащий в себе два списка list1. Один из них будет иметь имя pupa, а другой — lupa.

list2 = list(pupa = list1, lupa = list1)
list2

$pupa
$pupa$numbers
[1] 1 2 3 4 5

$pupa$letters
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"

$pupa$logic
[1] TRUE


$lupa
$lupa$numbers
[1] 1 2 3 4 5

$lupa$letters
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"

$lupa$logic
[1] TRUE

• *Извлеките первый элемент списка list2, из него — второй полэлемент, а из него — третье значение.

list2[[1]][[2]][3]

[1] "c"

18.6 Датафрейм

• Запустите команду data(mtcars) чтобы загрузить встроенный датафрейм с информацией про автомобили. Каждая строчка датафрейма - модель автомобиля, каждая колонка - отдельная характеристика. Подробнее см. ?mtcars.

data(mtcars)
mtcars

• Изучите структуру датафрейма mtcars с помощью функции str().

str(mtcars)

'data.frame':   32 obs. of  11 variables:
 $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
 $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
 $ disp: num  160 160 108 258 360 ...
 $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
 $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
 $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
 $ qsec: num  16.5 17 18.6 19.4 17 ...
 $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
 $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
 $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
 $ carb: num  4 4 1 1 2 1 4 2 2 4 ...

• Найдите значение третьей строчки четвертого столбца датафрейма mtcars.

mtcars[3, 4]

[1] 93

• Извлеките первые шесть строчек и первые шесть столбцов датафрейма mtcars.

mtcars[1:6, 1:6]

• Извлеките колонку wt датафрейма mtcars - массу автомобиля в тысячах фунтов.

mtcars$wt

 [1] 2.620 2.875 2.320 3.215 3.440 3.460 3.570 3.190 3.150 3.440 3.440 4.070
[13] 3.730 3.780 5.250 5.424 5.345 2.200 1.615 1.835 2.465 3.520 3.435 3.840
[25] 3.845 1.935 2.140 1.513 3.170 2.770 3.570 2.780

• Извлеките колонки из mtcars в следующем порядке: hp, mpg, cyl.

mtcars[, c("hp", "mpg", "cyl")]

• Посчитайте количество автомобилей с 4 цилиндрами (cyl) в датафрейме mtcars.

sum(mtcars$cyl == 4)

[1] 11

• Посчитайте долю автомобилей с 4 цилиндрами (cyl) в датафрейме mtcars.

mean(mtcars$cyl == 4)

[1] 0.34375

• Найдите все автомобили мощностью не менее 100 лошадиных сил (hp) в датафрейме mtcars.

mtcars[mtcars$hp >= 100, ]

• Найдите все автомобили мощностью не менее 100 лошадиных сил (hp) и 4 цилиндрами (cyl) в датафрейме mtcars.

mtcars[mtcars$hp >= 100 & mtcars$cyl == 4, ]

• Посчитайте максимальную массу (wt) автомобиля в выборке, воспользовавшись функцией max():

max(mtcars$wt)

[1] 5.424

• Посчитайте максимальную массу (wt) автомобиля в выборке, воспользовавшись функцией min():

min(mtcars$wt)

[1] 1.513

• Найдите строчку датафрейма mtcars с самым легким автомобилем.

mtcars[mtcars$wt == min(mtcars$wt), ]

• Извлеките строчки датафрейма mtcars с автомобилями, масса которых ниже средней массы.

mtcars[mtcars$wt < mean(mtcars$wt), ]

• Масса автомобиля указана в тысячах фунтов. Создайте колонку wt_kg с массой автомобиля в килограммах. Результат округлите до целых значений с помощью функции round().

1 фунт = 0.45359237 кг.

mtcars$wt_kg <- round(mtcars$wt * 1000 * 0.45359237)
mtcars

18.7 Условные конструкции

• Создайте вектор vec5:

vec5 <- c(5, 20, 30, 0, 2, 9)

• Создайте новый строковый вектор, где на месте чисел больше 10 в vec5 будет стоять “большое число,” а на месте остальных чисел — “маленькое число.”

ifelse(vec5 > 10, "большое число", "маленькое число")

[1] "маленькое число" "большое число"   "большое число"   "маленькое число"
[5] "маленькое число" "маленькое число"

• Загрузите файл heroes_information.csv в переменную heroes.

heroes <- read.csv("data/heroes_information.csv", 
                   stringsAsFactors = FALSE,
                   na.strings = c("-", "-99"))

• Создайте новою колонку hair в heroes, в которой будет значение "Bold" для тех супергероев, у которых в колонке Hair.color стоит "No Hair", и значение "Hairy" во всех остальных случаях.

heroes$hair <- ifelse(heroes$Hair.color == "No Hair", "Bold", "Hairy")
head(heroes)

• Создайте новою колонку tall в heroes, в которой будет значение "tall" для тех супергероев, у которых в колонке Height стоит число больше 190, значение "short" для тех супергероев, у которых в колонке Height стоит число меньше 170, и значение "middle" во всех остальных случаях.

# heroes$tall <- dplyr::case_when(
#   heroes$Height > 190 ~ "tall",
#   heroes$Height < 170 ~ "short",
#   TRUE ~ "middle"
# )
heroes$tall <- ifelse(heroes$Height > 190, 
                      "tall",
                      ifelse(heroes$Height < 170,
                             "short",
                             "middle"))

18.8 Создание функций

• Создайте функцию plus_one(), которая принимает число и возвращает это же число + 1.

plus_one <- function(x) x + 1

• Проверьте функцию plus_one() на числе 41.

plus_one(41)

[1] 42

• Создайте функцию circle_area, которая вычисляет площадь круга по радиусу согласно формуле \(\pi r^2\).

circle_area <- function(r) pi * r ^ 2

• Посчитайте площадь круга с радиусом 5.

circle_area(5)

[1] 78.53982

• Создайте функцию cels2fahr(), которая будет превращать градусы по Цельсию в градусы по Фаренгейту.

cels2fahr <- function(x) x * 9 / 5 + 32

• Проверьте на значениях -100, -40 и 0, что функция cels2fahr() работает корректно.

cels2fahr(c(-100, -40, 0))

[1] -148  -40   32

• Напишите функцию highlight(), которая принимает на входе строковый вектор, а возвращает тот же вектор, но дополненный значением "***" в начале и конце вектора. Лучше всего это рассмотреть на примере:

highlight <- function(x) c("***", x, "***")

highlight(c("Я", "Бэтмен!"))

[1] "***"     "Я"       "Бэтмен!" "***"    

• Теперь сделайте функцию highlight более гибкой. Добавьте в нее параметр wrapper =, который по умолчанию равен "***". Значение параметра wrapper = и будет вставлено в начало и конец вектора.

highlight <- function(x, wrapper = "***") c(wrapper, x, wrapper)

• Проверьте написанную функцию на векторе c("Я", "Бэтмен!").

highlight(c("Я", "Бэтмен!")) 

[1] "***"     "Я"       "Бэтмен!" "***"    

highlight(c("Я", "Бэтмен!"), wrapper = "__") 

[1] "__"      "Я"       "Бэтмен!" "__"     

• Создайте функцию trim(), которая будет возвращать вектор без первого и последнего значения (вне зависимости от типа данных).

trim <- function(x) x[c(-1, -length(x))]

• Проверьте, что функция trim() работает корректно:

trim(1:7)

[1] 2 3 4 5 6

trim(letters)

 [1] "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
[20] "u" "v" "w" "x" "y"

• Теперь добавьте в функцию trim() параметр n = со значением по умолчанию 1. Этот параметр будет обозначать сколько значений нужно отрезать слева и справа от вектора.

trim <- function(x, n = 1) x[c(-1:-n, (-length(x)+n-1):-length(x))]

• Проверьте полученную функцию:

trim(letters)

 [1] "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
[20] "u" "v" "w" "x" "y"

trim(letters, n = 2)

 [1] "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u"
[20] "v" "w" "x"

• Сделайте так, чтобы функция trim() работала корректно с n = 0, т.е. функция возвращала бы исходный вектор без изменений.

trim <- function(x, n = 1) {
  if (n == 0) return(x)
  x[c(-1:-n, (-length(x)+n-1):-length(x))]
}

trim(letters, n = 0)

 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
[20] "t" "u" "v" "w" "x" "y" "z"

• *Теперь добавьте проверку на адекватность входных данных: функция trim() должна выдавать ошибку, если n = меньше нуля или если n = слишком большой и отрезает все значения вектора:

trim <- function(x, n = 1) {
  if (n < 0) stop("n не может быть меньше нуля!")
  l <- length(x)
  if (n > ceiling(l/2) - 1) stop("n слишком большой!")
  if (n == 0) return(x)
  x[c(-1:-n, (-l+n-1):-l)]
}

• *Проверьте полученную функцию trim():

trim(1:6, 3)

Error in trim(1:6, 3): n слишком большой!

trim(1:6, -1)

Error in trim(1:6, -1): n не может быть меньше нуля!

• Создайте функцию na_n(), которая будет возвращать количество NA в векторе.

na_n <- function(x) sum(is.na(x))

• Проверьте функцию na_n() на векторе:

na_n(c(NA, 3:5, NA, 2, NA))

[1] 3

• Напишите функцию factors(), которая будет возвращать все делители числа в виде числового вектора.

Здесь может понадобиться оператор для получения остатка от деления: %%.

factors <- function(x) (1:x)[x %% (1:x) == 0]

• Проверьте функцию factors() на простых и сложных числах:

factors(3)

[1] 1 3

factors(161)

[1]   1   7  23 161

factors(1984)

 [1]    1    2    4    8   16   31   32   62   64  124  248  496  992 1984

• *Напишите функцию is_prime(), которая проверяет, является ли число простым.

Здесь может пригодиться функция any() - она возвращает TRUE, если в векторе есть хотя бы один TRUE.

is_prime <- function(x) !any(x%%(2:(x-1)) == 0)
#is_prime <- function(x) length(factors(x)) == 2 #Используя уже написанную функцию factors()

• Проверьте какие года были для нас простыми, а какие нет:

is_prime(2017)

[1] TRUE

is_prime(2019)

[1] FALSE

2019/3 #2019 делится на 3 без остатка

[1] 673

is_prime(2020)

[1] FALSE

is_prime(2021)

[1] FALSE

• *Создайте функцию monotonic(), которая возвращает TRUE, если значения в векторе не убывают (то есть каждое следующее - больше или равно предыдущему) или не возврастают.

Полезная функция для этого — diff() — возвращает разницу соседних значений.

monotonic <- function(x) all(diff(x)>=0) | all(diff(x)<=0)

monotonic(1:7)

[1] TRUE

monotonic(c(1:5,5:1))

[1] FALSE

monotonic(6:-1)

[1] TRUE

monotonic(c(1:5, rep(5, 10), 5:10))

[1] TRUE

Бинарные операторы типа + или %in% тоже представляют собой функции. Более того, мы можем создавать свои бинарные операторы! В этом нет особой сложности — нужно все так же создавать функцию (для двух переменных), главное окружать их % и название обрамлять обратными штрихами `. Например, можно сделать свой бинарный оператор %notin%, который будет выдавать TRUE, если значения слева нет в векторе справа:

`%notin%` <- function(x, y) ! (x %in% y)
1:10 %notin% c(1, 4, 5)

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

• *Создайте бинарный оператор %without%, который будет возвращать все значения вектора слева без значений вектора справа.

`%without%` <- function(x, y) x[!x %in% y]

c("а", "и", "б", "сидели", "на", "трубе") %without% c("а", "б")

[1] "и"      "сидели" "на"     "трубе" 

• *Создайте бинарный оператор %between%, который будет возвращать TRUE, если значение в векторе слева накходится в диапазоне значений вектора справа:

`%between%` <- function(x, y) x >= min(y) & x <= max(y)

1:10 %between% c(1, 4, 5)

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

18.9 Семейство функций apply()

• Создайте матрицу M2:

M2 <- matrix(c(20:11, 11:20), nrow = 5)
M2

     [,1] [,2] [,3] [,4]
[1,]   20   15   11   16
[2,]   19   14   12   17
[3,]   18   13   13   18
[4,]   17   12   14   19
[5,]   16   11   15   20

• Посчитайте максимальное значение матрицы M2 по каждой строчке.

apply(M2, 1, max)

[1] 20 19 18 19 20

• Посчитайте максимальное значение матрицы M2 по каждому столбцу.

apply(M2, 2, max)

[1] 20 15 15 20

• Посчитайте среднее значение матрицы M2 по каждой строке.

apply(M2, 1, mean)

[1] 15.5 15.5 15.5 15.5 15.5

• Посчитайте среднее значение матрицы M2 по каждому столбцу.

apply(M2, 2, mean)

[1] 18 13 13 18

• Создайте список list3:

list3 <- list(
  a = 1:5,
  b = 0:20,
  c = 4:24,
  d = 6:3,
  e = 6:25
  )

• Найдите максимальное значение каждого вектора списка list3.

sapply(list3, max)

 a  b  c  d  e 
 5 20 24  6 25 

• Посчитайте сумму каждого вектора списка list3.

sapply(list3, sum)

  a   b   c   d   e 
 15 210 294  18 310 

• Посчитайте длину каждого вектора списка list3.

sapply(list3, length)

 a  b  c  d  e 
 5 21 21  4 20 

• Напишите функцию max_item(), которая будет принимать на входе список, а возвращать - (первый) самый длинный его элемент.

Для этого вам может понадобиться функция which.max(), которая возвращает индекс максимального значения (первого, если их несколько).

max_item <- function (x) x[[which.max(sapply(x, length))]]

• Проверьте функцию max_item() на списке list3.

max_item(list3)

 [1]  0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20

• Теперь мы сделаем сложный список list4:

list4 <- list(1:3, 3:40, list3)

• Посчитайте длину каждого вектора в списке, в т.ч. для списка внутри. Результат должен быть списком с такой же структорой, как и изначальный список list4.

Для этого может понадобиться функция rapply(): recursive lapply

rapply(list4, length, how = "list")

[[1]]
[1] 3

[[2]]
[1] 38

[[3]]
[[3]]$a
[1] 5

[[3]]$b
[1] 21

[[3]]$c
[1] 21

[[3]]$d
[1] 4

[[3]]$e
[1] 20

• *Загрузите набор данных heroes и посчитайте, сколько NA в каждом из столбцов.

Для этого удобно использовать ранее написанную функцию na_n().

sapply(heroes, na_n)

         X       name     Gender  Eye.color       Race Hair.color     Height 
         0          0         29        172        304        172        217 
 Publisher Skin.color  Alignment     Weight       hair       tall 
         0        662          7        239        172        217 

• *Используя ранее написанную функцию is_prime(), напишите функцию prime_numbers(), которая будет возвращать все простые числа до выбранного числа.

is_prime <- function(x) !any(x %% (2:(x - 1)) == 0)
prime_numbers <- function(x) (2:x)[sapply(2:x, is_prime)]

prime_numbers(200)

 [1]   3   5   7  11  13  17  19  23  29  31  37  41  43  47  53  59  61  67  71
[20]  73  79  83  89  97 101 103 107 109 113 127 131 137 139 149 151 157 163 167
[39] 173 179 181 191 193 197 199

library(tidyverse)
heroes <- read_csv("data/heroes_information.csv",
                   na = c("-", "-99"))
powers <- read_csv("data/super_hero_powers.csv")

18.10 magrittr::%>%

• Перепишите следующие выражения, используя %>%:

sqrt(sum(1:10))

[1] 7.416198

1:10 %>%
  sum() %>%
  sqrt()

[1] 7.416198

abs(min(-5:5))

[1] 5

-5:5 %>%
  min() %>%
  abs()

[1] 5

c("Корень из", 2, "равен", sqrt(2))

[1] "Корень из"       "2"               "равен"           "1.4142135623731"

2 %>% c("Корень из", ., "равен", sqrt(.))

[1] "Корень из"       "2"               "равен"           "1.4142135623731"

##Выбор строк: dplyr::slice() и dplyr::filter() {#solution_filt}

• Выберите только те строчки, в которых содержится информация о супергероях тяжелее 500 кг.

heroes %>% 
  filter(Weight > 500)

• Выберите только те строчки, в которых содержится информация о женщинах-супергероях тяжелее 500 кг.

heroes %>% 
  filter(Weight > 500 & Gender == "Female")

• Выберите только те строчки, в которых содержится информация о супергероях человеческой расы ("Human") женского пола. Из этих супергероев возьмите первые 5.

heroes %>% 
  filter(Race == "Human" & Gender == "Female") %>%
  slice(1:5)

##Выбор столбцов: dplyr::select() {#solution_select}

• Выберете первые 4 столбца в powers.

powers %>%
  select(1:4)

• Выберите все столбцы от Reflexes до Empathy в тиббле powers:

powers %>%
  select(Reflexes:Empathy)

• Выберите все столбцы тиббла powers кроме первого (hero_names):

powers %>%
select(!hero_names)

18.11 Сортировка строк: dplyr::arrange()

• Выберите из тиббла heroes колонки name, Gender, Height и отсортируйте строчки по возрастанию Height.

heroes %>%
  select(name, Gender, Height) %>%
  arrange(Height)

• Выберите из тиббла heroes колонки name, Gender, Height и отсортируйте строчки по убыванию Height.

heroes %>%
  select(name, Gender, Height) %>%
  arrange(desc(Height))

• Выберите из тиббла heroes колонки name, Gender, Height и отсортируйте строчки сначала по Gender, затем по убыванию Height.

heroes %>%
  select(name, Gender, Height) %>%
  arrange(Gender, desc(Height))

18.12 Уникальные значения: dplyr::distinct()

• Извлеките уникальные значения столбца Eye color из тиббла heroes.

heroes %>%
  distinct(`Eye color`)

• Извлеките уникальные значения столбца Hair color из тиббла heroes.

heroes %>%
  distinct(`Hair color`)

18.13 Создание колонок: dplyr::mutate() и dplyr::transmute()

• Создайте колонку height_m с ростом супергероев в метрах, затем выберите только колонки name и height_m.

heroes %>%
  mutate(height_m = Height/100) %>%
  select(name, height_m)

• Создайте новою колонку hair в heroes, в которой будет значение “Bold” для тех супергероев, у которых в колонке Hair.color стоит “No Hair,” и значение “Hairy” во всех остальных случаях. Затем выберите только колонки name, Hair color, hair.

heroes %>%
  mutate(hair = ifelse(`Hair color` == "No Hair", "Bold", "Hairy")) %>%
  select(name, `Hair color`, hair)

18.14 Агрегация: dplyr::group_by() %>% summarise()

• Посчитайте количество супергероев по расам и отсортируйте по убыванию. Извлеките первые 5 строк.

heroes %>%
  count(Race, sort = TRUE) %>%
  slice(1:5)

• Посчитайте средний пост по полу.

heroes %>%
  group_by(Gender) %>%
  summarise(height_mean = mean(Height, na.rm = TRUE))

18.15 Операции с несколькими колонками: across()

• Посчитайте количество NA в каждой колонке, группируя по полу (Gender).

na_n <- function(x) sum(is.na(x))
heroes %>%
  group_by(Gender) %>%
  summarise(across(everything(), na_n))

• Посчитайте количество NA в каждой колонке, которая заканчивается на "color", группируя по полу (Gender).

na_n <- function(x) sum(is.na(x))
heroes %>%
  group_by(Gender) %>%
  summarise(across(ends_with("color"), na_n))

• Создайте из тиббла heroes новый тиббл с колонками name, Height и Weight, где для каждого героя содержится значение "выше среднего", если его рост или вес выше среднего по колонке и "ниже среднего", если ниже или равен среднему.

higher_than_average <- function(x) ifelse(x > mean(x, na.rm = TRUE),
                                          "выше среднего",
                                          "ниже среднего")
heroes %>%
  transmute(name, 
            across(c(Height, Weight), 
                   higher_than_average))

• Создайте из тиббла heroes новый тиббл с колонками Gender, name, Height и Weight, где для каждого героя содержится значение "выше среднего", если его рост или вес выше среднего по колонке и "ниже среднего", если ниже или равен среднему внутри соответствующей группы по полу.

heroes %>%
  group_by(Gender) %>%
  transmute(name, 
            across(c(Height, Weight), 
                   higher_than_average))

18.16 Соединение датафреймов: *_join {#solution_join}

Создайте тиббл web_creators, в котором будут супергерои, которые могут плести паутину, т.е. у них стоит TRUE в колонке Web Creation в тиббле powers.

powers_web <- powers %>%
  select(hero_names, `Web Creation`)
web_creators <- left_join(heroes, powers_web, by = c("name" = "hero_names")) %>%
  filter(`Web Creation`)
web_creators

• Найдите всех супергероев, которые присутствуют в heroes, но отсутствуют в powers. Ответом должен быть строковый вектор с именами супергероев.

anti_join(heroes, powers, by = c("name" = "hero_names")) %>%
  pull(name)

 [1] "Agent 13"          "Alfred Pennyworth" "Arsenal"          
 [4] "Batgirl III"       "Batgirl V"         "Beetle"           
 [7] "Black Goliath"     "Black Widow II"    "Blaquesmith"      
[10] "Bolt"              "Boomer"            "Box"              
[13] "Box III"           "Captain Mar-vell"  "Cat II"           
[16] "Cecilia Reyes"     "Clea"              "Clock King"       
[19] "Colin Wagner"      "Colossal Boy"      "Corsair"          
[22] "Cypher"            "Danny Cooper"      "Darkside"         
[25] "ERG-1"             "Fixer"             "Franklin Storm"   
[28] "Giant-Man"         "Giant-Man II"      "Goliath"          
[31] "Goliath"           "Goliath"           "Guardian"         
[34] "Hawkwoman"         "Hawkwoman II"      "Hawkwoman III"    
[37] "Howard the Duck"   "Jack Bauer"        "Jesse Quick"      
[40] "Jessica Sanders"   "Jigsaw"            "Jyn Erso"         
[43] "Kid Flash II"      "Kingpin"           "Meteorite"        
[46] "Mister Zsasz"      "Mogo"              "Moloch"           
[49] "Morph"             "Nite Owl II"       "Omega Red"        
[52] "Paul Blart"        "Penance"           "Penance I"        
[55] "Plastic Lad"       "Power Man"         "Renata Soliz"     
[58] "Ronin"             "Shrinking Violet"  "Snake-Eyes"       
[61] "Spider-Carnage"    "Spider-Woman II"   "Stacy X"          
[64] "Thunderbird II"    "Two-Face"          "Vagabond"         
[67] "Vision II"         "Vulcan"            "Warbird"          
[70] "White Queen"       "Wiz Kid"           "Wondra"           
[73] "Wyatt Wingfoot"    "Yellow Claw"      

• Найдите всех супергероев, которые присутствуют в powers, но отсутствуют в heroes. Ответом должен быть строковый вектор с именами супергероев.

anti_join(powers, heroes, by = c("hero_names" = "name")) %>%
  pull(hero_names)

 [1] "3-D Man"           "Bananaman"         "Bizarro-Girl"     
 [4] "Black Vulcan"      "Blue Streak"       "Bradley"          
 [7] "Clayface"          "Concrete"          "Dementor"         
[10] "Doctor Poison"     "Fire"              "Hellgramite"      
[13] "Lara Croft"        "Little Epic"       "Lord Voldemort"   
[16] "Orion"             "Peek-a-Boo"        "Queen Hippolyta"  
[19] "Reactron"          "SHDB"              "Stretch Armstrong"
[22] "TEST"              "Tommy Clarke"      "Tyrant"           

18.17 Tidy data

• Для начала создайте тиббл heroes_weight, скопировав код:

heroes_weight <- heroes %>%
  filter(Publisher %in% c("DC Comics", "Marvel Comics")) %>%
  group_by(Gender, Publisher) %>%
  summarise(weight_mean = mean(Weight, na.rm = TRUE)) %>%
  drop_na()
heroes_weight 

Функция drop_na() позволяет выбросить все строчки, в которых встречается NA.

• Превратите тиббл heroes_weight в широкий тиббл:

heroes_weight %>%
  pivot_wider(names_from = "Publisher", values_from = "weight_mean")

• Затем превратите его обратно в длинный тиббл:

heroes_weight %>%
  pivot_wider(names_from = "Publisher", values_from = "weight_mean") %>%
  pivot_longer(cols = !Gender,
               names_to = "Publisher",
               values_to = "weight_mean")

• Сделайте powers длинным тибблом с тремя колонками: hero_names, power (названгие суперсилы) и has (наличие суперсилы у данного супергероя).

powers %>%
  pivot_longer(cols = !hero_names,
               names_to = "power",
               values_to = "has")

• Сделайте тиббл powers обратно широким, но с новой структурой: каждая строчка означает суперсилу, а каждая колонка - супергероя (за исключением первой колонки - названия суперсилы).

powers %>%
  pivot_longer(cols = !hero_names,
               names_to = "power",
               values_to = "has") %>%
  pivot_wider(names_from = hero_names,
              values_from = has)