added a quality function to the package

R/SFCB.R

@@ -204,140 +204,3 @@ sfcb <- function(X, Y, group.method = c("adjclust", "cclustofvar"),
   
   return(out)
 }
-
-# Methods for SFCB-class ####
-#' @title Methods for SFCB object
-#' @name SFCB
-#' @export
-#' @aliases summary.SFCB
-#' @aliases print.SFCB
-#' @aliases plot.SFCB
-#' @aliases extract.SFCB
-#' @aliases SFCB-class
-#' @description Print or plot a summary of the result of \code{\link{sfcb}} (
-#' \code{SFCB} object)
-#' @param object a \code{SFCB} object
-#' @param x a \code{SFCB} object
-#' @param plot.type  type of the plot. Default to \code{"dendrogram"}
-#' @param ... not used
-#' @param at numeric vector. Set of the number of intervals to extract for 
-#' \code{extract_at}
-#' @author {Victor Picheny, \email{victor.picheny@inrae.fr}\cr 
-#' Remi Servien, \email{remi.servien@inrae.fr}\cr
-#' Nathalie Vialaneix, \email{nathalie.vialaneix@inrae.fr}}
-#' @seealso \code{\link{sfcb}}
-#' data(truffles)
-#' out1 <- sfcb(rainfall, truffles, group.method = "adjclust", 
-#'              summary.method = "pls", selection.method = "relief")
-#' summary(out1)
-#' 
-#' \dontrun{
-#' plot(out1)
-#' plot(out1, plot.type = "selection")
-#' plot(out1, plot.type = "importance")
-#' }
-#' 
-#' out2 <- sfcb(rainfall, truffles, group.method = "adjclust", 
-#'              summary.method = "basics", selection.method = "none",
-#'              range.at = c(5, 7))
-#' out3 <- extract_at(out2, at = 6)
-#' summary(out3)
-#' 
-summary.SFCB <- function(object, ...) {
-  cat("\nCall:\n")
-  print(object$call)
-  cat("\nSFCB object with:\n")
-  lobj <- length(object$groups)
-  if (lobj == 1) {
-    cat("    -", length(unique(object$groups[[1]])), "interval(s)\n")
-  } else {
-    minl <- length(unique(object$groups[[1]]))
-    maxl <- length(unique(object$groups[[lobj]]))
-    cat("    -", minl, "-", maxl, "interval(s)\n")
-  }
-  if ("selected" %in% names(object)) {
-    if (!is.null(ncol(object$selected[[1]]))) {
-      selected <- lapply(object$selected, function(alist) {
-        apply(alist[, 2:3], 1, sum)
-      })
-    } else selected <- object$selected
-    if (lobj == 1) {
-      selected <- object$groups[[1]][selected[[1]]]
-      cat("    -", length(unique(selected)), "selected interval(s)\n")
-    } else {
-      selected <- mapply(function(a, b) a[b], object$groups, selected)
-      selected <- sapply(selected, function(x) length(unique(x)))
-      cat("    -", min(selected), "-", max(selected), "selected interval(s)\n")
-    }
-  }
-  cat("    -", nrow(object$mse) / lobj, "repeats\n")
-  cat("    - MSE ranging in [", min(object$mse$mse), ", ", max(object$mse$mse),
-      "]\n", sep = "")
-  if ("computational.times" %in% names(object)) {
-    cat("    - computational time (total):", sum(object$computational.times), 
-        "(seconds)\n\n")
-  }
-  return(invisible(NULL))
-}
-
-#' @export
-#' @rdname SFCB
-print.SFCB <- function(x, ...) {
-  summary(x)
-}
-
-#' @rdname SFCB
-#' @export
-plot.SFCB <- function(x, 
-                      plot.type = c("dendrogram", "selection", "importance"),
-                      shape.imp = c("boxplot", "histogram"),
-                      sel.type = c("importance", "selection"),
-                      threshold = "none") {
-  args <- list("x" = x)
-  plot.type <- match.arg(plot.type)
-  args$"shape.imp" <- match.arg(shape.imp)
-  args$"sel.type" <- match.arg(sel.type)
-  args$"threshold" <- threshold
-  
-  plot_function <- sprintf("plot_%s", plot.type)
-  plot_function <- eval(as.name(plot_function))
-  args <- args[names(formals(plot_function))]
-  
-  p <- do.call("plot_function", args)
-  if (plot.type != "dendrogram") return(p)
-  
-  return(invisible())
-}
-
-#' @rdname SFCB
-#' @export
-#' 
-extract_at <- function(object, at) {
-  UseMethod("extract_at")
-}
-
-#' @export
-extract_at.SFCB <- function(object, at) {
-  
-  extract_call <- match.call()
-  
-  if (!is.numeric(at)) stop("'at' must be a numeric vector")
-  orig_at <- names(object$groups)
-  at <- sort(at)
-  selected <- match(at, orig_at)
-  if (anyNA(selected)) {
-    stop("'at' must be included in the range of tested groups for 'object'.")
-  }
-  
-  out <- object
-  out$groups <- out$groups[selected]
-  out$summaries <- out$summaries[selected]
-  out$mse <- out$mse[out$mse$clust %in% at, ]
-  out$importances <- out$importances[selected]
-  if ("computational.times" %in% names(out)) out$"computational.times" <- NULL
-  if ("selected" %in% names(out)) out$selected <- out$selected[selected]
-  
-  out$call <- extract_call
-  
-  return(out)
-}

man/SFCB.Rd

 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/SFCB.R, R/sfcb_methods.R
+% Please edit documentation in R/sfcb_methods.R
 \name{SFCB}
 \alias{SFCB}
 \alias{summary.SFCB}
 \alias{print.SFCB}
 \alias{plot.SFCB}
-\alias{extract.SFCB}
-\alias{SFCB-class}
+\alias{extract_at.SFCB}
+\alias{quality.SFCB}
 \alias{extract_at}
 \alias{quality}
+\alias{SFCB-class}
 \title{Methods for SFCB object}
 \usage{
 \method{summary}{SFCB}(object, ...)
@@ -25,20 +26,6 @@
 
 extract_at(object, at)
 
-\method{summary}{SFCB}(object, ...)
-
-\method{print}{SFCB}(x, ...)
-
-\method{plot}{SFCB}(
-  x,
-  plot.type = c("dendrogram", "selection", "importance"),
-  shape.imp = c("boxplot", "histogram"),
-  sel.type = c("importance", "selection"),
-  threshold = "none"
-)
-
-extract_at(object, at)
-
 quality(object, ground_truth, threshold = NULL)
 }
 \arguments{
@@ -50,13 +37,16 @@ quality(object, ground_truth, threshold = NULL)
 
 \item{plot.type}{type of the plot. Default to \code{"dendrogram"}}
 
-\item{at}{numeric vector. Set of the number of intervals to extract for 
+\item{threshold}{numeric value. If not \code{NULL}, selection of variables to
+compute qualities is based on a threshold of importance values
 \code{extract_at}}
+
+\item{at}{numeric vector. Set of the number of intervals to extract for}
+
+\item{ground_truth}{numeric vector of ground truth. Target variables 
+to compute qualities correspond to non-zero entries of this vector}
 }
 \description{
-Print or plot a summary of the result of \code{\link{sfcb}} (
-\code{SFCB} object)
-
 Print or plot a summary of the result of \code{\link{sfcb}} (
 \code{SFCB} object)
 }
@@ -73,24 +63,6 @@ plot(out1, plot.type = "selection")
 plot(out1, plot.type = "importance")
 }
 
-out2 <- sfcb(rainfall, truffles, group.method = "adjclust", 
-             summary.method = "basics", selection.method = "none",
-             range.at = c(5, 7))
-out3 <- extract_at(out2, at = 6)
-summary(out3)
-
-\code{\link{sfcb}}
-data(truffles)
-out1 <- sfcb(rainfall, truffles, group.method = "adjclust", 
-             summary.method = "pls", selection.method = "relief")
-summary(out1)
-
-\dontrun{
-plot(out1)
-plot(out1, plot.type = "selection")
-plot(out1, plot.type = "importance")
-}
-
 out2 <- sfcb(rainfall, truffles, group.method = "adjclust", 
              summary.method = "basics", selection.method = "none",
              range.at = c(5, 7))
@@ -98,10 +70,6 @@ out3 <- extract_at(out2, at = 6)
 summary(out3)
 }
 \author{
-{Victor Picheny, \email{victor.picheny@inrae.fr}\cr 
-Remi Servien, \email{remi.servien@inrae.fr}\cr
-Nathalie Vialaneix, \email{nathalie.vialaneix@inrae.fr}}
-
 {Victor Picheny, \email{victor.picheny@inrae.fr}\cr 
 Remi Servien, \email{remi.servien@inrae.fr}\cr
 Nathalie Vialaneix, \email{nathalie.vialaneix@inrae.fr}}