所谓：操千曲而后晓声，观千剑而后识器。

作为一个开源软件，R的一个非常大的优点就是我们可以随意查看所有算法的源代码，在对这些源代码进行分析的过程中不仅可以加深对算法的认识，而且可以大步提高对R语言的掌握程度。如果可以也能根据自己的需求，对算法进行改进。不管是从理论的学习角度还是实用的角度，善于阅读和利用源代码，能让我们事半功倍。

当然，在开始的开始，你需要知道R函数是怎样的一个结构。也就是说你至少要有一点R的基础，最少吧，你需要一颗上劲的心。本文的末尾给出了R函数的文章，基本上看看就会了。我们就不从最基本的什么是函数这种问题开始了。

• 1. 最直接的方法当然是直接键入函数(不加括号)，大部分函数源代码就可以直接显现出来。我以PerformanceAnalytics包中的函数chart.Correlation()为例。

#install.packages("PerformanceAnalytics") 没有安装的安装一下。
> library(PerformanceAnalytics)
> chart.Correlation
function (R, histogram = TRUE, method = c("pearson", "kendall", 
    "spearman"), ...) 
{
    x = checkData(R, method = "matrix")
    if (missing(method)) 
        method = method[1]
    panel.cor <- function(x, y, digits = 2, prefix = "", use = "pairwise.complete.obs", 
        method = "pearson", cex.cor, ...) {
        usr <- par("usr")
        on.exit(par(usr))
        par(usr = c(0, 1, 0, 1))
        r <- cor(x, y, use = use, method = method)
        txt <- format(c(r, 0.123456789), digits = digits)[1]
        txt <- paste(prefix, txt, sep = "")
        if (missing(cex.cor)) 
            cex <- 0.8/strwidth(txt)
        test <- cor.test(as.numeric(x), as.numeric(y), method = method)
        Signif <- symnum(test$p.value, corr = FALSE, na = FALSE, 
            cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", 
                "**", "*", ".", " "))
        text(0.5, 0.5, txt, cex = cex * (abs(r) + 0.3)/1.3)
        text(0.8, 0.8, Signif, cex = cex, col = 2)
    }
    f <- function(t) {
        dnorm(t, mean = mean(x), sd = sd.xts(x))
    }
    dotargs <- list(...)
    dotargs$method <- NULL
    rm(method)
    hist.panel = function(x, ... = NULL) {
        par(new = TRUE)
        hist(x, col = "light gray", probability = TRUE, axes = FALSE, 
            main = "", breaks = "FD")
        lines(density(x, na.rm = TRUE), col = "red", lwd = 1)
        rug(x)
    }
    if (histogram) 
        pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor, 
            diag.panel = hist.panel)
    else pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor)
}
<bytecode: 0x000000000813e4f0>
<environment: namespace:PerformanceAnalytics>

当然呢，在Rstudio里面，我们可以把光标放在函数名上按F2，Rstudio会打开一个新的窗口来显示这个函数：

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

• 2 用函数page()，不过，结果在另一个窗口显示,选择电脑上的程序打开，我的是Notepad++。

> page(chart.Correlation)

• 3 与方法二类似，用函数edit()。这个函数一看就很有喜感，明显他是允许我们来修改函数的，这才是开源的真谛啊。修改了直接用。还是以我们这个函数为例。我们这个函数chart.Correlation是用来展示相关性的。但是她的参数很少，满足不了我的需求。

data(managers)
chart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")

做出来的图是这样的：

但是我想把相关系数的字体都搞成一致，然后小圆圈的空心点变成“+”，但是pch=这个参数不顶用。怎么办？查看了帮助文档help(chart.Correlation)也没有参数可调，看来修改函数是一个不错的选择了。

于是我就：

> mychart.Correlation<-edit(chart.Correlation)

我把它设置字体的部分和调整散点图形状的部分稍作了修改，点击Save，这样一个新的函数mychart.Correlation就生成了。现在，我用同样的数据和参数来绘制这个图，达到了我的要求：

data(managers)
mychart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")

修改后的函数是这样的：

函数edit()不仅可以修改包中的函数作为急用，也可以用来修改自己正在写的函数，可以说很实用了在我们写函数的时候。

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

> mean
function (x, ...) 
UseMethod("mean")
<bytecode: 0x0000000008c88590>
<environment: namespace:base>

此时要有methods()来查找mean具体的对象:

methods(mean)
 [1] mean.Date      mean.default   mean.difftime  mean.geometric mean.LCL       mean.POSIXct   mean.POSIXlt   mean.stderr    mean.UCL      
[10] mean.yearmon*  mean.yearqtr*  mean.zoo*     
see '?methods' for accessing help and source code

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

> mean.default
function (x, trim = 0, na.rm = FALSE, ...) 
{
    if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
        warning("argument is not numeric or logical: returning NA")
        return(NA_real_)
    }
    if (na.rm) 
        x <- x[!is.na(x)]
    if (!is.numeric(trim) || length(trim) != 1L) 
        stop("'trim' must be numeric of length one")
    n <- length(x)
    if (trim > 0 && n) {
        if (is.complex(x)) 
            stop("trimmed means are not defined for complex data")
        if (anyNA(x)) 
            return(NA_real_)
        if (trim >= 0.5) 
            return(stats::median(x, na.rm = FALSE))
        lo <- floor(n * trim) + 1
        hi <- n + 1 - lo
        x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
    }
    .Internal(mean(x))
}
<bytecode: 0x000000000ec0bbc8>
<environment: namespace:base>

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

如chart.Correlation()就不能用这方法：

> methods(chart.Correlation)
no methods found
> chart.Correlation.default
Error: object 'chart.Correlation.default' not found

• 5. methods()得出的类函数中带星号标注的源代码，用函数getAnywhere()，如查找predict函数的源代码。

> methods(predict)  
 [1] predict.ar*                predict.Arima*             predict.arima0*            predict.glm                predict.HoltWinters*      
 [6] predict.lm                 predict.loess*             predict.mlm*               predict.nls*               predict.poly*             
[11] predict.ppr*               predict.prcomp*            predict.princomp*          predict.smooth.spline*     predict.smooth.spline.fit*
[16] predict.StructTS*         
see '?methods' for accessing help and source code
> getAnywhere(predict.Arima)
A single object matching ‘predict.Arima’ was found
It was found in the following places
  registered S3 method for predict from namespace stats
  namespace:stats
with value

function (object, n.ahead = 1L, newxreg = NULL, se.fit = TRUE, 
    ...) 
{
    myNCOL <- function(x) if (is.null(x)) 
        0
    else NCOL(x)
    rsd <- object$residuals
    xr <- object$call$xreg
    xreg <- if (!is.null(xr)) 
        eval.parent(xr)
    else NULL
    ncxreg <- myNCOL(xreg)
    if (myNCOL(newxreg) != ncxreg) 
        stop("'xreg' and 'newxreg' have different numbers of columns")
    class(xreg) <- NULL
    xtsp <- tsp(rsd)
    n <- length(rsd)
    arma <- object$arma
    coefs <- object$coef
    narma <- sum(arma[1L:4L])
    if (length(coefs) > narma) {
        if (names(coefs)[narma + 1L] == "intercept") {
            xreg <- cbind(intercept = rep(1, n), xreg)
            newxreg <- cbind(intercept = rep(1, n.ahead), newxreg)
            ncxreg <- ncxreg + 1L
        }
        xm <- if (narma == 0) 
            drop(as.matrix(newxreg) %*% coefs)
        else drop(as.matrix(newxreg) %*% coefs[-(1L:narma)])
    }
    else xm <- 0
    if (arma[2L] > 0L) {
        ma <- coefs[arma[1L] + 1L:arma[2L]]
        if (any(Mod(polyroot(c(1, ma))) < 1)) 
            warning("MA part of model is not invertible")
    }
    if (arma[4L] > 0L) {
        ma <- coefs[sum(arma[1L:3L]) + 1L:arma[4L]]
        if (any(Mod(polyroot(c(1, ma))) < 1)) 
            warning("seasonal MA part of model is not invertible")
    }
    z <- KalmanForecast(n.ahead, object$model)
    pred <- ts(z[[1L]] + xm, start = xtsp[2L] + deltat(rsd), 
        frequency = xtsp[3L])
    if (se.fit) {
        se <- ts(sqrt(z[[2L]] * object$sigma2), start = xtsp[2L] + 
            deltat(rsd), frequency = xtsp[3L])
        list(pred = pred, se = se)
    }
    else pred
}
<bytecode: 0x0000000016ba2238>
<environment: namespace:stats>

• 6. 直接上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封装的，下载解压后就能看见源代码了。

再复杂的包也是由基本的R函数构成的，所以从基础学起总是不错的。基础决定高度。有了这六个查看R函数的方法，是不是清楚了很多呢。函数是完成某项具体任务的程序，能看R函数，学习R就不再是到处粘代码了也不再是只会调参数了，可以自己定义参数，自己来写函数了。

参考：
查看R源代码的六种方法
怎么才能查看R语言某个包某函数源码？
R查看各函数的源代码
查看R函数源代码
R语言－函数源代码查看
【r<-高级|理论】R的函数
第五节 R语言函数function