Devel

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatialplanr
 Title: Help files for prioritzr Spatial Planning projects
-Version: 0.6.7
+Version: 0.6.8
 Authors@R: c(
     person(
       given = "Jason D.",
@@ -30,7 +30,7 @@ Suggests:
     ggridges,
     irr,
     knitr,
-    oceandatr (>= 0.1.0),
+    oceandatr (>= 0.2.0),
     patchwork,
     prioritizr,
     RColorBrewer,
@@ -61,7 +61,7 @@ Imports:
     rnaturalearth,
     scales,
     sf,
-    spatialgridr (>= 0.0.1),
+    spatialgridr (>= 0.0.2),
     stringr,
     terra,
     tibble,

R/data.R

@@ -5,7 +5,6 @@
 #' @format `dat_PUs`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -22,7 +21,6 @@
 #' @format `dat_bndry`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -39,7 +37,6 @@
 #' @format `dat_region`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -55,7 +52,6 @@
 #' @format `dat_species_bin`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -72,7 +68,6 @@
 #' @format `dat_species_bin2`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -89,7 +84,6 @@
 #' @format `dat_species_prob`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   ...
 #' }
@@ -106,7 +100,6 @@
 #' @format `dat_mpas`
 #' A data frame with XXXX rows and XXX columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   \item{wdpa}{binary MPA information (1: MPA)}
 #'   ...
@@ -160,7 +153,6 @@
 #' @format `dat_clim`
 #' A data frame with 780 rows and 3 columns:
 #' \describe{
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{geometry}{sf geometry column}
 #'   \item{metric}{climate metric information}
 #'   ...
@@ -178,7 +170,6 @@
 # A data frame with 397 rows and 17 columns:
 # \describe{
 #   \item{Chelonia_mydas}{suitable habitat for Chelonia mydas}
-#   \item{cellID}{cell ID of planning units}
 #   ...
 # }
 # @source Aquamaps.org
@@ -196,7 +187,6 @@
 #' A data frame with 397 rows and 17 columns:
 #' \describe{
 #'   \item{wdpa}{binary vector denoting presence or absence of a current marine protected area}
-#'   \item{cellID}{cell ID of planning units}
 #'   ...
 #' }
 #' @source https://www.protectedplanet.net/en/thematic-areas/wdpa?tab=WDPA
@@ -233,7 +223,6 @@
 #' @format `CoralSeaVelocity`
 #' A data frame with 397 rows and 3 columns:
 #' \describe{
-#'   \item{cellID}{cell ID of the planning units}
 #'   \item{vocMagg_transformed}{Climate velocity column}
 #'   \item{geometry}{Geometry column of sf object}
 #'   ...
@@ -263,7 +252,6 @@
 #' A data frame with bathymetry data
 #' \describe{
 #
-#'   \item{cellID}{ID number for each row (or cell) of the dataset}
 #'   \item{bathymetry}{Bathymetry data}
 #'   \item{geometry}{sf geometry column}
 #'   ...

R/splnr_apply_cutoffs.R

@@ -23,7 +23,7 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
     features <- features %>%
       dplyr::as_tibble() %>%
       dplyr::mutate(dplyr::across(
-        -dplyr::any_of(c("cellID", "geometry")), # Apply to all columns except geometry and cellID
+        -dplyr::any_of("geometry"), # Apply to all columns except geometry
         ~ dplyr::case_when(
           . >= Cutoffs ~ 1,
           . < Cutoffs ~ 0,
@@ -34,11 +34,10 @@ splnr_apply_cutoffs <- function(features, Cutoffs, inverse = FALSE) {
 
     if (inverse == TRUE) { # Need to flip the ones/zeros
       features <- features %>%
-        dplyr::mutate(dplyr::across(-dplyr::any_of(c("cellID", "geometry")), ~ 1 - .))
+        dplyr::mutate(dplyr::across(-dplyr::any_of("geometry"), ~ 1 - .))
     }
   } else if (length(Cutoffs) == length(names(Cutoffs))) { # Named vector with values for each column
 
-
     nm <- names(Cutoffs) # Testing - We should only be operating on the columns in the Cutoffs vector
 
     for (f in 1:length(nm)) {

R/splnr_featureRep.R

@@ -2,7 +2,7 @@
 #'
 #' @param soln The `prioritizr` solution
 #' @param pDat The `prioritizr` problem
-#' @param targetsDF `data.frame`with list of features under "feature" column and their corresponding targets under "target" column
+#' @param targets `data.frame`with list of features under "feature" column and their corresponding targets under "target" column
 #' @param climsmart logical denoting whether spatial planning was done climate-smart (and targets have to be calculated differently)
 #' @param climsmartApproach either 0,1,2 or 3 depending on the climate-smart approach used (0 = None; 1 = Climate Priority Area; 2 = Feature; 3 = Percentile).
 #' @param solnCol Name of the column with the solution
@@ -29,15 +29,17 @@
 #'   soln = soln,
 #'   pDat = pDat
 #' )
-splnr_get_featureRep <- function(soln, pDat, targetsDF = NA,
-                                 climsmart = FALSE, climsmartApproach = 0, solnCol = "solution_1") {
+splnr_get_featureRep <- function(soln, pDat, targets = NA,
+                                 climsmart = FALSE,
+                                 climsmartApproach = 0,
+                                 solnCol = "solution_1") {
   s_cols <- pDat$data$features[[1]]
 
   # Get data for features not chosen
   not_selected <- soln %>%
     dplyr::select(
       -tidyselect::starts_with(c("Cost", "solution_")),
-      -tidyselect::any_of(c("metric", "cellID")),
+      -tidyselect::any_of(c("metric")),
       -tidyselect::any_of(s_cols)
     ) %>%
     sf::st_drop_geometry()
@@ -102,13 +104,13 @@ splnr_get_featureRep <- function(soln, pDat, targetsDF = NA,
       dplyr::ungroup() %>%
       dplyr::mutate(relative_held = .data$absolute_held / .data$total_amount) %>% # Calculate proportion
       dplyr::select(-"total_amount", -"absolute_held") %>% # Remove extra columns
-      dplyr::left_join(targetsDF, by = "feature") #%>% # Add targets to df
+      dplyr::left_join(targets, by = "feature") #%>% # Add targets to df
     # dplyr::select(-"type")
 
   } else if (climsmart == TRUE & climsmartApproach == 3) {
 
     s1 <- s1 %>%
-      dplyr::left_join(targetsDF, by = "feature")
+      dplyr::left_join(targets, by = "feature")
 
   } else {
     # Add targets to df
@@ -179,11 +181,13 @@ splnr_get_featureRep <- function(soln, pDat, targetsDF = NA,
 #'
 #' (splnr_plot_featureRep(df, category = dat_category))
 #'
-splnr_plot_featureRep <- function(df, category = NA,
+splnr_plot_featureRep <- function(df,
+                                  category = NA,
                                   categoryFeatureCol = NA,
                                   renameFeatures = FALSE,
                                   namesToReplace = NA,
-                                  nr = 1, showTarget = NA,
+                                  nr = 1,
+                                  showTarget = NA,
                                   plotTitle = "",
                                   ...) {
 

R/splnr_plot.R

@@ -2,15 +2,13 @@
 #'
 #' (For now can replace splnr_plot_cost(), splnr_plot_binFeature(), splnr_plot_MPAs(), splnr_plot_featureNo())
 #'
-#' Written by Kilian Barreiro
+#' Written by Kilian Barreiro and Jason Everett
 #' Written: February 2024
 #'
-#' Plot Spatial Data, returns a gg object
-#'
 #' @param df The dataframe containing the data to be plotted. It must include a geometry column to be used with geom_sf.
-#' @param col_names A list of column names to include in the plot. If specified, only these columns will be used to color the plot.
-#' @param paletteName The name of the color palette to use for filling. Default is "YlGnBu".
-#' @param colourVals The color values to use if col_names is specified and the data is binary.
+#' @param col_names A list of column names to include in the plot. If specified, only these columns will be used to colour the plot.
+#' @param paletteName The name of the colour palette to use for filling. Default is "YlGnBu".
+#' @param colourVals The colour values to use if col_names is specified and the data is binary.
 #' @param plot_title The title of the plot.
 #' @param legend_title The title of the legend.
 #' @param legend_labels A vector of strings containing the labels to use for legend values.
@@ -158,7 +156,7 @@ splnr_plot <- function(df,
 
     gg <- gg +
       ggplot2::geom_sf(data = df, ggplot2::aes(fill = .data[[col_names]]), colour = "grey80", size = 0.1) +
-      ggplot2::scale_fill_viridis_c() +
+      ggplot2::scale_fill_viridis_c(name = legend_title) +
       ggplot2::guides(fill = ggplot2::guide_colourbar(order = 1))
 
   } else if (is.null(col_names)){ # No column to plot by

R/splnr_plotting.R

@@ -206,7 +206,7 @@ splnr_plot_costOverlay <- function(soln, Cost = NA, Cost_name = "Cost",
         as.numeric(stats::quantile(dplyr::pull(Cost, Cost_name), 0.99))
       ),
       # direction = 1,
-      # oob = scales::squish,
+      oob = scales::squish,
       # guide = ggplot2::guide_colourbar(
       #   title.position = "bottom",
       #   title.hjust = 0.5,

R/splnr_plotting_climate.R

@@ -208,29 +208,27 @@ splnr_plot_climKernelDensity_Fancy <- function(solution_list, names,
 #'
 #' @examples
 #' target <- dat_species_bin %>%
-#'   dplyr::select(-"cellID") %>%
 #'   sf::st_drop_geometry() %>%
 #'   colnames() %>%
 #'   data.frame() %>%
 #'   setNames(c("feature")) %>%
 #'   dplyr::mutate(target = 0.3)
 #'
 #' CPA <- splnr_climate_priorityAreaApproach(
-#'   featuresDF = dat_species_bin,
-#'   metricDF = dat_clim,
-#'   targetsDF = target,
+#'   features = dat_species_bin,
+#'   metric = dat_clim,
+#'   targets = target,
 #'   direction = -1,
 #'   refugiaTarget = 1
 #' )
 #'
 #' out_sf <- CPA$Features %>%
 #'   dplyr::mutate(Cost_None = rep(1, 780)) %>%
-#'   dplyr::left_join(dat_clim %>%
-#'     sf::st_drop_geometry(), by = "cellID")
+#'   sf::st_join(dat_clim, join = sf::st_equals)
 #'
 #' usedFeatures <- out_sf %>%
 #'   sf::st_drop_geometry() %>%
-#'   dplyr::select(-tidyselect::starts_with("Cost_"), -"cellID", -"metric") %>%
+#'   dplyr::select(-tidyselect::starts_with("Cost_"), -"metric") %>%
 #'   names()
 #'
 #' p1 <- prioritizr::problem(out_sf, usedFeatures, "Cost_None") %>%

R/splnr_targets.R

@@ -19,16 +19,14 @@ splnr_targets_byInverseArea <- function(df, target_min, target_max) {
     inherits(df, c("sf", "data.frame")),
     is.numeric(target_min) && target_min >= 0 && target_min <= 1,
     is.numeric(target_max) && target_max >= 0 && target_max <= 1,
-    target_min <= target_max,
-    "cellID" %in% names(df)
+    target_min <= target_max
   )
 
   PU_area_km2 <- as.numeric(sf::st_area(df[1, 1]) / 1e+06) # Area of each planning unit
 
   total_PU_area <- nrow(df) * PU_area_km2 # Total area of the study region
 
   dat <- df %>%
-    dplyr::select(-"cellID") %>%
     sf::st_drop_geometry() %>%
     dplyr::mutate(dplyr::across(dplyr::everything(), ~ tidyr::replace_na(.x, 0))) %>%
     dplyr::summarise(dplyr::across(dplyr::everything(), ~ sum(., is.na(.), 0))) %>%