update roc curve

src/v4/HTRSIM/dev/flat_full_bis.Rmd

@@ -5255,10 +5255,18 @@ roc_plot <- function(comparison_df, ...) {
   args <- lapply(list(...), function(x) if (!is.null(x)) ggplot2::sym(x))
 
   #comparison_df$isDE <- factor(comparison_df$isDE, levels= c(TRUE, FALSE))
-  ggplot2::ggplot(comparison_df, ggplot2::aes(d = !isDE , m = p.adj, !!!args )) +
-    plotROC::geom_roc(n.cuts = 0, labels = FALSE) + 
-    ggplot2::theme_bw() +
-    ggplot2::ggtitle("ROC curve") 
+  p <- ggplot2::ggplot(comparison_df, ggplot2::aes(d = !isDE , m = p.adj, !!!args )) +
+        plotROC::geom_roc(n.cuts = 0, labels = FALSE) + 
+        ggplot2::theme_bw() +
+        ggplot2::ggtitle("ROC curve") 
+  
+  ## -- annotation AUC
+  df_AUC <- plotROC::calc_auc(p)[c("from", "AUC")]
+  df_AUC$AUC <- round(df_AUC$AUC, digits = 3)
+  annotations <- do.call(paste, c(df_AUC, sep = " - AUC: "))
+  annotations <- paste(annotations, collapse  = "\n")
+  p <- p + ggplot2::annotate("text", x = .75, y = .25, label = annotations)
+  return(p)
 }
 
 
@@ -5876,6 +5884,116 @@ test_that("wrapperDESeq2 function works correctly", {
 
 })
 
+```
+
+## Anova 
+
+
+```{r function-anova, filename =  "anova"}
+
+#' Handle ANOVA Errors
+#'
+#' This function handles ANOVA errors and warnings during the ANOVA calculation process.
+#'
+#' @param l_TMB A list of fitted glmmTMB models.
+#' @param group A character string indicating the group for which ANOVA is calculated.
+#' @param ... Additional arguments to be passed to the \code{car::Anova} function.
+#' 
+#' @return A data frame containing ANOVA results for the specified group.
+#' @export
+#' 
+#' @examples
+#' l_tmb <- fitModelParallel(Sepal.Length ~ Sepal.Width + Petal.Length,
+#'                           data = iris, group_by = "Species", n.cores = 1)
+#' anova_res <- handleAnovaError(l_tmb, "setosa", type = "III")
+#'
+#' @importFrom car Anova
+#' @export
+handleAnovaError <- function(l_TMB, group, ...) {
+  tryCatch(
+    expr = {
+      withCallingHandlers(
+        car::Anova(l_TMB[[group]], ...),
+        warning = function(w) {
+          message(paste(Sys.time(), "warning for group", group, ":", conditionMessage(w)))
+          invokeRestart("muffleWarning")
+        })
+    },
+    error = function(e) {
+      message(paste(Sys.time(), "error for group", group, ":", conditionMessage(e)))
+      NULL
+    }
+  )
+}
+
+
+#' Perform ANOVA on Multiple glmmTMB Models in Parallel
+#'
+#' This function performs analysis of variance (ANOVA) on a list of \code{glmmTMB}
+#' models in parallel for different groups specified in the list. It returns a list
+#' of ANOVA results for each group.
+#'
+#' @param l_glmmTMB A list of \code{glmmTMB} models, with model names corresponding to the groups.
+#' @param ... Additional arguments passed to \code{\link[stats]{anova}} function.
+#'
+#' @return A list of ANOVA results for each group.
+#'
+#' @examples
+#' # Perform ANOVA
+#' data(iris)
+#' l_tmb<- fitModelParallel( Sepal.Length ~ Sepal.Width  + Petal.Length, 
+#'                          data = iris, group_by = "Species", n.cores = 1 )
+#' anov_res <- anovaParallel(l_tmb , type = "III")
+#' @importFrom stats anova
+#' @export
+anovaParallel <- function(l_tmb, ...) {
+  l_group <- attributes(l_tmb)$names
+  lapply(setNames(l_group, l_group), function(group) handleAnovaError(l_tmb, group, ...))
+}
+
+
+```
+
+
+```{r  test-anova}
+
+
+test_that("handleAnovaError return correct ouptut", {
+  data(iris)
+  l_tmb <- fitModelParallel(Sepal.Length ~ Sepal.Width + Petal.Length,
+                            data = iris, group_by = "Species", n.cores = 1)
+  anova_res <- handleAnovaError(l_tmb, "setosa", type = "III")
+  
+  expect_s3_class(anova_res, "data.frame")
+  expect_equal(nrow(anova_res), 3)  # Number of levels
+})
+
+test_that("handleAnovaError return correct ouptut", {
+  data(iris)
+  l_tmb <- fitModelParallel(Sepal.Length ~ Sepal.Width + Petal.Length,
+                            data = iris, group_by = "Species", n.cores = 1)
+  anova_res <- handleAnovaError(l_tmb, "INALID_GROUP", type = "III")
+  
+  expect_null(anova_res)
+})
+
+
+
+test_that("anovaParallel returns valid ANOVA results", {
+  data(iris)
+  l_tmb <- fitModelParallel(Sepal.Length ~ Sepal.Width + Petal.Length,
+                            data = iris, group_by = "Species", n.cores = 1)
+  anov_res <- anovaParallel(l_tmb, type = "III")
+  
+  expect_is(anov_res, "list")
+  expect_equal(length(anov_res), length(unique(iris$Species)))
+  
+})
+
+
+
+
+
 ```