Code refactoring of the plotting functions

.github/workflows/check-standard.yaml

@@ -47,15 +47,9 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          pak-version: rc
-          # about pak-version:
-          # Ubuntu doesn't install the proper version of XML see https://github.com/r-lib/actions/issues/559. Remove when fixed.
-          # see also: https://stackoverflow.com/questions/73243945/pkgdown-action-failing-at-build-xml
-          # Temporarily forcing ggplot2 to v3.5.2 on main branch (see https://github.com/SticsRPacks/CroPlotR/issues/84)  
           extra-packages: |
             any::rcmdcheck
             SticsRPacks/SticsRFiles@main
-            ggplot2@3.5.2  
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2
@@ -77,8 +71,7 @@ jobs:
           repository: SticsRPacks/SticsRTests
           event-type: R-CMD-check
           client-payload: '{"ref": "${{ github.ref }}", "sha": "${{ github.sha }}", "repo": "${{ github.event.repository.name }}"}'
-
-       - name: Wait for SticsRTests workflow to complete (block-and-fail)
+      - name: Wait for SticsRTests workflow to complete (block-and-fail)
         uses: actions/github-script@v6
         with:
           github-token: ${{ secrets.TRIGGER_PAT }}

.github/workflows/test-coverage.yaml

@@ -29,12 +29,6 @@ jobs:
           extra-packages: any::covr
           needs: coverage
 
-      - name: Force ggplot2 version 3.5.2
-        run: |
-          install.packages("remotes")
-          remotes::install_version("ggplot2", version = "3.5.2", upgrade = "never")
-        shell: Rscript {0}
-
       - name: Test coverage
         run: |
           covr::codecov(

.github/workflows/vdiffr.yaml

@@ -5,7 +5,7 @@ on:
 
 jobs:
   snapshot_comparison:
-    runs-on: ubuntu-latest  # Replace with the appropriate runner for your needs
+    runs-on: ubuntu-latest # Replace with the appropriate runner for your needs
 
     steps:
       - name: Checkout repository
@@ -18,18 +18,12 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          pak-version: rc
-            # about pak-version:
-            # Ubuntu doesn't install the proper version of XML see https://github.com/r-lib/actions/issues/559. Remove when fixed.
-            # see also: https://stackoverflow.com/questions/73243945/pkgdown-action-failing-at-build-xml
-            # Temporarily forcing ggplot2 to v3.5.2 on main branch (see https://github.com/SticsRPacks/CroPlotR/issues/84)
           extra-packages: |
             any::testthat
             any::rcmdcheck
             any::remotes
             any::vdiffr
             any::zip
-            ggplot2@3.5.2
             SticsRPacks/SticsRFiles@main
           needs: check
 
@@ -39,7 +33,8 @@ jobs:
           Rscript -e "pkg_version <- 'Latest'; tmpdir <- '${{ runner.temp }}';          testthat::test_file('tests/testthat/test-dynamic-plots.R', stop_on_failure=FALSE); testthat::test_file('tests/testthat/test-scatter-plots.R', stop_on_failure=FALSE)"
 
       - name: Cache the snapshot scripts
-        run: | # Move the scripts and data from tests/testthat to the tmpdir directory so that both run use the same scripts
+        run:
+          | # Move the scripts and data from tests/testthat to the tmpdir directory so that both run use the same scripts
           mv tests/testthat/* ${{ runner.temp }}/
 
       - name: Checkout CroPlotR main branch
@@ -66,4 +61,3 @@ jobs:
       - name: Compare snapshots
         run: |
           Rscript -e "tmpdir <- '${{ runner.temp }}'; testthat::test_file('${{ runner.temp }}/vdiffr/test-snapshots.R', stop_on_failure=TRUE)"
-

DESCRIPTION

@@ -15,6 +15,7 @@ Authors@R: c(
            comment = c(ORCID = "0000-0002-4044-4322")),
     person("Michel", "Giner", , "michel.giner@cirad.fr", role = "aut",
            comment = c(ORCID = "0000-0002-9310-2377")),
+    person("Valentine", "Rahier", role = "ctb"),
     person("Amine", "Barkaoui", role = "ctb"),
     person("Patrick", "Lutz", role = "ctb")
   )
@@ -36,6 +37,7 @@ Depends:
 Imports:
     cli,
     dplyr,
+	ggh4x (>= 0.3.1),
     ggplot2,
     ggrepel,
     gridExtra,
@@ -57,4 +59,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3

NAMESPACE

@@ -67,6 +67,7 @@ importFrom(parallel,parLapply)
 importFrom(parallel,stopCluster)
 importFrom(plyr,join_all)
 importFrom(reshape2,melt)
+importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(stats,cor)
 importFrom(stats,lm)
@@ -75,4 +76,3 @@ importFrom(stats,qt)
 importFrom(stats,sd)
 importFrom(stats,var)
 importFrom(tidyselect,vars_select_helpers)
-importFrom(utils,head)

R/aesthetics.R

@@ -1,24 +1,40 @@
-#' Template aesthetics
-#'
-#' This function returns a template list of aesthetics for a plot, including
-#' color, shape, linetype, and group.
-#'
-#' @return A list of aesthetics for a plot.
-#'
-#' @keywords internal
-template_aesthetics <- function() {
-  aesthetics <- list(
-    "plot" = list(
-      "color" = list(NULL), "shape" = list(NULL),
-      "linetype" = list(NULL), "group" = list(NULL)
-    ),
-    "versions" = list("shape" = list(NULL), "linetype" = list(NULL))
-  )
-  return(aesthetics)
-}
+#' Detects if a situation is a mixture
+#'
+#' This function checks if the situation is a mixture based on
+#' the presence of a column named "Dominance" and the uniqueness
+#' of its values.
+#'
+#' @param sim_situation A data frame containing the simulated data for
+#' one situation.
+#' @return A logical value indicating if the situation is a mixture.
+#' @examples
+#' \dontrun{
+#' sim_data <- data.frame(
+#'   Dominance = c("Principal", "Principal", "Associated", "Associated")
+#' )
+#' CroPlotR:::detect_mixture(sim_data)
+#' # Output: TRUE
+#'
+#' sim_data <- data.frame(Dominance = c("Single Crop", "Single Crop"))
+#' CroPlotR:::detect_mixture(sim_data)
+#' # Output: FALSE
+#'
+#' sim_data <- data.frame(lai = c(1, 1.2))
+#' CroPlotR:::detect_mixture(sim_data)
+#' # Output: FALSE
+#' }
+detect_mixture <- function(sim_situation) {
+  is_Dominance <- grep("Dominance", x = colnames(sim_situation), fixed = TRUE)
+  if (length(is_Dominance) > 0) {
+    is_mixture <- length(unique(sim_situation[[is_Dominance]])) > 1
+  } else {
+    is_mixture <- FALSE
+  }
 
+  return(is_mixture)
+}
 
-#' Detect items cases
+#' Detect items cases for dynamic plots
 #'
 #' This function detects the cases for computing the aesthetics of a plot based on
 #' whether it is a mixture or not, whether it has one or multiple versions, and
@@ -46,94 +62,59 @@ detect_mixture_version_overlap <- function(is_mixture, one_version, overlap) {
   return(case)
 }
 
-#' Detect items cases
+#' Detect items cases for scatter plots
 #'
 #' This function detects the cases for computing the aesthetics of a plot based on
 #' whether it is a mixture or not, whether it has one or multiple versions, and
 #' whether there are one or several situations to plot into the same plot.
 #'
 #' @param is_mixture A logical value indicating whether the crop is a mixture or not.
 #' @param one_version A logical value indicating whether the plot has one or multiple versions (e.g. of the model).
-#' @param several_sit A logical value indicating whether there are one or several situations to plot.
+#' @param has_distinct_situations A logical value indicating whether there are one or several situations to plot.
 #'
 #' @return A character string indicating the case for computing the aesthetics of the plot.
 #'
 #' @keywords internal
-detect_mixture_version_situations <- function(is_mixture, one_version, several_sit) {
-  case <- switch(paste(is_mixture, !one_version, several_sit),
-    "TRUE TRUE TRUE" = "mixture_versions_situations",
-    "TRUE TRUE FALSE" = "mixture_versions_no_situations",
-    "TRUE FALSE TRUE" = "mixture_no_versions_situations",
-    "TRUE FALSE FALSE" = "mixture_no_versions_no_situations",
+detect_mixture_version_situations <- function(is_mixture, one_version, has_distinct_situations) {
+  case <- switch(paste(is_mixture, !one_version, has_distinct_situations),
+    "TRUE TRUE TRUE" = "mixture_versions",
+    "TRUE TRUE FALSE" = "mixture_versions",
+    "TRUE FALSE TRUE" = "mixture_no_versions",
+    "TRUE FALSE FALSE" = "mixture_no_versions",
     "FALSE TRUE TRUE" = "non_mixture_versions_situations",
-    "FALSE TRUE FALSE" = "non_mixture_versions_no_situations",
+    "FALSE TRUE FALSE" = "non_mixture_versions_per_situations",
     "FALSE FALSE TRUE" = "non_mixture_no_versions_situations",
-    "FALSE FALSE FALSE" = "non_mixture_no_versions_no_situations"
+    "FALSE FALSE FALSE" = "non_mixture_no_versions_per_situations"
   )
 
   return(case)
 }
 
-#' Manages the aesthetics of the graphics
-#'
-#' @description Manages the shape, color and line type of the graphics according
-#'  to their content
-#'
-#' @param sim A simulation list of data.frames
-#' @param obs An observation list of data.frames
-#' @param type The type of plot required, either "dynamic" or "scatter"
-#' @param overlap A list of lists containing the variables to represent on the
-#' same graph when `type = "dynamic"`
-#' @param several_sit Boolean. Must be equal to `TRUE` if sim and obs gather
-#' more than one situation and if situations should be differentiated
-#' on the graph.
-#' @param shape_sit Shape to differentiate between situations when
-#' `all_situations= TRUE`. See details.
-#' @param one_version Boolean. Must be `TRUE` if several versions will be
-#' plotted on the same graph.
-#' @param iVersion Integer. Version number of sim
-#' @param dot_args List of dot arguments given to plot function
-#'
-#' @details The `shape_sit` argument can be:
-#' * "none" (the default): Same shape for all situations.
-#' * "txt": Writes the name of the situation above each point.
-#' * "symbol": One shape for each situation.
-#' * "group": One shape for each group of situations described in
-#' `situation_group`.
-#'
-#' @return An aesthetics expression which will allow to manage the aesthetics
-#' of the graphics
+#' Detect items cases
 #'
-#' @keywords internal
+#' This function returns a unique string based on the type of plot, and
+#' whether the situation is a mixture or not, if there is one or multiple
+#' versions to plot, and if there is one or several situations to plot
+#' into the same plot.
+#' The output is used to choose the right plotting function in a switch.
 #'
-aesthetics <- function(sim, obs = NULL, type = c("dynamic", "scatter"),
-                       overlap = NULL, several_sit = FALSE,
-                       shape_sit = c("none", "txt", "symbol", "group"),
-                       one_version = TRUE, iVersion = 1,
-                       dot_args = NULL) {
-  is_dominance <- grep("Dominance", x = colnames(sim), fixed = TRUE)
-  if (length(is_dominance) > 0) {
-    is_mixture <- length(unique(sim[[is_dominance]])) > 1
-  } else {
-    is_mixture <- FALSE
-  }
-  is_mixture <- is_mixture && (length(unique(sim$Dominance)) > 1)
-
-  aesthetics <- template_aesthetics()
-
+#' @param type The type of plot required, either 'dynamic' or 'scatter
+#' @param is_mixture A logical value indicating whether the crop is a mixture or not.
+#' @param one_version A logical value indicating whether the plot has one or multiple versions (e.g. of the model).
+#' @param has_distinct_situations A logical value indicating whether there are one or several situations to plot.
+#' @param overlap A logical value indicating whether there is any overlapping variables in the plot.
+#'
+#' @return A unique character string for the plot.
+#'
+#' @keywords internal
+detect_item_case <- function(type, is_mixture, one_version, has_distinct_situations, overlap) {
   if (type == "dynamic") {
-    aesthetics <- aesthetics_dynamic(
-      sim, aesthetics, overlap, one_version, iVersion, dot_args,
-      is_mixture
-    )
+    item_case <- detect_mixture_version_overlap(is_mixture, one_version, overlap)
   } else if (type == "scatter") {
-    aesthetics <- aesthetics_scatter(
-      sim, aesthetics, overlap, several_sit, one_version, iVersion,
-      dot_args, is_mixture
-    )
+    item_case <- detect_mixture_version_situations(is_mixture, one_version, has_distinct_situations)
   } else {
     stop("type must be either 'dynamic' or 'scatter'")
   }
 
-  return(aesthetics)
+  return(item_case)
 }