原文链接:http://wangjinshe33.blog.163.com/blog/static/17558281201371301051757/
在学习R的过程中,当你能够顺利的使用一些R各个包提供给你的函数以后,是否会让你想看一看具体这个过程是如何实现的呢?
在R中,代码可以分为如下几个级别:
(1)控制台直接输入函数名称
首先,是你输入了函数对象名称,你可以直接看到代码的,如要获得函数对象fivenum的代码,就只需要在Console中键入函数对象名称fivenum就可以得到如下结果:
function (x, na.rm = TRUE)
{
xna <- is.na(x)
if (na.rm)
x <- x[!xna]
else if (any(xna))
return(rep.int(NA, 5))
x <- sort(x)
n <- length(x)
if (n == 0)
rep.int(NA, 5)
else {
n4 <- floor((n + 3)/2)/2
d <- c(1, n4, (n + 1)/2, n + 1 - n4, n)
0.5 * (x[floor(d)] + x[ceiling(d)])
}
}
<environment: namespace:stats>
{
}
<environment: namespace:stats>
(2)被”封“起来的函数,methods(fn)
function (x, ...)
UseMethod("mean")
<environment: namespace:base>
UseMethod("mean")
<environment: namespace:base>
[1] mean.data.frame mean.Date
mean.default
mean.difftime
mean.POSIXct
mean.POSIXlt
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(as.numeric(NA))
}
if (na.rm)
x <- x[!is.na(x)]
trim <- trim[1]
n <- length(x)
if (trim > 0 && n > 0) {
if (is.complex(x))
stop("trimmed means are not defined for complex data")
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]
n <- hi - lo + 1
}
.Internal(mean(x))
}
<environment: namespace:base>
{
}
<environment: namespace:base>
(3)getS3method(FUN,"default")
getAnywhere(FUN)
function (x, y, ...)
{
if (is.null(attr(x, "class")) && is.function(x)) {
nms <- names(list(...))
if (missing(y))
y <- {
if (!"from" %in% nms)
0
else if (!"to" %in% nms)
1
else if (!"xlim" %in% nms)
NULL
}
if ("ylab" %in% nms)
plot.function(x, y, ...)
else plot.function(x, y, ylab = paste(deparse(substitute(x)),
"(x)"), ...)
}
else UseMethod("plot")
}
<environment: namespace:graphics>
{
}
<environment: namespace:graphics>
plot.acf*
plot.data.frame*
plot.Date*
plot.decomposed.ts* plot.default
plot.dendrogram*
plot.density
plot.ecdf
plot.factor*
plot.formula*
plot.hclust*
plot.histogram*
plot.HoltWinters*
plot.isoreg*
plot.lm
plot.medpolish*
plot.mlm
plot.POSIXct*
plot.POSIXlt*
plot.ppr*
plot.prcomp*
plot.princomp*
plot.profile.nls*
plot.spec
plot.spec.coherency
plot.spec.phase
plot.stepfun
plot.stl*
plot.table*
plot.ts
plot.tskernel*
plot.TukeyHSD
plot.dendrogram*
plot.hclust*
plot.medpolish*
plot.prcomp*
plot.spec.phase
plot.tskernel*
[1] lm.fit
lm.fit.null
lm.influence lm.wfit
lm.wfit.null
Warning message:
function 'lm' appears not to be generic in: methods(lm)
Warning message:
function 'lm' appears not to be generic in: methods(lm)
A single object matching 'plot.stl' was found
It was found in the following places
registered S3 method for plot from namespace stats
namespace:stats
with value
It was found in the following places
with value
function (x, labels = colnames(X), set.pars = list(mar = c(0,
6, 0, 6), oma = c(6, 0, 4, 0), tck = -0.01, mfrow = c(nplot,
1)), main = NULL, range.bars = TRUE, ..., col.range = "light gray")
{
sers <- x$time.series
ncomp <- ncol(sers)
data <- drop(sers %*% rep(1, ncomp))
X <- cbind(data, sers)
colnames(X) <- c("data", colnames(sers))
nplot <- ncomp + 1
if (range.bars)
mx <- min(apply(rx <- apply(X, 2, range), 2, diff))
if (length(set.pars)) {
oldpar <- do.call("par", as.list(names(set.pars)))
on.exit(par(oldpar))
do.call("par", set.pars)
}
for (i in 1:nplot) {
plot(X[, i], type = if (i < nplot)
"l"
else "h", xlab = "", ylab = "", axes = FALSE, ...)
if (range.bars) {
dx <- 1/64 * diff(ux <- par("usr")[1:2])
y <- mean(rx[, i])
rect(ux[2] - dx, y + mx/2, ux[2] - 0.4 * dx, y -
mx/2, col = col.range, xpd = TRUE)
}
if (i == 1 && !is.null(main))
title(main, line = 2, outer = par("oma")[3] > 0)
if (i == nplot)
abline(h = 0)
box()
right <- i%%2 == 0
axis(2, labels = !right)
axis(4, labels = right)
axis(1, labels = i == nplot)
mtext(labels[i], side = 2, 3)
}
mtext("time", side = 1, line = 3)
invisible()
}
<environment: namespace:stats>
{
}
<environment: namespace:stats>