Modules split: Staging

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: GiottoVisuals
 Title: Visuals for the Giotto spatial biology analysis ecosystem
-Version: 0.1.0
+Version: 0.1.0.1
 Authors@R: c(
 	person("Ruben", "Dries", email = "rubendries@gmail.com",
 		 role = c("aut", "cre")),
@@ -27,14 +27,14 @@ Depends:
     base (>= 3.5.0),
     utils (>= 3.5.0),
     R (>= 3.5.0),
-    GiottoUtils,
-    GiottoClass
 Imports:
     checkmate,
     colorRamp2,
     cowplot (>= 0.9.4),
     data.table,
     ggplot2 (>= 3.1.1),
+    GiottoUtils (>= 0.1.0.1),
+    GiottoClass (>= 0.1.0.1),
     ggrepel,
     igraph (>= 1.2.4.1),
     methods,
@@ -84,12 +84,14 @@ Collate:
     'dd.R'
     'gg_info_layers.R'
     'globals.R'
+    'gstop.R'
     'plot_dendrogram.R'
     'plot_heatmap.R'
     'plot_sankey.R'
     'plot_scatter.R'
     'plot_violin.R'
     'spatialDE_visuals.R'
+    'suite_reexports.R'
     'vis_spatial.R'
     'vis_spatial_in_situ.R'
     'viz_spatial_network.R'

NAMESPACE

@@ -16,6 +16,7 @@ export(dimPlot3D)
 export(expand_feature_info)
 export(getColors)
 export(getDistinctColors)
+export(getRainbowColors)
 export(get_continuous_colors)
 export(gg_simple_scatter)
 export(giottoSankeyPlan)

NEWS.md

@@ -0,0 +1,18 @@
+
+# Giotto Visuals 0.1.1 (TBD)
+
+## Breaking Changes
+- Removed: `getDistinctColors()` to *GiottoUtils*
+
+## Added
+- Add: `getDistinctColors()` and `getRainbowColors()` as re-exports from *GiottoUtils*
+
+## Changes
+- Changed: Package internal functions now have `.` prefix
+- Changed: *GiottoUtils* and *GiottoClass* moved to Imports
+- Changed: Other internal function naming changes to bring in line with updates to *GiottoUtils*
+
+
+# Giotto Visuals 0.1.0 (23/11/29)
+
+Initial release

R/aux_defaults.R

@@ -109,7 +109,7 @@ set_default_color_discrete = function(
       return(simple_palette_factory(col = colors, rev = reverse, strategy = strategy))
     } else { # assume call to getColors() otherwise
       # return wrapped
-      return(get_palette_factory(pal = colors, rev = reverse, strategy = strategy))
+      return(.get_palette_factory(pal = colors, rev = reverse, strategy = strategy))
     }
   }
 }
@@ -360,14 +360,14 @@ set_default_color_continuous <- function(
   # evaluate 'colors'
   switch(
     style,
-    'divergent' = evaluate_color_gradient_divergent(colors = colors,
+    'divergent' = .evaluate_color_gradient_divergent(colors = colors,
                                                     reverse = reverse,
                                                     midpoint = midpoint,
                                                     grad2 = grad2,
                                                     grad = grad,
                                                     gradn = gradn,
                                                     ...),
-    'sequential' = evaluate_color_gradient_sequential(colors = colors,
+    'sequential' = .evaluate_color_gradient_sequential(colors = colors,
                                                       reverse = reverse,
                                                       gradn = gradn,
                                                       grad = grad,
@@ -376,7 +376,7 @@ set_default_color_continuous <- function(
 }
 
 
-evaluate_color_gradient_divergent = function(colors,
+.evaluate_color_gradient_divergent = function(colors,
                                              reverse,
                                              midpoint,
                                              grad2,
@@ -400,7 +400,7 @@ evaluate_color_gradient_divergent = function(colors,
                        ...)
     } else if (length(colors) == 1L) { # assume call to getColors() otherwise
       # return wrapped
-      colors <- get_palette_factory(pal = colors, rev = reverse, strategy = 'cutoff')(256)
+      colors <- .get_palette_factory(pal = colors, rev = reverse, strategy = 'cutoff')(256)
       gradient <- gradn(colors = colors, rescaler = mid_rescaler(mid = midpoint), ...)
     } else { # assume custom palette
       gradient <- gradn(colors = colors, rescaler = mid_rescaler(mid = midpoint), ...)
@@ -413,7 +413,7 @@ evaluate_color_gradient_divergent = function(colors,
   gradient
 }
 
-evaluate_color_gradient_sequential = function(colors,
+.evaluate_color_gradient_sequential = function(colors,
                                               reverse,
                                               gradn,
                                               grad,
@@ -429,7 +429,7 @@ evaluate_color_gradient_sequential = function(colors,
                        ...)
     } else if (length(colors) == 1L) { # assume call to getColors() otherwise
       # return wrapped
-      colors <- get_palette_factory(pal = colors, rev = reverse, strategy = 'cutoff')(256)
+      colors <- .get_palette_factory(pal = colors, rev = reverse, strategy = 'cutoff')(256)
       gradient <- gradn(colors = colors, ...)
     } else { # assume custom palette
       gradient <- gradn(colors = colors, ...)

R/aux_save.R

@@ -31,9 +31,9 @@ NULL
 
 
 
-#' @describeIn plot_save ggplot saving. ... passes to cowplot::save_plot
+#' @describeIn plot_save (internal) ggplot saving. ... passes to cowplot::save_plot
 #' @keywords internal
-ggplot_save_function = function(gobject,
+.ggplot_save_function = function(gobject,
                                 plot_object,
                                 save_dir = NULL,
                                 save_folder = NULL,
@@ -124,9 +124,9 @@ ggplot_save_function = function(gobject,
 
 
 
-#' @describeIn plot_save base and general saving. ... passes to grDevices png, tiff, pdf, svg
+#' @describeIn plot_save (internal) base and general saving. ... passes to grDevices png, tiff, pdf, svg
 #' @keywords internal
-general_save_function = function(gobject,
+.general_save_function = function(gobject,
                                  plot_object,
                                  save_dir = NULL,
                                  save_folder = NULL,
@@ -266,7 +266,7 @@ all_plots_save_function = function(gobject,
 
   if(any('ggplot' %in% class(plot_object))) {
 
-    ggplot_save_function(gobject = gobject,
+    .ggplot_save_function(gobject = gobject,
                          plot_object = plot_object,
                          save_dir = save_dir,
                          save_folder = save_folder,
@@ -288,7 +288,7 @@ all_plots_save_function = function(gobject,
 
   } else {
 
-    general_save_function(gobject = gobject,
+    .general_save_function(gobject = gobject,
                           plot_object = plot_object,
                           save_dir = save_dir,
                           save_folder = save_folder,

R/aux_visuals.R

@@ -5,8 +5,8 @@ NULL
 
 # clusters ####
 
-#' @title decide_cluster_order
-#' @name decide_cluster_order
+#' @title Decide cluster order
+#' @name .decide_cluster_order
 #' @description creates order for clusters
 #' @inheritParams data_access_params
 #' @param expression_values expression values to use (e.g. "normalized", "scaled", "custom")
@@ -19,7 +19,7 @@ NULL
 #' @return custom
 #' @details Calculates order for clusters.
 #' @keywords internal
-decide_cluster_order = function(gobject,
+.decide_cluster_order = function(gobject,
                                 spat_unit = NULL,
                                 feat_type = NULL,
                                 expression_values = c('normalized', 'scaled', 'custom'),
@@ -55,8 +55,12 @@ decide_cluster_order = function(gobject,
                           feat_type = feat_type)
 
   ## check parameters
-  if(is.null(cluster_column)) stop('\n cluster column must be selected \n')
-  if(!cluster_column %in% colnames(cell_metadata)) stop('\n cluster column is not found \n')
+  if(is.null(cluster_column)) .gstop('cluster column must be selected')
+  if(!cluster_column %in% colnames(cell_metadata)) {
+    .gstop('cluster column is not found in',
+           str_bracket(spat_unit), str_bracket(feat_type),
+           'metadata')
+  }
 
   ## cluster order ##
   cluster_order = match.arg(cluster_order, c('size', 'correlation', 'custom'))
@@ -113,7 +117,7 @@ aes_string2 <- function(...){
 }
 
 
-#' @title gg_input
+#' @title gg input
 #' @name gg_input
 #' @description modular handling of ggplot inputs for functions that may either
 #' append additional information to a ggplot object or be where the ggobject is

R/color_palettes.R

@@ -86,25 +86,25 @@ getColors <- function(pal = 'viridis',
       pkg_to_use = 'palr'
     }
     if(inherits(try_val, 'try-error')) {
-      stop(wrap_txt(pal, 'not discovered in supported palette packages:',
-                    names(pal_names), errWidth = TRUE))
+      .gstop(pal, 'not discovered in supported palette packages:',
+             names(pal_names))
     }
     pal = try_val
   }
 
   out = switch(
     pkg_to_use,
     'hcl' = grDevices::hcl.colors(n = n, palette = pal),
-    'base' = get_base_colors(n = n, pal = pal),
-    'RColorBrewer' = get_rcolorbrewer_colors(n = n, pal = pal, strategy = strategy),
-    'viridis' = get_viridis_colors(n = n, pal = pal),
-    'wesanderson' = get_wes_anderson_colors(n = n, pal = pal),
-    'ggsci' = get_ggsci_colors(n = n, pal = pal, strategy = strategy),
-    'nord' = get_nord_colors(n = n, pal = pal),
-    'palettetown' = get_palettetown_colors(n = n, pal = pal, strategy = strategy),
-    'palr' = get_palr_colors(n = n, pal = pal),
-    'NineteenEightyR' = get_ninteeneightyr_colors(n = n, pal = pal, strategy = strategy),
-    'rcartocolor' = get_rcarto_colors(n = n, pal = pal, strategy = strategy)
+    'base' = .get_base_colors(n = n, pal = pal),
+    'RColorBrewer' = .get_rcolorbrewer_colors(n = n, pal = pal, strategy = strategy),
+    'viridis' = .get_viridis_colors(n = n, pal = pal),
+    'wesanderson' = .get_wes_anderson_colors(n = n, pal = pal),
+    'ggsci' = .get_ggsci_colors(n = n, pal = pal, strategy = strategy),
+    'nord' = .get_nord_colors(n = n, pal = pal),
+    'palettetown' = .get_palettetown_colors(n = n, pal = pal, strategy = strategy),
+    'palr' = .get_palr_colors(n = n, pal = pal),
+    'NineteenEightyR' = .get_ninteeneightyr_colors(n = n, pal = pal, strategy = strategy),
+    'rcartocolor' = .get_rcarto_colors(n = n, pal = pal, strategy = strategy)
   )
 
   if(rev) return(rev(out))
@@ -115,60 +115,11 @@ getColors <- function(pal = 'viridis',
 
 
 
-#' @title getDistinctColors
-#' @description Returns a number of distinct colors based on the RGB scale
-#' @param n number of colors wanted
-#' @return character vector of hexadecimal distinct colors
-#' @export
-getDistinctColors <- function(n) {
-
-  if(n < 1) stop(wrap_txt('getDistinctColors \'n\' colors wanted must be at least 1\n', errWidth = TRUE), call. = FALSE)
-
-  qual_col_pals <- RColorBrewer::brewer.pal.info[RColorBrewer::brewer.pal.info$category == 'qual',]
-  col_vector <- unique(unlist(mapply(RColorBrewer::brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals))));
-
-  if(n > length(col_vector)) {
-
-    # get all possible colors
-    all_colors = grDevices::colors()
-    all_colors_no_grey = grep(x = all_colors, pattern = 'grey|gray', value = T, invert = T)
-    grey_colors = grep(x = all_colors, pattern = 'grey', value = T, invert = F)
-    admitted_grey_colors = grey_colors[seq(1, 110, 10)]
-    broad_colors = c(all_colors_no_grey, admitted_grey_colors)
-
-    set.seed(1234)
-    on.exit(set.seed(Sys.time()))
-    # if too many colors requested, warn about recycling
-    if(n > length(broad_colors)) {
-      warning('\n not enough unique colors in R, maximum = 444 \n')
-      col_vector = sample(x = broad_colors, size = n, replace = TRUE)
-    } else {
-      col_vector = sample(x = broad_colors, size = n, replace = FALSE)
-    }
-
-  } else {
-
-    xxx <- grDevices::col2rgb(col_vector);
-    dist_mat <- as.matrix(stats::dist(t(xxx)));
-    diag(dist_mat) <- 1e10;
-    while (length(col_vector) > n) {
-      minv <- apply(dist_mat,1,function(x)min(x));
-      idx <- which(minv==min(minv))[1];
-      dist_mat <- dist_mat[-idx, -idx];
-      col_vector <- col_vector[-idx]
-    }
-
-  }
-  return(col_vector)
-}
-
-
-
 
 
 # get palettes ####
 
-get_rcolorbrewer_colors <- function(n, pal, strategy) {
+.get_rcolorbrewer_colors <- function(n, pal, strategy) {
 
   # DT vars
   rn = maxcolors = NULL
@@ -185,7 +136,7 @@ get_rcolorbrewer_colors <- function(n, pal, strategy) {
   return(out)
 }
 
-get_ggsci_colors <- function(n, pal, strategy) {
+.get_ggsci_colors <- function(n, pal, strategy) {
   package_check('ggsci')
 
   pal_fullname <- paste0('ggsci::pal_', pal, '()')
@@ -200,7 +151,7 @@ get_ggsci_colors <- function(n, pal, strategy) {
   )
 }
 
-get_viridis_colors <- function(n, pal = 'viridis') {
+.get_viridis_colors <- function(n, pal = 'viridis') {
   # viridisLite should always be installed if viridis is there
   package_check('viridisLite')
   return(
@@ -218,7 +169,7 @@ get_viridis_colors <- function(n, pal = 'viridis') {
   )
 }
 
-get_base_colors = function(n, pal = 'rainbow') {
+.get_base_colors = function(n, pal = 'rainbow') {
   return(
     switch(
       pal,
@@ -233,18 +184,18 @@ get_base_colors = function(n, pal = 'rainbow') {
   )
 }
 
-get_wes_anderson_colors = function(n, pal) {
+.get_wes_anderson_colors = function(n, pal) {
   package_check('wesanderson')
   out = wesanderson::wes_palette(name = pal, n = n, type = 'continuous')
   return(out)
 }
 
-get_nord_colors = function(n, pal) {
+.get_nord_colors = function(n, pal) {
   package_check('nord')
   return(nord::nord(palette = pal, n = n))
 }
 
-get_palettetown_colors = function(n, pal, strategy) {
+.get_palettetown_colors = function(n, pal, strategy) {
   package_check('palettetown')
   colors = get_continuous_colors(
     palettetown::ichooseyou(pokemon = pal),
@@ -253,7 +204,7 @@ get_palettetown_colors = function(n, pal, strategy) {
   )
 }
 
-get_palr_colors = function(n, pal) {
+.get_palr_colors = function(n, pal) {
   package_check('palr')
   return(
     switch(
@@ -270,7 +221,7 @@ get_palr_colors = function(n, pal) {
   )
 }
 
-get_ninteeneightyr_colors = function(n, pal, strategy) {
+.get_ninteeneightyr_colors = function(n, pal, strategy) {
   package_check('NineteenEightyR', repository = 'github',
                 github_repo = 'm-clark/NineteenEightyR')
 
@@ -293,7 +244,7 @@ get_ninteeneightyr_colors = function(n, pal, strategy) {
   return(get_continuous_colors(col = pal_col, n = n, strategy))
 }
 
-get_rcarto_colors = function(n, pal, strategy) {
+.get_rcarto_colors = function(n, pal, strategy) {
   package_check('rcartocolor', repository = 'CRAN')
 
   pal_col = suppressWarnings({
@@ -369,7 +320,7 @@ simple_palette_factory = function(col, rev = FALSE, strategy = 'interpolate') {
 #' @param strategy policy when insufficient colors are available
 #' @param strategy strategy to use
 #' @seealso [set_default_color_discrete()]
-get_palette_factory = function(pal, rev = FALSE, strategy = 'interpolate') {
+.get_palette_factory = function(pal, rev = FALSE, strategy = 'interpolate') {
 
   function(n) {
     col = getColors(pal = pal, n = n, rev = rev, strategy = 'cutoff')