B01-03 函数进阶

2017-08-02 20:39:39

知识扩展

函数的结构

R有两类函数: 闭包(closure)和内置(primitive)函数

闭包

由R代码写成
包括3部分: 形参(formals, 即arglist)、函数体(body)和环境
和普通R对象一样，也有attributes、class等属性

function (arglist) expr 
return(value)

内置函数

由C语言写成，通常内置于base包内
没有形参(arglist)、函数体(body)和环境
没有attributes、class等属性

function (arglist) .Primitive(method)

例子

构造一个自定义函数addN

addN <- function(x, n=1) return(x+n)
formals(addN)

## $x
## 
## 
## $n
## [1] 1

body(addN)

## return(x + n)

environment(addN)

## <environment: R_GlobalEnv>

查看内置函数sum

sum

## function (..., na.rm = FALSE)  .Primitive("sum")

formals(sum)

## NULL

body(sum)

## NULL

environment(sum)

## NULL

函数、对象、环境

f <- function(x, y) {
    print(list("本闭包环境"=ls()))
    print(list("上一层环境"=ls(envir=parent.frame())))
    return(x+y)}
a <- 1; b <- 2

当前环境有些什么对象?

list("当前环境"=ls())

## $当前环境
## [1] "a" "b" "f"

运行f()函数，该闭包环境里有些什么对象?

f(a, b)

## $本闭包环境
## [1] "x" "y"
## 
## $上一层环境
## [1] "a" "b" "f"

## [1] 3

作用域

作用域(scoping)的概念会在B01_04讲

f <- function(x) x + y
y <- 10

函数定义中找不到y，则到上一级环境中找

f(1)

## [1] 11

如果找到R_GlobalEnv仍找不到，则返回错误

rm(y)
f(1)

Error in f(1) : object 'y' not found

操作皆函数

“To understand computations in R, two slogans are helpful:

Everything that exists is an object.

Everything that happens is a function call."
— John Chambers

代数算符

x <- 5
y <- 3
c(x + y, `+`(x, y))

## [1] 8 8

all.equal(x + y, `+`(x, y))

## [1] TRUE

算符函数	等价于
`-`(5, 2)	5 - 2
`*`(5, 2)	5 * 2
`/`(5, 2)	5 / 2
`%%`(5, 2)	5 %% 2
`==`(5, 2)	5 == 2

这些也是函数

for (i=1:2) print(i)

`for`(i, 1:2, print(i))

## [1] 1
## [1] 2

if (3>2) print("y") else print("n")

`if`(3>2, print("y"), print("n"))

## [1] "y"

连这些也是函数

`[`(1:5, 3)

## [1] 3

`[`(iris, 4, 5)

## [1] setosa
## Levels: setosa versicolor virginica

`[[`(as.list(1:4), 2)

## [1] 2

`{`(print("a"), print(3))

## [1] "a"
## [1] 3

`<-`(x, 4); x

## [1] 4

用函数自定义操作符

排列组合

`%A%` <- function(n, m) choose(n, m) * factorial(m)
`%C%` <- function(n, m) choose(n, m)

5 %A% 3

## [1] 60

5 %C% 3

## [1] 10

函数参数

参数匹配原则

完整参数名精确匹配
参数名前缀模糊匹配
参数顺序匹配

f <- function(first, second, third=5) 
    c(first=first, second=second, 
      third=third)

f("a", TRUE)

##  first second  third 
##    "a" "TRUE"    "5"

f(second="a", TRUE)

##  first second  third 
## "TRUE"    "a"    "5"

f(t="a", TRUE, f=5)

##  first second  third 
##    "5" "TRUE"    "a"

参数列表实践建议

函数作者
- 参数名称要意义明确，避免过长或过度缩写
- 无默认值的参数在前，有默认值的参数在后
- 最重要的无默认值参数放在最前面
- CRAN的附加包规范禁止使用参数模糊匹配，故尽量用参数全名
- 在…后面的参数，必须用完整参数名精确匹配
函数使用者
- 第一、二个参数不妨用顺序匹配，其余的尽量用精确匹配
- 尽量避免模糊匹配

参数缺失和默认值

f <- function(x, y) {
    if (missing(x)) x <- 0
    if (missing(y)) y <- 0
    return(c(x, y))
}
f()

## [1] 0 0

等价于

f <- function(x=0, y=0) c(x, y)

限定参数取值范围

数值

f <- function(x=1:4) {
    stopifnot(x %in% 1:4)
    paste("out:", x[[1]])
}
f()

## [1] "out: 1"

f(6)

Error: x %in% 1:4 is not TRUE

非数值

f <- function(x=c("a", "b")) {
    x <- match.arg(x)
    paste("out:", x)
}
f()

## [1] "out: a"

f('c')

Error in match.arg(x) : 
    'arg' should be one of “a”, “b”

dot dot dot (…)

...匹配所有的“其他”参数，可轻松地传递给其他函数
- 用list(...)捕获所有未匹配参数
...过于灵活，可导致参数跳过校验而不报错

f <- function(..., na.rm=TRUE) {
    # 解析...参数
    args <- unlist(list(...))
    # 校验: 如不是全为数值，则报错
    stopifnot(all(is.numeric(args)))
    # 计算均值
    mean(unlist(args), na.rm=na.rm)
}
f(1, 4, 6, 9, NA)

## [1] 5

f(1, 4, 6, 9, "m")

Error: all(is.numeric(args)) is not TRUE

f <- function(...){
    args <- list(...)
    if ("x" %in% names(args)) 
        print(mean(args$x))
    if ("y" %in% names(args)) 
        print(sd(args$y))
    plot(...)
}

f(x=1:5, y=log(1:5), 
  col="blue", type="b")

## [1] 3
## [1] 0.6355094

特殊调用

替换函数

形如fun<-，具体用法为fun() <-
事实上R生成了一个修改后的副本，然后才删除原本

library(pryr)
x <- 1:10
address(x)

## [1] "0x3831270"

`revise<-` <- function(x, n, value) {
    x[[n]] <- value
    x
}

revise(x, 5) <- 7
x

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

address(x)

## [1] "0x36a4490"

等价于x[5] <- 7 (内置函数[<-)
内部方法(primitive)可实现原位替换
拷贝修改机制有时可能导致内存溢出

返回值

函数返回return()函数显式定义的值，并跳出调用栈
如没有return，则返回函数最后一个求解出的值

f <- function(x, y){
    if (x < y) {
        "lower"
    }else{
        "higher or equal"
    }
}
f(4, 3)

## [1] "higher or equal"

f <- function(x, y){
    if (!all(is.numeric(x), 
             is.numeric(y))) 
        return(
            "Must be both numeric!")
    if (x < y) {
        "lower"
    }else{
        "higher or equal"
    }
}
f("a", 3)

## [1] "Must be both numeric!"

on.exit()

函数退出调用栈时，通过on.exit()函数可触发钩子
通常用于重置状态，恢复运行前的设置

f <- function(x){
    setwd("C:")
    x
}
f(1)

[1] 1

getwd()

[1] "C:/"

f <- function(x){
    old.wd <- getwd()
    on.exit(setwd(old.wd))
    x
}
f(1)

[1] 1

getwd()

[1] "/R_Tutorial/B01 FP And OOP"

Thank you!

回到主目录