所謂：操千曲而后曉聲净薛，觀千劍而后識器汪榔。
作為一個開源軟件，R的一個非常大的優(yōu)點(diǎn)就是我們可以隨意查看所有算法的源代碼肃拜，在對這些源代碼進(jìn)行分析的過程中不僅可以加深對算法的認(rèn)識痴腌，而且可以大步提高對R語言的掌握程度。如果可以也能根據(jù)自己的需求燃领，對算法進(jìn)行改進(jìn)士聪。不管是從理論的學(xué)習(xí)角度還是實(shí)用的角度，善于閱讀和利用源代碼猛蔽，能讓我們事半功倍剥悟。
當(dāng)然，在開始的開始曼库，你需要知道R函數(shù)是怎樣的一個結(jié)構(gòu)区岗。也就是說你至少要有一點(diǎn)R的基礎(chǔ)，最少吧毁枯，你需要一顆上勁的心慈缔。本文的末尾給出了R函數(shù)的文章，基本上看看就會了种玛。我們就不從最基本的什么是函數(shù)這種問題開始了藐鹤。
- 最直接的方法當(dāng)然是直接鍵入函數(shù)(不加括號)，大部分函數(shù)源代碼就可以直接顯現(xiàn)出來赂韵。我以PerformanceAnalytics包中的函數(shù)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>
當(dāng)然呢祭示，在Rstudio里面肄满，我們可以把光標(biāo)放在函數(shù)名上按F2，Rstudio會打開一個新的窗口來顯示這個函數(shù)：
優(yōu)點(diǎn)：直接簡單质涛。
缺點(diǎn)：并非所有的函數(shù)都能通過此方法得到悄窃。
原因：R是面向?qū)ο笤O(shè)計(jì)的程序語言。
- 2 用函數(shù)page()蹂窖，不過，結(jié)果在另一個窗口顯示,選擇電腦上的程序打開恩敌，我的是Notepad++瞬测。
> page(chart.Correlation)
- 3 與方法二類似，用函數(shù)edit()。這個函數(shù)一看就很有喜感月趟，明顯他是允許我們來修改函數(shù)的灯蝴，這才是開源的真諦啊。修改了直接用孝宗。還是以我們這個函數(shù)為例穷躁。我們這個函數(shù)chart.Correlation是用來展示相關(guān)性的。但是她的參數(shù)很少因妇，滿足不了我的需求问潭。
data(managers)
chart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")
做出來的圖是這樣的：
但是我想把相關(guān)系數(shù)的字體都搞成一致，然后小圓圈的空心點(diǎn)變成“+”婚被，但是pch=這個參數(shù)不頂用狡忙。怎么辦？查看了幫助文檔help(chart.Correlation)也沒有參數(shù)可調(diào)址芯，看來修改函數(shù)是一個不錯的選擇了灾茁。
于是我就：
> mychart.Correlation<-edit(chart.Correlation)
我把它設(shè)置字體的部分和調(diào)整散點(diǎn)圖形狀的部分稍作了修改，點(diǎn)擊Save谷炸，這樣一個新的函數(shù)mychart.Correlation就生成了”弊ǎ現(xiàn)在，我用同樣的數(shù)據(jù)和參數(shù)來繪制這個圖旬陡，達(dá)到了我的要求：
data(managers)
mychart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")
修改后的函數(shù)是這樣的：
函數(shù)edit()不僅可以修改包中的函數(shù)作為急用拓颓，也可以用來修改自己正在寫的函數(shù)，可以說很實(shí)用了在我們寫函數(shù)的時候季惩。
- 對于計(jì)算方法不同的函數(shù)录粱，要用methods()來定義具體的查看對象，如查看函數(shù)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>
- 對于程序包里的函數(shù)青抛，需要先調(diào)用函數(shù)所在的包旗闽。
2.對于methods()得出的類函數(shù)中帶星號標(biāo)注的源代碼是看不到的。
3.對于非類函數(shù)蜜另，不能用此方法适室。
如chart.Correlation()就不能用這方法：
> methods(chart.Correlation)
no methods found
> chart.Correlation.default
Error: object 'chart.Correlation.default' not found
- methods()得出的類函數(shù)中帶星號標(biāo)注的源代碼，用函數(shù)getAnywhere()举瑰，如查找predict函數(shù)的源代碼捣辆。
> 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>
- 直接上CRAN 下載源代碼包
流程如下：
- 直接上CRAN 下載源代碼包
- 登入R主頁 http://www.r-project.org/ ，點(diǎn)擊 Download 下的CRAN;
- 選擇一個鏡像;
- 里面的Source Code for all Platforms下有各種源碼了此迅，對于程序包汽畴，點(diǎn)packages;
- 點(diǎn)選擇項(xiàng)Table of available packages, sorted by name;
- 找到你你想要的包旧巾，點(diǎn)擊看Package source這一項(xiàng)，用tar.gz封裝的忍些，下載解壓后就能看見源代碼了鲁猩。
再復(fù)雜的包也是由基本的R函數(shù)構(gòu)成的，所以從基礎(chǔ)學(xué)起總是不錯的罢坝±眨基礎(chǔ)決定高度。有了這六個查看R函數(shù)的方法嘁酿，是不是清楚了很多呢隙券。函數(shù)是完成某項(xiàng)具體任務(wù)的程序，能看R函數(shù)痹仙，學(xué)習(xí)R就不再是到處粘代碼了也不再是只會調(diào)參數(shù)了是尔，可以自己定義參數(shù)，自己來寫函數(shù)了开仰。
參考：
查看R源代碼的六種方法
怎么才能查看R語言某個包某函數(shù)源碼拟枚？
R查看各函數(shù)的源代碼
查看R函數(shù)源代碼
R語言－函數(shù)源代碼查看
【r<-高級|理論】R的函數(shù)
第五節(jié) R語言函數(shù)function
