R/plot.R

In MLGL: Multi-Layer Group-Lasso

#'
#' Plot the path obtained from \code{\link{MLGL}} function
#'
#' @param x \code{\link{MLGL}} object
#' @param log.lambda If TRUE, use log(lambda) instead of lambda in abscissa
#' @param lambda.lines if TRUE, add vertical lines at lambda values
#' @param ... Other parameters for plot function
#'
#' @examples
#' # Simulate gaussian data with block-diagonal variance matrix containing 12 blocks of size 5
#' set.seed(42)
#' X <- simuBlockGaussian(50, 12, 5, 0.7)
#' # Generate a response variable
#' y <- X[, c(2, 7, 12)] %*% c(2, 2, -2) + rnorm(50, 0, 0.5)
#' # Apply MLGL method
#' res <- MLGL(X, y)
#' # Plot the solution path
#' plot(res)
#' @method plot MLGL
#'
#' @seealso \link{MLGL}
#'
#' @export
plot.MLGL <- function(x, log.lambda = FALSE, lambda.lines = FALSE, ...) {
  # check log
  if (length(log.lambda) != 1) {
    stop("log must be a boolean.")
  }
  if (!is.logical(log.lambda)) {
    stop("log must be a boolean.")
  }
  # check log
  if (length(lambda.lines) != 1) {
    stop("lambda.lines must be a boolean.")
  }
  if (!is.logical(lambda.lines)) {
    stop("lambda.lines must be a boolean.")
  }

  bet <- listToMatrix(x, "lambda")

  # abscissa: log or not ?
  absc <- x$lambda
  if (log.lambda) {
    absc <- log(absc)
  }

  # plot
  matplot(absc, bet,
    type = "l", lty = 1, xlab = ifelse(log.lambda, expression(paste("log(", lambda, ")")), expression(lambda)),
    ylab = "Coefficients", main = "Solution path", ...
  )

  # add vertical lines for lambda values
  if (lambda.lines) {
    abline(v = absc, col = "blue", lty = "dotted", lwd = 0.5)
  }
}


#'
#' Plot the cross-validation obtained from \code{\link{cv.MLGL}} function
#'
#' @param x \code{\link{cv.MLGL}} object
#' @param log.lambda If TRUE, use log(lambda) instead of lambda in abscissa
#' @param ... Other parameters for plot function
#'
#' @examples
#' set.seed(42)
#' # Simulate gaussian data with block-diagonal variance matrix containing 12 blocks of size 5
#' X <- simuBlockGaussian(50, 12, 5, 0.7)
#' # Generate a response variable
#' y <- X[, c(2, 7, 12)] %*% c(2, 2, -2) + rnorm(50, 0, 0.5)
#' # Apply cv.MLGL method
#' res <- cv.MLGL(X, y)
#' # Plot the cv error curve
#' plot(res)
#' @method plot cv.MLGL
#'
#' @seealso \link{cv.MLGL}
#'
#' @export
plot.cv.MLGL <- function(x, log.lambda = FALSE, ...) {
  # check log
  if (length(log.lambda) != 1) {
    stop("log must be a boolean.")
  }
  if (!is.logical(log.lambda)) {
    stop("log must be a boolean.")
  }

  # abscissa: log or not ?
  absc <- x$lambda
  lam <- c(x$lambda.min, x$lambda.1se)
  if (log.lambda) {
    absc <- log(absc)
    lam <- log(lam)
  }

  # plot
  matplot(absc, cbind(x$cvm, x$cvupper, x$cvlower),
    type = "l", lty = c(1, 2, 2), col = c(1, 2, 2),
    xlab = ifelse(log.lambda, expression(paste("log(", lambda, ")")), expression(lambda)), ylab = "Error", ...
  )
  abline(v = lam, col = "blue", lty = "dashed")
}


#'
#' Plot the stability path obtained from \code{\link{stability.MLGL}} function
#'
#' @param x \code{\link{stability.MLGL}} object
#' @param log.lambda If TRUE, use log(lambda) instead of lambda in abscissa
#' @param threshold Threshold for selection frequency
#' @param ... Other parameters for plot function
#'
#' @return A list containing:
#' \describe{
#' \item{var}{Index of selected variables for the given threshold.}
#' \item{group}{Index of the associated group.}
#' \item{threshold}{Value of threshold}
#' }
#'
#' @examples
#' \donttest{
#' set.seed(42)
#' # Simulate gaussian data with block-diagonal variance matrix containing 12 blocks of size 5
#' X <- simuBlockGaussian(50, 12, 5, 0.7)
#'
#' # Generate a response variable
#' y <- X[, c(2, 7, 12)] %*% c(2, 2, -2) + rnorm(50, 0, 0.5)
#'
#' # Apply stability.MLGL method
#' res <- stability.MLGL(X, y)
#' selected <- plot(res)
#' print(selected)
#' }
#'
#' @method plot stability.MLGL
#'
#' @seealso \link{stability.MLGL}
#'
#' @export
plot.stability.MLGL <- function(x, log.lambda = FALSE, threshold = 0.75, ...) {
  # check log
  if (length(log.lambda) != 1) {
    stop("log must be a boolean.")
  }
  if (!is.logical(log.lambda)) {
    stop("log must be a boolean.")
  }
  # threshold
  if (!is.numeric(threshold) | (length(threshold) != 1)) {
    stop("threshold must be a positive real lesser than 1.")
  }
  if ((threshold < 0) | (threshold > 1)) {
    stop("threshold must be a positive real lesser than 1.")
  }

  # abscissa: log or not ?
  absc <- x$lambda
  if (log.lambda) {
    absc <- log(absc)
  }

  # determine color according to threshold
  col <- apply(x$stability, 2, FUN = function(x) {
    ifelse(any(x > threshold), 2, 1)
  })

  # plot
  matplot(absc, x$stability,
    type = "l", lty = 1, col = col,
    xlab = ifelse(log.lambda, expression(paste("log(", lambda, ")")), expression(lambda)), ylab = "Probability selection", ...
  )
  abline(h = threshold, col = "blue", lty = "dashed")

  # determine selected groups and variables
  selectedGroup <- which(col == 2)
  indsel <- x$group %in% selectedGroup

  return(invisible(list(var = x$var[indsel], group = x$group[indsel], threshold = threshold)))
}



#'
#' Plot the path obtained from \code{\link{fullProcess}} function
#'
#' @param x \code{\link{fullProcess}} object
#' @param log.lambda If TRUE, use log(lambda) instead of lambda in abscissa
#' @param lambda.lines If TRUE, add vertical lines at lambda values
#' @param lambda.opt If there is several optimal lambdas, which one to print "min", "max" or "both"
#' @param ... Other parameters for plot function
#'
#' @examples
#' set.seed(42)
#' # Simulate gaussian data with block-diagonal variance matrix containing 12 blocks of size 5
#' X <- simuBlockGaussian(50, 12, 5, 0.7)
#' # Generate a response variable
#' y <- X[, c(2, 7, 12)] %*% c(2, 2, -2) + rnorm(50, 0, 0.5)
#' # Apply MLGL method
#' res <- fullProcess(X, y)
#' # Plot the solution path
#' plot(res)
#' @method plot fullProcess
#'
#' @seealso \link{fullProcess}
#'
#' @export
plot.fullProcess <- function(x, log.lambda = FALSE, lambda.lines = FALSE, lambda.opt = c("min", "max", "both"), ...) {
  lambda.opt <- match.arg(lambda.opt)

  lambdaOpt <- switch(lambda.opt,
    "min" = x$lambdaOpt[1],
    "max" = x$lambdaOpt[length(x$lambdaOpt)],
    "both" = c(1, x$lambdaOpt[length(x$lambdaOpt)])
  )
  par(mfrow = c(2, 1))
  plot(x$res, ...)
  abline(v = ifelse(log.lambda, log(lambdaOpt), lambdaOpt), col = "red", lty = "dotted")
  text(ifelse(log.lambda, log(lambdaOpt), lambdaOpt), 0, labels = expression(lambda[opt]), col = "red", pos = 1)

  abscissa <- x$res$lambda
  if (log.lambda) {
    abscissa <- log(abscissa)
  }

  matplot(abscissa, cbind(x$res$nGroup, sapply(x$reject, length)),
    type = "l", col = c(1, 4), xlab = ifelse(log.lambda, expression(paste("log(", lambda, ")")), expression(lambda)),
    ylab = "Number of groups", main = "Number of groups in MLGL path", ...
  )
  abline(v = ifelse(log.lambda, log(lambdaOpt), lambdaOpt), col = "red", lty = "dotted")
  text(ifelse(log.lambda, log(lambdaOpt), lambdaOpt), 0, labels = expression(lambda[opt]), col = "red", pos = 2)
  legend("topright", c("before testing", "after testing"), col = c(1, 4), lty = 1:2, cex = 0.6)
}


#'
#' Plot the path obtained from \code{\link{HMT}} function
#'
#' @param x \code{\link{fullProcess}} object
#' @param log.lambda If TRUE, use log(lambda) instead of lambda in abscissa
#' @param lambda.lines If TRUE, add vertical lines at lambda values
#' @param lambda.opt If there is several optimal lambdas, which one to print "min", "max" or "both"
#' @param ... Other parameters for plot function
#'
#' @examples
#' set.seed(42)
#' # Simulate gaussian data with block-diagonal variance matrix containing 12 blocks of size 5
#' X <- simuBlockGaussian(50, 12, 5, 0.7)
#' # Generate a response variable
#' y <- X[, c(2, 7, 12)] %*% c(2, 2, -2) + rnorm(50, 0, 0.5)
#' # Apply MLGL method
#' res <- MLGL(X, y)
#'
#' out <- HMT(res, X, y)
#' plot(out)
#' @method plot HMT
#'
#' @seealso \link{HMT}
#'
#' @export
plot.HMT <- function(x, log.lambda = FALSE, lambda.lines = FALSE, lambda.opt = c("min", "max", "both"), ...) {
  lambda.opt <- match.arg(lambda.opt)

  lambdaOpt <- switch(lambda.opt,
    "min" = x$lambdaOpt[1],
    "max" = x$lambdaOpt[length(x$lambdaOpt)],
    "both" = c(1, x$lambdaOpt[length(x$lambdaOpt)])
  )

  abscissa <- x$lambda
  if (log.lambda) {
    abscissa <- log(abscissa)
  }

  matplot(abscissa, cbind(x$nGroup, x$nSelectedGroup),
    type = "l", col = c(1, 4), xlab = ifelse(log.lambda, expression(paste("log(", lambda, ")")), expression(lambda)),
    ylab = "Number of groups", main = "Number of groups in MLGL path", ...
  )
  abline(v = ifelse(log.lambda, log(lambdaOpt), lambdaOpt), col = "red", lty = "dotted")
  text(ifelse(log.lambda, log(lambdaOpt), lambdaOpt), 0, labels = expression(lambda[opt]), col = "red", pos = 2)
  legend("topright", c("before testing", "after testing"), col = c(1, 4), lty = 1:2, cex = 0.6)
}