六種方法查看R函數源代碼,爲啥第三種最惹人喜歡?

所謂:操千曲而後曉聲,觀千劍而後識器。

作爲一個開源軟件,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()不僅可以修改包中的函數作爲急用,也可以用來修改自己正在寫的函數,可以說很實用了在我們寫函數的時候。


    1. 對於計算方法不同的函數,要用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

    1. 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>

    1. 直接上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

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章