如何查看函数代码
在R的学习和实战中,我们需要灵活地使用R的函数(R函数非常多也非常广),有时候需要研究一些R函数的代码,一来学习前辈们是如何设计和创建R函数;二来弄清楚R函数是怎么工作的;三来可以根据实际情况来修改R函数。研究函数代码,有这么多意义,那我们如何查看R函数代码呢?一般情况,我们只需要在R命令提示符后输入函数名即可。例如> sumfunction(..., na.rm = FALSE) .Primitive("sum")若是类函数,先用methods()方法查看类函数列表,找到具体需要的函数,写出来,回车即可。例如> methods(summary)summary.aov summary.aovlist*
summary.aspell* summary.connection
summary.data.frame summary.Date
summary.default summary.ecdf*
summary.factor summary.glm
summary.infl* summary.lm
summary.loess* summary.manova
summary.matrix summary.mlm*
summary.nls* summary.packageStatus*
summary.PDF_Dictionary* summary.PDF_Stream*
summary.POSIXct summary.POSIXlt
summary.ppr* summary.prcomp*
summary.princomp* summary.proc_time
summary.srcfile summary.srcref
summary.stepfun summary.stl*
summary.table summary.tukeysmooth*
Non-visible functions are asterisked
> summary.lm
function (object, correlation = FALSE, symbolic.cor = FALSE,
...)
{
z <- object
p <- z$rank
rdf <- z$df.residual
if (p == 0)
{
r <- z$residuals
n <- length(r)
w <- z$weights
if (is.null(w))
{ rss <- sum(r^2) } else { rss <- sum(w * r^2) r <- sqrt(w) * r } resvar <- rss/rdf ans <- z class(ans) <- "summary.lm" ans$aliased <- is.na(coef(object)) ans$residuals <- r ans$df <- c(0L, n, length(ans$aliased)) ans$coefficients <- matrix(NA, 0L, 4L) dimnames(ans$coefficients) <- list(NULL, c("Estimate", "Std. Error", "t value", "Pr(>|t|)")) ans$sigma <- sqrt(resvar) ans$r.squared <- ans$adj.r.squared <- 0 return(ans) } if (is.null(z$terms)) stop("invalid 'lm' object:no 'terms' component") if (!inherits(object, "lm")) warning("calling summary.lm(<fake-lm-object>) ...") Qr <- qr.lm(object) n <- NROW(Qr$qr) if (is.na(z$df.residual) || n - p != z$df.residual) warning("residual degrees of freedom in object suggest this is not an \"lm\" fit") r <- z$residuals f <- z$fitted.values w <- z$weights if (is.null(w)) { mss <- if (attr(z$terms, "intercept")) sum((f - mean(f))^2) else sum(f^2) rss <- sum(r^2) } else { mss <- if (attr(z$terms, "intercept")) { m <- sum(w * f/sum(w)) sum(w * (f - m)^2) } else sum(w * f^2) rss <- sum(w * r^2) r <- sqrt(w) * r } resvar <- rss/rdf if (is.finite(resvar) && resvar < (mean(f)^2 + var(f)) * 1e-30) warning("essentially perfect fit: summary may be unreliable") p1 <- 1L:p R <- chol2inv(Qr$qr) se <- sqrt(diag(R) * resvar) est <- z$coefficients] tval <- est/se ans <- z ans$residuals <- r ans$coefficients <- cbind(est, se, tval, 2 * pt(abs(tval), rdf, lower.tail = FALSE)) dimnames(ans$coefficients) <- list(names(z$coefficients)], c("Estimate", "Std. Error", "t value", "Pr(>|t|)")) ans$aliased <- is.na(coef(object)) ans$sigma <- sqrt(resvar) ans$df <- c(p, rdf, NCOL(Qr$qr)) if (p != attr(z$terms, "intercept")) { df.int <- if (attr(z$terms, "intercept")) 1L else 0L ans$r.squared <- mss/(mss + rss) ans$adj.r.squared <- 1 - (1 - ans$r.squared) * ((n - df.int)/rdf) ans$fstatistic <- c(value = (mss/(p - df.int))/resvar, numdf = p - df.int, dendf = rdf) } else ans$r.squared <- ans$adj.r.squared <- 0 ans$cov.unscaled <- R dimnames(ans$cov.unscaled) <- dimnames(ans$coefficients) if (correlation) { ans$correlation <- (R * resvar)/outer(se, se) dimnames(ans$correlation) <- dimnames(ans$cov.unscaled) ans$symbolic.cor <- symbolic.cor } if (!is.null(z$na.action)) ans$na.action <- z$na.action class(ans) <- "summary.lm" ans}
【想一想】1如何学习R编程?2如何写R函数?【做一做】1查阅mean函数和plot函数的代码?2根据自己的问题域,研究一些函数的源代码?
原文地址:http://mp.weixin.qq.com/s?__biz=MzA4NDgyMzkyMA==&mid=200387156&idx=1&sn=9b52da529198538e464b9ce8bf79dc46&3rd=MzA3MDU4NTYzMw==&scene=6#rd
页:
[1]