PDA

View Full Version : Open Source



WeeG
06-11-2009, 09:44 AM
Is it possible to see how the various functions are implemended ?
I mean, if I want to learn some model or test by looking at the code of it in R, is it possible ?

example: t test, linear regression, glm,.....

Tart
06-11-2009, 01:02 PM
in many cases simply type name of the function in R to get source. for example typing lm (linear models produces)

> lm
function (formula, data, subset, weights, na.action, method = "qr",
model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE,
contrasts = NULL, offset, ...)
{
ret.x <- x
ret.y <- y
cl <- match.call()
mf <- match.call(expand.dots = FALSE)
m <- match(c("formula", "data", "subset", "weights", "na.action",
"offset"), names(mf), 0L)
mf <- mf[c(1L, m)]
mf$drop.unused.levels <- TRUE
mf[[1L]] <- as.name("model.frame")
mf <- eval(mf, parent.frame())
if (method == "model.frame")
return(mf)
else if (method != "qr")
warning(gettextf("method = '&#37;s' is not supported. Using 'qr'",
method), domain = NA)
mt <- attr(mf, "terms")
y <- model.response(mf, "numeric")
w <- as.vector(model.weights(mf))
if (!is.null(w) && !is.numeric(w))
stop("'weights' must be a numeric vector")
offset <- as.vector(model.offset(mf))
if (!is.null(offset)) {
if (length(offset) != NROW(y))
stop(gettextf("number of offsets is %d, should equal %d (number of observations)",
length(offset), NROW(y)), domain = NA)
}
if (is.empty.model(mt)) {
x <- NULL
z <- list(coefficients = if (is.matrix(y)) matrix(, 0,
3) else numeric(0L), residuals = y, fitted.values = 0 *
y, weights = w, rank = 0L, df.residual = if (is.matrix(y)) nrow(y) else length(y))
if (!is.null(offset)) {
z$fitted.values <- offset
z$residuals <- y - offset
}
}
else {
x <- model.matrix(mt, mf, contrasts)
z <- if (is.null(w))
lm.fit(x, y, offset = offset, singular.ok = singular.ok,
...)
else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok,
...)
}
class(z) <- c(if (is.matrix(y)) "mlm", "lm")
z$na.action <- attr(mf, "na.action")
z$offset <- offset
z$contrasts <- attr(x, "contrasts")
z$xlevels <- .getXlevels(mt, mf)
z$call <- cl
z$terms <- mt
if (model)
z$model <- mf
if (ret.x)
z$x <- x
if (ret.y)
z$y <- y
if (!qr)
z$qr <- NULL
z
}
<environment: namespace:stats>


of course it doesn't always work (example t.test) in this case you probably want to download source files. go to usual CRAN select mirror, and on the left under "Software" you will see R Sources, download and now search through for specified function. I never really did it. But I know it is possible.

Tart
06-12-2009, 03:56 PM
One other way
go to you R folder, go to library select desired package
for example you are interested in qr function which is not available via simply typing in R. If you type qr it gives the following:

> qr
function (x, ...)
UseMethod("qr")
<environment: namespace:base>


Go to base folder in library (message above tells you it is part of the base package). You should see R-ex folder
C:\Program Files\R\R-2.9.0\library\base\R-ex. Inside you will see zip file unzip it
there is a qr.r function there - open it - you will see the source code


### Name: qr
### Title: The QR Decomposition of a Matrix
### Aliases: qr qr.default qr.coef qr.qy qr.qty qr.resid qr.fitted qr.solve
### is.qr as.qr solve.qr
### Keywords: algebra array

### ** Examples

hilbert <- function(n) { i <- 1:n; 1 / outer(i - 1, i, "+") }
h9 <- hilbert(9); h9
qr(h9)$rank #--> only 7
qrh9 <- qr(h9, tol = 1e-10)
qrh9$rank #--> 9
##-- Solve linear equation system H &#37;*% x = y :
y <- 1:9/10
x <- qr.solve(h9, y, tol = 1e-10) # or equivalently :
x <- qr.coef(qrh9, y) #-- is == but much better than
#-- solve(h9) %*% y
h9 %*% x # = y

## overdetermined system
A <- matrix(runif(12), 4)
b <- 1:4
qr.solve(A, b) # or solve(qr(A), b)
solve(qr(A, LAPACK=TRUE), b)
# this is a least-squares solution, cf. lm(b ~ 0 + A)

## underdetermined system
A <- matrix(runif(12), 3)
b <- 1:3
qr.solve(A, b)
solve(qr(A, LAPACK=TRUE), b)
# solutions will have one zero, not necessarily the same one