R/plot.customizedGlmnet.R

In customizedTraining: Customized Training for Lasso and Elastic-Net Regularized Generalized Linear Models

#' Visualize variables selected in each customized training subset
#' 
#' Produces a plot, with a row for each customized training submodel, showing
#' the variables selected in the subset, with variables along the horizonal axis
#' 
#' @param x a fitted \code{customizedGlmnet} object
#' @param lambda regularization parameter. Required
#' @param ... ignored
#' 
#' @return the function returns silently
#' 
#' @export
#' 
#' @examples
#' require(glmnet)
#' 
#' # Simulate synthetic data
#' n = m = 150
#' p = 50
#' q = 5
#' K = 3
#' sigmaC = 10
#' sigmaX = sigmaY = 1
#' set.seed(5914)
#' 
#' beta = matrix(0, nrow = p, ncol = K)
#' for (k in 1:K) beta[sample(1:p, q), k] = 1
#' c = matrix(rnorm(K*p, 0, sigmaC), K, p)
#' eta = rnorm(K)
#' pi = (exp(eta)+1)/sum(exp(eta)+1)
#' z = t(rmultinom(m + n, 1, pi))
#' x = crossprod(t(z), c) + matrix(rnorm((m + n)*p, 0, sigmaX), m + n, p)
#' y = rowSums(z*(crossprod(t(x), beta))) + rnorm(m + n, 0, sigmaY)
#' 
#' x.train = x[1:n, ]
#' y.train = y[1:n]
#' x.test = x[n + 1:m, ]
#' y.test = y[n + 1:m]
#' 
#' # Example 1: Use clustering to fit the customized training model to training
#' # and test data with no predefined test-set blocks
#' 
#' fit1 = customizedGlmnet(x.train, y.train, x.test, G = 3,
#'     family = "gaussian")
#' 
#' # Plot nonzero coefficients by group:
#' plot(fit1, lambda = 10)
#' 
#' # Example 2: If the test set has predefined blocks, use these blocks to define
#' # the customized training sets, instead of using clustering.
#' group.id = apply(z == 1, 1, which)[n + 1:m]
#' 
#' fit2 = customizedGlmnet(x.train, y.train, x.test, group.id)
#' 
#' # Plot nonzero coefficients by group:
#' plot(fit2, lambda = 10)
#' 
plot.customizedGlmnet <-
function(x, lambda, ...)
{
    groups = as.character(sort(unique(x$groupid)))
    nonzeroVariables = matrix(0, nrow = length(x$CTset) + 1,
        ncol = ncol(x$x$train))
    rownames(nonzeroVariables) = c("Standard", paste("Group", groups))

    selected = unique(unlist(stats::predict(x$standard, s = lambda,
        type = 'nonzero')))
    nonzeroVariables['Standard', selected] = 1
    for (group in groups) {
        selected = NULL
        if (class(x$fit[[group]])[1] != "singleton") {
            selected = unique(unlist(stats::predict(x$fit[[group]],
                s = lambda/x$fit[[group]]$nobs, type = "nonzero")))
        }
        nonzeroVariables[paste("Group", group), selected] = 1
    }
    
    selected = apply(t(nonzeroVariables), 1, rev)
    selected = t(selected[, colSums(selected) > 0])

    graphics::par(mar = c(5.1, 6.1, 4.1, 2.1))
    graphics::image(selected, col = c("white", "forestgreen"),
        axes = FALSE, xlab = "Variable", main = "Variables selected")
    graphics::axis(2, at = 0:length(groups)/length(groups),
        labels = colnames(selected), las = 1, lwd = 0)
}