Devel jde

.github/workflows/MacOS.yaml

@@ -25,7 +25,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v7
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.github/workflows/Ubuntu.yaml

@@ -28,7 +28,7 @@ jobs:
       PKG_SYSREQS: false
 
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v7
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.github/workflows/render-readme.yaml

@@ -18,7 +18,7 @@ jobs:
       contents: write
     steps:
       - name: Checkout repo
-        uses: actions/checkout@v4
+        uses: actions/checkout@v7
         with:
           fetch-depth: 0
 

.github/workflows/test-coverage.yaml

@@ -19,7 +19,7 @@ jobs:
       PKG_SYSREQS: false
 
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v7
 
       - uses: r-lib/actions/setup-r@v2
         with:

R/splnr_apply_cutoffs.R

@@ -118,7 +118,6 @@
 #' df_inverse_cutoff <- splnr_apply_cutoffs(dat_species_prob, Cutoffs = 0.5, inverse = TRUE)
 #' print(df_inverse_cutoff)
 splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
-
   # --- Input Assertions ---
 
   assertthat::assert_that(
@@ -186,9 +185,7 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
   # col_name:   used only for error messages.
 
   resolve_cutoff <- function(entry, col_values, col_name) {
-
     if (is.numeric(entry)) {
-
       assertthat::assert_that(
         length(entry) == 1,
         msg = paste0(
@@ -197,9 +194,7 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
         )
       )
       threshold <- entry
-
     } else if (is.function(entry)) {
-
       # Strip NAs before passing to the user's function so that common
       # aggregation functions (quantile, mean, etc.) work without the user
       # needing to remember na.rm = TRUE.
@@ -224,7 +219,6 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
           "Got: ", deparse(threshold)
         )
       )
-
     } else {
       stop(
         "Each entry in 'Cutoffs' must be a numeric scalar or a function. ",
@@ -266,15 +260,13 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
         thresh
       }
     )
-
   } else if (is.numeric(Cutoffs) && is.null(names(Cutoffs)) && length(Cutoffs) == 1) {
     # Single numeric scalar: same threshold for every numeric column.
     # Validate once against the first column (value check only; column data
     # is irrelevant for a numeric entry but resolve_cutoff requires it).
     message("Applying single cutoff of ", Cutoffs, " to all numeric feature columns.")
     resolve_cutoff(Cutoffs, features_plain[[numeric_cols[1]]], numeric_cols[1])
     thresholds <- stats::setNames(rep(Cutoffs, length(numeric_cols)), numeric_cols)
-
   } else {
     # Named numeric vector or named list: per-column thresholds.
     # Convert a named numeric vector to a list so resolve_cutoff handles both
@@ -308,9 +300,9 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
     features_tbl <- features_tbl %>%
       dplyr::mutate(
         !!rlang::sym(col) := dplyr::case_when(
-          is.na(!!rlang::sym(col))    ~ 0,
+          is.na(!!rlang::sym(col)) ~ 0,
           !!rlang::sym(col) >= thresh ~ 1,
-          TRUE                        ~ 0
+          TRUE ~ 0
         )
       )
   }

R/splnr_deprecated.R

@@ -21,9 +21,7 @@
 #' df <- splnr_convert_regionalisation(dat, PUs)
 #' }
 splnr_convert_regionalisation <- function(dat, PUs, cat_name = NA, col_name = NA) {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_convert_regionalisation()", "spatialgridr::get_data_in_grid()")
-
 }
 
 
@@ -49,14 +47,10 @@ splnr_convert_regionalisation <- function(dat, PUs, cat_name = NA, col_name = NA
 #' df <- splnr_convert_toPUs(dat, PlanUnits)
 #' }
 splnr_convert_toPUs <- function(dat, PlanUnits) {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_convert_toPUs()", "spatialgridr::get_data_in_grid()")
-
 }
 
 
-
-
 #' Plot MPAs
 #'
 #' `splnr_plot_MPAs()` allows to plot either the outline or the area of MPAs existing in the planning region (for example extracted with the `spatialplanr`function [splnr_get_MPAs()]) in a customisable way using `ggplot2`. This function requires an `sf` object containing the information whether a planning unit in the planning region lies within an MPA or not in a column called `wdpa` and outputs a `ggobject`. It can be combined with the `spatialplanr` function [splnr_gg_add()].
@@ -78,9 +72,7 @@ splnr_convert_toPUs <- function(dat, PlanUnits) {
 #' }
 splnr_plot_MPAs <- function(df, colorVals = c("TRUE" = "blue", "FALSE" = "white"),
                             showLegend = TRUE, plotTitle = "Locked In Areas", legendTitle = "") {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_plot_MPAs()", "splnr_plot()")
-
 }
 
 
@@ -120,13 +112,10 @@ splnr_plot_MPAs <- function(df, colorVals = c("TRUE" = "blue", "FALSE" = "white"
 #' }
 splnr_plot_cost <- function(cost, costName = "Cost", legendTitle = "Cost",
                             paletteName = "YlGnBu", plotTitle = "") {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_plot_MPAs()", "splnr_plot()")
-
 }
 
 
-
 #' Plot binary feature
 #'
 #' `splnr_plot_binFeature()` allows to plot presences and absences of a feature in the planning region in a customisable way using `ggplot2`. This function requires an `sf` object with binary information of a feature(`0` for absences and `1` for presences, for example created from continuous data with the `spatialplanr` function [splnr_apply_cutoffs()]). It outputs a `ggobject` and can be combined with the `spatialplanr` function [splnr_gg_add()].
@@ -150,9 +139,7 @@ splnr_plot_cost <- function(cost, costName = "Cost", legendTitle = "Cost",
 splnr_plot_binFeature <- function(df, colInterest,
                                   colorVals = c("Suitable" = "#3182bd", "Not Suitable" = "#c6dbef"),
                                   showLegend = TRUE, plotTitle = " ", legendTitle = "Habitat") {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_plot_binFeature()", "splnr_plot()")
-
 }
 
 
@@ -180,10 +167,5 @@ splnr_plot_binFeature <- function(df, colInterest,
 #' }
 splnr_plot_featureNo <- function(df, showLegend = TRUE, paletteName = "YlGnBu",
                                  plotTitle = "Number of Features", legendTitle = "Features") {
-
   lifecycle::deprecate_stop("0.6.2", "splnr_plot_featureNo()", "splnr_plot()")
-
 }
-
-
-

R/splnr_featureRep.R

@@ -193,7 +193,6 @@ splnr_get_featureRep <- function(soln, pDat, targets = NA,
                                  climsmartApproach = 0,
                                  solnCol = "solution_1",
                                  incidental_features = character(0)) {
-
   # --- Input Assertions ---
   # Ensure 'soln' is an sf object and not empty.
   assertthat::assert_that(
@@ -293,14 +292,14 @@ splnr_get_featureRep <- function(soln, pDat, targets = NA,
     # Climate Priority Area (CPA) approach: features were split into _CS and _NCS
     # components. Aggregate them back to the original feature name.
     s1 <- s1 %>%
-      dplyr::select(-.data$relative_held) %>%
+      dplyr::select(-"relative_held") %>%
       dplyr::mutate(
         feature = stringr::str_remove_all(.data$feature, "_CS"),
         feature = stringr::str_remove_all(.data$feature, "_NCS")
       ) %>%
       dplyr::group_by(.data$feature) %>%
       dplyr::summarise(
-        total_amount  = sum(.data$total_amount,  na.rm = TRUE),
+        total_amount  = sum(.data$total_amount, na.rm = TRUE),
         absolute_held = sum(.data$absolute_held, na.rm = TRUE)
       ) %>%
       dplyr::ungroup() %>%
@@ -310,12 +309,10 @@ splnr_get_featureRep <- function(soln, pDat, targets = NA,
         0
       )) %>%
       dplyr::left_join(targets, by = "feature")
-
   } else if (climsmart == TRUE && climsmartApproach == 3) {
     # Percentile approach: join with pre-adjusted targets dataframe.
     s1 <- s1 %>%
       dplyr::left_join(targets, by = "feature")
-
   } else {
     # Standard (non-climate-smart) approach: targets from the problem object.
     s1 <- s1 %>%
@@ -368,7 +365,7 @@ splnr_get_featureRep <- function(soln, pDat, targets = NA,
           .data$absolute_held / .data$total_amount,
           0
         ),
-        target     = 0,
+        target = 0,
         incidental = TRUE
       )
   } else {
@@ -438,6 +435,9 @@ splnr_get_featureRep <- function(soln, pDat, targets = NA,
 #'   by which to sort the features on the x-axis. Accepted values include:
 #'   `"category"`, `"feature"`, `"target"`, `"representation"` (`relative_held`),
 #'   or `"difference"` (between representation and target).
+#' @param base_size A numeric value for the base font size (in points) passed to
+#'   `ggplot2::theme_bw()`. All text elements scale proportionally from this value.
+#'   Defaults to `14`.
 #' @param ... Other arguments passed on to [ggplot2::theme()] to customize the plot's theme.
 #'
 #' @return A [ggplot2::ggplot] object representing the feature representation bar plot.
@@ -500,8 +500,8 @@ splnr_plot_featureRep <- function(df,
                                   showTarget = NA,
                                   plotTitle = "",
                                   sort_by = "category",
+                                  base_size = 14,
                                   ...) {
-
   assertthat::assert_that(
     inherits(df, c("data.frame", "tbl_df")),
     is.logical(renameFeatures),
@@ -538,7 +538,7 @@ splnr_plot_featureRep <- function(df,
       )
     )
     category <- category %>%
-      dplyr::rename(feature = categoryFeatureCol)
+      dplyr::rename(feature = !!rlang::sym(categoryFeatureCol))
   }
 
 
@@ -629,7 +629,7 @@ splnr_plot_featureRep <- function(df,
       fill = "NA", colour = "black"
     ) +
     ggplot2::labs(title = plotTitle, x = "Feature", y = "Representation of features \nin total selected area (%)") +
-    ggplot2::theme_bw() +
+    ggplot2::theme_bw(base_size = base_size) +
     # Ensure ymax is calculated correctly and handled for empty df
     ggplot2::scale_y_continuous(
       limits = c(0, max(df$relative_held, na.rm = TRUE, 0) + 10), # Ensure at least 0 if all NA
@@ -642,16 +642,13 @@ splnr_plot_featureRep <- function(df,
     ) +
     ggplot2::guides(colour = "none") +
     ggplot2::theme(
-      axis.text.x = ggplot2::element_text(angle = 90, hjust = 1, vjust = 0.5, size = 16, colour = "black"),
-      axis.text.y = ggplot2::element_text(size = 16, colour = "black"),
+      axis.text.x = ggplot2::element_text(angle = 90, hjust = 1, vjust = 0.5, colour = "black"),
+      axis.text.y = ggplot2::element_text(colour = "black"),
       axis.title.x = ggplot2::element_blank(),
-      axis.title.y = ggplot2::element_text(size = 16),
       legend.title = ggplot2::element_blank(),
-      legend.text = ggplot2::element_text(size = 16),
       legend.position = "top",
       legend.direction = "horizontal",
       legend.background = ggplot2::element_rect(fill = "NA"),
-      title = ggplot2::element_text(size = 16),
       ...
     )
 
@@ -699,6 +696,9 @@ splnr_plot_featureRep <- function(df,
 #'   percentage for 'representative' features. Required if `indicateTargets` is `TRUE`.
 #' @param colTarget A [character][base::character] string specifying the color
 #'   for the target indicator lines.
+#' @param base_size A numeric value for the base font size (in points) passed to
+#'   `ggplot2::theme_minimal()`. All text elements scale proportionally from this value.
+#'   Defaults to `14`.
 #'
 #' @return A [ggplot2::ggplot] object of the circular bar plot.
 #' @export
@@ -769,8 +769,8 @@ splnr_plot_featureRep <- function(df,
 #' }
 splnr_plot_circBplot <- function(df, legend_color, legend_list,
                                  indicateTargets = TRUE, impTarget = NA,
-                                 repTarget = NA, colTarget = "red") {
-
+                                 repTarget = NA, colTarget = "red",
+                                 base_size = 14) {
   # assertthat checks for initial inputs
   assertthat::assert_that(
     inherits(df, c("data.frame", "tbl_df")),
@@ -902,19 +902,19 @@ splnr_plot_circBplot <- function(df, legend_color, legend_list,
       inherit.aes = FALSE
     ) +
     ggplot2::annotate("text",
-                      x = rep(max(data$id - 1), 4),
-                      y = c(25, 50, 75, 100),
-                      label = c(25, 50, 75, 100),
-                      color = "grey50",
-                      size = 4,
-                      angle = 0, # -5
-                      fontface = "bold",
-                      hjust = 0.5
+      x = rep(max(data$id - 1), 4),
+      y = c(25, 50, 75, 100),
+      label = c(25, 50, 75, 100),
+      color = "grey50",
+      size = 4,
+      angle = 0, # -5
+      fontface = "bold",
+      hjust = 0.5
     ) +
 
     # setting limitations of actual plot
     ggplot2::ylim(-130, 130) + # -140, 130
-    ggplot2::theme_minimal() +
+    ggplot2::theme_minimal(base_size = base_size) +
     ggplot2::coord_polar() +
     ggplot2::geom_text(
       data = label_data, ggplot2::aes(
@@ -924,7 +924,6 @@ splnr_plot_circBplot <- function(df, legend_color, legend_list,
       fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle,
       inherit.aes = FALSE
     ) +
-
     ggplot2::theme(
       legend.position = "bottom",
       axis.text = ggplot2::element_blank(),

R/splnr_get_IUCNRedList.R

@@ -56,9 +56,11 @@
 #' # For example: Sys.setenv(IUCN_REDLIST_KEY = "YOUR_API_KEY_HERE")
 #'
 #' # Example: Create a dataframe with species names and retrieve their IUCN Red List categories.
-#' df_species_redlist <- data.frame(Species = c("Diomedea exulans",
-#'                                               "Hippocampus kuda",
-#'                                               "Squatina squatina")) %>%
+#' df_species_redlist <- data.frame(Species = c(
+#'   "Diomedea exulans",
+#'   "Hippocampus kuda",
+#'   "Squatina squatina"
+#' )) %>%
 #'   splnr_get_IUCNRedList()
 #' print(df_species_redlist)
 #'
@@ -68,7 +70,6 @@
 #' print(df_alt_col)
 #' }
 splnr_get_IUCNRedList <- function(df, species_col = "Species") {
-
   # Assertions to validate input parameters.
   assertthat::assert_that(
     inherits(df, "data.frame"),
@@ -110,7 +111,7 @@ splnr_get_IUCNRedList <- function(df, species_col = "Species") {
     # Rename the selected columns to match the input dataframe's species column name
     # and a new column for the IUCN category for clarity.
     dplyr::rename(!!species_col := .data$result.scientific_name,
-                  IUCN_Category = .data$category
+      IUCN_Category = .data$category
     )
 
   # Perform a left join to link the species in the input dataframe to their