From b6c8aa3d6c58e41fe45053ae425595cc1c84577a Mon Sep 17 00:00:00 2001
From: Nathalie Vialaneix <nathalie.vialaneix@inrae.fr>
Date: Tue, 14 Mar 2023 13:35:43 +0100
Subject: [PATCH] add time in quality plots (fixed #8)
---
R/plot_functions.R | 34 +++++++++++++++++++++++++++++++---
R/sfcb_methods.R | 4 +++-
man/SFCB-class.Rd | 4 +++-
3 files changed, 37 insertions(+), 5 deletions(-)
diff --git a/R/plot_functions.R b/R/plot_functions.R
index bc43e90..f94f73a 100644
--- a/R/plot_functions.R
+++ b/R/plot_functions.R
@@ -319,17 +319,42 @@ plot_selection <- function(x, sel.type, threshold) {
plot_quality <- function(x, quality.crit) {
+ valid_criteria <- "mse"
+ if ("computational.times" %in% names(x)) {
+ valid_criteria <- c(valid_criteria, "time")
+ }
if ("quality" %in% names(x)) {
- valid_criteria <- c("mse", "Precision", "Recall", "ARI", "NMI")
- } else valid_criteria <- "mse"
+ valid_criteria <- c(valid_criteria, "Precision", "Recall", "ARI", "NMI")
+ }
crit_ok <- all(sapply(quality.crit, function(cc) cc %in% valid_criteria))
if (!crit_ok || length(quality.crit) > 2) {
stop(paste0("'quality.crit' must be a vector with length at most 2 in ",
- paste(valid_criteria, collapse = ", "), "."))
+ paste(valid_criteria, collapse = ", "), "."),
+ call. = FALSE)
+ }
+
+ if (length(quality.crit) == 2 && "time" %in% quality.crit) {
+ stop("'time' is a valid quality criterion to plot only taken alone.",
+ call. = FALSE)
+ }
+
+ if ("time" %in% quality.crit) {
+ df <- data.frame("criterion" = c(unname(x$"computational.times")),
+ "step" = names(x$"computational.times"))
+ df$step <- factor(df$step, levels = names(x$"computational.times"),
+ ordered = TRUE)
+ p <- ggplot(df, aes(fill = .data$step, y = .data$criterion, x = 1)) +
+ geom_bar(stat = "identity") + theme_bw() + xlim(0, 2) +
+ ylab("computational time (s)") +
+ theme(axis.title.x = element_blank(), axis.ticks.x = element_blank(),
+ axis.text.x = element_blank()) +
+ scale_fill_brewer(type = "qual", palette = 7)
+ return(p)
}
if (length(quality.crit) == 1) {
+ # build data frame
if (quality.crit == "mse") {
df <- data.frame("criterion" = x$mse$mse, "at" = x$mse$clust)
ylimits <- c(0, max(df$criterion))
@@ -340,11 +365,14 @@ plot_quality <- function(x, quality.crit) {
ylimits <- c(-1, 1)
} else ylimits <- c(0, 1)
}
+
+ # make plot
p <- ggplot(df, aes(x = .data$at, y = .data$criterion)) +
geom_jitter(width=0.2, height = 0) + theme_bw() +
xlab("number of intervals") + ylab(quality.crit) + ylim(ylimits) +
scale_x_continuous(breaks = unique(df$at),
limits = c(min(df$at) - 0.5, max(df$at + 0.5)))
+
} else {
if ("mse" %in% quality.crit) {
quality.crit <- setdiff(quality.crit, "mse")
diff --git a/R/sfcb_methods.R b/R/sfcb_methods.R
index 14e93a6..2f35738 100644
--- a/R/sfcb_methods.R
+++ b/R/sfcb_methods.R
@@ -27,7 +27,9 @@
#' represent the importance. Default to \code{"boxplot"}
#' @param quality.crit character vector (length 1 or 2) indicating one or two
#' quality criteria to display. The values have to be taken in \{\code{"mse"},
-#' \code{"Precision"}, \code{"Recall"}, \code{"ARI"}, \code{"NMI"}\}
+#' \code{"time"}, \code{"Precision"}, \code{"Recall"}, \code{"ARI"},
+#' \code{"NMI"}\}. If \code{"time"} is chosen, it can not be associated with any
+#' other criterion
#' @param ... not used
#' @param at numeric vector. Set of the number of intervals to extract for
#' @param ground_truth numeric vector of ground truth. Target variables
diff --git a/man/SFCB-class.Rd b/man/SFCB-class.Rd
index a50fbc7..4a6902d 100644
--- a/man/SFCB-class.Rd
+++ b/man/SFCB-class.Rd
@@ -51,7 +51,9 @@ represent the importance. Default to \code{"boxplot"}}
\item{quality.crit}{character vector (length 1 or 2) indicating one or two
quality criteria to display. The values have to be taken in \{\code{"mse"},
-\code{"Precision"}, \code{"Recall"}, \code{"ARI"}, \code{"NMI"}\}}
+\code{"time"}, \code{"Precision"}, \code{"Recall"}, \code{"ARI"},
+\code{"NMI"}\}. If \code{"time"} is chosen, it can not be associated with any
+other criterion}
\item{at}{numeric vector. Set of the number of intervals to extract for}
--
GitLab