R/run.sparsestep.R

In sparsestep: SparseStep Regression

# Core SparseStep routine. This could be implemented in a low-level language 
# in the future, if necessary.
#
run.sparsestep <- function(x, y, XX, Xy, nvars, lambda, gamma0, gammastep,
			   gammastop, IMsteps, force.zero, threshold) {
	# Start solving SparseStep
	gamma <- gamma0
	beta <- matrix(0.0, nvars, 1)

	it <- 0
	while (gamma > gammastop)
	{
		for (i in 1:IMsteps) {
			alpha <- beta
			omega <- gamma^2/(alpha^2 + gamma^2)^2
			Omega <- diag(as.vector(omega), nvars, nvars)
			beta <- solve(XX + lambda * Omega, Xy)
		}
		it <- it + 1
		gamma <- gamma / gammastep
	}

	# perform IM until convergence
	epsilon <- 1e-14
	loss <- get.loss(x, y, gamma, beta, lambda)
	lbar <- (1.0 + 2.0 * epsilon) * loss
	while ((lbar - loss)/loss > epsilon)
	{
		alpha <- beta
		omega <- gamma^2/(alpha^2 + gamma^2)^2
		Omega <- diag(as.vector(omega), nvars, nvars)
		beta <- solve(XX + lambda * Omega, Xy)
		lbar <- loss
		loss <- get.loss(x, y, gamma, beta, lambda)
	}

	# postprocessing
	if (force.zero) {
		beta[which(abs(beta) < threshold)] <- 0
	}
	return(beta)
}

get.loss <- function(x, y, gamma, beta, lambda)
{
	Xb <- x %*% beta
	diff <- y - Xb
	b2 <- beta^2
	binv <- 1/(b2 + gamma^2)
	loss <- t(diff) %*% diff + lambda * t(b2) %*% binv
	return(loss)
}