Основы программирования

Ветвления

Задание 1

Напишите выражение, которое проверяет, есть ли в векторе пропущенные значения. Если есть прощенные значения - выдает предупреждение warning('есть пропуски').

vec <- sample(10, 5)
vec[3] <- NA

if (any(is.na(vec))) {
  warning('есть пропуски')
}

Задание 2

Дополните предыдущее задание альтернативным выводом - если пропусков нет, то выводится сообщение message('пропусков нет').

vec <- sample(10, 5)
if (any(is.na(vec))) {
  warning('есть пропуски')
} else {
  message('пропусков нет')
}

Задание 3

Напишите выражение которое будет проверять, четное ли число вектора, и если четное - возвращать 'odd', еси нечетное - 'even'.

Воспользоваться напрямую конструкцией if...else не получится, так как она проверяет одно логическое сравнение, соответственно, чтобы проверить вектор, придется использовать циклы. В данном случае решением будет воспользоваться функцией ifelse(), которая векторизована.

vec <- sample(10, 5)
vec
## [1]  1 10  8  3  4
ifelse(vec %% 2 == 0, 'even', 'odd')
## [1] "odd"  "even" "even" "odd"  "even"

Задание 4

У вас есть shiny-приложение, в котором можно переключать тип генерируемого распределения: нормальное, равномерное и логнормальное. Напишите выражение, которое будет в зависимости от параметра distrib будет генерировать семпл длиной в 20 элементов из одного из этих трех распределений. Параметры распределений возьмите по умолчанию.

distrib <- 'log-normal'
my_sample <- switch(distrib, 
                    'normal' = rnorm(20),
                    'uniform' = runif(20),
                    'log-normal' = rlnorm(20)
)
round(quantile(my_sample, probs = seq(0, 1, 0.1)), 3)
##    0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
## 0.208 0.322 0.332 0.480 0.627 0.917 1.223 1.913 2.737 4.032 9.630

Задание 5

Расширьте предыдущее задание так, чтобы при выборе трех других альтернатив ('cauchy', 'binomial', 'other') в distrib возвращалось значение 1.

Можно напрямую указать для каждой новой альтернативы значение 1, также можно воспользоваться механизмом обработки пропущенных значений аргументов, когда при выборе альтернативы, к которой не назначено значение, выбирается следующее непропущенное значение.

distrib <- 'binomial'
my_sample <- switch(distrib, 
                    'normal' = rnorm(20),
                    'uniform' = runif(20),
                    'log-normal' = rlnorm(20),
                    'cauchy' = ,
                    'binomial' = ,
                    'other' = 1
)
my_sample
## [1] 1

0.1 Циклы и *pply-функции {-}

Задание 1

Напишите простой цикл, который перебирает элементы вектора и проверяет, пропущено значение или нет. Если пропущено - выводит warning('есть пропуски').

vec <- sample(10, 7)
vec[c(3, 6)] <- NA

for (i in vec) {
  if (is.na(i))
    warning('есть пропуски')
}

Задание 2

Напишите цикл, который перебирает элементы вектора до тех пор, пока не найдет значение, кратное 3.

Можно воспользоваться как связкой for + break(), но корректнее в данном случае будет использовать цикл while или repeat.

i <- 1
while (i %% 7 != 0) {
  print(paste('i = ', i))
  i <- i + 1
}
## [1] "i =  1"
## [1] "i =  2"
## [1] "i =  3"
## [1] "i =  4"
## [1] "i =  5"
## [1] "i =  6"

Задание 3

Найдите в цикле. все значения вектора 1:200, которые нацело делятся на 17, и составьте из них вектор vec_17.

При работе с циклами неправильно использовать наращивание вектора в цикле (т.е. выражения вида x <- c(x, new_value)). Корректным будет создать вектор определенной длины, который потом заполнять по индексу. В данном случае длина вектора будет 200 %/% 17 = 11 (максимальный возможный множитель, при котором произведение будет меньше или равно 200).

max_values <- 200 %/% 17
vec_17 <- vector('numeric', length = max_values)
for (i in 1:max_values) {
  vec_17[i] <- i * 17
}
vec_17
##  [1]  17  34  51  68  85 102 119 136 153 170 187

В целом неоптимально подобные задачи решать в цикле. Для этого есть векторизация.

vec_17 <- 1:max_values * 17
vec_17
##  [1]  17  34  51  68  85 102 119 136 153 170 187

Задание 4

Создайте квадратную таблицу 5 * 5 (mx <- matrix(5, 5)), в которой по диагоналям будут расположены 99, а в остальных ячейках 0.

Как и в предыдущем задании, корректно сначала создать таблицу, а потом ее заполнять значениями.

mx <- matrix(data = 0, nrow = 5, ncol = 5)
for (i in 1:5) {
  for (j in 1:5)
    if (i == j | i == 6 - j)
        mx[i, j] <- 99
}
mx
##      [,1] [,2] [,3] [,4] [,5]
## [1,]   99    0    0    0   99
## [2,]    0   99    0   99    0
## [3,]    0    0   99    0    0
## [4,]    0   99    0   99    0
## [5,]   99    0    0    0   99

Задание 5

Найдите максимальное значение по каждой колонке в таблице mtcars. Для каждой колонки выведите строку 'Максимальное значение по колонке xxx: zzz', где xxx и zzz - название колонки и максимальное значение соответственно.

for (i in 1:ncol(mtcars)) {
  col_value <- max(mtcars[, i])
  col_name <- names(mtcars)[i]
  msg <- paste0('Максимальное значение по колонке ', col_name, ': ', col_value)
  print(msg)
}
## [1] "Максимальное значение по колонке mpg: 33.9"
## [1] "Максимальное значение по колонке cyl: 8"
## [1] "Максимальное значение по колонке disp: 472"
## [1] "Максимальное значение по колонке hp: 335"
## [1] "Максимальное значение по колонке drat: 4.93"
## [1] "Максимальное значение по колонке wt: 5.424"
## [1] "Максимальное значение по колонке qsec: 22.9"
## [1] "Максимальное значение по колонке vs: 1"
## [1] "Максимальное значение по колонке am: 1"
## [1] "Максимальное значение по колонке gear: 5"
## [1] "Максимальное значение по колонке carb: 8"
names(mtcars)
##  [1] "mpg"  "cyl"  "disp" "hp"   "drat" "wt"   "qsec" "vs"   "am"   "gear"
## [11] "carb"

Задание 6

Решите задание 5 с помощью функции apply().

Функция apply() возвращает именованный вектор, который можно сразу использовать в формировании текстового сообщения.

vec <- apply(mtcars, 2, max)
paste0('Максимальное значение по колонке ', names(vec), ': ', vec)
##  [1] "Максимальное значение по колонке mpg: 33.9" 
##  [2] "Максимальное значение по колонке cyl: 8"    
##  [3] "Максимальное значение по колонке disp: 472" 
##  [4] "Максимальное значение по колонке hp: 335"   
##  [5] "Максимальное значение по колонке drat: 4.93"
##  [6] "Максимальное значение по колонке wt: 5.424" 
##  [7] "Максимальное значение по колонке qsec: 22.9"
##  [8] "Максимальное значение по колонке vs: 1"     
##  [9] "Максимальное значение по колонке am: 1"     
## [10] "Максимальное значение по колонке gear: 5"   
## [11] "Максимальное значение по колонке carb: 8"

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

Задание 1

Выведите аргументы функции read.table()

args(read.table)
## function (file, header = FALSE, sep = "", quote = "\"'", dec = ".", 
##     numerals = c("allow.loss", "warn.loss", "no.loss"), row.names, 
##     col.names, as.is = !stringsAsFactors, na.strings = "NA", 
##     colClasses = NA, nrows = -1, skip = 0, check.names = TRUE, 
##     fill = !blank.lines.skip, strip.white = FALSE, blank.lines.skip = TRUE, 
##     comment.char = "#", allowEscapes = FALSE, flush = FALSE, 
##     stringsAsFactors = FALSE, fileEncoding = "", encoding = "unknown", 
##     text, skipNul = FALSE) 
## NULL

Задание 2

Напишите простую функцию f1, которая складывает два введенных числа.

f1 <- function(x, y) {
  res <- x + y
  return(res)
}
f1(x = 3, y = 8)
## [1] 11

Задание 3

Напишите простую функцию f2, которая складывает два введенных числа, при этом второй аргумент по умолчанию равен 12.

f2 <- function(x, y = 12) {
  res <- x + y
  return(res)
}
f2(x = 3, y = 8)
## [1] 11
f2(x = 3)
## [1] 15

Задание 4

Напишите функцию, которая возвращает сумму двух переданных аргументов и их произведение.

Функции возвращают один объект, поэтому если необходимо вернуть два или более объекта, их надо объединить в список.

f3 <- function(x, y) {
  res_sum <- x + y
  res_mult <- x * y
  res <- list(sum = res_sum, mult = res_mult)
  return(res)
}
f3(x = 3, y = 8)
## $sum
## [1] 11
## 
## $mult
## [1] 24

Задание 5

Напишите функцию, которая возвращает класс переданных в функцию объектов. Количество объектов может быть любым.

Здесь необходимо использовать три точки, ... - обозначение необязательных аргументов. То есть, на место трех точек может быть передано в качестве аргументов что угодно, в том числе и любое количество объектов.

my_fun_dot <- function(...) sapply(list(...), class)
my_fun_dot('a', 5, TRUE)
## [1] "character" "numeric"   "logical"

Задание 6

С помощью анонимной функций и функции семейства *pply напишите выражение, которое будет добавлять к каждому элементу вектора letters слово letter, например, letter a.

sapply(letters[1:5], function(x) paste("letter", x))
##          a          b          c          d          e 
## "letter a" "letter b" "letter c" "letter d" "letter e"