> 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有至关重要的作用。

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