Commit b6387a64 authored by davidkep's avatar davidkep

add reg. M estimator

parent 278cd373
......@@ -37,5 +37,5 @@ Suggests:
License: MIT + file LICENSE
NeedsCompilation: yes
RoxygenNote: 7.1.0
Roxygen: list(markdown = TRUE)
Roxygen: list(markdown = TRUE, load = "source")
RdMacros: lifecycle
......@@ -4,15 +4,11 @@ S3method(as_starting_point,enpy_starting_points)
S3method(as_starting_point,starting_point)
S3method(c,starting_point)
S3method(c,starting_points)
S3method(coef,cv_elnetfit)
S3method(coef,cv_pensefit)
S3method(coef,elnetfit)
S3method(coef,pensefit)
S3method(plot,cv_elnetfit)
S3method(plot,cv_pensefit)
S3method(plot,elnetfit)
S3method(plot,pensefit)
S3method(print,nsoptim_metrics)
S3method(coef,pense_cvfit)
S3method(coef,pense_fit)
S3method(plot,pense_cvfit)
S3method(plot,pense_fit)
export(adamest_cv)
export(adapense_cv)
export(as_starting_point)
export(consistency_const)
......@@ -29,14 +25,17 @@ export(enpy_options)
export(initest_options)
export(mloc)
export(mlocscale)
export(mm_algorithm_options)
export(mscale)
export(mscale_algorithm_options)
export(mstep_options)
export(pense)
export(pense_cv)
export(pense_mm_options)
export(pense_options)
export(prinsens)
export(print.nsoptim_metrics)
export(regmest)
export(regmest_cv)
export(rho_function)
export(starting_point)
export(tau_size)
......
......@@ -22,22 +22,34 @@
#' @export
#' @importFrom lifecycle deprecate_warn deprecated is_present
#' @importFrom rlang warn
coef.pensefit <- function (object, lambda, sparse, exact = deprecated(), correction = deprecated(), ...) {
cl <- match.call(expand.dots = FALSE)
cl$`...` <- NULL
cl[[1L]] <- quote(pense:::.coef_fit)
eval.parent(cl)
}
coef.pense_fit <- function (object, lambda, sparse = NULL, exact = deprecated(), correction = deprecated(), ...) {
if (is_present(exact)) {
deprecate_warn('2.0.0', 'coef(exact=)')
}
if (is_present(correction)) {
deprecate_stop('2.0.0', 'coef(correction=)')
}
#' @rdname coef.pensefit
#' @export
coef.elnetfit <- function (object, lambda, sparse, exact = deprecated(), ...) {
cl <- match.call(expand.dots = FALSE)
cl$`...` <- NULL
cl[[1L]] <- quote(pense:::.coef_fit)
eval.parent(cl)
if (length(lambda) > 1L) {
warn("Only first element in `lambda` is used.")
}
lambda <- .as(lambda[[1L]], 'numeric')
if (isTRUE(lambda > object$lambda[[1L]]) && isTRUE(sum(abs(object$estimates[[1L]]$beta)) < .Machine$double.eps)) {
return(.concat_coefs(object$estimates[[1L]], object$call, sparse, parent.frame()))
}
lambda_match <- .approx_match(lambda, object$lambda)
if (is.na(lambda_match)) {
warn("Requested penalization level not part of the sequence. Returning interpolated coefficients.")
return(.interpolate_coefs(object, lambda, object$lambda, sparse = sparse, envir = parent.frame()))
} else {
return(.concat_coefs(object$estimates[[lambda_match]], object$call, sparse, parent.frame()))
}
}
#' Extract Coefficient Estimates
#'
#' Extract coefficients from a PENSE (or LS-EN) regularization path with hyper-parameters chosen by cross-validation.
......@@ -64,56 +76,8 @@ coef.elnetfit <- function (object, lambda, sparse, exact = deprecated(), ...) {
#'
#' @example examples/pense_fit.R
#' @export
coef.cv_pensefit <- function (object, lambda = c('min', 'se'), se_mult = 2, sparse, exact = deprecated(),
coef.pense_cvfit <- function (object, lambda = c('min', 'se'), se_mult = 2, sparse = NULL, exact = deprecated(),
correction = deprecated(), ...) {
cl <- match.call(expand.dots = FALSE)
cl$`...` <- NULL
cl[[1L]] <- quote(pense:::.coef_cvfit)
eval.parent(cl)
}
#' @rdname coef.cv_pensefit
#' @export
coef.cv_elnetfit <- function (object, lambda = c('min', 'se'), se_mult = 2, sparse, exact = deprecated(), ...) {
cl <- match.call(expand.dots = FALSE)
cl$`...` <- NULL
cl[[1L]] <- quote(pense:::.coef_cvfit)
eval.parent(cl)
}
#' @importFrom lifecycle deprecate_warn deprecated is_present
#' @importFrom rlang warn
.coef_fit <- function (object, lambda, sparse = NULL, exact = deprecated(), correction = deprecated()) {
if (is_present(exact)) {
deprecate_warn('2.0.0', 'coef(exact=)')
}
if (is_present(correction)) {
deprecate_stop('2.0.0', 'coef(correction=)')
}
if (length(lambda) > 1L) {
warn("Only first element in `lambda` is used.")
}
lambda <- .as(lambda[[1L]], 'numeric')
if (isTRUE(lambda > object$lambda[[1L]]) && isTRUE(sum(abs(object$estimates[[1L]]$beta)) < .Machine$double.eps)) {
return(.concat_coefs(object$estimates[[1L]], object$call, sparse, parent.frame()))
}
lambda_match <- .approx_match(lambda, object$lambda)
if (is.na(lambda_match)) {
warn("Requested penalization level not part of the sequence. Returning interpolated coefficients.")
return(.interpolate_coefs(object, lambda, object$lambda, sparse = sparse, envir = parent.frame()))
} else {
return(.concat_coefs(object$estimates[[lambda_match]], object$call, sparse, parent.frame()))
}
}
#' @importFrom lifecycle deprecate_warn deprecated is_present
#' @importFrom rlang warn
.coef_cvfit <- function (object, lambda = c('min', 'se'), se_mult = 2, sparse = NULL, exact = deprecated(),
correction = deprecated()) {
if (is_present(exact)) {
deprecate_warn('2.0.0', 'coef(exact=)')
}
......@@ -166,6 +130,7 @@ coef.cv_elnetfit <- function (object, lambda = c('min', 'se'), se_mult = 2, spar
}
}
## Interpolate the coefficients at `lambda` using estimates from `object` at `lambda_seq`.
## @param ... passed on to `.concat_coefs()`
.interpolate_coefs <- function (object, lambda, lambda_seq, ...) {
......
......@@ -67,10 +67,9 @@ mscale_algorithm_options <- function (max_it = 200, eps = 1e-8) {
return(mscale_opts)
}
#' MM-Algorithm to Compute Penalized Elastic Net S-Estimates
#' MM-Algorithm to Compute Penalized Elastic Net S- and M-Estimates
#'
#' Additional options for the MM algorithm to compute EN S-estimates.
#' Additional options for the MM algorithm to compute EN S- and M-estimates.
#'
#' @param max_it maximum number of iterations.
#' @param tightening how to make inner iterations more precise as the algorithm approaches a local minimum.
......@@ -78,12 +77,11 @@ mscale_algorithm_options <- function (max_it = 200, eps = 1e-8) {
#' is attained.
#' @param en_algorithm_opts options for the inner LS-EN algorithm. See [en_algorithm_options] for details.
#'
#' @return options for the PENSE MM-algorithm.
#' @return options for the MM algorithm.
#' @export
pense_mm_options <- function (max_it = 500, tightening = c('adaptive', 'exponential', 'none'),
tightening_steps = 10, en_algorithm_opts) {
list(algorithm = 'mm',
max_it = .as(max_it[[1L]], 'integer'),
mm_algorithm_options <- function (max_it = 500, tightening = c('adaptive', 'exponential', 'none'),
tightening_steps = 10, en_algorithm_opts) {
list(algorithm = 'mm', max_it = .as(max_it[[1L]], 'integer'),
tightening = .tightening_id(match.arg(tightening)),
tightening_steps = .as(tightening_steps[[1L]], 'integer'),
en_options = if (missing(en_algorithm_opts)) { NULL } else { en_algorithm_opts })
......@@ -204,6 +202,12 @@ en_ridge_options <- function () {
1L)
}
.regmest_algorithm_id <- function (opts) {
switch (opts$algorithm,
mm = 1L,
1L)
}
.tightening_id <- function (tightening) {
switch (tightening, exponential = 1L, adaptive = 2L, 0L)
}
......
......@@ -54,14 +54,14 @@ en_options_dal <- function (maxit = 100, eps = 1e-8, eta_mult = 2, eta_start_num
#'
#' \Sexpr[results=rd, stage=render]{lifecycle::badge('deprecated')}
#'
#' Superseded by [pense_mm_options()] and options supplied directly to [pense()].
#' Superseded by [mm_algorithm_options()] and options supplied directly to [pense()].
#'
#' @export
#' @keywords internal
#' @importFrom lifecycle deprecate_warn
pense_options <- function (delta = 0.25, maxit = 1000, eps = 1e-6, mscale_eps = 1e-8, mscale_maxit = 200,
verbosity = 0, cc = NULL, en_correction = TRUE) {
deprecate_warn('2.0.0', 'pense_options()', with = 'pense_mm_options()')
deprecate_warn('2.0.0', 'pense_options()', with = 'mm_algorithm_options()')
list(maxit = maxit, bdp = delta, eps = eps, mscale_opts = mscale_algorithm_options(max_it = maxit, eps = mscale_eps),
cc = cc)
}
......@@ -70,15 +70,15 @@ pense_options <- function (delta = 0.25, maxit = 1000, eps = 1e-6, mscale_eps =
#'
#' \Sexpr[results=rd, stage=render]{lifecycle::badge('deprecated')}
#'
#' Superseded by [pense_mm_options()] and options supplied directly to [pense()].
#' Superseded by [mm_algorithm_options()] and options supplied directly to [pense()].
#'
#' @export
#' @keywords internal
#' @importFrom lifecycle deprecate_warn
mstep_options <- function (cc = 3.44, maxit = 1000, eps = 1e-6, adjust_bdp = FALSE, verbosity = 0,
en_correction = TRUE) {
deprecate_warn('2.0.0', 'pense_options()', with = 'pense_mm_options()')
pense_mm_options(max_it = maxit)
deprecate_warn('2.0.0', 'mstep_options()', with = 'mm_algorithm_options()')
mm_algorithm_options(max_it = maxit)
}
#' Deprecated: ENPY Initial Estimates for EN S-Estimators
......
......@@ -58,8 +58,8 @@
#'
#' @seealso [elnet_cv()] for cross-validating prediction performance of the estimates.
#' @seealso [pense()] for an S-estimate of regression with elastic net penalty.
#' @seealso [coef.pensefit()] for extracting coefficient estimates.
#' @seealso [plot.pensefit()] for plotting the regularization path.
#' @seealso [coef.pense_fit()] for extracting coefficient estimates.
#' @seealso [plot.pense_fit()] for plotting the regularization path.
#'
#' @export
#' @aliases adaelnet adaen
......@@ -91,7 +91,7 @@ elnet <- function(x, y, alpha, nlambda = 100, lambda_min_ratio, lambda, penalty_
structure(list(estimates = .metrics_attrib(res$estimates, res$metrics), call = call, predictions = predictions,
lambda = unlist(lapply(res$estimates, `[[`, 'lambda'), use.names = FALSE, recursive = FALSE)),
class = 'elnetfit')
class = c('en', 'pense_fit'))
}
......@@ -130,8 +130,8 @@ elnet <- function(x, y, alpha, nlambda = 100, lambda_min_ratio, lambda, penalty_
#' \item{`estimates`}{the estimates fitted on the full data. Same format as returned by [elnet()].}
#' }
#'
#' @seealso [coef.cv_elnetfit()] for extracting coefficient estimates.
#' @seealso [plot.cv_elnetfit()] for plotting the CV performance or the regularization path.
#' @seealso [coef.pense_cvfit()] for extracting coefficient estimates.
#' @seealso [plot.pense_cvfit()] for plotting the CV performance or the regularization path.
#' @example examples/ls_elnet.R
#'
#' @export
......@@ -188,7 +188,7 @@ elnet_cv <- function (x, y, lambda, cv_k, cv_repl = 1, cv_metric = c('rmspe', 't
args$restore_coef_length(args$std_data$unstandardize_coefs(est))
})
return(structure(list(call = call, cvres = cv_perf_df, cv_replications = cv_perf, cv_measure = cv_measure_str,
estimates = .metrics_attrib(fit$estimates, fit$metrics)), class = 'cv_elnetfit'))
estimates = .metrics_attrib(fit$estimates, fit$metrics)), class = c('pense_en', 'pense_cvfit')))
}
## Perform some final input adjustments and call the internal C++ code.
......
#' Compute (Adaptive) Elastic Net S-Estimates of Regression
#'
#' Compute the elastic net S-estimates (PENSE estimates) along a grid of penalization levels with optional
#' Compute elastic net S-estimates (PENSE estimates) along a grid of penalization levels with optional
#' penalty loadings for adaptive elastic net.
#'
#' @section Strategies for Using Starting Points:
......@@ -16,7 +16,7 @@
#' set the `enpy_specific` argument to `TRUE`.
#'
#' In addition to EN-PY initial estimates, the algorithm can also use the "0-based" strategy if
#' `follow_zero_based = TRUE` (as the default). Here, the 0-vector is used to start the optimization at the largest
#' `add_zero_based = TRUE` (by default). Here, the 0-vector is used to start the optimization at the largest
#' penalization level in `lambda`. At subsequent penalization levels, the solution at the previous penalization level
#' is also used as starting point.
#'
......@@ -70,6 +70,9 @@
#' If this is less than `comparison_tol`, two solutions are deemed equal if the squared difference
#' of the intercepts is less than `comparison_tol` and the squared \eqn{L_2} norm of the
#' difference vector is less than `comparison_tol`.
#' @param add_zero_based also consider the 0-based regularization path. See details for a description.
#' @param enpy_specific use the EN-PY initial estimates only at the penalization level they are computed for.
#' See details for a description.
#' @param sparse use sparse coefficient vectors.
#' @param ncores number of CPU cores to use in parallel. By default, only one CPU core is used. May not be supported
#' on your platform, in which case a warning is given.
......@@ -97,8 +100,8 @@
#' }
#'
#' @seealso [pense_cv()] for selecting hyper-parameters via cross-validation.
#' @seealso [coef.pensefit()] for extracting coefficient estimates.
#' @seealso [plot.pensefit()] for plotting the regularization path.
#' @seealso [coef.pense_fit()] for extracting coefficient estimates.
#' @seealso [plot.pense_fit()] for plotting the regularization path.
#'
#' @example examples/pense_fit.R
#' @export
......@@ -108,7 +111,7 @@ pense <- function(x, y, alpha, nlambda = 50, nlambda_enpy = 10, lambda, lambda_m
penalty_loadings, intercept = TRUE, bdp = 0.25, add_zero_based = TRUE, enpy_specific = FALSE,
other_starts, eps = 1e-6, explore_solutions = 10, explore_tol = 0.1, max_solutions = 10,
comparison_tol = sqrt(eps), sparse = FALSE, ncores = 1, standardize = TRUE,
algorithm_opts = pense_mm_options(), mscale_opts = mscale_algorithm_options(),
algorithm_opts = mm_algorithm_options(), mscale_opts = mscale_algorithm_options(),
enpy_opts = enpy_options(), cv_k = deprecated(), cv_objective = deprecated(), ...) {
# Stop for CV-related options. Must migrate to `pense_cv`
......@@ -135,7 +138,7 @@ pense <- function(x, y, alpha, nlambda = 50, nlambda_enpy = 10, lambda, lambda_m
})
structure(list(estimates = .metrics_attrib(fit$estimates, fit$metrics), call = call,
lambda = unlist(lapply(fit$estimates, `[[`, 'lambda'), use.names = FALSE, recursive = FALSE)),
class = 'pensefit')
class = c('pense', 'pense_fit'))
}
#' Cross-validation for (Adaptive) PENSE Estimates
......@@ -241,7 +244,7 @@ pense_cv <- function(x, y, standardize = TRUE, lambda, cv_k, cv_repl = 1,
args$restore_coef_length(args$std_data$unstandardize_coefs(ests[[1L]]))
})
return(structure(list(call = call, cvres = cv_perf_df, cv_replications = cv_perf, cv_measure = cv_measure_str,
estimates = .metrics_attrib(fit$estimates, fit$metrics)), class = 'cv_pensefit'))
estimates = .metrics_attrib(fit$estimates, fit$metrics)), class = c('pense', 'pense_cvfit')))
}
#' @description `adapense_cv()` is a convenience wrapper to compute adaptive PENSE estimates.
......@@ -334,18 +337,6 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
return(list(extended_lambda = lambda, starting_points = starting_points))
}
#' @importFrom methods is
.sparsify_other_starts <- function (other_starts, sparse) {
lapply(other_starts, function (est) {
if (isTRUE(sparse) && !is(est$beta, 'dsparseVector')) {
est$beta <- sparseVector(as.numeric(est$beta), seq_along(est$beta), length(est$beta))
} else if (!isTRUE(sparse) && !is.numeric(est$beta)) {
est$beta <- .as(est$beta, 'numeric')
}
return(est)
})
}
## Get the smallest lambda such that the PENSE estimate gives the empty model.
.pense_max_lambda <- function (x, y, alpha, pense_options, penalty_loadings = NULL) {
optional_args <- list()
......@@ -387,7 +378,7 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
penalty_loadings, intercept = TRUE, bdp = 0.25, add_zero_based = TRUE, enpy_specific = FALSE,
other_starts, eps = 1e-6, explore_solutions = 10, explore_tol = 0.1, max_solutions = 10,
comparison_tol = sqrt(eps), sparse = FALSE, ncores = 1, standardize = TRUE,
algorithm_opts = pense_mm_options(), mscale_opts = mscale_algorithm_options(),
algorithm_opts = mm_algorithm_options(), mscale_opts = mscale_algorithm_options(),
enpy_opts = enpy_options(),
options = deprecated(), init_options = deprecated(), en_options = deprecated(),
initial = deprecated(), warm_reset = deprecated(), ...) {
......@@ -495,7 +486,7 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
strategy_other_individual = FALSE,
strategy_other_shared = FALSE,
algorithm = .pense_algorithm_id(algorithm_opts),
intercept = isTRUE(intercept),
intercept = !isFALSE(intercept),
eps = .as(eps[[1L]], 'numeric'),
comparison_tol = .as(comparison_tol[[1L]], 'numeric'),
explore_tol = .as(explore_tol[[1L]], 'numeric'),
......@@ -530,7 +521,6 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
enpy_opts$num_threads <- pense_opts$num_threads
# Standardizing the data
intercept <- !isFALSE(intercept)
standardize <- if (is.character(standardize)) {
if (pmatch(standardize[[1L]], 'cv_only', nomatch = 0L) == 1L) {
standardize <- 'cv_only'
......@@ -553,9 +543,10 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
}
if (ncol(x) == 0L) {
pense_opts$intercept <- TRUE
warn("All values in `penalty_loadings` are infinite. Only computing the intercept.")
std_data <- .standardize_data(matrix(runif(x_dim[[1L]]), ncol = 1L), y, intercept = intercept, sparse = sparse,
standardize = standardize, robust = TRUE, mscale_opts = mscale_opts,
std_data <- .standardize_data(matrix(runif(x_dim[[1L]]), ncol = 1L), y, intercept = TRUE,
sparse = sparse, standardize = standardize, robust = TRUE, mscale_opts = mscale_opts,
bdp = pense_opts$mscale$delta, scale_cc = pense_opts$mscale$cc)
# Compute only the 0-based solution.
pense_opts$strategy_enpy_individual <- FALSE
......@@ -564,13 +555,12 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
lambda <- .pense_lambda_grid(std_data$x, std_data$y, alpha, 1, 1, pense_opts, NULL)
return(list(std_data = std_data, alpha = alpha, lambda = lambda, enpy_lambda_inds = integer(0L),
penalty_loadings = NULL, intercept = intercept, pense_opts = pense_opts,
enpy_opts = enpy_opts, optional_args = optional_args,
penalty_loadings = NULL, pense_opts = pense_opts, enpy_opts = enpy_opts, optional_args = optional_args,
restore_coef_length = restore_coef_length))
}
std_data <- .standardize_data(x, y, intercept = intercept, standardize = standardize, robust = TRUE, sparse = sparse,
mscale_opts = mscale_opts, bdp = pense_opts$mscale$delta,
std_data <- .standardize_data(x, y, intercept = pense_opts$intercept, standardize = standardize, robust = TRUE,
sparse = sparse, mscale_opts = mscale_opts, bdp = pense_opts$mscale$delta,
scale_cc = pense_opts$mscale$cc)
# Scale penalty loadings appropriately
......@@ -592,7 +582,7 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
# Split the `other_starts` into individual and shared starts.
if (!missing(other_starts)) {
if (is(other_starts, 'starting_points')) {
if (is(other_starts, 'starting_point')) {
other_starts <- structure(list(other_starts), class = 'starting_points')
} else if (!is(other_starts, 'starting_points')) {
abort(paste("`other_starts` must be a list of starting points created by",
......@@ -638,10 +628,10 @@ adapense_cv <- function (x, y, alpha, alpha_preliminary = 0, exponent = 1, ...)
}
if (any(lambda < .Machine$double.eps)) {
abort("at least one value in `lambda` less or equal to 0.")
abort("All values in `lambda` must be positive.")
}
return(list(std_data = std_data, alpha = alpha, lambda = lambda, enpy_lambda_inds = enpy_lambda_inds,
penalty_loadings = penalty_loadings, intercept = intercept, pense_opts = pense_opts,
enpy_opts = enpy_opts, optional_args = optional_args, restore_coef_length = restore_coef_length))
penalty_loadings = penalty_loadings, pense_opts = pense_opts, enpy_opts = enpy_opts,
optional_args = optional_args, restore_coef_length = restore_coef_length))
}
......@@ -7,13 +7,7 @@
#'
#' @example examples/pense_fit.R
#' @export
plot.pensefit <- function (x, ...) {
.plot_coef_path(x, x$lambda, envir = parent.frame())
}
#' @rdname plot.pensefit
#' @export
plot.elnetfit <- function (x, ...) {
plot.pense_fit <- function (x, ...) {
.plot_coef_path(x, x$lambda, envir = parent.frame())
}
......@@ -29,7 +23,7 @@ plot.elnetfit <- function (x, ...) {
#'
#' @example examples/pense_fit.R
#' @export
plot.cv_pensefit <- function(x, what = c('cv', 'coef.path'), se_mult, ...) {
plot.pense_cvfit <- function(x, what = c('cv', 'coef.path'), se_mult, ...) {
what <- match.arg(what)
if (what == 'coef.path' && isFALSE(x$call$fit_all)) {
stop("`x` was created with `fit_all = FALSE`. Coefficient path not available.")
......@@ -48,15 +42,8 @@ plot.cv_pensefit <- function(x, what = c('cv', 'coef.path'), se_mult, ...) {
cv = .plot_cv_res(x, se_mult, se_sel))
}
#' @rdname plot.cv_pensefit
#' @export
plot.cv_elnetfit <- function(x, what = c('cv', 'coef.path'), se_mult, ...) {
cl <- match.call()
cl[[1L]] <- quote(pense:::plot.cv_pensefit)
eval.parent(cl)
}
#' @importFrom graphics plot segments abline
#' @importFrom rlang warn
.plot_cv_res <- function (object, se_mult, se_sel) {
measure_label <- switch(object$cv_measure, mape = "Median absolute prediction error",
rmspe = "Root mean square prediction error",
......@@ -72,11 +59,26 @@ plot.cv_elnetfit <- function(x, what = c('cv', 'coef.path'), se_mult, ...) {
}
cols <- colors[as.integer(se_sel)]
xrange <- range(lambda)
# Ensure errorbars don't extend into the negative!
errorbar_ymin <- cvavg - se_mult * cvse
neg_errorbars <- which(errorbar_ymin <= 0)
if (length(neg_errorbars) > 0L) {
warn("Error bars extending into the negative range are truncated.")
if (length(neg_errorbars) < length(cvavg)) {
# There are errorbars that do don't extend to the negative. Use the smallest positive value.
errorbar_ymin[neg_errorbars] <- min(errorbar_ymin[-neg_errorbars])
} else {
# All errorbars extend to the negative. Use arbitrary value.
errorbar_ymin <- rep.int(cvavg * 0.95, length(errorbar_ymin))
}
}
plot(lambda, cvavg, log = 'xy', col = cols,
ylim = range(cvavg + se_mult * cvse, cvavg - se_mult * cvse),
ylim = range(cvavg + se_mult * cvse, errorbar_ymin),
pch = 20L, xlab = expression(lambda), ylab = measure_label, main = "CV prediction performance")
if (isTRUE(se_mult > 0)) {
segments(lambda, cvavg - se_mult * cvse, lambda, cvavg + se_mult * cvse, col = cols)
segments(lambda, errorbar_ymin, lambda, cvavg + se_mult * cvse, col = cols)
abline(h = cvavg[[min_ind]] + se_mult * cvse[[min_ind]], col = colors[[3L]], lty = '22')
}
})
......
This diff is collapsed.
......@@ -375,3 +375,16 @@ extract_metric <- function (metrics, attr, node) {
return(list(loadings = penalty_loadings, trimmed_x = x, restore_fun = restore_coef_length))
}
#' @importFrom methods is
.sparsify_other_starts <- function (other_starts, sparse) {
lapply(other_starts, function (est) {
if (isTRUE(sparse) && !is(est$beta, 'dsparseVector')) {
est$beta <- sparseVector(as.numeric(est$beta), seq_along(est$beta), length(est$beta))
} else if (!isTRUE(sparse) && !is.numeric(est$beta)) {
est$beta <- .as(est$beta, 'numeric')
}
return(est)
})
}
#!/bin/sh
rm -Rf autom4te.cache
rm config.log
rm config.status
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/coef-methods.R
\name{coef.cv_pensefit}
\alias{coef.cv_pensefit}
\alias{coef.cv_elnetfit}
\name{coef.pense_cvfit}
\alias{coef.pense_cvfit}
\title{Extract Coefficient Estimates}
\usage{
\method{coef}{cv_pensefit}(
\method{coef}{pense_cvfit}(
object,
lambda = c("min", "se"),
se_mult = 2,
sparse,
sparse = NULL,
exact = deprecated(),
correction = deprecated(),
...
)
\method{coef}{cv_elnetfit}(
object,
lambda = c("min", "se"),
se_mult = 2,
sparse,
exact = deprecated(),
...
)
}
\arguments{
\item{object}{PENSE with cross-validated hyper-parameters to extract coefficients from.}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/coef-methods.R
\name{coef.pensefit}
\alias{coef.pensefit}
\alias{coef.elnetfit}
\name{coef.pense_fit}
\alias{coef.pense_fit}
\title{Extract Coefficient Estimates}
\usage{
\method{coef}{pensefit}(
\method{coef}{pense_fit}(
object,
lambda,
sparse,
sparse = NULL,
exact = deprecated(),
correction = deprecated(),
...
)
\method{coef}{elnetfit}(object, lambda, sparse, exact = deprecated(), ...)
}
\arguments{
\item{object}{PENSE regularization path to extract coefficients from.}
......
......@@ -128,7 +128,7 @@ coef(cv_results, lambda = 'se')
\code{\link[=pense]{pense()}} for an S-estimate of regression with elastic net penalty.
\code{\link[=coef.pensefit]{coef.pensefit()}} for extracting coefficient estimates.
\code{\link[=coef.pense_fit]{coef.pense_fit()}} for extracting coefficient estimates.
\code{\link[=plot.pensefit]{plot.pensefit()}} for plotting the regularization path.
\code{\link[=plot.pense_fit]{plot.pense_fit()}} for plotting the regularization path.
}
......@@ -86,7 +86,7 @@ coef(cv_results, lambda = 'se')
\code{\link[=pense_cv]{pense_cv()}} for cross-validation of S-estimates of regression with elastic net penalty.
\code{\link[=coef.cv_elnetfit]{coef.cv_elnetfit()}} for extracting coefficient estimates.
\code{\link[=coef.pense_cvfit]{coef.pense_cvfit()}} for extracting coefficient estimates.
\code{\link[=plot.cv_elnetfit]{plot.cv_elnetfit()}} for plotting the CV performance or the regularization path.
\code{\link[=plot.pense_cvfit]{plot.pense_cvfit()}} for plotting the CV performance or the regularization path.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/control_options.R
\name{pense_mm_options}
\alias{pense_mm_options}
\title{MM-Algorithm to Compute Penalized Elastic Net S-Estimates}
\name{mm_algorithm_options}
\alias{mm_algorithm_options}
\title{MM-Algorithm to Compute Penalized Elastic Net S- and M-Estimates}
\usage{
pense_mm_options(
mm_algorithm_options(
max_it = 500,
tightening = c("adaptive", "exponential", "none"),
tightening_steps = 10,
......@@ -22,8 +22,8 @@ is attained.}
\item{en_algorithm_opts}{options for the inner LS-EN algorithm. See \link{en_algorithm_options} for details.}
}
\value{
options for the PENSE MM-algorithm.
options for the MM algorithm.
}
\description{
Additional options for the MM algorithm to compute EN S-estimates.
Additional options for the MM algorithm to compute EN S- and M-estimates.
}
......@@ -17,6 +17,6 @@ mstep_options(
\Sexpr[results=rd, stage=render]{lifecycle::badge('deprecated')}
}
\details{
Superseded by \code{\link[=pense_mm_options]{pense_mm_options()}} and options supplied directly to \code{\link[=pense]{pense()}}.
Superseded by \code{\link[=mm_algorithm_options]{mm_algorithm_options()}} and options supplied directly to \code{\link[=pense]{pense()}}.
}
\keyword{internal}
......@@ -28,7 +28,7 @@ pense(
sparse = FALSE,
ncores = 1,
standardize = TRUE,
algorithm_opts = pense_mm_options(),
algorithm_opts = mm_algorithm_options(),
mscale_opts = mscale_algorithm_options(),
enpy_opts = enpy_options(),
cv_k = deprecated(),
......@@ -66,6 +66,11 @@ coefficient. Only allowed for \code{alpha} > 0.}
\item{bdp}{desired breakdown point of the estimator, between 0 and 0.5.}
\item{add_zero_based}{also consider the 0-based regularization path. See details for a description.}
\item{enpy_specific}{use the EN-PY initial estimates only at the penalization level they are computed for.
See details for a description.}
\item{other_starts}{a list of other staring points, created by \code{\link[=starting_point]{starting_point()}}.
If the output of \code{\link[=enpy_initial_estimates]{enpy_initial_estimates()}} is given, the starting points will be \emph{shared}
among all penalization levels.
......@@ -126,7 +131,7 @@ a list-like object with the following items
}
}
\description{
Compute the elastic net S-estimates (PENSE estimates) along a grid of penalization levels with optional
Compute elastic net S-estimates (PENSE estimates) along a grid of penalization levels with optional
penalty loadings for adaptive elastic net.
}
\section{Strategies for Using Starting Points}{
......@@ -143,7 +148,7 @@ If the starting points should be \emph{specific} to the penalization level the s
set the \code{enpy_specific} argument to \code{TRUE}.
In addition to EN-PY initial estimates, the algorithm can also use the "0-based" strategy if
\code{follow_zero_based = TRUE} (as the default). Here, the 0-vector is used to start the optimization at the largest
\code{add_zero_based = TRUE} (by default). Here, the 0-vector is used to start the optimization at the largest
penalization level in \code{lambda}. At subsequent penalization levels, the solution at the previous penalization level
is also used as starting point.
......@@ -189,7 +194,7 @@ coef(cv_results, lambda = 'se')
\seealso{
\code{\link[=pense_cv]{pense_cv()}} for selecting hyper-parameters via cross-validation.
\code{\link[=coef.pensefit]{coef.pensefit()}} for extracting coefficient estimates.
\code{\link[=coef.pense_fit]{coef.pense_fit()}} for extracting coefficient estimates.
\code{\link[=plot.pensefit]{plot.pensefit()}} for plotting the regularization path.
\code{\link[=plot.pense_fit]{plot.pense_fit()}} for plotting the regularization path.
}
......@@ -19,6 +19,6 @@ pense_options(
\Sexpr[results=rd, stage=render]{lifecycle::badge('deprecated')}
}
\details{
Superseded by \code{\link[=pense_mm_options]{pense_mm_options()}} and options supplied directly to \code{\link[=pense]{pense()}}.
Superseded by \code{\link[=mm_algorithm_options]{mm_algorithm_options()}} and options supplied directly to \code{\link[=pense]{pense()}}.
}
\keyword{internal}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plot-methods.R
\name{plot.cv_pensefit}
\alias{plot.cv_pensefit}
\alias{plot.cv_elnetfit}
\name{plot.pense_cvfit}
\alias{plot.pense_cvfit}