7.0中的S语言函数用类对象封装

7.0中可以查看源代码

> colMeans
function(x, ...)
.Call("S_c_use_method", "colMeans")
> colMeans.default
function(x, na.rm = F, dims = 1, weights = NULL, freq = NULL, n = NULL
)
{
# Compute column means for a matrix.
# Supports higher-dimensional arrays - use dims to specify how
# many "row dimensions".
# May supply weights or frequencies (repetition counts).
# If `n' supplied, use that as number of rows, and
# and return vector w/o names.
# Otherwise return vector with names in usual case,
# or array with dimnames if there are at least 2 column dimensio
ns.
haveN <- !is.null(n)
if(haveN)
p <- length(x)/n
else {
if(length(dim(x)) < 2)
x <- as.matrix(x)
dimx <- dim(x)
if(dims < 1 || dims > length(dimx) - 1)
stop("dims not compatible with dim(x)")
dims <- seq(length = dims)
n <- prod(dimx[dims])
p <- prod(dimx[ - dims])
}
if(length(freq)) {
if(length(freq) != n)
stop("Length of freq does not match the number o
f rows"
)
if(length(weights))
weights <- weights * freq
else weights <- freq
}
answerIsNA <- F
if(length(weights)) {
# if weights supplied
if(length(weights) != n) stop(
"Length of weights does not match the nu
mber of rows"
)
# When calling C code, weights must have length 0 or n.
if(anyMissing(weights)) {
if(na.rm) {
wna <- which.na(weights)
weights <- weights[ - wna, drop = F]
dim(x) <- c(n, p)
x <- x[ - wna, , drop = F]
n <- nrow(x)
}
else answerIsNA <- T
}
}
if(answerIsNA)
answer <- NA * double(p)
else if(is.complex(x)) {
answer <- .C("S_colSums_NA_weights",
as.integer(n),
as.integer(p),
Re(x),
as.integer(length(weights)),
as.double(weights),
answer = double(p),
divide = TRUE,
as.integer(na.rm),
NAOK = T,
specialsok = T)$answer + (1i) * .C(
"S_colSums_NA_weights",
as.integer(n),
as.integer(p),
Im(x),
as.integer(length(weights)),
as.double(weights),
answer = double(p),
divide = TRUE,
as.integer(na.rm),
NAOK = T,
specialsok = T)$answer
}
else {
answer <- .C("S_colSums_NA_weights",
as.integer(n),
as.integer(p),
as.double(x),
as.integer(length(weights)),
as.double(weights),
answer = double(p),
divide = TRUE,
as.integer(na.rm),
NAOK = T,
specialsok = T)$answer
}
if(haveN)
return(answer)
if(length(dimx[ - dims]) > 1) {
#result is an array
dim(answer) <- dimx[ - dims]
if(!is.null(dimnames(x)))
dimnames(answer) <- dimnames(x)[ - dims]
}
else {
#result is a vector
temp <- dimnames(x)[[length(dimx)]]
if(length(temp) == p)
names(answer) <- temp
}
answer
}
ps：介绍s programming一书看看

还是自己试着多写点code

谢谢 你

谢谢 你

谢谢 你

[此贴子已经被作者于2007-1-21 22:41:03编辑过]