4 Функции
Безусловно, в R дикое множество различных функций. Но иногда нам и их не хватает. И возникает потребность написать свои. Сделать это, на самом деле, вовсе не так сложно, как может показаться. Разберёмся по порядку.
Для начала нам нужно осознать, что функция — это объект (такой же объект, как и вектор, матрица или список). И этот объект создается с помощью некоторой функции и имеет имя, которое возникает в результате присваивания. Пока вроде всё знакомо, не так ли?
Функция, которая делает функции называется function()
(внезапно!). Таким образом выглядит её конструкция:
my_func
— название нашей новой функции, function()
— собственно функция, которая требует на вход аргументы нашей будушей функции, а в фигурных скобках мы будем описывать, как наша функция работает.
Теперь нам нужно вспомнить, что функция должна что-то принимать на вход и что-то возвращать в результате работы. На самом деле можно начать с ещё более простого варианта — когда функция даже ничего не принимает на вход, а просто что-то возвращает после выполнения:
## [1] "Hello, world!"
Функция return()
определяет, что будет возвращать наша функция как итог работы. В данном случае она возвращает нам строку "Hello, world!"
. Мы можем немного изменить нашу функцию, чтобы она приветствовала не только мир, но и того, кто к ней обратился:
my_hello <- function(name) {
phrase <- paste0("Hello, ", name, "!")
return(phrase)
}
my_hello("Антон")
## [1] "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, Антон!"
## [1] "Hello, world!"
Теперь функция приветствует того, кто указан в её аргументе, а если не указано никого — приветствует весь мир! Pacific function.
Мы создавали промежуточную переменную phrase
, в которую записывали результат работы функции paste0()
, которая занимается соединением строк. Но у нас достаточно простая функция, поэтому нет необходимости занимать лишние строки. Можно упростить её следующим образом:
## [1] "Hello, world!"
Но можно пойти и ещё дальше!
## [1] "Hello, world!"
Даже return()
не обязателен! Функция просто возвращает результат последней выплоненной команды. Красота!
Общий принцип создания и работы функции понятен. Попробуем сделать что-то более интересное. Например, применим какие-то логические конструкции.
Напишем простую функцию, которая будет определять, чётное число или нечётное. Чётность определяется остатком от деления на два: если остаток равен нулю, то число чётное, иначе — нечётное.
Конечно, в R как и в любом другом языке программирования есть if else statement и for and while loops. Но зачем они нам, если есть
ifelse()
и векторизация?
Чтобы написать такую функцию, нам надо понять, как работает функция ifelse()
. Работает она достаточно просто: она требует на вход три аргумента — условие, которое необходимо проверить, значение, которое необходимо вернуть, если условие выполнено, и значение, которое необходимо вернуть, если условие не выполнено. Например,
## [1] "неверно"
## [1] "верно"
Как мы можем использовать эту функцию для написания кастомной? Вот так:ъ
## [1] "even"
## [1] "odd"
Но можно написать ещё короче! Всего в одну строку!
## [1] "odd"
## [1] "even"
![](img/code.png)
Посчитайте пингвинов! Напишите функцию, которая выводит корректную форму слова «пингвин» в ответ на ввод некоторого числа.
## [1] "1 пингвин"
## [1] "3 пингвина"
## [1] "10 пингвинов"
4.1 Открытый исходный код
В R можно не только написать свои функции, но и посмотреть, как написаны другие, то есть увидеть исходный код. Для этого надо написать название функции и выполнить её как команду (без скобок):
## 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>
## 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>