From cadf61070c0a378f5a6887b3ab87b7c9a835b597 Mon Sep 17 00:00:00 2001
From: Nathalie Vialaneix <nathalie.vialaneix@inrae.fr>
Date: Tue, 21 Feb 2023 17:00:01 +0100
Subject: [PATCH] added function to extract results at certain steps

---
 NAMESPACE   |  2 ++
 R/SFCB.R    | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 man/SFCB.Rd | 25 +++++++++++++++++++++++-
 3 files changed, 80 insertions(+), 3 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index a95337d..e4b7357 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(extract_at,SFCB)
 S3method(plot,SFCB)
 S3method(print,SFCB)
 S3method(print,SISIRres)
@@ -11,6 +12,7 @@ S3method(summary,SISIRres)
 S3method(summary,ridgeRes)
 S3method(summary,sparseRes)
 export(SISIR)
+export(extract_at)
 export(project)
 export(ridgeSIR)
 export(sfcb)
diff --git a/R/SFCB.R b/R/SFCB.R
index 9b8bf5a..5ff6f2e 100644
--- a/R/SFCB.R
+++ b/R/SFCB.R
@@ -206,12 +206,13 @@ sfcb <- function(X, Y, group.method = c("adjclust", "cclustofvar"),
 }
 
 # Methods for SFCB-class ####
-#' @title Print SFCB object
+#' @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)
@@ -219,10 +220,29 @@ sfcb <- function(X, Y, group.method = c("adjclust", "cclustofvar"),
 #' @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)
@@ -266,7 +286,6 @@ print.SFCB <- function(x, ...) {
   summary(x)
 }
 
-#' @title Print SFCB object
 #' @rdname SFCB
 #' @export
 plot.SFCB <- function(x, 
@@ -288,4 +307,37 @@ plot.SFCB <- function(x,
   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$importance <- out$importance[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)
 }
\ No newline at end of file
diff --git a/man/SFCB.Rd b/man/SFCB.Rd
index 5459969..0450d5c 100644
--- a/man/SFCB.Rd
+++ b/man/SFCB.Rd
@@ -5,8 +5,10 @@
 \alias{summary.SFCB}
 \alias{print.SFCB}
 \alias{plot.SFCB}
+\alias{extract.SFCB}
 \alias{SFCB-class}
-\title{Print SFCB object}
+\alias{extract_at}
+\title{Methods for SFCB object}
 \usage{
 \method{summary}{SFCB}(object, ...)
 
@@ -19,6 +21,8 @@
   sel.type = c("importance", "selection"),
   threshold = "none"
 )
+
+extract_at(object, at)
 }
 \arguments{
 \item{object}{a \code{SFCB} object}
@@ -28,6 +32,9 @@
 \item{x}{a \code{SFCB} object}
 
 \item{plot.type}{type of the plot. Default to \code{"dendrogram"}}
+
+\item{at}{numeric vector. Set of the number of intervals to extract for 
+\code{extract_at}}
 }
 \description{
 Print or plot a summary of the result of \code{\link{sfcb}} (
@@ -35,6 +42,22 @@ Print or plot a summary of the result of \code{\link{sfcb}} (
 }
 \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)
 }
 \author{
 {Victor Picheny, \email{victor.picheny@inrae.fr}\cr 
-- 
GitLab