• Posts tagged "S3"

Blog Archives

R语言基于S3的面向对象编程

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-class-s3/

r-class-s3

前言

对于R语言的面向对象编程,不同于其他的编程语言,R语言提供了3种底层对象类型,一种是S3类型,一种是S4类型,还有一种是RC类型。

S3对象简单、具有动态性、结构化特征不明显;S4对象结构化、
功能强大;RC对象是2.12版本后使用的新类型,用于解决S3,S4很难实现的对象。

本文将从S3对象开始,介绍R语言面向对象编程的细节。

目录

  1. S3对象介绍
  2. 创建S3对象
  3. 泛型函数和方法调用
  4. 查看S3对象的函数
  5. S3对象继承
  6. S3对象的缺点
  7. S3对象的使用

1 S3对象介绍

在R语言中,基于S3对象的面向对象编程,是一种基于泛型函数的实现方式。泛型函数是一种特殊的函数, 根据传入对象的类型决定调用哪个具体的方法。基于S3对象实现的面向对象编程,不同其他语言的面向对象编程,是一种动态函数调用的模拟实现。S3对象被广泛应用于R的早期的开发包中。

关于面向对象的介绍,请参考文章:R语言面向对象编程

2 创建S3对象

本文的系统环境

  • Linux: Ubuntu Server 12.04.2 LTS 64bit
  • R: 3.0.1 x86_64-pc-linux-gnu

注:pryr只支持Linux系统环境

为了方便我们检查对象的类型,引入pryr包作为辅助工具。关于pryr包的介绍,请参考文章:撬动R内核的高级工具包pryr


# 加载pryr包
> library(pryr)

通过变量创建S3对象


> x<-1
> attr(x,'class')<-'foo'

> x
[1] 1
attr(,"class")
[1] "foo"

> class(x)
[1] "foo"

# 用pryr包的otype函数,检查x的类型
> otype(x)
[1] "S3"

通过structure()函数创建S3对象


> y <- structure(2, class = "foo")

> y
[1] 2
attr(,"class")
[1] "foo"

> class(y)
[1] "foo"

> otype(y)
[1] "S3"

创建一个多类型的S3对象

S3对象没有明确结构关系,一个S3对象可以有多个类型, S3对象的 class 属性可以是一个向量,包括多种类型。


> x<-1
> attr(x,'class')<- c("foo", "bar")
> class(x)
[1] "foo" "bar"
> otype(x)
[1] "S3"

3 泛型函数和方法调用

对于S3对象的使用,通常用UseMethod()函数来定义一个泛型函数的名称,通过传入参数的class属性,来确定不同的方法调用。

定义一个teacher的泛型函数

+ 用UseMethod()定义teacher泛型函数
+ 用teacher.xxx的语法格式定义teacher对象的行为
+ 其中teacher.default是默认行为


# 用UseMethod()定义teacher泛型函数
> teacher <- function(x, ...) UseMethod("teacher")

# 用pryr包中ftype()函数,检查teacher的类型
> ftype(teacher)
[1] "s3"      "generic"

# 定义teacher内部函数
> teacher.lecture <- function(x) print("讲课")
> teacher.assignment <- function(x) print("布置作业")
> teacher.correcting <- function(x) print("批改作业")
> teacher.default<-function(x) print("你不是teacher")

方法调用时,通过传入参数的class属性,来确定不同的方法调用。

  • 定义一个变量a,并设置a的class属性为lecture
  • 把变量a,传入到teacher泛型函数中
  • 函数teacher.lecture()函数的行为被调用

> a<-'teacher'

# 给老师变量设置行为
> attr(a,'class') <- 'lecture'

# 执行老师的行为
> teacher(a)
[1] "讲课"

当然,我们也可以直接调用teacher中定义的行为,如果这样做了就失败了面向对象封装的意义。


> teacher.lecture()
[1] "讲课"

> teacher.lecture(a)
[1] "讲课"

> teacher()
[1] "你不是teacher"

4 查看S3对象的函数

当我们使用S3对象进行面向对象封装后,可以用methods()函数来查看S3对象中的定义的内部行为函数。


# 查看teacher对象
> teacher
function(x, ...) UseMethod("teacher")

# 查看teacher对象的内部函数
>  methods(teacher)
[1] teacher.assignment teacher.correcting teacher.default    teacher.lecture

通过methods()的generic.function参数,来匹配泛型函数名字。


> methods(generic.function=predict)
 [1] predict.ar*                predict.Arima*             predict.arima0*
 [4] predict.glm                predict.HoltWinters*       predict.lm
 [7] predict.loess*             predict.mlm                predict.nls*
[10] predict.poly               predict.ppr*               predict.prcomp*
[13] predict.princomp*          predict.smooth.spline*     predict.smooth.spline.fit*
[16] predict.StructTS*

   Non-visible functions are asterisked

通过methods()的class参数,来匹配类的名字。


> methods(class=lm)
 [1] add1.lm*           alias.lm*          anova.lm           case.names.lm*
 [5] confint.lm*        cooks.distance.lm* deviance.lm*       dfbeta.lm*
 [9] dfbetas.lm*        drop1.lm*          dummy.coef.lm*     effects.lm*
[13] extractAIC.lm*     family.lm*         formula.lm*        hatvalues.lm
[17] influence.lm*      kappa.lm           labels.lm*         logLik.lm*
[21] model.frame.lm     model.matrix.lm    nobs.lm*           plot.lm
[25] predict.lm         print.lm           proj.lm*           qr.lm*
[29] residuals.lm       rstandard.lm       rstudent.lm        simulate.lm*
[33] summary.lm         variable.names.lm* vcov.lm*

   Non-visible functions are asterisked

用getAnywhere()函数,查看所有的函数。


# 查看teacher.lecture函数
> getAnywhere(teacher.lecture)
A single object matching ‘teacher.lecture’ was found
It was found in the following places
  .GlobalEnv
  registered S3 method for teacher
with value

function(x) print("讲课")

# 查看不可见的函数predict.ppr
> predict.ppr
Error: object 'predict.ppr' not found
> exists("predict.ppr")
[1] FALSE

# getAnywhere()函数查找predict.ppr
> getAnywhere("predict.ppr")
A single object matching ‘predict.ppr’ was found
It was found in the following places
  registered S3 method for predict from namespace stats
  namespace:stats
with value

function (object, newdata, ...)
{
    if (missing(newdata))
        return(fitted(object))
    if (!is.null(object$terms)) {
        newdata <- as.data.frame(newdata)
        rn <- row.names(newdata)
        Terms <- delete.response(object$terms)
        m <- model.frame(Terms, newdata, na.action = na.omit,
            xlev = object$xlevels)
        if (!is.null(cl <- attr(Terms, "dataClasses")))
            .checkMFClasses(cl, m)
        keep <- match(row.names(m), rn)
        x <- model.matrix(Terms, m, contrasts.arg = object$contrasts)
    }
    else {
        x <- as.matrix(newdata)
        keep <- seq_len(nrow(x))
        rn <- dimnames(x)[[1L]]
    }
    if (ncol(x) != object$p)
        stop("wrong number of columns in 'x'")
    res <- matrix(NA, length(keep), object$q, dimnames = list(rn,
        object$ynames))
    res[keep, ] <- matrix(.Fortran(C_pppred, as.integer(nrow(x)),
        as.double(x), as.double(object$smod), y = double(nrow(x) *
            object$q), double(2 * object$smod[4L]))$y, ncol = object$q)
    drop(res)
}
<bytecode: 0x000000000df6c2d0>
<environment: namespace:stats>

使用getS3method()函数,也同样可以查看不可见的函数


# getS3method()函数查找predict.ppr
> getS3method("predict", "ppr")
function (object, newdata, ...)
{
    if (missing(newdata))
        return(fitted(object))
    if (!is.null(object$terms)) {
        newdata <- as.data.frame(newdata)
        rn <- row.names(newdata)
        Terms <- delete.response(object$terms)
        m <- model.frame(Terms, newdata, na.action = na.omit,
            xlev = object$xlevels)
        if (!is.null(cl <- attr(Terms, "dataClasses")))
            .checkMFClasses(cl, m)
        keep <- match(row.names(m), rn)
        x <- model.matrix(Terms, m, contrasts.arg = object$contrasts)
    }
    else {
        x <- as.matrix(newdata)
        keep <- seq_len(nrow(x))
        rn <- dimnames(x)[[1L]]
    }
    if (ncol(x) != object$p)
        stop("wrong number of columns in 'x'")
    res <- matrix(NA, length(keep), object$q, dimnames = list(rn,
        object$ynames))
    res[keep, ] <- matrix(.Fortran(C_pppred, as.integer(nrow(x)),
        as.double(x), as.double(object$smod), y = double(nrow(x) *
            object$q), double(2 * object$smod[4L]))$y, ncol = object$q)
    drop(res)
}
<bytecode: 0x000000000df6c2d0>
<environment: namespace:stats>

5 S3对象的继承关系

S3对象有一种非常简单的继承方式,用NextMethod()函数来实现。

定义一个 node泛型函数


> node <- function(x) UseMethod("node", x)
> node.default <- function(x) "Default node"

# father函数
> node.father <- function(x) c("father")

# son函数,通过NextMethod()函数指向father函数
> node.son <- function(x) c("son", NextMethod())

# 定义n1
> n1 <- structure(1, class = c("father"))
# 在node函数中传入n1,执行node.father()函数
> node(n1)
[1] "father"

# 定义n2,设置class属性为两个
> n2 <- structure(1, class = c("son", "father"))
# 在node函数中传入n2,执行node.son()函数和node.father()函数
> node(n2)
[1] "son"    "father"

通过对node()函数传入n2的参数,node.son()先被执行,然后通过NextMethod()函数继续执行了node.father()函数。这样其实就模拟了,子函数调用父函数的过程,实现了面向对象编程中的继承。

6 S3对象的缺点

从上面对S3对象的介绍来看,S3对象并不是完全的面向对象实现,而是一种通过泛型函数模拟的面向对象的实现。

  • S3使用起来简单,但在实际的面向对象编程过程中,当对象关系有一定的复杂度,S3对象所表达的意义就会变得不太清楚。
  • S3封装的内部函数,可绕过泛型函数的检查,以直接被调用。
  • S3参数的class属性,可以被任意设置,没有预处理的检查。
  • S3参数,只能通过调用class属性进行函数调用,其他属性则不会被class()函数执行。
  • S3参数的class属性有多个值时,调用时会按照程序赋值顺序来调用第一个合法的函数。

所以,S3只能R语言面向对象的一种简单的实现。

7 S3对象的使用

S3对象系统,被广泛地应用于R语言的早期开发中。在base包中,就有很多的S3对象。

base包的S3对象


# mean函数
> mean
function (x, ...)
UseMethod("mean")


> ftype(mean)
[1] "s3"      "generic"

# t函数
> ftype(t)
[1] "s3"      "generic"

# plot函数
> ftype(plot)
[1] "s3"      "generic"

自定义的S3对象


# 定义数字型变量a
> a <- 1
# 变量a的class为numeric
> class(a)
[1] "numeric"

# 定义泛型函数f1
> f1 <- function(x) {
+   a <- 2
+   UseMethod("f1")
+ }

# 定义f1的内部函数
> f1.numeric <- function(x) a

# 给f1()传入变量a
> f1(a)
[1] 2

# 给f1()传入数字99
> f1(99)
[1] 2

# 定义f1的内部函数
> f1.character <- function(x) paste("char", x)

# 给f1()传入字符a
> f1("a")
[1] "char a"

这样,我们就对S3对象系统有了一个全面认识,开始R语言的面向对象编程之路。

转载请注明出处:
http://blog.fens.me/r-class-s3/

打赏作者

撬动R内核的高级工具包pryr

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-pryr/

r-pryr

前言

随着对R语言的使用越来越深入,我们需要更多的对R语言底层的进行了解,比如数据结构S3,S4对象,函数的调用机制等。pryr包就是可以帮助我们了解R语言运行机制的工具。利用pryr包,我们可以更容易地接触R的核心。

本文为R语言的高级内容。

目录

  1. pryr介绍
  2. pryr安装
  3. pryr使用

1 pryr介绍

pryr包是一个深层的了解R语言运行机制的工具,可以帮助我们更加贴近R语言的核心。为了能开发出更高级R语言应用,需要我们更深入地懂R。

pryr的API介绍

内部实现工具:

  • promise对象:uneval(), is_promise()
  • 查询环境变量: where(), rls(), parenv()
  • 查看闭包函数变量: unenclose()
  • 函数调用关系:call_tree()
  • 查看对象底层对应的C语言类型 address(), refs(), typename()
  • 跟踪对象是否被修改track_copy()

面向对象检查:

  • 判断属于哪种类型对象: otype()
  • 判断属于哪种类型函数: ftype()

辅助编程函数:

  • 通过参数创建函数:make_function(), f()
  • 变量表达式替换:substitute_q(), subs()
  • 批量修改对象: modify_lang()
  • 快速创建list对象:dots(), named_dots()
  • 建匿名函数调用:partial()
  • 找符合条件函数:find_funs()

代码简化工具:

  • 创建延迟或直接绑定:%<d-%, %<a-%
  • 创建常量绑定:%<c-%
  • 重新绑定:rebind, <<-

2 pryr安装

系统环境

  • Linux Ubuntu 12.04.2 LTS 64bit
  • R 3.0.1 x86_64-pc-linux-gnu (64-bit)

由于项目pryr,还没有发布到CRAN,仅支持从github安装。我们要使用devtools包来通过github来安装。关于devtools包的使用,请参考文章:在巨人的肩膀前行 催化R包开发

pryr安装


~ R

# 安装devtools
# install.packages("devtools")

> library(devtools)
> install_github("pryr")

注:我尝试在Win7下安装,但出现了编译错误。

3 pryr使用

  • 3.1 创建匿名函数f()
  • 3.2 通过参数创建函数make_function()
  • 3.3 创建匿名函数调用partial()
  • 3.4 变量表达式替换substitute_q(), subs()
  • 3.5 面向对象类型判断otype(),ftype()
  • 3.6 查看对象底层的C语言类型 address(), refs(), typename()
  • 3.7 查看对象是否被修改track_copy()
  • 3.8 查看闭包函数变量 unenclose()
  • 3.9 批量修改对象 modify_lang()
  • 3.10 快速创建list对象 dots(), named_dots()
  • 3.11 查找符合条件函数 fun_calls()
  • 3.12 查询环境变量 where(), rls(), parenv()
  • 3.13 打印函数调用关系 call_tree(), ast()
  • 3.14 promise对象 uneval(), is_promise()
  • 3.15 数据绑定%<a-%, %<c-%,%<d-%, rebind,<<-

3.1 创建匿名函数f()

通过使用f()函数,可以实现创建匿名函数,在单行完成函数定义、调用、运算的操作。


# 创建一个匿名函数
> f(x + y)
function (x, y)
x + y

# 创建一个匿名函数,并赋值计算
> f(x + y)(1, 10)
[1] 11

# 创建一个匿名函数,指定参数和默认值
> f(x, y = 2, x + y)
function (x, y = 2)
x + y

# 创建一个匿名函数,并赋值计算
> f(x, y = 2, x + y)(1)
[1] 3

# 创建一个匿名函数,多行运行,并赋值计算
>  f({y <- runif(1); x + y})(3)
[1] 3.7483

3.2 通过参数创建函数make_function()

通过使用make_function()函数,可以通过make_function()函数的3个参数,来创建一个普通的函数,从而现实动态性。

make_function()函数的3个参数分别是:

  • 生成函数的参数部分, list类型
  • 生成函数的表达式部分, 语法表达式, call类型
  • 生成函数的系统环境部分, environment类型

# 创建标准的函数
> f <- function(x) x + 3
> f
function(x) x + 3

# 运行函数
> f(12)
[1] 15

# 通过参数创建函数
> g <- make_function(alist(x = ), quote(x + 3))
> g
function (x)
x + 3

# 运行函数
> g(12)
[1] 15

3.3 创建匿名函数调用partial()

使用partial()函数,可以减少参数定义的过程,方便匿名函数的调用


# 定义一个普通的函数
> compact1 <- function(x) Filter(Negate(is.null), x)
> compact1
function(x) Filter(Negate(is.null), x)

# 通过partial定义的匿名函数
> compact2 <- partial(Filter, Negate(is.null))
> compact2
function (...)
Filter(Negate(is.null), ...)

我们看到,上面的两个函数定义很像,一个是有明确的参数定义,另一个用partial()则是隐式的参数定义。

再看另一例:输出runif()均匀分布的结果


# 标准函数实现
> f1 <- function(){runif(rpois(1, 5))}
> f1()
[1] 0.09654228 0.93089395 0.85530142 0.33021067 0.16728877 0.79099825
> f1()
[1] 0.6166580 0.2100876 0.3125176

# 通过partial的匿名函数调用
> f2 <- partial(runif, n = rpois(1, 5))
> f2()
[1] 0.25955143 0.12858459 0.04994997 0.11505708 0.10509429
> f2()
[1] 0.9710866 0.1469317

3.4 变量表达式替换 substitute_q(), subs()

使用substitute_q()函数,可以对表达式调用,直接进行参数替换


# 定义一个表达式调用
>  x <- quote(a + b)
> class(x)
[1] "call"

# 对x调用参数替换,无效
>  substitute(x, list(a = 1, b = 2))
x

# 对直接变量参数替换
> substitute(a+b, list(a = 1, b = 2))
1 + 2

# 对x调用参数替换
>  substitute_q(x, list(a = 1, b = 2))
1 + 2

执行参数调用
> eval(substitute_q(x, list(a = 1, b = 2)))
[1] 3

使用subs()函数,可以直接对变量表达式替换


> a <- 1
> b <- 2

# 对变量表达式替换,无效
> substitute(a + b)
a + b

# 对变量表达式替换
> subs(a + b)
1 + 2

3.5 面向对象类型判断otype(),ftype()

判断对象类型:通过otype()函数可以很容易的分辨出基本类型,S3类型,S4类型,RC类型的对象,比起内置的类型检查要高效的多。


# 基本类型
> otype(1:10)
[1] "primitive"
> otype(c('a','d'))
[1] "primitive"
> otype(list(c('a'),data.frame()))
[1] "primitive"

# S3类型
> otype(data.frame())
[1] "S3"

# 自定的S3类型
> x <- 1
> attr(x,'class')<-'foo'
> is.object(x)
[1] TRUE
> otype(x)
[1] "S3"

# S4类型
> setClass("Person",slots=list(name="character",age="numeric"))
> alice<-new("Person",name="Alice",age=40) 
> isS4(alice)
[1] TRUE
> otype(alice)
[1] "S4"

# RC类型
> Account<-setRefClass("Account")
> a<-Account$new()
> class(a)
[1] "Account"
attr(,"package")
[1] ".GlobalEnv"

> is.object(a)
[1] TRUE
> isS4(a)
[1] TRUE
> otype(a)
[1] "RC"

判断函数类型:通过ftype()函数可以很容易的分辨出function,primitive,S3,S4,internal类型的函数,比起内置的类型检查要高效的多。


# 标准函数
> ftype(`%in%`)
[1] "function"

# primitive函数
> ftype(sum)
[1] "primitive" "generic"

# internal函数
> ftype(writeLines)
[1] "internal"
> ftype(unlist)
[1] "internal" "generic"

# S3函数
>  ftype(t.data.frame)
[1] "s3"     "method"
> ftype(t.test)
[1] "s3"      "generic"

# S4 函数
> setGeneric("union")
[1] "union"
> setMethod("union",c(x="data.frame",y="data.frame"),function(x, y){unique(rbind (x, y))})
[1] "union"
> ftype(union)
[1] "s4"      "generic"

# RC函数
> Account<-setRefClass("Account",fields=list(balance="numeric"),methods=list(
+   withdraw=function(x){balance<<-balance-x},
+   deposit=function(x){balance<<-balance+x}))
> a<-Account$new(balance=100)
> a$deposit(100)
> ftype(a$deposit)
[1] "rc"     "method"

3.6 查看对象底层的C语言类型 address(), refs(), typename()

我们可以通过address(), refs(), typename()来查看,R对象对应的底层C语言实现的类型。

  • typename: 返回C语言类型名
  • address: 返回内存地址
  • refs: 返回指针数字

查看变量


# 定义一个变量x
>  x <- 1:10

# 打印C语言类型名
> typename(x)
[1] "INTSXP"

# 返回指针
> refs(x)
[1] 1

# 打印内存地址
> address(x)
[1] "0x365f560"

# 定义一个list对象
>  z <- list(1:10)

# 打印C语言类型名
>  typename(z)
[1] "VECSXP"

# 延迟赋值
> delayedAssign("a", 1 + 2)

# 打印C语言类型名
> typename(a)
[1] "PROMSXP"

# 打印a变量
> a
[1] 3
> typename(a)
[1] "PROMSXP"

# 定义变量b,与a变量对比
> b<-3
> typename(b)
[1] "REALSXP"

3.7 查看对象是否被修改track_copy()

使用track_copy()函数,我们可以跟踪对象,并检查是被修改过,通过内存地址进行判断。


# 定义一个变量
> a<-1:3
> a
[1] 1 2 3

# 查看变量的内存地址
> address(a)
[1] "0x2ad77f0"

# 跟踪变量
> track_a <- track_copy(a)

# 检查变更是否被修改,没有修改
> track_a()

# 给变量赋值
> a[3] <- 3L

# 查看变量的内存地址,发现没有变化
> address(a)
[1] "0x2ad77f0"

# 检查变量是否被修改,没有修改
>  track_a()

# 再次给变量赋值
> a[3]<-3

# 查看变量的内存地址,内存地址改变
> address(a)
[1] "0x37f8580"

# 检查变量是否被修改,已被修改,变成一份copy
>  track_a()
a copied

3.8 查看闭包函数变量 unenclose()

使用unenclose()给闭包环境的变量的赋值


# 定义一个嵌套函数power
>  power <- function(exp) {
+      function(x) x ^ exp
+  }

# 调用闭包函数
>  square <- power(2)
>  cube <- power(3)

# 查看square函数,exp变量并显示没有赋值后的结果
> square
function(x) x ^ exp
<environment: 0x4055f28>

# 查看square函数,exp变量显示赋值后的结果
> unenclose(square)
function (x)
x^2

# 执行square函数
> square(3)
[1] 9

3.9 批量修改对象 modify_lang()

这是一个神奇的函数,可以方便地替换 list对象、表达式、函数 中的变量定义。

接下来,我们尝试替换list对象中定义的变量a为变量b


# 定义list对象及内部数据
> examples <- list(
+        quote(a <- 5),
+        alist(a = 1, c = a),
+        function(a = 1) a * 10,
+        expression(a <- 1, a, f(a), f(a = a))
+      )

# 查看对象数据
> examples
[[1]]
a <- 5

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

[[2]]$c
a

[[3]]
function (a = 1)
a * 10

[[4]]
expression(a <- 1, a, f(a), f(a = a))

# 定义转换函数a_to_b,
>  a_to_b <- function(x) {
+        if (is.name(x) && identical(x, quote(a))) return(quote(b))
+        x
+  }

# 批量修改对象,替换examples对象中,所有的变量a变成变量b
> modify_lang(examples, a_to_b)
[[1]]
b <- 5

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

[[2]]$c
b

[[3]]
function (a = 1)
b * 10

[[4]]
expression(b <- 1, b, f(b), f(a = b))

3.10 快速创建list对象 dots(), named_dots()

使用dots()函数,我们可以快速创建list对象,通过参数设置来list的数据的名字和值。


# 初始化一个变量
> y <- 2

# 创建list对象
> dots(x = 1, y, z = )
$x
[1] 1

[[2]]
y

$z

# 查看对象类型
> class(dots(x = 1, y, z = ))
[1] "list"

# 查看对象的内部结果
> str(dots(x = 1, y, z = ))
List of 3
 $ x: num 1
 $  : symbol y
 $ z: symbol

使用named_dots()函数,同样我们可以快速创建list对象,通过参数设置list的数据的名字和值。与dots()函数的不同点在于,参数变量就是list的数据的名字,如 变量y在没有赋值情况下,也被用作list数据的名字,并可以通过$y来得到值。


# 创建list对象
> named_dots(x = 1, y, z =)
$x
[1] 1

$y
y

$z

# 查看对象类型
> class(named_dots(x = 1, y, z =))
[1] "list"

# 查看对象的内部结果
> str(named_dots(x = 1, y, z =))
List of 3
 $ x: num 1
 $ y: symbol y
 $ z: symbol

3.11 查找符合条件函数 fun_calls()

使用fun_calls()函数,可以通过过滤条件快速找到函数。

查找base包中所有的函数,找到匹配match.fun字符串的函数名


> find_funs("package:base", fun_calls, "match.fun", fixed = TRUE)
Using environment package:base
 [1] "apply"  "eapply" "Find"   "lapply" "Map"    "mapply" "Negate" "outer"
 [9] "Reduce" "sapply" "sweep"  "tapply" "vapply"

# 查看Map函数,检查是否包括match.fun字符串
> Map
function (f, ...)
{
    f <- match.fun(f)
    mapply(FUN = f, ..., SIMPLIFY = FALSE)
}
<bytecode: 0x21688e0>
<environment: namespace:base>

查找stats包中所有的函数的参数,找到精确匹配FUN字符串的函数名


> find_funs("package:stats", fun_args, "^FUN$")
Using environment package:stats
[1] "addmargins"           "aggregate.data.frame" "aggregate.ts"
[4] "ave"                  "dendrapply"

# 查看ave函数源代码,检查参数名是否有FUN字符串
> ave
function (x, ..., FUN = mean)
{
    if (missing(...))
        x[] <- FUN(x)
    else {
        g <- interaction(...)
        split(x, g) <- lapply(split(x, g), FUN)
    }
    x
}
<bytecode: 0x2acba70>
<environment: namespace:stats>

3.12 查询环境变量 where(), rls(), parenv()

使用where()函数,可以定位对象的在R环境中的位置,有点像Linux的命令whereis。


# 定义一个变量x
> x <- 1
> where("x")
<environment: R_GlobalEnv>

# 查询t.test函数的位置
> where("t.test")
<environment: package:stats>
attr(,"name")
[1] "package:stats"
attr(,"path")
[1] "/usr/lib/R/library/stats"

> t.test
function (x, ...)
UseMethod("t.test")
<bytecode: 0x1ae9bc8>
<environment: namespace:stats>

# 查询mean函数的位置
> where("mean")
<environment: base>

# 查询where函数的位置
> where("where")
<environment: package:pryr>
attr(,"name")
[1] "package:pryr"
attr(,"path")
[1] "/home/conan/R/x86_64-pc-linux-gnu-library/3.0/pryr"

使用rls()函数,可以显示出当前环境的所有变量,包括当前变量,全局变量,空环境变量,命令空间环境变量。


# 打印当前环境的变量
> ls()
 [1] "a"                "Account"          "alice"            "a_to_b"
 [5] "b"                "compact1"         "compact2"         "examples"
 [9] "f"                "f1"               "f2"               "g"
[13] "myGeneric"        "my_long_variable" "plot2"            "union"
[17] "x"                "y"

# 打印所有环境的变量
> rls()
[[1]]
 [1] "a"                          "Account"
 [3] "alice"                      "a_to_b"
 [5] "b"                          ".__C__Account"
 [7] "compact1"                   "compact2"
 [9] ".__C__Person"               "examples"
[11] "f"                          "f1"
[13] "f2"                         "g"
[15] ".__global__"                "myGeneric"
[17] "my_long_variable"           "plot2"
[19] ".Random.seed"               ".requireCachedGenerics"
[21] ".__T__myGeneric:.GlobalEnv" ".__T__union:base"
[23] "union"                      "x"
[25] "y"

使用parenv()函数,可以找到函数调用的上一级环境,从而可以追溯到函数的根。


# 定义一个3层嵌套函数
> adder <- function(x) function(y) function(z) x + y + z

# 调用第一层函数
> add2 <- adder(2)

# 查看函数
> add2
function(y) function(z) x + y + z
<environment: 0x323c000>

# 调用第二层函数
> add3<-add2(3)
> add3
function(z) x + y + z
<environment: 0x3203558>

# 查内层函数的上一级环境
>  parenv(add3)
<environment: 0x323c000>
>  parenv(add2)
<environment: R_GlobalEnv>

3.13 找印调用关系 call_tree(), ast()

使用call_tree()函数,可以打印出表达式的调用关系


# 嵌套函数语句调用
>  call_tree(quote(f(x, 1, g(), h(i()))))
\- ()
  \- `f
  \- `x
  \-  1
  \- ()
    \- `g
  \- ()
    \- `h
    \- ()
      \- `i

# 条件语句调用
> call_tree(quote(if (TRUE) 3 else 4))
\- ()
  \- `if
  \-  TRUE
  \-  3
  \-  4

# 表达式语句调用
> call_tree(expression(1, 2, 3))
\-  1
\-  2
\-  3

使用ast()函数,可以直接打印语句的调用关系


# 嵌套表达式语句
> ast(f(x, 1, g(), h(i())))
\- ()
  \- `f
  \- `x
  \-  1
  \- ()
    \- `g
  \- ()
    \- `h
    \- ()
      \- `i

# 条件语句
> ast(if (TRUE) 3 else 4)
\- ()
  \- `if
  \-  TRUE
  \-  3
  \-  4

# 函数定义
> ast(function(a = 1, b = 2) {a + b})
\- ()
  \- `function
  \- []
    \ a = 1
    \ b = 2
  \- ()
    \- `{
    \- ()
      \- `+
      \- `a
      \- `b
  \- 

# 函数调用
> ast(f()()())
\- ()
  \- ()
    \- ()
      \- `f

3.14 promise对象 uneval(), is_promise()

promise对象:是R语言中延迟加载机制的一部分,包含三个部分:值,表达式和环境。当函数被调用时参数进行匹配,然后每个形式参数会绑定到一个promise上。表达式有形式参数和存储在promise里的函数的指针。

简单来说,延迟加载调用过程就是,先把函数指针存储在promise对象里,并不马上调用;当其实调用发生时,从promise对象里找到函数指针,进行函数的调用。


# 定义变量并赋值
> x <- 10

# 检查是否 promise模式
> is_promise(x)
[1] FALSE

# 匿名函数调用,检查是否 promise模式
> (function(x) is_promise(x))(x = 10)
[1] TRUE

使用uneval()函数,可以在延迟赋值的过程中,打印函数调用方法,而不执行赋值函数调用。


# 定义一个函数
> f <- function(x) {
+     uneval(x)
+ }

# 打印函数调用
> f(a + b)
a + b

> class(f(a+b))
[1] "call"

# 打印函数调用
> f(1 + 4)
1 + 4

# 延迟赋值
> delayedAssign("x", 1 + 4)

# 不执行函数调用,只打印函数调用
> uneval(x)
1 + 4

# 执行函数调用,并赋值
> x
[1] 5

# 延迟赋值又一例
> delayedAssign("x", {
+     for(i in 1:3)
+         cat("yippee!\n")
+     10
+ })

# 执行函数调用,并赋值
> x
yippee!
yippee!
yippee!
[1] 10

3.15 数据绑定%<a-%, %<c-%,%<d-%, rebind,<<-

使用特殊的函数,可以实现数据绑定的功能。

直接绑定


> x %<a-% runif(1)
> x
[1] 0.06793592
> x
[1] 0.8217227

常量绑定


> y %<c-% 4 + 2
[1] 6
> y
[1] 4

延迟绑定


> z %<d-% (a + b)
> a <- 10
> b <- 100
> z
[1] 110

重新绑定


# 对已知变量a重新赋值
> a <- 1
> rebind("a", 2)

# 对未知变量cc重新赋值,出错
> rebind("ccc", 2)
Error: Can't find ccc

# 用 <<- 对已知变量a重新赋值
> a<<-2
> a
[1] 2

# 用 <<- 对未知变量cc重新赋值
> rm(ccc)
> ccc
Error: object 'ccc' not found
> ccc<<-2
> ccc
[1] 2

通过对pryr全面介绍,我们了解这个包的强大,对于R的数据结构的理解非常有帮助。

转载请注明出处:
http://blog.fens.me/r-pryr/

打赏作者