Nothing
# --------------------------------------
# Author: Andreas Alfons
# Erasmus Universiteit Rotterdam
# --------------------------------------
fastLasso <- function(x, y, lambda, subset = NULL, normalize = TRUE,
intercept = TRUE, eps = .Machine$double.eps,
use.Gram = TRUE, drop = TRUE, raw = FALSE) {
# initializations
intercept <- isTRUE(intercept)
use.Gram <- isTRUE(use.Gram)
drop <- isTRUE(drop)
raw <- isTRUE(raw)
# compute lasso
if(raw) {
# call C++ function
fit <- .Call("R_testLasso", R_x=x, R_y=y, R_lambda=lambda,
R_initial=seq_along(y), R_normalize=normalize,
R_intercept=intercept, R_eps=eps, R_useGram=use.Gram,
PACKAGE = "robustHD")
# prepare object for raw lasso fit
coef <- fit$coefficients
res <- fit$residuals
if(drop) {
# drop the dimension of the components
coef <- drop(coef)
res <- drop(res)
}
center <- mean(res)
scale <- sqrt(mean((res-center)^2))
fit <- list(best=fit$indices, coefficients=coef, residuals=res,
objective=fit$crit, center=center, scale=scale)
} else {
# check subset
if(is.null(subset)) {
useSubset <- FALSE
subset <- integer()
} else useSubset <- TRUE
# call C++ function
fit <- .Call("R_fastLasso", R_x=x, R_y=y, R_lambda=lambda,
R_useSubset=useSubset, R_subset=subset,
R_normalize=normalize, R_intercept=intercept,
R_eps=eps, R_useGram=use.Gram,
PACKAGE = "robustHD")
if(drop) fit <- lapply(fit, drop) # drop the dimension of the components
}
# return lasso fit
fit
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.