Preparing for a hotfix update. - R CMD checks

DESCRIPTION

@@ -60,7 +60,6 @@ Suggests:
     purrr,
     qpdf,
     RColorBrewer,
-    rgdal,
     rjags,
     rlang,
     rmarkdown,

NEWS.md

@@ -3,6 +3,7 @@
 ## General.
 -   Fixed a bug that prevented error messages stating the dependencies missing per function to show up properly.
 -   Fixed assumptions on Seurat v4 and v5 and reverted to the use of cannonical `GetAssayData` and `SetAssayData` functions.
+-   Fixed dependency problems with archived packages.
 
 ## do_BeeSwarmPlot()
 -   Changed default continuous palette to `YlGnBu`.
@@ -14,6 +15,13 @@
 -   Changed default value of `legend.position` to `bottom`. 
 -   Fixed a bug in which legend key glyphs would not show up when using `use_silhouette = TRUE`. 
 
+## do_CopyNumberVariantPlot()
+-   Fixed an issue in which using `min.cutoff` or `max.cutoff` would render the values outside these bounds to NA and therefore being plotted as grey. Now they will have the highest/lowest value possible.
+
+## do_FeaturePlot()
+-   Added `symmetry.type` parameter, that allows to control how the symmetry is computed: either in absolute values (taking into account the highest and lowest value) or in the middle point specified by `symmetry.center`.
+-   Added `symmetry.center` parameter, that allows to control the center of symmetry when `symmetry.type` is set to `centered`. 
+
 ## do_ViolinPlot()
 -   Changed default value of `legend.position` to `bottom`. 
 -   Fixed a bug in which the default color palette would not be applied when `plot_boxplots = FALSE`.

R/do_CopyNumberVariantPlot.R

@@ -267,6 +267,17 @@ do_CopyNumberVariantPlot <- function(sample,
 
                  dplyr::group_by(.data[[group]], .data$Event) %>%
                  dplyr::summarise("mean" = mean(.data$CNV_score, na.rm = TRUE))
+
+    # Fix the out of bound values.
+    if (!is.na(min.cutoff)){
+      data.use <- data.use %>% 
+                  dplyr::mutate("mean" = ifelse(.data$mean < min.cutoff, min.cutoff, .data$mean))
+    }
+
+    if (!is.na(max.cutoff)){
+      data.use <- data.use %>% 
+                  dplyr::mutate("mean" = ifelse(.data$mean > max.cutoff, max.cutoff, .data$mean))
+    }
     })
 
     events <- c(as.character(seq(1, 22)), vapply(seq(1, 22), function(x){return(c(paste0(x, "p"), paste0(x, "q")))}, FUN.VALUE = character(2)))

R/do_FeaturePlot.R

@@ -11,6 +11,12 @@
 #' @param group.by.colors.use \strong{\code{\link[base]{character}}} | Colors to use for the group dots.
 #' @param group.by.show.dots \strong{\code{\link[base]{logical}}} | Controls whether to place in the middle of the groups.
 #' @param group.by.cell_borders.alpha \strong{\code{\link[base]{numeric}}} | Controls the transparency of the new borders drawn by \strong{\code{group.by.cell_borders}}.
+#' @param symmetry.type \strong{\code{\link[base]{character}}} | Type of symmetry to be enforced. One of:
+#' \itemize{
+#'   \item \emph{\code{absolute}}: The highest absolute value will be taken into a account to generate the color scale ranging from [-value, value]. Works after \strong{\code{min.cutoff}} and \strong{\code{max.cutoff}}.
+#'   \item \emph{\code{centered}}: Centers the scale around the provided value in \strong{\code{symmetry.center}}. Works after \strong{\code{min.cutoff}} and \strong{\code{max.cutoff}}.
+#' }
+#' @param symmetry.center \strong{\code{\link[base]{numeric}}} | Value upon which the scale will be centered.
 #' @return  A ggplot2 object containing a Feature Plot.
 #' @export
 #'
@@ -34,6 +40,8 @@ do_FeaturePlot <- function(sample,
                            idents.highlight = NULL,
                            dims = c(1, 2),
                            enforce_symmetry = FALSE,
+                           symmetry.type = "absolute", 
+                           symmetry.center = NA,
                            pt.size = 1,
                            font.size = 14,
                            font.type = "sans",
@@ -144,7 +152,8 @@ do_FeaturePlot <- function(sample,
                        "group.by.dot.size" = group.by.dot.size,
                        "group.by.cell_borders.alpha" = group.by.cell_borders.alpha,
                        "sequential.direction" = sequential.direction,
-                       "diverging.direction" = diverging.direction)
+                       "diverging.direction" = diverging.direction,
+                       "symmetry.center" = symmetry.center)
   check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric)
   # Check character parameters.
   # Workaround for features.
@@ -188,7 +197,8 @@ do_FeaturePlot <- function(sample,
                          "axis.title.face" = axis.title.face,
                          "axis.text.face" = axis.text.face,
                          "legend.title.face" = legend.title.face,
-                         "legend.text.face" = legend.text.face)
+                         "legend.text.face" = legend.text.face,
+                         "symmetry.type" = symmetry.type)
   check_type(parameters = character_list, required_type = "character", test_function = is.character)
 
   # Check slot.
@@ -285,7 +295,9 @@ do_FeaturePlot <- function(sample,
   check_parameters(viridis.direction, parameter_name = "viridis.direction")
   check_parameters(sequential.direction, parameter_name = "sequential.direction")
   check_parameters(diverging.direction, parameter_name = "diverging.direction")
-
+  check_parameters(parameter = symmetry.type, parameter_name = "symmetry.type")
+
+
   if (length(min.cutoff) != length(features)){
     warning(paste0(add_warning(), crayon_body("Please provide as many values to "),
                    crayon_key("min.cutoff"),
@@ -404,7 +416,9 @@ do_FeaturePlot <- function(sample,
                                       min.cutoff = min.cutoff,
                                       max.cutoff = max.cutoff,
                                       flavor = "Seurat",
-                                      enforce_symmetry = enforce_symmetry)
+                                      enforce_symmetry = enforce_symmetry,
+                                      center_on_value = if(symmetry.type == "absolute"){FALSE} else {TRUE},
+                                      value_center = symmetry.center)
         p <- add_scale(p = p,
                        function_use = ggplot2::scale_color_gradientn(colors = colors.gradient,
                                                                      na.value = na.value,
@@ -425,7 +439,9 @@ do_FeaturePlot <- function(sample,
                                       min.cutoff = min.cutoff[counter],
                                       max.cutoff = max.cutoff[counter],
                                       flavor = "Seurat",
-                                      enforce_symmetry = enforce_symmetry)
+                                      enforce_symmetry = enforce_symmetry,
+                                      center_on_value = if(symmetry.type == "absolute"){FALSE} else {TRUE},
+                                      value_center = symmetry.center)
 
         p[[counter]] <- add_scale(p = p[[counter]],
                                   function_use = ggplot2::scale_color_gradientn(colors = colors.gradient,
@@ -656,7 +672,9 @@ do_FeaturePlot <- function(sample,
                                       min.cutoff = min.cutoff.use,
                                       max.cutoff = max.cutoff.use,
                                       flavor = "Seurat",
-                                      enforce_symmetry = enforce_symmetry)
+                                      enforce_symmetry = enforce_symmetry,
+                                      center_on_value = if(symmetry.type == "absolute"){FALSE} else {TRUE},
+                                      value_center = symmetry.center)
 
         p.loop <- add_scale(p = p.loop,
                             function_use = ggplot2::scale_color_gradientn(colors = colors.gradient,
@@ -839,7 +857,9 @@ do_FeaturePlot <- function(sample,
                                         min.cutoff = min.cutoff.use,
                                         max.cutoff = max.cutoff.use,
                                         flavor = "Seurat",
-                                        enforce_symmetry = enforce_symmetry)
+                                        enforce_symmetry = enforce_symmetry,
+                                        center_on_value = if(symmetry.type == "absolute"){FALSE} else {TRUE},
+                                        value_center = symmetry.center)
 
           p.loop <- add_scale(p = p.loop,
                               function_use = ggplot2::scale_color_gradientn(colors = colors.gradient,

R/utils.R

@@ -2518,6 +2518,13 @@ check_parameters <- function(parameter,
                                          crayon_body(": "),
                                          paste(vapply(c("plain", "italic", "bold", "bold.italic"), crayon_key, FUN.VALUE = character(1)), collapse = crayon_body(", ")),
                                          crayon_body(".")))
+  }   else if (parameter_name %in% c("symmetry.type")){
+    assertthat::assert_that(parameter %in% c("absolute", "centered"),
+                            msg = paste0(add_cross(), crayon_body("Please provide one of the following to "),
+                                         crayon_key(parameter_name),
+                                         crayon_body(": "),
+                                         paste(vapply(c("absolute", "centered"), crayon_key, FUN.VALUE = character(1)), collapse = crayon_body(", ")),
+                                         crayon_body(".")))
   }
 }