R/p.dcsvm.R

In dcsvm: Density Convoluted Support Vector Machines

#' Make Predictions for Sparse Density-Convoluted SVM
#'
#' This function predicts the binary class labels or the fitted values of a \code{\link{dcsvm}} object.
#'
#' @name predict.dcsvm
#' @aliases predict.dcsvm
#' @title Make Predictions for Sparse Density-Convoluted SVM
#'
#' @description
#' Predicts binary class labels or fitted values for a \code{dcsvm} model using new data.
#'
#' @usage
#' \method{predict}{dcsvm}(object, newx, s = NULL, type = c("class", "link"), ...)
#'
#' @param object A fitted \code{\link{dcsvm}} object.
#' @param newx A matrix of new values for \code{x} at which predictions are to be made. Note that \code{newx} must be a matrix; vectors or other formats are not accepted.
#' @param s Value(s) of the L1 tuning parameter \code{lambda} for computing coefficients. Default is the entire \code{lambda} sequence obtained by \code{\link{dcsvm}}.
#' @param type \code{"class"} or \code{"link"}? \code{"class"} produces the predicted binary class labels, while \code{"link"} returns the fitted values. Default is \code{"class"}.
#' @param ... Not used. Other arguments to \code{predict}.
#'
#' @details
#' \code{s} represents the new \code{lambda} values for making predictions. If \code{s} is not part of the original \code{lambda} sequence generated by \code{\link{dcsvm}}, \code{predict.dcsvm} uses linear interpolation to compute predictions by combining adjacent \code{lambda} values in the original sequence. This functionality is adapted from the \code{predict} methods in the \code{glmnet} and \code{gcdnet} packages.
#'
#' @return
#' Returns either the predicted class labels or the fitted values, depending on the choice of \code{type}.
#'
#' @seealso
#' \code{\link{coef.dcsvm}}
#'
#' @examples
#' data(colon)
#' fit <- dcsvm(colon$x, colon$y, lam2=1)
#' print(predict(fit, type="class", newx=colon$x[2:5, ]))
#'
#' @export
predict.dcsvm <- function(object, newx, s=NULL, 
    type=c("class", "link"), ...) {
  type <- match.arg(type)
  b0 <- t(as.matrix(object$b0))
  rownames(b0) <- "(Intercept)"
  nbeta <- rbind2(b0, object$beta)
  if (!is.null(s)) {
    vnames <- dimnames(nbeta)[[1]]
    dimnames(nbeta) <- list(NULL, NULL)
    lambda <- object$lambda
    lamlist <- lambda.interp(lambda, s)
    nbeta <- nbeta[ , lamlist$left, drop=FALSE] %*% 
            Diagonal(x=lamlist$frac) +
            nbeta[ , lamlist$right, drop=FALSE] %*% 
            Diagonal(x=1-lamlist$frac)
    dimnames(nbeta) <- list(vnames, paste(seq(along=s)))
  }
  nfit <- as.matrix(as.matrix(cbind2(1, newx)) %*% nbeta)
  switch(type, link=nfit, class=ifelse(nfit > 0, 1, -1))
} 

#' Print a DCSVM Object
#'
#' Print a summary of the \code{\link{dcsvm}} solution paths.
#'
#' @name print.dcsvm
#' @aliases print.dcsvm
#' @title Print a DCSVM Object
#'
#' @description
#' Prints a summary of the \code{dcsvm} object, showing the solution paths.
#'
#' @usage
#' \method{print}{dcsvm}(x, digits = max(3, getOption("digits") - 3), ...)
#'
#' @param x A fitted \code{\link{dcsvm}} object.
#' @param digits Specifies the significant digits to use in the output. Default is \code{max(3, getOption("digits") - 3)}.
#' @param ... Additional arguments to \code{print}.
#'
#' @details
#' This function prints a two-column matrix with columns \code{Df} and \code{Lambda}. The \code{Df} column shows the number of nonzero coefficients, and the \code{Lambda} column displays the corresponding \code{lambda} value. It is adapted from the \code{print} function in the \code{gcdnet} and \code{glmnet} packages.
#'
#' @return
#' A two-column matrix with one column showing the number of nonzero coefficients and the other column showing the \code{lambda} values.
#'
#' @seealso
#' \code{print.dcsvm}, \code{predict.dcsvm}, \code{coef.dcsvm}, \code{plot.dcsvm}, and \code{cv.dcsvm}.
#'
#' @examples
#' data(colon)
#' fit <- dcsvm(colon$x, colon$y)
#' print(fit)
#'
#' @export
print.dcsvm = function(x, digits=max(3, 
    getOption("digits")-3), ...) {
  cat("\nCall: ", deparse(x$call), "\n\n")
  print(cbind(Df=x$df, Lambda=signif(x$lambda, digits)))
} 


#' Plot Coefficients for Sparse Density-Convoluted SVM
#'
#' Plots the solution paths for a fitted \code{\link{dcsvm}} object.
#'
#' @name plot.dcsvm
#' @aliases plot.dcsvm
#' @title Plot Coefficients for Sparse Density-Convoluted SVM
#'
#' @description
#' Plots the solution paths as a coefficient profile plot for a fitted \code{dcsvm} model.
#'
#' @usage
#' \method{plot}{dcsvm}(x, xvar = c("norm", "lambda"), color = FALSE, label = FALSE, ...)
#'
#' @param x A fitted \code{\link{dcsvm}} model.
#' @param xvar Specifies the X-axis. If \code{xvar == "norm"}, plots against the L1-norm of the coefficients; if \code{xvar == "lambda"}, plots against the log-lambda sequence.
#' @param color If \code{TRUE}, plots the curves with rainbow colors; otherwise, with gray colors (default).
#' @param label If \code{TRUE}, labels the curves with variable sequence numbers. Default is \code{FALSE}.
#' @param ... Other graphical parameters to \code{plot}.
#'
#' @return
#' No return value, only called for plots.
#' 
#' @details
#' This function generates a coefficient profile plot showing the solution paths of the sparse density-convoluted SVM.
#'
#' @seealso
#' \code{print.dcsvm}, \code{predict.dcsvm}, \code{coef.dcsvm}, \code{plot.dcsvm}, and \code{cv.dcsvm}.
#'
#' @examples
#' data(colon)
#' fit <- dcsvm(colon$x, colon$y)
#' oldpar <- par(mfrow = c(1,3)) #changes par() and stores original par()
#' # Plots against the L1-norm of the coefficients
#' plot(fit)
#' # Plots against the log-lambda sequence
#' plot(fit, xvar="lambda", label=TRUE)
#' # Plots with colors
#' plot(fit, color=TRUE)
#' # Reset to user's option
#' par(oldpar)
#'
#' @export
plot.dcsvm <- function(x, xvar=c("norm", "lambda"), 
    color=FALSE, label=FALSE, ...) {
  beta <- x$beta
  lambda <- x$lambda
  df <- x$df
  xvar <- match.arg(xvar)
  ##beta should be in 'dgCMatrix' format
  which <- nonzero(beta)
  beta <- as.matrix(beta[which, ])
  xvar <- match.arg(xvar)
  switch(xvar, 
    norm = {
      index <- colSums(abs(beta))
      iname <- "l1 norm"
           }, 
    lambda = {
      index <- log(lambda)
      iname <- "log lambda"
           }
  )
  xlab <- iname
  ylab <- "coefficients"
  dotlist <- list(...)
  type <- dotlist$type
  if (is.null(type)) {
    if (color == FALSE) 
      matplot(index, t(beta), lty=1, xlab=xlab, ylab=ylab, 
        type="l", pch=500, 
        col=gray.colors(12, start=0.05, 
        end=0.7, gamma=2.2), ...) else matplot(index, 
      t(beta), lty=1, xlab=xlab, ylab=ylab, 
      type="l", pch=500, ...)
  } else matplot(index, t(beta), lty=1, xlab=xlab, ylab=ylab, ...)
    atdf <- pretty(index)
  prettydf <- trunc(approx(x=index, y=df, xout=atdf, rule=2)$y)
  axis(3, at=atdf, labels=prettydf, cex.axis=1, tcl=NA)
  if (label) {
    nnz <- length(which)
    xpos <- max(index)
    pos <- 4
    if (xvar == "lambda") {
      xpos <- min(index)
      pos <- 2
    }
    xpos <- rep(xpos, nnz)
    ypos <- beta[, ncol(beta)]
    text(xpos, ypos, paste(which), cex=0.5, pos=pos)
  }
}