文档章节

查看R源代码的六种方法

不最醉不龟归
 不最醉不龟归
发布于 2017/05/24 14:21
字数 1274
阅读 21
收藏 0

> methods(length)
[1] length.pdf_doc* length.POSIXlt 
see '?methods' for accessing help and source code
> length.POSIXlt
function (x) 
length(x[[1L]])
<bytecode: 0x00000000111d75b0>
<environment: namespace:base>
 

-------------------------------------------------------------------------

 

 

方法一:直接写函数名称,如在R中查看回归分析代码:

  1. lm

复制代码


直接可以查看到

  1. function (formula, data, subset, weights, na.action, method = "qr", 
  2.     model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
  3.     contrasts = NULL, offset, ...) 
  4. {
  5.     ret.x <- x
  6.     ret.y <- y
  7.     cl <- match.call()
  8.     mf <- match.call(expand.dots = FALSE)
  9.     m <- match(c("formula", "data", "subset", "weights", "na.action", 
  10.         "offset"), names(mf), 0L)
  11.     mf <- mf[c(1L, m)]
  12.     mf$drop.unused.levels <- TRUE
  13.     mf[[1L]] <- quote(stats::model.frame)
  14.     mf <- eval(mf, parent.frame())
  15.     if (method == "model.frame") 
  16.         return(mf)
  17.     else if (method != "qr") 
  18.         warning(gettextf("method = '%s' is not supported. Using 'qr'", 
  19.             method), domain = NA)
  20.     mt <- attr(mf, "terms")
  21.     y <- model.response(mf, "numeric")
  22.     w <- as.vector(model.weights(mf))
  23.     if (!is.null(w) && !is.numeric(w)) 
  24.         stop("'weights' must be a numeric vector")
  25.     offset <- as.vector(model.offset(mf))
  26.     if (!is.null(offset)) {
  27.         if (length(offset) != NROW(y)) 
  28.             stop(gettextf("number of offsets is %d, should equal %d (number of observations)", 
  29.                 length(offset), NROW(y)), domain = NA)
  30.     }
  31.     if (is.empty.model(mt)) {
  32.         x <- NULL
  33.         z <- list(coefficients = if (is.matrix(y)) matrix(, 0, 
  34.             3) else numeric(), residuals = y, fitted.values = 0 * 
  35.             y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w != 
  36.             0) else if (is.matrix(y)) nrow(y) else length(y))
  37.         if (!is.null(offset)) {
  38.             z$fitted.values <- offset
  39.             z$residuals <- y - offset
  40.         }
  41.     }
  42.     else {
  43.         x <- model.matrix(mt, mf, contrasts)
  44.         z <- if (is.null(w)) 
  45.             lm.fit(x, y, offset = offset, singular.ok = singular.ok, 
  46.                 ...)
  47.         else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, 
  48.             ...)
  49.     }
  50.     class(z) <- c(if (is.matrix(y)) "mlm", "lm")
  51.     z$na.action <- attr(mf, "na.action")
  52.     z$offset <- offset
  53.     z$contrasts <- attr(x, "contrasts")
  54.     z$xlevels <- .getXlevels(mt, mf)
  55.     z$call <- cl
  56.     z$terms <- mt
  57.     if (model) 
  58.         z$model <- mf
  59.     if (ret.x) 
  60.         z$x <- x
  61.     if (ret.y) 
  62.         z$y <- y
  63.     if (!qr) 
  64.         z$qr <- NULL
  65.     z
  66. }
  67.  

复制代码

优点:直接简单。
缺点:并非所有的函数都能通过此方法得到。
原因:R是面向对象设计的程序语言。

方法二:与方法一类似,用函数page(),不过,结果在另一个窗口显示。


方法三:与方法二类似,用函数edit()。

方法四:对于计算方法不同的函数,要用methods()来定义具体的查看对象,如查看函数mean代码,用方法一只能查到

  1. function (x, ...) 
  2. UseMethod("mean")

复制代码

无法得到具体的代码。此时要有methods()来查找mean具体的对象

  1. methods(mean)

复制代码



此时,结果是

[1] mean.Date     mean.default  mean.difftime mean.POSIXct  mean.POSIXlt 

要查看具体名称,如mean.default的代码,直接用代码

  1. mean.default

复制代码


可以看到mean.default的源代码

  1. function (x, trim = 0, na.rm = FALSE, ...) 
  2. {
  3.     if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
  4.         warning("argument is not numeric or logical: returning NA")
  5.         return(NA_real_)
  6.     }
  7.     if (na.rm) 
  8.         x <- x[!is.na(x)]
  9.     if (!is.numeric(trim) || length(trim) != 1L) 
  10.         stop("'trim' must be numeric of length one")
  11.     n <- length(x)
  12.     if (trim > 0 && n) {
  13.         if (is.complex(x)) 
  14.             stop("trimmed means are not defined for complex data")
  15.         if (anyNA(x)) 
  16.             return(NA_real_)
  17.         if (trim >= 0.5) 
  18.             return(stats::median(x, na.rm = FALSE))
  19.         lo <- floor(n * trim) + 1
  20.         hi <- n + 1 - lo
  21.         x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
  22.     }
  23.     .Internal(mean(x))
  24. }

复制代码


注意:1. 对于程序包里的函数,需要先调用函数所在的包。
           2.对于methods()得出的类函数中带星号标注的源代码是看不到的。
           3.对于非类函数,不能用此方法。

方法五:对于方法四中methods()得出的类函数中带星号标注的源代码,用函数getAnywhere(),如查找predict函数的源代码。

  1. methods(predict)  

复制代码

结果显示:
[1] predict.ar*                predict.Arima*             predict.arima0*            predict.glm                predict.HoltWinters*       predict.lm                
[7] predict.loess*             predict.mlm*               predict.nls*               predict.poly*              predict.ppr*               predict.prcomp*           
[13] predict.princomp*          predict.smooth.spline*     predict.smooth.spline.fit* predict.StructTS*         


若用命令predict.Arima查看predict.Arima源代码。结果显示:

错误: 找不到对象'predict.Arima'

此时,用

  1. getAnywhere(predict.Arima)

复制代码


这样就可以查看到predict.Arima的源代码。

  1. function (object, n.ahead = 1L, newxreg = NULL, se.fit = TRUE, 
  2.     ...) 
  3. {
  4.     myNCOL <- function(x) if (is.null(x)) 
  5.         0
  6.     else NCOL(x)
  7.     rsd <- object$residuals
  8.     xr <- object$call$xreg
  9.     xreg <- if (!is.null(xr)) 
  10.         eval.parent(xr)
  11.     else NULL
  12.     ncxreg <- myNCOL(xreg)
  13.     if (myNCOL(newxreg) != ncxreg) 
  14.         stop("'xreg' and 'newxreg' have different numbers of columns")
  15.     class(xreg) <- NULL
  16.     xtsp <- tsp(rsd)
  17.     n <- length(rsd)
  18.     arma <- object$arma
  19.     coefs <- object$coef
  20.     narma <- sum(arma[1L:4L])
  21.     if (length(coefs) > narma) {
  22.         if (names(coefs)[narma + 1L] == "intercept") {
  23.             xreg <- cbind(intercept = rep(1, n), xreg)
  24.             newxreg <- cbind(intercept = rep(1, n.ahead), newxreg)
  25.             ncxreg <- ncxreg + 1L
  26.         }
  27.         xm <- if (narma == 0) 
  28.             drop(as.matrix(newxreg) %*% coefs)
  29.         else drop(as.matrix(newxreg) %*% coefs[-(1L:narma)])
  30.     }
  31.     else xm <- 0
  32.     if (arma[2L] > 0L) {
  33.         ma <- coefs[arma[1L] + 1L:arma[2L]]
  34.         if (any(Mod(polyroot(c(1, ma))) < 1)) 
  35.             warning("MA part of model is not invertible")
  36.     }
  37.     if (arma[4L] > 0L) {
  38.         ma <- coefs[sum(arma[1L:3L]) + 1L:arma[4L]]
  39.         if (any(Mod(polyroot(c(1, ma))) < 1)) 
  40.             warning("seasonal MA part of model is not invertible")
  41.     }
  42.     z <- KalmanForecast(n.ahead, object$model)
  43.     pred <- ts(z[[1L]] + xm, start = xtsp[2L] + deltat(rsd), 
  44.         frequency = xtsp[3L])
  45.     if (se.fit) {
  46.         se <- ts(sqrt(z[[2L]] * object$sigma2), start = xtsp[2L] + 
  47.             deltat(rsd), frequency = xtsp[3L])
  48.         return(list(pred = pred, se = se))
  49.     }
  50.     else return(pred)
  51. }
  52.  

复制代码

方法六:直接上CRAN 下载源代码包

流程如下:

1)       登入R主页 http://www.r-project.org/ ,点击 Download 下的CRAN;

2)       选择一个镜像;

3)       里面的Source Code for all Platforms下有各种源码了,对于程序包,点packages;

4)       点选择项Table of available packages, sorted by name;

5)       找到你你想要的包,点击看Package source这一项,用tar.gz封装的,下载解压后就能看见源代码了。


 

很多函数的核心是用C或FORTRAN等写的,利用.C(),.FORTRAN()等函数调用。这种做法是出于计算效率的考虑。

最后,如果真的想阅读组成R系统本身的源代码,在各个CRAN中均有下载。都是精心挑选过的算法,是学习的好材料。同时,你可以看到R系统内部是如何构成的,对于高效使用R有至关重要的作用。


欢迎大家多多和我交流,共同进步。

本文转载自:http://f.dataguru.cn/thread-364443-1-1.html

共有 人打赏支持
不最醉不龟归
粉丝 15
博文 423
码字总数 445380
作品 0
深圳
程序员
在eclipse中查看Android源代码

声明:高手跳过此文章 当我们在eclipse中开发android程序的时候,往往需要看源代码(可能是出于好奇,可能是读源码习惯),那么如何查看Android源代码呢? 比如下面这种情况 图一 假设我们想...

fylx
2013/09/01
0
0
程序员自学编程的5种方法,哪些基本工具必须掌握?

编程是报酬相当丰厚的行业,有不少的小伙伴对于编程是相当的感兴趣。 如果你有仔细观察程序员身边的女朋友,一般都很漂亮,她们比较欣赏程序员的才华和有钱任性。 程序员自学编程的5种方法,...

W3Cschool
2017/12/08
0
0
LeetCode:Valid Parentheses - 合理的括号搭配

1、题目名称 Valid Parentheses(合理的括号搭配) 2、题目地址 https://leetcode.com/problems/valid-parentheses/ 3、题目内容 英文:Given a string containing just the characters , ,......

北风其凉
2015/11/08
0
0
Linux 平台下阅读源码的工具链

本文作者:伯乐在线 -肖汉松 。未经作者许可,禁止转载! 欢迎加入伯乐在线专栏作者。 前言 看源代码是一个程序员必须经历的事情,也是可以提升能力的一个捷径.个人认为: 要完全掌握一个软件的...

伯乐在线
2016/05/23
0
0
Linux源代码分析工具链

vim+ctags+cscope 源码阅读三剑客.vim配合ctags和cscope,足以在源代码里面自由翱翔,在函数和变量间自由跳转. 安装 1 sudo apt-get install vim ctags cscope 使用 vim vim的使用就略过了,网上...

CasparLi
2015/09/06
197
0

没有更多内容

加载失败,请刷新页面

加载更多

树莓派上安装 Nextcloud 云

# install docker and docker composesudo apt-get updatesudo apt-get install git docker-composecurl -sSL https://get.docker.com | sh# fetch projectcd ~git clone https://git......

How11
3分钟前
0
0
python 基本语法

布尔值:True False,操作符有 and, or, not; 常量通常使用大写表示,如PI = 3.14159265359; 除法操作符有 /, //, %,如 10 / 3 = 3.3333333333333335,10 // 3 = 3, 10 % 3 = 1; 在计算机内存中...

bug_404
4分钟前
0
0
centos 下安装 elastic search 启动的问题

正常步骤 1Download and unzip Elasticsearch 2 Run bin/elasticsearch 3 Run curl http://localhost:9200/ 异常信息: root 账户启动报错,Exception in thread "main" Java.lang.RuntimeE......

xiaomin0322
11分钟前
0
0
mysql_exceptions.OperationalError: 1054

错误:python连接Mysql错误:_mysql_exceptions.OperationalError: (1054, "Unknown column 'CVE' in 'field lis解决办法 注:要根据自己具体情况进行判断,可以 print sql % args,来判断该...

fang_faye
13分钟前
0
0
分布式数据库DDM Sidecar模式负载均衡

简介 1.分布式数据库中间件 DDM 分布式数据库中间件(Distributed Database Middleware)是解决数据库容量、性能瓶颈和分布式扩展问题的中间件服务,提供分库分表、读写分离、弹性扩容等能力...

中间件小哥
17分钟前
0
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部