R语言基础--函数构建

函数的编写

参考文章

格式如下所示：

函数名 <- function(数据,参数1=默认值,...)
{
异常处理;
表达式(循环/判别);
return(返回值);
}

函数案例A

输入直角三角形的两个边长，求斜边长

rcal <- function(x,y){ 
z <- x^2 + y^2 
result <- sqrt(z) 
return(result) 
}

运行结果如下所示：

rcal <- function(x,y){ 
+     z <- x^2 + y^2 
+     result <- sqrt(z) 
+     return(result) 
+ } 
rcal(3,4)
[1] 5

函数案例B

给出两个数字后，直接给出这两个数的平方和

sqtest <- function(x,y){
z1 = x^2;z2=y^2;z3=z1+z2;
return(z3);
}
sqtest(3,4)

运行结果如下所示：

sqtest <- function(x,y){
+     z1 = x^2;z2=y^2;z3=z1+z2;
+     return(z3);
+ }
sqtest(3,4)
[1] 25

函数案例C-转换百分比

创建一个函数，将小数转换为百分数，如下所示：

addPercent <- function(x){
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}
x <- c(0.011, 0.0022, 0.1234)
addPercent(x)

运行结果如下所示：

addPercent <- function(x){
+   percent <- round(x*100, digits = 1)
+   result <- paste(percent, "%", setp="")
+   return(result)
+ }

x <- c(0.011, 0.0022, 0.1234)

addPercent(x)
[1] "1.1 % "  "0.2 % "  "12.3 % "

在R中，函数其实就是一种对象，可以像操作其他对象一样操作，例如可以将函数赋予一个新的对象来实现它的拷贝，如下所示：

addPercent <- function(x){
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}
ppaste <- addPercent
x <- c(0.011, 0.0022, 0.1234)
ppaste(x)

运行结果如下所示：

addPercent <- function(x){
+   percent <- round(x*100, digits = 1)
+   result <- paste(percent, "%", setp="")
+   return(result)
+ }

ppaste <- addPercent
x <- c(0.011, 0.0022, 0.1234)

ppaste(x)
[1] "1.1 % "  "0.2 % "  "12.3 % "

需要注意的是，我们在输入ppaste <- addPercent，函数addPercent后面我们并没有加()，这说明，只是将函数addPercet本身给ppaste这个变量，而不是调用addPercent这个函数。当我们输入ppaste，不加括号时，就会出现函数的内容，如下所示：

ppaste
function(x){
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}

其实在R中，只输入函数本身，不输入括号，都会显示函数的内容，再看如下代码：

mean
function (x, ...) 
UseMethod("mean")
<bytecode: 0x000000000baf0a08>
<environment: namespace:base>
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: 0x0000000004c04a38>
<environment: namespace:stats>

函数的返回结果

还以前面的addPercent()函数为例说明一下，它的代码如下所示：

addPercent <- function(x){
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}

在大括号中最后一行是return(result)，把它删掉，再运行代码，如下所示：

addPercent <- function(x){
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
}
x <- c(0.011, 0.0022, 0.1234)
addPercent(x)
print(addPercent(x))

可以发现，addPercent(x)没有返回结果，而print(addPercent(x))返回了原计算结果。因此在这里看来，return(result)这行代码是多余的，其实不一定，如果我们想要提前结束函数的运行，就会有用了，现在把addPercent()改造一下，加入一行代码，即

if(!is.numeric(x)) return(NULL)，如下所示：

addPercent <- function(x){
  if(!is.numeric(x)) return(NULL)
  percent <- round(x*100, digits = 1)
  result <- paste(percent, "%", setp="")
}
x <- c(0.011, 0.0022, 0.1234)
y <- c("Hello, R")
addPercent(x)
addPercent(y)

运行结果如下所示：

addPercent(x)
addPercent(y)
NULL

变量x是数字，运行没问题，但变量y是字符串，就出现了问题，此时reurn()语句就派上了用场，函数判断出来了变量y不是数字，就返回了NULL。

函数的简化

只要函数体只包含一行代码，那么包围函数体的大括号{}有的时候可以省略，将这行代码直接放在参数列表后面即可，如下所示：

odds <- function(x) x / (1 - x)
odds(0.8)

运行结果如下所示：

odds <- function(x) x / (1 - x)
odds(0.8)
[1] 4

现在我们使用这种方式来重写addPercent()函数，如下所示：

addPercent <- function(x) paste(round(x * 100, digits = 1), "%", sep = "")
addPercent(0.0021)

运行结果如下不所示：

addPercent <- function(x) paste(round(x * 100, digits = 1), "%", sep = "")
addPercent(0.0021)
[1] "0.2%"

但是，通常情况下并不推荐这么写，因为可读性太差。其实这种方式还可以继续简化，那就是匿名函数。

给函数添加更多的参数

addPercent()会自动将传入的数字乘以100，如果待转换的数字已经是百分数了，那么就需要将其除以100，再传入参数，如下所示：

percentages <- c(58.23, 120.4, 33)
addPercent(percentages/100)

运行结果如下所示：

percentages <- c(58.23, 120.4, 33)
addPercent(percentages/100)
[1] "58.2%"  "120.4%" "33%"

此时，为了更加方法，可以给addPercent()函数再添加一个参数，用于控制数字的乘或除，例如我们添加一个mult参数，如下所示：

addPercent <- function(x, mult){
  percent <- round(x*mult, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}
percentages <- c(58.23, 120.4, 33)
decimalstages <- c(0.001, 0.123, 1.334)
addPercent(percentages, mult = 1)
addPercent(decimalstages, mult = 100)

运行结果如下所示：

addPercent(percentages, mult = 1)
[1] "58.2 % "  "120.4 % " "33 % "   
addPercent(decimalstages, mult = 100)
[1] "0.1 % "   "12.3 % "  "133.4 % "

设置默认值

还以上面的案例为例说明一下，如果我们忘记了传递mult参数，那么就会出错，如下所示：

addPercent(decimalstages)
Error in addPercent(decimalstages) : 
  argument "mult" is missing, with no default

为避免这种情况，可以为mult参数添加一个默认值，如下所示：

addPercent <- function(x, mult=100){
  percent <- round(x*mult, digits = 1)
  result <- paste(percent, "%", setp="")
  return(result)
}
decimalstages <- c(0.001, 0.123, 1.334)
addPercent(decimalstages)

运行结果如下所示：

addPercent(decimalstages)
[1] "0.1 % "   "12.3 % "  "133.4 % "

三点参数

如果我们再为addPercent()函数添加一个参数用于控制保留的小数位置，此时就已经有了3个参数，参数已经比较多了，这样参数的传入列表会很长，R中为此有一个很好的解决方案，就是三点参数（...），其实从R的很多函数中我们就能看到这种形式，例如我们在pheatmap这个包中的pheatmap()这个函数中就能看到这种形式，如下所示：

pheatmap(mat, color = colorRampPalette(rev(brewer.pal(n = 7, name =
  "RdYlBu")))(100), kmeans_k = NA, breaks = NA, border_color = "grey60",
  cellwidth = NA, cellheight = NA, scale = "none", cluster_rows = TRUE,
  cluster_cols = TRUE, clustering_distance_rows = "euclidean",
  clustering_distance_cols = "euclidean", clustering_method = "complete",
  clustering_callback = identity2, cutree_rows = NA, cutree_cols = NA,
  treeheight_row = ifelse((class(cluster_rows) == "hclust") || cluster_rows,
  50, 0), treeheight_col = ifelse((class(cluster_cols) == "hclust") ||
  cluster_cols, 50, 0), legend = TRUE, legend_breaks = NA,
  legend_labels = NA, annotation_row = NA, annotation_col = NA,
  annotation = NA, annotation_colors = NA, annotation_legend = TRUE,
  annotation_names_row = TRUE, annotation_names_col = TRUE,
  drop_levels = TRUE, show_rownames = T, show_colnames = T, main = NA,
  fontsize = 10, fontsize_row = fontsize, fontsize_col = fontsize,
  angle_col = c("270", "0", "45", "90", "315"), display_numbers = F,
  number_format = "%.2f", number_color = "grey30", fontsize_number = 0.8
  * fontsize, gaps_row = NULL, gaps_col = NULL, labels_row = NULL,
  labels_col = NULL, filename = NA, width = NA, height = NA,
  silent = FALSE, na_col = "#DDDDDD", ...)

可以看到，最后就是三个点（...），说明参数列表还有，省略了。

现在使用这种三点参数来修改addPercent()函数，其格式如下所示：

addPercent <- function(x, mult=100, ...){
  percent <- round(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
decimalstages <- c(0.3331, 0.13323, 1.33334)
addPercent(decimalstages, digits = 2)

运行结果如下所示：

addPercent(decimalstages, digits = 2)
[1] "33.31 % "  "13.32 % "  "133.33 % "
addPercent(decimalstages)
[1] "33 % "  "13 % "  "133 % "

将函数当作参数

在R中，可以将函数当作参数，例如在apply()系列函数中就能遇到。在前面的案例中，addPercent()中使用了round()函数，但是如果我们想要使用其它的函数，例如signif()，那么就可以将这个函数当作参数，具体的实现形式如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}

这种形式下，在percent <- FUN(x*mult, ...)这一步，默认情况下使用的是round()函数，如果要使用signif()这个函数，使用addPercent()时，直接在FUN=中直接添加上signif即可，如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
x <- c(0.1223, 0.8956, 0.4234)
addPercent(x, FUN=signif, digits = 3)

计算结果如下所示：

 addPercent(x, FUN=signif, digits = 3)
[1] "12.2 % " "89.6 % " "42.3 % "

现在解释一下这个函数的调用过程：

向量x乘以mult（默认是100）；
R将signif()函数的代码传递给FUN参数，这样FUN()就成了signif()函数的一份拷贝，功能和行为都与之相同；
R接收参数digits并将其传递给FUN()。
在这里需要注意的是，FUN=signif这个参数中,signif并没有添加小括号，如果添加了小括号，就是将signif()函数的调用结果而非函数本身赋值给参数FUN。

匿名函数

在上面的案例中，参数FUN其实可以传递各种参数，甚至也可以没有函数名称，直接复制代码即可，因此FUN参数除了使用函数名进行赋值外，还可以直接将代码放在FUN中，这种直接放代码的形式就是以匿名函数的方式进行传递的，所谓的匿名函数（Anonymous Function）就是指没有名称的函数，看下面的案例：

addPercent <- function(x, mult=100, FUN=round, ...){
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
profits <- c(2100, 1430, 3580, 5230)
addPercent(profits, FUN = function(x) round(x / sum(x) *100))

运行结果如下所示：

profits <- c(2100, 1430, 3580, 5230)
addPercent(profits, FUN = function(x) round(x / sum(x) *100))
[1] "17 % " "12 % " "29 % " "42 % "

其实还可以继续简化，如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
profits <- c(2100, 1430, 3580, 5230)
addPercent(profits/sum(profits))

计算结果如下所示：

profits <- c(2100, 1430, 3580, 5230)
addPercent(profits/sum(profits))
[1] "17 % " "12 % " "29 % " "42 % "

匿名函数的使用前提是，①函数本身代码很短，②只会使用一次，不会用在别的地方。

函数匹配

前面提到的“将函数作为参数”案例中，通过将函数名将代码传递一个参数，这就意味着，假如有一个与函数名相同的对象，就会出错，例如我们在调用addPercent()函数之前，再定义一个名为round的对象，如下所示：

round <- c(0.45, -0.45, 58.5)

此时再调用addPercent()函数，如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
addPercent(round, FUN=round)

运行结果如下所示：

round <- c(0.45, -0.45, 58.5)
addPercent(round, FUN=round)
Error in FUN(x * mult, ...) : could not find function "FUN"

此时就出错了，因为R没有将round()函数传递给FUN，而是把向量round赋予给了FUN，为了避免这种情况，可以调用一下match.fun()函数，如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  FUN <- match.fun(FUN)
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}
round <- c(0.45, -0.45, 58.5)
addPercent(round, FUN=round)

运行结果如下所示：

round <- c(0.45, -0.45, 58.5)
addPercent(round, FUN=round)
[1] "45 % "   "-45 % "  "5850 % "

match.fun函数会查找与名称round相匹配的函数，并将代码复制给FUN，而不会找到round向量，另外，match.fun()还支持字符对象，例如FUN='round'这样传递参数也是有效的。

处理作用域

在前面的案例中，我们只使用了Workspace，也就是说，创建的每一个以对象都存在于整个环境中，这个环境被称为全局环境（Global Environment）。在前面的案例中，函数内部的 一些参数，例如x，mult和FUN并非都是创建在Workspace中的对象，它们是在函数内部创建的对象，这些变量在退出函数回到Workspace后都无法使用了，看下面的一个案例：

首选创建一个对象x和函数test()，如下所示：

x <- 1:5
test <- function(x){
  cat("This is x: ", x, "\n")
  rm(x)
  cat("This is x after removing it:", x, "\n")
}
x
test(5:1)

运行结果如下所示：

x
[1] 1 2 3 4 5
test(5:1)
This is x:  5 4 3 2 1 
This is x after removing it: 1 2 3 4 5

从上面的案例可以发现，test()这个函数的功能就是接收一个参数x，输出到控制台，然后将其删除，并再次输出。函数内部虽然已经使用了rm(x)来删除这个x，但是x还是能输出，不过，两次输出的x内容并不一样。

函数的检索路径

在一个函数被调用时，它将首选创建一个临时的本地环境(Local Environment)，这个本地环境嵌套在全局环境中，这意味着本地环境中仍然可以访问全局环境内的对象。只要函数执行完毕，本地环境就会立即释放，同时其中的所有对象也会被销毁。

换一种说法就是：函数创建的环境始终位于调用它的环境之内，而调用它的环境被称为父环境(Parent Environment)。所以，当我们从Worksapce中通过脚本或命令行调用某个函数时，它的父环境恰好为全局环境。

下图就是test()函数调用的原理：

image

外层的大矩形表示全局环境，而内层的灰色矩形则表示test函数的本地环境。在全局环境中，我们将对象x赋值为1:5，而在调用函数内部，则另外创建了一个参数x，赋值为5:1，这个参数成为了本地环境中的一个对象。

当R在代码中发现了一个对象x时，它将首先检索本地环境。而恰好能够找到参数x，所以它将被用在第一次的cat()调用中，接下来一行，R移除了这个对象x。所以，当R到达第三行时，就再也找不到本地环境中的对象x了。

此时，R会顺序环境栈上移，到达全局环境，并在其中查找名为x的对象，由于其中也恰好有x，因此它将被用于第二次的cat()调用。

如果在函数内部使用rm()，在默认情况下，它只会删除位于函数中的对象，这可以避免在函数中使用更大范围数据集所带来的内存消耗风险，因为我们可以在使用这个对象后立即将其删除，而无需等待函数执行完毕。

使用内部函数

test()函数出现的调用全局环境对象的问题其实是没有意义的，因为我们从一开始就应该避免函数对全局环境对象的依赖。事实上，R背后隐藏的整个概念都不支持将全局变量应用到函数内部。R作为一门函数式编程语言，它的一个主要思想就是在于任何函数的输出结果都不能依赖于外部环境，而仅仅是由传入的参数决定。只要各个参数的值相同，结果就不会发生变化。这种操作的优势在于，有时候我们想要在某个函数内部重复地执行某种操作，但离开这个函数后，这一操作又是没有意义的。

假设我们要比较几盏灯在半供电和全供电时亮度的差异，而用来遮挡外面太阳光的窗帘又不能完全阻挡光线的进入，因此还需要测量日光提供的亮度，然后将灯光的测量结果减去日光的亮度，来修正最终的结果。

要计算半供电时的灯光效率，可以实现下面的函数：

calculate.eff <- function(x, y, control){
  min.base <- function(z)  - mean(control)
  min.base(x) / min.base(y)
}

在ccalculate.eff()函数内部，可以看到有另外一个函数的定义：min.base()，这个函数定义在calculate.eff()函数的本地环境中，并且也会在离开函数时销毁，也就是说，它并不存在于Workspace内。

我们可以像下面这样调用这个函数：

calculate.eff <- function(x, y, control){
  min.base <- function(z) z - mean(control)
  min.base(x) / min.base(y)
}
half <- c(2.23, 3.23, 1.48)
full <- c(4.85, 4.995, 4.12)
nothing <- c(0.14, 0.18, 0.56, 0.23)
calculate.eff(half, full,nothing)

计算结果如下所示：

half <- c(2.23, 3.23, 1.48)
full <- c(4.85, 4.995, 4.12)
nothing <- c(0.14, 0.18, 0.56, 0.23)
calculate.eff(half, full,nothing)

[1] 0.4270093 0.6258612 0.3129473

从源代码中可以看到，min.base()的定义中使用了对象control，但这个对象并没有出现在函数的参数列表中，其原因可以看一下这个函数的调用过程，如下所示：

image

调用过程如下所示：

  1. 函数calculate.eff()创建了一个本地环境，包含对象x（其值为fifty），y（其值为hundred），control（值为nothing），以及函数min.base()；
  2. 函数min.base()在calculate.eff()函数内创建了一个新的本地环境，包含对象z，值为x；
  3. min.base()在calculate.eff()的环境内查找对象control，计算其中每个元素的平均值，并将z的每个元素减去这个平均值，之后返回结果；
  4. 与前一个过程相同，只是z的值换成了y。
  5. 3和4的结果相除，结果返回到全局环境。

本地环境所嵌入的环境实际上是函数被定义的地方，而非调用的地方。假设我们在calculate.eff()内使用addPercent()来格式化数字，那么addPercent()所创建的本地环境不会被嵌入在calculate.eff()中，而是在全局环境内，也就是addPercent()被定义的地方。

方法分配

关于函数的另外一个问题就是函数的方法问题。因为理解了这方面的知识，才能理解函数如何能够根据传入参数的类型来确定返回不同的结果。R中有一个机制被称为通用函数系统（Generic Function System），它允许用户使用相同的名称调用不同的函数。

例如，当我们输出一个列表时，输出会以行的方式进行排列，当我们输出一个数据框的时候，则会以列的方式显示，由此可见，print()函数对待列表和数据框的方式是不同的，但是所用的函数却是一样的。

现在看一下print()函数的代码，如下所示：

print
function (x, ...) 
UseMethod("print")

最后两行可以忽略，它表示的是外层空间的东西，供R语言的高手使用，第1行可以看出来，print()这个函数的函数体只有一行代码。

像这种什么都不做，仅仅是将对象正确地传递给其他函数的函数被称为通用函数(Generic Function)。print()就是一个通用函数。真正完成实际工作的函数被称方法（Methods）。可见，所有的方法都是函数，但并不是每个函数都是方法。

通过UseMethod调用方法

print()仅靠那一行代码肯定是完成无法完成不同方式打印向量、数据框、列表等复杂任务的，真正完成的其实是UseMethod()这个函数，这个函数做的所有事情就是告诉R查找一个能够处理传入参数x类型相匹配的函数。R会完整地遍历定义的函数名称，查找以print形状，后面接一个点号加上对象类型名的函数。

我们也可以通过apropos('print\\.')的命令来实现这个过程，如下所示：

apropos('print\\.')

 [1] ".rs.rnbHooks.print.html"             ".rs.rnbHooks.print.htmlwidget"      
 [3] ".rs.rnbHooks.print.knit_asis"        ".rs.rnbHooks.print.knit_image_paths"
 [5] ".rs.rnbHooks.print.shiny.tag"        ".rs.rnbHooks.print.shiny.tag.list"  
 [7] "print.AsIs"                          "print.by"                           
 [9] "print.condition"                     "print.connection"                   
[11] "print.data.frame"                    "print.Date"                         
[13] "print.default"                       "print.difftime"                     
[15] "print.Dlist"                         "print.DLLInfo"                      
[17] "print.DLLInfoList"                   "print.DLLRegisteredRoutines"        
[19] "print.eigen"                         "print.factor"                       
[21] "print.function"                      "print.hexmode"                      
[23] "print.libraryIQR"                    "print.listof"                       
[25] "print.NativeRoutineList"             "print.noquote"                      
[27] "print.numeric_version"               "print.octmode"                      
[29] "print.packageInfo"                   "print.POSIXct"                      
[31] "print.POSIXlt"                       "print.proc_time"                    
[33] "print.restart"                       "print.rle"                          
[35] "print.simple.list"                   "print.srcfile"                      
[37] "print.srcref"                        "print.summary.table"                
[39] "print.summary.warnings"              "print.summaryDefault"               
[41] "print.table"                         "print.warnings"

apropos()括号内的引号之间可以添加正则表达式，这与grep()函数非常类似。假如我们要打印一个数据框，那么R将查找函数print.data.frame()，并使用它来打印作为参数传入的对象，我们可以手工调用这个函数，如下所示：

small.one <- data.frame(a = 1:2, b = 2:1)
small.one
print(small.one)
print.data.frame(small.one)

运行结果如下所示：

small.one <- data.frame(a = 1:2, b = 2:1)
small.one

  a b
1 1 2
2 2 1
print(small.one)

  a b
1 1 2
2 2 1

print.data.frame(small.one)

  a b
1 1 2
2 2 1

函数的输出结果与调用通过的print(small.one)函数是完全相同的，因为print()将打印small.one的任务完全交给了print.data.frame()函数来完成。

使用默认方法

对于列表来说，你可能会觉得print.list()函数承担了打印任务，但实际上print.list()函数并不存在，此时R会忽略对象的类型，直接调用默认方法print.default()来打印列表。

许多通过函数都有一个默认方法，当无法调用特定方法执行时将派上用场，如果存在默认方法，那么它的名称必然是函数名后面加点，再加上default。我们来看一下默认方法打印small.one这个变量的结果：

small.one <- data.frame(a = 1:2, b = 2:1)
print.default(small.one)

运行结果如下所示：

small.one <- data.frame(a = 1:2, b = 2:1)
print.default(small.one)

$a
[1] 1 2
$b
[1] 2 1

attr(,"class")

[1] "data.frame"

实现自己的通用函数

用户自己也可以实现自己的通用函数。现在看前面的addPercent()函数，它的代码如下所示：

addPercent <- function(x, mult=100, FUN=round, ...){
  FUN <- match.fun(FUN)
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}

对于addPercent()函数来说，传入的参数x不能是字符向量，因为它无法参与后面的乘法运算，但可以利用方法分配机制，实现一个特定的函数来处理这一问题，如下所示：

addPercent.character <- function(x){
  paste(x, "%", sep="")
}

需要注意的是，这里的对象不是向量，而是字符，同样的原理，之前那个addPercent(0函数也应该变成针对特定类型对象的方法，将名称改为addPercent.numeric。在实现方法分配时，如果代码不是过长，应该尽量把所有函数的实现放在同一个脚本文件中，这样只要运行一个脚本，就可以使用完整的函数功能。

接着定义最外层的addPercent()函数，如下所示：

addPercent <- function(x, ...){
  UseMethod("addPercent")
}

函数只定义了两个参数，x和...，...参数确保在addPercent.numeric()函数中使用的其它参数依然有效，这些附加参数将会原封不动地传递给内部调用的函数。当把完整的脚本文件发送给控制台后，就哦可以向addPercent()函数传入字符向量或数值向量了，如下所示：

addPercent.character <- function(x){
  paste(x, "%", sep="")
}
addPercent.numeric <- function(x, mult=100, FUN=round, ...){
  FUN <- match.fun(FUN)
  percent <- FUN(x*mult, ...)
  result <- paste(percent, "%", setp="")
  return(result)
}

addPercent <- function(x, ...){
  UseMethod("addPercent")
}

new.numbers <- c(0.82,0.022, 1.62, 0.4)
addPercent(new.numbers,FUN=floor)
addPercent(letters[1:6])
small.one <- data.frame(a = 1:2, b = 2:1)
small.one
addPercent(small.one)

运行结果如下所示：

addPercent(new.numbers,FUN=floor)

[1] "82 % "  "2 % "   "162 % " "40 % " 

addPercent(letters[1:6])

[1] "a%" "b%" "c%" "d%" "e%" "f%"

small.one <- data.frame(a = 1:2, b = 2:1)
small.one

  a b
1 1 2
2 2 1

addPercent(small.one)
Error in UseMethod("addPercent") : 

  no applicable method for 'addPercent' applied to an object of class "data.frame"

其中，addPercent(small.one)这行代码出错。出错的信息显示，没有适当的方法用于处理传入的数据框，此时 们还可以修改这种错误提示，如下所示：

addPercent.default <- function(x){

  cat('You should try a numeric or character vector.\n')

}

这段代码的功能在于显示一条信息，这条信息相对于R默认的错误信息更容易理解，现在运行完整代码，如下所示：

addPercent.character <- function(x){

  paste(x, "%", sep="")

}

addPercent.numeric <- function(x, mult=100, FUN=round, ...){

  FUN <- match.fun(FUN)

  percent <- FUN(x*mult, ...)

  result <- paste(percent, "%", setp="")

  return(result)

}

addPercent <- function(x, ...){

  UseMethod("addPercent")

}

addPercent.default <- function(x){

  cat('You should try a numeric or character vector.\n')

}

new.numbers <- c(0.82,0.022, 1.62, 0.4)

addPercent(new.numbers,FUN=floor)

addPercent(letters[1:6])

small.one <- data.frame(a = 1:2, b = 2:1)

small.one

addPercent(small.one)

结果如下所示：

addPercent(new.numbers,FUN=floor)

[1] "82 % "  "2 % "   "162 % " "40 % " 

addPercent(letters[1:6])

[1] "a%" "b%" "c%" "d%" "e%" "f%"

small.one <- data.frame(a = 1:2, b = 2:1)

small.one

  a b

1 1 2

2 2 1

addPercent(small.one)

You should try a numeric or character vector.

函数返回多个结果

当函数需要返回多个结果时，通常用list的形式返回结果，如下所示：

vms = function(x){

  xx=rev(sort(x)) 

# 对向量x从小到大排序，然后用ver()转换为从大到小排序

  xx=xx[1:5]

# 提取前5个元素

  mean(xx)

#求均值

  return(list(xbar=mean(xx),top5=xx))

}

运行后如下所示：

y <- c(12,4,65,22,33,123,322,90)
vms(y)
$xbar
[1] 126.6

$top5

[1] 322 123  90  65  33

使用单变量求解函数方程

用到的函数是optimize()，先看一个案例：

经济学的一个基本模型就是随着价格上涨，产品的销量会下降，可以使用如下的函数来表示：

sales <- function(price) {100 - 0.5*price}

那么期望收益就是产品价格与销量的乘积，如下所示：

revenue <- function(price) {price*sales(price)}

现在使用curve()函数将这两个函数画出来，它接收一个函数作为参数，并绘制出一定范围内的函数图像，我们假设定价范围在50美元到60美元之间，那么这个图像如下所示:

sales <- function(price) {100 - 0.5*price}
revenue <- function(price) {price*sales(price)}
par(mfrow = c(1, 2))
curve(sales, from = 50, to = 150, xname="price", ylab= "Sales", main="Sales")
curve(revenue, from=50, to=150, xname="price", ylab="Revenue", main="Revenue")
par(mfrow=c(1,2))

image

从上图的右图可以看出来，收益明显有一个最高点，因此现在使用R中的optimize()函数计算出这个最大值，如果要使用optimize()这个函数，要输入它目标函数（这里是revenue())和区间（这里是50~150），默认情况下，optimize()计算的是最小值，但此时我们要计算最大值，就需要调整一下，如下所示：

optimise(revenue, interval = c(50, 150), maximum = TRUE)

计算结果如下所示：

optimise(revenue, interval = c(50, 150), maximum = TRUE)
$maximum

[1] 100
$objective
[1] 5000

replicate函数

replicate函数与rep函数类似，rep函数的功能是将一个参数重复数次，如下所示：

rep(1,4)

[1] 1 1 1 1

rep(c(1,4),3)

[1] 1 4 1 4 1 4

而replicate函数则是把某个表达式重复计算数次，多数情况下，它们的计算结果都相同，除非是使用了随机数时才有可能不同，如下所示：

replicate(5, runif(1))

[1] 0.7306532 0.8837189 0.5781437 0.2151454 0.4487271

rep(runif(1),5)

[1] 0.7360304 0.7360304 0.7360304 0.7360304 0.7360304

replicate函数的这种功能在比较复杂的例子中使用很广，例如Monte Carlo个分析中。

现在看一个比较简单的案例。

在这个案例中，我们会分析某人上下班时使用不同交通工具所花费的时间，我们在这个案例中会创建一个time_for_commute函数，这个函数用sample随机挑选一种交通工具（小汽车、公交车或自行车），然后使用rnorm或rlnorm找到一个正态分布或对数正态分布的行程时间，代码如下所示：

time_for_commute <- function(){

  # select communication tool

  mode_of_transport <- sample(

    c("car", "bus", "train", "bike"),

    size = 1,

    prob = c(0.1, 0.2, 0.3, 0.4)

)

  time <- switch(

    mode_of_transport,

    car = rlnorm(1, log(30), 0.5),

    bus = rlnorm(1, log(40), 0.5),

    train = rnorm(1, 30, 10),

    bike = rnorm(1, 60, 5))

  names(time) <- mode_of_transport

  time

}

replicate(5, time_for_commute())

运行结果如下所示：

replicate(5, time_for_commute())

   train      bus      bus     bike      bus 

56.38663 53.76305 29.99244 60.87293 98.38907

代码解释：switch语句很难使这个函数被量化，这就说明，为了找到上下班时间的分布，我们需要多次调用time_for_commute来生成每天的数据。

参考资料

  1. R语言轻松入门与提高 [法]Andrie de Vries ,[比利时]Joris Mey [法] Andrie de Vries 著
  2. 学习R.[美] Richard，Cotton 著刘军 译
最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 204,293评论 6赞 478
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 85,604评论 2赞 381
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 150,958评论 0赞 337
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 54,729评论 1赞 277
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 63,719评论 5赞 366
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 48,630评论 1赞 281
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 38,000评论 3赞 397
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 36,665评论 0赞 258
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 40,909评论 1赞 299
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,646评论 2赞 321
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,726评论 1赞 330
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 33,400评论 4赞 321
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 38,986评论 3赞 307
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,959评论 0赞 19
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,197评论 1赞 260
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 44,996评论 2赞 349
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 42,481评论 2赞 342