R/cpalspath.R

In SALES: The (Adaptive) Elastic Net and Lasso Penalized Sparse Asymmetric Least Squares (SALES) and Coupled Sparse Asymmetric Least Squares (COSALES) using Coordinate Descent and Proximal Gradient Algorithms

cpalspath <- function(x, y, w, nlam, flmin, ulam, isd, intr, eps, dfmax, pmax,
                      jd, pfmean, pf2mean, pfscale, pf2scale, maxit, lam2, tau,
                      nobs, nvars, vnames) {
  ##=======================================================================##
  ## DATA SETUP
  storage.mode(y) <- "double"
  storage.mode(x) <- "double"
  if (tau <= 0 || tau >= 1 || tau == 0.5)
    stop("tau must be in (0,1)\\{0.5}")
  tau <- as.double(tau)
  if (w <= 0) stop("Weight must be positive.")
  w <- as.double(w)
  ##=======================================================================##
  ## CALL FORTRAN CORE
  fit <- .Fortran("cpalslassoNET", w, tau, lam2, nobs, nvars, x, y, jd, pfmean,
                  pfscale, pf2mean, pf2scale, dfmax, pmax, nlam, flmin, ulam,
                  eps, isd, intr, maxit, nalam = integer(1), b0 = double(nlam),
                  beta = double(pmax * nlam), ibeta = integer(pmax),
                  nbeta = integer(nlam), t0 = double(nlam),
                  theta = double(pmax * nlam), itheta = integer(pmax),
                  ntheta = integer(nlam), alam = double(nlam),
                  npass = integer(1), jerr = integer(1), PACKAGE = "SALES")
  ##=======================================================================##
  ## OUTPUT
  outlist <- getoutput(fit, maxit, pmax, nvars, vnames)
  outlist <- c(outlist, list(npasses = fit$npass, jerr = fit$jerr))
  class(outlist) <- c("cpalspath")
  outlist
}