4 Функции

Безусловно, в R дикое множество различных функций. Но иногда нам и их не хватает. И возникает потребность написать свои. Сделать это, на самом деле, вовсе не так сложно, как может показаться. Разберёмся по порядку.

Для начала нам нужно осознать, что функция — это объект (такой же объект, как и вектор, матрица или список). И этот объект создается с помощью некоторой функции и имеет имя, которое возникает в результате присваивания. Пока вроде всё знакомо, не так ли?

Функция, которая делает функции называется function() (внезапно!). Таким образом выглядит её конструкция:

my_func <- function() {
  
}

my_func — название нашей новой функции, function() — собственно функция, которая требует на вход аргументы нашей будушей функции, а в фигурных скобках мы будем описывать, как наша функция работает.

Теперь нам нужно вспомнить, что функция должна что-то принимать на вход и что-то возвращать в результате работы. На самом деле можно начать с ещё более простого варианта — когда функция даже ничего не принимает на вход, а просто что-то возвращает после выполнения:

my_hello <- function() {
  return("Hello, world!")
}
my_hello()

## [1] "Hello, world!"

Функция return() определяет, что будет возвращать наша функция как итог работы. В данном случае она возвращает нам строку "Hello, world!". Мы можем немного изменить нашу функцию, чтобы она приветствовала не только мир, но и того, кто к ней обратился:

my_hello <- function(name) {
  phrase <- paste0("Hello, ", name, "!")
  return(phrase)
}
my_hello("Антон")

## [1] "Hello, Антон!"

Теперь функция приветствует меня и не только — надо всего лишь указать имя того, кому надо сказать «привет».

А что будет, если не указать ничего?

my_hello()

## Error in paste0("Hello, ", name, "!"): argument "name" is missing, with no default

Функция нам сообщает, что аргумент name является обязательным. Что ж, если мы не хотим такой ошибки, то можем задать значение по умолчанию:

my_hello <- function(name = "world") {
  phrase <- paste0("Hello, ", name, "!")
  return(phrase)
}
my_hello("Антон")

## [1] "Hello, Антон!"

my_hello()

## [1] "Hello, world!"

Теперь функция приветствует того, кто указан в её аргументе, а если не указано никого — приветствует весь мир! Pacific function.

Мы создавали промежуточную переменную phrase, в которую записывали результат работы функции paste0(), которая занимается соединением строк. Но у нас достаточно простая функция, поэтому нет необходимости занимать лишние строки. Можно упростить её следующим образом:

my_hello <- function(name = "world") {
  return(paste0("Hello, ", name, "!"))
}
my_hello()

## [1] "Hello, world!"

Но можно пойти и ещё дальше!

my_hello <- function(name = "world") {
  paste0("Hello, ", name, "!")
}
my_hello()

## [1] "Hello, world!"

Даже return() не обязателен! Функция просто возвращает результат последней выплоненной команды. Красота!

Общий принцип создания и работы функции понятен. Попробуем сделать что-то более интересное. Например, применим какие-то логические конструкции.

Напишем простую функцию, которая будет определять, чётное число или нечётное. Чётность определяется остатком от деления на два: если остаток равен нулю, то число чётное, иначе — нечётное.

Конечно, в R как и в любом другом языке программирования есть if else statement и for and while loops. Но зачем они нам, если есть ifelse() и векторизация?

Чтобы написать такую функцию, нам надо понять, как работает функция ifelse(). Работает она достаточно просто: она требует на вход три аргумента — условие, которое необходимо проверить, значение, которое необходимо вернуть, если условие выполнено, и значение, которое необходимо вернуть, если условие не выполнено. Например,

ifelse(2 > 8, "верно", "неверно")

## [1] "неверно"

ifelse(10 != 2, "верно", "неверно")

## [1] "верно"

Как мы можем использовать эту функцию для написания кастомной? Вот так:ъ

odd_even <- function(x) {
  ifelse(x %% 2 == 0, 'even', 'odd')
}
odd_even(2)

## [1] "even"

odd_even(3)

## [1] "odd"

Но можно написать ещё короче! Всего в одну строку!

odd_even <- function(x) ifelse(x %% 2 == 0, 'even', 'odd')
odd_even(5)

## [1] "odd"

odd_even(8)

## [1] "even"

Посчитайте пингвинов! Напишите функцию, которая выводит корректную форму слова «пингвин» в ответ на ввод некоторого числа.

penguin(1)

## [1] "1 пингвин"

penguin(3)

## [1] "3 пингвина"

penguin(10)

## [1] "10 пингвинов"

4.1 Открытый исходный код

В R можно не только написать свои функции, но и посмотреть, как написаны другие, то есть увидеть исходный код. Для этого надо написать название функции и выполнить её как команду (без скобок):

sd # стандартное отклонение --- корень из дисперсии

## function (x, na.rm = FALSE) 
## sqrt(var(if (is.vector(x) || is.factor(x)) x else as.double(x), 
##     na.rm = na.rm))
## <bytecode: 0x7fa447a717d0>
## <environment: namespace:stats>

lm # функция для построения линейной регрессионной модели

## function (formula, data, subset, weights, na.action, method = "qr", 
##     model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
##     contrasts = NULL, offset, ...) 
## {
##     ret.x <- x
##     ret.y <- y
##     cl <- match.call()
##     mf <- match.call(expand.dots = FALSE)
##     m <- match(c("formula", "data", "subset", "weights", "na.action", 
##         "offset"), names(mf), 0L)
##     mf <- mf[c(1L, m)]
##     mf$drop.unused.levels <- TRUE
##     mf[[1L]] <- quote(stats::model.frame)
##     mf <- eval(mf, parent.frame())
##     if (method == "model.frame") 
##         return(mf)
##     else if (method != "qr") 
##         warning(gettextf("method = '%s' is not supported. Using 'qr'", 
##             method), domain = NA)
##     mt <- attr(mf, "terms")
##     y <- model.response(mf, "numeric")
##     w <- as.vector(model.weights(mf))
##     if (!is.null(w) && !is.numeric(w)) 
##         stop("'weights' must be a numeric vector")
##     offset <- model.offset(mf)
##     mlm <- is.matrix(y)
##     ny <- if (mlm) 
##         nrow(y)
##     else length(y)
##     if (!is.null(offset)) {
##         if (!mlm) 
##             offset <- as.vector(offset)
##         if (NROW(offset) != ny) 
##             stop(gettextf("number of offsets is %d, should equal %d (number of observations)", 
##                 NROW(offset), ny), domain = NA)
##     }
##     if (is.empty.model(mt)) {
##         x <- NULL
##         z <- list(coefficients = if (mlm) matrix(NA_real_, 0, 
##             ncol(y)) else numeric(), residuals = y, fitted.values = 0 * 
##             y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w != 
##             0) else ny)
##         if (!is.null(offset)) {
##             z$fitted.values <- offset
##             z$residuals <- y - offset
##         }
##     }
##     else {
##         x <- model.matrix(mt, mf, contrasts)
##         z <- if (is.null(w)) 
##             lm.fit(x, y, offset = offset, singular.ok = singular.ok, 
##                 ...)
##         else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, 
##             ...)
##     }
##     class(z) <- c(if (mlm) "mlm", "lm")
##     z$na.action <- attr(mf, "na.action")
##     z$offset <- offset
##     z$contrasts <- attr(x, "contrasts")
##     z$xlevels <- .getXlevels(mt, mf)
##     z$call <- cl
##     z$terms <- mt
##     if (model) 
##         z$model <- mf
##     if (ret.x) 
##         z$x <- x
##     if (ret.y) 
##         z$y <- y
##     if (!qr) 
##         z$qr <- NULL
##     z
## }
## <bytecode: 0x7fa447c11ee0>
## <environment: namespace:stats>