Merge pull request #40 from erblast/39_ggplot2v4p0

39 ggplot2v4p0
parcats checks currently disabled

Author: erblast

.github/workflows/parcats.yml

@@ -4,10 +4,10 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
-  workflow_dispatch:
 
-name: test-coverage
+name: test-coverage.yaml
+
+permissions: read-all
 
 jobs:
   test-coverage:
@@ -16,36 +16,47 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Test coverage
         run: |
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
             install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          print(cov)
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v5
+        with:
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+          files: ./cobertura.xml
+          plugins: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |
           ## --------------------------------------------------------------------
-          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
         shell: bash
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
-          path: ${{ runner.temp }}/package
+          path: ${{ runner.temp }}/package

.github/workflows/coverage.yaml .github/workflows/test-coverage.yaml.github/workflows/coverage.yaml renamed to .github/workflows/test-coverage.yaml

@@ -1,6 +1,6 @@
 Package: easyalluvial
 Title: Generate Alluvial Plots with a Single Line of Code
-Version: 0.3.2
+Version: 0.4
 Authors@R: person( "Bjoern", "Koneswarakantha", role = c("aut","cre"), email = "datistics@gmail.com", comment = c(ORCID = "0000-0003-4585-7799") )
 URL: https://github.com/erblast/easyalluvial/
 Description: Alluvial plots are similar to sankey diagrams and visualise categorical data 
@@ -39,7 +39,7 @@ Suggests:
     rpart,
     glmnet,
     xgboost
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Imports:
   purrr
   , tidyr (>= 1.0.0)

DESCRIPTION

@@ -13,6 +13,7 @@ export(get_data_space)
 export(get_pdp_predictions)
 export(manip_bin_numerics)
 export(manip_factor_2_numeric)
+export(manip_get_ggplot_data)
 export(palette_filter)
 export(palette_increase_length)
 export(palette_plot_intensity)

NAMESPACE

@@ -1,3 +1,6 @@
+# Version 0.4.0 20250825
+- adapted to changes in ggplot2 v4.0.0
+
 # Version 0.3.2 submitted to CRAN 20231207
 - check for vip pkg installation before executing example of alluvial_model_response_parsnip
 - option for using geom_text instead of geom_label (by https://github.com/gernophil)

NEWS.md

@@ -459,9 +459,9 @@ alluvial_long = function( data
       theme( axis.text.x = element_text( angle = 90, vjust = 0.5 , hjust = 0 ) )
   }
 
-  p$data_key = data_key
-  p$alluvial_type = 'long'
-  p$alluvial_params = params
+  attr(p, "data_key") <- data_key
+  attr(p, "alluvial_type") <- 'long'
+  attr(p, "alluvial_params") <- params
 
   return(p)
 }

R/alluvial_long.R

@@ -919,8 +919,11 @@ alluvial_model_response = function(pred, dspace, imp, degree = 4
   p = p +
     labs(title = title, subtitle = subtitle, caption = caption)
 
-  p$alluvial_type = 'model_response'
-  p$alluvial_params = c(p$alluvial_params[! names(p$alluvial_params) %in% names(params)], params)
+  attr(p, "alluvial_type") <- 'model_response'
+  attr(p, "alluvial_params") <- c(
+    attr(p, "alluvial_params")[! names(attr(p, "alluvial_params")) %in% names(params)],
+    params
+  )
 
   return(p)
 
@@ -1110,8 +1113,7 @@ alluvial_model_response_caret = function(train, data_input, degree = 4, bins = 5
 #' m <- parsnip::rand_forest(mode = "regression") %>%
 #'   parsnip::set_engine("randomForest")
 #' 
-#' rec_prep = recipes::recipe(disp ~ ., df) %>%
-#'   recipes::prep()
+#' rec_prep = recipes::recipe(disp ~ ., df) 
 #' 
 #' wf <- workflows::workflow() %>%
 #'   workflows::add_model(m) %>%
@@ -1173,7 +1175,7 @@ alluvial_model_response_parsnip = function(m, data_input, degree = 4, bins = 5
     imp = .f_imp(m) %>%
       select(Variable, Importance)
   } else {
-    imp = workflows::pull_workflow_fit(m) %>%
+    imp = workflows::extract_fit_parsnip(m) %>%
       .f_imp() %>%
       select(Variable, Importance)
   }
@@ -1231,4 +1233,3 @@ alluvial_model_response_parsnip = function(m, data_input, degree = 4, bins = 5
 }
 
 
-

R/alluvial_model_response.R

@@ -403,9 +403,9 @@ alluvial_wide = function( data
 
   })
 
-  p$data_key = data_key
-  p$alluvial_type = 'wide'
-  p$alluvial_params = params
+  attr(p, 'alluvial_type') = 'wide'
+  attr(p, 'alluvial_params') = params
+  attr(p, 'data_key') = data_key
 
   return(p)
 }

R/alluvial_wide.R

@@ -1,4 +1,4 @@
-expect_doppelganger <- function(title, fig, path = NULL, ...) {
+expect_doppelganger <- function(title, fig, ...) {
   testthat::skip_if_not_installed("vdiffr")
-  vdiffr::expect_doppelganger(title, fig, path = path, ...)
+  vdiffr::expect_doppelganger(title, fig, ...)
 }

R/expect_doppelganger.R

@@ -164,7 +164,7 @@ manip_bin_numerics = function(x
     # labels
 
     df = df %>%
-      mutate_if(is.factor, fct_explicit_na, na_level = NA_label ) %>%
+      mutate_if(is.factor, manip_explicit_na, na_level = NA_label ) %>%
       left_join( select(df_old, one_of( c(numerics, 'easyalluvialid') ) ), by = 'easyalluvialid')
 
     for(num in numerics){
@@ -185,7 +185,7 @@ manip_bin_numerics = function(x
 
     df = df %>%
       mutate_if(is.numeric, as.factor ) %>%
-      mutate_if(is.factor, fct_explicit_na, na_level = NA_label ) %>%
+      mutate_if(is.factor,  manip_explicit_na, na_level = NA_label ) %>%
       rename_at( vars( ends_with('.y') ) , .funs = function(x) str_replace(x, '\\.y$', '') )
 
     return(df)
@@ -239,8 +239,8 @@ manip_bin_numerics = function(x
   }
 
   #remove easyalluvialid
-  data_new = select(data_new, columns) %>%
-    mutate_if( is.factor, fct_explicit_na, na_level = NA_label )
+  data_new = select(data_new, all_of(columns)) %>%
+    mutate_if( is.factor, manip_explicit_na, na_level = NA_label )
 
   if( input_vector ){
     return( data_new$x )
@@ -291,3 +291,31 @@ check_empty_lvl <- function(col, df){
   }
 }
 
+
+#' Get ggplot data
+#'@description retrieve ggplot 2 plot data from S3 and S7 (>= ggplot2 v4.0)
+#'@param p ggplot object
+#'@export
+manip_get_ggplot_data <- function(p) {
+  data <- if (inherits(p, "ggplot2::ggplot")) {
+    p@data
+  } else if (inherits(p, "ggplot")) {
+    p$data
+  } else {
+    stop("p needs to be a ggplot object")
+  }
+}
+
+#' Make NA levels explicit
+#' @description fct_na_value_to_level will create a NA level even there is
+#' none present to begin with
+#'@keywords internal
+manip_explicit_na <- function(f, na_level) {
+
+  if (anyNA(f)) {
+    f <- forcats::fct_na_value_to_level(f, level = na_level)
+  }
+  
+  return(f)
+}
+