diff --git a/DESCRIPTION b/DESCRIPTION index 3d52f4b27..a7a4403de 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: scCustomize Type: Package Title: Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing Description: Collection of functions created and/or curated to aid in the visualization and analysis of single-cell data using 'R'. 'scCustomize' aims to provide 1) Customized visualizations for aid in ease of use and to create more aesthetic and functional visuals. 2) Improve speed/reproducibility of common tasks/pieces of code in scRNA-seq analysis with a single or group of functions. For citation please use: Marsh SE (2021) "Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing" . -Version: 1.1.1 -Date: 2023-01-13 +Version: 1.1.2 +Date: 2023-07-11 Authors@R: c( person(given = "Samuel", family = "Marsh", email = "samuel.marsh@childrens.harvard.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3012-6945")), person(given = "Ming", family = "Tang", role = c("ctb"), email = "tangming2005@gmail.com"), diff --git a/NAMESPACE b/NAMESPACE index ec068d252..ced6eb667 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,6 +33,7 @@ export(DimPlot_LIGER) export(DimPlot_scCustom) export(DiscretePalette_scCustomize) export(DotPlot_scCustom) +export(Extract_Modality) export(Extract_Sample_Meta) export(Extract_Top_Markers) export(FeaturePlot_DualAssay) @@ -53,6 +54,7 @@ export(Liger_to_Seurat) export(Median_Stats) export(Merge_Seurat_List) export(Merge_Sparse_Data_All) +export(Merge_Sparse_Multimodal_All) export(Meta_Highlight_Plot) export(Meta_Numeric) export(Meta_Present) @@ -90,6 +92,7 @@ export(Read_CellBender_h5_Multi_Directory) export(Read_CellBender_h5_Multi_File) export(Read_GEO_Delim) export(Read_Metrics_10X) +export(Reduction_Loading_Present) export(Rename_Clusters) export(Replace_Suffix) export(Seq_QC_Plot_Alignment_Combined) @@ -157,6 +160,7 @@ importFrom(SeuratObject,PackageCheck) importFrom(circlize,colorRamp2) importFrom(cowplot,theme_cowplot) importFrom(data.table,fread) +importFrom(dplyr,across) importFrom(dplyr,all_of) importFrom(dplyr,any_of) importFrom(dplyr,arrange) @@ -169,14 +173,12 @@ importFrom(dplyr,intersect) importFrom(dplyr,left_join) importFrom(dplyr,mutate) importFrom(dplyr,n) -importFrom(dplyr,one_of) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,select) -importFrom(dplyr,select_at) importFrom(dplyr,slice) importFrom(dplyr,slice_max) -importFrom(dplyr,summarise_at) +importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(forcats,fct_relevel) importFrom(ggbeeswarm,geom_quasirandom) @@ -195,6 +197,7 @@ importFrom(janitor,adorn_totals) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(methods,as) +importFrom(methods,hasArg) importFrom(methods,new) importFrom(methods,slot) importFrom(paletteer,paletteer_c) @@ -203,7 +206,6 @@ importFrom(patchwork,plot_annotation) importFrom(patchwork,plot_layout) importFrom(patchwork,wrap_plots) importFrom(pbapply,pblapply) -importFrom(pbapply,pbmapply) importFrom(pbapply,pboptions) importFrom(purrr,discard) importFrom(purrr,keep) diff --git a/NEWS.md b/NEWS.md index 5fa4a497f..dfa368d08 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,32 @@ +# scCustomize 1.1.2 (2023-07-11) +## Added +- Added `aspect_ratio` parameter to all dimensionality reduction plots to control axes ratio of output plot. +- Added `plot_median` and `median_size` parameters to `QC_Plots_*` functions. +- Added `split_collect` parameter to `FeaturePlot_scCustom` to collect all guides when using `split.by` for a single feature ([#94](https://github.com/samuel-marsh/scCustomize/issues/94)). +- Added new parameters to `Clustered_DotPlot` to allow modification of sizes of column text labels, legend text labels, and legend title labels ([#96](https://github.com/samuel-marsh/scCustomize/issues/96)). +- Added new function `Merge_Sparse_Multimodal_All` for merging multi-modal data (1 matrix per modality) ([#104](https://github.com/samuel-marsh/scCustomize/issues/104)). +- Added new parameter to `Clustered_DotPlot` named `row_label_fontface` to allow control of fontface used for row labels ([#103](https://github.com/samuel-marsh/scCustomize/issues/103)). +- Added helper utility `Reduction_Loading_Present`, in part to fix issue with `FeaturePlot_scCustom` and internal feature checking. +- Added ability to turn off feature/ident clustering in `Clustered_DotPlot` using new parameters: `cluster_feature`, `cluster_ident` ([#106](https://github.com/samuel-marsh/scCustomize/issues/106)). +- Added `dot_size` parameter to statistics plotting functions `Plot_Cells_per_Sample` and `Plot_Median_*` family. +- Added new parameter `no_legend` to `Iterate_Meta_Highlight_Plot` to allow for plotting with a plot title instead of plot legend ([#108](https://github.com/samuel-marsh/scCustomize/issues/108)). + + +## Changed +- Moved `QC_Plots_Feature` to use `VlnPlot_scCustom` under the hood like rest of `QC_Plots_*` functions. +- Renamed parameter `abort` in `Meta_Present` to `return_none` to align with `Gene_Present` and `Reduction_Loading_Present`. +- Replace superseded dplyr syntax/functionality `summarise_at`, `select(.data[[var]])`, and `rename(.data[[var]])` with current dplyr syntax. +- Internal rewrite of plotting sections within `Iterate_Cluster_Highlight_Plot` and `Iterate_Meta_Highlight_Plot` to align with recent updates to base `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` functions. + + +## Fixes +- Fixed `QC_Plots_Feature` to respect parameters when passing to `VlnPlot` ([#91](https://github.com/samuel-marsh/scCustomize/issues/91)). +- Fixed `Read_CellBender_h5_*` functions to support CellBender outputs from STARsolo- or Cell Ranger (pre-V3)-processed data ([#99](https://github.com/samuel-marsh/scCustomize/issues/99)). +- Fixed `FeaturePlot_scCustom` to allow for plotting of dimensionality reduction loadings ([#97](https://github.com/samuel-marsh/scCustomize/issues/97)). +- Fixed `Read10X_Multi_Directory` and `Read10X_h5_Multi_Directory` to support files processed with Cell Ranger `multi` pipeline. + + + # scCustomize 1.1.1 (2023-01-13) ## Added - Added `label_color_num` parameter to `PalettePlot` allow control of color labeling. @@ -21,6 +50,7 @@ - Updated out-dated documentation for number of package functions. - Typo/styling fixes. + # scCustomize 1.1.0 (2022-12-22) ## Added - Added `merge` parameter to `Read10X_GEO`, `Read10X_h5_GEO`, `Read_GEO_Delim` and `Read_CellBender_h5_Multi_File`. diff --git a/R/Color_Palettes.R b/R/Color_Palettes.R index da599a4c6..7935b78ec 100644 --- a/R/Color_Palettes.R +++ b/R/Color_Palettes.R @@ -182,14 +182,14 @@ Single_Color_Palette <- function(pal_color, "#000000" ) ) - if (!pal_color %in% names(brewer_single_modified)) { + if (!pal_color %in% names(x = brewer_single_modified)) { cli_abort(message = c("Paleete name not found.", "i" = "Palette name not found. Please select one of following palette options: {.field 'reds', 'blues', 'greens', 'purples', or 'grays'}") ) } set.seed(seed = seed_use) pal_use <- brewer_single_modified[[pal_color]] - output_pal <- sample(pal_use, size = num_colors) + output_pal <- sample(x = pal_use, size = num_colors) return(output_pal) } @@ -216,7 +216,7 @@ NavyAndOrange <- function( ) { navy_orange <- c("navy", "orange") if (flip_order) { - navy_orange <- rev(navy_orange) + navy_orange <- rev(x = navy_orange) } return(navy_orange) } @@ -356,8 +356,8 @@ ColorBlind_Pal <- function( varibow_scCustom <- function( n_colors ) { - sats <- rep_len(c(0.55,0.7,0.85,1),length.out = n_colors) - vals <- rep_len(c(1,0.8,0.6),length.out = n_colors) + sats <- rep_len(x = c(0.55,0.7,0.85,1), length.out = n_colors) + vals <- rep_len(x = c(1,0.8,0.6), length.out = n_colors) rainbow(n_colors, s = sats, v = vals) } @@ -469,7 +469,7 @@ DiscretePalette_scCustomize <- function( } if (shuffle_pal) { set.seed(seed = seed) - palette_out <- sample(palette_out[1:num_colors]) + palette_out <- sample(x = palette_out[1:num_colors]) } else { palette_out <- palette_out[1:num_colors] } diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 906113eb5..36ac8a511 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -225,8 +225,8 @@ glue_collapse_scCustom <- function( #' Perform Feature and Meta Checks before plotting #' -#' Wraps the `Gene_Present`, `Meta_Present`, and `Case_Check` into single function to perform feature -#' checks before plotting. +#' Wraps the `Gene_Present`, `Meta_Present`, `Reduction_Loading_Present`, and `Case_Check` into +#' single function to perform feature checks before plotting. #' #' @param object Seurat object #' @param features vector of features and/or meta data variables to plot. @@ -245,11 +245,13 @@ Feature_PreCheck <- function( # Check features and meta to determine which features present features_list <- Gene_Present(data = object, gene_list = features, omit_warn = FALSE, print_msg = FALSE, case_check_msg = FALSE, return_none = TRUE) - meta_list <- Meta_Present(seurat_object = object, meta_col_names = features_list[[2]], omit_warn = FALSE, print_msg = FALSE, abort = FALSE) + meta_list <- Meta_Present(seurat_object = object, meta_col_names = features_list[[2]], omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) - all_not_found_features <- meta_list[[2]] + reduction_list <- Reduction_Loading_Present(seurat_object = object, reduction_names = meta_list[[2]], omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) - all_found_features <- c(features_list[[1]], meta_list[[1]]) + all_not_found_features <- reduction_list[[2]] + + all_found_features <- c(features_list[[1]], meta_list[[1]], reduction_list[[1]]) # Stop if no features found if (length(x = all_found_features) < 1) { diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index f7cc01df5..772117de7 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -18,6 +18,8 @@ #' @param shuffle_seed Sets the seed if randomly shuffling the order of points. #' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of #' technique and therefore needs to be set manually. Default is "UMAP". +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param label logical. Whether or not to label the clusters. ONLY applies to plotting by cluster. Default is TRUE. #' @param label_size size of cluster labels. #' @param label_repel logical. Whether to repel cluster labels from each other if plotting by @@ -61,6 +63,7 @@ DimPlot_LIGER <- function( shuffle = TRUE, shuffle_seed = 1, reduction_label = "UMAP", + aspect_ratio = NULL, label = TRUE, label_size = NA, label_repel = FALSE, @@ -170,6 +173,15 @@ DimPlot_LIGER <- function( shuffle_seed = shuffle_seed) p3 <- wrap_plots(p1 + p2) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p3 <- p3 & theme(aspect.ratio = aspect_ratio) + } + return(p3) } @@ -192,6 +204,14 @@ DimPlot_LIGER <- function( label_color = label_color, label = label, color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p1 <- p1 & theme(aspect.ratio = aspect_ratio) + } + return(p1) } @@ -210,6 +230,14 @@ DimPlot_LIGER <- function( split_by = split_by, shuffle_seed = shuffle_seed, color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p2 <- p2 & theme(aspect.ratio = aspect_ratio) + } + return(p2) } } @@ -330,7 +358,7 @@ plotFactors_scCustom <- function( "i" = "The number of datasets provided to {.code reorder_datasets} ({.field {length(x = reorder_datasets)}}) does not match number of datasets in LIGER object ({.field {length(x = levels(x = levels(liger_object@cell.data$dataset)))}}).") ) } else { - if (!all(levels(liger_object@cell.data$dataset) %in% reorder_datasets)) { + if (!all(levels(x = liger_object@cell.data$dataset) %in% reorder_datasets)) { cli_abort(message = c("Error reordering datasets (name mismatch).", "*" = "Dataset names provided to {.code reorder_datasets} do not match names of datasets in LIGER object.", "i" = "Please check spelling.") @@ -379,16 +407,16 @@ plotFactors_scCustom <- function( # Get Data and Plot Factors cli_inform(message = "{.field Generating plots}") - k <- ncol(liger_object@H.norm) + k <- ncol(x = liger_object@H.norm) pb <- txtProgressBar(min = 0, max = k, style = 3) - W <- t(liger_object@W) - rownames(W) <- colnames(liger_object@scale.data[[1]]) + W <- t(x = liger_object@W) + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) Hs_norm <- liger_object@H.norm H_raw = do.call(rbind, liger_object@H) plot_list = list() tsne_list = list() for (i in 1:k) { - top_genes.W <- rownames(W)[order(W[, i], decreasing = T)[1:num_genes]] + top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] top_genes.W.string <- paste0(top_genes.W, collapse = ", ") factor_textstring <- paste0("Factor", i) plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") @@ -461,7 +489,7 @@ plotFactors_scCustom <- function( if (plot_dimreduc) { tsne_df <- data.frame(Hs_norm[, i], liger_object@tsne.coords) factorlab <- paste0("Factor", i) - colnames(tsne_df) <- c(factorlab, x_axis_label, y_axis_label) + colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) if (order) { tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b1d8831d2..348c5830e 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -379,8 +379,8 @@ Top_Genes_Factor <- function( # Extract genes W <- t(liger_object@W) - rownames(W) <- colnames(liger_object@scale.data[[1]]) - top_genes <- rownames(W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) + top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] return(top_genes) } @@ -422,31 +422,31 @@ Generate_Plotting_df_LIGER <- function(object, split_by = NULL ) { tsne_df <- data.frame(object@tsne.coords) - colnames(tsne_df) <- c("tsne1", "tsne2") + colnames(x = tsne_df) <- c("tsne1", "tsne2") tsne_df[[group_by]] <- object@cell.data[[group_by]] if (!is.null(x = split_by)) { tsne_df[[split_by]] <- object@cell.data[[split_by]] } if (reorder.idents == TRUE){ - tsne_df[[group_by]] <- factor(tsne_df[[group_by]], levels = new.order) + tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) } c_names <- names(object@clusters) - if (is.null(clusters)) { + if (is.null(x = clusters)) { # if clusters have not been set yet - if (length(object@clusters) == 0) { - clusters <- rep(1, nrow(object@tsne.coords)) - names(clusters) <- c_names <- rownames(object@tsne.coords) + if (length(x = object@clusters) == 0) { + clusters <- rep(1, nrow(x = object@tsne.coords)) + names(x = clusters) <- c_names <- rownames(x = object@tsne.coords) } else { clusters <- object@clusters - c_names <- names(object@clusters) + c_names <- names(x = object@clusters) } } tsne_df[['Cluster']] <- clusters[c_names] if (shuffle) { set.seed(shuffle_seed) - idx <- sample(1:nrow(tsne_df)) + idx <- sample(x = 1:nrow(tsne_df)) tsne_df <- tsne_df[idx, ] } return(tsne_df) @@ -538,15 +538,15 @@ Plot_By_Cluster_LIGER <- function( tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) if (!is.null(x = split_by)) { - list_of_splits <- unique(tsne_df[[split_by]]) + list_of_splits <- unique(x = tsne_df[[split_by]]) } # Get length of meta data feature if (!is.null(x = split_by) && !is.null(x = num_columns)) { - split.by_length <- length(list_of_splits) + split.by_length <- length(x = list_of_splits) # Calculate number of rows for selected number of columns - num_rows <- ceiling(split.by_length/num_columns) + num_rows <- ceiling(x = split.by_length/num_columns) # Check column and row compatibility if (num_columns > split.by_length) { @@ -791,15 +791,15 @@ Plot_By_Meta_LIGER <- function( tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) if (!is.null(x = split_by)) { - list_of_splits <- unique(tsne_df[[split_by]]) + list_of_splits <- unique(x = tsne_df[[split_by]]) } # Get length of meta data feature if (!is.null(x = split_by) && !is.null(x = num_columns)) { - split.by_length <- length(list_of_splits) + split.by_length <- length(x = list_of_splits) # Calculate number of rows for selected number of columns - num_rows <- ceiling(split.by_length/num_columns) + num_rows <- ceiling(x = split.by_length/num_columns) # Check column and row compatibility if (num_columns > split.by_length) { @@ -823,7 +823,7 @@ Plot_By_Meta_LIGER <- function( x_axis_label <- paste0(reduction_label, "_1") y_axis_label <- paste0(reduction_label, "_2") - group_by <- sym(group_by) + group_by <- sym(x = group_by) if (raster) { if (!is.null(x = split_by)) { @@ -958,7 +958,7 @@ Variable_Features_ALL_LIGER <- function( cli_inform(message = "Normalizing and identifying variable features.") - temp_liger <- rliger::normalize(temp_liger) + temp_liger <- rliger::normalize(object = temp_liger) temp_liger <- rliger::selectGenes(object = temp_liger, var.thresh = var.thresh, do.plot = do.plot, num.genes = num_genes, tol = tol, alpha.thresh = alpha.thresh, cex.use = pt.size, chunk = chunk) var_genes <- temp_liger@var.genes @@ -1041,14 +1041,14 @@ Liger_to_Seurat <- function( raw.data <- Merge_Sparse_Data_All(liger_object@raw.data, nms) scale.data <- do.call(rbind, liger_object@scale.data) - rownames(scale.data) <- colnames(raw.data) + rownames(x = scale.data) <- colnames(x = raw.data) if (maj_version < 3) { var.genes <- liger_object@var.genes inmf.obj <- new( Class = "dim.reduction", gene.loadings = t(liger_object@W), cell.embeddings = liger_object@H.norm, key = "iNMF_" ) - rownames(inmf.obj@gene.loadings) <- var.genes + rownames(x = inmf.obj@gene.loadings) <- var.genes tsne.obj <- new( Class = "dim.reduction", cell.embeddings = liger_object@tsne.coords, @@ -1063,10 +1063,10 @@ Liger_to_Seurat <- function( inmf.loadings <- t(x = liger_object@W) inmf.embeddings <- liger_object@H.norm ncol_Hnorm <- ncol(x = liger_object@H.norm) - colnames(inmf.embeddings) <- paste0("iNMF_", 1:ncol_Hnorm) + colnames(x = inmf.embeddings) <- paste0("iNMF_", 1:ncol_Hnorm) tsne.embeddings <- liger_object@tsne.coords - colnames(tsne.embeddings) <- paste0(key_name, 1:2) + colnames(x = tsne.embeddings) <- paste0(key_name, 1:2) rownames(x = inmf.loadings) <- var.genes rownames(x = inmf.embeddings) <- rownames(x = tsne.embeddings) <- @@ -1090,13 +1090,13 @@ Liger_to_Seurat <- function( new.seurat <- NormalizeData(new.seurat) } if (by.dataset) { - ident.use <- as.character(unlist(lapply(1:length(liger_object@raw.data), function(i) { - dataset.name <- names(liger_object@raw.data)[i] - paste0(dataset.name, as.character(liger_object@clusters[colnames(liger_object@raw.data[[i]])])) + ident.use <- as.character(x = unlist(x = lapply(1:length(liger_object@raw.data), function(i) { + dataset.name <- names(x = liger_object@raw.data)[i] + paste0(dataset.name, as.character(x = liger_object@clusters[colnames(liger_object@raw.data[[i]])])) }))) } else { if (maj_version < 3) { - ident.use <- as.character(liger_object@clusters) + ident.use <- as.character(x = liger_object@clusters) } else { ident.use <- liger_object@clusters } @@ -1118,7 +1118,7 @@ Liger_to_Seurat <- function( SetAssayData(new.seurat, slot = "scale.data", t(scale.data), assay = "RNA") new.seurat[[reduction_label]] <- tsne.obj new.seurat[['inmf']] <- inmf.obj - Idents(new.seurat) <- ident.use + Idents(object = new.seurat) <- ident.use } if (keep_meta){ # extract meta data from liger object @@ -1127,12 +1127,12 @@ Liger_to_Seurat <- function( liger_meta <- liger_meta %>% select(-any_of(c("nUMI", "nGene", "dataset"))) # extract meta data names - meta_names <- colnames(liger_meta) + meta_names <- colnames(x = liger_meta) # add meta data to new seurat object for (meta_var in meta_names){ meta_transfer <- liger_meta %>% pull(meta_var) - names(meta_transfer) <- colnames(x = new.seurat) + names(x = meta_transfer) <- colnames(x = new.seurat) new.seurat <- AddMetaData(object = new.seurat, metadata = meta_transfer, col.name = meta_var) diff --git a/R/Nebulosa_Plotting.R b/R/Nebulosa_Plotting.R index 67d60d959..b0b1634c1 100644 --- a/R/Nebulosa_Plotting.R +++ b/R/Nebulosa_Plotting.R @@ -13,6 +13,8 @@ #' "inferno", "plasma"). Default is "magma". #' @param custom_palette non-default color palette to be used in place of default viridis options. #' @param pt.size Adjust point size for plotting. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @param combine Create a single plot? If FALSE, a list with ggplot objects is returned. #' @param ... Extra parameters passed to \code{\link[Nebulosa]{plot_density}}. @@ -43,6 +45,7 @@ Plot_Density_Custom <- function( viridis_palette = "magma", custom_palette = NULL, pt.size = 1, + aspect_ratio = NULL, reduction = NULL, combine = TRUE, ... @@ -85,9 +88,26 @@ Plot_Density_Custom <- function( if (!is.null(x = custom_palette)) { suppressMessages(plot_list <- plot_list & scale_color_gradientn(colors = custom_palette)) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_list <- plot_list & theme(aspect.ratio = aspect_ratio) + } + return(plot_list) } + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_list <- plot_list & theme(aspect.ratio = aspect_ratio) + } + return(plot_list) } @@ -102,6 +122,8 @@ Plot_Density_Custom <- function( #' "inferno", "plasma"). Default is "magma". #' @param custom_palette non-default color palette to be used in place of default viridis options. #' @param pt.size Adjust point size for plotting. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @param ... Extra parameters passed to \code{\link[Nebulosa]{plot_density}}. #' @@ -129,6 +151,7 @@ Plot_Density_Joint_Only <- function( viridis_palette = "magma", custom_palette = NULL, pt.size = 1, + aspect_ratio = NULL, reduction = NULL, ... ) { @@ -180,8 +203,25 @@ Plot_Density_Joint_Only <- function( if (!is.null(x = custom_palette)) { suppressMessages(plot <- plot + scale_color_gradientn(colors = custom_palette)) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index d220e8d21..30a3d15b0 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -375,7 +375,7 @@ Add_CellBender_Diff <- function( #' @param barcodes_colname name of barcodes column in meta_data. Required if `barcodes_to_rownames = TRUE`. #' #' @import cli -#' @importFrom dplyr select +#' @importFrom dplyr select all_of #' @importFrom magrittr "%>%" #' @importFrom tibble column_to_rownames #' @@ -445,7 +445,7 @@ Meta_Remove_Seurat <- function( #' #' @import cli #' @importFrom data.table fread -#' @importFrom dplyr select left_join +#' @importFrom dplyr select left_join all_of #' @importFrom magrittr "%>%" #' @importFrom stats setNames #' @importFrom tibble column_to_rownames rownames_to_column @@ -647,7 +647,7 @@ Extract_Sample_Meta <- function( combined_exclude <- c(nFeature_cols, nCount_cols, "percent_mito", "percent_ribo", "percent_mito_ribo", "log10GenesPerUMI") - variables_exclude <- Meta_Present(seurat_object = object, meta_col_names = combined_exclude, omit_warn = FALSE, print_msg = FALSE, abort = FALSE)[[1]] + variables_exclude <- Meta_Present(seurat_object = object, meta_col_names = combined_exclude, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE)[[1]] } # Ensure include exclude are unique @@ -662,13 +662,13 @@ Extract_Sample_Meta <- function( # Check variables include/exclude are present if (!is.null(x = variables_include)) { - include_meta_list <- Meta_Present(seurat_object = object, meta_col_names = variables_include, omit_warn = FALSE, print_msg = FALSE, abort = FALSE) + include_meta_list <- Meta_Present(seurat_object = object, meta_col_names = variables_include, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) } else { include_meta_list <- NULL } if (!is.null(x = variables_exclude)) { - exclude_meta_list <- Meta_Present(seurat_object = object, meta_col_names = variables_exclude, omit_warn = FALSE, print_msg = FALSE, abort = FALSE) + exclude_meta_list <- Meta_Present(seurat_object = object, meta_col_names = variables_exclude, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) } else { exclude_meta_list <- NULL } @@ -700,7 +700,7 @@ Extract_Sample_Meta <- function( slice(1) # remove rownames - rownames(sample_meta_df) <- NULL + rownames(x = sample_meta_df) <- NULL # Filter data.frame if (include_all) { diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 36a0591f0..172ee68bd 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -126,7 +126,7 @@ kMeans_Elbow <- function( ) { # Calculate the within squares # code from @Ben https://stackoverflow.com/a/15376462/15568251 - wss <- (nrow(data)-1)*sum(apply(data,2,var)) + wss <- (nrow(x = data)-1)*sum(apply(data,2,var)) for (i in 2:k_max) wss[i] <- sum(kmeans(data, centers=i)$withinss) @@ -134,7 +134,7 @@ kMeans_Elbow <- function( plot_data <- data.frame(wss) %>% rownames_to_column("k") - plot_data$k <- as.numeric(plot_data$k) + plot_data$k <- as.numeric(x = plot_data$k) # Plot data plot <- ggplot(data = plot_data, mapping = aes(y = wss, x = .data[["k"]])) + diff --git a/R/QC_Plotting_Seurat.R b/R/QC_Plotting_Seurat.R index a2b6848be..06d77ef4d 100644 --- a/R/QC_Plotting_Seurat.R +++ b/R/QC_Plotting_Seurat.R @@ -14,7 +14,9 @@ #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. -#' @param pt.size Point size for plotting +#' @param pt.size Point size for plotting. +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -50,6 +52,8 @@ QC_Plots_Genes <- function( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -81,6 +85,11 @@ QC_Plots_Genes <- function( plot <- plot + scale_y_log10() } + # plot median + if (plot_median) { + plot <- plot + stat_summary(fun = median, geom='point', size = median_size, colour = "white", shape = 95) + } + return(plot) } @@ -97,7 +106,9 @@ QC_Plots_Genes <- function( #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. -#' @param pt.size Point size for plotting +#' @param pt.size Point size for plotting. +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -133,6 +144,8 @@ QC_Plots_UMIs <- function( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -164,6 +177,11 @@ QC_Plots_UMIs <- function( plot <- plot + scale_y_log10() } + # plot median + if (plot_median) { + plot <- plot + stat_summary(fun = median, geom='point', size = median_size, colour = "white", shape = 95) + } + return(plot) } @@ -182,7 +200,9 @@ QC_Plots_UMIs <- function( #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. -#' @param pt.size Point size for plotting +#' @param pt.size Point size for plotting. +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -219,6 +239,8 @@ QC_Plots_Mito <- function( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -250,6 +272,11 @@ QC_Plots_Mito <- function( plot <- plot + scale_y_log10() } + # plot median + if (plot_median) { + plot <- plot + stat_summary(fun = median, geom='point', size = median_size, colour = "white", shape = 95) + } + return(plot) } @@ -267,7 +294,9 @@ QC_Plots_Mito <- function( #' @param plot_title Plot Title. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. -#' @param pt.size Point size for plotting +#' @param pt.size Point size for plotting. +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -306,6 +335,8 @@ QC_Plots_Feature <- function( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -323,7 +354,7 @@ QC_Plots_Feature <- function( if (is.null(x = plot_title)) { plot_title <- paste0(feature, " per Cell/Nucleus") } - plot <- VlnPlot(object = seurat_object, features = feature, group.by = group.by, pt.size = pt.size, cols = colors_use, ...) + + plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = feature, group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + xlab(x_axis_label) + ylab(y_axis_label) + @@ -340,6 +371,11 @@ QC_Plots_Feature <- function( plot <- plot + scale_y_log10() } + # plot median + if (plot_median) { + plot <- plot + stat_summary(fun = median, geom='point', size = median_size, colour = "white", shape = 95) + } + return(plot) } @@ -358,6 +394,8 @@ QC_Plots_Feature <- function( #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. #' @param pt.size Point size for plotting +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -395,6 +433,8 @@ QC_Plots_Complexity <- function( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -403,7 +443,9 @@ QC_Plots_Complexity <- function( color_seed = 123, ... ) { - QC_Plots_Feature(seurat_object = seurat_object, feature = feature, group.by = group.by, x_axis_label = x_axis_label, y_axis_label = y_axis_label, plot_title = plot_title, low_cutoff = low_cutoff, high_cutoff = high_cutoff, pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + plot <- QC_Plots_Feature(seurat_object = seurat_object, feature = feature, group.by = group.by, x_axis_label = x_axis_label, y_axis_label = y_axis_label, plot_title = plot_title, low_cutoff = low_cutoff, high_cutoff = high_cutoff, pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, median_size = median_size, ...) + + return(plot) } @@ -420,6 +462,8 @@ QC_Plots_Complexity <- function( #' @param mito_name The column name containing percent mitochondrial counts information. Default value is #' "percent_mito" which is default value created when using `Add_Mito_Ribo_Seurat()`. #' @param pt.size Point size for plotting +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param colors_use vector of colors to use for plot. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is TRUE). #' @param y_axis_log logical. Whether to change y axis to log10 scale (Default is FALSE). @@ -456,6 +500,8 @@ QC_Plots_Combined_Vln <- function( mito_cutoffs = NULL, mito_name = "percent_mito", pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -488,11 +534,11 @@ QC_Plots_Combined_Vln <- function( } # Create Individual Plots - feature_plot <- QC_Plots_Genes(seurat_object = seurat_object, group.by = group.by, low_cutoff = feature_cutoffs[1], high_cutoff = feature_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + feature_plot <- QC_Plots_Genes(seurat_object = seurat_object, group.by = group.by, low_cutoff = feature_cutoffs[1], high_cutoff = feature_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, median_size = median_size, ...) - UMI_plot <- QC_Plots_UMIs(seurat_object = seurat_object, group.by = group.by, low_cutoff = UMI_cutoffs[1], high_cutoff = UMI_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + UMI_plot <- QC_Plots_UMIs(seurat_object = seurat_object, group.by = group.by, low_cutoff = UMI_cutoffs[1], high_cutoff = UMI_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, median_size = median_size, ...) - mito_plot <- QC_Plots_Mito(seurat_object = seurat_object, group.by = group.by, mito_name = mito_name, low_cutoff = mito_cutoffs[1], high_cutoff = mito_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + mito_plot <- QC_Plots_Mito(seurat_object = seurat_object, group.by = group.by, mito_name = mito_name, low_cutoff = mito_cutoffs[1], high_cutoff = mito_cutoffs[2], pt.size = pt.size, colors_use = colors_use, x_lab_rotate = x_lab_rotate, y_axis_log = y_axis_log, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, median_size = median_size, ...) # wrap plots plots <- wrap_plots(feature_plot, UMI_plot, mito_plot, ncol = 3) diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index 3c5431ec2..a19e3d50f 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -598,6 +598,7 @@ Read10X_h5_GEO <- function( #' @param secondary_path path from the parent directory to count matrix files for each sample. #' @param default_10X_path logical (default TRUE) sets the secondary path variable to the default 10X #' directory structure. +#' @param cellranger_multi logical, whether samples were processed with Cell Ranger `multi`, default is FALSE. #' @param sample_list a vector of sample directory names if only specific samples are desired. If `NULL` will #' read in subdirectories in parent directory. #' @param sample_names a set of sample names to use for each sample entry in returned list. If `NULL` will @@ -632,6 +633,7 @@ Read10X_Multi_Directory <- function( base_path, secondary_path = NULL, default_10X_path = TRUE, + cellranger_multi = FALSE, sample_list = NULL, sample_names = NULL, parallel = FALSE, @@ -655,8 +657,18 @@ Read10X_Multi_Directory <- function( if (default_10X_path && !is.null(x = secondary_path)) { cli_abort(message = "If {.code default_10X_path = TRUE} then {.code secondary_path} must be NULL.") } + + if (!default_10X_path && !is.null(x = secondary_path) && cellranger_multi) { + cli_abort(message = "If {.code cellranger_multi = TRUE} then {.code default_10X_path} must be TRUE") + } + if (default_10X_path) { - secondary_path <- "outs/filtered_feature_bc_matrix/" + if (cellranger_multi) { + secondary_path <- "/outs/per_sample_outs/" + multi_extra_path <- "count/sample_filtered_feature_bc_matrix" + } else { + secondary_path <- "outs/filtered_feature_bc_matrix/" + } } if (is.null(x = secondary_path)) { secondary_path <- "" @@ -676,7 +688,11 @@ Read10X_Multi_Directory <- function( If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) # *** Here is where the swap of mclapply or pbmclapply is occuring *** raw_data_list <- mclapply(mc.cores = num_cores, 1:length(x = sample_list), function(x) { - file_path <- file.path(base_path, sample_list[x], secondary_path) + if (cellranger_multi) { + file_path <- file.path(base_path, sample_list[x], secondary_path, sample_list[x], multi_extra_path) + } else { + file_path <- file.path(base_path, sample_list[x], secondary_path) + } raw_data <- Read10X(data.dir = file_path, ...) return(raw_data) }) @@ -685,7 +701,11 @@ Read10X_Multi_Directory <- function( if (is.null(x = secondary_path)) { file_path <- file.path(base_path, sample_list[x]) } else { - file_path <- file.path(base_path, sample_list[x], secondary_path) + if (cellranger_multi) { + file_path <- file.path(base_path, sample_list[x], secondary_path, sample_list[x], multi_extra_path) + } else { + file_path <- file.path(base_path, sample_list[x], secondary_path) + } } raw_data <- Read10X(data.dir = file_path, ...) }) @@ -715,11 +735,13 @@ Read10X_Multi_Directory <- function( #' @param secondary_path path from the parent directory to count matrix files for each sample. #' @param default_10X_path logical (default TRUE) sets the secondary path variable to the default 10X #' directory structure. +#' @param cellranger_multi logical, whether samples were processed with Cell Ranger `multi`, default is FALSE. #' @param h5_filename name of h5 file (including .h5 suffix). If all h5 files have same name (i.e. Cell Ranger output) #' then use full file name. By default function uses Cell Ranger name: "filtered_feature_bc_matrix.h5". #' If h5 files have sample specific prefixes (i.e. from Cell Bender) then use only the shared part of file #' name (e.g., "_filtered_out.h5"). -#' @param cell_bender logical (default FALSE). Is the h5 file from cell bender output, needed to set correct file names. +#' @param cell_bender `r lifecycle::badge("deprecated")` CellBender read functions are now independent family of functions. +#' See `Read_CellBender_*` functions. #' @param sample_list a vector of sample directory names if only specific samples are desired. If `NULL` will #' read in subdirectories in parent directory. #' @param sample_names a set of sample names to use for each sample entry in returned list. If `NULL` will @@ -759,8 +781,9 @@ Read10X_h5_Multi_Directory <- function( base_path, secondary_path = NULL, default_10X_path = TRUE, + cellranger_multi = FALSE, h5_filename = "filtered_feature_bc_matrix.h5", - cell_bender = FALSE, + cell_bender = deprecated(), sample_list = NULL, sample_names = NULL, replace_suffix = FALSE, @@ -770,9 +793,14 @@ Read10X_h5_Multi_Directory <- function( merge = FALSE, ... ) { - # Check cell bender or default 10X - if (cell_bender && default_10X_path) { - cli_abort(message = "Both `cell_bender` and `default_10X_path` cannot be simultaneously set to TRUE.") + # Deprecated + if (lifecycle::is_present(cell_bender)) { + lifecycle::deprecate_stop(when = "1.1.2", + what = "Read10X_h5_Multi_Directory(cell_bender)", + with = "Read_CellBender_h5_Multi_Directory()", + details = c("v" = "CellBender read capabilities are now indepdent functions. See `Read_CellBender_h5_Multi_Directory`", + "i" = "Parameter and warning will be fully removed in v1.2.0.") + ) } # Confirm num_cores specified @@ -792,9 +820,20 @@ Read10X_h5_Multi_Directory <- function( if (default_10X_path && !is.null(x = secondary_path)) { cli_abort(message = "If {.code default_10X_path = TRUE} then {.code secondary_path} must be NULL.") } + + if (!default_10X_path && !is.null(x = secondary_path) && cellranger_multi) { + cli_abort(message = "If {.code cellranger_multi = TRUE} then {.code default_10X_path} must be TRUE") + } + if (default_10X_path) { - secondary_path <- "outs/" + if (cellranger_multi) { + secondary_path <- "/outs/per_sample_outs/" + multi_extra_path <- "count/" + } else { + secondary_path <- "outs/" + } } + if (is.null(x = secondary_path)) { secondary_path <- "" } @@ -814,8 +853,8 @@ Read10X_h5_Multi_Directory <- function( If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) # *** Here is where the swap of mclapply or pbmclapply is occuring *** raw_data_list <- mclapply(mc.cores = num_cores, 1:length(x = sample_list), function(x) { - if (cell_bender) { - file_path <- file.path(base_path, sample_list[x], secondary_path, paste0(sample_list[x], h5_filename)) + if (cellranger_multi) { + file_path <- file.path(base_path, sample_list[x], secondary_path, sample_list[x], multi_extra_path, h5_filename) } else { file_path <- file.path(base_path, sample_list[x], secondary_path, h5_filename) } @@ -825,17 +864,13 @@ Read10X_h5_Multi_Directory <- function( } else { raw_data_list <- pblapply(1:length(x = sample_list), function(x) { if (is.null(x = secondary_path)) { - if (cell_bender) { - file_path <- file.path(base_path, sample_list[x], paste0(sample_list[x], h5_filename)) + if (cellranger_multi) { + file_path <- file.path(base_path, sample_list[x], secondary_path, sample_list[x], multi_extra_path, h5_filename) } else { file_path <- file.path(base_path, sample_list[x], h5_filename) } } else { - if (cell_bender) { - file_path <- file.path(base_path, sample_list[x], secondary_path, paste0(sample_list[x], h5_filename)) - } else { - file_path <- file.path(base_path, sample_list[x], secondary_path, h5_filename) - } + file_path <- file.path(base_path, sample_list[x], secondary_path, h5_filename) } raw_data <- Read10X_h5(filename = file_path, ...) }) @@ -1063,6 +1098,10 @@ Read_GEO_Delim <- function( #' @param file_name Path to h5 file. #' @param use.names Label row names with feature names rather than ID numbers (default TRUE). #' @param unique.features Make feature names unique (default TRUE). +#' @param h5_group_name Name of the group within H5 file that contains count data. This is only +#' required if H5 file contains multiple subgroups and non-default names. Default is `NULL`. +#' @param feature_slot_name Name of the slot contain feature names/ids. Must be one of: +#' "features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features". #' #' @return sparse matrix #' @@ -1083,9 +1122,11 @@ Read_GEO_Delim <- function( #' Read_CellBender_h5_Mat <- function( - file_name, - use.names = TRUE, - unique.features = TRUE + file_name, + use.names = TRUE, + unique.features = TRUE, + h5_group_name = NULL, + feature_slot_name = "features" ) { # Check hdf5r installed hdf5r_check <- PackageCheck("hdf5r", error = FALSE) @@ -1101,26 +1142,87 @@ Read_CellBender_h5_Mat <- function( # Check file if (!file.exists(file_name)) { - cli_abort(message = "File: {file_name} not found.") + cli_abort(message = "File: {.val {file_name}} not found.") } - if (use.names) { - feature_slot <- 'features/name' - } else { - feature_slot <- 'features/id' + # Check feature_slot_name is acceptable + if (!feature_slot_name %in% c("features", "genes")) { + cli_abort(message = c("{.code feature_slot_name} must be one of {.val features} or {.val genes}.", + "i" = "If unsure, check contents of H5 file {.code rhdf5::h5ls('{file_name}')}.")) } # Read file infile <- hdf5r::H5File$new(filename = file_name, mode = "r") - counts <- infile[["matrix/data"]] - indices <- infile[["matrix/indices"]] - indptr <- infile[["matrix/indptr"]] - shp <- infile[["matrix/shape"]] - features <- infile[[paste0("matrix/", feature_slot)]][] - barcodes <- infile[["matrix/barcodes"]] + # Get list of H5 contents + h5_dataset_list <- hdf5r::list.datasets(infile) + + # Check feature_slot_name is correct + if (!length(x = grep(pattern = feature_slot_name, x = h5_dataset_list, value = TRUE)) > 0) { + cli::cli_abort(message = c("{.code feature_slot_name}: {.val {feature_slot_name}} not found in H5 file.", + "i" = "Check contents of H5 file {.code rhdf5::h5ls('{file_name}')} to confirm correct {.code feature_slot_name}.")) + } + + # Assign feature slot name + if (feature_slot_name == "features") { + if (use.names) { + feature_slot <- 'features/name' + } + else { + feature_slot <- 'features/id' + } + } + + if (feature_slot_name == "genes") { + if (use.names) { + feature_slot <- 'gene_names' + } + else { + feature_slot <- 'genes' + } + } + # add name check + group_names <- names(x = infile) + if (!is.null(x = h5_group_name) && !h5_group_name %in% group_names) { + cli::cli_abort(message = c("{.code h5_group_name} {.val {h5_group_name}} not found.", + "i" = "Check H5 file group names {.code rhdf5::h5ls('{file_name}')}.")) + } + + # Read in data + if ("matrix" %in% group_names) { + counts <- infile[["matrix/data"]] + indices <- infile[["matrix/indices"]] + indptr <- infile[["matrix/indptr"]] + shp <- infile[["matrix/shape"]] + features <- infile[[paste0("matrix/", feature_slot)]][] + barcodes <- infile[["matrix/barcodes"]] + } else { + if (length(x = group_names) == 1) { + counts <- infile[[paste0(group_names, '/data')]] + indices <- infile[[paste0(group_names, '/indices')]] + indptr <- infile[[paste0(group_names, '/indptr')]] + shp <- infile[[paste0(group_names, '/shape')]] + features <- infile[[paste0(group_names, '/', feature_slot)]][] + barcodes <- infile[[paste0(group_names, '/barcodes')]] + } else { + # check subgroups + if (is.null(x = h5_group_name)) { + cli::cli_abort(message = c("H5 file contains multiple sub-groups.", + "i" = "Please provide {.code h5_group_name} specifying which subgroup contains count data.")) + } else { + counts <- infile[[paste0(h5_group_name, '/data')]] + indices <- infile[[paste0(h5_group_name, '/indices')]] + indptr <- infile[[paste0(h5_group_name, '/indptr')]] + shp <- infile[[paste0(h5_group_name, '/shape')]] + features <- infile[[paste0(h5_group_name, '/', feature_slot)]][] + barcodes <- infile[[paste0(h5_group_name, '/barcodes')]] + } + } + } + + # Create sparse matrix sparse.mat <- sparseMatrix( i = indices[] + 1, p = indptr[], @@ -1157,6 +1259,10 @@ Read_CellBender_h5_Mat <- function( #' read in subdirectories in parent directory. #' @param sample_names a set of sample names to use for each sample entry in returned list. If `NULL` will #' set names to the subdirectory name of each sample. +#' @param h5_group_name Name of the group within H5 file that contains count data. This is only +#' required if H5 file contains multiple subgroups and non-default names. Default is `NULL`. +#' @param feature_slot_name Name of the slot contain feature names/ids. Must be one of: +#' "features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features". #' @param replace_suffix logical (default FALSE). Whether or not to replace the barcode suffixes of matrices #' using \code{\link{Replace_Suffix}}. #' @param new_suffix_list a vector of new suffixes to replace existing suffixes if `replace_suffix = TRUE`. @@ -1193,6 +1299,8 @@ Read_CellBender_h5_Multi_Directory <- function( custom_name = NULL, sample_list = NULL, sample_names = NULL, + h5_group_name = NULL, + feature_slot_name = "features", replace_suffix = FALSE, new_suffix_list = NULL, parallel = FALSE, @@ -1253,7 +1361,7 @@ Read_CellBender_h5_Multi_Directory <- function( file_path <- file.path(base_path, sample_list[x], secondary_path, paste0(sample_list[x], file_suffix)) # read and return data - raw_data <- Read_CellBender_h5_Mat(file_name = file_path, ...) + raw_data <- Read_CellBender_h5_Mat(file_name = file_path, h5_group_name = h5_group_name, feature_slot_name = feature_slot_name, ...) return(raw_data) }) } else { @@ -1262,7 +1370,7 @@ Read_CellBender_h5_Multi_Directory <- function( file_path <- file.path(base_path, sample_list[x], secondary_path, paste0(sample_list[x], file_suffix)) # read and return data - raw_data <- Read_CellBender_h5_Mat(file_name = file_path, ...) + raw_data <- Read_CellBender_h5_Mat(file_name = file_path, h5_group_name = h5_group_name, feature_slot_name = feature_slot_name, ...) return(raw_data) }) } @@ -1313,7 +1421,11 @@ Read_CellBender_h5_Multi_Directory <- function( #' read in all files within `data_dir` directory. #' @param sample_names a set of sample names to use for each sample entry in returned list. If `NULL` will #' set names to the subdirectory name of each sample. -#' @param parallel logical (default FALSE) whether or not to use multi core processing to read in matrices. +#' @param h5_group_name Name of the group within H5 file that contains count data. This is only +#' required if H5 file contains multiple subgroups and non-default names. Default is `NULL`. +#' @param feature_slot_name Name of the slot contain feature names/ids. Must be one of: +#' "features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features". +#' @param parallel logical (default FALSE) whether or not to use multi core processing to read in matrices #' @param num_cores how many cores to use for parallel processing. #' @param merge logical (default FALSE) whether or not to merge samples into a single matrix or return #' list of matrices. If TRUE each sample entry in list will have cell barcode prefix added. The prefix @@ -1344,6 +1456,8 @@ Read_CellBender_h5_Multi_File <- function( custom_name = NULL, sample_list = NULL, sample_names = NULL, + h5_group_name = NULL, + feature_slot_name = "features", parallel = FALSE, num_cores = NULL, merge = FALSE, @@ -1395,12 +1509,12 @@ Read_CellBender_h5_Multi_File <- function( If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) raw_data_list <- mclapply(mc.cores = num_cores, 1:length(sample_list), function(i) { h5_loc <- file.path(data_dir, paste0(sample_list[i], file_suffix)) - data <- Read_CellBender_h5_Mat(file_name = h5_loc, ...) + data <- Read_CellBender_h5_Mat(file_name = h5_loc, h5_group_name = h5_group_name, feature_slot_name = feature_slot_name, ...) }) } else { raw_data_list <- pblapply(1:length(x = sample_list), function(i) { h5_loc <- file.path(data_dir, paste0(sample_list[i], file_suffix)) - data <- Read_CellBender_h5_Mat(file_name = h5_loc, ...) + data <- Read_CellBender_h5_Mat(file_name = h5_loc, h5_group_name = h5_group_name, feature_slot_name = feature_slot_name, ...) }) } diff --git a/R/Seurat_Iterative_Plotting.R b/R/Seurat_Iterative_Plotting.R index 6e3c02244..7b07a6b43 100644 --- a/R/Seurat_Iterative_Plotting.R +++ b/R/Seurat_Iterative_Plotting.R @@ -103,6 +103,7 @@ Iterate_PC_Loading_Plots <- function( #' @param file_type File type to save output as. Must be one of following: ".pdf", ".png", ".tiff", ".jpeg", or ".svg". #' @param single_pdf saves all plots to single PDF file (default = FALSE). `file_type`` must be .pdf #' @param color color scheme to use. +#' @param legend logical, whether or not to include plot legend, default is TRUE. #' @param dpi dpi for image saving. #' @param reduction Dimensionality Reduction to use (default is object default). #' @param dims Dimensions to plot. @@ -139,6 +140,7 @@ Iterate_DimPlot_bySample <- function( single_pdf = FALSE, dpi = 600, color = "black", + legend = TRUE, reduction = NULL, dims = c(1, 2), pt.size = NULL, @@ -195,20 +197,29 @@ Iterate_DimPlot_bySample <- function( max(reduc_coordinates[, 2])) # Extract orig.ident - column_list <- as.character(unique(seurat_object@meta.data$orig.ident)) + column_list <- as.character(x = unique(x = seurat_object@meta.data$orig.ident)) # Create list of cells per sample cells_per_sample <- lapply(column_list, function(sample) { - row.names(seurat_object@meta.data)[which(seurat_object@meta.data$orig.ident == sample)] + row.names(x = seurat_object@meta.data)[which(x = seurat_object@meta.data$orig.ident == sample)] }) # Single PDF option if (single_pdf == TRUE) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pblapply(cells_per_sample,function(cells) {DimPlot(object = seurat_object, cells = cells, group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + - xlim(x_axis) + - ylim(y_axis)}) + all_plots <- pblapply(cells_per_sample,function(cells) { + if (legend) { + DimPlot(object = seurat_object, cells = cells, group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + } else { + DimPlot(object = seurat_object, cells = cells, group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + + NoLegend() + } + }) cli_inform(message = "{.field Saving plots to file}") pdf(paste(file_path, file_name, file_type, sep="")) pb <- txtProgressBar(min = 0, max = length(all_plots), style = 3, file = stderr()) @@ -225,9 +236,16 @@ Iterate_DimPlot_bySample <- function( cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = length(cells_per_sample), style = 3, file = stderr()) for (i in 1:length(cells_per_sample)) { - DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + - xlim(x_axis) + - ylim(y_axis) + if (legend) { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + } else { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + + NoLegend() + } suppressMessages(ggsave(filename = paste(file_path, column_list[[i]], file_name, file_type, sep=""), dpi = dpi)) setTxtProgressBar(pb = pb, value = i) } @@ -238,9 +256,16 @@ Iterate_DimPlot_bySample <- function( cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = length(cells_per_sample), style = 3, file = stderr()) for (i in 1:length(cells_per_sample)) { - DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + - xlim(x_axis) + - ylim(y_axis) + if (legend) { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + } else { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + xlim(x_axis) + + ylim(y_axis) + + NoLegend() + } suppressMessages(ggsave(filename = paste(file_path, column_list[[i]], file_name, file_type, sep=""), useDingbats = FALSE)) setTxtProgressBar(pb = pb, value = i) } @@ -275,7 +300,7 @@ Iterate_DimPlot_bySample <- function( #' @import cli #' @import ggplot2 #' @importFrom grDevices dev.off pdf -#' @importFrom pbapply pbmapply pboptions +#' @importFrom pbapply pblapply pboptions #' @importFrom Seurat DimPlot #' @importFrom SeuratObject DefaultDimReduc #' @importFrom stringr str_detect @@ -294,18 +319,18 @@ Iterate_DimPlot_bySample <- function( #' Iterate_Cluster_Highlight_Plot <- function( - seurat_object, - highlight_color = "navy", - background_color = "lightgray", - pt.size = NULL, - reduction = NULL, - file_path = NULL, - file_name = NULL, - file_type = NULL, - single_pdf = FALSE, - dpi = 600, - raster = NULL, - ... + seurat_object, + highlight_color = "dodgerblue", + background_color = "lightgray", + pt.size = NULL, + reduction = NULL, + file_path = NULL, + file_name = NULL, + file_type = NULL, + single_pdf = FALSE, + dpi = 600, + raster = NULL, + ... ) { # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -343,6 +368,7 @@ Iterate_Cluster_Highlight_Plot <- function( "*" = "Must specify output file type format from the following:", "i" = "{.field {glue_collapse_scCustom(input_string = file_type_options, and = TRUE)}}")) } + if (!file_type %in% file_type_options) { cli_abort(message = "{.code file_type} must be one of the following: {.field {glue_collapse_scCustom(input_string = file_type_options, and = TRUE)}}") } @@ -376,19 +402,16 @@ Iterate_Cluster_Highlight_Plot <- function( if (single_pdf == TRUE) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pbmapply(function(x, arg1) { - cells_to_highlight <- CellsByIdentities(seurat_object, idents = x) - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight, - cols.highlight = arg1, - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) - }, list_idents, highlight_color, SIMPLIFY = FALSE) + all_plots <- pblapply(1:num_idents, function(x) { + suppressMessages(Cluster_Highlight_Plot(seurat_object = seurat_object, + cluster_name = list_idents[x], + highlight_color = highlight_color[x], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) + }) cli_inform(message = "{.field Saving plots to file}") pdf(paste(file_path, file_name, file_type, sep="")) pb <- txtProgressBar(min = 0, max = length(all_plots), style = 3, file = stderr()) @@ -404,18 +427,15 @@ Iterate_Cluster_Highlight_Plot <- function( if (str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) - cells_to_highlight <- CellsByIdentities(seurat_object) - for (i in 1:length(cells_to_highlight)) { - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight[[i]], - cols.highlight = highlight_color[i], - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) + for (i in 1:num_idents) { + suppressMessages(Cluster_Highlight_Plot(seurat_object = seurat_object, + cluster_name = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) suppressMessages(ggsave(filename = paste(file_path, list_idents_save[i], "_", file_name, file_type, sep=""), dpi = dpi)) setTxtProgressBar(pb = pb, value = i) } @@ -425,18 +445,15 @@ Iterate_Cluster_Highlight_Plot <- function( if (str_detect(file_type, ".pdf") == TRUE) { cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) - cells_to_highlight <- CellsByIdentities(seurat_object) - for (i in 1:length(cells_to_highlight)) { - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight[[i]], - cols.highlight = highlight_color[i], - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) + for (i in 1:num_idents) { + suppressMessages(Cluster_Highlight_Plot(seurat_object = seurat_object, + cluster_name = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) suppressMessages(ggsave(filename = paste(file_path, list_idents_save[[i]], "_", file_name, file_type, sep=""), useDingbats = FALSE)) setTxtProgressBar(pb = pb, value = i) } @@ -459,6 +476,9 @@ Iterate_Cluster_Highlight_Plot <- function( #' all clusters/plots or a vector of colors equal to the number of clusters to use (in order) for the clusters/plots. #' @param background_color non-highlighted cell colors. #' @param pt.size point size for both highlighted cluster and background. +#' @param no_legend logical, whether or not to remove plot legend and move to plot title. Default is FALSE. +#' @param title_prefix Value that should be used for plot title prefix if `no_legend = TRUE`. +#' If NULL the value of `meta_data_column` will be used. Default is NULL. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @param file_path directory file path and/or file name prefix. Defaults to current wd. #' @param file_name name suffix to append after sample name. @@ -475,7 +495,7 @@ Iterate_Cluster_Highlight_Plot <- function( #' @import ggplot2 #' @importFrom grDevices dev.off pdf #' @importFrom forcats fct_relevel -#' @importFrom pbapply pbmapply pboptions +#' @importFrom pbapply pblapply pboptions #' @importFrom Seurat DimPlot #' @importFrom SeuratObject DefaultDimReduc #' @importFrom stringr str_detect @@ -501,6 +521,8 @@ Iterate_Meta_Highlight_Plot <- function( highlight_color = "navy", background_color = "lightgray", pt.size = NULL, + no_legend = FALSE, + title_prefix = NULL, reduction = NULL, file_path = NULL, file_name = NULL, @@ -530,7 +552,7 @@ Iterate_Meta_Highlight_Plot <- function( } # Change active ident for plotting - Idents(seurat_object) <- meta_data_column + Idents(object = seurat_object) <- meta_data_column # Set file_path before path check if current dir specified as opposed to leaving set to NULL if (!is.null(x = file_path) && file_path == "") { @@ -577,7 +599,7 @@ Iterate_Meta_Highlight_Plot <- function( # Relevel idents for plotting to sorted order if (single_pdf && is.null(x = new_meta_order) && meta_data_sort) { - Idents(seurat_object) <- fct_relevel(Idents(seurat_object), sort) + Idents(object = seurat_object) <- fct_relevel(Idents(object = seurat_object), sort) } # Relevel idents to custom order @@ -585,7 +607,7 @@ Iterate_Meta_Highlight_Plot <- function( if (length(x = new_meta_order) != length(x = levels(x = seurat_object@active.ident))) { cli_abort(message = c("The length of 'new_meta_order' ({.field {length(x = new_meta_order)}}) does not equal the number of levels in {.code meta_data_column}: {.val {meta_data_column}} ({.field {length(x = levels(x = seurat_object@active.ident))}})")) } - Idents(seurat_object) <- factor(Idents(seurat_object), levels = new_meta_order) + Idents(object = seurat_object) <- factor(Idents(object = seurat_object), levels = new_meta_order) } # Get number of clusters/identities @@ -606,24 +628,56 @@ Iterate_Meta_Highlight_Plot <- function( highlight_color <- highlight_color } } + # Create plot titles if needed. + if (!is.null(x = title_prefix) && !no_legend) { + cli_warn(message = "{.code title_prefix} was omitted as {.code no_legend = FALSE}.") + } + + if (is.null(x = title_prefix) && no_legend) { + plot_title <- lapply(1:num_idents, function(z) { + paste0(meta_data_column, ": ", list_idents[z]) + }) + } else { + plot_title <- lapply(1:num_idents, function(z) { + paste0(title_prefix, ": ", list_idents[z]) + }) + } + + if (!is.null(x = title_prefix) && length(x = title_prefix) != 1 && no_legend) { + cli_abort(message = "{.field `title_prefix`} must be vector of length 1.") + } # Single PDF option if (single_pdf == TRUE) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pbmapply(function(x, arg1) { - cells_to_highlight <- CellsByIdentities(seurat_object, idents = x) - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight, - cols.highlight = arg1, - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) - }, list_idents, highlight_color, SIMPLIFY = FALSE) + all_plots <- pblapply(1:num_idents, function(x) { + if (no_legend) { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[x], + highlight_color = highlight_color[x], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...) + + NoLegend() + + ggtitle(plot_title[x]) + + CenterTitle()) + } else { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[x], + highlight_color = highlight_color[x], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) + } + + }) cli_inform(message = "{.field Saving plots to file}") pdf(paste(file_path, file_name, file_type, sep="")) pb <- txtProgressBar(min = 0, max = length(all_plots), style = 3, file = stderr()) @@ -639,18 +693,32 @@ Iterate_Meta_Highlight_Plot <- function( if (str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) - cells_to_highlight <- CellsByIdentities(seurat_object) - for (i in 1:length(cells_to_highlight)) { - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight[[i]], - cols.highlight = highlight_color[i], - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) + for (i in 1:num_idents) { + if (no_legend) { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...) + + NoLegend() + + ggtitle(plot_title[i]) + + CenterTitle()) + } else { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) + } + suppressMessages(ggsave(filename = paste(file_path, list_idents_save[i], "_", file_name, file_type, sep=""), dpi = dpi)) setTxtProgressBar(pb = pb, value = i) } @@ -660,18 +728,32 @@ Iterate_Meta_Highlight_Plot <- function( if (str_detect(file_type, ".pdf") == TRUE) { cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) - cells_to_highlight <- CellsByIdentities(seurat_object) - for (i in 1:length(cells_to_highlight)) { - suppressMessages(DimPlot(object = seurat_object, - cells.highlight = cells_to_highlight[[i]], - cols.highlight = highlight_color[i], - cols = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - reduction = reduction, - raster = raster, - ...)) + for (i in 1:num_idents) { + if (no_legend) { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...) + + NoLegend() + + ggtitle(plot_title[i]) + + CenterTitle()) + } else { + suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, + meta_data_column = meta_data_column, + meta_data_highlight = list_idents[i], + highlight_color = highlight_color[i], + background_color = background_color, + pt.size = pt.size, + reduction = reduction, + raster = raster, + ...)) + } + suppressMessages(ggsave(filename = paste(file_path, list_idents_save[[i]], "_", file_name, file_type, sep=""), useDingbats = FALSE)) setTxtProgressBar(pb = pb, value = i) } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index fdcc5847b..6e3f95e69 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -22,6 +22,10 @@ #' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). #' Default is c(512, 512). #' @param split.by Variable in `@meta.data` to split the plot by. +#' @param split_collect logical, whether to collect the legends/guides when plotting with `split.by`. +#' Default is TRUE if one value is provided to `features` otherwise is set to FALSE. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param num_columns Number of columns in plot layout. #' @param slot Which slot to pull expression data from? Default is "data". #' @param alpha_exp new alpha level to apply to expressing cell color palette (`colors_use`). Must be @@ -41,6 +45,7 @@ #' @import cli #' @import ggplot2 #' @import patchwork +#' @importFrom methods hasArg #' @importFrom scales alpha #' @importFrom Seurat FeaturePlot #' @importFrom SeuratObject DefaultDimReduc @@ -67,6 +72,8 @@ FeaturePlot_scCustom <- function( raster = NULL, raster.dpi = c(512, 512), split.by = NULL, + split_collect = NULL, + aspect_ratio = NULL, num_columns = NULL, slot = "data", alpha_exp = NULL, @@ -84,6 +91,21 @@ FeaturePlot_scCustom <- function( split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] } + # Set or check split_collect values + if (is.null(x = split_collect)) { + if (length(x = features) == 1) { + split_collect <- TRUE + } else { + split_collect <- FALSE + } + } + + if (!is.null(x = split_collect)) { + if (length(x = features) > 1 && split_collect) { + cli_abort(message = "{.code split_collect} cannot be set to {.field TRUE} if the number of features is greater than 1.") + } + } + # Check features and meta to determine which features present all_found_features <- Feature_PreCheck(object = seurat_object, features = features) @@ -195,7 +217,14 @@ FeaturePlot_scCustom <- function( plot <- plot & theme(legend.title=element_blank()) plot <- suppressMessages(plot + scale_y_continuous(sec.axis = dup_axis(name = all_found_features))) + No_Right() } else { - plot <- plot + plot_layout(nrow = num_rows, ncol = num_columns) + if (split_collect) { + if (hasArg("keep.scale")) { + cli_abort(message = "The parameter {.code keep.scale} cannot be set different from default if {.code split_collect - TRUE}.") + } + plot <- plot + plot_layout(nrow = num_rows, ncol = num_columns, guides = "collect") + } else { + plot <- plot + plot_layout(nrow = num_rows, ncol = num_columns) + } } } @@ -250,6 +279,14 @@ FeaturePlot_scCustom <- function( options(scCustomize_warn_na_cutoff = FALSE) } + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } @@ -267,6 +304,8 @@ FeaturePlot_scCustom <- function( #' @param na_color color to use for points below lower limit. #' @param order whether to move positive cells to the top (default = TRUE). #' @param pt.size Adjust point size for plotting. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @param na_cutoff Value to use as minimum expression cutoff. To set no cutoff set to `NA`. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if @@ -310,6 +349,7 @@ FeaturePlot_DualAssay <- function( na_color = "lightgray", order = TRUE, pt.size = NULL, + aspect_ratio = NULL, reduction = NULL, na_cutoff = 0.000000001, raster = NULL, @@ -358,18 +398,26 @@ FeaturePlot_DualAssay <- function( } # Change assay and plot raw - DefaultAssay(seurat_object) <- assay1 + DefaultAssay(object = seurat_object) <- assay1 plot_raw <- FeaturePlot_scCustom(seurat_object = seurat_object, features = features, slot = slot, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, raster.dpi = raster.dpi, ...) & labs(color = assay1) # Change to cell bender and plot - DefaultAssay(seurat_object) <- assay2 + DefaultAssay(object = seurat_object) <- assay2 plot_cell_bender <- FeaturePlot_scCustom(seurat_object = seurat_object, features = features, slot = slot, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, raster.dpi = raster.dpi, ...) & labs(color = assay2) # Assemble plots & return plots plots <- wrap_plots(plot_raw, plot_cell_bender, ncol = num_columns) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plots <- plots & theme(aspect.ratio = aspect_ratio) + } + return(plots) } @@ -386,6 +434,8 @@ FeaturePlot_DualAssay <- function( #' Use 'ident' to group.by active.ident class. #' @param colors_use color for the points on plot. #' @param pt.size Adjust point size for plotting. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param title_size size for plot title labels. #' @param num_columns number of columns in final layout plot. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if @@ -427,6 +477,7 @@ Split_FeatureScatter <- function( group.by = NULL, colors_use = NULL, pt.size = NULL, + aspect_ratio = NULL, title_size = 15, num_columns = NULL, raster = NULL, @@ -457,7 +508,7 @@ Split_FeatureScatter <- function( num_columns <- split.by_length } # Calculate number of rows for selected number of columns - num_rows <- ceiling(split.by_length/num_columns) + num_rows <- ceiling(x = split.by_length/num_columns) # Check column and row compatibility if (num_columns > split.by_length) { @@ -468,7 +519,7 @@ Split_FeatureScatter <- function( } # Check features are present - possible_features <- c(rownames(seurat_object), colnames(seurat_object@meta.data)) + possible_features <- c(rownames(x = seurat_object), colnames(x = seurat_object@meta.data)) check_features <- setdiff(x = c(feature1, feature2), y = possible_features) if (length(x = check_features) > 0) { cli_abort(message = "The following feature(s) were not present in Seurat object: '{.field {check_features}}'") @@ -491,14 +542,14 @@ Split_FeatureScatter <- function( # Extract split.by list of values if (inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { - meta_sample_list <- as.character(x = levels(seurat_object@meta.data[, split.by])) + meta_sample_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) } else { - meta_sample_list <- as.character(unique(seurat_object@meta.data[, split.by])) + meta_sample_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) } # Extract cell names per meta data list of values cell_names <- lapply(meta_sample_list, function(x) { - row.names(seurat_object@meta.data)[which(seurat_object@meta.data[, split.by] == x)]}) + row.names(x = seurat_object@meta.data)[which(x = seurat_object@meta.data[, split.by] == x)]}) # raster check raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) @@ -559,7 +610,17 @@ Split_FeatureScatter <- function( }) # Wrap Plots into single output - wrap_plots(plots, ncol = num_columns, nrow = num_rows) + plot_layout(guides = 'collect') + plot_comb <- wrap_plots(plots, ncol = num_columns, nrow = num_rows) + plot_layout(guides = 'collect') + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_comb <- plot_comb & theme(aspect.ratio = aspect_ratio) + } + + return(plot_comb) } @@ -641,7 +702,7 @@ VlnPlot_scCustom <- function( pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) # Add raster check for scCustomize - num_cells <- unlist(CellsByIdentities(object = seurat_object, idents = idents)) + num_cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = idents)) if (is.null(x = raster)) { if (pt.size == 0) { @@ -705,7 +766,7 @@ VlnPlot_scCustom <- function( #' Default is 0.15 ("cm"). Spacing dependent on unit provided to `spacing_unit`. #' @param spacing_unit Unit to use in specifying vertical spacing between plots. Default is "cm". #' @param vln_linewidth Adjust the linewidth of violin outline. Must be numeric. -#' @param pt.size Adjust point size for plotting. Default for `StackedVlnPlot` is 0 to avoid issues with +#' @param pt.size Adjust point size for plotting. Default for `Stacked_VlnPlot` is 0 to avoid issues with #' rendering so many points in vector form. Alternatively, see `raster` parameter. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if #' greater than 100,000 total points plotted (# Cells x # of features). @@ -765,7 +826,7 @@ Stacked_VlnPlot <- function( } # Set rasterization - num_cells <- unlist(CellsByIdentities(object = seurat_object, idents = idents)) + num_cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = idents)) if (length(x = num_cells) * length(x = all_found_features) > 100000 && is.null(x = raster) && pt.size != 0) { raster <- TRUE @@ -836,7 +897,7 @@ Stacked_VlnPlot <- function( if (!is.numeric(x = vln_linewidth)) { cli_abort(message = "{.code vln_linewidth} parameter must be numeric.") } - for (j in 1:length(plot_list)) { + for (j in 1:length(x = plot_list)) { plot_return[[j]]$layers[[1]]$aes_params$linewidth <- vln_linewidth } } @@ -961,6 +1022,12 @@ DotPlot_scCustom <- function( #' `feature_km_repeats`. Default is 1000. #' @param column_km_repeats `r lifecycle::badge("deprecated")` soft-deprecated. See `ident_km_repeats` #' @param row_label_size Size of the feature labels. Provided to `row_names_gp` in Heatmap call. +#' @param row_label_fontface Fontface to use for row labels. Provided to `row_names_gp` in Heatmap call. +#' @param cluster_feature logical, whether to cluster and reorder feature axis. Default is TRUE. +#' @param cluster_ident logical, whether to cluster and reorder identity axis. Default is TRUE. +#' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. +#' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. +#' @param legend_title_size Sise of the legend title text labels. Provided to `title_gp` in Heatmap legend call. #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. @@ -1025,6 +1092,12 @@ Clustered_DotPlot <- function( row_km_repeats = deprecated(), column_km_repeats = deprecated(), row_label_size = 8, + row_label_fontface = "plain", + cluster_feature = TRUE, + cluster_ident = TRUE, + column_label_size = 8, + legend_label_size = 10, + legend_title_size = 10, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1073,6 +1146,12 @@ Clustered_DotPlot <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Check acceptable fontface + if (!row_label_fontface %in% c("plain", "bold", "italic", "oblique", "bold.italic")) { + cli_abort(message = c("{.code row_label_face} {.val {row_label_face}} not recognized.", + "i" = "Must be one of {.val plain}, {.val bold}, {.val italic}, {.val olique}, or {.val bold.italic}.")) + } + # Check unique features features_unique <- unique(x = features) @@ -1098,7 +1177,7 @@ Clustered_DotPlot <- function( # Get expression data exp_mat <- data %>% select(-any_of(c("pct.exp", "avg.exp"))) %>% - pivot_wider(names_from = .data[["id"]], values_from = .data[["avg.exp.scaled"]]) %>% + pivot_wider(names_from = any_of("id"), values_from = any_of("avg.exp.scaled")) %>% as.data.frame() row.names(x = exp_mat) <- exp_mat$features.plot @@ -1114,7 +1193,7 @@ Clustered_DotPlot <- function( ) # Extract good features - good_features <- rownames(exp_mat) + good_features <- rownames(x = exp_mat) # Remove rows with NAs exp_mat <- exp_mat %>% @@ -1127,7 +1206,7 @@ Clustered_DotPlot <- function( # Get percent expressed data percent_mat <- data %>% select(-any_of(c("avg.exp", "avg.exp.scaled"))) %>% - pivot_wider(names_from = .data[["id"]], values_from = .data[["pct.exp"]]) %>% + pivot_wider(names_from = any_of("id"), values_from = any_of("pct.exp")) %>% as.data.frame() row.names(x = percent_mat) <- percent_mat$features.plot @@ -1171,14 +1250,14 @@ Clustered_DotPlot <- function( # Modify if class = "colors" if (inherits(x = colors_use_idents, what = "colors")) { - colors_use_idents <- as.vector(colors_use_idents) + colors_use_idents <- as.vector(x = colors_use_idents) } # Pull Annotation and change colors to ComplexHeatmap compatible format - Identity <- colnames(exp_mat) + Identity <- colnames(x = exp_mat) identity_colors <- colors_use_idents - names(identity_colors) <- Identity + names(x = identity_colors) <- Identity identity_colors_list <- list(Identity = identity_colors) # Create identity annotation @@ -1203,7 +1282,7 @@ Clustered_DotPlot <- function( exp_color_middle <- Middle_Number(min = exp_color_min, max = exp_color_max) } - palette_length <- length(colors_use_exp) + palette_length <- length(x = colors_use_exp) palette_middle <- Middle_Number(min = 0, max = palette_length) # Create palette @@ -1269,7 +1348,7 @@ Clustered_DotPlot <- function( # Create legend for point size lgd_list = list( - ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]])), + ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]]), labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), ComplexHeatmap::Legend(labels = c(0.25,0.5,0.75,1), title = "Percent Expressing", graphics = list( function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.25) * unit(2, "mm"), @@ -1279,7 +1358,9 @@ Clustered_DotPlot <- function( function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.75) * unit(2, "mm"), gp = gpar(fill = "black")), function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), - gp = gpar(fill = "black"))) + gp = gpar(fill = "black"))), + labels_gp = gpar(fontsize = legend_label_size), + title_gp = gpar(fontsize = legend_title_size, fontface = "bold") ) ) @@ -1297,62 +1378,74 @@ Clustered_DotPlot <- function( if (raster) { if (flip) { cluster_dot_plot <- ComplexHeatmap::Heatmap(t(exp_mat), - heatmap_legend_param=list(title="Expression"), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), col=col_fun, rect_gp = gpar(type = "none"), layer_fun = layer_fun, - row_names_gp = gpar(fontsize = row_label_size), + row_names_gp = gpar(fontsize = row_label_size, fontface = row_label_fontface), + column_names_gp = gpar(fontsize = column_label_size), column_km = k, row_km_repeats = ident_km_repeats, border = "black", left_annotation = column_ha, column_km_repeats = feature_km_repeats, show_parent_dend_line = show_parent_dend_line, - column_names_rot = x_lab_rotate) + column_names_rot = x_lab_rotate, + cluster_rows = cluster_ident, + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, - heatmap_legend_param=list(title="Expression"), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), col=col_fun, rect_gp = gpar(type = "none"), layer_fun = layer_fun, - row_names_gp = gpar(fontsize = row_label_size), + row_names_gp = gpar(fontsize = row_label_size, fontface = row_label_fontface), + column_names_gp = gpar(fontsize = column_label_size), row_km = k, row_km_repeats = feature_km_repeats, border = "black", top_annotation = column_ha, column_km_repeats = ident_km_repeats, show_parent_dend_line = show_parent_dend_line, - column_names_rot = x_lab_rotate) + column_names_rot = x_lab_rotate, + cluster_rows = cluster_feature, + cluster_columns = cluster_ident) } } else { if (flip) { cluster_dot_plot <- ComplexHeatmap::Heatmap(t(exp_mat), - heatmap_legend_param=list(title="Expression"), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), col=col_fun, rect_gp = gpar(type = "none"), cell_fun = cell_fun_flip, - row_names_gp = gpar(fontsize = row_label_size), + row_names_gp = gpar(fontsize = row_label_size, fontface = row_label_fontface), + column_names_gp = gpar(fontsize = column_label_size), column_km = k, row_km_repeats = ident_km_repeats, border = "black", left_annotation = column_ha, column_km_repeats = feature_km_repeats, show_parent_dend_line = show_parent_dend_line, - column_names_rot = x_lab_rotate) + column_names_rot = x_lab_rotate, + cluster_rows = cluster_ident, + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, - heatmap_legend_param=list(title="Expression"), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), col=col_fun, rect_gp = gpar(type = "none"), cell_fun = cell_fun, - row_names_gp = gpar(fontsize = row_label_size), + row_names_gp = gpar(fontsize = row_label_size, fontface = row_label_fontface), + column_names_gp = gpar(fontsize = column_label_size), row_km = k, row_km_repeats = feature_km_repeats, border = "black", top_annotation = column_ha, column_km_repeats = ident_km_repeats, show_parent_dend_line = show_parent_dend_line, - column_names_rot = x_lab_rotate) + column_names_rot = x_lab_rotate, + cluster_rows = cluster_feature, + cluster_columns = cluster_ident) } } @@ -1379,6 +1472,8 @@ Clustered_DotPlot <- function( #' `scCustomize_Palette()`. #' @param background_color non-highlighted cell colors. #' @param pt.size point size for both highlighted cluster and background. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if #' greater than 200,000 cells. #' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). @@ -1412,6 +1507,7 @@ Cluster_Highlight_Plot <- function( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1477,6 +1573,14 @@ Cluster_Highlight_Plot <- function( # Edit plot legend plot <- suppressMessages(plot & scale_color_manual(breaks = names(cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } @@ -1491,6 +1595,8 @@ Cluster_Highlight_Plot <- function( #' @param highlight_color Color to highlight cells (default "navy"). #' @param background_color non-highlighted cell colors. #' @param pt.size point size for both highlighted cluster and background. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if #' greater than 200,000 cells. #' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). @@ -1529,6 +1635,7 @@ Meta_Highlight_Plot <- function( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1541,7 +1648,7 @@ Meta_Highlight_Plot <- function( Is_Seurat(seurat_object = seurat_object) # Check meta data - good_meta_data_column <- Meta_Present(seurat_object = seurat_object, meta_col_names = meta_data_column, omit_warn = FALSE, print_msg = FALSE, abort = FALSE)[[1]] + good_meta_data_column <- Meta_Present(seurat_object = seurat_object, meta_col_names = meta_data_column, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE)[[1]] # stop if none found if (length(x = good_meta_data_column) == 0) { @@ -1560,7 +1667,7 @@ Meta_Highlight_Plot <- function( } # Check meta_data_highlight - meta_var_list <- as.character(unique(seurat_object@meta.data[, good_meta_data_column])) + meta_var_list <- as.character(x = unique(x = seurat_object@meta.data[, good_meta_data_column])) # Check good and bad highlight values bad_meta_highlight <- meta_var_list[!meta_var_list %in% meta_data_highlight] @@ -1584,7 +1691,7 @@ Meta_Highlight_Plot <- function( raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) # Change default ident and pull cells to highlight in plot - Idents(seurat_object) <- good_meta_data_column + Idents(object = seurat_object) <- good_meta_data_column cells_to_highlight <- CellsByIdentities(seurat_object, idents = found_meta_highlight) @@ -1624,6 +1731,14 @@ Meta_Highlight_Plot <- function( # Update legend and return plot plot <- suppressMessages(plot & scale_color_manual(breaks = names(cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } @@ -1637,6 +1752,8 @@ Meta_Highlight_Plot <- function( #' @param highlight_color Color to highlight cells. #' @param background_color non-highlighted cell colors (default is "lightgray").. #' @param pt.size point size for both highlighted cluster and background. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if #' greater than 200,000 cells. #' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). @@ -1679,6 +1796,7 @@ Cell_Highlight_Plot <- function( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1719,7 +1837,7 @@ Cell_Highlight_Plot <- function( # set point size if (is.null(x = pt.size)) { - pt.size <- AutoPointSize_scCustom(data = sum(lengths(cells_highlight)), raster = raster) + pt.size <- AutoPointSize_scCustom(data = sum(lengths(x = cells_highlight)), raster = raster) } # Check right number of colors provided @@ -1757,6 +1875,14 @@ Cell_Highlight_Plot <- function( # Edit plot legend plot <- suppressMessages(plot & scale_color_manual(breaks = names(cells_highlight), values = c(highlight_color, background_color), na.value = background_color)) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } @@ -1781,6 +1907,8 @@ Cell_Highlight_Plot <- function( #' individual plots in layout. Default is FALSE. #' @param figure_plot logical. Whether to remove the axes and plot with legend on left of plot denoting #' axes labels. (Default is FALSE). Requires `split_seurat = TRUE`. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param shuffle logical. Whether to randomly shuffle the order of points. This can be useful for crowded #' plots if points of interest are being buried. (Default is TRUE). #' @param seed Sets the seed if randomly shuffling the order of points. @@ -1832,6 +1960,7 @@ DimPlot_scCustom <- function( split.by = NULL, split_seurat = FALSE, figure_plot = FALSE, + aspect_ratio = NULL, shuffle = TRUE, seed = 1, label = NULL, @@ -1942,8 +2071,25 @@ DimPlot_scCustom <- function( plot_figure <- plot + axis_plot + plot_layout(design = figure_layout) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_figure <- plot_figure & theme(aspect.ratio = aspect_ratio) + } + return(plot_figure) } else { + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } @@ -1980,8 +2126,25 @@ DimPlot_scCustom <- function( plot_figure <- plot + axis_plot + plot_layout(design = figure_layout) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_figure <- plot_figure & theme(aspect.ratio = aspect_ratio) + } + return(plot_figure) } else { + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + return(plot) } } else { @@ -2003,13 +2166,13 @@ DimPlot_scCustom <- function( # Extract cell names per meta data list of values # Extract split.by list of values if (inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { - split_by_list <- as.character(x = levels(seurat_object@meta.data[, split.by])) + split_by_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) } else { - split_by_list <- as.character(unique(seurat_object@meta.data[, split.by])) + split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) } cell_names <- lapply(split_by_list, function(x) { - row.names(seurat_object@meta.data)[which(seurat_object@meta.data[, split.by] == x)]}) + row.names(x = seurat_object@meta.data)[which(seurat_object@meta.data[, split.by] == x)]}) # Unify colors across plots if (is.null(x = group.by)) { @@ -2020,7 +2183,7 @@ DimPlot_scCustom <- function( colors_overall <- colors_use - names(colors_overall) <- levels_overall + names(x = colors_overall) <- levels_overall # plot plots <- lapply(1:length(x = split_by_list), function(x) { @@ -2043,6 +2206,15 @@ DimPlot_scCustom <- function( # Wrap Plots into single output plots <- wrap_plots(plots, ncol = num_columns) + plot_layout(guides = 'collect') + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plots <- plots & theme(aspect.ratio = aspect_ratio) + } + return(plots) } } @@ -2057,6 +2229,8 @@ DimPlot_scCustom <- function( #' @param meta_data_column Meta data column to split plots by. #' @param colors_use single color to use for all plots or a vector of colors equal to the number of plots. #' @param pt.size Adjust point size for plotting. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. #' @param title_size size for plot title labels. #' @param num_columns number of columns in final layout plot. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). @@ -2092,6 +2266,7 @@ DimPlot_All_Samples <- function( meta_data_column = "orig.ident", colors_use = "black", pt.size = NULL, + aspect_ratio = NULL, title_size = 15, num_columns = NULL, reduction = NULL, @@ -2127,12 +2302,12 @@ DimPlot_All_Samples <- function( if (inherits(x = seurat_object@meta.data[, meta_data_column], what = "factor")) { meta_sample_list <- levels(x = seurat_object@meta.data[, meta_data_column]) } else { - meta_sample_list <- as.character(unique(seurat_object@meta.data[, meta_data_column])) + meta_sample_list <- as.character(x = unique(x = seurat_object@meta.data[, meta_data_column])) } # Extract cell names per meta data list of values cell_names <- lapply(meta_sample_list, function(x) { - row.names(seurat_object@meta.data)[which(seurat_object@meta.data[, meta_data_column] == x)]}) + row.names(x = seurat_object@meta.data)[which(seurat_object@meta.data[, meta_data_column] == x)]}) # Set uniform point size is pt.size = NULL (based on plot with most cells) if (is.null(x = pt.size)) { @@ -2166,7 +2341,17 @@ DimPlot_All_Samples <- function( }) # Wrap Plots into single output - wrap_plots(plots, ncol = num_columns) + plot_comb <- wrap_plots(plots, ncol = num_columns) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot_comb <- plot_comb & theme(aspect.ratio = aspect_ratio) + } + + return(plot_comb) } diff --git a/R/Statistics.R b/R/Statistics.R index a13eb9bca..8f1a26bee 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -6,7 +6,7 @@ #' @param group_by_var meta data column to classify samples (default = "orig.ident"). #' #' @import cli -#' @importFrom dplyr left_join rename +#' @importFrom dplyr left_join rename all_of #' @importFrom janitor adorn_totals #' @importFrom magrittr "%>%" #' @importFrom tibble rownames_to_column column_to_rownames @@ -32,7 +32,7 @@ Cluster_Stats_All_Samples <- function( Is_Seurat(seurat_object = seurat_object) # Check on meta data column - possible_meta_col <- colnames(seurat_object@meta.data) + possible_meta_col <- colnames(x = seurat_object@meta.data) if (!group_by_var %in% possible_meta_col) { cli_abort(message = "{.val {group_by_var}} was not found in meta.data slot of Seurat Object.") } @@ -40,12 +40,12 @@ Cluster_Stats_All_Samples <- function( # Extract total percents total_percent <- prop.table(x = table(seurat_object@active.ident)) * 100 total_percent <- data.frame(total_percent) %>% - rename(Cluster = .data[["Var1"]]) + rename(Cluster = all_of("Var1")) # Extract total cell number per cluster across all samples total_cells <- table(seurat_object@active.ident) %>% data.frame() %>% - rename(Cluster = .data[["Var1"]], Number = .data[["Freq"]]) + rename(Cluster = all_of("Var1"), Number = all_of("Freq")) # Cluster overall stats across all animals cluster_stats <- suppressMessages(left_join(total_cells, total_percent)) @@ -53,7 +53,7 @@ Cluster_Stats_All_Samples <- function( # Extract cells per metadata column per cluster cells_per_cluster_2 <- table(seurat_object@active.ident, seurat_object@meta.data[, group_by_var]) cells_per_cluster_2 <- data.frame(cells_per_cluster_2) %>% - rename(Cluster = .data[["Var1"]], group_by_var = .data[["Var2"]], cell_number = .data[["Freq"]]) + rename(Cluster = all_of("Var1"), group_by_var = all_of("Var2"), cell_number = all_of("Freq")) cells_per_cluster_2 <- cells_per_cluster_2 %>% pivot_wider(names_from = group_by_var, values_from = .data[["cell_number"]]) @@ -64,7 +64,7 @@ Cluster_Stats_All_Samples <- function( # Calculate and extract percents of cells per cluster per percent_per_cluster_2 <- prop.table(x = table(seurat_object@active.ident, seurat_object@meta.data[, group_by_var]), margin = 2) * 100 percent_per_cluster_2 <- data.frame(percent_per_cluster_2) %>% - rename(cluster = .data[["Var1"]], group_by_var = .data[["Var2"]], percent = .data[["Freq"]]) + rename(cluster = all_of("Var1"), group_by_var = all_of("Var2"), percent = all_of("Freq")) percent_per_cluster_2 <- percent_per_cluster_2 %>% pivot_wider(names_from = group_by_var, values_from = .data[["percent"]]) %>% column_to_rownames("cluster") @@ -132,7 +132,7 @@ Percent_Expressing <- function( # Check group_by is in object if (!is.null(x = group_by)) { - possible_groups <- colnames(seurat_object@meta.data) + possible_groups <- colnames(x = seurat_object@meta.data) if (!group_by %in% possible_groups) { cli_abort("Grouping variable {.val {group_by}} was not found in Seurat Object.") } @@ -140,7 +140,7 @@ Percent_Expressing <- function( # Check split_by is in object if (!is.null(x = split_by)) { - possible_groups <- colnames(seurat_object@meta.data) + possible_groups <- colnames(x = seurat_object@meta.data) if (!split_by %in% possible_groups) { cli_abort("Splitting variable {.val {split_by}} was not found in Seurat Object.") } @@ -187,7 +187,7 @@ Percent_Expressing <- function( # Convert & return data.frame row_dim_names <- features_list - col_dim_names <- names(percent_expressing) + col_dim_names <- names(x = percent_expressing) mat_dims <- list(row_dim_names, col_dim_names) final_df <- data.frame(matrix(unlist(percent_expressing), nrow = length(features_list), byrow = FALSE, dimnames = mat_dims), stringsAsFactors = FALSE) return(final_df) @@ -207,7 +207,7 @@ Percent_Expressing <- function( #' #' @return A data.frame. #' -#' @importFrom dplyr group_by one_of select_at summarise_at +#' @importFrom dplyr group_by select summarise any_of across #' @importFrom magrittr "%>%" #' @importFrom stats median #' @@ -246,7 +246,7 @@ Median_Stats <- function( # Filter meta data for columns of interest meta_numeric_check <- Fetch_Meta(object = seurat_object) %>% - select_at(all_variables) + select(any_of(all_variables)) all_variables <- Meta_Numeric(data = meta_numeric_check) @@ -258,15 +258,15 @@ Median_Stats <- function( median_by_group <- meta_data %>% group_by(.data[[group_by_var]]) %>% - summarise_at(vars(one_of(all_variables)), median) + summarise(across(all_variables, median)) # Calculate overall medians median_overall <- meta_data %>% - summarise_at(vars(one_of(all_variables)), median) + summarise(across(all_variables, median)) # Create data.frame with group_by_var as column name meta_col_name_df <- data.frame(col_name = "Totals (All Cells)") - colnames(meta_col_name_df) <- group_by_var + colnames(x = meta_col_name_df) <- group_by_var # Merge with overall median data.frame median_overall <- cbind(meta_col_name_df, median_overall) @@ -274,7 +274,7 @@ Median_Stats <- function( median_all <- rbind(median_by_group, median_overall) # Rename columns and return data.frame - colnames(median_all) <- all_variable_col_names + colnames(x = median_all) <- all_variable_col_names return(median_all) } @@ -331,7 +331,7 @@ CellBender_Feature_Diff <- function( data.frame() %>% rownames_to_column("Feature_Names") - colnames(raw_counts)[2] <- "Raw_Counts" + colnames(x = raw_counts)[2] <- "Raw_Counts" # Pull Cell Bender Counts cb_counts <- pluck(seurat_object, "assays", cell_bender_assay, "counts") %>% @@ -339,7 +339,7 @@ CellBender_Feature_Diff <- function( data.frame() %>% rownames_to_column("Feature_Names") - colnames(cb_counts)[2] <- "CellBender_Counts" + colnames(x = cb_counts)[2] <- "CellBender_Counts" # Check features identical diff_features <- symdiff(x = raw_counts$Feature_Names, y = cb_counts$Feature_Names) diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index 2966f1e79..ed2535948 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -6,6 +6,7 @@ #' @param sample_col Specify which column in meta.data specifies sample ID (i.e. orig.ident). #' @param group_by Column in meta.data slot to group results by (i.e. "Treatment"). #' @param colors_use List of colors or color palette to use. Only applicable if `group_by` is not NULL. +#' @param dot_size size of the dots plotted if `group_by` is not NULL. Default is 1. #' @param plot_title Plot title. #' @param y_axis_label Label for y axis. #' @param x_axis_label Label for x axis. @@ -18,7 +19,7 @@ #' #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom dplyr n select slice left_join +#' @importFrom dplyr n select slice left_join any_of #' @importFrom magrittr "%>%" #' #' @export @@ -39,6 +40,7 @@ Plot_Median_Genes <- function( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median Genes/Cell per Sample", y_axis_label = "Median Genes", x_axis_label = NULL, @@ -64,18 +66,18 @@ Plot_Median_Genes <- function( if (!is.null(x = group_by)) { meta <- meta %>% - select(.data[[sample_col]], .data[[group_by]]) + select(any_of(c(sample_col, group_by))) } else { meta <- meta %>% - select(.data[[sample_col]]) + select(any_of(sample_col)) } meta[[sample_col]] <- factor(meta[[sample_col]], ordered = FALSE) - meta <- data.frame(meta[!duplicated(meta[,sample_col]),]) + meta <- data.frame(meta[!duplicated(x = meta[,sample_col]),]) if (is.null(x = group_by)) { - colnames(meta) <- sample_col + colnames(x = meta) <- sample_col } merged <- suppressMessages(left_join(medians, meta)) @@ -108,7 +110,7 @@ Plot_Median_Genes <- function( } else { plot <- ggplot(data = merged, mapping = aes(x = .data[[group_by]], y = .data[["Median_nFeature_RNA"]], fill = .data[[group_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + scale_fill_manual(values = colors_use) + theme_ggprism_mod() + ggtitle(plot_title) + @@ -142,6 +144,7 @@ Plot_Median_Genes <- function( #' @param sample_col Specify which column in meta.data specifies sample ID (i.e. orig.ident). #' @param group_by Column in meta.data slot to group results by (i.e. "Treatment"). #' @param colors_use List of colors or color palette to use. Only applicable if `group_by` is not NULL. +#' @param dot_size size of the dots plotted if `group_by` is not NULL. Default is 1. #' @param plot_title Plot title. #' @param y_axis_label Label for y axis. #' @param x_axis_label Label for x axis. @@ -154,7 +157,7 @@ Plot_Median_Genes <- function( #' #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom dplyr n select slice left_join +#' @importFrom dplyr n select slice left_join any_of #' @importFrom magrittr "%>%" #' #' @export @@ -175,6 +178,7 @@ Plot_Median_UMIs <- function( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median UMIs/Cell per Sample", y_axis_label = "Median UMIs", x_axis_label = NULL, @@ -200,10 +204,10 @@ Plot_Median_UMIs <- function( if (!is.null(x = group_by)) { meta <- meta %>% - select(.data[[sample_col]], .data[[group_by]]) + select(any_of(c(sample_col, group_by))) } else { meta <- meta %>% - select(.data[[sample_col]]) + select(any_of(sample_col)) } meta[[sample_col]] <- factor(meta[[sample_col]], ordered = FALSE) @@ -211,7 +215,7 @@ Plot_Median_UMIs <- function( meta <- data.frame(meta[!duplicated(meta[,sample_col]),]) if (is.null(x = group_by)) { - colnames(meta) <- sample_col + colnames(x = meta) <- sample_col } merged <- suppressMessages(left_join(medians, meta)) @@ -244,7 +248,7 @@ Plot_Median_UMIs <- function( } else { plot <- ggplot(data = merged, mapping = aes(x = .data[[group_by]], y = .data[["Median_nCount_RNA"]], fill = .data[[group_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + scale_fill_manual(values = colors_use) + theme_ggprism_mod() + ggtitle(plot_title) + @@ -278,6 +282,7 @@ Plot_Median_UMIs <- function( #' @param sample_col Specify which column in meta.data specifies sample ID (i.e. orig.ident). #' @param group_by Column in meta.data slot to group results by (i.e. "Treatment"). #' @param colors_use List of colors or color palette to use. Only applicable if `group_by` is not NULL. +#' @param dot_size size of the dots plotted if `group_by` is not NULL. Default is 1. #' @param plot_title Plot title. #' @param y_axis_label Label for y axis. #' @param x_axis_label Label for x axis. @@ -290,7 +295,7 @@ Plot_Median_UMIs <- function( #' #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom dplyr n select slice left_join +#' @importFrom dplyr n select slice left_join any_of #' @importFrom magrittr "%>%" #' #' @export @@ -312,6 +317,7 @@ Plot_Median_Mito <- function( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median % Mito per Sample", y_axis_label = "Percent Mitochondrial Reads", x_axis_label = NULL, @@ -337,10 +343,10 @@ Plot_Median_Mito <- function( if (!is.null(x = group_by)) { meta <- meta %>% - select(.data[[sample_col]], .data[[group_by]]) + select(any_of(c(sample_col, group_by))) } else { meta <- meta %>% - select(.data[[sample_col]]) + select(any_of(sample_col)) } meta[[sample_col]] <- factor(meta[[sample_col]], ordered = FALSE) @@ -348,7 +354,7 @@ Plot_Median_Mito <- function( meta <- data.frame(meta[!duplicated(meta[,sample_col]),]) if (is.null(x = group_by)) { - colnames(meta) <- sample_col + colnames(x = meta) <- sample_col } merged <- suppressMessages(left_join(medians, meta)) @@ -381,7 +387,7 @@ Plot_Median_Mito <- function( } else { plot <- ggplot(data = merged, mapping = aes(x = .data[[group_by]], y = .data[["Median_percent_mito"]], fill = .data[[group_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + scale_fill_manual(values = colors_use) + theme_ggprism_mod() + ggtitle(plot_title) + @@ -416,6 +422,7 @@ Plot_Median_Mito <- function( #' @param sample_col Specify which column in meta.data specifies sample ID (i.e. orig.ident). #' @param group_by Column in meta.data slot to group results by (i.e. "Treatment"). #' @param colors_use List of colors or color palette to use. Only applicable if `group_by` is not NULL. +#' @param dot_size size of the dots plotted if `group_by` is not NULL. Default is 1. #' @param plot_title Plot title. #' @param y_axis_label Label for y axis. #' @param x_axis_label Label for x axis. @@ -428,7 +435,7 @@ Plot_Median_Mito <- function( #' #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom dplyr n select slice left_join +#' @importFrom dplyr n select slice left_join any_of #' @importFrom magrittr "%>%" #' #' @export @@ -455,6 +462,7 @@ Plot_Median_Other <- function( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = NULL, y_axis_label = NULL, x_axis_label = NULL, @@ -489,10 +497,10 @@ Plot_Median_Other <- function( if (!is.null(x = group_by)) { meta <- meta %>% - select(.data[[sample_col]], .data[[group_by]]) + select(any_of(c(sample_col, group_by))) } else { meta <- meta %>% - select(.data[[sample_col]]) + select(any_of(sample_col)) } meta[[sample_col]] <- factor(meta[[sample_col]], ordered = FALSE) @@ -500,7 +508,7 @@ Plot_Median_Other <- function( meta <- data.frame(meta[!duplicated(meta[,sample_col]),]) if (is.null(x = group_by)) { - colnames(meta) <- sample_col + colnames(x = meta) <- sample_col } merged <- suppressMessages(left_join(medians, meta)) @@ -533,7 +541,7 @@ Plot_Median_Other <- function( } else { plot <- ggplot(data = merged, mapping = aes(x = .data[[group_by]], y = .data[[paste0("Median_", median_var)]], fill = .data[[group_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + scale_fill_manual(values = colors_use) + theme_ggprism_mod() + ggtitle(plot_title) + @@ -567,6 +575,7 @@ Plot_Median_Other <- function( #' @param sample_col Specify which column in meta.data specifies sample ID (i.e. orig.ident). #' @param group_by Column in meta.data slot to group results by (i.e. "Treatment"). #' @param colors_use List of colors or color palette to use. +#' @param dot_size size of the dots plotted if `group_by` is not NULL. Default is 1. #' @param plot_title Plot title. #' @param y_axis_label Label for y axis. #' @param x_axis_label Label for x axis. @@ -598,6 +607,7 @@ Plot_Cells_per_Sample <- function( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Cells/Nuclei per Sample", y_axis_label = "Number of Cells", x_axis_label = NULL, @@ -622,7 +632,7 @@ Plot_Cells_per_Sample <- function( # Calculate total cells and merge with meta.data total_cells <- table(seurat_object@meta.data[[sample_col]]) %>% data.frame() %>% - rename(!!sample_col := .data[["Var1"]], Number_of_Cells = .data[["Freq"]]) + rename(!!sample_col := all_of("Var1"), Number_of_Cells = all_of("Freq")) meta <- Fetch_Meta(object = seurat_object) @@ -652,7 +662,7 @@ Plot_Cells_per_Sample <- function( # Generate base plot plot <- ggplot(data = merged, mapping = aes(x = .data[[group_by]], y = .data[["Number_of_Cells"]], fill = .data[[group_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + scale_fill_manual(values = colors_use) + theme_ggprism_mod() + ggtitle(plot_title) + diff --git a/R/Utilities.R b/R/Utilities.R index d7274c9b8..08c8a509f 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -59,7 +59,7 @@ Gene_Present <- function( possible_features <- rownames(x = GetAssayData(object = data, assay = assay)) } else if ((class(x = data)[[1]] == "liger")) { # get complete gene list - length_liger <- length(data@raw.data) + length_liger <- length(x = data@raw.data) list_genes <- lapply(1:length_liger, function(x){ rownames(x = data@raw.data[[x]]) @@ -216,7 +216,8 @@ Case_Check <- function( #' @param meta_col_names vector of column names to check. #' @param print_msg logical. Whether message should be printed if all features are found. Default is TRUE. #' @param omit_warn logical. Whether to print message about features that are not found in current object. Default is TRUE. -#' @param abort logical. Whether or not to stop function and print stop message if no input `meta_col_names` are found. Default is TRUE. +#' @param return_none logical. Whether list of found vs. bad features should still be returned if no +#' `meta_col_names` are found. Default is FALSE. #' #' @return vector of meta data columns that are present #' @@ -237,7 +238,7 @@ Meta_Present <- function( meta_col_names, print_msg = TRUE, omit_warn = TRUE, - abort = TRUE + return_none = FALSE ) { # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -250,7 +251,7 @@ Meta_Present <- function( bad_meta <- meta_col_names[!meta_col_names %in% possible_features] found_meta <- meta_col_names[meta_col_names %in% possible_features] - if (abort) { + if (!return_none) { if (length(x = found_meta) < 1) { cli_abort(message = c("No meta data columns found.", "i" = "The following @meta.data columns were not found: {.field {glue_collapse_scCustom(input_string = bad_meta, and = TRUE)}}") @@ -319,7 +320,7 @@ Meta_Numeric <- function( is.numeric(x = data[[x]]) })) - colnames(all_numeric) <- "Is_Numeric" + colnames(x = all_numeric) <- "Is_Numeric" # Pull results into vectors invalid_variables <- all_numeric %>% @@ -343,6 +344,109 @@ Meta_Numeric <- function( } +#' Check if reduction loadings are present +#' +#' Check if reduction loadings are present in object and return vector of found loading names. Return +#' warning messages for genes not found. +#' +#' @param seurat_object object name. +#' @param reduction_names vector of genes to check. +#' @param print_msg logical. Whether message should be printed if all features are found. Default is TRUE. +#' @param omit_warn logical. Whether to print message about features that are not found in current object. +#' Default is TRUE. +#' @param return_none logical. Whether list of found vs. bad features should still be returned if no +#' features are found. Default is FALSE. +#' +#' @importFrom purrr reduce +#' @importFrom stringr str_to_upper str_to_sentence +#' +#' @return A list of length 3 containing 1) found features, 2) not found features. +#' +#' @export +#' +#' @concept helper_util +#' +#' @examples +#' \dontrun{ +#' reductions <- Reduction_Loading_Present(seurat_object = obj_name, reduction_name = "PC_1") +#' found_features <- features[[1]] +#' } +#' + +Reduction_Loading_Present <- function( + seurat_object, + reduction_names, + print_msg = TRUE, + omit_warn = TRUE, + return_none = FALSE +) { + # If no reductions are present + if (length(x = seurat_object@reductions) == 0) { + if (return_none) { + # Combine into list and return + feature_list <- list( + found_features = NULL, + bad_features = NULL + ) + return(feature_list) + } else { + cli_abort(message ="No requested features found.") + } + } + + # Get all reduction names + possible_reduction_names <- unlist(x = lapply(1:length(seurat_object@reductions), function(z) { + names <- names(x = seurat_object@reductions[[z]]) + }) + ) + + # If any features not found + if (any(!reduction_names %in% possible_reduction_names)) { + bad_features <- reduction_names[!reduction_names %in% possible_reduction_names] + found_features <- reduction_names[reduction_names %in% possible_reduction_names] + if (length(x = found_features) == 0) { + if (return_none) { + # Combine into list and return + feature_list <- list( + found_features = NULL, + bad_features = bad_features + ) + return(feature_list) + } else { + cli_abort(message ="No requested features found.") + } + } + + # Return message of features not found + if (length(x = bad_features) > 0 && omit_warn) { + cli_warn(message = c("The following features were omitted as they were not found:", + "i" = "{.field {glue_collapse_scCustom(input_string = bad_features, and = TRUE)}}") + ) + } + + # Combine into list and return + feature_list <- list( + found_features = found_features, + bad_features = bad_features + ) + return(feature_list) + } + + # Print all found message if TRUE + if (print_msg) { + cli_inform(message = "All features present.") + } + + # Return full input gene list. + # Combine into list and return + feature_list <- list( + found_features = reduction_names, + bad_features = NULL + ) + return(feature_list) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### DATA ACCESS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -425,6 +529,7 @@ Fetch_Meta.liger <- function( #' \url{https://github.com/welch-lab/liger/blob/master/R/utilities.R} (License: GPL-3). #' Function was modified for use in scCustomize (add progress bar, prefix vs. suffix, and delimiter options). #' +#' @import cli #' @import Matrix #' @importFrom dplyr intersect #' @importFrom magrittr "%>%" @@ -470,14 +575,14 @@ Merge_Sparse_Data_All <- function( if (!is.null(x = add_cell_ids)) { # check barcodes will be unique after adding prefixes/suffixes all_names <- lapply(1:length(x = matrix_list), function(i){ - cell_names <- colnames(matrix_list[[i]]) + cell_names <- colnames(x = matrix_list[[i]]) }) new_names <- lapply(X = 1:length(x = matrix_list), function(x){ - colnames(matrix_list[[x]]) <- paste0(add_cell_ids[x], cell_id_delimiter, colnames(matrix_list[[x]])) + colnames(x = matrix_list[[x]]) <- paste0(add_cell_ids[x], cell_id_delimiter, colnames(matrix_list[[x]])) }) - are_duplicates <- unlist(new_names) %>% + are_duplicates <- unlist(x = new_names) %>% duplicated() %>% any() @@ -491,11 +596,11 @@ Merge_Sparse_Data_All <- function( # Use summary to convert the sparse matrices into three-column indexes where i are the # row numbers, j are the column numbers, and x are the nonzero entries col_offset <- 0 - allGenes <- unique(unlist(lapply(matrix_list, rownames))) + allGenes <- unique(x = unlist(x = lapply(matrix_list, rownames))) allCells <- c() cli_inform(message = "{.field Preparing & merging matrices.}") pb <- txtProgressBar(min = 0, max = length(x = matrix_list), style = 3, file = stderr()) - for (i in 1:length(matrix_list)) { + for (i in 1:length(x = matrix_list)) { curr <- matrix_list[[i]] curr_s <- summary(curr) @@ -511,13 +616,13 @@ Merge_Sparse_Data_All <- function( cellnames <- paste0(colnames(curr), cell_id_delimiter, add_cell_ids [i]) } } else { - cellnames <- colnames(curr) + cellnames <- colnames(x = curr) } allCells <- c(allCells, cellnames) # Next, change the row (gene) indexes so that they index on the union of the gene sets, # so that proper merging can occur. - idx <- match(rownames(curr), allGenes) + idx <- match(x = rownames(x = curr), allGenes) newgenescurr <- idx[curr_s[, 1]] curr_s[, 1] <- newgenescurr @@ -549,6 +654,105 @@ Merge_Sparse_Data_All <- function( } +#' Extract multi-modal data into list by modality +#' +#' Reorganize multi-modal data after import with `Read10X()` or scCustomize read functions. +#' Organizes sub-lists by data modality instead of by sample. +#' +#' @param matrix_list list of matrices to split by modality +#' +#' @return list of lists, with one sublist per data modality. Sub-list contain 1 matrix entry per sample +#' +#' @import cli +#' +#' @export +#' +#' @concept helper_util +#' +#' @examples +#' \dontrun{ +#' multi_mat <- Read10X(...) +#' new_multi_mat <- Extract_Modality(matrix_list = multi_mat) +#' } +#' + +Extract_Modality <- function( + matrix_list +) { + modality_names <- names(x = matrix_list[[1]]) + + unlist_mat <- unlist(x = matrix_list) + + index_list <- lapply(1:length(x = modality_names), function(x) { + modality_index <- grep(x = names(x = unlist_mat), pattern = modality_names[x]) + }) + + split_list <- lapply(1:length(x = modality_names), function(i) { + modality_list <- unlist_mat[index_list[[i]]] + sample_name <- gsub(pattern = paste0("_.", modality_names[i]), x = names(x = modality_list), replacement = "") + names(x = modality_list) <- sample_name + return(modality_list) + }) + + names(split_list) <- modality_names + return(split_list) +} + + +#' Merge a list of Sparse Matrices contain multi-modal data. +#' +#' Enables easy merge of a list of sparse matrices for multi-modal data. +#' +#' @param matrix_list list of matrices to merge. +#' @param add_cell_ids a vector of sample ids to add as prefix to cell barcode during merge. +#' @param prefix logical. Whether `add_cell_ids` should be added as prefix to current cell barcodes/names +#' or as suffix to current cell barcodes/names. Default is TRUE, add as prefix. +#' @param cell_id_delimiter The delimiter to use when adding cell id prefix/suffix. Default is "_". +#' +#' @import cli +#' +#' @return A list containing one sparse matrix for each modality +#' +#' @export +#' +#' @concept helper_util +#' +#' @examples +#' \dontrun{ +#' data_list <- Read10X_GEO(...) +#' merged_list <- Merge_Sparse_Multimodal_All(matrix_list = data_list, add_cell_ids = names(data_list), +#' prefix = TRUE, cell_id_delimiter = "_") +#' } +#' + +Merge_Sparse_Multimodal_All <- function( + matrix_list, + add_cell_ids = NULL, + prefix = TRUE, + cell_id_delimiter = "_" +) { + # Check matrix_list is list of lists + if (!inherits(x = matrix_list[[1]], what = "list")) { + cli_abort(message = "{.code matrix_list} is not multimodal, please use {.field Merge_Sparse_Data_All}.") + } + + # Extract matrices + mat_list <- Extract_Modality(matrix_list = matrix_list) + + # Merge and return + modality_names <- names(x = mat_list) + + merged_list <- lapply(1:length(x = modality_names), function(x) { + cli_inform(message = "Merging {.val {modality_names[x]}} matrices.") + merged <- Merge_Sparse_Data_All(matrix_list = mat_list[[x]], add_cell_ids = add_cell_ids, prefix = prefix, cell_id_delimiter = cell_id_delimiter) + }) + + names(x = merged_list) <- modality_names + + return(merged_list) +} + + #' Check Matrix Validity #' #' Native implementation of SeuratObjects CheckMatrix but with modified warning messages. @@ -756,7 +960,7 @@ Replace_Suffix <- function( return(data_single) }) # Add names back to output - names(data_mod) <- names(data) + names(x = data_mod) <- names(x = data) return(data_mod) } else { @@ -834,7 +1038,7 @@ Change_Delim_Suffix <- function( return(data_single) }) # Add names back to output - names(data_mod) <- names(data) + names(x = data_mod) <- names(x = data) return(data_mod) } else { # for data.frames and individual matrices @@ -912,7 +1116,7 @@ Change_Delim_Prefix <- function( return(data_single) }) # Add names back to output - names(data_mod) <- names(data) + names(x = data_mod) <- names(x = data) return(data_mod) } else { # for data.frames and individual matrices @@ -988,7 +1192,7 @@ Change_Delim_All <- function( return(data_single) }) # Add names back to output - names(data_mod) <- names(data) + names(x = data_mod) <- names(x = data) return(data_mod) } else { # for data.frames and individual matrices @@ -1360,7 +1564,7 @@ Pull_Cluster_Annotation <- function( } # Create list elements per cluster - cell_type_list <- unique(annotation_table[[cell_type_col]]) + cell_type_list <- unique(x = annotation_table[[cell_type_col]]) cluster_annotation_list <- lapply(c(1:length(cell_type_list)), function(x){ cluster <- annotation_table %>% filter(.data[[cell_type_col]] == cell_type_list[x]) %>% @@ -1376,8 +1580,8 @@ Pull_Cluster_Annotation <- function( new_cluster_ids_list <- list(new_cluster_ids) secondary_ids_list <- list(secondary_ids) # Name the new cluster ids list - names(new_cluster_ids_list) <- "new_cluster_idents" - names(secondary_ids_list) <- colnames(annotation_table)[[3]] + names(x = new_cluster_ids_list) <- "new_cluster_idents" + names(x = secondary_ids_list) <- colnames(annotation_table)[[3]] # Combine and return both lists as single list final_cluster_annotation_list <- c(cluster_annotation_list, new_cluster_ids_list, secondary_ids_list) @@ -1429,7 +1633,7 @@ Rename_Clusters <- function( # Name the new idents vector if (is.null(x = names(x = new_idents))) { - names(new_idents) <- levels(seurat_object) + names(x = new_idents) <- levels(x = seurat_object) } # If named check that names are right length if (!is.null(x = names(x = new_idents)) && length(x = unique(x = names(x = new_idents))) != length(x = levels(x = seurat_object))) { @@ -1440,7 +1644,7 @@ Rename_Clusters <- function( # Rename meta column for old ident information if desired if (!is.null(x = meta_col_name)) { - seurat_object[[meta_col_name]] <- Idents(seurat_object) + seurat_object[[meta_col_name]] <- Idents(object = seurat_object) } # Add new idents & return object @@ -1518,7 +1722,7 @@ Setup_scRNAseq_Project <- function( # Check for directories and create new ones lapply(output_dirs, function(dir_path){ if (!dir.exists(dir_path)){ - dir.create(dir_path) + dir.create(path = dir_path) } else { cli_warn(message = "The directory {.val {dir_path}} aleady exists. No new directory created.") } diff --git a/cran-comments.md b/cran-comments.md index 82506aba7..a06c78fa3 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,8 +1,7 @@ ## Minor Version Update -This is a minor update from v1.1.0 to v1.1.1. In this version I have: +This is a minor update from v1.1.1 to v1.1.2. In this version I have: - Combination of bug fixes, new features, code styling (see News.md). -- One package (viridis) moved from Imports to Suggests. ## R CMD check results diff --git a/man/Cell_Highlight_Plot.Rd b/man/Cell_Highlight_Plot.Rd index a0a986aec..382c78b76 100644 --- a/man/Cell_Highlight_Plot.Rd +++ b/man/Cell_Highlight_Plot.Rd @@ -10,6 +10,7 @@ Cell_Highlight_Plot( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -30,6 +31,9 @@ Cell_Highlight_Plot( \item{pt.size}{point size for both highlighted cluster and background.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{raster}{Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.} diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index fca178ca3..d3dccbf94 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -10,6 +10,7 @@ Cluster_Highlight_Plot( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -31,6 +32,9 @@ Cluster_Highlight_Plot( \item{pt.size}{point size for both highlighted cluster and background.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{raster}{Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.} diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index 8c06dc4fb..541e23c48 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -21,6 +21,12 @@ Clustered_DotPlot( row_km_repeats = deprecated(), column_km_repeats = deprecated(), row_label_size = 8, + row_label_fontface = "plain", + cluster_feature = TRUE, + cluster_ident = TRUE, + column_label_size = 8, + legend_label_size = 10, + legend_title_size = 10, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -81,6 +87,18 @@ smaller than row_km, but this might mean the original row_km is not a good choic \item{row_label_size}{Size of the feature labels. Provided to \code{row_names_gp} in Heatmap call.} +\item{row_label_fontface}{Fontface to use for row labels. Provided to \code{row_names_gp} in Heatmap call.} + +\item{cluster_feature}{logical, whether to cluster and reorder feature axis. Default is TRUE.} + +\item{cluster_ident}{logical, whether to cluster and reorder identity axis. Default is TRUE.} + +\item{column_label_size}{Size of the feature labels. Provided to \code{column_names_gp} in Heatmap call.} + +\item{legend_label_size}{Size of the legend text labels. Provided to \code{labels_gp} in Heatmap legend call.} + +\item{legend_title_size}{Sise of the legend title text labels. Provided to \code{title_gp} in Heatmap legend call.} + \item{raster}{Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE.} \item{plot_km_elbow}{Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. diff --git a/man/DimPlot_All_Samples.Rd b/man/DimPlot_All_Samples.Rd index 4b36c6bcc..c0d0f5adb 100644 --- a/man/DimPlot_All_Samples.Rd +++ b/man/DimPlot_All_Samples.Rd @@ -9,6 +9,7 @@ DimPlot_All_Samples( meta_data_column = "orig.ident", colors_use = "black", pt.size = NULL, + aspect_ratio = NULL, title_size = 15, num_columns = NULL, reduction = NULL, @@ -27,6 +28,9 @@ DimPlot_All_Samples( \item{pt.size}{Adjust point size for plotting.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{title_size}{size for plot title labels.} \item{num_columns}{number of columns in final layout plot.} diff --git a/man/DimPlot_LIGER.Rd b/man/DimPlot_LIGER.Rd index edb83baa1..0a72d6054 100644 --- a/man/DimPlot_LIGER.Rd +++ b/man/DimPlot_LIGER.Rd @@ -14,6 +14,7 @@ DimPlot_LIGER( shuffle = TRUE, shuffle_seed = 1, reduction_label = "UMAP", + aspect_ratio = NULL, label = TRUE, label_size = NA, label_repel = FALSE, @@ -53,6 +54,9 @@ if points of interest are being buried. (Default is TRUE).} \item{reduction_label}{What to label the x and y axes of resulting plots. LIGER does not store name of technique and therefore needs to be set manually. Default is "UMAP".} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{label}{logical. Whether or not to label the clusters. ONLY applies to plotting by cluster. Default is TRUE.} \item{label_size}{size of cluster labels.} diff --git a/man/DimPlot_scCustom.Rd b/man/DimPlot_scCustom.Rd index c63508519..372e717f2 100644 --- a/man/DimPlot_scCustom.Rd +++ b/man/DimPlot_scCustom.Rd @@ -13,6 +13,7 @@ DimPlot_scCustom( split.by = NULL, split_seurat = FALSE, figure_plot = FALSE, + aspect_ratio = NULL, shuffle = TRUE, seed = 1, label = NULL, @@ -51,6 +52,9 @@ individual plots in layout. Default is FALSE.} \item{figure_plot}{logical. Whether to remove the axes and plot with legend on left of plot denoting axes labels. (Default is FALSE). Requires \code{split_seurat = TRUE}.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{shuffle}{logical. Whether to randomly shuffle the order of points. This can be useful for crowded plots if points of interest are being buried. (Default is TRUE).} diff --git a/man/Extract_Modality.Rd b/man/Extract_Modality.Rd new file mode 100644 index 000000000..4d694fa4d --- /dev/null +++ b/man/Extract_Modality.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{Extract_Modality} +\alias{Extract_Modality} +\title{Extract multi-modal data into list by modality} +\usage{ +Extract_Modality(matrix_list) +} +\arguments{ +\item{matrix_list}{list of matrices to split by modality} +} +\value{ +list of lists, with one sublist per data modality. Sub-list contain 1 matrix entry per sample +} +\description{ +Reorganize multi-modal data after import with \code{Read10X()} or scCustomize read functions. +Organizes sub-lists by data modality instead of by sample. +} +\examples{ +\dontrun{ +multi_mat <- Read10X(...) +new_multi_mat <- Extract_Modality(matrix_list = multi_mat) +} + +} +\concept{helper_util} diff --git a/man/FeaturePlot_DualAssay.Rd b/man/FeaturePlot_DualAssay.Rd index 0c3648437..76f94b90b 100644 --- a/man/FeaturePlot_DualAssay.Rd +++ b/man/FeaturePlot_DualAssay.Rd @@ -13,6 +13,7 @@ FeaturePlot_DualAssay( na_color = "lightgray", order = TRUE, pt.size = NULL, + aspect_ratio = NULL, reduction = NULL, na_cutoff = 1e-09, raster = NULL, @@ -41,6 +42,9 @@ FeaturePlot_DualAssay( \item{pt.size}{Adjust point size for plotting.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{na_cutoff}{Value to use as minimum expression cutoff. To set no cutoff set to \code{NA}.} diff --git a/man/FeaturePlot_scCustom.Rd b/man/FeaturePlot_scCustom.Rd index 64eebe55f..9033b3bde 100644 --- a/man/FeaturePlot_scCustom.Rd +++ b/man/FeaturePlot_scCustom.Rd @@ -16,6 +16,8 @@ FeaturePlot_scCustom( raster = NULL, raster.dpi = c(512, 512), split.by = NULL, + split_collect = NULL, + aspect_ratio = NULL, num_columns = NULL, slot = "data", alpha_exp = NULL, @@ -53,6 +55,12 @@ Default is c(512, 512).} \item{split.by}{Variable in \verb{@meta.data} to split the plot by.} +\item{split_collect}{logical, whether to collect the legends/guides when plotting with \code{split.by}. +Default is TRUE if one value is provided to \code{features} otherwise is set to FALSE.} + +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{num_columns}{Number of columns in plot layout.} \item{slot}{Which slot to pull expression data from? Default is "data".} diff --git a/man/Iterate_Cluster_Highlight_Plot.Rd b/man/Iterate_Cluster_Highlight_Plot.Rd index e44a469f8..66b3be849 100644 --- a/man/Iterate_Cluster_Highlight_Plot.Rd +++ b/man/Iterate_Cluster_Highlight_Plot.Rd @@ -6,7 +6,7 @@ \usage{ Iterate_Cluster_Highlight_Plot( seurat_object, - highlight_color = "navy", + highlight_color = "dodgerblue", background_color = "lightgray", pt.size = NULL, reduction = NULL, diff --git a/man/Iterate_DimPlot_bySample.Rd b/man/Iterate_DimPlot_bySample.Rd index 7269d87fa..3010d922e 100644 --- a/man/Iterate_DimPlot_bySample.Rd +++ b/man/Iterate_DimPlot_bySample.Rd @@ -12,6 +12,7 @@ Iterate_DimPlot_bySample( single_pdf = FALSE, dpi = 600, color = "black", + legend = TRUE, reduction = NULL, dims = c(1, 2), pt.size = NULL, @@ -33,6 +34,8 @@ Iterate_DimPlot_bySample( \item{color}{color scheme to use.} +\item{legend}{logical, whether or not to include plot legend, default is TRUE.} + \item{reduction}{Dimensionality Reduction to use (default is object default).} \item{dims}{Dimensions to plot.} diff --git a/man/Iterate_Meta_Highlight_Plot.Rd b/man/Iterate_Meta_Highlight_Plot.Rd index 97f8628fd..cd918ec4b 100644 --- a/man/Iterate_Meta_Highlight_Plot.Rd +++ b/man/Iterate_Meta_Highlight_Plot.Rd @@ -12,6 +12,8 @@ Iterate_Meta_Highlight_Plot( highlight_color = "navy", background_color = "lightgray", pt.size = NULL, + no_legend = FALSE, + title_prefix = NULL, reduction = NULL, file_path = NULL, file_name = NULL, @@ -39,6 +41,11 @@ all clusters/plots or a vector of colors equal to the number of clusters to use \item{pt.size}{point size for both highlighted cluster and background.} +\item{no_legend}{logical, whether or not to remove plot legend and move to plot title. Default is FALSE.} + +\item{title_prefix}{Value that should be used for plot title prefix if \code{no_legend = TRUE}. +If NULL the value of \code{meta_data_column} will be used. Default is NULL.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{file_path}{directory file path and/or file name prefix. Defaults to current wd.} diff --git a/man/Merge_Sparse_Multimodal_All.Rd b/man/Merge_Sparse_Multimodal_All.Rd new file mode 100644 index 000000000..be94f991e --- /dev/null +++ b/man/Merge_Sparse_Multimodal_All.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{Merge_Sparse_Multimodal_All} +\alias{Merge_Sparse_Multimodal_All} +\title{Merge a list of Sparse Matrices contain multi-modal data.} +\usage{ +Merge_Sparse_Multimodal_All( + matrix_list, + add_cell_ids = NULL, + prefix = TRUE, + cell_id_delimiter = "_" +) +} +\arguments{ +\item{matrix_list}{list of matrices to merge.} + +\item{add_cell_ids}{a vector of sample ids to add as prefix to cell barcode during merge.} + +\item{prefix}{logical. Whether \code{add_cell_ids} should be added as prefix to current cell barcodes/names +or as suffix to current cell barcodes/names. Default is TRUE, add as prefix.} + +\item{cell_id_delimiter}{The delimiter to use when adding cell id prefix/suffix. Default is "_".} +} +\value{ +A list containing one sparse matrix for each modality +} +\description{ +Enables easy merge of a list of sparse matrices for multi-modal data. +} +\examples{ +\dontrun{ +data_list <- Read10X_GEO(...) +merged_list <- Merge_Sparse_Multimodal_All(matrix_list = data_list, add_cell_ids = names(data_list), +prefix = TRUE, cell_id_delimiter = "_") +} + +} +\concept{helper_util} diff --git a/man/Meta_Highlight_Plot.Rd b/man/Meta_Highlight_Plot.Rd index e75a2b5ff..467d0c6ef 100644 --- a/man/Meta_Highlight_Plot.Rd +++ b/man/Meta_Highlight_Plot.Rd @@ -11,6 +11,7 @@ Meta_Highlight_Plot( highlight_color = NULL, background_color = "lightgray", pt.size = NULL, + aspect_ratio = NULL, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -33,6 +34,9 @@ Meta_Highlight_Plot( \item{pt.size}{point size for both highlighted cluster and background.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{raster}{Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.} diff --git a/man/Meta_Present.Rd b/man/Meta_Present.Rd index 648bf6b57..cdd5433b2 100644 --- a/man/Meta_Present.Rd +++ b/man/Meta_Present.Rd @@ -9,7 +9,7 @@ Meta_Present( meta_col_names, print_msg = TRUE, omit_warn = TRUE, - abort = TRUE + return_none = FALSE ) } \arguments{ @@ -21,7 +21,8 @@ Meta_Present( \item{omit_warn}{logical. Whether to print message about features that are not found in current object. Default is TRUE.} -\item{abort}{logical. Whether or not to stop function and print stop message if no input \code{meta_col_names} are found. Default is TRUE.} +\item{return_none}{logical. Whether list of found vs. bad features should still be returned if no +\code{meta_col_names} are found. Default is FALSE.} } \value{ vector of meta data columns that are present diff --git a/man/Plot_Cells_per_Sample.Rd b/man/Plot_Cells_per_Sample.Rd index a0dcbb588..1296f5f64 100644 --- a/man/Plot_Cells_per_Sample.Rd +++ b/man/Plot_Cells_per_Sample.Rd @@ -9,6 +9,7 @@ Plot_Cells_per_Sample( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Cells/Nuclei per Sample", y_axis_label = "Number of Cells", x_axis_label = NULL, @@ -26,6 +27,8 @@ Plot_Cells_per_Sample( \item{colors_use}{List of colors or color palette to use.} +\item{dot_size}{size of the dots plotted if \code{group_by} is not NULL. Default is 1.} + \item{plot_title}{Plot title.} \item{y_axis_label}{Label for y axis.} diff --git a/man/Plot_Density_Custom.Rd b/man/Plot_Density_Custom.Rd index f90499eab..fab105e17 100644 --- a/man/Plot_Density_Custom.Rd +++ b/man/Plot_Density_Custom.Rd @@ -11,6 +11,7 @@ Plot_Density_Custom( viridis_palette = "magma", custom_palette = NULL, pt.size = 1, + aspect_ratio = NULL, reduction = NULL, combine = TRUE, ... @@ -30,6 +31,9 @@ Plot_Density_Custom( \item{pt.size}{Adjust point size for plotting.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{combine}{Create a single plot? If FALSE, a list with ggplot objects is returned.} diff --git a/man/Plot_Density_Joint_Only.Rd b/man/Plot_Density_Joint_Only.Rd index 9dc38076e..956f31fc9 100644 --- a/man/Plot_Density_Joint_Only.Rd +++ b/man/Plot_Density_Joint_Only.Rd @@ -10,6 +10,7 @@ Plot_Density_Joint_Only( viridis_palette = "magma", custom_palette = NULL, pt.size = 1, + aspect_ratio = NULL, reduction = NULL, ... ) @@ -26,6 +27,9 @@ Plot_Density_Joint_Only( \item{pt.size}{Adjust point size for plotting.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{...}{Extra parameters passed to \code{\link[Nebulosa]{plot_density}}.} diff --git a/man/Plot_Median_Genes.Rd b/man/Plot_Median_Genes.Rd index 428c59dde..03194ff73 100644 --- a/man/Plot_Median_Genes.Rd +++ b/man/Plot_Median_Genes.Rd @@ -9,6 +9,7 @@ Plot_Median_Genes( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median Genes/Cell per Sample", y_axis_label = "Median Genes", x_axis_label = NULL, @@ -26,6 +27,8 @@ Plot_Median_Genes( \item{colors_use}{List of colors or color palette to use. Only applicable if \code{group_by} is not NULL.} +\item{dot_size}{size of the dots plotted if \code{group_by} is not NULL. Default is 1.} + \item{plot_title}{Plot title.} \item{y_axis_label}{Label for y axis.} diff --git a/man/Plot_Median_Mito.Rd b/man/Plot_Median_Mito.Rd index fb4815f0f..cdfe96904 100644 --- a/man/Plot_Median_Mito.Rd +++ b/man/Plot_Median_Mito.Rd @@ -9,6 +9,7 @@ Plot_Median_Mito( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median \% Mito per Sample", y_axis_label = "Percent Mitochondrial Reads", x_axis_label = NULL, @@ -26,6 +27,8 @@ Plot_Median_Mito( \item{colors_use}{List of colors or color palette to use. Only applicable if \code{group_by} is not NULL.} +\item{dot_size}{size of the dots plotted if \code{group_by} is not NULL. Default is 1.} + \item{plot_title}{Plot title.} \item{y_axis_label}{Label for y axis.} diff --git a/man/Plot_Median_Other.Rd b/man/Plot_Median_Other.Rd index 2a7c437ea..d004e1069 100644 --- a/man/Plot_Median_Other.Rd +++ b/man/Plot_Median_Other.Rd @@ -10,6 +10,7 @@ Plot_Median_Other( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = NULL, y_axis_label = NULL, x_axis_label = NULL, @@ -29,6 +30,8 @@ Plot_Median_Other( \item{colors_use}{List of colors or color palette to use. Only applicable if \code{group_by} is not NULL.} +\item{dot_size}{size of the dots plotted if \code{group_by} is not NULL. Default is 1.} + \item{plot_title}{Plot title.} \item{y_axis_label}{Label for y axis.} diff --git a/man/Plot_Median_UMIs.Rd b/man/Plot_Median_UMIs.Rd index 65207f238..231614be6 100644 --- a/man/Plot_Median_UMIs.Rd +++ b/man/Plot_Median_UMIs.Rd @@ -9,6 +9,7 @@ Plot_Median_UMIs( sample_col = "orig.ident", group_by = NULL, colors_use = NULL, + dot_size = 1, plot_title = "Median UMIs/Cell per Sample", y_axis_label = "Median UMIs", x_axis_label = NULL, @@ -26,6 +27,8 @@ Plot_Median_UMIs( \item{colors_use}{List of colors or color palette to use. Only applicable if \code{group_by} is not NULL.} +\item{dot_size}{size of the dots plotted if \code{group_by} is not NULL. Default is 1.} + \item{plot_title}{Plot title.} \item{y_axis_label}{Label for y axis.} diff --git a/man/QC_Plots_Combined_Vln.Rd b/man/QC_Plots_Combined_Vln.Rd index d86b8b5c4..75f3852b5 100644 --- a/man/QC_Plots_Combined_Vln.Rd +++ b/man/QC_Plots_Combined_Vln.Rd @@ -12,6 +12,8 @@ QC_Plots_Combined_Vln( mito_cutoffs = NULL, mito_name = "percent_mito", pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -38,6 +40,10 @@ default is the current active.ident of the object.} \item{pt.size}{Point size for plotting} +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} + \item{colors_use}{vector of colors to use for plot.} \item{x_lab_rotate}{Rotate x-axis labels 45 degrees (Default is TRUE).} diff --git a/man/QC_Plots_Complexity.Rd b/man/QC_Plots_Complexity.Rd index fa05f2c4d..6117faada 100644 --- a/man/QC_Plots_Complexity.Rd +++ b/man/QC_Plots_Complexity.Rd @@ -14,6 +14,8 @@ QC_Plots_Complexity( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -43,6 +45,10 @@ default is the current active.ident of the object.} \item{pt.size}{Point size for plotting} +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} + \item{colors_use}{vector of colors to use for plot.} \item{x_lab_rotate}{Rotate x-axis labels 45 degrees (Default is TRUE).} diff --git a/man/QC_Plots_Feature.Rd b/man/QC_Plots_Feature.Rd index b1eee579a..979505f5a 100644 --- a/man/QC_Plots_Feature.Rd +++ b/man/QC_Plots_Feature.Rd @@ -14,6 +14,8 @@ QC_Plots_Feature( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -41,7 +43,11 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} -\item{pt.size}{Point size for plotting} +\item{pt.size}{Point size for plotting.} + +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} \item{colors_use}{vector of colors to use for plot.} diff --git a/man/QC_Plots_Genes.Rd b/man/QC_Plots_Genes.Rd index e3059b939..561f35466 100644 --- a/man/QC_Plots_Genes.Rd +++ b/man/QC_Plots_Genes.Rd @@ -13,6 +13,8 @@ QC_Plots_Genes( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -38,7 +40,11 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} -\item{pt.size}{Point size for plotting} +\item{pt.size}{Point size for plotting.} + +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} \item{colors_use}{vector of colors to use for plot.} diff --git a/man/QC_Plots_Mito.Rd b/man/QC_Plots_Mito.Rd index 2ab452ac0..372813d45 100644 --- a/man/QC_Plots_Mito.Rd +++ b/man/QC_Plots_Mito.Rd @@ -14,6 +14,8 @@ QC_Plots_Mito( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -42,7 +44,11 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} -\item{pt.size}{Point size for plotting} +\item{pt.size}{Point size for plotting.} + +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} \item{colors_use}{vector of colors to use for plot.} diff --git a/man/QC_Plots_UMIs.Rd b/man/QC_Plots_UMIs.Rd index cb323486e..fe35a5c51 100644 --- a/man/QC_Plots_UMIs.Rd +++ b/man/QC_Plots_UMIs.Rd @@ -13,6 +13,8 @@ QC_Plots_UMIs( low_cutoff = NULL, high_cutoff = NULL, pt.size = NULL, + plot_median = FALSE, + median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -38,7 +40,11 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} -\item{pt.size}{Point size for plotting} +\item{pt.size}{Point size for plotting.} + +\item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} + +\item{median_size}{Shape size for the median is plotted.} \item{colors_use}{vector of colors to use for plot.} diff --git a/man/Read10X_Multi_Directory.Rd b/man/Read10X_Multi_Directory.Rd index b6f5149f7..3c906084c 100644 --- a/man/Read10X_Multi_Directory.Rd +++ b/man/Read10X_Multi_Directory.Rd @@ -8,6 +8,7 @@ Read10X_Multi_Directory( base_path, secondary_path = NULL, default_10X_path = TRUE, + cellranger_multi = FALSE, sample_list = NULL, sample_names = NULL, parallel = FALSE, @@ -24,6 +25,8 @@ Read10X_Multi_Directory( \item{default_10X_path}{logical (default TRUE) sets the secondary path variable to the default 10X directory structure.} +\item{cellranger_multi}{logical, whether samples were processed with Cell Ranger \code{multi}, default is FALSE.} + \item{sample_list}{a vector of sample directory names if only specific samples are desired. If \code{NULL} will read in subdirectories in parent directory.} diff --git a/man/Read10X_h5_Multi_Directory.Rd b/man/Read10X_h5_Multi_Directory.Rd index f1cb351d0..a0f1e4f6a 100644 --- a/man/Read10X_h5_Multi_Directory.Rd +++ b/man/Read10X_h5_Multi_Directory.Rd @@ -8,8 +8,9 @@ Read10X_h5_Multi_Directory( base_path, secondary_path = NULL, default_10X_path = TRUE, + cellranger_multi = FALSE, h5_filename = "filtered_feature_bc_matrix.h5", - cell_bender = FALSE, + cell_bender = deprecated(), sample_list = NULL, sample_names = NULL, replace_suffix = FALSE, @@ -28,12 +29,15 @@ Read10X_h5_Multi_Directory( \item{default_10X_path}{logical (default TRUE) sets the secondary path variable to the default 10X directory structure.} +\item{cellranger_multi}{logical, whether samples were processed with Cell Ranger \code{multi}, default is FALSE.} + \item{h5_filename}{name of h5 file (including .h5 suffix). If all h5 files have same name (i.e. Cell Ranger output) then use full file name. By default function uses Cell Ranger name: "filtered_feature_bc_matrix.h5". If h5 files have sample specific prefixes (i.e. from Cell Bender) then use only the shared part of file name (e.g., "_filtered_out.h5").} -\item{cell_bender}{logical (default FALSE). Is the h5 file from cell bender output, needed to set correct file names.} +\item{cell_bender}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} CellBender read functions are now independent family of functions. +See \verb{Read_CellBender_*} functions.} \item{sample_list}{a vector of sample directory names if only specific samples are desired. If \code{NULL} will read in subdirectories in parent directory.} diff --git a/man/Read_CellBender_h5_Mat.Rd b/man/Read_CellBender_h5_Mat.Rd index 6c278b6c3..d5c1ac919 100644 --- a/man/Read_CellBender_h5_Mat.Rd +++ b/man/Read_CellBender_h5_Mat.Rd @@ -4,7 +4,13 @@ \alias{Read_CellBender_h5_Mat} \title{Load CellBender h5 matrices (corrected)} \usage{ -Read_CellBender_h5_Mat(file_name, use.names = TRUE, unique.features = TRUE) +Read_CellBender_h5_Mat( + file_name, + use.names = TRUE, + unique.features = TRUE, + h5_group_name = NULL, + feature_slot_name = "features" +) } \arguments{ \item{file_name}{Path to h5 file.} @@ -12,6 +18,12 @@ Read_CellBender_h5_Mat(file_name, use.names = TRUE, unique.features = TRUE) \item{use.names}{Label row names with feature names rather than ID numbers (default TRUE).} \item{unique.features}{Make feature names unique (default TRUE).} + +\item{h5_group_name}{Name of the group within H5 file that contains count data. This is only +required if H5 file contains multiple subgroups and non-default names. Default is \code{NULL}.} + +\item{feature_slot_name}{Name of the slot contain feature names/ids. Must be one of: +"features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features".} } \value{ sparse matrix diff --git a/man/Read_CellBender_h5_Multi_Directory.Rd b/man/Read_CellBender_h5_Multi_Directory.Rd index de27413b3..aa82d11c6 100644 --- a/man/Read_CellBender_h5_Multi_Directory.Rd +++ b/man/Read_CellBender_h5_Multi_Directory.Rd @@ -11,6 +11,8 @@ Read_CellBender_h5_Multi_Directory( custom_name = NULL, sample_list = NULL, sample_names = NULL, + h5_group_name = NULL, + feature_slot_name = "features", replace_suffix = FALSE, new_suffix_list = NULL, parallel = FALSE, @@ -35,6 +37,12 @@ read in subdirectories in parent directory.} \item{sample_names}{a set of sample names to use for each sample entry in returned list. If \code{NULL} will set names to the subdirectory name of each sample.} +\item{h5_group_name}{Name of the group within H5 file that contains count data. This is only +required if H5 file contains multiple subgroups and non-default names. Default is \code{NULL}.} + +\item{feature_slot_name}{Name of the slot contain feature names/ids. Must be one of: +"features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features".} + \item{replace_suffix}{logical (default FALSE). Whether or not to replace the barcode suffixes of matrices using \code{\link{Replace_Suffix}}.} diff --git a/man/Read_CellBender_h5_Multi_File.Rd b/man/Read_CellBender_h5_Multi_File.Rd index 29ba7cc00..3a6b53dbf 100644 --- a/man/Read_CellBender_h5_Multi_File.Rd +++ b/man/Read_CellBender_h5_Multi_File.Rd @@ -10,6 +10,8 @@ Read_CellBender_h5_Multi_File( custom_name = NULL, sample_list = NULL, sample_names = NULL, + h5_group_name = NULL, + feature_slot_name = "features", parallel = FALSE, num_cores = NULL, merge = FALSE, @@ -30,7 +32,13 @@ read in all files within \code{data_dir} directory.} \item{sample_names}{a set of sample names to use for each sample entry in returned list. If \code{NULL} will set names to the subdirectory name of each sample.} -\item{parallel}{logical (default FALSE) whether or not to use multi core processing to read in matrices.} +\item{h5_group_name}{Name of the group within H5 file that contains count data. This is only +required if H5 file contains multiple subgroups and non-default names. Default is \code{NULL}.} + +\item{feature_slot_name}{Name of the slot contain feature names/ids. Must be one of: +"features"(Cell Ranger v3+) or "genes" (Cell Ranger v1/v2 or STARsolo). Default is "features".} + +\item{parallel}{logical (default FALSE) whether or not to use multi core processing to read in matrices} \item{num_cores}{how many cores to use for parallel processing.} diff --git a/man/Reduction_Loading_Present.Rd b/man/Reduction_Loading_Present.Rd new file mode 100644 index 000000000..870d2ff2a --- /dev/null +++ b/man/Reduction_Loading_Present.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{Reduction_Loading_Present} +\alias{Reduction_Loading_Present} +\title{Check if reduction loadings are present} +\usage{ +Reduction_Loading_Present( + seurat_object, + reduction_names, + print_msg = TRUE, + omit_warn = TRUE, + return_none = FALSE +) +} +\arguments{ +\item{seurat_object}{object name.} + +\item{reduction_names}{vector of genes to check.} + +\item{print_msg}{logical. Whether message should be printed if all features are found. Default is TRUE.} + +\item{omit_warn}{logical. Whether to print message about features that are not found in current object. +Default is TRUE.} + +\item{return_none}{logical. Whether list of found vs. bad features should still be returned if no +features are found. Default is FALSE.} +} +\value{ +A list of length 3 containing 1) found features, 2) not found features. +} +\description{ +Check if reduction loadings are present in object and return vector of found loading names. Return +warning messages for genes not found. +} +\examples{ +\dontrun{ +reductions <- Reduction_Loading_Present(seurat_object = obj_name, reduction_name = "PC_1") +found_features <- features[[1]] +} + +} +\concept{helper_util} diff --git a/man/Split_FeatureScatter.Rd b/man/Split_FeatureScatter.Rd index 0652c0873..808d90ed4 100644 --- a/man/Split_FeatureScatter.Rd +++ b/man/Split_FeatureScatter.Rd @@ -12,6 +12,7 @@ Split_FeatureScatter( group.by = NULL, colors_use = NULL, pt.size = NULL, + aspect_ratio = NULL, title_size = 15, num_columns = NULL, raster = NULL, @@ -37,6 +38,9 @@ Use 'ident' to group.by active.ident class.} \item{pt.size}{Adjust point size for plotting.} +\item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.} + \item{title_size}{size for plot title labels.} \item{num_columns}{number of columns in final layout plot.} diff --git a/man/Stacked_VlnPlot.Rd b/man/Stacked_VlnPlot.Rd index 4181a55ce..84443ee04 100644 --- a/man/Stacked_VlnPlot.Rd +++ b/man/Stacked_VlnPlot.Rd @@ -57,7 +57,7 @@ Default is 0.15 ("cm"). Spacing dependent on unit provided to \code{spacing_uni \item{vln_linewidth}{Adjust the linewidth of violin outline. Must be numeric.} -\item{pt.size}{Adjust point size for plotting. Default for \code{StackedVlnPlot} is 0 to avoid issues with +\item{pt.size}{Adjust point size for plotting. Default for \code{Stacked_VlnPlot} is 0 to avoid issues with rendering so many points in vector form. Alternatively, see \code{raster} parameter.} \item{raster}{Convert points to raster format. Default is NULL which will rasterize by default if diff --git a/vignettes/articles/Cell_Bender_Functions.Rmd b/vignettes/articles/Cell_Bender_Functions.Rmd index a957d2b9c..55dcd10e6 100644 --- a/vignettes/articles/Cell_Bender_Functions.Rmd +++ b/vignettes/articles/Cell_Bender_Functions.Rmd @@ -70,6 +70,19 @@ cell_bender_mat <- Read_CellBender_h5_Mat(file_name = "PATH/SampleA_out_filtered ``` +### Importing CellBender data based on STARsolo or pre-V3 Cell Ranger inputs +If the input that CellBender uses is based on STARsolo or pre-V3 Cell Ranger data then some of the slot name which stores feature/gene ids in the H5 file is different. These files can be read by specifying the optional `feature_slot_name` parameter. +```{r eval=FALSE} +cell_bender_starsolo_mat <- Read_CellBender_h5_Mat(file_name = "PATH/SampleA_out_filtered.h5", feature_slot_name = "genes") +``` + +### Importing CellBender data with non-standard group names +If CellBender H5 file contains non-standard H5 group names then `Read_CellBender_h5_Mat` will error. To circumvent this simply supply the name of the H5 group that contains the count data. +```{r eval=FALSE} +cell_bender_name_mat <- Read_CellBender_h5_Mat(file_name = "PATH/SampleA_out_filtered.h5", h5_group_name = "background_removed") +``` + + ## Reading multiple CellBender files with single function scCustomize also contains two wrapper functions to easily read multiple CellBender files stored either in single directory or in multiple sub-directories `Read_CellBender_h5_Multi_File` and `Read_CellBender_h5_Multi_Directory`. diff --git a/vignettes/articles/QC_Plots.Rmd b/vignettes/articles/QC_Plots.Rmd index dd893adbf..742b0133d 100644 --- a/vignettes/articles/QC_Plots.Rmd +++ b/vignettes/articles/QC_Plots.Rmd @@ -159,7 +159,8 @@ In addition to being able to supply Seurat parameters with `...` these plots lik * `plot_title`: Change plot title * `x_axis_label`/`y_axis_label`: Change axis labels. * `x_lab_rotate`: Should x-axis label be rotated 45 degrees? -* `y_axis_log`: Should y-axis in linear or log10 scale. +* `y_axis_log`: Should y-axis in linear or log10 scale. +* `plot_median` & `median_size`: Plot a line at the median of each x-axis identity. ```{r, fig.height=5, fig.width=13, fig.align='center', fig.cap="*Setting `y_axis_log` can be very helpful for initial plots where outliers skew the visualization of the majority of the data without excluding data by setting y-axis limit.*"} @@ -170,6 +171,15 @@ wrap_plots(p1, p2, ncol = 2) ``` +```{r, fig.height=5, fig.width=13, fig.align='center', fig.cap="*Plotting median values by setting the `plot_median = TRUE` parameter.*"} +p1 <- QC_Plots_UMIs(seurat_object = hca_bm, low_cutoff = 1200, high_cutoff = 45000, pt.size = 0, plot_median = TRUE) +p2 <- QC_Plots_UMIs(seurat_object = hca_bm, low_cutoff = 1200, high_cutoff = 45000, pt.size = 0, y_axis_log = TRUE, plot_median = TRUE) + +wrap_plots(p1, p2, ncol = 2) + +``` + + ### Combined Plotting Function As a shortcut you can return single patchwork plot of the 3 main QC Plots (Genes, UMIs, %Mito) by using single function, `QC_Plots_Combined_Vln()`. diff --git a/vignettes/articles/Read_and_Write_Functions.Rmd b/vignettes/articles/Read_and_Write_Functions.Rmd index 0cf16234b..3a7ace71c 100644 --- a/vignettes/articles/Read_and_Write_Functions.Rmd +++ b/vignettes/articles/Read_and_Write_Functions.Rmd @@ -226,6 +226,13 @@ GEO_Merged <- Merge_Sparse_Data_All(matrix_list = GEO_Single) knitr::include_graphics(c("../../docs/reference/figures/assets/geo_merged.png")) ``` +### Multimodal Data +If you have multimodal data (each entry in list contains sub-list with matrices) then you can use `Merge_Sparse_Multimodal_All()`. This function will return a list with each entry representing a merged matrix for single modality. +```{r eval=FALSE} +GEO_Merged_Multimodal <- Merge_Sparse_Multimodal_All(matrix_list = GEO_Multimodal) +``` + + ### Add Barcode Prefix/Suffix `Merge_Sparse_Data_All` contains a number of optional parameters to control modification to the cell barcodes. *NOTE: If any of the barcodes in the input matrix list overlap and no prefixes/suffixes are provided the function will error.*