\name{Whitening_Lasso}
\alias{Whitening_Lasso}
\title{
Whitening Lasso
}
\description{
The function implements the approach described in the paper Zhu et al. (2020) given in the references.
}
\usage{
Whitening_Lasso(X, Y, Sigma, gamma = 0.95, maxsteps = 2000)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
  \item{X}{
Design matrix of the linear model.
}
  \item{Y}{
Response variable of the linear model.
}
  \item{Sigma}{
Correlation matrix of the rows of the design matrix. If not specified, the function \code{\link{Sigma_Estimation}} will be used to estimate this matrix.}
  \item{gamma}{
Parameter \eqn{\gamma} defined in the paper Zhu et al. (2020) given in the references. Its default value is 0.95.}
  \item{maxsteps}{
Integer specifying the maximum number of steps for the generalized Lasso algorithm. Its default value is 2000.}
}

\value{
Returns a list with the following components
\item{lambda }{different values of the parameter \eqn{\lambda} considered.}
\item{beta }{matrix of the estimations of \eqn{\beta} for all the \eqn{\lambda} considered.}
\item{trans_mat }{tranformation matrix which is the inverse of the square root of the estimation of the correlation matrix of the rows of the design matrix X.}
\item{beta.min }{estimation of \eqn{\beta} which minimize the MSE.}
\item{mse }{MSE for all the \eqn{\lambda} considered.}
}

\references{
W. Zhu, C. Levy-Leduc, N. Ternes. "A variable selection approach for highly correlated predictors in 
high-dimensional genomic data". arXiv:2007.10768.
}

\author{
Wencan Zhu, Celine Levy-Leduc, Nils Ternes
}

\examples{
data(X)
data(Y)
Sigma_est <- Sigma_Estimation(X)$mat
res_wlasso <- Whitening_Lasso(X=X, Y=Y, Sigma=Sigma_est, maxsteps=100, gamma=0.9)
beta_est <- res_wlasso$beta

## The function is currently defined as
function (X, Y, Sigma, gamma = 0.95, maxsteps = 2000, ...) 
{
    Sigma <- round(Sigma, 6)
    file <- try(SVD_sigma <- svd(Sigma))
    if (class(file) == "try-error") {
        cat("Caught an error during SVD.\n")
        Eigen_Sigma <- eigen(Sigma)
        V_sigma <- Eigen_Sigma$vectors
        lam <- Eigen_Sigma$values
        square_root_sigma <- V_sigma \%*\% diag(sqrt(lam)) \%*\% 
            solve(V_sigma)
        inv_diag <- ifelse(lam < 1e-06, 0, 1/sqrt(lam))
        inv_square_root_Sigma <- V_sigma \%*\% diag(inv_diag) \%*\% 
            solve(V_sigma)
    }
    else {
        U_sigma <- SVD_sigma$u
        D_sigma <- SVD_sigma$d
        square_root_sigma <- U_sigma \%*\% diag(sqrt(D_sigma)) \%*\% 
            t(U_sigma)
        inv_diag <- ifelse(D_sigma < 1e-06, 0, 1/sqrt(D_sigma))
        inv_square_root_Sigma <- U_sigma \%*\% diag(inv_diag) \%*\% 
            t(U_sigma)
        inv_square_root_Sigma <- U_sigma \%*\% diag(1/sqrt(D_sigma)) \%*\% 
            t(U_sigma)
    }
    X_tilde0 <- X \%*\% inv_square_root_Sigma
    out0 <- genlasso::genlasso(Y, X_tilde0, inv_square_root_Sigma, 
        maxsteps = maxsteps, ...)
    p <- ncol(X)
    top_grill <- (1:floor((p/5))) * 5
    opt_top <- opt_final_top <- c()
    beta_final_df <- matrix(NA, length(out0$lambda), p)
    mse_final <- c()
    for (i in 1:length(out0$lambda)) {
        beta_tilde <- out0$beta[, i]
        beta_tilde_sort <- sort(abs(beta_tilde), decreasing = TRUE)
        beta_tilde_top <- sapply(top_grill, top_thresh, sorted_vect = beta_tilde_sort, 
            x = beta_tilde)
        yhat <- as.matrix(X_tilde0 \%*\% beta_tilde_top)
        residuals <- sweep(yhat, 1, Y)
        mse_top <- colMeans(residuals^2)
        ratio_mse <- c()
        for (k in 1:(length(top_grill) - 1)) {
            ratio_mse[k] <- round(mse_top[k + 1]/mse_top[k], 
                6)
        }
        top_ratio <- min(which(ratio_mse >= gamma))
        if (is.infinite(top_ratio)) {
            opt_top[i] <- p
        }
        else {
            opt_top[i] <- top_grill[top_ratio]
        }
        beta_tilde_opt <- top_thresh(x = beta_tilde, thresh = opt_top[i], 
            sorted_vect = beta_tilde_sort)
        beta_final0 <- inv_square_root_Sigma \%*\% beta_tilde_opt
        beta_sort <- sort(abs(beta_final0), decreasing = TRUE)
        beta_interm <- sapply(top_grill, top, x = beta_sort, 
            sorted_vect = beta_sort)
        yhat <- as.matrix(X \%*\% beta_interm)
        residuals <- sweep(yhat, 1, Y)
        mse_final_top <- colMeans(residuals^2)
        ratio_mse <- c()
        for (k in 1:(length(top_grill) - 1)) {
            ratio_mse[k] <- round(mse_final_top[k + 1]/mse_final_top[k],6)
        }
        top_ratio <- min(which(ratio_mse >= gamma))
        if (is.infinite(top_ratio)) {
            opt_top[i] <- p
        }
        else {
            opt_final_top[i] <- top_grill[top_ratio]
        }
        beta_final_df[i, ] <- round(top(x = beta_final0, thresh = opt_final_top[i], 
            sorted_vect = beta_sort), 6)
        mse_final[i] <- mse_final_top[top_ratio]    
    }
    beta_min <- beta_final_df[which.min(mse_final), ]
    return(list(lambda = out0$lambda, beta = beta_final_df, 
    trans_mat = inv_square_root_Sigma, beta.min=beta_min, mse=mse_final))
  }
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ ~Whitening Lasso }% use one of  RShowDoc("KEYWORDS")

