diff --git a/DESCRIPTION b/DESCRIPTION index ce2becda6a..8e28b62097 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.3 -Date: 2023-07-19 +Version: 2.0.0 +Date: 2023-11-08 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"), @@ -13,7 +13,7 @@ Authors@R: c( URL: https://github.com/samuel-marsh/scCustomize, https://samuel-marsh.github.io/scCustomize/, https://doi.org/10.5281/zenodo.5706431 BugReports: https://github.com/samuel-marsh/scCustomize/issues Depends: R (>= 4.0.0), - Seurat (>= 4.3.0) + Seurat (>= 4.3.0.1) Imports: circlize, cli (>= 3.2.0), @@ -40,8 +40,8 @@ Imports: purrr, rlang (>= 1.0.1), scales, - scattermore (>= 0.7), - SeuratObject (>= 4.1.2), + scattermore (>= 1.2), + SeuratObject (>= 5.0.0), stats, stringi, stringr, @@ -56,10 +56,9 @@ Suggests: knitr, Nebulosa, remotes, - rliger, rmarkdown, + scuttle, tidyselect, - tidyverse, qs, viridis License: GPL (>= 3) diff --git a/NAMESPACE b/NAMESPACE index ced6eb667e..d5b83e4e64 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,10 +5,13 @@ S3method(Fetch_Meta,liger) export(Add_CellBender_Diff) export(Add_Cell_Complexity_LIGER) export(Add_Cell_Complexity_Seurat) +export(Add_Cell_QC_Metrics) export(Add_Mito_Ribo_LIGER) export(Add_Mito_Ribo_Seurat) export(Add_Pct_Diff) export(Add_Sample_Meta) +export(Add_Top_Gene_Pct_Seurat) +export(Barcode_Plot) export(Blank_Theme) export(Case_Check) export(CellBender_Diff_Plot) @@ -38,9 +41,11 @@ export(Extract_Sample_Meta) export(Extract_Top_Markers) export(FeaturePlot_DualAssay) export(FeaturePlot_scCustom) +export(FeatureScatter_scCustom) export(Fetch_Meta) export(Gene_Present) export(Hue_Pal) +export(Iterate_Barcode_Rank_Plot) export(Iterate_Cluster_Highlight_Plot) export(Iterate_DimPlot_bySample) export(Iterate_FeaturePlot_scCustom) @@ -51,6 +56,7 @@ export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) export(Liger_to_Seurat) +export(MAD_Stats) export(Median_Stats) export(Merge_Seurat_List) export(Merge_Sparse_Data_All) @@ -74,6 +80,7 @@ export(Plot_Median_Other) export(Plot_Median_UMIs) export(Pull_Cluster_Annotation) export(Pull_Directory_List) +export(QC_Histogram) export(QC_Plot_GenevsFeature) export(QC_Plot_UMIvsFeature) export(QC_Plot_UMIvsGene) @@ -119,7 +126,6 @@ export(Store_Palette_Seurat) export(Top_Genes_Factor) export(UnRotate_X) export(VariableFeaturePlot_scCustom) -export(Variable_Features_ALL_LIGER) export(VlnPlot_scCustom) export(plotFactors_scCustom) export(scCustomize_Palette) @@ -156,7 +162,10 @@ importFrom(Seurat,VariableFeaturePlot) importFrom(Seurat,VizDimLoadings) importFrom(Seurat,VlnPlot) importFrom(SeuratObject,DefaultDimReduc) -importFrom(SeuratObject,PackageCheck) +importFrom(SeuratObject,Features) +importFrom(SeuratObject,JoinLayers) +importFrom(SeuratObject,LayerData) +importFrom(SeuratObject,Layers) importFrom(circlize,colorRamp2) importFrom(cowplot,theme_cowplot) importFrom(data.table,fread) @@ -176,6 +185,7 @@ importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,select) +importFrom(dplyr,setdiff) importFrom(dplyr,slice) importFrom(dplyr,slice_max) importFrom(dplyr,summarise) @@ -212,8 +222,8 @@ importFrom(purrr,keep) importFrom(purrr,map) importFrom(purrr,map2) importFrom(purrr,map_dbl) -importFrom(purrr,pluck) importFrom(purrr,reduce) +importFrom(rlang,is_installed) importFrom(rlang,sym) importFrom(scales,alpha) importFrom(scales,hue_pal) @@ -221,6 +231,7 @@ importFrom(scales,label_percent) importFrom(scattermore,geom_scattermore) importFrom(stats,cor) importFrom(stats,kmeans) +importFrom(stats,mad) importFrom(stats,median) importFrom(stats,quantile) importFrom(stats,setNames) diff --git a/NEWS.md b/NEWS.md index 685749b0d2..52cb6f047b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,66 @@ +# scCustomize 2.0.0 (2023-11-06) +## Added +- Added support for metrics produced by Cell Ranger `multi` pipeline to `Read10X_Metrics` via new parameter `cellranger_multi`. +- Added `dot_size` parameter to `Seq_QC_Plot_*` family of functions. +- Added two new sequencing QC functions to create and iterate barcode rank plots: `Barcode_Plot` and `Iterate_Barcode_Rank_Plot`. +- Added `ident_legend` parameter to `QC_Plot_UMIvsGene` to control show/hide of the identity legend ([#121](https://github.com/samuel-marsh/scCustomize/issues/121)). +- Added support for sparse matrix input in `CellBender_Feature_Diff`. +- Added `min_count_label` in `CellBender_Diff_Plot` to better control feature labeling. +- Allow specification of meta data column containing sample names/IDs in `Iterate_DimPlot_bySample` using new `sample_column` parameter. +- Added new function `MAD_Stats` to calculate to the median absolute deviation of meta.data columns by grouping variable and across entire object. +- Added new function `Add_Top_Gene_Pct_Seurat` to add another QC measure of cell complexity to object meta.data. Returns percentage of counts occupied by top XX genes in each cell. +- Added ability to provide set of custom features to `VariableFeaturePlot_scCustom` using `custom_features` parameter. +- Added new overall cell QC metric function `Add_Cell_QC_Metrics` to simplify adding cell QC metrics. Single function call to add Mito/Ribo Percentages, Cell Complexity, Top Gene Percentages, MSigDB Percentages, IEG Percentages, and/or Cell Cycle Scoring (human only). +- Added 2 new gene lists to package data for use in `Add_Cell_QC_Metrics` function: "msigdb_qc_gene_list" and "ieg_gene_list". +- Added several internal functions to support new MsigDB and IEG capabilities of `Add_Cell_QC_Metrics`. +- Added new parameters `plot_median` and `plot_boxplot` to `VlnPlot_scCustom` (and `VlnPlot_scCustom`-based plots; e.g., `QC_Plot_*` family) for added visualization. +- Added `QC_Histogram` to plot QC features (or any feature) using simple histogram. +- Added `FeatureScatter_scCustom` function to customize Seurat's `FeatureScatter` plots. +- Added `figure_plot` parameter to all 2D DR (t-SNE, UMAP, etc) based plots ([#127](https://github.com/samuel-marsh/scCustomize/issues/127)). + + +## Changed +- Large scale under the hood code adjustments to ensure compatibility with Seurat V5 object structure. +- Internal code syntax updates independent of Seurat functionality. +- **HARD DEPRECATION** `Split_FeatureScatter` function has been completely deprecated and it's functionality has been moved to new `FeatureScatter_scCustom`. +- **SOFT DEPRECATION** The parameter `gene_list` in `Iterate_FeaturePlot_scCustom` and `Iterate_VlnPlot_scCustom` has been soft-deprecated and replaced by `features` parameter. Specifying `gene_list` will display deprecation warning but continue to function until next major update. +- The above soft deprecation was to clarify that other features besides genes can be plotted and coincides with update to functions to allow for iterative plots of meta.data or reductions in addition to assay features ([#123](https://github.com/samuel-marsh/scCustomize/issues/123)). +- Internal rewrite of `Read10X_Metrics` to use new internal helper functions. +- Changed `Liger_to_Seurat` to transfer the liger_object@H slot in addition to H.norm slot already moved. +- Replaced `length(x = colnames(x = obj)` with `length(x = Cells(x = obj)` for accurate plotting based on V5 object structure. +- `Gene_Present` now accepts `assay` parameter. +- Internal reorganization of some functions within `R/` for better organization. +- Updated default scCustomize color palettes (`scCustomize_Palette`). Now if number of colors is greater than 2 but less than 8 the default palette will be `ColorBlind_Pal` (previously it was "polychrome"). Polychrome remains the default when number of colors is between 9-36. +- Updated parameter default within `scCustomize_Palette` to `ggplot_default_colors = FALSE` to avoid uncessary error when no value supplied. +- Minimum version of scattermore package updated to v1.2. +- `DimPlot_scCustom` will now set `label = TRUE` if `label.box` is set to TRUE but `label` is not changed from default. +- Removed loading of full tidyverse in vignettes to remove from package suggests (lessen dependency installs when not completely needed). +- Replace Seurat `PackageCheck` (now deprecated), with `rlang::is_installed()` for non-dependency checks. +- Update vignettes with new features and bug fixes from old code. +- Temporary removal of `Variable_Features_ALL_LIGER` until rliger returns to CRAN. + + +## Fixes +- Fixed issue in `Read10X_Metrics` that caused errors when reading files on windows operating system ([#115](https://github.com/samuel-marsh/scCustomize/issues/115)). +- Fixed issue in `Create_CellBender_Merged_Seurat` when feature names are changed (underscore to dash) during object creation ([#118](https://github.com/samuel-marsh/scCustomize/issues/118)). +- Fixed error in `Read10X_h5_Mutli_Directory` when reading Cell Ranger `multi` directories. +- Added new checks to `VlnPlot_scCustom`, `DimPlot_scCustom`, and `DotPlot_scCustom` to avoid otherwise ambiguous error messages ([#120](https://github.com/samuel-marsh/scCustomize/issues/120)). +- Fixed internal check message accidentally user facing in `VlnPlot_scCustom` ([#122](https://github.com/samuel-marsh/scCustomize/issues/122)). +- Fixed cli warning in `Cell_Highlight_Plot` that could cause function to error without proper error message. +- Fixed handling of file names in `Read_*` functions to avoid unnecessary errors. +- Replace superseded dplyr syntax/functionality `drop_na(.data[[var]]`, with current dplyr syntax. +- Internal code fixes to accelerate plotting functions. +- Fixed default plot colors in `VlnPlot`-based plots when `split.by` is not NULL. +- Fixed error when trying to plot more than two variables with `group.by` when using `DimPlot_scCustom` ([#128](https://github.com/samuel-marsh/scCustomize/issues/128)). +- Fixed errors in parameter description for `Add_Mito_Ribo_Seurat` and `Add_Mito_Ribo_LIGER` which incorrectly stated the names of new meta.data/cell.data columns to be added. +- Fixed bug in `DotPlot_scCustom` that prevented it from working unless `group.by` parameter was explicitly added. +- Fixed bug in `Case_Check` caused by typo. +- Fixed color warning messages in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` that were too verbose. +- Fixed bug in `Add_Mito_Ribo_Seurat` and `Add_Mito_Ribo_LIGER` which caused error when supplying custom list of features for non-default organism ([#133](https://github.com/samuel-marsh/scCustomize/issues/133)). +- Fixed bug in `DimPlot_scCustom` preventing that errored when trying to split plot and use `figure_plot` at same time. + + + # scCustomize 1.1.3 (2023-07-19) ## Added - None. diff --git a/R/Color_Palettes.R b/R/Color_Palettes.R index 7935b78ec9..52d637933a 100644 --- a/R/Color_Palettes.R +++ b/R/Color_Palettes.R @@ -215,7 +215,7 @@ NavyAndOrange <- function( flip_order = FALSE ) { navy_orange <- c("navy", "orange") - if (flip_order) { + if (isTRUE(x = flip_order)) { navy_orange <- rev(x = navy_orange) } return(navy_orange) @@ -376,7 +376,7 @@ varibow_scCustom <- function( #' @import cli # #' @importFrom colorway varibow (now directly ported for CRAN compatibility) #' @importFrom paletteer paletteer_d -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' #' @return A vector of colors #' @@ -428,8 +428,8 @@ DiscretePalette_scCustomize <- function( # dittoseq check if (palette == "ditto_seq") { - dittoseq_check <- PackageCheck("dittoSeq", error = FALSE) - if (!dittoseq_check[1]) { + dittoseq_check <- is_installed(pkg = "dittoSeq") + if (isFALSE(x = dittoseq_check[1])) { cli_abort(message = c( "Please install the {.val dittoSeq} package to {.code palette = {symbol$dquote_left}ditto_seq{symbol$dquote_right}}", "i" = "This can be accomplished with the following commands:", @@ -467,7 +467,7 @@ DiscretePalette_scCustomize <- function( "i" = "Please adjust {.code num_colors} to be less than or equal to {.field {length(x = palette_out)}} or select a different {.code palette}.") ) } - if (shuffle_pal) { + if (isTRUE(x = shuffle_pal)) { set.seed(seed = seed) palette_out <- sample(x = palette_out[1:num_colors]) } else { @@ -484,7 +484,8 @@ DiscretePalette_scCustomize <- function( #' @param num_groups number of groups to be plotted. If `ggplot_default_colors = FALSE` then by default: #' \itemize{ #' \item If number of levels plotted equal to 2 then colors will be `NavyAndOrange()`. -#' \item If If number of levels plotted greater than 2 but less than or equal to 36 it will use "polychrome" from `DiscretePalette_scCustomize`. +#' \item If number of levels plotted greater than 2 but less than or equal to 8 it will use `ColorBlind_Pal()`. +#' \item If number of levels plotted greater than 2 but less than or equal to 36 it will use "polychrome" from `DiscretePalette_scCustomize()`. #' \item If greater than 36 will use "varibow" with shuffle = TRUE from `DiscretePalette_scCustomize`. #' } #' @param ggplot_default_colors logical. Whether to use default ggplot hue palette or not. @@ -503,11 +504,11 @@ DiscretePalette_scCustomize <- function( scCustomize_Palette <- function( num_groups, - ggplot_default_colors, + ggplot_default_colors = FALSE, color_seed = 123 ) { # Set color palette depending on group length - if (ggplot_default_colors) { + if (isTRUE(x = ggplot_default_colors)) { colors_use <- Hue_Pal(num_colors = num_groups) } else { if (num_groups == 1) { @@ -516,7 +517,10 @@ scCustomize_Palette <- function( if (num_groups == 2) { colors_use <- NavyAndOrange() } - if (num_groups > 2 && num_groups <= 36) { + if (num_groups > 2 && num_groups <= 8) { + colors_use <- ColorBlind_Pal() + } + if (num_groups > 8 && num_groups <= 36) { colors_use <- DiscretePalette_scCustomize(num_colors = num_groups, palette = "polychrome") } if (num_groups > 36) { @@ -585,7 +589,7 @@ PalettePlot <- function( # Plot # Label plot - if (label_color_num) { + if (isTRUE(x = label_color_num)) { palette_plot <- ggplot(palette_data) + geom_tile(aes(x = .data[["x"]], y = .data[["y"]], fill = .data[["fill"]])) + geom_text(aes(x = .data[["x"]], y = .data[["y"]], label = .data[["x"]])) + diff --git a/R/Data.R b/R/Data.R index 208fa96cf6..a2f9146062 100644 --- a/R/Data.R +++ b/R/Data.R @@ -35,3 +35,56 @@ #' @concept data #' "ensembl_ribo_id" + + +#' QC Gene Lists +#' +#' Gene symbols for qc percentages from MSigDB database. The gene sets are from 3 MSigDB lists: +#' "HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". +#' +#' @format A list of 18 vectors +#' \describe{ +#' \item{Homo_sapiens_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for human} +#' \item{Homo_sapiens_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for human} +#' \item{Homo_sapiens_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for human} +#' \item{Mus_musculus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for mouse} +#' \item{Mus_musculus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for mouse} +#' \item{Mus_musculus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for mouse} +#' \item{Rattus_norvegicus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for rat} +#' \item{Rattus_norvegicus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for rat} +#' \item{Rattus_norvegicus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for rat} +#' \item{Drosophila_melanogaster_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for fly} +#' \item{Drosophila_melanogaster_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for fly} +#' \item{Drosophila_melanogaster_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for fly} +#' \item{Dario_rerio_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for zebrafish} +#' \item{Dario_rerio_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for zebrafish} +#' \item{Dario_rerio_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for zebrafish} +#' \item{Macaca_mulatta_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for macaque} +#' \item{Macaca_mulatta_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for macaque} +#' \item{Macaca_mulatta_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for macaque} +#' +#' } +#' @concept data +#' +#' @source MSigDB gene sets via msigdbr package \url{https://cran.r-project.org/package=msigdbr} +#' +"msigdb_qc_gene_list" + + +#' Immediate Early Gene (IEG) gene lists +#' +#' Gene symbols for immediate early genes +#' +#' @format A list of seven vectors +#' \describe{ +#' \item{Mus_musculus_IEGs}{Gene symbols for IEGs from source publication (see below)} +#' \item{Homo_sapiens_IEGs}{Human gene symbols for homologous genes from mouse gene list} +#' +#' } +#' @concept data +#' +#' @source Mouse gene list is from: SI Table 4 from \doi{10.1016/j.neuron.2017.09.026}. Human +#' gene list was compiled by first creating homologous gene list using biomaRt and then adding some manually curated +#' homologs according to HGNC. +#' +"ieg_gene_list" diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 36ac8a511c..86089193a0 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -132,7 +132,7 @@ Assay_Present <- function( } # Return message of assays not found - if (length(x = bad_assays) > 0 && omit_warn) { + if (length(x = bad_assays) > 0 && isTRUE(x = omit_warn)) { cli_warn(message = c("The following assays were omitted as they were not found:", "i" = "{.field {glue_collapse_scCustom(input_string = bad_assays, and = TRUE)}}.") ) @@ -147,7 +147,7 @@ Assay_Present <- function( } # Print all found message if TRUE - if (print_msg) { + if (isTRUE(x = print_msg)) { cli_inform(message = "All assays present.") } @@ -161,6 +161,33 @@ Assay_Present <- function( } +#' Check whether assay is V5 +# +#' Checks Seurat object to verify whether it is composed of "Assay" or "Assay5" slots. +#' +#' @param seurat_object Seurat object name. +#' @param assay name of assay to check, default is NULL. +#' +#' @return TRUE if seurat_object contains "Assay5" class. +#' +#' @noRd +#' + +Assay5_Check <- function( + seurat_object, + assay = NULL +){ + assay <- assay %||% DefaultAssay(object = seurat_object) + + if (inherits(x = seurat_object@assays[[assay]], what = "Assay")) { + return(FALSE) + } + if (inherits(x = seurat_object@assays[[assay]], what = "Assay5")) { + return(TRUE) + } +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### WARN/ERROR MESSAGING #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -209,7 +236,7 @@ glue_collapse_scCustom <- function( input_length <- length(x = input_string) # set last seperator - if (and) { + if (isTRUE(x = and)) { last_sep <- " and " } else { last_sep <- " or " @@ -230,6 +257,7 @@ glue_collapse_scCustom <- function( #' #' @param object Seurat object #' @param features vector of features and/or meta data variables to plot. +#' @param assay Assay to use (default is the current object default assay). #' #' @return vector of features and/or meta data that were found in object. #' @@ -240,10 +268,14 @@ glue_collapse_scCustom <- function( Feature_PreCheck <- function( object, - features + features, + assay = NULL ) { + # set assay (if null set to active assay) + assay <- assay %||% DefaultAssay(object = object) + # 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) + features_list <- Gene_Present(data = object, gene_list = features, omit_warn = FALSE, print_msg = FALSE, case_check_msg = FALSE, return_none = TRUE, seurat_assay = assay) meta_list <- Meta_Present(seurat_object = object, meta_col_names = features_list[[2]], omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) @@ -278,6 +310,576 @@ Feature_PreCheck <- function( } +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### QC HELPERS #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' Ensembl Mito IDs +#' +#' Retrieves Ensembl IDs for mitochondrial genes +#' +#' @param species species to retrieve IDs. +#' +#' @return vector of Ensembl Gene IDs +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_Ensembl_Mito <- function( + species +) { + # Accepted species names + accepted_names <- data.frame( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + # Species Spelling Options + mouse_options <- accepted_names$Mouse_Options + human_options <- accepted_names$Human_Options + marmoset_options <- accepted_names$Marmoset_Options + zebrafish_options <- accepted_names$Zebrafish_Options + rat_options <- accepted_names$Rat_Options + drosophila_options <- accepted_names$Drosophila_Options + macaque_options <- accepted_names$Macaque_Options + + if (species %in% marmoset_options) { + cli_abort(message = "Marmoset mitochondrial genome is not part of current Ensembl build.") + } + + if (species %in% mouse_options) { + mito_ensembl <- ensembl_mito_id$Mus_musculus_mito_ensembl + } + if (species %in% human_options) { + mito_ensembl <- ensembl_mito_id$Homo_sapiens_mito_ensembl + } + if (species %in% zebrafish_options) { + mito_ensembl <- ensembl_mito_id$Danio_rerio_mito_ensembl + } + if (species %in% rat_options) { + mito_ensembl <- ensembl_mito_id$Rattus_norvegicus_mito_ensembl + } + if (species %in% drosophila_options) { + mito_ensembl <- ensembl_mito_id$Drosophila_melanogaster_mito_ensembl + } + if (species %in% macaque_options) { + mito_ensembl <- ensembl_mito_id$Macaca_mulatta_mito_ensembl + } + + return(mito_ensembl) +} + + +#' Ensembl Ribo IDs +#' +#' Retrieves Ensembl IDs for ribosomal genes +#' +#' @param species species to retrieve IDs. +#' +#' @return vector of Ensembl Gene IDs +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_Ensembl_Ribo <- function( + species +) { + # Accepted species names + accepted_names <- data.frame( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + # Species Spelling Options + mouse_options <- accepted_names$Mouse_Options + human_options <- accepted_names$Human_Options + marmoset_options <- accepted_names$Marmoset_Options + zebrafish_options <- accepted_names$Zebrafish_Options + rat_options <- accepted_names$Rat_Options + drosophila_options <- accepted_names$Drosophila_Options + macaque_options <- accepted_names$Macaque_Options + + if (species %in% mouse_options) { + ribo_ensembl <- ensembl_ribo_id$Mus_musculus_ribo_ensembl + } + if (species %in% human_options) { + ribo_ensembl <- ensembl_ribo_id$Homo_sapiens_ribo_ensembl + } + if (species %in% zebrafish_options) { + ribo_ensembl <- ensembl_ribo_id$Callithrix_jacchus_ribo_ensembl + } + if (species %in% zebrafish_options) { + ribo_ensembl <- ensembl_ribo_id$Danio_rerio_ribo_ensembl + } + if (species %in% rat_options) { + ribo_ensembl <- ensembl_ribo_id$Rattus_norvegicus_ribo_ensembl + } + if (species %in% drosophila_options) { + ribo_ensembl <- ensembl_ribo_id$Drosophila_melanogaster_ribo_ensembl + } + if (species %in% macaque_options) { + ribo_ensembl <- ensembl_ribo_id$Macaca_mulatta_ribo_ensembl + } + + return(ribo_ensembl) +} + + +#' Retrieve MSigDB Gene Lists +#' +#' Retrieves species specific gene lists for MSigDB QC Hallmark lists: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", +#' "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". +#' +#' @param species species to retrieve IDs. +#' +#' @return list of 3 sets of gene_symbols +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + + Retrieve_MSigDB_Lists <- function( + species + ) { + # Accepted species names + accepted_names <- data.frame( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + # Species Spelling Options + mouse_options <- accepted_names$Mouse_Options + human_options <- accepted_names$Human_Options + marmoset_options <- accepted_names$Marmoset_Options + zebrafish_options <- accepted_names$Zebrafish_Options + rat_options <- accepted_names$Rat_Options + drosophila_options <- accepted_names$Drosophila_Options + macaque_options <- accepted_names$Macaque_Options + + if (species %in% marmoset_options) { + cli_abort(message = "Marmoset is not currently a part of MSigDB gene list database.") + } + + # set prefix + if (species %in% mouse_options) { + prefix <- "Mus_musculus_" + } + if (species %in% human_options) { + prefix <- "Homo_sapiens_" + } + if (species %in% zebrafish_options) { + prefix <- "Dario_rerio_" + } + if (species %in% rat_options) { + prefix <- "Rattus_norvegicus_" + } + if (species %in% drosophila_options) { + prefix <- "Drosophila_melanogaster_" + } + if (species %in% macaque_options) { + prefix <- "Macaca_mulatta_" + } + + # set list names + oxphos <- paste0(prefix, "msigdb_oxphos") + apop <- paste0(prefix, "msigdb_apop") + dna_repair <- paste0(prefix, "msigdb_dna_repair") + + # pull lists + qc_gene_list <- list( + oxphos = msigdb_qc_gene_list[[oxphos]], + apop = msigdb_qc_gene_list[[apop]], + dna_repair = msigdb_qc_gene_list[[dna_repair]] + ) + + return(qc_gene_list) + } + + + #' Retrieve IEG Gene Lists + #' + #' Retrieves species specific IEG gene lists + #' + #' @param species species to retrieve IDs. + #' + #' @return list of 2 sets of gene_symbols + #' + #' @import cli + #' + #' @keywords internal + #' + #' @noRd + #' + + Retrieve_IEG_Lists <- function( + species + ) { + # Accepted species names + accepted_names <- data.frame( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + # Species Spelling Options + mouse_options <- accepted_names$Mouse_Options + human_options <- accepted_names$Human_Options + marmoset_options <- accepted_names$Marmoset_Options + zebrafish_options <- accepted_names$Zebrafish_Options + rat_options <- accepted_names$Rat_Options + drosophila_options <- accepted_names$Drosophila_Options + macaque_options <- accepted_names$Macaque_Options + + if (species %in% c(marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options)) { + cli_abort(message = "Rat, Marmoset, Macaque, Zebrafish, and Drosophila are not currently supported.") + } + + # set prefix + if (species %in% mouse_options) { + prefix <- "Mus_musculus_" + } + if (species %in% human_options) { + prefix <- "Homo_sapiens_" + } + + # set list names + ieg <- paste0(prefix, "IEG") + + # pull lists + qc_gene_list <- list( + ieg = ieg_gene_list[[ieg]] + ) + + return(qc_gene_list) + } + + + #' Add MSigDB Gene Lists Percentages + #' + #' Adds percentage of counts from 3 hallmark MSigDB hallmark gene sets: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", + #' "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". + #' + #' @param seurat_object object name. + #' @param species Species of origin for given Seurat Object. Only accepted species are: mouse, human, + #' zebrafish, rat, drosophila, or rhesus macaque (name or abbreviation) + #' @param oxphos_name name to use for the new meta.data column containing percent MSigDB Hallmark oxidative + #' phosphorylation counts. Default is "percent_oxphos". + #' @param apop_name name to use for the new meta.data column containing percent MSigDB Hallmark apoptosis counts. + #' Default is "percent_apop". + #' @param dna_repair_name name to use for the new meta.data column containing percent MSigDB Hallmark DNA repair counts. + #' Default is "percent_oxphos". + #' @param assay Assay to use (default is the current object default assay). + #' @param overwrite Logical. Whether to overwrite existing meta.data columns. Default is FALSE meaning that + #' function will abort if columns with any one of the names provided to `mito_name` `ribo_name` or + #' `mito_ribo_name` is present in meta.data slot. + #' + #' @return Seurat object + #' + #' @import cli + #' + #' @keywords internal + #' + #' @noRd + #' + + + Add_MSigDB_Seurat <- function( + seurat_object, + species, + oxphos_name = "percent_oxphos", + apop_name = "percent_apop", + dna_repair_name = "percent_dna_repair", + assay = NULL, + overwrite = FALSE + ) { + # Accepted species names + accepted_names <- list( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + if (!species %in% unlist(x = accepted_names)) { + cli_inform(message = "The supplied species ({.field {species}}) is not currently supported.") + } + + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # Check name collision + if (any(duplicated(x = c(oxphos_name, apop_name, dna_repair_name)))) { + cli_abort(message = "One or more of values provided to {.code oxphos_name}, {.code apop_name}, {.code dna_repair_name} are identical.") + } + + # Overwrite check + if (oxphos_name %in% colnames(x = seurat_object@meta.data) || apop_name %in% colnames(x = seurat_object@meta.data) || dna_repair_name %in% colnames(x = seurat_object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Columns with {.val {oxphos_name}} and/or {.val {apop_name}} already present in meta.data slot.", + "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE} or change respective {.code oxphos_name}, {.code apop_name}, and/or {.code dna_repair_name}*") + ) + } + cli_inform(message = c("Columns with {.val {oxphos_name}} and/or {.val {apop_name}} already present in meta.data slot.", + "i" = "Overwriting those columns as .code {overwrite = TRUE.}") + ) + } + + # Set default assay + assay <- assay %||% DefaultAssay(object = seurat_object) + + # Retrieve gene lists + msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + + oxphos_found <- Feature_PreCheck(object = seurat_object, features = msigdb_gene_list[["oxphos"]]) + apop_found <- Feature_PreCheck(object = seurat_object, features = msigdb_gene_list[["apop"]]) + dna_repair_found <- Feature_PreCheck(object = seurat_object, features = msigdb_gene_list[["dna_repair"]]) + + # Add mito and ribo columns + if (length(x = oxphos_found) > 0) { + seurat_object[[oxphos_name]] <- PercentageFeatureSet(object = seurat_object, features = oxphos_found, assay = assay) + } + if (length(x = apop_found) > 0) { + seurat_object[[apop_name]] <- PercentageFeatureSet(object = seurat_object, features = apop_found, assay = assay) + } + if (length(x = dna_repair_found) > 0) { + seurat_object[[dna_repair_name]] <- PercentageFeatureSet(object = seurat_object, features = dna_repair_found, assay = assay) + } + + # return final object + return(seurat_object) + } + + + + #' Add IEG Gene List Percentages + #' + #' Adds percentage of counts from IEG genes from mouse and human. + #' + #' @param seurat_object object name. + #' @param species Species of origin for given Seurat Object. Only accepted species are: mouse, human (name or abbreviation). + #' @param ieg_name name to use for the new meta.data column containing percent IEG gene counts. Default is "percent_ieg". + #' @param assay Assay to use (default is the current object default assay). + #' @param overwrite Logical. Whether to overwrite existing meta.data columns. Default is FALSE meaning that + #' function will abort if columns with the name provided to `ieg_name` is present in meta.data slot. + #' + #' @return Seurat object + #' + #' @import cli + #' + #' @keywords internal + #' + #' @noRd + #' + + + Add_IEG_Seurat <- function( + seurat_object, + species, + ieg_name = "percent_ieg", + assay = NULL, + overwrite = FALSE + ) { + # Accepted species names + accepted_names <- list( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + if (!species %in% unlist(x = accepted_names)) { + cli_inform(message = "The supplied species ({.field {species}}) is not currently supported.") + } + + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # Overwrite check + if (ieg_name %in% colnames(x = seurat_object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Column with {.val {ieg_name}} already present in meta.data slot.", + "i" = "*To run function and overwrite column set parameter {.code overwrite = TRUE} or change respective {.code ieg_name}*") + ) + } + cli_inform(message = c("Column with {.val {ieg_name}} already present in meta.data slot.", + "i" = "Overwriting those column as .code {overwrite = TRUE.}") + ) + } + + # Set default assay + assay <- assay %||% DefaultAssay(object = seurat_object) + + # Retrieve gene lists + ieg_gene_list <- Retrieve_IEG_Lists(species = species) + + ieg_found <- Feature_PreCheck(object = seurat_object, features = ieg_gene_list[["ieg"]]) + + # Add mito and ribo columns + if (length(x = ieg_found) > 0) { + seurat_object[[ieg_name]] <- PercentageFeatureSet(object = seurat_object, features = ieg_found, assay = assay) + } + + # return final object + return(seurat_object) + } + + + #' Return default QC features + #' + #' Returns default QC features full names when provided with shortcut name. + #' + #' @param seurat_object object name. + #' @param features vector of features to check against defaults. + #' @param print_defaults return the potential accepted default values. + #' + #' @return list of found and not found features + #' + #' @import cli + #' + #' @keywords internal + #' + #' @noRd + #' + + Return_QC_Defaults <- function( + seurat_object, + features, + print_defaults = FALSE + ) { + # default values + feature_defaults <- list( + feature = c("features", "Features", "genes", "Genes"), + UMIs = c("counts", "Counts", "umis", "umi", "UMI", "UMIs", "UMIS"), + mito = c("mito", "Mito"), + ribo = c("ribo", "Ribo"), + mito_ribo = c("mito_ribo", "Mito_Ribo"), + complexity = c("complexity", "Complexity"), + top_pct = c("top_pct", "Top_Pct"), + IEG = c("ieg", "IEG"), + OXPHOS = c("oxphos", "OXPHOS"), + APOP = c("apop", "Apop"), + DNA_Repair = c("dna_repair", "DNA_Repair") + ) + + # if print is TRUE + if (isTRUE(x = print_defaults)) { + cli_inform(message = c("Accepted default values are:", + "{.field {glue_collapse_scCustom(input_string = unlist(feature_defaults), and = TRUE)}}")) + stop_quietly() + } + + # Assign values + if (any(features %in% feature_defaults[[1]])) { + default1 <- "nFeature_RNA" + } else { + default1 <- NULL + } + if (any(features %in% feature_defaults[[2]])) { + default2 <- "nCount_RNA" + } else { + default2 <- NULL + } + if (any(features %in% feature_defaults[[3]])) { + default3 <- "percent_mito" + } else { + default3 <- NULL + } + if (any(features %in% feature_defaults[[4]])) { + default4 <- "percent_ribo" + } else { + default4 <- NULL + } + if (any(features %in% feature_defaults[[5]])) { + default5 <- "percent_mito_ribo" + } else { + default5 <- NULL + } + if (any(features %in% feature_defaults[[6]])) { + default6 <- "log10GenesPerUMI" + } else { + default6 <- NULL + } + if (any(features %in% feature_defaults[[7]])) { + default7 <- grep(pattern = "percent_top", x = colnames(x = seurat_object@meta.data), value = TRUE) + } else { + default7 <- NULL + } + if (any(features %in% feature_defaults[[8]])) { + default8 <- "percent_ieg" + } else { + default8 <- NULL + } + if (any(features %in% feature_defaults[[9]])) { + default9 <- "percent_oxphos" + } else { + default9 <- NULL + } + if (any(features %in% feature_defaults[[10]])) { + default10 <- "percent_apop" + } else { + default10 <- NULL + } + if (any(features %in% feature_defaults[[11]])) { + default11 <- "percent_dna_repair" + } else { + default11 <- NULL + } + + # All found defaults + all_found_defaults <- c(default1, default2, default3, default4, default5, default6, default7, default8, default9, default10, default11) + + # get not found features + not_found_defaults <- features[!features %in% unlist(feature_defaults)] + + # create return list + feat_list <- list( + found_defaults = all_found_defaults, + not_found_defaults = not_found_defaults + ) + + # return feature list + return(feat_list) + } + + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### GENERAL HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -381,130 +983,309 @@ symdiff <- function( } -#' Ensembl Mito IDs +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### METRICS HELPERS #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' Read Gene Expression Statistics from 10X Cell Ranger Count #' -#' Retrieves Ensembl IDs for mitochondrial genes +#' Get data.frame with all metrics from the Cell Ranger `count` analysis (present in web_summary.html) #' -#' @param species species to retrieve IDs. +#' @param base_path path to the parent directory which contains all of the subdirectories of interest. +#' @param secondary_path path from the parent directory to count "outs/" folder which contains the +#' "metrics_summary.csv" file. +#' @param default_10X logical (default TRUE) sets the secondary path variable to the default 10X directory structure. +#' @param lib_list a list of sample names (matching directory names) to import. If `NULL` will read +#' in all samples in parent directory. +#' @param lib_names a set of sample names to use for each sample. If `NULL` will set names to the +#' directory name of each sample. #' -#' @return vector of Ensembl Gene IDs +#' @return A data frame with sample metrics produced by Cell Ranger `count` pipeline. #' #' @import cli +#' @import pbapply +#' @importFrom dplyr bind_rows setdiff +#' @importFrom utils txtProgressBar setTxtProgressBar read.csv #' #' @keywords internal #' #' @noRd #' +#' @examples +#' \dontrun{ +#' count_metrics <- Metrics_Count_GEX(base_path = base_path, lib_list = lib_list, secondary_path = secondary_path, lib_names = lib_names) +#' } +#' + +Metrics_Count_GEX <- function( + lib_list, + base_path, + secondary_path, + lib_names +){ + cli_inform(message = "Reading {.field Gene Expression} Metrics") + raw_data_list <- pblapply(1:length(x = lib_list), function(x) { + if (is.null(x = secondary_path)) { + file_path <- file.path(base_path, lib_list[x]) + } else { + file_path <- file.path(base_path, lib_list[x], secondary_path) + } -Retrieve_Ensembl_Mito <- function( - species -) { - # Accepted species names - accepted_names <- data.frame( - Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), - Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), - Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), - Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), - Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), - Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), - Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) - ) + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = F) + # Change format of numeric columns to due commas in data csv output. + column_numbers <- grep(pattern = ",", x = raw_data[1, ]) + raw_data[,c(column_numbers)] <- lapply(raw_data[,c(column_numbers)],function(x){as.numeric(gsub(",", "", x))}) - # Species Spelling Options - mouse_options <- accepted_names$Mouse_Options - human_options <- accepted_names$Human_Options - marmoset_options <- accepted_names$Marmoset_Options - zebrafish_options <- accepted_names$Zebrafish_Options - rat_options <- accepted_names$Rat_Options - drosophila_options <- accepted_names$Drosophila_Options - macaque_options <- accepted_names$Macaque_Options - if (species %in% marmoset_options) { - cli_abort(message = "Marmoset mitochondrial genome is not part of current Ensembl build.") - } + column_numbers_pct <- grep(pattern = "%", x = raw_data[1, ]) + all_columns <- 1:ncol(x = raw_data) - if (species %in% mouse_options) { - mito_ensembl <- ensembl_mito_id$Mus_musculus_mito_ensembl - } - if (species %in% human_options) { - mito_ensembl <- ensembl_mito_id$Homo_sapiens_mito_ensembl - } - if (species %in% zebrafish_options) { - mito_ensembl <- ensembl_mito_id$Danio_rerio_mito_ensembl - } - if (species %in% rat_options) { - mito_ensembl <- ensembl_mito_id$Rattus_norvegicus_mito_ensembl - } - if (species %in% drosophila_options) { - mito_ensembl <- ensembl_mito_id$Drosophila_melanogaster_mito_ensembl + column_numbers_numeric <- setdiff(x = all_columns, y = column_numbers_pct) + + raw_data[,c(column_numbers_numeric)] <- lapply(raw_data[,c(column_numbers_numeric)],function(x){as.numeric(x)}) + + return(raw_data) + }) + + # Name the list items + if (is.null(x = lib_names)) { + names(x = raw_data_list) <- lib_list + } else { + names(x = raw_data_list) <- lib_names } - if (species %in% macaque_options) { - mito_ensembl <- ensembl_mito_id$Macaca_mulatta_mito_ensembl + + # Combine the list and add sample_id column + full_data <- bind_rows(raw_data_list, .id = "sample_id") + + # Change column nams to use "_" separator instead of "." for readability + colnames(x = full_data) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = full_data)) + + rownames(x = full_data) <- full_data$sample_id + + return(full_data) + +} + + +#' Read Gene Expression Statistics from 10X Cell Ranger multi +#' +#' Get data.frame with all gene expression metrics from the Cell Ranger `multi` analysis (present in web_summary.html) +#' +#' @param base_path path to the parent directory which contains all of the subdirectories of interest. +#' @param secondary_path path from the parent directory to count "outs/" folder which contains the +#' "metrics_summary.csv" file. +#' @param default_10X logical (default TRUE) sets the secondary path variable to the default 10X directory structure. +#' @param lib_list a list of sample names (matching directory names) to import. If `NULL` will read +#' in all samples in parent directory. +#' @param lib_names a set of sample names to use for each sample. If `NULL` will set names to the +#' directory name of each sample. +#' +#' @return A data frame with sample gene expression metrics produced by Cell Ranger `multi` pipeline. +#' +#' @import cli +#' @import pbapply +#' @importFrom dplyr all_of bind_rows filter rename select setdiff +#' @importFrom magrittr "%>%" +#' @importFrom tibble column_to_rownames +#' @importFrom utils txtProgressBar setTxtProgressBar read.csv +#' +#' @keywords internal +#' +#' @noRd +#' +#' @examples +#' \dontrun{ +#' count_multi_metrics <- Metrics_Multi_GEX(base_path = base_path, lib_list = lib_list, secondary_path = secondary_path, lib_names = lib_names) +#' } +#' + +Metrics_Multi_GEX <- function( + lib_list, + base_path, + secondary_path, + lib_names +){ + cli_inform(message = "Reading {.field Gene Expression} Metrics") + + raw_data_list <- pblapply(1:length(x = lib_list), function(x) { + if (is.null(x = secondary_path)) { + file_path <- file.path(base_path, lib_list[x]) + } else { + file_path <- file.path(base_path, lib_list[x], secondary_path, lib_list[x]) + } + + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = F) + + # Change format to column based and select relevant metrics + GEX_metrics <- raw_data %>% + filter(.data[["Grouped.By"]] == "Physical library ID" & .data[["Library.Type"]] == "Gene Expression") %>% + select(all_of(c("Metric.Name", "Metric.Value"))) %>% + column_to_rownames("Metric.Name") %>% + t() %>% + data.frame() + + GEX_metrics2 <- raw_data %>% + filter(.data[["Metric.Name"]] %in% c(c("Median UMI counts per cell", "Median genes per cell", "Median reads per cell", "Total genes detected"))) %>% + select(all_of(c("Metric.Name", "Metric.Value"))) %>% + column_to_rownames("Metric.Name") %>% + t() %>% + data.frame() + + raw_data_gex <- cbind(GEX_metrics, GEX_metrics2) + + # Change format of numeric columns to due commas in data csv output. + column_numbers <- grep(pattern = ",", x = raw_data_gex[1, ]) + raw_data_gex[,c(column_numbers)] <- lapply(raw_data_gex[,c(column_numbers)],function(x){as.numeric(gsub(",", "", x))}) + + # Rename multi columns to match names from count + names_to_replace <- c(Reads.Mapped.to.Genome = "Mapped.to.genome", + Reads.Mapped.Confidently.to.Genome = "Confidently.mapped.to.genome", + Reads.Mapped.Confidently.to.Intergenic.Regions = "Confidently.mapped.to.intergenic.regions", + Reads.Mapped.Confidently.to.Intronic.Regions = "Confidently.mapped.to.intronic.regions", + Reads.Mapped.Confidently.to.Exonic.Regions = "Confidently.mapped.to.exonic.regions", + Reads.Mapped.Confidently.to.Transcriptome = "Confidently.mapped.to.transcriptome", + Reads.Mapped.Antisense.to.Gene = "Confidently.mapped.antisense", + Fraction.Reads.in.Cells = "Confidently.mapped.reads.in.cells", + Estimated.Number.of.Cells = "Estimated.number.of.cells", + Mean.Reads.per.Cell = "Mean.reads.per.cell", + Median.Genes.per.Cell = "Median.genes.per.cell", + Number.of.Reads = "Number.of.reads", + Valid.Barcodes = "Valid.barcodes", + Sequencing.Saturation = "Sequencing.saturation", + Total.Genes.Detected = "Total.genes.detected", + Median.UMI.Counts.per.Cell = "Median.UMI.counts.per.cell") + + raw_data_gex <- raw_data_gex %>% + rename(all_of(names_to_replace)) + + column_numbers_pct <- grep(pattern = "%", x = raw_data_gex[1, ]) + all_columns <- 1:ncol(x = raw_data_gex) + + column_numbers_numeric <- setdiff(x = all_columns, y = column_numbers_pct) + + raw_data_gex[,c(column_numbers_numeric)] <- lapply(raw_data_gex[,c(column_numbers_numeric)],function(x){as.numeric(x)}) + + return(raw_data_gex) + }) + + # Name the list items + if (is.null(x = lib_names)) { + names(x = raw_data_list) <- lib_list + } else { + names(x = raw_data_list) <- lib_names } - return(mito_ensembl) + # Combine the list and add sample_id column + full_data <- bind_rows(raw_data_list, .id = "sample_id") + + # Change column nams to use "_" separator instead of "." for readability + colnames(x = full_data) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = full_data)) + + rownames(x = full_data) <- full_data$sample_id + + return(full_data) } -#' Ensembl Ribo IDs +#' Read VDJ T Statistics from 10X Cell Ranger multi #' -#' Retrieves Ensembl IDs for ribsomal genes +#' Get data.frame with all VDJ T metrics from the Cell Ranger `multi` analysis (present in web_summary.html) #' -#' @param species species to retrieve IDs. +#' @param base_path path to the parent directory which contains all of the subdirectories of interest. +#' @param secondary_path path from the parent directory to count "outs/" folder which contains the +#' "metrics_summary.csv" file. +#' @param default_10X logical (default TRUE) sets the secondary path variable to the default 10X directory structure. +#' @param lib_list a list of sample names (matching directory names) to import. If `NULL` will read +#' in all samples in parent directory. +#' @param lib_names a set of sample names to use for each sample. If `NULL` will set names to the +#' directory name of each sample. #' -#' @return vector of Ensembl Gene IDs +#' @return A data frame with sample VDJ T metrics produced by Cell Ranger `multi` pipeline. #' #' @import cli +#' @import pbapply +#' @importFrom dplyr all_of bind_rows filter select setdiff +#' @importFrom magrittr "%>%" +#' @importFrom tibble column_to_rownames +#' @importFrom utils txtProgressBar setTxtProgressBar read.csv #' #' @keywords internal #' #' @noRd #' +#' @examples +#' \dontrun{ +#' vdj_multi_metrics <- Metrics_Multi_VDJT(base_path = base_path, lib_list = lib_list, secondary_path = secondary_path, lib_names = lib_names) +#' } +#' + +Metrics_Multi_VDJT <- function( + lib_list, + base_path, + secondary_path, + lib_names +){ + cli_inform(message = "Reading {.field VDJ T} Metrics") + + raw_data_list <- pblapply(1:length(x = lib_list), function(x) { + if (is.null(x = secondary_path)) { + file_path <- file.path(base_path, lib_list[x]) + } else { + file_path <- file.path(base_path, lib_list[x], secondary_path, lib_list[x]) + } -Retrieve_Ensembl_Ribo <- function( - species -) { - # Accepted species names - accepted_names <- data.frame( - Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), - Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), - Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), - Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), - Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), - Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), - Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) - ) + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = F) - # Species Spelling Options - mouse_options <- accepted_names$Mouse_Options - human_options <- accepted_names$Human_Options - marmoset_options <- accepted_names$Marmoset_Options - zebrafish_options <- accepted_names$Zebrafish_Options - rat_options <- accepted_names$Rat_Options - drosophila_options <- accepted_names$Drosophila_Options - macaque_options <- accepted_names$Macaque_Options + VDJ_T_Metrics <- raw_data %>% + filter(.data[["Grouped.By"]]== "Physical library ID" & .data[["Library.Type"]] == "VDJ T") %>% + select(all_of(c("Metric.Name", "Metric.Value"))) %>% + column_to_rownames("Metric.Name") %>% + t() %>% + data.frame() - if (species %in% mouse_options) { - ribo_ensembl <- ensembl_ribo_id$Mus_musculus_ribo_ensembl - } - if (species %in% human_options) { - ribo_ensembl <- ensembl_ribo_id$Homo_sapiens_ribo_ensembl - } - if (species %in% zebrafish_options) { - ribo_ensembl <- ensembl_ribo_id$Callithrix_jacchus_ribo_ensembl - } - if (species %in% zebrafish_options) { - ribo_ensembl <- ensembl_ribo_id$Danio_rerio_ribo_ensembl - } - if (species %in% rat_options) { - ribo_ensembl <- ensembl_ribo_id$Rattus_norvegicus_ribo_ensembl - } - if (species %in% drosophila_options) { - ribo_ensembl <- ensembl_ribo_id$Drosophila_melanogaster_ribo_ensembl - } - if (species %in% macaque_options) { - ribo_ensembl <- ensembl_ribo_id$Macaca_mulatta_ribo_ensembl + VDJ_T_Metrics2 <- raw_data %>% + filter(.data[["Metric.Name"]] %in% c("Cells with productive TRA contig", "Cells with productive TRB contig", "Cells with productive V-J spanning (TRA, TRB) pair", "Cells with productive V-J spanning pair", "Median TRA UMIs per Cell", "Median TRB UMIs per Cell", "Number of cells with productive V-J spanning pair", "Paired clonotype diversity") + ) %>% + select(all_of(c("Metric.Name", "Metric.Value"))) %>% + column_to_rownames("Metric.Name") %>% + t() %>% + data.frame() + + raw_data_vdjt <- cbind(VDJ_T_Metrics, VDJ_T_Metrics2) + + column_numbers <- grep(pattern = ",", x = raw_data_vdjt[1, ]) + raw_data_vdjt[,c(column_numbers)] <- lapply(raw_data_vdjt[,c(column_numbers)],function(x){as.numeric(gsub(",", "", x))}) + + column_numbers_pct <- grep(pattern = "%", x = raw_data_vdjt[1, ]) + all_columns <- 1:ncol(x = raw_data_vdjt) + + column_numbers_numeric <- setdiff(x = all_columns, y = column_numbers_pct) + + raw_data_vdjt[,c(column_numbers_numeric)] <- lapply(raw_data_vdjt[,c(column_numbers_numeric)],function(x){as.numeric(x)}) + + return(raw_data_vdjt) + }) + + # Name the list items + if (is.null(x = lib_names)) { + names(x = raw_data_list) <- lib_list + } else { + names(x = raw_data_list) <- lib_names } - return(ribo_ensembl) + # test_return <- lapply(1:length(test_return), function(i) { + # test_return[[i]]$Estimated.number.of.cells <- as.numeric(test_return[[i]]$Estimated.number.of.cells) + # }) + + # Combine the list and add sample_id column + full_data <- bind_rows(raw_data_list, .id = "sample_id") + + # Change column nams to use "_" separator instead of "." for readability + colnames(x = full_data) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = full_data)) + + rownames(x = full_data) <- full_data$sample_id + + return(full_data) } + diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 772117de7b..8537f359f3 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -80,11 +80,11 @@ DimPlot_LIGER <- function( Is_LIGER(liger_object = liger_object) # Set group_by defaults - if (!combination && is.null(x = group_by)) { + if (isFALSE(x = combination) && is.null(x = group_by)) { group_by <- "cluster" } - if (combination && is.null(x = group_by)) { + if (isTRUE(x = combination) && is.null(x = group_by)) { group_by <- "dataset" } @@ -118,7 +118,7 @@ DimPlot_LIGER <- function( # Add raster check for scCustomize raster <- raster %||% (nrow(x = liger_object@cell.data) > 2e5) - if (raster && (nrow(x = liger_object@cell.data) > 2e5) && getOption(x = 'scCustomize_warn_raster_LIGER', default = TRUE)) { + if (isTRUE(x = raster) && (nrow(x = liger_object@cell.data) > 2e5) && getOption(x = 'scCustomize_warn_raster_LIGER', default = TRUE)) { cli_inform(message = c("", "Rasterizing points since number of points exceeds 200,000.", "To disable this behavior set {.code raster = FALSE}", @@ -139,7 +139,7 @@ DimPlot_LIGER <- function( y_axis_label <- paste0(reduction_label, "_2") # plot combination plot - if (combination) { + if (isTRUE(x = combination)) { p1 <- Plot_By_Cluster_LIGER(liger_object = liger_object, colors_use = colors_use_cluster, split_by = split_by, @@ -322,7 +322,7 @@ plotFactors_scCustom <- function( Is_LIGER(liger_object = liger_object) # if returning and saving - if (save_plots) { + if (isTRUE(x = save_plots)) { # Check file path is valid if (!is.null(x = file_path) && file_path != "") { @@ -378,7 +378,7 @@ plotFactors_scCustom <- function( # Default Colors for Factor Plots if (is.null(x = colors_use_factors)) { - if (ggplot_default_colors) { + if (isTRUE(x = ggplot_default_colors)) { colors_use_factors <- Hue_Pal(num_colors = num_datasets) } else { colors_use_factors <- DiscretePalette_scCustomize(num_colors = num_datasets, palette = "varibow", shuffle_pal = TRUE, seed = color_seed) @@ -423,7 +423,7 @@ plotFactors_scCustom <- function( h_df = data.frame(x = 1:nrow(Hs_norm), h_norm = Hs_norm[, i], h_raw = H_raw[, i], dataset = liger_object@cell.data$dataset, highlight = FALSE) - if (raster) { + if (isTRUE(x = raster)) { top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + labs(x = 'Cell', y = 'Raw H Score') + @@ -460,7 +460,7 @@ plotFactors_scCustom <- function( if (!is.null(cells.highlight)) { h_df[cells.highlight, 'highlight'] = TRUE - if (raster) { + if (isTRUE(x = raster)) { top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), aes(.data[["x"]], .data[["h_raw"]]), col = "black", @@ -486,16 +486,16 @@ plotFactors_scCustom <- function( plot_list[[i]] = full # plot tSNE/UMAP - if (plot_dimreduc) { + if (isTRUE(x = plot_dimreduc)) { tsne_df <- data.frame(Hs_norm[, i], liger_object@tsne.coords) factorlab <- paste0("Factor", i) colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) - if (order) { + if (isTRUE(x = order)) { tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] } - if (raster) { + if (isTRUE(x = raster)) { p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + geom_scattermore(pointsize = pt.size_dimreduc, pixels = raster.dpi) + ggtitle(label = paste('Factor', i)) + @@ -527,12 +527,12 @@ plotFactors_scCustom <- function( } # save plots - if (save_plots) { + if (isTRUE(x = save_plots)) { cli_inform(message = "{.field Saving plots to file}") pdf(paste(file_path, file_name, ".pdf", sep="")) pb <- txtProgressBar(min = 0, max = length(x = 1:k), style = 3, file = stderr()) for (i in 1:k) { - if (plot_dimreduc) { + if (isTRUE(x = plot_dimreduc)) { print(plot_list[[i]]) print(tsne_list[[i]]) setTxtProgressBar(pb = pb, value = i) @@ -546,7 +546,7 @@ plotFactors_scCustom <- function( } # return plots - if (return_plots) { + if (isTRUE(x = return_plots)) { return(list(factor_plots = plot_list, dimreduc_plots = tsne_list)) } diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 348c5830e3..01bad5e1f5 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -9,9 +9,9 @@ #' @param mito_name name to use for the new meta.data column containing percent mitochondrial counts. #' Default is "percent_mito". #' @param ribo_name name to use for the new meta.data column containing percent ribosomal counts. -#' Default is "percent_mito". +#' Default is "percent_ribo". #' @param mito_ribo_name name to use for the new meta.data column containing percent mitochondrial+ribosomal -#' counts. Default is "percent_mito". +#' counts. Default is "percent_mito_ribo". #' @param mito_pattern A regex pattern to match features against for mitochondrial genes (will set automatically #' if species is mouse or human; marmoset features list saved separately). #' @param ribo_pattern A regex pattern to match features against for ribosomal genes (will set automatically @@ -72,7 +72,7 @@ Add_Mito_Ribo_LIGER <- function( ) # Return list of accepted default species name options - if (list_species_names) { + if (isTRUE(x = list_species_names)) { return(accepted_names) stop_quietly() } @@ -87,7 +87,7 @@ Add_Mito_Ribo_LIGER <- function( # Overwrite check if (mito_name %in% colnames(x = liger_object@cell.data) || ribo_name %in% colnames(x = liger_object@cell.data) || mito_ribo_name %in% colnames(x = liger_object@cell.data)) { - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in cell.data slot.", "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE} or change respective {.code mito_name}, {.code ribo_name}, and/or {.code mito_ribo_name}.*") ) @@ -114,7 +114,7 @@ Add_Mito_Ribo_LIGER <- function( macaque_options <- accepted_names$Macaque_Options # Check ensembl vs patterns - if (ensembl_ids && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern), !is.null(x = mito_features), !is.null(x = ribo_features))) { + if (isTRUE(x = ensembl_ids) && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern), !is.null(x = mito_features), !is.null(x = ribo_features))) { cli_warn(message = c("When using a default species and setting {.code ensembl_ids = TRUE} provided patterns or features are ignored.", "*" = "Supplied {.code mito_pattern}, {.code ribo_pattern}, {.code mito_features}, {.code ribo_features} will be disregarded.") ) @@ -155,13 +155,13 @@ Add_Mito_Ribo_LIGER <- function( } # Check that values are provided for mito and ribo - if (is.null(x = mito_pattern) && is.null(x = mito_features) && is.null(x = ribo_pattern) && is.null(x = ribo_pattern)) { + if (is.null(x = mito_pattern) && is.null(x = mito_features) && is.null(x = ribo_pattern) && is.null(x = ribo_features)) { cli_abort(message = c("No features or patterns provided for mito/ribo genes.", "i" = "Please provide a default species name or pattern/features.")) } # Retrieve ensembl ids if TRUE - if (ensembl_ids) { + if (isTRUE(x = ensembl_ids)) { mito_features <- Retrieve_Ensembl_Mito(species = species) ribo_features <- Retrieve_Ensembl_Ribo(species = species) } @@ -257,7 +257,7 @@ Add_Cell_Complexity_LIGER <- function( # Check columns for overwrite if (meta_col_name %in% colnames(x = liger_object@cell.data)) { - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("Column {.val {meta_col_name}} already present in cell.data slot.", "i" = "*To run function and overwrite column, set parameter {.code overwrite = TRUE} or change respective {.code meta_col_name}*.") ) @@ -331,7 +331,7 @@ Meta_Present_LIGER <- function( } # Print all found message if TRUE - if (print_msg) { + if (isTRUE(x = print_msg)) { cli_inform(message = "All @cell.data columns present.") } @@ -428,10 +428,10 @@ Generate_Plotting_df_LIGER <- function(object, tsne_df[[split_by]] <- object@cell.data[[split_by]] } - if (reorder.idents == TRUE){ + if (isTRUE(x = reorder.idents)) { tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) } - c_names <- names(object@clusters) + c_names <- names(x = object@clusters) if (is.null(x = clusters)) { # if clusters have not been set yet if (length(x = object@clusters) == 0) { @@ -444,7 +444,7 @@ Generate_Plotting_df_LIGER <- function(object, } tsne_df[['Cluster']] <- clusters[c_names] - if (shuffle) { + if (isTRUE(x = shuffle)) { set.seed(shuffle_seed) idx <- sample(x = 1:nrow(tsne_df)) tsne_df <- tsne_df[idx, ] @@ -576,7 +576,7 @@ Plot_By_Cluster_LIGER <- function( y_axis_label <- paste0(reduction_label, "_2") # plot - if (raster) { + if (isTRUE(x = raster)) { if (!is.null(x = split_by)) { p2 <- lapply(1:length(x = list_of_splits), function(x){ p2 <- ggplot(subset(tsne_df, tsne_df[[split_by]] %in% list_of_splits[x]), aes(x = .data[['tsne1']], y = .data[['tsne2']], color = .data[['Cluster']])) + @@ -592,14 +592,14 @@ Plot_By_Cluster_LIGER <- function( xlab(x_axis_label) + ylab(y_axis_label) - if (label_box) { + if (isTRUE(x = label_box)) { geom.use <- ifelse(test = label_repel, yes = geom_label_repel, no = geom_label) p2 <- p2 + geom.use( data = centers, mapping = aes(label = .data[['Cluster']], fill = .data[['Cluster']]), size = label_size, show.legend = FALSE, color = label_color ) + scale_fill_manual(values = colors_use) - } else if (label) { + } else if (isTRUE(x = label)) { geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) p2 <- p2 + geom.use( data = centers, @@ -623,14 +623,14 @@ Plot_By_Cluster_LIGER <- function( xlab(x_axis_label) + ylab(y_axis_label) - if (label_box) { + if (isTRUE(x = label_box)) { geom.use <- ifelse(test = label_repel, yes = geom_label_repel, no = geom_label) p2 <- p2 + geom.use( data = centers, mapping = aes(label = .data[['Cluster']], fill = .data[['Cluster']]), size = label_size, show.legend = FALSE, color = label_color ) + scale_fill_manual(values = colors_use) - } else if (label) { + } else if (isTRUE(x = label)) { geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) p2 <- p2 + geom.use( data = centers, @@ -658,14 +658,14 @@ Plot_By_Cluster_LIGER <- function( xlab(x_axis_label) + ylab(y_axis_label) - if (label_box) { + if (isTRUE(x = label_box)) { geom.use <- ifelse(test = label_repel, yes = geom_label_repel, no = geom_label) p2 <- p2 + geom.use( data = centers, mapping = aes(label = .data[['Cluster']], fill = .data[['Cluster']]), size = label_size, show.legend = FALSE, color = label_color ) + scale_fill_manual(values = colors_use) - } else if (label) { + } else if (isTRUE(x = label)) { geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) p2 <- p2 + geom.use( data = centers, @@ -689,14 +689,14 @@ Plot_By_Cluster_LIGER <- function( xlab(x_axis_label) + ylab(y_axis_label) - if (label_box) { + if (isTRUE(x = label_box)) { geom.use <- ifelse(test = label_repel, yes = geom_label_repel, no = geom_label) p2 <- p2 + geom.use( data = centers, mapping = aes(label = .data[['Cluster']], fill = .data[['Cluster']]), size = label_size, show.legend = FALSE, color = label_color ) + scale_fill_manual(values = colors_use) - } else if (label) { + } else if (isTRUE(x = label)) { geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) p2 <- p2 + geom.use( data = centers, @@ -825,7 +825,7 @@ Plot_By_Meta_LIGER <- function( group_by <- sym(x = group_by) - if (raster) { + if (isTRUE(x = raster)) { if (!is.null(x = split_by)) { p1 <- lapply(1:length(x = list_of_splits), function(x){ ggplot(subset(tsne_df, tsne_df[[split_by]] %in% list_of_splits[x]), aes(x = .data[['tsne1']], y = .data[['tsne2']], color = !!group_by)) + @@ -898,76 +898,76 @@ Plot_By_Meta_LIGER <- function( } -#' Perform variable gene selection over whole dataset -#' -#' Performs variable gene selection for LIGER object across the entire object instead of by -#' dataset and then taking union. -#' -#' @param liger_object LIGER object name. -#' @param num_genes Number of genes to find. Optimizes the value of `var.thresh` to get -#' this number of genes, (Default is NULL). -#' @param var.thresh Variance threshold. Main threshold used to identify variable genes. -#' Genes with expression variance greater than threshold (relative to mean) are selected. -#' (higher threshold -> fewer selected genes). -#' @param alpha.thresh Alpha threshold. Controls upper bound for expected mean gene -#' expression (lower threshold -> higher upper bound). (default 0.99) -#' @param tol Tolerance to use for optimization if num.genes values passed in (default 0.0001). -#' @param do.plot Display log plot of gene variance vs. gene expression. Selected genes are -#' plotted in green. (Default FALSE) -#' @param pt.size Point size for plot. -#' @param chunk size of chunks in hdf5 file. (Default 1000) -#' -#' @return A LIGER Object with variable genes in correct slot. -#' -#' @import cli -#' -#' @references Matching function parameter text descriptions are taken from `rliger::selectGenes` -#' which is called by this function after creating new temporary object/dataset. -#' \url{https://github.com/welch-lab/liger}. (License: GPL-3). -#' -#' @export -#' -#' @concept liger_object_util -#' -#' @examples -#' \dontrun{ -#' liger_obj <- Variable_Features_ALL_LIGER(liger_object = liger_obj, num_genes = 2000) -#' } -#' - -Variable_Features_ALL_LIGER <- function( - liger_object, - num_genes = NULL, - var.thresh = 0.3, - alpha.thresh = 0.99, - tol = 0.0001, - do.plot = FALSE, - pt.size = 0.3, - chunk=1000 -) { - Is_LIGER(liger_object = liger_object) - - raw_data <- liger_object@raw.data - - cli_inform(message = "Creating temporary object with combined data.") - - temp_liger <- rliger::createLiger(raw.data = list("dataset" = Merge_Sparse_Data_All(raw_data)), remove.missing = FALSE) - - rm(raw_data) - gc() - - cli_inform(message = "Normalizing and identifying variable features.") - - 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 - - rm(temp_liger) - gc() - - liger_object@var.genes <- var_genes - return(liger_object) -} +# #' Perform variable gene selection over whole dataset +# #' +# #' Performs variable gene selection for LIGER object across the entire object instead of by +# #' dataset and then taking union. +# #' +# #' @param liger_object LIGER object name. +# #' @param num_genes Number of genes to find. Optimizes the value of `var.thresh` to get +# #' this number of genes, (Default is NULL). +# #' @param var.thresh Variance threshold. Main threshold used to identify variable genes. +# #' Genes with expression variance greater than threshold (relative to mean) are selected. +# #' (higher threshold -> fewer selected genes). +# #' @param alpha.thresh Alpha threshold. Controls upper bound for expected mean gene +# #' expression (lower threshold -> higher upper bound). (default 0.99) +# #' @param tol Tolerance to use for optimization if num.genes values passed in (default 0.0001). +# #' @param do.plot Display log plot of gene variance vs. gene expression. Selected genes are +# #' plotted in green. (Default FALSE) +# #' @param pt.size Point size for plot. +# #' @param chunk size of chunks in hdf5 file. (Default 1000) +# #' +# #' @return A LIGER Object with variable genes in correct slot. +# #' +# #' @import cli +# #' +# #' @references Matching function parameter text descriptions are taken from `rliger::selectGenes` +# #' which is called by this function after creating new temporary object/dataset. +# #' \url{https://github.com/welch-lab/liger}. (License: GPL-3). +# #' +# #' @export +# #' +# #' @concept liger_object_util +# #' +# #' @examples +# #' \dontrun{ +# #' liger_obj <- Variable_Features_ALL_LIGER(liger_object = liger_obj, num_genes = 2000) +# #' } +# #' + +# Variable_Features_ALL_LIGER <- function( +# liger_object, +# num_genes = NULL, +# var.thresh = 0.3, +# alpha.thresh = 0.99, +# tol = 0.0001, +# do.plot = FALSE, +# pt.size = 0.3, +# chunk=1000 +# ) { +# Is_LIGER(liger_object = liger_object) +# +# raw_data <- liger_object@raw.data +# +# cli_inform(message = "Creating temporary object with combined data.") +# +# temp_liger <- rliger::createLiger(raw.data = list("dataset" = Merge_Sparse_Data_All(raw_data)), remove.missing = FALSE) +# +# rm(raw_data) +# gc() +# +# cli_inform(message = "Normalizing and identifying variable features.") +# +# 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 +# +# rm(temp_liger) +# gc() +# +# liger_object@var.genes <- var_genes +# return(liger_object) +# } #' Create a Seurat object containing the data from a liger object @@ -1013,14 +1013,14 @@ Variable_Features_ALL_LIGER <- function( #' } Liger_to_Seurat <- function( - liger_object, - nms = names(liger_object@H), - renormalize = TRUE, - use.liger.genes = TRUE, - by.dataset = FALSE, - keep_meta = TRUE, - reduction_label = NULL, - seurat_assay = "RNA" + liger_object, + nms = names(liger_object@H), + renormalize = TRUE, + use.liger.genes = TRUE, + by.dataset = FALSE, + keep_meta = TRUE, + reduction_label = "UMAP", + seurat_assay = "RNA" ) { if (is.null(x = reduction_label)) { cli_abort(message = c("{.code reduction_label} parameter was not set.", @@ -1061,16 +1061,23 @@ Liger_to_Seurat <- function( var.genes <- gsub("_", replacement = "-", var.genes) } inmf.loadings <- t(x = liger_object@W) + rinmf.loadings <- t(x = liger_object@W) + inmf.embeddings <- liger_object@H.norm + rinmf.embeddings <- do.call(what = 'rbind', args = liger_object@H) + ncol_Hnorm <- ncol(x = liger_object@H.norm) colnames(x = inmf.embeddings) <- paste0("iNMF_", 1:ncol_Hnorm) + colnames(x = rinmf.embeddings) <- paste0("rawiNMF_", 1:ncol_Hnorm) tsne.embeddings <- liger_object@tsne.coords colnames(x = tsne.embeddings) <- paste0(key_name, 1:2) rownames(x = inmf.loadings) <- var.genes rownames(x = inmf.embeddings) <- + rownames(x = rinmf.embeddings) <- rownames(x = tsne.embeddings) <- rownames(x = scale.data) + inmf.obj <- CreateDimReducObject( embeddings = inmf.embeddings, loadings = inmf.loadings, @@ -1078,6 +1085,15 @@ Liger_to_Seurat <- function( global = TRUE, assay = seurat_assay ) + + rinmf.obj <- CreateDimReducObject( + embeddings = rinmf.embeddings, + loadings = rinmf.loadings, + key = "rawiNMF_", + global = TRUE, + assay = seurat_assay + ) + tsne.obj <- CreateDimReducObject( embeddings = tsne.embeddings, key = key_name, @@ -1086,13 +1102,13 @@ Liger_to_Seurat <- function( ) } new.seurat <- CreateSeuratObject(raw.data) - if (renormalize) { + if (isTRUE(x = renormalize)) { new.seurat <- NormalizeData(new.seurat) } - if (by.dataset) { + if (isTRUE(x = by.dataset)) { 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]])])) + paste0(dataset.name, as.character(x = liger_object@clusters[colnames(x = liger_object@raw.data[[i]])])) }))) } else { if (maj_version < 3) { @@ -1108,19 +1124,21 @@ Liger_to_Seurat <- function( } new.seurat@scale.data <- t(scale.data) new.seurat@dr[[reduction_label]] <- tsne.obj - new.seurat@dr$inmf <- inmf.obj + new.seurat@dr$iNMF <- inmf.obj + new.seurat@dr$iNMF <- rinmf.obj new.seurat <- SetIdent(new.seurat, ident.use = ident.use) } else { - if (use.liger.genes) { + if (isTRUE(x = use.liger.genes)) { VariableFeatures(new.seurat) <- var.genes } SetAssayData(new.seurat, slot = "scale.data", t(scale.data), assay = "RNA") new.seurat[[reduction_label]] <- tsne.obj - new.seurat[['inmf']] <- inmf.obj + new.seurat[['iNMF']] <- inmf.obj + new.seurat[['rawiNMF']] <- rinmf.obj Idents(object = new.seurat) <- ident.use } - if (keep_meta){ + if (isTRUE(x = keep_meta)) { # extract meta data from liger object liger_meta <- Fetch_Meta(object = liger_object) # remove meta data values already transferred @@ -1141,4 +1159,3 @@ Liger_to_Seurat <- function( return(new.seurat) } - diff --git a/R/Nebulosa_Plotting.R b/R/Nebulosa_Plotting.R index b0b1634c1e..6662efd4b1 100644 --- a/R/Nebulosa_Plotting.R +++ b/R/Nebulosa_Plotting.R @@ -25,7 +25,8 @@ #' @import ggplot2 #' @import patchwork # #' @importFrom Nebulosa plot_density -#' @importFrom SeuratObject DefaultDimReduc PackageCheck +#' @importFrom rlang is_installed +#' @importFrom SeuratObject DefaultDimReduc #' #' @export #' @@ -51,8 +52,8 @@ Plot_Density_Custom <- function( ... ) { # Check Nebulosa installed - Nebulosa_check <- PackageCheck("Nebulosa", error = FALSE) - if (!Nebulosa_check[1]) { + Nebulosa_check <- is_installed(pkg = "Nebulosa") + if (isFALSE(x = Nebulosa_check)) { cli_abort(message = c( "Please install the {.val Nebulosa} package to use {.code Plot_Density_Custom}", "i" = "This can be accomplished with the following commands: ", @@ -132,7 +133,8 @@ Plot_Density_Custom <- function( #' @import cli #' @import ggplot2 # #' @importFrom Nebulosa plot_density -#' @importFrom SeuratObject DefaultDimReduc PackageCheck +#' @importFrom rlang is_installed +#' @importFrom SeuratObject DefaultDimReduc #' #' @export #' @@ -156,8 +158,8 @@ Plot_Density_Joint_Only <- function( ... ) { # Check Nebulosa installed - Nebulosa_check <- PackageCheck("Nebulosa", error = FALSE) - if (!Nebulosa_check[1]) { + Nebulosa_check <- is_installed(pkg = "Nebulosa") + if (isFALSE(x = Nebulosa_check)) { cli_abort(message = c( "Please install the {.val Nebulosa} package to use {.code Plot_Density_Joint_Only}", "i" = "This can be accomplished with the following commands: ", diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 30a3d15b04..01c6235405 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1,3 +1,85 @@ +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### GENERAL OBJECT UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' Merge a list of Seurat Objects +#' +#' Enables easy merge of a list of Seurat Objects. See See \code{\link[SeuratObject]{merge}} for more information, +#' +#' @param list_seurat list composed of multiple Seurat Objects. +#' @param add.cell.ids A character vector of equal length to the number of objects in `list_seurat`. +#' Appends the corresponding values to the start of each objects' cell names. See \code{\link[SeuratObject]{merge}}. +#' @param merge.data Merge the data slots instead of just merging the counts (which requires renormalization). +#' This is recommended if the same normalization approach was applied to all objects. +#' See \code{\link[SeuratObject]{merge}}. +#' @param project Project name for the Seurat object. See \code{\link[SeuratObject]{merge}}. +#' +#' @import cli +#' @importFrom magrittr "%>%" +#' @importFrom purrr reduce +#' +#' @return A Seurat Object +#' +#' @export +#' +#' @concept object_util +#' +#' @examples +#' \dontrun{ +#' object_list <- list(obj1, obj2, obj3, ...) +#' merged_object <- Merge_Seurat_List(list_seurat = object_list) +#' } +#' + +Merge_Seurat_List <- function( + list_seurat, + add.cell.ids = NULL, + merge.data = TRUE, + project = "SeuratProject" +) { + # Check list_seurat is list + if (!inherits(x = list_seurat, what = "list")) { + cli_abort(message = "{.code list_seurat} must be environmental variable of class {.val list}") + } + + # Check list_seurat is only composed of Seurat objects + for (i in 1:length(x = list_seurat)) { + if (!inherits(x = list_seurat[[i]], what = "Seurat")) { + cli_abort("One or more of entries in {.code list_seurat} are not objects of class {.val Seurat}") + } + } + + # Check all barcodes are unique to begin with + duplicated_barcodes <- list_seurat %>% + lapply(colnames) %>% + unlist() %>% + duplicated() %>% + any() + + if (isTRUE(x = duplicated_barcodes) && is.null(x = add.cell.ids)) { + cli_abort(message = c("There are overlapping cell barcodes present in the input objects", + "i" = "Please rename cells or provide prefixes to {.code add.cell.ids} parameter to make unique.") + ) + } + + # Check right number of suffix/prefix ids are provided + if (!is.null(x = add.cell.ids) && length(x = add.cell.ids) != length(x = list_seurat)) { + cli_abort(message = "The number of prefixes in {.code add.cell.ids} must be equal to the number of objects supplied to {.code list_seurat}.") + } + + # Rename cells if provided + list_seurat <- lapply(1:length(x = list_seurat), function(x) { + list_seurat[[x]] <- RenameCells(object = list_seurat[[x]], add.cell.id = add.cell.ids[x]) + }) + + # Merge objects + merged_object <- reduce(list_seurat, function(x, y) { + merge(x = x, y = y, merge.data = merge.data, project = project) + }) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### QC UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -14,9 +96,9 @@ #' @param mito_name name to use for the new meta.data column containing percent mitochondrial counts. #' Default is "percent_mito". #' @param ribo_name name to use for the new meta.data column containing percent ribosomal counts. -#' Default is "percent_mito". +#' Default is "percent_ribo". #' @param mito_ribo_name name to use for the new meta.data column containing percent -#' mitochondrial+ribosomal counts. Default is "percent_mito". +#' mitochondrial+ribosomal counts. Default is "percent_mito_ribo". #' @param mito_pattern A regex pattern to match features against for mitochondrial genes (will set automatically if #' species is mouse or human; marmoset features list saved separately). #' @param ribo_pattern A regex pattern to match features against for ribosomal genes @@ -48,8 +130,9 @@ #' @concept object_util #' #' @examples -#' library(Seurat) -#' pbmc_small <- Add_Mito_Ribo_Seurat(seurat_object = pbmc_small, species = "human") +#' \dontrun{ +#' obj <- Add_Mito_Ribo_Seurat(seurat_object = obj, species = "human") +#'} #' Add_Mito_Ribo_Seurat <- function( @@ -79,7 +162,7 @@ Add_Mito_Ribo_Seurat <- function( ) # Return list of accepted default species name options - if (list_species_names) { + if (isTRUE(x = list_species_names)) { return(accepted_names) stop_quietly() } @@ -94,7 +177,7 @@ Add_Mito_Ribo_Seurat <- function( # Overwrite check if (mito_name %in% colnames(x = seurat_object@meta.data) || ribo_name %in% colnames(x = seurat_object@meta.data) || mito_ribo_name %in% colnames(x = seurat_object@meta.data)) { - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in meta.data slot.", "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE} or change respective {.code mito_name}, {.code ribo_name}, and/or {.code mito_ribo_name}*") ) @@ -124,7 +207,7 @@ Add_Mito_Ribo_Seurat <- function( macaque_options <- accepted_names$Macaque_Options # Check ensembl vs patterns - if (ensembl_ids && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern), !is.null(x = mito_features), !is.null(x = ribo_features))) { + if (isTRUE(x = ensembl_ids) && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern), !is.null(x = mito_features), !is.null(x = ribo_features))) { cli_warn(message = c("When using a default species and setting {.code ensembl_ids = TRUE} provided patterns or features are ignored.", "*" = "Supplied {.code mito_pattern}, {.code ribo_pattern}, {.code mito_features}, {.code ribo_features} will be disregarded.") ) @@ -164,13 +247,13 @@ Add_Mito_Ribo_Seurat <- function( } # Check that values are provided for mito and ribo - if (is.null(x = mito_pattern) && is.null(x = mito_features) && is.null(x = ribo_pattern) && is.null(x = ribo_pattern)) { + if (is.null(x = mito_pattern) && is.null(x = mito_features) && is.null(x = ribo_pattern) && is.null(x = ribo_features)) { cli_abort(message = c("No features or patterns provided for mito/ribo genes.", "i" = "Please provide a default species name or pattern/features.")) } # Retrieve ensembl ids if TRUE - if (ensembl_ids) { + if (isTRUE(x = ensembl_ids)) { mito_features <- Retrieve_Ensembl_Mito(species = species) ribo_features <- Retrieve_Ensembl_Ribo(species = species) } @@ -273,7 +356,7 @@ Add_Cell_Complexity_Seurat <- function( # Check columns for overwrite if (meta_col_name %in% colnames(x = seurat_object@meta.data)) { - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("Column {.val {meta_col_name}} already present in meta.data slot.", "i" = "*To run function and overwrite column, set parameter {.code overwrite = TRUE} or change respective {.code meta_col_name}*.") ) @@ -295,6 +378,303 @@ Add_Cell_Complexity_Seurat <- function( } +#' Add Percent of High Abundance Genes +#' +#' Add the percentage of counts occupied by the top XX most highly expressed genes in each cell. +#' +#' @param seurat_object object name. +#' @param num_top_genes An integer vector specifying the size(s) of the top set of high-abundance genes. +#' Used to compute the percentage of library size occupied by the most highly expressed genes in each cell. +#' @param meta_col_name name to use for new meta data column. Default is "percent_topXX", where XX is +#' equal to the value provided to `num_top_genes`. +#' @param assay assay to use in calculation. Default is "RNA". *Note* This should only be changed if +#' storing corrected and uncorrected assays in same object (e.g. outputs of both Cell Ranger and Cell Bender). +#' @param overwrite Logical. Whether to overwrite existing an meta.data column. Default is FALSE meaning that +#' function will abort if column with name provided to `meta_col_name` is present in meta.data slot. +#' +#' @import cli +#' @importFrom dplyr select all_of +#' @importFrom magrittr "%>%" +#' @importFrom rlang is_installed +#' @importFrom SeuratObject LayerData +#' +#' @return A Seurat Object +#' +#' @export +#' +#' @concept object_util +#' +#' +#' @references This function uses scuttle package (license: GPL-3) to calculate the percent of expression +#' coming from top XX genes in each cell. Parameter description for `num_top_genes` also from scuttle. +#' If using this function in analysis, in addition to citing scCustomize, please cite scuttle: +#' McCarthy DJ, Campbell KR, Lun ATL, Willis QF (2017). “Scater: pre-processing, quality control, +#' normalisation and visualisation of single-cell RNA-seq data in R.” Bioinformatics, 33, 1179-1186. +#' \url{doi:10.1093/bioinformatics/btw777}. +#' @seealso \url{https://bioconductor.org/packages/release/bioc/html/scuttle.html} +#' +#' @examples +#' library(Seurat) +#' pbmc_small <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc_small, num_top_genes = 50) +#' + +Add_Top_Gene_Pct_Seurat <- function( + seurat_object, + num_top_genes = 50, + meta_col_name = NULL, + assay = "RNA", + overwrite = FALSE +){ + # Check for scuttle first + scuttle_check <- is_installed(pkg = "scuttle") + if (isFALSE(x = scuttle_check)) { + cli_abort(message = c( + "Please install the {.val scuttle} package to calculate/add top {num_top_genes} genes percentage.", + "i" = "This can be accomplished with the following commands: ", + "----------------------------------------", + "{.field `install.packages({symbol$dquote_left}BiocManager{symbol$dquote_right})`}", + "{.field `BiocManager::install({symbol$dquote_left}scuttle{symbol$dquote_right})`}", + "----------------------------------------" + )) + } + + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # Add assay warning message + if (assay != "RNA") { + cli_warn(message = "Assay is set to value other than 'RNA'. This should only be done in rare instances. See documentation for more info ({.code ?Add_Top_Gene_Pct_Seurat}).", + .frequency = "once", + .frequency_id = "assay_warn") + } + + # Set colnames + scuttle_colname <- paste0("percent.top_", num_top_genes) + if (is.null(x = meta_col_name)) { + meta_col_name <- paste0("percent_top", num_top_genes) + } + + # Check columns for overwrite + if (meta_col_name %in% colnames(x = seurat_object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Column {.val {meta_col_name}} already present in meta.data slot.", + "i" = "*To run function and overwrite column, set parameter {.code overwrite = TRUE} or change respective {.code meta_col_name}*.") + ) + } + cli_inform(message = c("Column {.val {meta_col_name}} already present in meta.data slot", + "i" = "Overwriting those columns as {.code overwrite = TRUE}.") + ) + } + + # Extract matrix + count_mat <- LayerData(object = seurat_object, assay = assay) + + # calculate + res <- as.data.frame(scuttle::perCellQCMetrics(x = count_mat, percent.top = num_top_genes)) + + # select percent column + res <- res %>% + select(all_of(scuttle_colname)) + + # Add to object and return + seurat_object <- AddMetaData(object = seurat_object, metadata = res, col.name = meta_col_name) + + return(seurat_object) +} + + +#' Add Multiple Cell Quality Control Values with Single Function +#' +#' Add Mito/Ribo %, Cell Complexity (log10GenesPerUMI), Top Gene Percent with single function call +#' +#' @param seurat_object object name. +#' @param add_mito_ribo logical, whether to add percentage of counts belonging to mitochondrial/ribosomal +#' genes to object (Default is TRUE). +#' @param add_complexity logical, whether to add Cell Complexity to object (Default is TRUE). +#' @param add_top_pct logical, whether to add Top Gene Percentages to object (Default is TRUE). +#' @param add_MSigDB logical, whether to add percentages of counts belonging to genes from of mSigDB hallmark +#' gene lists: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR" to +#' object (Default is TRUE). +#' @param add_IEG logical, whether to add percentage of counts belonging to IEG genes to object (Default is TRUE). +#' @param add_cell_cycle logical, whether to addcell cycle scores and phase based on +#' \code{\link[Seurat]{CellCycleScoring}}. Only applicable if `species = "human"`. (Default is TRUE). +#' @param species Species of origin for given Seurat Object. If mouse, human, marmoset, zebrafish, rat, +#' drosophila, or rhesus macaque (name or abbreviation) are provided the function will automatically +#' generate mito_pattern and ribo_pattern values. +#' @param mito_name name to use for the new meta.data column containing percent mitochondrial counts. +#' Default is "percent_mito". +#' @param ribo_name name to use for the new meta.data column containing percent ribosomal counts. +#' Default is "percent_ribo". +#' @param mito_ribo_name name to use for the new meta.data column containing percent +#' mitochondrial+ribosomal counts. Default is "percent_mito_ribo". +#' @param complexity_name name to use for new meta data column for `Add_Cell_Complexity_Seurat`. +#' Default is "log10GenesPerUMI". +#' @param top_pct_name name to use for new meta data column for `Add_Top_Gene_Pct_Seurat`. +#' Default is "percent_topXX", where XX is equal to the value provided to `num_top_genes`. +#' @param oxphos_name name to use for new meta data column for percentage of MSigDB oxidative phosphorylation +#' counts. Default is "percent_oxphos". +#' @param apop_name name to use for new meta data column for percentage of MSigDB apoptosis counts. +#' Default is "percent_apop". +#' @param dna_repair_name name to use for new meta data column for percentage of MSigDB DNA repair +#' counts. Default is "percent_dna_repair".. +#' @param ieg_name name to use for new meta data column for percentage of IEG counts. Default is "percent_ieg". +#' @param mito_pattern A regex pattern to match features against for mitochondrial genes (will set automatically if +#' species is mouse or human; marmoset features list saved separately). +#' @param ribo_pattern A regex pattern to match features against for ribosomal genes +#' (will set automatically if species is mouse, human, or marmoset). +#' @param mito_features A list of mitochondrial gene names to be used instead of using regex pattern. +#' Will override regex pattern if both are present (including default saved regex patterns). +#' @param ribo_features A list of ribosomal gene names to be used instead of using regex pattern. +#' Will override regex pattern if both are present (including default saved regex patterns). +#' @param ensembl_ids logical, whether feature names in the object are gene names or +#' ensembl IDs (default is FALSE; set TRUE if feature names are ensembl IDs). +#' @param num_top_genes An integer vector specifying the size(s) of the top set of high-abundance genes. +#' Used to compute the percentage of library size occupied by the most highly expressed genes in each cell. +#' @param assay assay to use in calculation. Default is "RNA". *Note* This should only be changed if +#' storing corrected and uncorrected assays in same object (e.g. outputs of both Cell Ranger and Cell Bender). +#' @param overwrite Logical. Whether to overwrite existing an meta.data column. Default is FALSE meaning that +#' function will abort if column with name provided to `meta_col_name` is present in meta.data slot. +#' +#' @import cli +#' @importFrom SeuratObject Layers +#' +#' @return A Seurat Object +#' +#' @export +#' +#' @concept object_util +#' +#' @examples +#' \dontrun{ +#' obj <- Add_Cell_QC_Metrics(seurat_object = obj, species = "Human") +#'} +#' + +Add_Cell_QC_Metrics <- function( + seurat_object, + add_mito_ribo = TRUE, + add_complexity = TRUE, + add_top_pct = TRUE, + add_MSigDB = TRUE, + add_IEG = TRUE, + add_cell_cycle = TRUE, + species, + mito_name = "percent_mito", + ribo_name = "percent_ribo", + mito_ribo_name = "percent_mito_ribo", + complexity_name = "log10GenesPerUMI", + top_pct_name = NULL, + oxphos_name = "percent_oxphos", + apop_name = "percent_apop", + dna_repair_name = "percent_dna_repair", + ieg_name = "percent_ieg", + mito_pattern = NULL, + ribo_pattern = NULL, + mito_features = NULL, + ribo_features = NULL, + ensembl_ids = FALSE, + num_top_genes = 50, + assay = NULL, + overwrite = FALSE +) { + # Set assay + assay <- assay %||% DefaultAssay(object = seurat_object) + + # Accepted species names + accepted_names <- data.frame( + Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), + Human_Options = c("Human", "human", "Hu", "hu", "Hs", "hs"), + Marmoset_Options = c("Marmoset", "marmoset", "CJ", "Cj", "cj", NA), + Zebrafish_Options = c("Zebrafish", "zebrafish", "DR", "Dr", "dr", NA), + Rat_Options = c("Rat", "rat", "RN", "Rn", "rn", NA), + Drosophila_Options = c("Drosophila", "drosophila", "DM", "Dm", "dm", NA), + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA) + ) + + # Species Spelling Options + mouse_options <- accepted_names$Mouse_Options + human_options <- accepted_names$Human_Options + marmoset_options <- accepted_names$Marmoset_Options + zebrafish_options <- accepted_names$Zebrafish_Options + rat_options <- accepted_names$Rat_Options + drosophila_options <- accepted_names$Drosophila_Options + macaque_options <- accepted_names$Macaque_Options + + # Add mito/ribo + if (isTRUE(x = add_mito_ribo)) { + cli_inform(message = "Adding {.field Mito/Ribo Percentages} to meta.data.") + seurat_object <- Add_Mito_Ribo_Seurat(seurat_object = seurat_object, species = species, mito_name = mito_name, ribo_name = ribo_name, mito_ribo_name = mito_ribo_name, mito_pattern = mito_pattern, ribo_pattern = ribo_pattern, mito_features = mito_features, ribo_features = ribo_features, ensembl_ids = ensembl_ids, assay = assay, overwrite = overwrite) + } + + # Add complexity + if (isTRUE(x = add_complexity)) { + cli_inform(message = "Adding {.field Cell Complexity #1 (log10GenesPerUMI)} to meta.data.") + seurat_object <- Add_Cell_Complexity_Seurat(seurat_object = seurat_object, meta_col_name = complexity_name, assay = assay, overwrite = overwrite) + } + + # Add top gene expression percent + if (isTRUE(x = add_top_pct)) { + cli_inform(message = "Adding {.field Cell Complexity #2 (Top {num_top_genes} Percentages)} to meta.data.") + seurat_object <- Add_Top_Gene_Pct_Seurat(seurat_object = seurat_object, num_top_genes = num_top_genes, meta_col_name = top_pct_name, assay = assay, overwrite = overwrite) + } + + # Add MSigDB + if (isTRUE(x = add_MSigDB)) { + if (species %in% marmoset_options) { + cli_warn(message = c("{.val Marmoset} is not currently a part of MSigDB gene list database.", + "i" = "No columns will be added to object meta.data")) + } else { + cli_inform(message = "Adding {.field MSigDB Oxidative Phosphorylation, Apoptosis, and DNA Repair Percentages.} to meta.data.") + seurat_object <- Add_MSigDB_Seurat(seurat_object = seurat_object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, assay = assay, overwrite = overwrite) + } + } + + # Add IEG + if (isTRUE(x = add_IEG)) { + if (species %in% c(marmoset_options, rat_options, zebrafish_options, macaque_options, drosophila_options)) { + cli_warn(message = c("{.val Rat, Marmoset, Macaque, Zebrafish, and Drosophila} are not currently supported.", + "i" = "No column will be added to object meta.data")) + } else { + cli_inform(message = "Adding {.field MSigDB Oxidative Phosphorylation, Apoptosis, and DNA Repair Percentages.} to meta.data.") + seurat_object <- Add_IEG_Seurat(seurat_object = seurat_object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite) + } + } + + if (isTRUE(x = add_cell_cycle)) { + if (!species %in% human_options) { + cli_abort(message = c("Cell Cycle Scoring is only supported for human in this function.", + "i" = "To add score for other species supply cell cycle gene list of `CellCycleScoring` function." + )) + } else { + if (length(grep(x = Layers(object = seurat_object), pattern = "data", value = T)) == 0) { + cli_inform(message = c("Layer with normalized data not present.", + "i" = "Normalizing Data.")) + seurat_object <- NormalizeData(object = seurat_object) + } + + # Overwrite check + if ("S.Score" %in% colnames(x = seurat_object@meta.data) || "G2M.Score" %in% colnames(x = seurat_object@meta.data) || "Phase" %in% colnames(x = seurat_object@meta.data)) { + if (!overwrite) { + cli_abort(message = c("Columns with {.val S.Score}, {.val G2M.Score} and/or {.val Phase} already present in meta.data slot.", + "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE}*") + ) + } + cli_inform(message = c("Columns with {.val S.Score}, {.val G2M.Score} and/or {.val Phase} already present in meta.data slot.", + "i" = "Overwriting those columns as .code {overwrite = TRUE.}") + ) + } + + # Add Cell Cycle Scoring + cli_inform(message = "Adding {.field Cell Cycle Scoring to meta.data.} to meta.data.") + seurat_object <- CellCycleScoring(object = seurat_object, s.features = Seurat::cc.genes.updated.2019$s.genes, g2m.features = Seurat::cc.genes.updated.2019$g2m.genes) + } + } + + # return object + return(seurat_object) +} + + #' Calculate and add differences post-cell bender analysis #' #' Calculate the difference in features and UMIs per cell when both cell bender and raw assays are present. @@ -408,7 +788,7 @@ Meta_Remove_Seurat <- function( meta_data_filtered <- meta_data %>% select(-all_of(x = existing_names)) - if (barcodes_to_rownames) { + if (isTRUE(x = barcodes_to_rownames)) { # Check barcodes colname exists if (!barcodes_colname %in% colnames(x = meta_data)) { cli_abort(message = "{.code barcodes_colname}: {.val {barcodes_colname}} was not present in the column names of meta_data data.frame provided.") @@ -539,7 +919,7 @@ Add_Sample_Meta <- function( rownames_to_column("barcodes") # remove - if (overwrite) { + if (isTRUE(x = overwrite)) { meta_seurat <- meta_seurat %>% select(-all_of(x = dup_columns)) } else { @@ -550,7 +930,7 @@ Add_Sample_Meta <- function( meta_merged <- left_join(x = meta_seurat, y = meta_data, by = setNames(join_by_meta, join_by_seurat)) # Remove existing Seurat meta - if (length(x = dup_columns) > 0 && overwrite) { + if (length(x = dup_columns) > 0 && isTRUE(x = overwrite)) { meta_merged <- meta_merged %>% column_to_rownames("barcodes") } else { @@ -600,6 +980,7 @@ Add_Sample_Meta <- function( #' #' @import cli #' @importFrom dplyr any_of grouped_df select slice +#' @importFrom magrittr "%>%" #' #' @export #' @@ -641,9 +1022,9 @@ Extract_Sample_Meta <- function( # Generate nCount and nFeature variable vectors for exclusion if (is.null(x = variables_exclude)) { - nFeature_cols <- grep(x = colnames(object@meta.data), pattern = "^nFeature", value = TRUE) + nFeature_cols <- grep(x = colnames(x = object@meta.data), pattern = "^nFeature", value = TRUE) - nCount_cols <- grep(x = colnames(object@meta.data), pattern = "^nCount", value = TRUE) + nCount_cols <- grep(x = colnames(x = object@meta.data), pattern = "^nCount", value = TRUE) combined_exclude <- c(nFeature_cols, nCount_cols, "percent_mito", "percent_ribo", "percent_mito_ribo", "log10GenesPerUMI") @@ -703,7 +1084,7 @@ Extract_Sample_Meta <- function( rownames(x = sample_meta_df) <- NULL # Filter data.frame - if (include_all) { + if (isTRUE(x = include_all)) { sample_meta_df_filtered <- sample_meta_df } else { if (length(x = include_meta_list[[1]]) > 0) { @@ -774,7 +1155,7 @@ Store_Misc_Info_Seurat <- function( # Check if name already present misc_present <- names(x = seurat_object@misc) if (data_name %in% misc_present) { - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("Item(s) named: {.val {data_name}} already present in @misc slot.", "i" = "*To run function and overwrite items set parameter {.code overwrite = TRUE} or change {.code data_name}*") ) @@ -793,7 +1174,7 @@ Store_Misc_Info_Seurat <- function( # Check class of data if (inherits(x = data_to_store, what = "list")) { - if (list_as_list) { + if (isTRUE(x = list_as_list)) { # Check length of name if (length(x = data_name) != 1) { cli_abort(message = "When storing as list the length {.code data_name} must be {.field 1 (one)}.") diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 172ee68bd4..38318ed696 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -151,6 +151,254 @@ kMeans_Elbow <- function( } +#' Split FeatureScatter +#' +#' Create FeatureScatter using split.by +#' +#' @param seurat_object Seurat object name. +#' @param feature1 First feature to plot. +#' @param feature2 Second feature to plot. +#' @param split.by Feature to split plots by (i.e. "orig.ident"). +#' @param group.by Name of one or more metadata columns to group (color) cells by (for example, orig.ident). +#' 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 +#' greater than 100,000 cells. +#' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). +#' Default is c(512, 512). +#' @param ggplot_default_colors logical. If `colors_use = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes. +#' @param color_seed random seed for the "varibow" palette shuffle if `colors_use = NULL` and number of +#' groups plotted is greater than 36. Default = 123. +#' @param ... Extra parameters passed to \code{\link[Seurat]{FeatureScatter}}. +#' +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' @import patchwork +#' @importFrom magrittr "%>%" +#' @importFrom Seurat FeatureScatter +#' @importFrom stats cor +#' +#' @noRd +#' + +scCustomze_Split_FeatureScatter <- function( + seurat_object, + feature1 = NULL, + feature2 = NULL, + split.by = NULL, + group.by = NULL, + colors_use = NULL, + pt.size = NULL, + aspect_ratio = NULL, + title_size = 15, + num_columns = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123, + ... +) { + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # split.by present + if (is.null(x = split.by)) { + cli_abort(message = "No value supplied to {.code split.by}.") + } + + # Check split.by is valid + if (split.by %in% colnames(seurat_object@meta.data) == FALSE) { + cli_abort(message = c("The meta data variable: {.val {split.by}} could not be found in object@meta.data.", + "i" = "Please check the spelling and column names of meta.data slot.") + ) + } + + # Set column and row lengths + split.by_length <- length(x = unique(x = seurat_object@meta.data[[split.by]])) + + if (is.null(x = num_columns)) { + num_columns <- split.by_length + } + # Calculate number of rows for selected number of columns + num_rows <- ceiling(x = split.by_length/num_columns) + + # Check column and row compatibility + if (num_columns > split.by_length) { + cli_abort(message = c("The number of columns specified is greater than the number of meta data variables.", + "*" = "{.val {split.by}} only contains {.field {split.by_length}} variables.", + "i" = "Please adjust {.code num_columns} to be less than or equal to {.field {split.by_length}}.") + ) + } + + # Check features are present + 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}}'") + } + + # Extract min/maxes of features + data_to_plot <- FetchData(object = seurat_object, vars = c(feature1, feature2)) + cor_data_features <- c("nCount_RNA", "nFeature_RNA") + if (feature1 %in% cor_data_features && feature2 %in% cor_data_features) { + min_feature1 <- min(data_to_plot[, feature1])-1 + max_feature1 <- max(data_to_plot[, feature1])+1 + min_feature2 <- min(data_to_plot[, feature2])-1 + max_feature2 <- max(data_to_plot[, feature2])+1 + } else { + min_feature1 <- min(data_to_plot[, feature1])-0.05 + max_feature1 <- max(data_to_plot[, feature1])+0.05 + min_feature2 <- min(data_to_plot[, feature2])-0.05 + max_feature2 <- max(data_to_plot[, feature2])+0.05 + } + + # Extract split.by list of values + if (inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { + meta_sample_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) + } else { + 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(x = seurat_object@meta.data)[which(x = seurat_object@meta.data[, split.by] == x)]}) + + # raster check + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) + + # Set uniform point size is pt.size = NULL (based on plot with most cells) + if (is.null(x = pt.size)) { + # cells per meta data + cells_by_meta <- data.frame(table(seurat_object@meta.data[, split.by])) + # Identity with greatest number of cells + max_cells <- max(cells_by_meta$Freq) + # modified version of the autopointsize function from Seurat + pt.size <- AutoPointSize_scCustom(data = max_cells, raster = raster) + } + + # Add correlations if applicable + cor_data_features <- c("nCount_RNA", "nFeature_RNA") + if (feature1 %in% cor_data_features && feature2 %in% cor_data_features) { + plot_cor <- TRUE + cor_data <- FetchData(object = seurat_object, vars = c("nCount_RNA", "nFeature_RNA", split.by)) + + cor_values <- lapply(1:length(x = meta_sample_list), function(i) { + cor_data_filtered <- cor_data %>% + filter(.data[[split.by]] == meta_sample_list[[i]]) + round(x = cor(x = cor_data_filtered[, "nCount_RNA"], y = cor_data_filtered[, "nFeature_RNA"]), digits = 2) + }) + } else { + plot_cor <- FALSE + } + + # Set colors + group.by <- group.by %||% 'ident' + + if (group.by == "ident") { + group_by_length <- length(x = unique(x = seurat_object@active.ident)) + } else { + group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + } + + if (is.null(x = colors_use)) { + # set default plot colors + if (is.null(x = colors_use)) { + colors_use <- scCustomize_Palette(num_groups = group_by_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + } + + # Plots + plots <- lapply(1:length(x = meta_sample_list), function(j) { + plot <- FeatureScatter(seurat_object, feature1 = feature1, feature2 = feature2, cells = cell_names[[j]], group.by = group.by, cols = colors_use, pt.size = pt.size, raster = raster, raster.dpi = raster.dpi, ...) + + theme(plot.title = element_text(hjust = 0.5, size = title_size), + legend.position = "right") + + xlim(min_feature1, max_feature1) + + ylim(min_feature2, max_feature2) + if (isTRUE(x = plot_cor)) { + plot + ggtitle(paste(meta_sample_list[[j]]), subtitle = paste0("Correlation: ", cor_values[j])) + } else { + plot + ggtitle(paste(meta_sample_list[[j]])) + } + }) + + # Wrap Plots into single output + 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) +} + + +#' Figure Plots +#' +#' Removes the axes from 2D DR plots and makes them into plot label. +#' Used for `figure_plot` parameter in plotting functions. +#' +#' @param plot 2D DR plot +#' +#' @return A modified plot +#' +#' @import ggplot2 +#' @import patchwork +#' +#' @references parameter/code modified from code by Tim Stuart via twitter: \url{https://twitter.com/timoast/status/1526237116035891200?s=20&t=foJOF81aPSjr1t7pk1cUPg}. +#' +#' @noRd +#' + +Figure_Plot <- function( + plot +){ + # pull axis labels + x_lab_reduc <- plot$labels$x + y_lab_reduc <- plot$labels$y + + plot <- plot & NoAxes() + + axis_plot <- ggplot(data.frame(x= 100, y = 100), aes(x = .data[["x"]], y = .data[["y"]])) + + geom_point() + + xlim(c(0, 10)) + ylim(c(0, 10)) + + theme_classic() + + ylab(y_lab_reduc) + xlab(x_lab_reduc) + + theme(plot.background = element_rect(fill = "transparent", colour = NA), + panel.background = element_rect(fill = "transparent"), + axis.text.x = element_blank(), + axis.text.y = element_blank(), + axis.ticks = element_blank(), + axis.line = element_line( + arrow = arrow(angle = 15, length = unit(.5, "cm"), type = "closed") + ) + ) + + figure_layout <- c( + area(t = 1, l = 2, b = 11, r = 11), + area(t = 10, l = 1, b = 12, r = 2)) + + plot_figure <- plot + axis_plot + + plot_layout(design = figure_layout) + + return(plot_figure) +} + + + + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### TEST/HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -236,7 +484,7 @@ Test_Integer <- function( x ) { test <- all.equal(x, as.integer(x), check.attributes = FALSE) - if (test == TRUE) { + if (isTRUE(x = test)) { return(TRUE) } else { return(FALSE) @@ -457,3 +705,5 @@ No_Right <- function() { ) return(no.right) } + + diff --git a/R/QC_Plotting_Seq_10X.R b/R/QC_Plotting_Seq_10X.R index 6f81e9d0f4..870a00f02a 100644 --- a/R/QC_Plotting_Seq_10X.R +++ b/R/QC_Plotting_Seq_10X.R @@ -11,6 +11,7 @@ #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -21,7 +22,7 @@ #' @import cli #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -38,6 +39,7 @@ Seq_QC_Plot_Reads_per_Cell <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -91,7 +93,7 @@ Seq_QC_Plot_Reads_per_Cell <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Mean_Reads_per_Cell"]], fill = .data[[plot_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1,size = 12), axis.text.y = element_text(size = 12), @@ -104,13 +106,13 @@ Seq_QC_Plot_Reads_per_Cell <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -145,6 +147,7 @@ Seq_QC_Plot_Reads_per_Cell <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -155,7 +158,7 @@ Seq_QC_Plot_Reads_per_Cell <- function( #' @import cli #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -172,6 +175,7 @@ Seq_QC_Plot_Number_Cells <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -225,7 +229,7 @@ Seq_QC_Plot_Number_Cells <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Estimated_Number_of_Cells"]], fill = .data[[plot_by]])) + geom_boxplot(fill = "white") + - geom_dotplot(binaxis ='y', stackdir = 'center') + + geom_dotplot(binaxis ='y', stackdir = 'center', dotsize = dot_size) + theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1,size = 12), axis.text.y = element_text(size = 12), @@ -238,13 +242,13 @@ Seq_QC_Plot_Number_Cells <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -279,6 +283,7 @@ Seq_QC_Plot_Number_Cells <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -289,7 +294,7 @@ Seq_QC_Plot_Number_Cells <- function( #' @import cli #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -306,6 +311,7 @@ Seq_QC_Plot_Genes <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -354,7 +360,7 @@ Seq_QC_Plot_Genes <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Median_Genes_per_Cell"]], fill = .data[[plot_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) + ggtitle("Median Genes per Cell") + ylab('Median Genes') + @@ -362,13 +368,13 @@ Seq_QC_Plot_Genes <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -403,6 +409,7 @@ Seq_QC_Plot_Genes <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -413,7 +420,7 @@ Seq_QC_Plot_Genes <- function( #' @import cli #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -430,6 +437,7 @@ Seq_QC_Plot_UMIs <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -478,7 +486,7 @@ Seq_QC_Plot_UMIs <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Median_UMI_Counts_per_Cell"]], fill = .data[[plot_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) + ggtitle("Median UMIs per Cell") + ylab('Median UMIs') + @@ -486,13 +494,13 @@ Seq_QC_Plot_UMIs <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -527,6 +535,7 @@ Seq_QC_Plot_UMIs <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -537,7 +546,7 @@ Seq_QC_Plot_UMIs <- function( #' @import cli #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -554,6 +563,7 @@ Seq_QC_Plot_Total_Genes <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -602,7 +612,7 @@ Seq_QC_Plot_Total_Genes <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Total_Genes_Detected"]], fill = .data[[plot_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) + ggtitle("Total Genes Detected per Sample") + ylab('Total Genes') + @@ -610,13 +620,13 @@ Seq_QC_Plot_Total_Genes <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -651,6 +661,7 @@ Seq_QC_Plot_Total_Genes <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -662,7 +673,7 @@ Seq_QC_Plot_Total_Genes <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -679,6 +690,7 @@ Seq_QC_Plot_Saturation <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -732,7 +744,7 @@ Seq_QC_Plot_Saturation <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Sequencing_Saturation"]], fill = .data[[plot_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) + ggtitle("Sequencing Saturation") + ylab('Sequencing Saturation Percent') + @@ -741,13 +753,13 @@ Seq_QC_Plot_Saturation <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -782,6 +794,7 @@ Seq_QC_Plot_Saturation <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -793,7 +806,7 @@ Seq_QC_Plot_Saturation <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -810,6 +823,7 @@ Seq_QC_Plot_Reads_in_Cells <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -863,7 +877,7 @@ Seq_QC_Plot_Reads_in_Cells <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Fraction_Reads_in_Cells"]], fill = .data[[plot_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) + ggtitle("Fraction of Reads in Cells per Sample") + ylab('Fraction of Reads in Cells') + @@ -872,13 +886,13 @@ Seq_QC_Plot_Reads_in_Cells <- function( theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -913,6 +927,7 @@ Seq_QC_Plot_Reads_in_Cells <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -924,7 +939,7 @@ Seq_QC_Plot_Reads_in_Cells <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -941,6 +956,7 @@ Seq_QC_Plot_Transcriptome <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -994,7 +1010,7 @@ Seq_QC_Plot_Transcriptome <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Confidently_to_Transcriptome"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Transcriptome") + ylab('Percent of Reads') + @@ -1002,13 +1018,13 @@ Seq_QC_Plot_Transcriptome <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1043,6 +1059,7 @@ Seq_QC_Plot_Transcriptome <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -1054,7 +1071,7 @@ Seq_QC_Plot_Transcriptome <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -1071,6 +1088,7 @@ Seq_QC_Plot_Genome <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -1124,7 +1142,7 @@ Seq_QC_Plot_Genome <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Confidently_to_Genome"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Genome") + ylab('Percent of Reads') + @@ -1132,13 +1150,13 @@ Seq_QC_Plot_Genome <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1173,6 +1191,7 @@ Seq_QC_Plot_Genome <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -1184,7 +1203,7 @@ Seq_QC_Plot_Genome <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -1201,6 +1220,7 @@ Seq_QC_Plot_Intergenic <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -1254,7 +1274,7 @@ Seq_QC_Plot_Intergenic <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Confidently_to_Intergenic_Regions"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Intergenic Regions") + ylab('Percent of Reads') + @@ -1262,13 +1282,13 @@ Seq_QC_Plot_Intergenic <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1303,6 +1323,7 @@ Seq_QC_Plot_Intergenic <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -1314,7 +1335,7 @@ Seq_QC_Plot_Intergenic <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -1331,6 +1352,7 @@ Seq_QC_Plot_Intronic <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -1384,7 +1406,7 @@ Seq_QC_Plot_Intronic <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Confidently_to_Intronic_Regions"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Intronic Regions") + ylab('Percent of Reads') + @@ -1392,13 +1414,13 @@ Seq_QC_Plot_Intronic <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1433,6 +1455,7 @@ Seq_QC_Plot_Intronic <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -1444,7 +1467,7 @@ Seq_QC_Plot_Intronic <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -1461,6 +1484,7 @@ Seq_QC_Plot_Exonic <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -1514,7 +1538,7 @@ Seq_QC_Plot_Exonic <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Confidently_to_Exonic_Regions"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Exonic Regions") + ylab('Percent of Reads') + @@ -1522,13 +1546,13 @@ Seq_QC_Plot_Exonic <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1563,6 +1587,7 @@ Seq_QC_Plot_Exonic <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by #' grouping factor. Default is FALSE. @@ -1574,7 +1599,7 @@ Seq_QC_Plot_Exonic <- function( #' @import ggplot2 #' @importFrom ggbeeswarm geom_quasirandom #' @importFrom scales label_percent -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom utils combn #' #' @export @@ -1591,6 +1616,7 @@ Seq_QC_Plot_Antisense <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -1644,7 +1670,7 @@ Seq_QC_Plot_Antisense <- function( } else { plot <- ggplot(metrics_dataframe, aes(x=.data[[plot_by]], y = .data[["Reads_Mapped_Antisense_to_Gene"]], fill = .data[[plot_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) + ggtitle("Percent of Reads Confidently Mapped to Antisense to Gene") + ylab('Percent of Reads') + @@ -1652,13 +1678,13 @@ Seq_QC_Plot_Antisense <- function( scale_y_continuous(labels = label_percent(accuracy = 1, scale = 1)) + theme_ggprism_mod() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } - if (significance) { - ggpubr_check <- PackageCheck("ggpubr", error = FALSE) - if (!ggpubr_check[1]) { + if (isTRUE(x = significance)) { + ggpubr_check <- is_installed(pkg = "ggpubr") + if (isFALSE(x = ggpubr_check)) { cli_abort(message = c( "Please install the {.val ggpubr} package to calculate/plot significance values.", "i" = "This can be accomplished with the following commands: ", @@ -1693,6 +1719,7 @@ Seq_QC_Plot_Antisense <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param patchwork_title Title to use for the patchworked plot output. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by @@ -1703,7 +1730,7 @@ Seq_QC_Plot_Antisense <- function( #' #' @import ggplot2 #' @importFrom patchwork plot_layout plot_annotation -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom stringr str_wrap #' #' @export @@ -1720,49 +1747,50 @@ Seq_QC_Plot_Basic_Combined <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, patchwork_title = "Sequencing QC Plots: Basic Cell Metrics", significance = FALSE, ... ) { # Create rotated axis value - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { axis_angle <- 45 } else { axis_angle <- 0 } # Create Plots & modify for plotting together - p1 <- Seq_QC_Plot_Number_Cells(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p1 <- Seq_QC_Plot_Number_Cells(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p1 <- p1 + labs(title = str_wrap(p1$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p2 <- Seq_QC_Plot_Reads_per_Cell(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p2 <- Seq_QC_Plot_Reads_per_Cell(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p2 <- p2 + labs(title = str_wrap(p2$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p3 <- Seq_QC_Plot_Genes(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p3 <- Seq_QC_Plot_Genes(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p3 <- p3 + labs(title = str_wrap(p3$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p4 <- Seq_QC_Plot_UMIs(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p4 <- Seq_QC_Plot_UMIs(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p4 <- p4 + labs(title = str_wrap(p4$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p5 <- Seq_QC_Plot_Total_Genes(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p5 <- Seq_QC_Plot_Total_Genes(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p5 <- p5 + labs(title = str_wrap(p5$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p6 <- Seq_QC_Plot_Saturation(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p6 <- Seq_QC_Plot_Saturation(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p6 <- p6 + labs(title = str_wrap(p6$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p7 <- Seq_QC_Plot_Reads_in_Cells(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p7 <- Seq_QC_Plot_Reads_in_Cells(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p7 <- p7 + labs(title = str_wrap(p7$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p8 <- Seq_QC_Plot_Transcriptome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p8 <- Seq_QC_Plot_Transcriptome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p8 <- p8 + labs(title = str_wrap(p8$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) @@ -1784,6 +1812,7 @@ Seq_QC_Plot_Basic_Combined <- function( #' @param plot_by Grouping factor for the plot. Default is to plot as single group with single point per sample. #' @param colors_use colors to use for plot if plotting by group. Defaults to RColorBrewer Dark2 palette if #' less than 8 groups and `DiscretePalette_scCustomize(palette = "polychrome")` if more than 8. +#' @param dot_size size of the dots plotted if `plot_by` is not `sample_id` Default is 1. #' @param x_lab_rotate logical. Whether to rotate the axes labels on the x-axis. Default is FALSE. #' @param patchwork_title Title to use for the patchworked plot output. #' @param significance logical. Whether to calculate and plot p-value comparisons when plotting by @@ -1794,7 +1823,7 @@ Seq_QC_Plot_Basic_Combined <- function( #' #' @import ggplot2 #' @importFrom patchwork plot_layout plot_annotation -#' @importFrom SeuratObject PackageCheck +#' @importFrom rlang is_installed #' @importFrom stringr str_wrap #' #' @export @@ -1811,41 +1840,42 @@ Seq_QC_Plot_Alignment_Combined <- function( metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, patchwork_title = "Sequencing QC Plots: Read Alignment Metrics", significance = FALSE, ... ) { # Create rotated axis value - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { axis_angle <- 45 } else { axis_angle <- 0 } # Create Plots & modify for plotting together - p1 <- Seq_QC_Plot_Genome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p1 <- Seq_QC_Plot_Genome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size, ...) p1 <- p1 + labs(title = str_wrap(p1$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p2 <- Seq_QC_Plot_Intergenic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p2 <- Seq_QC_Plot_Intergenic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p2 <- p2 + labs(title = str_wrap(p2$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p3 <- Seq_QC_Plot_Transcriptome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p3 <- Seq_QC_Plot_Transcriptome(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p3 <- p3 + labs(title = str_wrap(p3$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p4 <- Seq_QC_Plot_Exonic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p4 <- Seq_QC_Plot_Exonic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p4 <- p4 + labs(title = str_wrap(p4$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p5 <- Seq_QC_Plot_Intronic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p5 <- Seq_QC_Plot_Intronic(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p5 <- p5 + labs(title = str_wrap(p5$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) - p6 <- Seq_QC_Plot_Antisense(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, ...) + p6 <- Seq_QC_Plot_Antisense(metrics_dataframe = metrics_dataframe, plot_by = plot_by, colors_use = colors_use, significance = significance, dot_size = dot_size,) p6 <- p6 + labs(title = str_wrap(p6$labels$title, 18)) + theme_ggprism_mod(base_size = 10, axis_text_angle = axis_angle) @@ -1857,3 +1887,218 @@ Seq_QC_Plot_Alignment_Combined <- function( # Print plots suppressMessages(print(plot)) } + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### Barcode Rank QC #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' Create Barcode Rank Plot +#' +#' Plot UMI vs. Barcode Rank with inflection and knee. Requires input from DropletUtils package. +#' +#' @param br_out DFrame output from \code{\link[DropletUtils]{barcodeRanks}}. +#' @param pt.size point size for plotting, default is 6. +#' @param plot_title Title for plot, default is "Barcode Ranks". +#' @param raster_dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). +#' Default is c(1024, 1024). +#' @param plateau numerical value at which to add vertical line designating estimated +#' empty droplet plateau (default is NULL). +#' +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' @importFrom scattermore geom_scattermore +#' @importFrom cowplot theme_cowplot +#' +#' @export +#' +#' @concept seq_qc_plotting_basic +#' +#' @examples +#' \dontrun{ +#' mat <- Read10X_h5(filename = "raw_feature_bc_matrix.h5") +#' +#' br_results <- DropletUtils::barcodeRanks(mat) +#' +#' Barcode_Plot(br_out = br_results) +#' } +#' + +Barcode_Plot <- function( + br_out, + pt.size = 6, + plot_title = "Barcode Ranks", + raster_dpi = c(1024, 1024), + plateau = NULL +) { + # Check br_out is correct + if (!inherits(x = br_out, what = "DFrame")) { + cli_abort(message = c("{.code br_out} must be object of class {.field DFrame}.", + "i" = "Ensure {.code br_out} is output of {.code {.field DropletUtils::barcodeRanks}}.")) + } + + if (!all(c("knee", "inflection") %in% names(x = br_out@metadata)) && !all(c("rank", "total", "fitted") %in% names(x = br_out@listData))) { + cli_abort(message = c("{.code br_out} appears to be missing necessarily information.", + "i" = "Ensure {.code br_out} is output of {.code {.field DropletUtils::barcodeRanks}} and no errors occured when running code.")) + } + + plot <- ggplot(data = data.frame(br_out@listData), aes(x = .data[["rank"]], y = .data[["total"]])) + + geom_scattermore(pointsize = pt.size, pixels = raster_dpi) + + scale_y_log10() + + scale_x_log10() + + theme_cowplot() + + geom_line(mapping = aes(x = .data[["rank"]], y = .data[["fitted"]], color = "red"), show.legend = FALSE) + + geom_hline(yintercept = br_out@metadata$knee, linetype = "dashed", color = "dodgerblue") + + geom_hline(yintercept = br_out@metadata$inflection, linetype = "dashed", color = "forestgreen") + + annotate("text", x = 1, y = br_out@metadata$knee, label = paste0("Knee (", br_out@metadata$knee, ")"), vjust = -0.5, hjust = 0) + + annotate("text", x = 1, y = br_out@metadata$inflection, label = paste0("Inflection (", br_out@metadata$inflection, ")"), vjust = -0.5, hjust = 0) + + ylab("UMIs") + + xlab("Barcode Rank") + + ggtitle(plot_title) + + theme(plot.title = element_text(hjust = 0.5)) + + # Add plateau if specified + if (!is.null(x = plateau)) { + plot <- plot + + geom_vline(xintercept = plateau, linetype = "dashed", color = "dodgerblue") + + annotate("text", x = plateau, y = max(br_out$total), label = paste0("Plateau (", plateau, ")"), vjust = -0.5, hjust = -0.05) + } + + # return plot + return(plot) +} + + +#' Iterative Barcode Rank Plots +#' +#' Read data, calculate `DropletUtils::barcodeRanks`, create barcode rank plots, and outout single PDF output. +#' +#' @param dir_path_h5 path to parent directory (if `multi_directory = TRUE`) or directory containing +#' all h5 files (if `multi_directory = FALSE`). +#' @param multi_directory logical, whether or not all h5 files are in their own subdirectories or in a +#' single directory (default is TRUE; each in own subdirectory (e.g. output from Cell Ranger)). +#' @param h5_filename Either the file name of h5 file (if `multi_directory = TRUE`) or the shared +#' suffix (if `multi_directory = FALSE`) +#' @param cellranger_multi logical, whether the outputs to be read are from Cell Ranger `multi` as opposed +#' to Cell Ranger `count` (default is FALSE). Only valid if `multi_directory = FALSE`. +#' @param parallel logical, should files be read in parallel (default is FALSE). +#' @param num_cores Number of cores to use in parallel if `parallel = TRUE`. +#' @param file_path file path to use for saving PDF output. +#' @param file_name Name of PDF output file. +#' @param pt.size point size for plotting, default is 6. +#' @param raster_dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). +#' Default is c(1024, 1024). +#' @param plateau numerical values at which to add vertical line designating estimated +#' empty droplet plateau (default is NULL). Must be vector equal in length to number of samples. +#' @param ... Additional parameters passed to `Read10X_h5_Multi_Directory` or `Read10X_h5_GEO`. +#' +#' @return pdf document +#' +#' @import cli +#' @import ggplot2 +#' @importFrom grDevices dev.off pdf +#' @importFrom pbapply pblapply pboptions +#' @importFrom utils txtProgressBar setTxtProgressBar +#' +#' @export +#' +#' @concept seq_qc_plotting_basic +#' +#' @examples +#' \dontrun{ +#' Iterate_Barcode_Rank_Plot(dir_path_h5 = "H5_PATH/", multi_directory = TRUE, +#' h5_filename = "raw_feature_bc_matrix", parallel = TRUE, num_cores = 12, file_path = "OUTPUT_PATH", +#' file_name = "Barcode_Rank_Plots") +#' } +#' + +Iterate_Barcode_Rank_Plot <- function( + dir_path_h5, + multi_directory = TRUE, + h5_filename = "raw_feature_bc_matrix.h5", + cellranger_multi = FALSE, + parallel = FALSE, + num_cores = NULL, + file_path = NULL, + file_name = NULL, + pt.size = 6, + raster_dpi = c(1024, 1024), + plateau = NULL, + ... +) { + DropletUtils_check <- is_installed(pkg = "DropletUtils") + if (!DropletUtils_check[1]) { + cli_abort(message = c( + "Please install the {.val DropletUtils} package to use {.code Create_10X_H5}", + "i" = "This can be accomplished with the following commands: ", + "----------------------------------------", + "{.field `install.packages({symbol$dquote_left}BiocManager{symbol$dquote_right})`}", + "{.field `BiocManager::install({symbol$dquote_left}DropletUtils{symbol$dquote_right})`}", + "----------------------------------------" + )) + } + + # 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 == "") { + file_path <- NULL + } + + # Check file path is valid + if (!is.null(x = file_path)) { + if (!dir.exists(paths = file_path)) { + cli_abort(message = "Provided {.code file_path}: {symbol$dquote_left}{.field {file_path}}{symbol$dquote_right} does not exist.") + } + } + + # Check if file name provided + if (is.null(x = file_name)) { + cli_abort(message = "No file name provided. Please provide a file name using {.code file_name}.") + } + + # Set file type for single pdf option + file_type <- ".pdf" + + # Read in data + if (multi_directory) { + all_mat <- Read10X_h5_Multi_Directory(base_path = dir_path_h5, h5_filename = h5_filename, parallel = parallel, num_cores = num_cores, ...) + } else { + all_mat <- Read10X_h5_GEO(data_dir = dir_path_h5, parallel = parallel, num_cores = num_cores, shared_suffix = h5_filename, ...) + } + + cli_inform(message = "{.field Calculating Barcode Rank Statistics}") + pboptions(char = "=") + barcode_ranks_list <- pblapply(1:length(x = all_mat), function(x) { + br_file <- DropletUtils::barcodeRanks(m = all_mat[[x]]) + }) + + sample_names <- names(x = all_mat) + + rm(all_mat) + gc() + + num_samples <- length(x = barcode_ranks_list) + + if (!is.null(x = plateau) && length(x = plateau) != num_samples) { + cli_abort(message = "The number of values for plateau ({.field {length(x = plateau)}}) must be equal to the number of samples ({.field {num_samples}}).") + } + + # Single PDF option + cli_inform(message = "{.field Generating plots}") + pboptions(char = "=") + all_plots <- pblapply(1:num_samples, function(j) { + Barcode_Plot(br_out = barcode_ranks_list[[j]], pt.size = pt.size, plot_title = sample_names[j], raster_dpi = raster_dpi, plateau = plateau[j]) + }) + cli_inform(message = "{.field Saving plots to file}") + # Save plots + pdf(paste(file_path, file_name, file_type, sep="")) + pb <- txtProgressBar(min = 0, max = length(all_plots), style = 3, file = stderr()) + for (i in 1:length(all_plots)) { + print(all_plots[[i]]) + setTxtProgressBar(pb = pb, value = i) + } + close(con = pb) + dev.off() +} diff --git a/R/QC_Plotting_Seurat.R b/R/QC_Plotting_Seurat.R index 06d77ef4d7..10ecad7ba9 100644 --- a/R/QC_Plotting_Seurat.R +++ b/R/QC_Plotting_Seurat.R @@ -17,6 +17,7 @@ #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -53,6 +54,7 @@ QC_Plots_Genes <- function( high_cutoff = NULL, pt.size = NULL, plot_median = FALSE, + plot_boxplot = FALSE, median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, @@ -68,7 +70,7 @@ QC_Plots_Genes <- function( # Add pt.size check pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) - plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = "nFeature_RNA", group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + + plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = "nFeature_RNA", group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + xlab(x_axis_label) + ylab(y_axis_label) + @@ -76,20 +78,15 @@ QC_Plots_Genes <- function( theme(plot.subtitle = element_text(hjust = 0.5), legend.position = "none") # Rotate x axis label - if (!x_lab_rotate) { + if (isFALSE(x = x_lab_rotate)) { plot <- plot + UnRotate_X() } # return log10 y axis - if (y_axis_log) { + if (isTRUE(x = y_axis_log)) { 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) } @@ -109,6 +106,7 @@ QC_Plots_Genes <- function( #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -146,6 +144,7 @@ QC_Plots_UMIs <- function( pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -160,7 +159,7 @@ QC_Plots_UMIs <- function( # Add pt.size check pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) - plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = "nCount_RNA", group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + + plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = "nCount_RNA", group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + xlab(x_axis_label) + ylab(y_axis_label) + @@ -168,20 +167,15 @@ QC_Plots_UMIs <- function( theme(plot.subtitle = element_text(hjust = 0.5), legend.position = "none") # Rotate x axis label - if (!x_lab_rotate) { + if (isFALSE(x = x_lab_rotate)) { plot <- plot + UnRotate_X() } # return log10 y axis - if (y_axis_log) { + if (isTRUE(x = y_axis_log)) { 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) } @@ -203,6 +197,7 @@ QC_Plots_UMIs <- function( #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -241,6 +236,7 @@ QC_Plots_Mito <- function( pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -255,7 +251,7 @@ QC_Plots_Mito <- function( # Add pt.size check pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) - plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = mito_name, group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + + plot <- VlnPlot_scCustom(seurat_object = seurat_object, features = mito_name, group.by = group.by, colors_use = colors_use, pt.size = pt.size, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, plot_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + xlab(x_axis_label) + ylab(y_axis_label) + @@ -263,20 +259,15 @@ QC_Plots_Mito <- function( theme(plot.subtitle = element_text(hjust = 0.5), legend.position = "none") # Rotate x axis label - if (!x_lab_rotate) { + if (isFALSE(x = x_lab_rotate)) { plot <- plot + UnRotate_X() } # return log10 y axis - if (y_axis_log) { + if (isTRUE(x = y_axis_log)) { 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) } @@ -297,6 +288,7 @@ QC_Plots_Mito <- function( #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -337,6 +329,7 @@ QC_Plots_Feature <- function( pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -354,7 +347,7 @@ QC_Plots_Feature <- function( if (is.null(x = plot_title)) { plot_title <- paste0(feature, " per Cell/Nucleus") } - 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, ...) + + 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, plot_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + xlab(x_axis_label) + ylab(y_axis_label) + @@ -362,20 +355,15 @@ QC_Plots_Feature <- function( theme(plot.subtitle = element_text(hjust = 0.5), legend.position = "none") # Rotate x axis label - if (!x_lab_rotate) { + if (isFALSE(x = x_lab_rotate)) { plot <- plot + UnRotate_X() } # return log10 y axis - if (y_axis_log) { + if (isTRUE(x = y_axis_log)) { 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) } @@ -396,6 +384,7 @@ QC_Plots_Feature <- function( #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -434,6 +423,7 @@ QC_Plots_Complexity <- function( high_cutoff = NULL, pt.size = NULL, plot_median = FALSE, + plot_boxplot = FALSE, median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, @@ -443,7 +433,7 @@ QC_Plots_Complexity <- function( color_seed = 123, ... ) { - 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, ...) + 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, plot_boxplot = plot_boxplot, ...) return(plot) } @@ -464,6 +454,7 @@ QC_Plots_Complexity <- function( #' @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 plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). #' @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). @@ -502,6 +493,7 @@ QC_Plots_Combined_Vln <- function( pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -534,11 +526,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, plot_median = plot_median, median_size = median_size, ...) + 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, plot_boxplot = plot_boxplot, ...) - 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, ...) + 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, plot_boxplot = plot_boxplot, ...) - 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, ...) + 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, plot_boxplot = plot_boxplot, ...) # wrap plots plots <- wrap_plots(feature_plot, UMI_plot, mito_plot, ncol = 3) @@ -547,6 +539,163 @@ QC_Plots_Combined_Vln <- function( } +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### OBJECT QC HISTOGRAM #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' QC Histogram Plots +#' +#' Custom histogram for initial QC checks including lines for thresholding +#' +#' @param seurat_object Seurat object name. +#' @param features Feature from meta.data, assay features, or feature name shortcut to plot. +#' @param low_cutoff Plot line a potential low threshold for filtering. +#' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param split.by Feature to split plots by (i.e. "orig.ident"). +#' @param bins number of bins to plot default is 250. +#' @param colors_use color to fill histogram bars, default is "dodgerblue". +#' @param num_columns Number of columns in plot layout. +#' @param plot_title optional, vector to use for plot title. Default is the name of the +#' variable being plotted. +#' @param assay assay to pull features from, default is active assay. +#' @param print_defaults return list of accepted default shortcuts to provide to `features` instead +#' of full name. +#' +#' @return A patchwork object +#' +#' @import cli +#' @import ggplot2 +#' @importFrom cowplot theme_cowplot +#' @importFrom dplyr filter +#' @importFrom magrittr "%>%" +#' @importFrom patchwork wrap_plots plot_annotation +#' +#' @export +#' +#' @concept object_qc_plotting +#' +#' @examples +#' \dontrun{ +#' QC_Histogram(seurat_object = object, features = "nFeature_RNA") +#' } +#' + +QC_Histogram <- function( + seurat_object, + features, + low_cutoff = NULL, + high_cutoff = NULL, + split.by = NULL, + bins = 250, + colors_use = "dodgerblue", + num_columns = NULL, + plot_title = NULL, + assay = NULL, + print_defaults = FALSE +){ + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # default features + found_defaults <- Return_QC_Defaults(seurat_object = seurat_object, features = features, print_defaults = print_defaults) + + # set assay + assay <- assay %||% DefaultAssay(object = seurat_object) + + # Check split valid + if (!is.null(x = split.by)) { + split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + # Check feature length if split.by provided + if (!is.null(x = split.by)) { + if (length(x = features) != 1) { + cli_abort(message = "Only 1 feature can be plotted when {.code split.by = TRUE}.") + } + } + + # Check against object + found_features <- Gene_Present(data = seurat_object, gene_list = found_defaults[[2]], omit_warn = FALSE, print_msg = FALSE, case_check_msg = FALSE, return_none = TRUE, seurat_assay = assay) + + found_meta <- Meta_Present(seurat_object = seurat_object, meta_col_names = found_features[[2]], omit_warn = FALSE, print_msg = FALSE, return_none = TRUE) + + # Combine lists + all_not_found_features <- found_meta[[2]] + + all_found_features <- c(found_defaults[[1]], found_features[[1]], found_meta[[1]]) + + # Warn not found + if (length(x = all_not_found_features > 0)) { + cli_warn(message = c("The following features were omitted as they not found in default values or in Seurat object:", + "i" = "{.field {glue_collapse_scCustom(input_string = all_not_found_features, and = TRUE)}}")) + } + + # Check and set titles + if (is.null(x = plot_title) && is.null(x = split.by)) { + plot_titles <- all_found_features + } + + if (!is.null(x = plot_title) && length(x = plot_title) != features) { + cli_abort(message = "The number of {.code plot_title} (.field {length(x = plot_title)}}) does not equal number of features ({.field {length(x = all_found_features)}})") + } + + # Plot + if (is.null(x = split.by)) { + plot_list <- lapply(1:length(x = all_found_features), function(x) { + plot <- ggplot(data = seurat_object@meta.data, aes(x = .data[[all_found_features[x]]])) + + geom_histogram(color = "black", fill = colors_use, bins = bins) + + theme_cowplot() + + geom_vline(xintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + ggtitle(plot_titles[x]) + }) + + # wrap and return plots + plots <- wrap_plots(plot_list, ncol = num_columns) + + return(plots) + + } else { + # Pull required data + data_to_plot <- FetchData(object = seurat_object, vars = c(all_found_features, split.by)) + + # Extract split.by list of values + if (inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { + meta_sample_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) + } else { + meta_sample_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) + } + + if (length(x = colors_use) != length(x = meta_sample_list)) { + if (length(x = colors_use == 1)) { + if (colors_use == "dodgerblue") { + colors_use <- scCustomize_Palette(num_groups = length(x = meta_sample_list)) + } + } else { + cli_abort(message = c("The number of colors must match the number of variables in {.code split.by}.", + "i" = "The length of {.code colors_use} is {.field {length(x = colors_use)}} but the number of variables in {.code spliut.by} is {.field {length(x = split.by)}}")) + } + } + + # Plot + plot_list <- lapply(1:length(x = meta_sample_list), function(x) { + sub_data <- data_to_plot %>% + filter(.data[[split.by]] == meta_sample_list[x]) + + plot <- ggplot(data = sub_data, aes(x = .data[[all_found_features]])) + + geom_histogram(color = "black", fill = colors_use[x], bins = bins) + + theme_cowplot() + + geom_vline(xintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + ggtitle(meta_sample_list[x]) + }) + + # wrap and return plots + plots <- wrap_plots(plot_list, ncol = num_columns) + plot_annotation(title = all_found_features, theme = theme(plot.title = element_text(hjust = 0.5, face = "bold", size = rel(1.5)))) + + return(plots) + } +} + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### OBJECT QC SCATTER #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -575,6 +724,8 @@ QC_Plots_Combined_Vln <- function( #' @param cells Cells to include on the scatter plot (default is all cells). #' @param combination logical (default FALSE). Whether or not to return a plot layout with both the #' plot colored by identity and the meta data gradient plot. +#' @param ident_legend logical, whether to plot the legend containing identities (left plot) when +#' `combination = TRUE`. Default is TRUE. #' @param pt.size Passes size of points to both \code{\link[Seurat]{FeatureScatter}} and `geom_point`. #' @param group.by Name of one or more metadata columns to group (color) cells by (for example, orig.ident). #' Default is `@active.ident`. @@ -624,6 +775,7 @@ QC_Plot_UMIvsGene <- function( meta_gradient_low_cutoff = NULL, cells = NULL, combination = FALSE, + ident_legend = TRUE, pt.size = 1, group.by = NULL, raster = NULL, @@ -637,10 +789,10 @@ QC_Plot_UMIvsGene <- function( Is_Seurat(seurat_object = seurat_object) # Default raster check - if (combination) { - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 1e5) + if (isTRUE(x = combination)) { + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 1e5) } else { - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) } # select color palette if not specified @@ -650,7 +802,7 @@ QC_Plot_UMIvsGene <- function( group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) } if (is.null(x = colors_use)) { - if (ggplot_default_colors) { + if (isTRUE(x = ggplot_default_colors)) { colors_use <- Hue_Pal(group_by_length) } else { if (group_by_length <= 2) { @@ -668,12 +820,17 @@ QC_Plot_UMIvsGene <- function( } } + if (isFALSE(x = ident_legend) && isFALSE(x = combination)) { + cli_warn(message = "{.code ident_legend} parameter ignored as {.code combination = FALSE}") + } + + # Pull meta data featurescatter_data <- Fetch_Meta(object = seurat_object) %>% rownames_to_column("barcodes") # Check valid meta variable if (!is.null(x = meta_gradient_name)) { - meta_names <- colnames(featurescatter_data) + meta_names <- colnames(x = featurescatter_data) if (meta_gradient_name %in% meta_names == FALSE) { cli_abort(message = "The meta data variable {.val {meta_gradient_name}} could not be found in object@metadata.") } @@ -718,8 +875,8 @@ QC_Plot_UMIvsGene <- function( plot_cor_filtered <- round(x = cor(x = featurescatter_data_sort_filter[, "nCount_RNA"], y = featurescatter_data_sort_filter[, "nFeature_RNA"]), digits = 2) # Plot with meta gradient - if (!is.null(x = meta_gradient_name) && combination == FALSE) { - if (raster) { + if (!is.null(x = meta_gradient_name) && isFALSE(x = combination)) { + if (isTRUE(x = raster)) { p1 <- ggplot(data = featurescatter_data_sort, mapping = aes(x = .data[["nCount_RNA"]], y = .data[["nFeature_RNA"]])) + geom_scattermore(mapping = aes(color = .data[[meta_gradient_name]]), pointsize = pt.size) + scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + @@ -745,7 +902,7 @@ QC_Plot_UMIvsGene <- function( return(p1) } # Plot by identity - if (is.null(x = meta_gradient_name) && combination == FALSE) { + if (is.null(x = meta_gradient_name) && isFALSE(x = combination)) { p1 <- FeatureScatter(object = seurat_object, feature1 = "nCount_RNA", feature2 = "nFeature_RNA", cells = cells, pt.size = pt.size, shuffle = TRUE, raster = raster, raster.dpi = raster.dpi, cols = colors_use, group.by = group.by, seed = shuffle_seed, ...) + geom_hline(yintercept = c(if(is.finite(x = low_cutoff_gene)) {low_cutoff_gene}, if(is.finite(x = high_cutoff_gene)) {high_cutoff_gene}), linetype = "dashed", color = "red") + geom_vline(xintercept = c(if(is.finite(x = low_cutoff_UMI)) {low_cutoff_UMI}, if(is.finite(x = high_cutoff_UMI)) {high_cutoff_UMI}), linetype = "dashed", color = "blue") + @@ -755,7 +912,7 @@ QC_Plot_UMIvsGene <- function( return(p1) } - if (combination) { + if (isTRUE(x = combination)) { # Plot by identity p1 <- FeatureScatter(object = seurat_object, feature1 = "nCount_RNA", feature2 = "nFeature_RNA", cells = cells, pt.size = pt.size, shuffle = TRUE, raster = raster, raster.dpi = raster.dpi, cols = colors_use, group.by = group.by, seed = shuffle_seed, ...) + geom_hline(yintercept = c(if(is.finite(x = low_cutoff_gene)) {low_cutoff_gene}, if(is.finite(x = high_cutoff_gene)) {high_cutoff_gene}), linetype = "dashed", color = "red") + @@ -763,8 +920,12 @@ QC_Plot_UMIvsGene <- function( xlab(x_axis_label) + ylab(y_axis_label) + ggtitle("") + if (isFALSE(x = ident_legend)) { + p1 <- p1 + NoLegend() + } + # Plot with meta gradient - if (raster) { + if (isTRUE(x = raster)) { p2 <- ggplot(data = featurescatter_data_sort, mapping = aes(x = .data[["nCount_RNA"]], y = .data[["nFeature_RNA"]])) + geom_scattermore(mapping = aes(color = .data[[meta_gradient_name]]), pointsize = pt.size) + scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + @@ -869,7 +1030,7 @@ QC_Plot_GenevsFeature <- function( group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) } if (is.null(x = colors_use)) { - if (ggplot_default_colors) { + if (isTRUE(x = ggplot_default_colors)) { colors_use <- Hue_Pal(group_by_length) } else { if (group_by_length <= 2) { @@ -972,7 +1133,7 @@ QC_Plot_UMIvsFeature <- function( group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) } if (is.null(x = colors_use)) { - if (ggplot_default_colors) { + if (isTRUE(x = ggplot_default_colors)) { colors_use <- Hue_Pal(group_by_length) } else { if (group_by_length <= 2) { diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index a19e3d50f7..05112ea56a 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -15,8 +15,8 @@ #' @import cli #' @importFrom Matrix readMM # #' @importFrom DropletUtils write10xCounts +#' @importFrom rlang is_installed #' @importFrom Seurat Read10X -#' @importFrom SeuratObject PackageCheck #' #' @return A HDF5 format file that will be recognized as 10X Cell Ranger formatted file by Seurat or LIGER. #' @@ -36,8 +36,8 @@ Create_10X_H5 <- function( save_file_path, save_name ) { - DropletUtils_check <- PackageCheck("DropletUtils", error = FALSE) - if (!DropletUtils_check[1]) { + DropletUtils_check <- is_installed(pkg = "DropletUtils") + if (isFALSE(DropletUtils_check)) { cli_abort(message = c( "Please install the {.val DropletUtils} package to use {.code Create_10X_H5}", "i" = "This can be accomplished with the following commands: ", @@ -69,8 +69,8 @@ Create_10X_H5 <- function( fileext=".h5") DropletUtils::write10xCounts(path = temp_file, x = count_matrix, - barcodes = colnames(count_matrix), - gene.symbol = rownames(count_matrix), + barcodes = colnames(x = count_matrix), + gene.symbol = rownames(x = count_matrix), gene.type = "Gene Expression", type = "HDF5", version = "3") @@ -118,7 +118,7 @@ Create_CellBender_Merged_Seurat <- function( ... ) { # Filter Cell Bender matrix for Cell Ranger cells - cell_intersect <- intersect(x = colnames(x = raw_counts_matrix), y = colnames(raw_cell_bender_matrix)) + cell_intersect <- intersect(x = colnames(x = raw_counts_matrix), y = colnames(x = raw_cell_bender_matrix)) cli_inform(message = "{.field Filtering Cell Bender matrix for cells present in raw counts matrix.}") @@ -132,14 +132,14 @@ Create_CellBender_Merged_Seurat <- function( cell_names_seurat <- colnames(x = cell_bender_seurat) gene_names_seurat <- rownames(x = cell_bender_seurat) - # Filter raw counts by created Seurat parameters - cli_inform(message = "{.field Filtering raw counts matrix to match Seurat Object.}") - raw_counts_matrix <- raw_counts_matrix[gene_names_seurat, cell_names_seurat] - # Create raw counts assay object cli_inform(message = "{.field Creating raw counts Seurat Assay Object.}") counts <- CreateAssayObject(counts = raw_counts_matrix, min.cells = 0, min.features = 0) + # Filter raw counts by created Seurat parameters + cli_inform(message = "{.field Filtering raw counts Assay Object to match Seurat Object.}") + counts <- subset(x = counts, cells = Cells(x = cell_bender_seurat), features = rownames(x = cell_bender_seurat)) + # Add counts assay to Seurat Object cli_inform(message = "{.field Adding assay to Seurat Object.}") cell_bender_seurat[[raw_assay_name]] <- counts @@ -223,7 +223,7 @@ Read10X_GEO <- function( } # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } @@ -243,7 +243,7 @@ Read10X_GEO <- function( cli_inform(message = "{.field Reading 10X files from directory}") pboptions(char = "=") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) @@ -257,7 +257,7 @@ Read10X_GEO <- function( if (!file.exists(barcode.loc)) { cli_abort(message = "Barcode file missing. Expecting {val {basename(path = barcode.loc)}}") } - if (!pre_ver_3 && !file.exists(features.loc) ) { + if (isFALSE(x = pre_ver_3) && !file.exists(features.loc) ) { cli_abort(message = "Gene name or features file missing. Expecting {val {basename(path = features.loc)}}") } if (!file.exists(matrix.loc)) { @@ -302,7 +302,7 @@ Read10X_GEO <- function( replacement.column <- ifelse(test = gene.column == 2, yes = 1, no = 2) feature.names[na.features, gene.column] <- feature.names[na.features, replacement.column] } - if (unique.features) { + if (isTRUE(x = unique.features)) { fcols = ncol(x = feature.names) if (fcols < gene.column) { cli_abort(message = c("{.code gene.column} was set to {.val {gene.column}}, but feature.tsv.gz (or genes.tsv) only has {.field {cols}} columns.", @@ -350,7 +350,7 @@ Read10X_GEO <- function( if (!file.exists(barcode.loc)) { cli_abort(message = "Barcode file missing. Expecting {.val {basename(path = barcode.loc)}}") } - if (!pre_ver_3 && !file.exists(features.loc) ) { + if (isFALSE(x = pre_ver_3) && !file.exists(features.loc) ) { cli_abort(message = "Gene name or features file missing. Expecting {.val {basename(path = features.loc)}}") } if (!file.exists(matrix.loc)) { @@ -395,7 +395,7 @@ Read10X_GEO <- function( replacement.column <- ifelse(test = gene.column == 2, yes = 1, no = 2) feature.names[na.features, gene.column] <- feature.names[na.features, replacement.column] } - if (unique.features) { + if (isTRUE(x = unique.features)) { fcols = ncol(x = feature.names) if (fcols < gene.column) { cli_abort(message = c("{.code gene.column} was set to {.val {gene.column}}, but feature.tsv.gz (or genes.tsv) only has {.field {cols}} columns.", @@ -458,14 +458,14 @@ Read10X_GEO <- function( # Name the list if (!is.null(x = sample_names)) { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } else { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } # Merge data if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } @@ -534,12 +534,17 @@ Read10X_h5_GEO <- function( } # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } file.list <- list.files(path = data_dir, pattern = ".h5", full.names = FALSE) - # Remove "barcodes.tsv.gz" file suffix + + # Remove file suffix if provided + if (!is.null(x = shared_suffix)) { + shared_suffix <- gsub(pattern = ".h5", replacement = "", x = shared_suffix) + } + if (is.null(x = sample_list)) { if (is.null(x = shared_suffix)) { sample_list <- gsub(pattern = ".h5", x = file.list, replacement = "") @@ -555,7 +560,7 @@ Read10X_h5_GEO <- function( cli_inform(message = "{.field Reading 10X H5 files from directory}") pboptions(char = "=") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) @@ -572,14 +577,14 @@ Read10X_h5_GEO <- function( # Name the matrices if (is.null(x = sample_names)) { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } else { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } @@ -654,16 +659,16 @@ Read10X_Multi_Directory <- function( sample_list <- Pull_Directory_List(base_path = base_path) } # Add file path for 10X default directories - if (default_10X_path && !is.null(x = secondary_path)) { + if (isTRUE(x = 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) { + if (isFALSE(x = default_10X_path) && !is.null(x = secondary_path) && isTRUE(x = cellranger_multi)) { cli_abort(message = "If {.code cellranger_multi = TRUE} then {.code default_10X_path} must be TRUE") } - if (default_10X_path) { - if (cellranger_multi) { + if (isTRUE(x = default_10X_path)) { + if (isTRUE(x = cellranger_multi)) { secondary_path <- "/outs/per_sample_outs/" multi_extra_path <- "count/sample_filtered_feature_bc_matrix" } else { @@ -682,13 +687,13 @@ Read10X_Multi_Directory <- function( } # read data cli_inform(message = "{.field Reading gene expression files.}") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " 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 (cellranger_multi) { + if (isTRUE(x = 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) @@ -701,7 +706,7 @@ Read10X_Multi_Directory <- function( if (is.null(x = secondary_path)) { file_path <- file.path(base_path, sample_list[x]) } else { - if (cellranger_multi) { + if (isTRUE(x = 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) @@ -712,13 +717,13 @@ Read10X_Multi_Directory <- function( } # Name the list items if (is.null(x = sample_names)) { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } else { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } return(raw_data_list) @@ -804,7 +809,7 @@ Read10X_h5_Multi_Directory <- function( } # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } # Confirm directory exists @@ -817,16 +822,16 @@ Read10X_h5_Multi_Directory <- function( } # Add file path for 10X default directories - if (default_10X_path && !is.null(x = secondary_path)) { + if (isTRUE(x = 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) { + if (isFALSE(x = default_10X_path) && !is.null(x = secondary_path) && isTRUE(x = cellranger_multi)) { cli_abort(message = "If {.code cellranger_multi = TRUE} then {.code default_10X_path} must be TRUE") } - if (default_10X_path) { - if (cellranger_multi) { + if (isTRUE(x = default_10X_path)) { + if (isTRUE(x = cellranger_multi)) { secondary_path <- "/outs/per_sample_outs/" multi_extra_path <- "count/" } else { @@ -847,13 +852,13 @@ Read10X_h5_Multi_Directory <- function( # read data cli_inform(message = "{.field Reading gene expression files.}") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " 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 (cellranger_multi) { + if (isTRUE(x = 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) @@ -863,12 +868,8 @@ Read10X_h5_Multi_Directory <- function( }) } else { raw_data_list <- pblapply(1:length(x = sample_list), function(x) { - if (is.null(x = secondary_path)) { - 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) - } + if (isTRUE(x = 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) } @@ -877,18 +878,18 @@ Read10X_h5_Multi_Directory <- function( } # Name the list items if (is.null(x = sample_names)) { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } else { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } # Replace Suffixes - if (replace_suffix) { + if (isTRUE(x = replace_suffix)) { if (is.null(x = new_suffix_list)) { cli_abort(message = "No values provided to {.code new_suffix_list} but {.code replace_suffix = TRUE}.") } - current_suffix_list <- sapply(1:length(raw_data_list), function(x) { + current_suffix_list <- sapply(1:length(x = raw_data_list), function(x) { unique(str_extract(string = colnames(x = raw_data_list[[x]]), pattern = "-.$")) }) @@ -901,8 +902,8 @@ Read10X_h5_Multi_Directory <- function( } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } return(raw_data_list) @@ -990,14 +991,14 @@ Read_GEO_Delim <- function( } # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } # Read in subset of files if (!is.null(x = sample_list)) { # Add suffix - if (full_names) { + if (isTRUE(x = full_names)) { file_list <- sample_list } else { file_list <- paste0(sample_list, file_suffix) @@ -1026,20 +1027,20 @@ Read_GEO_Delim <- function( # Read in files cli_inform(message = "{.field Reading gene expression files from directory}") pboptions(char = "=") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " 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(x = file_list), function(i) { dge_loc <- file.path(data_dir, file_list[i]) data <- fread(file = dge_loc, data.table = F) - if (move_genes_rownames) { - first_col_name <- colnames(data[1]) + if (isTRUE(x = move_genes_rownames)) { + first_col_name <- colnames(x = data[1]) data <- data %>% column_to_rownames(first_col_name) } - if (barcode_suffix_period) { - colnames(data) <- gsub("\\.", "-", colnames(data)) + if (isTRUE(x = barcode_suffix_period)) { + colnames(x = data) <- gsub("\\.", "-", colnames(x = data)) } data_sparse <- as(data, "Matrix") return(data_sparse) @@ -1048,8 +1049,8 @@ Read_GEO_Delim <- function( raw_data_list <- pblapply(1:length(x = file_list), function(i) { dge_loc <- file.path(data_dir, file_list[i]) data <- fread(file = dge_loc, data.table = F) - if (move_genes_rownames) { - first_col_name <- colnames(data[1]) + if (isTRUE(x = move_genes_rownames)) { + first_col_name <- colnames(x = data[1]) data <- data %>% column_to_rownames(first_col_name) } @@ -1059,8 +1060,8 @@ Read_GEO_Delim <- function( cli_abort(message = c("One or more columns in the file: {.val {dge_loc}} contains non-numeric data.", "i" = "Please check original file and/or that parameter {.code move_genes_rownames} is set appropriately.")) } - if (barcode_suffix_period) { - colnames(data) <- gsub("\\.", "-", colnames(data)) + if (isTRUE(x = barcode_suffix_period)) { + colnames(x = data) <- gsub("\\.", "-", colnames(x = data)) } data_sparse <- as(data, "Matrix") return(data_sparse) @@ -1068,7 +1069,7 @@ Read_GEO_Delim <- function( } # Name the items in list - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names # Check matrices for (i in 1:length(x = raw_data_list)) { @@ -1076,8 +1077,8 @@ Read_GEO_Delim <- function( } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } @@ -1110,6 +1111,7 @@ Read_GEO_Delim <- function( #' #' @import cli #' @import Matrix +#' @importFrom rlang is_installed #' #' @export #' @@ -1129,8 +1131,8 @@ Read_CellBender_h5_Mat <- function( feature_slot_name = "features" ) { # Check hdf5r installed - hdf5r_check <- PackageCheck("hdf5r", error = FALSE) - if (!hdf5r_check[1]) { + hdf5r_check <- is_installed(pkg = "hdf5r") + if (isFALSE(x = hdf5r_check)) { cli_abort(message = c( "Please install the {.val hdf5r} package to use {.code Read_CellBender_h5_Mat} and read HDF5 files.", "i" = "This can be accomplished with the following commands: ", @@ -1159,13 +1161,13 @@ Read_CellBender_h5_Mat <- function( # 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.", + 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) { + if (isTRUE(x = use.names)) { feature_slot <- 'features/name' } else { @@ -1174,7 +1176,7 @@ Read_CellBender_h5_Mat <- function( } if (feature_slot_name == "genes") { - if (use.names) { + if (isTRUE(x = use.names)) { feature_slot <- 'gene_names' } else { @@ -1186,7 +1188,7 @@ Read_CellBender_h5_Mat <- function( 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.", + 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}')}.")) } @@ -1209,7 +1211,7 @@ Read_CellBender_h5_Mat <- function( } else { # check subgroups if (is.null(x = h5_group_name)) { - cli::cli_abort(message = c("H5 file contains multiple sub-groups.", + 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')]] @@ -1231,7 +1233,7 @@ Read_CellBender_h5_Mat <- function( repr = "T" ) - if (unique.features) { + if (isTRUE(x = unique.features)) { features <- make.unique(names = features) } @@ -1309,7 +1311,7 @@ Read_CellBender_h5_Multi_Directory <- function( ... ) { # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } # Confirm directory exists @@ -1330,7 +1332,7 @@ Read_CellBender_h5_Multi_Directory <- function( if (length(x = file_ext) == 0) { cli_abort(message = "'custom_name' must end with file extension '.h5'.") } - } else if (filtered_h5) { + } else if (isTRUE(x = filtered_h5)) { file_suffix <- "_out_filtered.h5" } else { file_suffix <- "_out.h5" @@ -1351,7 +1353,7 @@ Read_CellBender_h5_Multi_Directory <- function( # read data cli_inform(message = "{.field Reading gene expression files.}") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) @@ -1376,13 +1378,13 @@ Read_CellBender_h5_Multi_Directory <- function( } # Name the list items if (is.null(x = sample_names)) { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } else { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } # Replace Suffixes - if (replace_suffix) { + if (isTRUE(x = replace_suffix)) { if (is.null(x = new_suffix_list)) { cli_abort(message = "No values provided to {.code new_suffix_list} but {.code replace_suffix = TRUE}.") } @@ -1400,8 +1402,8 @@ Read_CellBender_h5_Multi_Directory <- function( } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } return(raw_data_list) @@ -1471,7 +1473,7 @@ Read_CellBender_h5_Multi_File <- function( } # Confirm num_cores specified - if (parallel && is.null(x = num_cores)) { + if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") } @@ -1484,7 +1486,7 @@ Read_CellBender_h5_Multi_File <- function( if (length(x = file_ext) == 0) { cli_abort(message = "'custom_name' must end with file extension '.h5'.") } - } else if (filtered_h5) { + } else if (isTRUE(x = filtered_h5)) { file_suffix <- "_out_filtered.h5" } else { file_suffix <- "_out.h5" @@ -1503,7 +1505,7 @@ Read_CellBender_h5_Multi_File <- function( cli_inform(message = "{.field Reading Cell Bender H5 files from directory}") pboptions(char = "=") - if (parallel) { + if (isTRUE(x = parallel)) { cli_inform(message = c("NOTE: Progress bars not currently supported for parallel processing.", "NOTE: Parallel processing will not report informative error messages.", " If function fails set {.code parallel = FALSE} and re-run for informative error reporting.\n")) @@ -1520,14 +1522,14 @@ Read_CellBender_h5_Multi_File <- function( # Name the matrices if (is.null(x = sample_names)) { - names(raw_data_list) <- sample_list + names(x = raw_data_list) <- sample_list } else { - names(raw_data_list) <- sample_names + names(x = raw_data_list) <- sample_names } # Merge data - if (merge) { - raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(raw_data_list)) + if (isTRUE(x = merge)) { + raw_data_merged <- Merge_Sparse_Data_All(matrix_list = raw_data_list, add_cell_ids = names(x = raw_data_list)) return(raw_data_merged) } @@ -1549,6 +1551,7 @@ Read_CellBender_h5_Multi_File <- function( #' @param secondary_path path from the parent directory to count "outs/" folder which contains the #' "metrics_summary.csv" file. #' @param default_10X logical (default TRUE) sets the secondary path variable to the default 10X directory structure. +#' @param cellranger_multi logical, whether or not metrics come from Cell Ranger `count` or from Cell Ranger `multi`. Default is FALSE. #' @param lib_list a list of sample names (matching directory names) to import. If `NULL` will read #' in all samples in parent directory. #' @param lib_names a set of sample names to use for each sample. If `NULL` will set names to the @@ -1559,6 +1562,7 @@ Read_CellBender_h5_Multi_File <- function( #' @import cli #' @import pbapply #' @importFrom dplyr bind_rows +#' @importFrom magrittr "%>%" #' @importFrom utils txtProgressBar setTxtProgressBar read.csv #' #' @export @@ -1575,6 +1579,7 @@ Read_Metrics_10X <- function( base_path, secondary_path = NULL, default_10X = TRUE, + cellranger_multi = FALSE, lib_list = NULL, lib_names = NULL ) { @@ -1588,11 +1593,15 @@ Read_Metrics_10X <- function( } # Add file path for 10X default directories - if (default_10X && !is.null(x = secondary_path)) { + if (isTRUE(x = default_10X) && !is.null(x = secondary_path)) { cli_abort(message = "If {.code default_10X_path = TRUE} then {.code secondary_path} must be NULL.") } - if (default_10X) { - secondary_path <- "outs/" + if (isTRUE(x = default_10X)) { + if (isTRUE(x = cellranger_multi)) { + secondary_path <- "outs/per_sample_outs/" + } else { + secondary_path <- "outs/" + } } if (is.null(x = secondary_path)) { secondary_path <- "" @@ -1605,35 +1614,36 @@ Read_Metrics_10X <- function( } } - # Read in raw data - raw_data_list <- pblapply(1:length(x = lib_list), function(x) { + if (isTRUE(x = cellranger_multi)) { if (is.null(x = secondary_path)) { - file_path <- file.path(base_path, lib_list[x]) + s1_file_path <- file.path(base_path, lib_list[1]) } else { - file_path <- file.path(base_path, lib_list[x], secondary_path) + s1_file_path <- file.path(base_path, lib_list[1], secondary_path, lib_list[1]) } - raw_data <- read.csv(file = paste0(file_path, "metrics_summary.csv"), stringsAsFactors = F) - # Change format of numeric columns to due commas in data csv output. - column_numbers <- grep(pattern = ",", x = raw_data[1, ]) - raw_data[,c(column_numbers)] <- lapply(raw_data[,c(column_numbers)],function(x){as.numeric(gsub(",", "", x))}) - return(raw_data) - }) + modalities <- read.csv(file = file.path(s1_file_path, "metrics_summary.csv"), stringsAsFactors = F)$Library.Type %>% + unique() - # Name the list items - if (is.null(x = lib_names)) { - names(raw_data_list) <- lib_list - } else { - names(raw_data_list) <- lib_names - } + if ("Gene Expression" %in% modalities) { + multi_gex_metrics <- Metrics_Multi_GEX(lib_list = lib_list, base_path = base_path, secondary_path = secondary_path, lib_names = lib_names) + } - # Combine the list and add sample_id column - full_data <- bind_rows(raw_data_list, .id = "sample_id") + if ("VDJ T" %in% modalities) { + multi_vdjt_metrics <- Metrics_Multi_VDJT(lib_list = lib_list, base_path = base_path, secondary_path = secondary_path, lib_names = lib_names) + } - # Change column nams to use "_" separator instead of "." for readability - colnames(full_data) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = full_data)) + # Return data + data_list <- list( + multi_gex_metrics = multi_gex_metrics, + multi_vdjt_metrics = multi_vdjt_metrics + ) + + return(data_list) + } else { + count_gex_metrics <- Metrics_Count_GEX(lib_list = lib_list, base_path = base_path, secondary_path = secondary_path, lib_names = lib_names) - return(full_data) + return(count_gex_metrics) + } } diff --git a/R/Seurat_Iterative_Plotting.R b/R/Seurat_Iterative_Plotting.R index 7b07a6b43b..e96c139b0f 100644 --- a/R/Seurat_Iterative_Plotting.R +++ b/R/Seurat_Iterative_Plotting.R @@ -61,7 +61,7 @@ Iterate_PC_Loading_Plots <- function( } # Check pca present - reduc_present <- names(seurat_object@reductions) + reduc_present <- names(x = seurat_object@reductions) if (!"pca" %in% reduc_present) { cli_abort(message = "Cannot find reduction 'pca' in this Seurat Object.") } @@ -87,7 +87,7 @@ Iterate_PC_Loading_Plots <- function( } close(con = pb) dev.off() - if (return_plots) { + if (isTRUE(x = return_plots)) { return(all_plots) } } @@ -98,6 +98,7 @@ Iterate_PC_Loading_Plots <- function( #' Iterate DimPlot by orig.ident column from Seurat object metadata #' #' @param seurat_object Seurat object name. +#' @param sample_column name of meta.data column containing sample names/ids (default is "orig.ident"). #' @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. #' @param file_type File type to save output as. Must be one of following: ".pdf", ".png", ".tiff", ".jpeg", or ".svg". @@ -134,6 +135,7 @@ Iterate_PC_Loading_Plots <- function( Iterate_DimPlot_bySample <- function( seurat_object, + sample_column = "orig.ident", file_path = NULL, file_name = NULL, file_type = NULL, @@ -149,6 +151,18 @@ Iterate_DimPlot_bySample <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Check meta.data column if not orig.ident + if (sample_column != "orig.ident") { + # Check meta data + sample_column <- Meta_Present(seurat_object = seurat_object, meta_col_names = sample_column, omit_warn = FALSE, print_msg = FALSE)[[1]] + + # stop if none found + if (length(x = sample_column) == 0) { + cli_abort(message = c("No meta.data column found.", + "i" = "Column {.field {sample_column}} was not found in the meta.data slot.")) + } + } + # 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 == "") { file_path <- NULL @@ -167,10 +181,10 @@ Iterate_DimPlot_bySample <- function( } # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -188,7 +202,7 @@ Iterate_DimPlot_bySample <- function( # Extract reduction coordinates reduction <- reduction %||% DefaultDimReduc(object = seurat_object) - cells <- colnames(x = seurat_object) + cells <- Cells(x = seurat_object) reduc_coordinates <- Embeddings(object = seurat_object[[reduction]])[cells, dims] reduc_coordinates <- as.data.frame(x = reduc_coordinates) x_axis <- c(min(reduc_coordinates[, 1]), @@ -197,24 +211,24 @@ Iterate_DimPlot_bySample <- function( max(reduc_coordinates[, 2])) # Extract orig.ident - column_list <- as.character(x = unique(x = seurat_object@meta.data$orig.ident)) + column_list <- as.character(x = unique(x = seurat_object@meta.data[[sample_column]])) # Create list of cells per sample cells_per_sample <- lapply(column_list, function(sample) { - row.names(x = seurat_object@meta.data)[which(x = seurat_object@meta.data$orig.ident == sample)] + row.names(x = seurat_object@meta.data)[which(x = seurat_object@meta.data[[sample_column]] == sample)] }) # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") 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, ...) + + if (isTRUE(x = legend)) { + DimPlot(object = seurat_object, cells = cells, group.by = sample_column, 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, ...) + + DimPlot(object = seurat_object, cells = cells, group.by = sample_column, cols = color, reduction = reduction, pt.size = pt.size, ...) + xlim(x_axis) + ylim(y_axis) + NoLegend() @@ -236,12 +250,12 @@ 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)) { - if (legend) { - DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + if (isTRUE(x = legend)) { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = sample_column, 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, ...) + + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = sample_column, cols = color, reduction = reduction, pt.size = pt.size, ...) + xlim(x_axis) + ylim(y_axis) + NoLegend() @@ -256,12 +270,12 @@ 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)) { - if (legend) { - DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = "orig.ident", cols = color, reduction = reduction, pt.size = pt.size, ...) + + if (isTRUE(x = legend)) { + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = sample_column, 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, ...) + + DimPlot(object = seurat_object, cells = cells_per_sample[[i]], group.by = sample_column, cols = color, reduction = reduction, pt.size = pt.size, ...) + xlim(x_axis) + ylim(y_axis) + NoLegend() @@ -353,10 +367,10 @@ Iterate_Cluster_Highlight_Plot <- function( } # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -377,7 +391,7 @@ Iterate_Cluster_Highlight_Plot <- function( reduction <- reduction %||% DefaultDimReduc(object = seurat_object) # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Get number of clusters/identities list_idents <- levels(x = seurat_object@active.ident) @@ -399,7 +413,7 @@ Iterate_Cluster_Highlight_Plot <- function( } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") all_plots <- pblapply(1:num_idents, function(x) { @@ -572,10 +586,10 @@ Iterate_Meta_Highlight_Plot <- function( } # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -595,15 +609,15 @@ Iterate_Meta_Highlight_Plot <- function( reduction <- reduction %||% DefaultDimReduc(object = seurat_object) # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Relevel idents for plotting to sorted order - if (single_pdf && is.null(x = new_meta_order) && meta_data_sort) { + if (isTRUE(x = single_pdf) && is.null(x = new_meta_order) && meta_data_sort) { Idents(object = seurat_object) <- fct_relevel(Idents(object = seurat_object), sort) } # Relevel idents to custom order - if (single_pdf && !is.null(x = new_meta_order)) { + if (isTRUE(x = single_pdf) && !is.null(x = new_meta_order)) { 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))}})")) } @@ -629,11 +643,11 @@ Iterate_Meta_Highlight_Plot <- function( } } # Create plot titles if needed. - if (!is.null(x = title_prefix) && !no_legend) { + if (!is.null(x = title_prefix) && isFALSE(x = no_legend)) { cli_warn(message = "{.code title_prefix} was omitted as {.code no_legend = FALSE}.") } - if (is.null(x = title_prefix) && no_legend) { + if (is.null(x = title_prefix) && isTRUE(x = no_legend)) { plot_title <- lapply(1:num_idents, function(z) { paste0(meta_data_column, ": ", list_idents[z]) }) @@ -643,16 +657,16 @@ Iterate_Meta_Highlight_Plot <- function( }) } - if (!is.null(x = title_prefix) && length(x = title_prefix) != 1 && no_legend) { + if (!is.null(x = title_prefix) && length(x = title_prefix) != 1 && isTRUE(x = no_legend)) { cli_abort(message = "{.field `title_prefix`} must be vector of length 1.") } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") all_plots <- pblapply(1:num_idents, function(x) { - if (no_legend) { + if (isTRUE(x = no_legend)) { suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, meta_data_column = meta_data_column, meta_data_highlight = list_idents[x], @@ -694,7 +708,7 @@ Iterate_Meta_Highlight_Plot <- function( cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) for (i in 1:num_idents) { - if (no_legend) { + if (isTRUE(x = no_legend)) { suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, meta_data_column = meta_data_column, meta_data_highlight = list_idents[i], @@ -729,7 +743,7 @@ Iterate_Meta_Highlight_Plot <- function( cli_inform(message = "{.field Generating plots and saving plots to file}") pb <- txtProgressBar(min = 0, max = num_idents, style = 3, file = stderr()) for (i in 1:num_idents) { - if (no_legend) { + if (isTRUE(x = no_legend)) { suppressMessages(Meta_Highlight_Plot(seurat_object = seurat_object, meta_data_column = meta_data_column, meta_data_highlight = list_idents[i], @@ -768,8 +782,9 @@ Iterate_Meta_Highlight_Plot <- function( #' Create and Save plots for Gene list with Single Command #' #' @param seurat_object Seurat object name. -#' @param gene_list vector of genes to plot. If a named vector is provided then the names for each gene +#' @param features vector of features to plot. If a named vector is provided then the names for each gene #' will be incorporated into plot title if `single_pdf = TRUE` or into file name if `FALSE`. +#' @param gene_list `r lifecycle::badge("deprecated")` soft-deprecated. See `features`. #' @param colors_use color scheme to use. #' @param na_color color for non-expressed cells. #' @param na_cutoff Value to use as minimum expression cutoff. To set no cutoff set to `NA`. @@ -816,7 +831,8 @@ Iterate_Meta_Highlight_Plot <- function( Iterate_FeaturePlot_scCustom <- function( seurat_object, - gene_list, + features, + gene_list = deprecated(), colors_use = viridis_plasma_dark_high, na_color = "lightgray", na_cutoff = 0.000000001, @@ -835,6 +851,18 @@ Iterate_FeaturePlot_scCustom <- function( alpha_na_exp = NULL, ... ) { + # Deprecation warning + if (lifecycle::is_present(gene_list)) { + lifecycle::deprecate_warn(when = "1.2.0", + what = "Iterate_FeaturePlot_scCustom(gene_list)", + with = "Iterate_FeaturePlot_scCustom(features)", + details = c("v" = "The parameter will remain functional until next major update.", + "i" = "Please adjust code now to prepare for full deprecation.") + ) + features <- gene_list + } + + # temp turn off message call from FeaturePlot_scCustomize op <- options(scCustomize_warn_na_cutoff = FALSE) on.exit(options(op)) @@ -843,11 +871,11 @@ Iterate_FeaturePlot_scCustom <- function( Is_Seurat(seurat_object = seurat_object) # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Return plot check - if (return_plots) { - if (!is.null(x = file_type) | !is.null(x = file_path) | !is.null(x = file_name) | single_pdf) { + if (isTRUE(x = return_plots)) { + if (!is.null(x = file_type) | !is.null(x = file_path) | !is.null(x = file_name) | isTRUE(x = single_pdf)) { cli_abort(message = c("Cannot return plots to list and save plots to file with single function call.", "i" = "If {.field saving plots} please set {.code return_plots = FALSE}.", "i" = "If {.field returning plots} please leave {.code file_type}, {.code file_path}, {.code file_name} and {.code single_pdf} at their default settings.")) @@ -860,14 +888,14 @@ Iterate_FeaturePlot_scCustom <- function( } # Check file path is valid - if (!is.null(x = file_path) && !return_plots) { + if (!is.null(x = file_path) && isFALSE(x = return_plots)) { if (!dir.exists(paths = file_path)) { cli_abort(message = "Provided {.code file_path}: {symbol$dquote_left}{.field {file_path}}{symbol$dquote_right} does not exist.") } } # Check if file name provided - if (is.null(x = file_name) && !return_plots) { + if (is.null(x = file_name) && isFALSE(return_plots)) { cli_abort(message = "No file name provided. Please provide a file name using {.code file_name}.") } @@ -875,10 +903,10 @@ Iterate_FeaturePlot_scCustom <- function( reduction <- reduction %||% DefaultDimReduc(object = seurat_object) # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -894,35 +922,47 @@ Iterate_FeaturePlot_scCustom <- function( cli_abort(message = "{.code file_type} must be one of the following: {.field {glue_collapse_scCustom(input_string = file_type_options, and = TRUE)}}") } - # Check whether features are present in object - gene_list <- Gene_Present(data = seurat_object, gene_list = gene_list, print_msg = FALSE, case_check = TRUE)[[1]] + # Check whether features are present in object (dependent on whether vector is named) + if (is.null(x = names(x = features))) { + all_found_features <- Feature_PreCheck(object = seurat_object, features = features) + } else { + all_found_features <- features + } + + if (any(features %in% colnames(seurat_object@meta.data)) && any(features %in% rownames(seurat_object))) { + cli_warn(message = c("Some of the {.code features} provided are from both assay features and meta.data", + "*" = "This could cause problems in plot output due to differences in {.field na_cutoff} parameter.", + "i" = "Suggest splitting {.code features} and running {.field Iterate_FeaturePlot_scCustom} once for each feature list.")) + } + + # gene_list <- Gene_Present(data = seurat_object, gene_list = gene_list, print_msg = FALSE, case_check = TRUE)[[1]] # Modify Cluster Labels names if needed for saving plots - if (!is.null(x = names(gene_list)) && !single_pdf) { - names_vec_mod <- gsub(pattern = "/", replacement = "-", x = names(x = gene_list)) - names(gene_list) <- names_vec_mod + if (!is.null(x = names(x = all_found_features)) && isFALSE(x = single_pdf)) { + names_vec_mod <- gsub(pattern = "/", replacement = "-", x = names(x = all_found_features)) + names(x = all_found_features) <- names_vec_mod } # Return plots instead of saving them - if (return_plots) { + if (isTRUE(x = return_plots)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pblapply(gene_list,function(gene) {FeaturePlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...)}) + all_plots <- pblapply(all_found_features,function(gene) {FeaturePlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...)}) return(all_plots) } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pblapply(gene_list,function(gene) {FeaturePlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp,...)}) + all_plots <- pblapply(all_found_features,function(gene) {FeaturePlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp,...)}) cli_inform(message = "{.field Saving plots to file}") # save plots with cluster annotation - if (!is.null(x = names(x = gene_list)) && is.null(x = split.by)) { + if (!is.null(x = names(x = all_found_features)) && is.null(x = split.by)) { pdf(paste(file_path, file_name, file_type, sep="")) pb <- txtProgressBar(min = 0, max = length(all_plots), style = 3, file = stderr()) for (i in 1:length(all_plots)) { - print(all_plots[[i]] + ggtitle((paste0(gene_list[i], "_", names(x = gene_list)[i])))) + print(all_plots[[i]] + ggtitle((paste0(all_found_features[i], "_", names(x = all_found_features)[i])))) setTxtProgressBar(pb = pb, value = i) } close(con = pb) @@ -942,13 +982,13 @@ Iterate_FeaturePlot_scCustom <- function( else { if (str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "{.field Generating plots and saving plots to file}") - pb <- txtProgressBar(min = 0, max = length(gene_list), style = 3, file = stderr()) - for (i in 1:length(gene_list)) { - FeaturePlot_scCustom(seurat_object = seurat_object, features = gene_list[i], colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...) - if (!is.null(x = names(x = gene_list))) { - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], "_", names(x = gene_list)[i], "_", file_name, file_type, sep=""), dpi = dpi)) + pb <- txtProgressBar(min = 0, max = length(all_found_features), style = 3, file = stderr()) + for (i in 1:length(all_found_features)) { + FeaturePlot_scCustom(seurat_object = seurat_object, features = all_found_features[i], colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...) + if (!is.null(x = names(x = all_found_features))) { + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], "_", names(x = all_found_features)[i], "_", file_name, file_type, sep=""), dpi = dpi)) } else { - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], "_", file_name, file_type, sep=""), dpi = dpi)) + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], "_", file_name, file_type, sep=""), dpi = dpi)) } setTxtProgressBar(pb = pb, value = i) } @@ -956,13 +996,13 @@ Iterate_FeaturePlot_scCustom <- function( } if (str_detect(file_type, ".pdf") == TRUE) { cli_inform(message = "{.field Generating plots and saving plots to file}") - pb <- txtProgressBar(min = 0, max = length(gene_list), style = 3, file = stderr()) - for (i in 1:length(gene_list)) { - FeaturePlot_scCustom(seurat_object = seurat_object, features = gene_list[i], colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...) - if (!is.null(x = names(x = gene_list))) { - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], "_", names(x = gene_list)[i], "_", file_name, file_type, sep=""), useDingbats = FALSE)) + pb <- txtProgressBar(min = 0, max = length(all_found_features), style = 3, file = stderr()) + for (i in 1:length(all_found_features)) { + FeaturePlot_scCustom(seurat_object = seurat_object, features = all_found_features[i], colors_use = colors_use, na_color = na_color, na_cutoff = na_cutoff, split.by = split.by, order = order, pt.size = pt.size, reduction = reduction, raster = raster, alpha_exp = alpha_exp, alpha_na_exp = alpha_na_exp, ...) + if (!is.null(x = names(x = all_found_features))) { + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], "_", names(x = all_found_features)[i], "_", file_name, file_type, sep=""), useDingbats = FALSE)) } else { - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], "_", file_name, file_type, sep=""), useDingbats = FALSE)) + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], "_", file_name, file_type, sep=""), useDingbats = FALSE)) } setTxtProgressBar(pb = pb, value = i) } @@ -971,7 +1011,7 @@ Iterate_FeaturePlot_scCustom <- function( } # One warning rastering - if (!raster && single_pdf && getOption(x = 'scCustomize_warn_raster_iterative', default = TRUE)) { + if (isFALSE(x = raster) && isTRUE(x = single_pdf) && getOption(x = 'scCustomize_warn_raster_iterative', default = TRUE)) { cli_inform(message = c("", "NOTE: {.code single_pdf = TRUE} and {.code raster = FALSE},", "Saving large numbers of plots in vector form can result in very large file sizes.", @@ -989,7 +1029,8 @@ Iterate_FeaturePlot_scCustom <- function( #' Create and Save plots for Gene list with Single Command #' #' @param seurat_object Seurat object name. -#' @param gene_list list of genes to plot. +#' @param features vector of features to plot. +#' @param gene_list `r lifecycle::badge("deprecated")` soft-deprecated. See `features`. #' @param colors_use color palette to use for plotting. By default if number of levels plotted is less than #' or equal to 36 it will use "polychrome" and if greater than 36 will use "varibow" with shuffle = TRUE #' both from `DiscretePalette_scCustomize`. @@ -1033,7 +1074,8 @@ Iterate_FeaturePlot_scCustom <- function( Iterate_VlnPlot_scCustom <- function( seurat_object, - gene_list, + features, + gene_list = deprecated(), colors_use = NULL, pt.size = NULL, group.by = NULL, @@ -1048,6 +1090,18 @@ Iterate_VlnPlot_scCustom <- function( color_seed = 123, ... ) { + # Deprecation warning + if (lifecycle::is_present(gene_list)) { + lifecycle::deprecate_warn(when = "1.2.0", + what = "Iterate_VlnPlot_scCustom(gene_list)", + with = "Iterate_VlnPlot_scCustom(features)", + details = c("v" = "The parameter will remain functional until next major update.", + "i" = "Please adjust code now to prepare for full deprecation.") + ) + features <- gene_list + } + + # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -1072,10 +1126,10 @@ Iterate_VlnPlot_scCustom <- function( } # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -1091,8 +1145,15 @@ Iterate_VlnPlot_scCustom <- function( cli_abort(message = "{.code file_type} must be one of the following: {.field {glue_collapse_scCustom(input_string = file_type_options, and = TRUE)}}") } - # Check whether features are present in object - gene_list <- Gene_Present(data = seurat_object, gene_list = gene_list, print_msg = FALSE, case_check = TRUE)[[1]] + # Check whether features are present in object (dependent on whether vector is named) + if (is.null(x = names(x = features))) { + all_found_features <- Feature_PreCheck(object = seurat_object, features = features) + } else { + all_found_features <- features + } + + # # Check whether features are present in object + # gene_list <- Gene_Present(data = seurat_object, gene_list = gene_list, print_msg = FALSE, case_check = TRUE)[[1]] # Set default color palette based on number of levels being plotted if (is.null(x = group.by)) { @@ -1102,7 +1163,7 @@ Iterate_VlnPlot_scCustom <- function( } # Check colors use vs. ggplot2 color scale - if (!is.null(x = colors_use) && ggplot_default_colors) { + if (!is.null(x = colors_use) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both custom palette to {.code colors_use} and specify {.code ggplot_default_colors = TRUE}.") } if (is.null(x = colors_use)) { @@ -1113,7 +1174,7 @@ Iterate_VlnPlot_scCustom <- function( } # Add one time raster warning - if (single_pdf && pt.size != 0 && !raster && getOption(x = 'scCustomize_warn_vln_raster_iterative', default = TRUE)) { + if (isTRUE(x = single_pdf) && pt.size != 0 && isFALSE(raster) && getOption(x = 'scCustomize_warn_vln_raster_iterative', default = TRUE)) { cli_inform(message = c("", "NOTE: {.code single_pdf = TRUE} and {.code pt.size} > 0 and {.code raster = FALSE},", "so all points are plotted.", @@ -1126,10 +1187,10 @@ Iterate_VlnPlot_scCustom <- function( } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") - all_plots <- pblapply(gene_list,function(gene) {VlnPlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...)}) + all_plots <- pblapply(all_found_features,function(gene) {VlnPlot_scCustom(seurat_object = seurat_object, features = gene, colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...)}) 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()) @@ -1143,20 +1204,20 @@ Iterate_VlnPlot_scCustom <- function( else { if (str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "{.field Generating plots and saving plots to file}") - pb <- txtProgressBar(min = 0, max = length(gene_list), style = 3, file = stderr()) - for (i in 1:length(gene_list)) { - VlnPlot_scCustom(seurat_object = seurat_object, features = gene_list[i], colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...) - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], file_name, file_type, sep=""), dpi = dpi)) + pb <- txtProgressBar(min = 0, max = length(x = all_found_features), style = 3, file = stderr()) + for (i in 1:length(x = all_found_features)) { + VlnPlot_scCustom(seurat_object = seurat_object, features = all_found_features[i], colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...) + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], file_name, file_type, sep=""), dpi = dpi)) setTxtProgressBar(pb = pb, value = i) } close(con = pb) } if (str_detect(file_type, ".pdf") == TRUE) { cli_inform(message = "{.field Generating plots and saving plots to file}") - pb <- txtProgressBar(min = 0, max = length(gene_list), style = 3, file = stderr()) - for (i in 1:length(gene_list)) { - VlnPlot_scCustom(seurat_object = seurat_object, features = gene_list[i], colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...) - suppressMessages(ggsave(filename = paste(file_path, gene_list[i], file_name, file_type, sep=""), useDingbats = FALSE)) + pb <- txtProgressBar(min = 0, max = length(x = all_found_features), style = 3, file = stderr()) + for (i in 1:length(x = all_found_features)) { + VlnPlot_scCustom(seurat_object = seurat_object, features = all_found_features[i], colors_use = colors_use, pt.size = pt.size, group.by = group.by, raster = raster, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, split.by = split.by, ...) + suppressMessages(ggsave(filename = paste(file_path, all_found_features[i], file_name, file_type, sep=""), useDingbats = FALSE)) setTxtProgressBar(pb = pb, value = i) } close(con = pb) @@ -1189,7 +1250,8 @@ Iterate_VlnPlot_scCustom <- function( #' @import ggplot2 #' @importFrom grDevices dev.off pdf #' @importFrom pbapply pblapply pboptions -#' @importFrom SeuratObject DefaultDimReduc PackageCheck +#' @importFrom rlang is_installed +#' @importFrom SeuratObject DefaultDimReduc #' @importFrom stringr str_detect #' @importFrom utils txtProgressBar setTxtProgressBar #' @@ -1223,8 +1285,8 @@ Iterate_Plot_Density_Custom <- function( ... ) { # Check Nebulosa installed - Nebulosa_check <- PackageCheck("Nebulosa", error = FALSE) - if (!Nebulosa_check[1]) { + Nebulosa_check <- is_installed(pkg = "Nebulosa") + if (isFALSE(x = Nebulosa_check)) { cli_abort(message = c( "Please install the {.val Nebulosa} package to use {.code Iterate_Plot_Density_Custom}", "i" = "This can be accomplished with the following commands: ", @@ -1266,10 +1328,10 @@ Iterate_Plot_Density_Custom <- function( reduction <- reduction %||% DefaultDimReduc(object = seurat_object) # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -1295,13 +1357,13 @@ Iterate_Plot_Density_Custom <- function( } # Modify Cluster Labels names if needed for saving plots - if (!is.null(x = names(gene_list)) && !single_pdf) { + if (!is.null(x = names(x = gene_list)) && isFALSE(x = single_pdf)) { names_vec_mod <- gsub(pattern = "/", replacement = "-", x = names(x = gene_list)) - names(gene_list) <- names_vec_mod + names(x = gene_list) <- names_vec_mod } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") all_plots <- pblapply(gene_list,function(gene) { @@ -1389,7 +1451,8 @@ Iterate_Plot_Density_Custom <- function( #' @importFrom grDevices dev.off pdf #' @importFrom pbapply pblapply pboptions #' @importFrom purrr discard keep -#' @importFrom SeuratObject DefaultDimReduc PackageCheck +#' @importFrom rlang is_installed +#' @importFrom SeuratObject DefaultDimReduc #' @importFrom stringr str_detect #' @importFrom utils txtProgressBar setTxtProgressBar #' @@ -1423,8 +1486,8 @@ Iterate_Plot_Density_Joint <- function( ... ) { # Check Nebulosa installed - Nebulosa_check <- PackageCheck("Nebulosa", error = FALSE) - if (!Nebulosa_check[1]) { + Nebulosa_check <- is_installed("Nebulosa") + if (isFALSE(Nebulosa_check)) { cli_abort(message = c( "Please install the {.val Nebulosa} package to use {.code Iterate_Plot_Density_Joint}", "i" = "This can be accomplished with the following commands: ", @@ -1473,10 +1536,10 @@ Iterate_Plot_Density_Joint <- function( reduction <- reduction %||% DefaultDimReduc(object = seurat_object) # Set file type for single pdf option - if (single_pdf && is.null(x = file_type)) { + if (isTRUE(x = single_pdf) && is.null(x = file_type)) { file_type <- ".pdf" } - if (single_pdf && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { + if (isTRUE(x = single_pdf) && !is.null(x = file_type) && str_detect(file_type, ".pdf") == FALSE) { cli_inform(message = "WARNING: non-PDF {.code file_type} specified but {.code single_pdf = TRUE} selected. Changing file_type to {.val .pdf} for output.") file_type <- ".pdf" } @@ -1498,7 +1561,7 @@ Iterate_Plot_Density_Joint <- function( }) if (!is.null(x = names(x = gene_list))) { - names(checked_gene_list) <- names(x = gene_list) + names(x = checked_gene_list) <- names(x = gene_list) } # remove any empty entries in list @@ -1520,13 +1583,13 @@ Iterate_Plot_Density_Joint <- function( } # Modify Cluster Labels names if needed for saving plots - if (!is.null(x = names(gene_list)) && !single_pdf) { + if (!is.null(x = names(x = gene_list)) && isFALSE(x = single_pdf)) { names_vec_mod <- gsub(pattern = "/", replacement = "-", x = names(x = gene_list)) - names(gene_list) <- names_vec_mod + names(x = gene_list) <- names_vec_mod } # Single PDF option - if (single_pdf == TRUE) { + if (isTRUE(x = single_pdf)) { cli_inform(message = "{.field Generating plots}") pboptions(char = "=") all_plots <- pblapply(1:length(final_gene_list),function(i) { diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 6e3f95e694..a95eb694dd 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -26,8 +26,11 @@ #' 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 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 num_columns Number of columns in plot layout. -#' @param slot Which slot to pull expression data from? Default is "data". +#' @param slot `r lifecycle::badge("deprecated")` soft-deprecated. See `layer` +#' @param layer Which layer 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 #' value between 0-1. #' @param alpha_na_exp new alpha level to apply to non-expressing cell color palette (`na_color`). Must be @@ -74,8 +77,10 @@ FeaturePlot_scCustom <- function( split.by = NULL, split_collect = NULL, aspect_ratio = NULL, + figure_plot = FALSE, num_columns = NULL, - slot = "data", + slot = deprecated(), + layer = "data", alpha_exp = NULL, alpha_na_exp = NULL, label = FALSE, @@ -86,6 +91,17 @@ FeaturePlot_scCustom <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Check is slot is supplied + if (lifecycle::is_present(slot)) { + lifecycle::deprecate_warn(when = "2.0.0", + what = "slot", + with = "layer", + details = c("v" = "As of Seurat 5.0.0 the {.code slot} parameter is deprecated and replaced with {.code layer}.", + "i" = "Please adjust code now to prepare for full deprecation.") + ) + layer <- slot + } + # Check meta if (!is.null(x = split.by)) { split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] @@ -101,7 +117,7 @@ FeaturePlot_scCustom <- function( } if (!is.null(x = split_collect)) { - if (length(x = features) > 1 && split_collect) { + if (length(x = features) > 1 && isTRUE(x = split_collect)) { cli_abort(message = "{.code split_collect} cannot be set to {.field TRUE} if the number of features is greater than 1.") } } @@ -110,14 +126,14 @@ FeaturePlot_scCustom <- function( all_found_features <- Feature_PreCheck(object = seurat_object, features = features) # Get length of meta data feature - if (is.null(x = split.by) && label_feature_yaxis) { + if (is.null(x = split.by) && isTRUE(x = label_feature_yaxis)) { cli_abort(message = "Setting {.code label_feature_yaxis = TRUE} is only supported when also setting {.code split.by}.") } if (!is.null(x = split.by)) { - split.by_length <- length(unique(seurat_object@meta.data[[split.by]])) + split.by_length <- length(x = unique(x = seurat_object@meta.data[[split.by]])) - if (!is.null(x = num_columns) && label_feature_yaxis) { + if (!is.null(x = num_columns) && isTRUE(x = label_feature_yaxis)) { cli_warn(message = c("Setting number of columns is not permitted if {.code label_feature_yaxis = TRUE}", "i" = "Number of columns be automatically set to number of levels in `split.by` ({.field {split.by_length}}).") @@ -148,7 +164,7 @@ FeaturePlot_scCustom <- function( } # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Set uniform poist size is pt.size = NULL (based on plot with most cells) if (is.null(x = pt.size)) { @@ -185,12 +201,12 @@ FeaturePlot_scCustom <- function( } # plot no split & combined - if (is.null(x = split.by) && combine) { + if (is.null(x = split.by) && isTRUE(x = combine)) { plot <- suppressMessages(FeaturePlot(object = seurat_object, features = all_found_features, order = order, pt.size = pt.size, reduction = reduction, raster = raster, split.by = split.by, ncol = num_columns, combine = combine, raster.dpi = raster.dpi, label = label, ...) & scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, NA), na.value = na_color)) } # plot no split & combined - if (is.null(x = split.by) && !combine) { + if (is.null(x = split.by) && isFALSE(x = combine)) { plot_list <- suppressMessages(FeaturePlot(object = seurat_object, features = all_found_features, order = order, pt.size = pt.size, reduction = reduction, raster = raster, split.by = split.by, ncol = num_columns, combine = combine, raster.dpi = raster.dpi, label = label, ...)) plot <- lapply(1:length(x = plot_list), function(i) { @@ -205,19 +221,19 @@ FeaturePlot_scCustom <- function( feature_data <- FetchData( object = seurat_object, vars = all_found_features, - slot = slot) + layer = layer) # Pull min and max values max_exp_value <- max(feature_data) min_exp_value <- min(feature_data) plot <- suppressMessages(FeaturePlot(object = seurat_object, features = all_found_features, order = order, pt.size = pt.size, reduction = reduction, raster = raster, split.by = split.by, raster.dpi = raster.dpi, label = label, ...) & scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, max_exp_value), na.value = na_color, name = all_found_features)) & RestoreLegend() & theme(axis.title.y.right = element_blank()) - if (label_feature_yaxis) { + if (isTRUE(x = label_feature_yaxis)) { plot <- plot + plot_layout(nrow = num_rows, ncol = num_columns) plot <- plot & theme(legend.title=element_blank()) plot <- suppressMessages(plot + scale_y_continuous(sec.axis = dup_axis(name = all_found_features))) + No_Right() } else { - if (split_collect) { + if (isTRUE(x = 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}.") } @@ -235,14 +251,14 @@ FeaturePlot_scCustom <- function( feature_data <- FetchData( object = seurat_object, vars = all_found_features[i], - slot = slot) + layer = layer) # Pull min and max values max_exp_value <- max(feature_data) min_exp_value <- min(feature_data) single_plot <- suppressMessages(FeaturePlot(object = seurat_object, features = all_found_features[i], order = order, pt.size = pt.size, reduction = reduction, raster = raster, split.by = split.by, raster.dpi = raster.dpi, label = label, ...) & scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, max_exp_value), na.value = na_color, name = features[i])) & RestoreLegend() & theme(axis.title.y.right = element_blank()) - if (label_feature_yaxis) { + if (isTRUE(x = label_feature_yaxis)) { single_plot <- single_plot + plot_layout(nrow = num_rows, ncol = num_columns) single_plot <- single_plot & theme(legend.title=element_blank()) single_plot <- suppressMessages(single_plot + scale_y_continuous(sec.axis = dup_axis(name = all_found_features[i]))) + No_Right() @@ -287,6 +303,19 @@ FeaturePlot_scCustom <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + # Figure plot + if (isTRUE(x = figure_plot)) { + if (length(x = all_found_features) == 1) { + plot <- Figure_Plot(plot = plot) + } else { + plot_list <- lapply(1:length(x = all_found_features), function(j) { + fig_plot <- Figure_Plot(plot = plot[[j]]) + }) + + plot <- wrap_plots(plot_list, ncol = num_columns) + } + } + return(plot) } @@ -312,7 +341,8 @@ FeaturePlot_scCustom <- function( #' greater than 200,000 cells. #' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). #' Default is c(512, 512). -#' @param slot Which slot to pull expression data from? Default is "data". +#' @param slot `r lifecycle::badge("deprecated")` soft-deprecated. See `layer` +#' @param layer Which layer to pull expression data from? Default is "data". #' @param num_columns Number of columns in plot layout. If number of features > 1 then `num_columns` #' dictates the number of columns in overall layout (`num_columns = 1` means stacked layout & `num_columns = 2` #' means adjacent layout). @@ -354,12 +384,27 @@ FeaturePlot_DualAssay <- function( na_cutoff = 0.000000001, raster = NULL, raster.dpi = c(512, 512), - slot = "data", + slot = deprecated(), + layer = "data", num_columns = NULL, alpha_exp = NULL, alpha_na_exp = NULL, ... ) { + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # Check is slot is supplied + if (lifecycle::is_present(slot)) { + lifecycle::deprecate_warn(when = "2.0.0", + what = "slot", + with = "layer", + details = c("v" = "As of Seurat 5.0.0 the {.code slot} parameter is deprecated and replaced with {.code layer}.", + "i" = "Please adjust code now to prepare for full deprecation.") + ) + layer <- slot + } + # Check assays present assays_not_found <- Assay_Present(seurat_object = seurat_object, assay_list = c(assay1, assay2), print_msg = FALSE, omit_warn = TRUE)[[2]] @@ -400,12 +445,12 @@ FeaturePlot_DualAssay <- function( # Change assay and plot raw 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) + plot_raw <- FeaturePlot_scCustom(seurat_object = seurat_object, features = features, layer = layer, 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(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) + plot_cell_bender <- FeaturePlot_scCustom(seurat_object = seurat_object, features = features, layer = layer, 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) @@ -424,6 +469,7 @@ FeaturePlot_DualAssay <- function( #' Split FeatureScatter #' +#' `r lifecycle::badge("deprecated")` #' Create FeatureScatter using split.by #' #' @param seurat_object Seurat object name. @@ -462,12 +508,20 @@ FeaturePlot_DualAssay <- function( #' @concept seurat_plotting #' #' @examples +#' \dontrun{ +#' # Function now DEPRECATED. #' library(Seurat) #' pbmc_small$sample_id <- sample(c("sample1", "sample2"), size = ncol(pbmc_small), replace = TRUE) #' +#' # OLD Code #' Split_FeatureScatter(seurat_object = pbmc_small, feature1 = "nCount_RNA", feature2 = "nFeature_RNA", #' split.by = "sample_id") #' +#' # NEW Code +#' FeatureScatter_scCustom(seurat_object = pbmc_small, feature1 = "nCount_RNA", +#' feature2 = "nFeature_RNA", split.by = "sample_id") +#'} +#' Split_FeatureScatter <- function( seurat_object, @@ -486,6 +540,12 @@ Split_FeatureScatter <- function( color_seed = 123, ... ) { + lifecycle::deprecate_stop(when = "2.0.0", + what = "Split_FeatureScatter()", + with = "FeatureScatter_scCustom()", + details = c("i" = "The functionality is now contained within `FeatureScatter_scCustom`") + ) + # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -501,8 +561,8 @@ Split_FeatureScatter <- function( ) } - # Set columna and row lengths - split.by_length <- length(unique(seurat_object@meta.data[[split.by]])) + # Set column and row lengths + split.by_length <- length(x = unique(x = seurat_object@meta.data[[split.by]])) if (is.null(x = num_columns)) { num_columns <- split.by_length @@ -552,7 +612,7 @@ Split_FeatureScatter <- function( 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) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Set uniform point size is pt.size = NULL (based on plot with most cells) if (is.null(x = pt.size)) { @@ -602,7 +662,7 @@ Split_FeatureScatter <- function( legend.position = "right") + xlim(min_feature1, max_feature1) + ylim(min_feature2, max_feature2) - if (plot_cor) { + if (isTRUE(x = plot_cor)) { plot + ggtitle(paste(meta_sample_list[[j]]), subtitle = paste0("Correlation: ", cor_values[j])) } else { plot + ggtitle(paste(meta_sample_list[[j]])) @@ -642,6 +702,9 @@ Split_FeatureScatter <- function( #' @param group.by Name of one or more metadata columns to group (color) cells by (for example, orig.ident); #' default is the current active.ident of the object. #' @param split.by Feature to split plots by (i.e. "orig.ident"). +#' @param plot_median logical, whether to plot median for each ident on the plot (Default is FALSE). +#' @param plot_boxplot logical, whether to plot boxplot inside of violin (Default is FALSE). +#' @param median_size Shape size for the median is plotted. #' @param idents Which classes to include in the plot (default is all). #' @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). @@ -679,6 +742,9 @@ VlnPlot_scCustom <- function( pt.size = NULL, group.by = NULL, split.by = NULL, + plot_median = FALSE, + plot_boxplot = FALSE, + median_size = 15, idents = NULL, num_columns = NULL, raster = NULL, @@ -695,14 +761,39 @@ VlnPlot_scCustom <- function( split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] } + # Add check for group.by before getting to colors + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + # Check features and meta to determine which features present all_found_features <- Feature_PreCheck(object = seurat_object, features = features) + # Check boxplot vs median + if (isTRUE(x = plot_median) && isTRUE(x = plot_boxplot)) { + cli_abort(message = c("Incompatible settings.", + "{.code plot_median} and {.code plot_boxplot} cannot both be set to TRUE.")) + } + # set size if NULL - pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) + if (isTRUE(x = plot_boxplot)) { + if (!is.null(x = pt.size)) { + cli::cli_warn(message = c("Provided value for {.code pt.size} ({.field {pt.size}}) will be ignored.", + "When setting {.field plot_boxplot = TRUE}, {.code pt.size} is automatically set to 0.")) + } + pt.size <- 0 + } else { + pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) + } + + # check median vs boxplot + if (isTRUE(x = plot_median) && isTRUE(x = plot_boxplot)) { + cli_abort(message = "{.code plot_median} and {.code plot_boxplot} cannot both be set {.field TRUE}") + } # Add raster check for scCustomize - num_cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = idents)) + # num_cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = idents)) + num_cells <- length(x = Cells(x = seurat_object)) if (is.null(x = raster)) { if (pt.size == 0) { @@ -720,14 +811,19 @@ VlnPlot_scCustom <- function( } # Set default color palette based on number of levels being plotted - if (is.null(x = group.by)) { - group_by_length <- length(x = unique(x = seurat_object@active.ident)) + if (is.null(x = split.by)) { + if (is.null(x = group.by)) { + group_by_length <- length(x = unique(x = seurat_object@active.ident)) + } else { + group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + } } else { - group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + group_by_length <- length(x = unique(x = seurat_object@meta.data[[split.by]])) } + # Check colors use vs. ggplot2 color scale - if (!is.null(x = colors_use) && ggplot_default_colors) { + if (!is.null(x = colors_use) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both custom palette to {.code colors_use} and specify {.code ggplot_default_colors = TRUE}.") } @@ -739,6 +835,22 @@ VlnPlot_scCustom <- function( # Plot plot <- VlnPlot(object = seurat_object, features = all_found_features, cols = colors_use, pt.size = pt.size, idents = idents, group.by = group.by, split.by = split.by, ncol = num_columns, raster = raster, add.noise = add.noise, ...) + # Add add median plot + if (isTRUE(x = plot_median) && is.null(x = split.by)) { + plot <- plot + stat_summary(fun = median, geom='point', size = median_size, colour = "white", shape = 95) + } + + if (isTRUE(x = plot_median) && !is.null(x = split.by)) { + cli_abort(message = "Cannot add median ({.field plot_median = TRUE}) when {.code split.by} is not NULL.") + } + + if (isTRUE(x = plot_boxplot) && is.null(x = split.by)) { + plot <- plot + geom_boxplot(fill='#A4A4A4', color="black", width = 0.1) + } + if (isTRUE(x = plot_boxplot) && !is.null(x = split.by)) { + cli_abort(message = "Cannot add median ({.field plot_boxplot = TRUE}) when {.code split.by} is not NULL.") + } + return(plot) } @@ -817,6 +929,11 @@ Stacked_VlnPlot <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Add check for group.by before getting to colors + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + # Check features and meta to determine which features present all_found_features <- Feature_PreCheck(object = seurat_object, features = features) @@ -826,7 +943,7 @@ Stacked_VlnPlot <- function( } # Set rasterization - num_cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = idents)) + num_cells <- length(x = Cells(x = seurat_object)) if (length(x = num_cells) * length(x = all_found_features) > 100000 && is.null(x = raster) && pt.size != 0) { raster <- TRUE @@ -836,14 +953,18 @@ Stacked_VlnPlot <- function( } # Set default color palette based on number of levels being plotted - if (is.null(x = group.by)) { - group_by_length <- length(x = unique(x = seurat_object@active.ident)) + if (is.null(x = split.by)) { + if (is.null(x = group.by)) { + group_by_length <- length(x = unique(x = seurat_object@active.ident)) + } else { + group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + } } else { - group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + group_by_length <- length(x = unique(x = seurat_object@meta.data[[split.by]])) } # Check colors use vs. ggplot2 color scale - if (!is.null(x = colors_use) && ggplot_default_colors) { + if (!is.null(x = colors_use) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both custom palette to {.code colors_use} and specify {.code ggplot_default_colors = TRUE}.") } if (is.null(x = colors_use)) { @@ -862,12 +983,12 @@ Stacked_VlnPlot <- function( # Add back x-axis title to bottom plot. patchwork is going to support this? # Add ability to rotate the X axis labels to the function call if (isTRUE(x = x_lab_rotate) || x_lab_rotate == 45) { - plot_list[[length(plot_list)]] <- plot_list[[length(plot_list)]] + + plot_list[[length(x = plot_list)]] <- plot_list[[length(x = plot_list)]] + theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1), axis.ticks.x = element_line()) } if (x_lab_rotate == 90) { - plot_list[[length(plot_list)]] <- plot_list[[length(plot_list)]] + + plot_list[[length(x = plot_list)]] <- plot_list[[length(x = plot_list)]] + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1), axis.ticks.x = element_line()) } @@ -875,7 +996,7 @@ Stacked_VlnPlot <- function( cli_abort(message = "{.code x_lab_rotate} must be either a logical or a numeric value of 45 or 90.") } - plot_list[[length(plot_list)]] <- plot_list[[length(plot_list)]] + + plot_list[[length(x = plot_list)]] <- plot_list[[length(x = plot_list)]] + theme(axis.text.x = element_text(), axis.ticks.x = element_line()) # change the y-axis tick to only max value @@ -913,6 +1034,8 @@ Stacked_VlnPlot <- function( #' #' @param seurat_object Seurat object name. #' @param features Features to plot. +#' @param group.by Name of one or more metadata columns to group (color) cells by (for example, orig.ident); +#' default is the current active.ident of the object. #' @param colors_use specify color palette to used. Default is viridis_plasma_dark_high. #' @param remove_axis_titles logical. Whether to remove the x and y axis titles. Default = TRUE. #' @param x_lab_rotate Rotate x-axis labels 45 degrees (Default is FALSE). @@ -941,6 +1064,7 @@ Stacked_VlnPlot <- function( DotPlot_scCustom <- function( seurat_object, features, + group.by = NULL, colors_use = viridis_plasma_dark_high, remove_axis_titles = TRUE, x_lab_rotate = FALSE, @@ -952,6 +1076,11 @@ DotPlot_scCustom <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Add check for group.by before getting to colors + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + # Check features and meta to determine which features present all_found_features <- Feature_PreCheck(object = seurat_object, features = features) @@ -960,21 +1089,21 @@ DotPlot_scCustom <- function( scale_color_gradientn(colors = colors_use) ) # Modify plot - if (remove_axis_titles) { + if (isTRUE(x = remove_axis_titles)) { plot <- plot + theme(axis.title.x = element_blank(), axis.title.y = element_blank() ) } - if (flip_axes) { + if (isTRUE(x = flip_axes)) { plot <- plot & coord_flip() } - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme(axis.text.x = element_text(angle = 45, hjust = 1)) } - if (y_lab_rotate) { + if (isTRUE(x = y_lab_rotate)) { plot <- plot + theme(axis.text.y = element_text(angle = 45, hjust = 1)) } @@ -1055,8 +1184,8 @@ DotPlot_scCustom <- function( #' @importFrom dplyr any_of filter select #' @importFrom grid grid.circle grid.rect gpar #' @importFrom magrittr "%>%" +#' @importFrom rlang is_installed #' @importFrom Seurat DotPlot -#' @importFrom SeuratObject PackageCheck #' @importFrom stats quantile #' @importFrom tidyr pivot_wider #' @@ -1110,8 +1239,8 @@ Clustered_DotPlot <- function( seed = 123 ) { # Check for packages - ComplexHeatmap_check <- PackageCheck("ComplexHeatmap", error = FALSE) - if (!ComplexHeatmap_check[1]) { + ComplexHeatmap_check <- is_installed(pkg = "ComplexHeatmap") + if (isFALSE(x = ComplexHeatmap_check)) { cli_abort(message = c( "Please install the {.val ComplexHeatmap} package to use {.code Clustered_DotPlot}", "i" = "This can be accomplished with the following commands: ", @@ -1123,21 +1252,17 @@ Clustered_DotPlot <- function( } if (lifecycle::is_present(row_km_repeats)) { - lifecycle::deprecate_warn(when = "1.1.0", + lifecycle::deprecate_stop(when = "2.0.0", what = "Clustered_DotPlot(row_km_repeats)", - with = "Clustered_DotPlot(feature_km_repeats)", - details = c("v" = "The parameter will remain functional until next major update.", - "i" = "Please adjust code now to prepare for full deprecation.") + with = "Clustered_DotPlot(feature_km_repeats)" ) feature_km_repeats <- row_km_repeats } if (lifecycle::is_present(column_km_repeats)) { - lifecycle::deprecate_warn(when = "1.1.0", + lifecycle::deprecate_stop(when = "2.0.0", what = "Clustered_DotPlot(column_km_repeats)", - with = "Clustered_DotPlot(ident_km_repeats)", - details = c("v" = "The parameter will remain functional until next major update.", - "i" = "Please adjust code now to prepare for full deprecation.") + with = "Clustered_DotPlot(ident_km_repeats)" ) ident_km_repeats <- column_km_repeats } @@ -1160,7 +1285,7 @@ Clustered_DotPlot <- function( } # Check features and meta to determine which features present - all_found_features <- Feature_PreCheck(object = seurat_object, features = features_unique) + all_found_features <- Feature_PreCheck(object = seurat_object, features = features_unique, assay = assay) # Check exp min/max set correctly if (!exp_color_min < exp_color_max) { @@ -1221,7 +1346,7 @@ Clustered_DotPlot <- function( as.matrix() # print quantiles - if (print_exp_quantiles) { + if (isTRUE(x = print_exp_quantiles)) { cli_inform(message = "Quantiles of gene expression data are:") print(quantile(exp_mat, c(0.1, 0.5, 0.9, 0.99))) } @@ -1237,7 +1362,7 @@ Clustered_DotPlot <- function( } # Check colors use vs. ggplot2 color scale - if (!is.null(x = colors_use_idents) && ggplot_default_colors) { + if (!is.null(x = colors_use_idents) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both custom palette to {.code colors_use} and specify {.code ggplot_default_colors = TRUE}.") } if (is.null(x = colors_use_idents)) { @@ -1261,7 +1386,7 @@ Clustered_DotPlot <- function( identity_colors_list <- list(Identity = identity_colors) # Create identity annotation - if (flip) { + if (isTRUE(x = flip)) { column_ha <- ComplexHeatmap::rowAnnotation(Identity = Identity, col = identity_colors_list, na_col = "grey", @@ -1289,7 +1414,7 @@ Clustered_DotPlot <- function( col_fun = colorRamp2(c(exp_color_min, exp_color_middle, exp_color_max), colors_use_exp[c(1,palette_middle, palette_length)]) # Calculate and plot Elbow - if (plot_km_elbow) { + if (isTRUE(x = plot_km_elbow)) { # if elbow_kmax not NULL check it is usable if (!is.null(x = elbow_kmax) && elbow_kmax > (nrow(x = exp_mat) - 1)) { elbow_kmax <- nrow(x = exp_mat) - 1 @@ -1312,8 +1437,8 @@ Clustered_DotPlot <- function( } # prep heatmap - if (flip) { - if (raster) { + if (isTRUE(x = flip)) { + if (isTRUE(x = raster)) { layer_fun_flip = function(i, j, x, y, w, h, fill) { grid.rect(x = x, y = y, width = w, height = h, gp = gpar(col = NA, fill = NA)) @@ -1329,7 +1454,7 @@ Clustered_DotPlot <- function( } } } else { - if (raster) { + if (isTRUE(x = raster)) { layer_fun = function(j, i, x, y, w, h, fill) { grid.rect(x = x, y = y, width = w, height = h, gp = gpar(col = NA, fill = NA)) @@ -1375,8 +1500,8 @@ Clustered_DotPlot <- function( # Create Plot set.seed(seed = seed) - if (raster) { - if (flip) { + if (isTRUE(x = raster)) { + if (isTRUE(x = flip)) { cluster_dot_plot <- ComplexHeatmap::Heatmap(t(exp_mat), 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, @@ -1412,7 +1537,7 @@ Clustered_DotPlot <- function( cluster_columns = cluster_ident) } } else { - if (flip) { + if (isTRUE(x = flip)) { cluster_dot_plot <- ComplexHeatmap::Heatmap(t(exp_mat), 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, @@ -1450,7 +1575,7 @@ Clustered_DotPlot <- function( } # Add pt.size legend & return plots - if (plot_km_elbow) { + if (isTRUE(x = plot_km_elbow)) { return(list(km_elbow_plot, ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list))) } return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list)) @@ -1474,6 +1599,8 @@ Clustered_DotPlot <- function( #' @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 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 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(). @@ -1508,6 +1635,7 @@ Cluster_Highlight_Plot <- function( background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1520,7 +1648,7 @@ Cluster_Highlight_Plot <- function( Is_Seurat(seurat_object = seurat_object) # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Perform Idents check and report errors when when length(cluster_name) > 1 if (length(x = cluster_name) > 1) { @@ -1539,7 +1667,7 @@ Cluster_Highlight_Plot <- function( # set point size if (is.null(x = pt.size)) { - pt.size <- AutoPointSize_scCustom(data = sum(lengths(cells_to_highlight)), raster = raster) + pt.size <- AutoPointSize_scCustom(data = sum(lengths(x = cells_to_highlight)), raster = raster) } # Set colors @@ -1547,7 +1675,7 @@ Cluster_Highlight_Plot <- function( if (length(x = highlight_color) == 1 && length(x = cluster_name) > 1) { highlight_color <- rep(x = highlight_color, length(x = cluster_name)) cli_inform(message = c("NOTE: Only one color provided to but {.field {length(x = cluster_name)}} clusters were provided.", - "i" = "Using the same color ({.val {highlight_color}}) for all clusters.")) + "i" = "Using the same color ({.val {highlight_color[1]}}) for all clusters.")) } # If NULL set using scCustomize_Palette @@ -1571,7 +1699,7 @@ 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)) + plot <- suppressMessages(plot & scale_color_manual(breaks = names(x = cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) # Aspect ratio changes if (!is.null(x = aspect_ratio)) { @@ -1581,6 +1709,11 @@ Cluster_Highlight_Plot <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + # Figure plot + if (isTRUE(x = figure_plot)) { + plot <- Figure_Plot(plot = plot) + } + return(plot) } @@ -1597,6 +1730,8 @@ Cluster_Highlight_Plot <- function( #' @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 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 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(). @@ -1636,6 +1771,7 @@ Meta_Highlight_Plot <- function( background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1688,7 +1824,7 @@ Meta_Highlight_Plot <- function( } # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Change default ident and pull cells to highlight in plot Idents(object = seurat_object) <- good_meta_data_column @@ -1697,7 +1833,7 @@ Meta_Highlight_Plot <- function( # set point size if (is.null(x = pt.size)) { - pt.size <- AutoPointSize_scCustom(data = sum(lengths(cells_to_highlight)), raster = raster) + pt.size <- AutoPointSize_scCustom(data = sum(lengths(x = cells_to_highlight)), raster = raster) } # Set colors @@ -1705,7 +1841,7 @@ Meta_Highlight_Plot <- function( if (length(x = highlight_color) == 1 && length(x = found_meta_highlight) > 1) { highlight_color <- rep(x = highlight_color, length(x = found_meta_highlight)) cli_inform(message = c("NOTE: Only one color provided to but {length(x = found_meta_highlight) `meta_data_highlight` variables were provided.}", - "i" = "Using the same color ({highlight_color}) for all variables")) + "i" = "Using the same color ({highlight_color[1]}) for all variables")) } # If NULL set using scCustomize_Palette @@ -1729,7 +1865,7 @@ 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)) + plot <- suppressMessages(plot & scale_color_manual(breaks = names(x = cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) # Aspect ratio changes if (!is.null(x = aspect_ratio)) { @@ -1739,6 +1875,11 @@ Meta_Highlight_Plot <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + # Figure plot + if (isTRUE(x = figure_plot)) { + plot <- Figure_Plot(plot = plot) + } + return(plot) } @@ -1754,6 +1895,8 @@ Meta_Highlight_Plot <- function( #' @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 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 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(). @@ -1797,6 +1940,7 @@ Cell_Highlight_Plot <- function( background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -1809,7 +1953,7 @@ Cell_Highlight_Plot <- function( Is_Seurat(seurat_object = seurat_object) if (!inherits(x = cells_highlight, what = "list")) { - cli_abort(message = ".{code cells_highlight} must be of class: {.val list()}.") + cli_abort(message = "{.code cells_highlight} must be of class: {.val list()}.") } if (is.null(x = names(x = cells_highlight))) { @@ -1825,7 +1969,7 @@ Cell_Highlight_Plot <- function( } # Check all cells are present in object - if (!all(unlist(x = cells_highlight) %in% colnames(x = seurat_object))) { + if (!all(unlist(x = cells_highlight) %in% Cells(x = seurat_object))) { cli_abort(message = c("Some of cells in {.code cells_highlight} are not present in object.", "i" = "Ensure all cells are present in object before plotting." ) @@ -1833,7 +1977,7 @@ Cell_Highlight_Plot <- function( } # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # set point size if (is.null(x = pt.size)) { @@ -1842,7 +1986,7 @@ Cell_Highlight_Plot <- function( # Check right number of colors provided # Check colors use vs. ggplot2 color scale - if (!is.null(x = highlight_color) && ggplot_default_colors) { + if (!is.null(x = highlight_color) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both {.code highlight_color} and specify {.code ggplot_default_colors = TRUE}.") } @@ -1873,7 +2017,7 @@ 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)) + plot <- suppressMessages(plot & scale_color_manual(breaks = names(x = cells_highlight), values = c(highlight_color, background_color), na.value = background_color)) # Aspect ratio changes if (!is.null(x = aspect_ratio)) { @@ -1883,6 +2027,11 @@ Cell_Highlight_Plot <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + # Figure plot + if (isTRUE(x = figure_plot)) { + plot <- Figure_Plot(plot = plot) + } + return(plot) } @@ -1979,12 +2128,26 @@ DimPlot_scCustom <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Change label if label.box + if (isTRUE(x = label.box) && is.null(x = label)) { + label <- TRUE + } + if (!is.null(x = split.by)) { split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] } + # Add check for group.by before getting to colors + if (length(x = group.by) > 1) { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } else { + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + } + # Add one time split_seurat warning - if (!is.null(x = split.by) && !split_seurat && getOption(x = 'scCustomize_warn_DimPlot_split_type', default = TRUE)) { + if (!is.null(x = split.by) && isFALSE(x = split_seurat) && getOption(x = 'scCustomize_warn_DimPlot_split_type', default = TRUE)) { cli_inform(c("", "NOTE: {.field DimPlot_scCustom} returns split plots as layout of all plots each", "with their own axes as opposed to Seurat which returns with shared x or y axis.", @@ -1995,7 +2158,7 @@ DimPlot_scCustom <- function( } # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) label <- label %||% (is.null(x = group.by)) @@ -2004,20 +2167,27 @@ DimPlot_scCustom <- function( split_seurat <- TRUE } - # figure_plot check - if (figure_plot && !split_seurat) { - cli_abort(message = "{.code figure_plot} can only be TRUE if {.code split_seurat = FALSE}.") - } + # # figure_plot check + # if (isTRUE(x = figure_plot) && isTRUE(x = split_seurat)) { + # cli_abort(message = "{.code figure_plot} can only be TRUE if {.code split_seurat = FALSE}.") + # } # Set default color palette based on number of levels being plotted - if (is.null(x = group.by)) { - group_by_length <- length(x = unique(x = seurat_object@active.ident)) + if (length(x = group.by) > 1) { + all_length <- lapply(group.by, function(x) { + num_var <- length(x = unique(x = seurat_object@meta.data[[x]])) + }) + group_by_length <- max(unlist(x = all_length)) } else { - group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + if (is.null(x = group.by)) { + group_by_length <- length(x = unique(x = seurat_object@active.ident)) + } else { + group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + } } # Check colors use vs. ggplot2 color scale - if (!is.null(x = colors_use) && ggplot_default_colors) { + if (!is.null(x = colors_use) && isTRUE(x = ggplot_default_colors)) { cli_abort(message = "Cannot provide both custom palette to {.code colors_use} and specify {.code ggplot_default_colors = TRUE}.") } @@ -2042,7 +2212,7 @@ DimPlot_scCustom <- function( # Plot if (is.null(x = split.by)) { plot <- DimPlot(object = seurat_object, cols = colors_use, pt.size = pt.size, reduction = reduction, group.by = group.by, split.by = split.by, shuffle = shuffle, seed = seed, label = label, label.size = label.size, label.color = label.color, repel = repel, raster = raster, raster.dpi = raster.dpi, ncol = num_columns, dims = dims, label.box = label.box, ...) - if (figure_plot) { + if (isTRUE(x = figure_plot)) { # pull axis labels x_lab_reduc <- plot$labels$x @@ -2094,10 +2264,10 @@ DimPlot_scCustom <- function( } } else { - if (split_seurat) { + if (isTRUE(x = split_seurat)) { # Plot Seurat Splitting plot <- DimPlot(object = seurat_object, cols = colors_use, pt.size = pt.size, reduction = reduction, group.by = group.by, split.by = split.by, shuffle = shuffle, seed = seed, label = label, label.size = label.size, label.color = label.color, repel = repel, raster = raster, raster.dpi = raster.dpi, ncol = num_columns, dims = dims, label.box = label.box, ...) - if (figure_plot) { + if (isTRUE(x = figure_plot)) { # pull axis labels x_lab_reduc <- plot$labels$x @@ -2155,7 +2325,7 @@ DimPlot_scCustom <- function( } # Extract reduction coordinates reduction <- reduction %||% DefaultDimReduc(object = seurat_object) - all_cells <- colnames(x = seurat_object) + all_cells <- Cells(x = seurat_object) reduc_coordinates <- Embeddings(object = seurat_object[[reduction]])[all_cells, dims] reduc_coordinates <- as.data.frame(x = reduc_coordinates) x_axis <- c(min(reduc_coordinates[, 1]), @@ -2286,11 +2456,11 @@ DimPlot_All_Samples <- function( } # Add raster check for scCustomize - raster <- raster %||% (length(x = colnames(x = seurat_object)) > 2e5) + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) # Extract reduction coordinates reduction <- reduction %||% DefaultDimReduc(object = seurat_object) - all_cells <- colnames(x = seurat_object) + all_cells <- Cells(x = seurat_object) reduc_coordinates <- Embeddings(object = seurat_object[[reduction]])[all_cells, dims] reduc_coordinates <- as.data.frame(x = reduc_coordinates) x_axis <- c(min(reduc_coordinates[, 1]), @@ -2366,6 +2536,8 @@ DimPlot_All_Samples <- function( #' #' @param seurat_object Seurat object name. #' @param num_features Number of top variable features to highlight by color/label. +#' @param custom_features A vector of custom feature names to label on plot instead of labeling top +#' variable genes. #' @param label logical. Whether to label the top features. Default is TRUE. #' @param pt.size Adjust point size for plotting. #' @param colors_use colors to use for plotting. Default is "black" and "red". @@ -2394,6 +2566,7 @@ DimPlot_All_Samples <- function( VariableFeaturePlot_scCustom <- function( seurat_object, num_features = 10, + custom_features = NULL, label = TRUE, pt.size = 1, colors_use = c("black", "red"), @@ -2409,6 +2582,12 @@ VariableFeaturePlot_scCustom <- function( # set assay (if null set to active assay) assay <- assay %||% DefaultAssay(object = seurat_object) + if (isTRUE(x = Assay5_Check(seurat_object = seurat_object, assay = assay))) { + cli_inform(message = c("!" = "Currently labeling top variable genes from Assay5 object will not correctly label top variable features due to changes in Seurat5.", + "i" = "This feature will be updated when more information comes from Seurat Dev team.", + "i" = "For now the top variable features can be manually extracted and provided to {.code custom_features} parameter.")) + } + # Extract num of desired features top_features <- head(x = VariableFeatures(object = seurat_object, assay = assay, selection.method = selection.method), num_features) @@ -2416,12 +2595,22 @@ VariableFeaturePlot_scCustom <- function( plot <- VariableFeaturePlot(object = seurat_object, pt.size = pt.size, assay = assay, selection.method = selection.method, cols = colors_use, ...) # Label points - if (label) { - plot <- LabelPoints(plot = plot, points = top_features, repel = repel) + if (isFALSE(x = label) && !is.null(x = custom_features)) { + cli_warn(message = "The provided values provided to {.field custom_features} were not labeled as {.code label = FALSE} was also set.") + } + + if (isTRUE(x = label)) { + if (is.null(x = custom_features)) { + plot <- LabelPoints(plot = plot, points = top_features, repel = repel) + } else { + # check all custom features are present + all_found_features <- Feature_PreCheck(object = seurat_object, features = custom_features) + plot <- LabelPoints(plot = plot, points = all_found_features, repel = repel) + } } # return log10 y axis - if (y_axis_log) { + if (isTRUE(x = y_axis_log)) { plot <- plot + scale_y_log10() return(plot) } @@ -2429,3 +2618,181 @@ VariableFeaturePlot_scCustom <- function( # Return plot return(plot) } + + +#' Modified version of FeatureScatter +#' +#' Create customized FeatureScatter plots with scCustomize defaults. +#' +#' @param seurat_object Seurat object name. +#' @param feature1 First feature to plot. +#' @param feature2 Second feature to plot. +#' @param colors_use color for the points on plot. +#' @param pt.size Adjust point size for plotting. +#' @param group.by Name of one or more metadata columns to group (color) cells by (for example, orig.ident). +#' Default is active ident. +#' @param split.by Feature to split plots by (i.e. "orig.ident"). +#' @param split_seurat logical. Whether or not to display split plots like Seurat (shared y axis) or as +#' individual plots in layout. Default is FALSE. +#' @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 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. Does NOT apply if `split_seurat = TRUE`. +#' @param plot.cor Display correlation in plot subtitle (or title if `split_seurat = TRUE`). +#' @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 +#' greater than 200,000 cells. +#' @param raster.dpi Pixel resolution for rasterized plots, passed to geom_scattermore(). +#' Default is c(512, 512). +#' @param ggplot_default_colors logical. If `colors_use = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes. +#' @param color_seed random seed for the "varibow" palette shuffle if `colors_use = NULL` and number of +#' groups plotted is greater than 36. Default = 123. +#' @param ... Extra parameters passed to \code{\link[Seurat]{FeatureScatter}}. +#' +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' @import patchwork +#' @importFrom magrittr "%>%" +#' @importFrom Seurat FeatureScatter +#' +#' @export +#' +#' @concept seurat_plotting +#' +#' @examples +#' \donttest{ +#' library(Seurat) +#' pbmc_small$sample_id <- sample(c("sample1", "sample2"), size = ncol(pbmc_small), replace = TRUE) +#' +#' FeatureScatter_scCustom(seurat_object = pbmc_small, feature1 = "nCount_RNA", +#' feature2 = "nFeature_RNA", split.by = "sample_id") +#'} +#' + +FeatureScatter_scCustom <- function( + seurat_object, + feature1 = NULL, + feature2 = NULL, + colors_use = NULL, + pt.size = NULL, + group.by = NULL, + split.by = NULL, + split_seurat = FALSE, + shuffle = TRUE, + aspect_ratio = NULL, + title_size = 15, + plot.cor = TRUE, + num_columns = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123, + ... +) { + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + if (!is.null(x = split.by)) { + split.by <- Meta_Present(seurat_object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + # Add check for group.by before getting to colors + if (length(x = group.by) > 1) { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } else { + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(seurat_object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + } + + # Add one time split_seurat warning + if (!is.null(x = split.by) && isFALSE(x = split_seurat) && getOption(x = 'scCustomize_warn_FeatureScatter_split_type', default = TRUE)) { + cli_inform(c("", + "NOTE: {.field FeatureScatter_scCustom} returns split plots as layout of all plots each", + "with their own axes as opposed to Seurat which returns with shared x or y axis.", + "To return to Seurat behvaior set {.code split_seurat = TRUE}.", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_FeatureScatter_split_type = FALSE) + } + + # Add raster check for scCustomize + raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) + + # Set default color palette based on number of levels being plotted + if (length(x = group.by) > 1) { + all_length <- lapply(group.by, function(x) { + num_var <- length(x = unique(x = seurat_object@meta.data[[x]])) + }) + group_by_length <- max(unlist(x = all_length)) + } else { + if (is.null(x = group.by)) { + group_by_length <- length(x = unique(x = seurat_object@active.ident)) + } else { + group_by_length <- length(x = unique(x = seurat_object@meta.data[[group.by]])) + } + } + + # set default plot colors + if (is.null(x = colors_use)) { + colors_use <- scCustomize_Palette(num_groups = group_by_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + + # Set uniform point size is pt.size = NULL (based on plot with most cells) + if (is.null(x = pt.size) && !is.null(split.by)) { + # cells per meta data + cells_by_split <- data.frame(table(seurat_object@meta.data[, split.by])) + # Identity with greatest number of cells + max_cells <- max(cells_by_split$Freq) + # modified version of the autopointsize function from Seurat + pt.size <- AutoPointSize_scCustom(data = max_cells, raster = raster) + } + + # set size otherwise + pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) + + # Plot + if (is.null(x = split.by)) { + plot <- FeatureScatter(object = seurat_object, feature1 = feature1, feature2 = feature2, cols = colors_use, pt.size = pt.size, group.by = group.by, split.by = split.by, shuffle = shuffle, plot.cor = plot.cor, raster = raster, raster.dpi = raster.dpi, ncol = num_columns, ...) + + # Change title + plot <- plot + + theme(plot.title = element_text(hjust = 0.5, size = title_size), legend.position = "right") + + ggtitle(paste0(feature1, " vs. ", feature2), subtitle = paste0("Correlation: ", plot$labels$title)) + + + # 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 + return(plot) + } else { + # Plot with Seurat splitting + if (isTRUE(x = split_seurat)) { + plot <- FeatureScatter(object = seurat_object, feature1 = feature1, feature2 = feature2, cols = colors_use, pt.size = pt.size, group.by = group.by, split.by = split.by, shuffle = shuffle, plot.cor = plot.cor, raster = raster, raster.dpi = raster.dpi, 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 <- plot & theme(aspect.ratio = aspect_ratio) + } + + # return plot + return(plot) + } else { + plot <- scCustomze_Split_FeatureScatter(seurat_object = seurat_object, feature1 = feature1, feature2 = feature2, split.by = split.by, group.by = group.by, colors_use = colors_use, pt.size = pt.size, aspect_ratio = aspect_ratio, title_size = title_size, num_columns = num_columns, raster = raster, raster.dpi = raster.dpi, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, ...) + + return(plot) + } + } +} diff --git a/R/Statistics.R b/R/Statistics.R index 8f1a26bee4..262a65e58c 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -68,7 +68,7 @@ Cluster_Stats_All_Samples <- function( percent_per_cluster_2 <- percent_per_cluster_2 %>% pivot_wider(names_from = group_by_var, values_from = .data[["percent"]]) %>% column_to_rownames("cluster") - colnames(percent_per_cluster_2) <- paste(colnames(percent_per_cluster_2), "%", sep = "_") + colnames(x = percent_per_cluster_2) <- paste(colnames(x = percent_per_cluster_2), "%", sep = "_") percent_per_cluster_2 <- percent_per_cluster_2 %>% rownames_to_column(var = "Cluster") @@ -91,7 +91,8 @@ Cluster_Stats_All_Samples <- function( #' @param entire_object logical (default = FALSE). Whether to calculate percent of expressing cells #' across the entire object as opposed to by cluster or by `group_by` variable. #' @param assay Assay to pull feature data from. Default is active assay. -#' @param slot Slot to pull feature data for. Default is "data". +#' @param slot `r lifecycle::badge("deprecated")` soft-deprecated. See `layer` +#' @param layer Which layer to pull expression data from? Default is "data". #' #' @return A data.frame #' @@ -118,12 +119,24 @@ Percent_Expressing <- function( group_by = NULL, split_by = NULL, entire_object = FALSE, - slot = "data", + slot = deprecated(), + layer = "data", assay = NULL ) { # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Check is slot is supplied + if (lifecycle::is_present(slot)) { + lifecycle::deprecate_warn(when = "2.0.0", + what = "slot", + with = "layer", + details = c("v" = "As of Seurat 5.0.0 the {.code slot} parameter is deprecated and replaced with {.code layer}.", + "i" = "Please adjust code now to prepare for full deprecation.") + ) + layer <- slot + } + # set assay (if null set to active assay) assay <- assay %||% DefaultAssay(object = seurat_object) @@ -148,10 +161,10 @@ Percent_Expressing <- function( # Pull Expression Info cells <- unlist(x = CellsByIdentities(object = seurat_object, idents = NULL)) - expression_info <- FetchData(object = seurat_object, vars = features_list, cells = cells, slot = slot) + expression_info <- FetchData(object = seurat_object, vars = features_list, cells = cells, layer = layer) # Add grouping variable - if (entire_object) { + if (isTRUE(x = entire_object)) { expression_info$id <- "All_Cells" } else { expression_info$id <- if (is.null(x = group_by)) { @@ -201,13 +214,14 @@ Percent_Expressing <- function( #' @param seurat_object Seurat object name. #' @param group_by_var Column in meta.data slot to group results by (default = "orig.ident"). #' @param default_var logical. Whether to include the default meta.data variables of: "nCount_RNA", -#' "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo" in addition to variables supplied to `median_var`. +#' "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", and "log10GenesPerUMI" +#' in addition to variables supplied to `median_var`. #' @param median_var Column(s) in `@meta.data` to calculate medians for in addition to defaults. #' Must be of `class()` integer or numeric. #' #' @return A data.frame. #' -#' @importFrom dplyr group_by select summarise any_of across +#' @importFrom dplyr group_by select summarise any_of across all_of #' @importFrom magrittr "%>%" #' @importFrom stats median #' @@ -230,8 +244,8 @@ Median_Stats <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) - if (default_var) { - default_var <- c("nCount_RNA", "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo") + if (isTRUE(x = default_var)) { + default_var <- c("nCount_RNA", "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", "log10GenesPerUMI") } else { default_var <- NULL } @@ -258,11 +272,11 @@ Median_Stats <- function( median_by_group <- meta_data %>% group_by(.data[[group_by_var]]) %>% - summarise(across(all_variables, median)) + summarise(across(all_of(all_variables), median)) # Calculate overall medians median_overall <- meta_data %>% - summarise(across(all_variables, median)) + summarise(across(all_of(all_variables), median)) # Create data.frame with group_by_var as column name meta_col_name_df <- data.frame(col_name = "Totals (All Cells)") @@ -280,6 +294,97 @@ Median_Stats <- function( } +#' Median Absolute Deviation Statistics +#' +#' Get quick values for X x median absolute deviation for Genes, UMIs, %mito per cell grouped by meta.data variable. +#' +#' @param seurat_object Seurat object name. +#' @param group_by_var Column in meta.data slot to group results by (default = "orig.ident"). +#' @param default_var logical. Whether to include the default meta.data variables of: "nCount_RNA", +#' "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", and "log10GenesPerUMI" +#' in addition to variables supplied to `mad_var`. +#' @param mad_var Column(s) in `@meta.data` to calculate medians for in addition to defaults. +#' Must be of `class()` integer or numeric. +#' @param mad_num integer value to multiply the MAD in returned data.frame (default is 2). +#' Often helpful when calculating a outlier range to base of of median + (X*MAD). +#' +#' @return A data.frame. +#' +#' @importFrom dplyr group_by select summarise any_of across all_of +#' @importFrom magrittr "%>%" +#' @importFrom stats mad +#' +#' @export +#' +#' @concept stats +#' +#' @examples +#' \dontrun{ +#' mad_stats <- MAD_Stats(seurat_object = obj, group_by_var = "orig.ident") +#' } +#' + +MAD_Stats <- function( + seurat_object, + group_by_var = "orig.ident", + default_var = TRUE, + mad_var = NULL, + mad_num = 2 +) { + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + if (isTRUE(x = default_var)) { + default_var <- c("nCount_RNA", "nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", "log10GenesPerUMI") + } else { + default_var <- NULL + } + + # Check group variable present + group_by_var <- Meta_Present(seurat_object = seurat_object, meta_col_names = group_by_var, print_msg = FALSE)[[1]] + + # Check stats variables present + all_variables <- c(default_var, mad_var) + + all_variables <- Meta_Present(seurat_object = seurat_object, meta_col_names = all_variables, print_msg = FALSE)[[1]] + + # Filter meta data for columns of interest + meta_numeric_check <- Fetch_Meta(object = seurat_object) %>% + select(any_of(all_variables)) + + all_variables <- Meta_Numeric(data = meta_numeric_check) + + # Create column names for final data frame from valid columns + all_variable_col_names <- c(group_by_var, paste0("MAD x ", mad_num, " ", all_variables)) + + # Calculate medians for each group_by + meta_data <- Fetch_Meta(object = seurat_object) + + mad_by_group <- meta_data %>% + group_by(.data[[group_by_var]]) %>% + summarise(across(all_of(all_variables), mad)) + + # Calculate overall medians + mad_overall <- meta_data %>% + summarise(across(all_of(all_variables), mad)) + + # Create data.frame with group_by_var as column name + meta_col_name_df <- data.frame(col_name = "Totals (All Cells)") + colnames(x = meta_col_name_df) <- group_by_var + # Merge with overall median data.frame + mad_overall <- cbind(meta_col_name_df, mad_overall) + + # Merge by group_by_var and overall median data.frames + mad_all <- rbind(mad_by_group, mad_overall) + + # Rename columns and return data.frame + colnames(x = mad_all) <- all_variable_col_names + + # return data.frame + return(mad_all) +} + + #' CellBender Feature Differences #' #' Get quick values for raw counts, CellBender counts, count differences, and percent count differences @@ -288,6 +393,8 @@ Median_Stats <- function( #' @param seurat_object Seurat object name. #' @param raw_assay Name of the assay containing the raw count data. #' @param cell_bender_assay Name of the assay containing the CellBender count data. +#' @param raw_mat Name of raw count matrix in environment if not using Seurat object. +#' @param cell_bender_mat Name of CellBender count matrix in environment if not using Seurat object. #' #' @return A data.frame containing summed raw counts, CellBender counts, count difference, and #' percent difference in counts. @@ -296,7 +403,7 @@ Median_Stats <- function( #' @importFrom dplyr arrange desc left_join mutate #' @importFrom magrittr "%>%" #' @importFrom Matrix rowSums -#' @importFrom purrr pluck +#' @importFrom SeuratObject Layers JoinLayers LayerData #' @importFrom tibble rownames_to_column column_to_rownames #' #' @export @@ -311,56 +418,120 @@ Median_Stats <- function( #' CellBender_Feature_Diff <- function( - seurat_object, - raw_assay, - cell_bender_assay + seurat_object = NULL, + raw_assay = NULL, + cell_bender_assay = NULL, + raw_mat = NULL, + cell_bender_mat = NULL ) { - # Is Seurat - Is_Seurat(seurat_object = seurat_object) + if (!is.null(x = seurat_object)) { + # Is Seurat + Is_Seurat(seurat_object = seurat_object) - # Check assays present - assays_not_found <- Assay_Present(seurat_object = seurat_object, assay_list = c(raw_assay, cell_bender_assay), print_msg = FALSE, omit_warn = TRUE)[[2]] + # Check assays present + assays_not_found <- Assay_Present(seurat_object = seurat_object, assay_list = c(raw_assay, cell_bender_assay), print_msg = FALSE, omit_warn = TRUE)[[2]] - if (!is.null(x = assays_not_found)) { - stop_quietly() - } + if (!is.null(x = assays_not_found)) { + stop_quietly() + } - # Pull raw counts - raw_counts <- pluck(seurat_object, "assays", raw_assay, "counts") %>% - rowSums() %>% - data.frame() %>% - rownames_to_column("Feature_Names") + # Check layers and join if split + raw_layers_present <- Layers(object = seurat_object, assay = raw_assay, search = 'counts') - colnames(x = raw_counts)[2] <- "Raw_Counts" + if (length(x = raw_layers_present) > 1) { + cli_inform(message = c("Multiple raw count layers present in {.field {raw_assay}} assay.", + "i" = "Plot will join layers.")) + seurat_object <- JoinLayers(object = seurat_object, assay = raw_assay) + } - # Pull Cell Bender Counts - cb_counts <- pluck(seurat_object, "assays", cell_bender_assay, "counts") %>% - rowSums() %>% - data.frame() %>% - rownames_to_column("Feature_Names") + # Check layers and join if split + cb_layers_present <- Layers(object = seurat_object, assay = cell_bender_assay, search = 'counts') + + if (length(x = cb_layers_present) > 1) { + cli_inform(message = c("Multiple raw count layers present in {.field {raw_assay}} assay.", + "i" = "Plot will join layers.")) + seurat_object <- JoinLayers(object = seurat_object, assay = cell_bender_assay) + } + + # Pull raw counts + raw_counts <- LayerData(object = seurat_object, assay = raw_assay, layer = "counts") %>% + rowSums() %>% + data.frame() %>% + rownames_to_column("Feature_Names") + + colnames(x = raw_counts)[2] <- "Raw_Counts" + + # Pull Cell Bender Counts + cb_counts <- LayerData(object = seurat_object, assay = cell_bender_assay, layer = "counts") %>% + rowSums() %>% + data.frame() %>% + rownames_to_column("Feature_Names") + + colnames(x = 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) - # Check features identical - diff_features <- symdiff(x = raw_counts$Feature_Names, y = cb_counts$Feature_Names) + if (length(x = diff_features > 0)) { + cli_warn(message = c("The following features are not present in both assays:", + "*" = "{.field {diff_features}}", + "i" = "Check matrices used to create object.") + ) + } + + # merge + merged_counts <- suppressMessages(left_join(x = raw_counts, y = cb_counts)) + + # Add diff and % diff + merged_counts <- merged_counts %>% + mutate(Count_Diff = .data[["Raw_Counts"]] - .data[["CellBender_Counts"]], + Pct_Diff = 100 - ((.data[["CellBender_Counts"]] / .data[["Raw_Counts"]]) * 100)) %>% + arrange(desc(.data[["Pct_Diff"]])) %>% + column_to_rownames("Feature_Names") - if (length(x = diff_features > 0)) { - cli_warn(message = c("The following features are not present in both assays:", - "*" = "{.field {diff_features}}", - "i" = "Check matrices used to create object.") - ) + # return data + return(merged_counts) } - # merge - merged_counts <- suppressMessages(left_join(x = raw_counts, y = cb_counts)) + # Matrix Version (Need to update warnings and checks here) + if (!is.null(x = raw_mat) && !is.null(x = cell_bender_mat)) { + # Pull raw counts + raw_counts <- raw_mat %>% + rowSums() %>% + data.frame() %>% + rownames_to_column("Feature_Names") + + colnames(x = raw_counts)[2] <- "Raw_Counts" + + # Pull Cell Bender Counts + cb_counts <- cell_bender_mat %>% + rowSums() %>% + data.frame() %>% + rownames_to_column("Feature_Names") + + colnames(x = cb_counts)[2] <- "CellBender_Counts" - # Add diff and % diff - merged_counts <- merged_counts %>% - mutate(Count_Diff = .data[["Raw_Counts"]] - .data[["CellBender_Counts"]], - Pct_Diff = 100 - ((.data[["CellBender_Counts"]] / .data[["Raw_Counts"]]) * 100)) %>% - arrange(desc(.data[["Pct_Diff"]])) %>% - column_to_rownames("Feature_Names") + # Check features identical + diff_features <- symdiff(x = raw_counts$Feature_Names, y = cb_counts$Feature_Names) - # return data - return(merged_counts) + if (length(x = diff_features > 0)) { + cli_warn(message = c("The following features are not present in both assays:", + "*" = "{.field {diff_features}}", + "i" = "Check matrices used to create object.") + ) + } + + # merge + merged_counts <- suppressMessages(left_join(x = raw_counts, y = cb_counts)) + + # Add diff and % diff + merged_counts <- merged_counts %>% + mutate(Count_Diff = .data[["Raw_Counts"]] - .data[["CellBender_Counts"]], + Pct_Diff = 100 - ((.data[["CellBender_Counts"]] / .data[["Raw_Counts"]]) * 100)) %>% + arrange(desc(.data[["Pct_Diff"]])) %>% + column_to_rownames("Feature_Names") + + # return data + return(merged_counts) + } } diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index ed25359483..bb88781bb5 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -119,7 +119,7 @@ Plot_Median_Genes <- function( } # Modify base plot - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } @@ -257,7 +257,7 @@ Plot_Median_UMIs <- function( } # Modify base plot - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } @@ -396,7 +396,7 @@ Plot_Median_Mito <- function( } # Modify base plot - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } @@ -550,7 +550,7 @@ Plot_Median_Other <- function( } # Modify base plot - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } @@ -670,7 +670,7 @@ Plot_Cells_per_Sample <- function( xlab("") # Modify base plot - if (x_lab_rotate) { + if (isTRUE(x = x_lab_rotate)) { plot <- plot + theme_ggprism_mod(axis_text_angle = 45) } @@ -699,6 +699,8 @@ Plot_Cells_per_Sample <- function( #' @param label logical, whether or not to label the features that have largest percent difference #' between raw and CellBender counts (Default is TRUE). #' @param num_labels Number of features to label if `label = TRUE`, (default is 20). +#' @param min_count_label Minimum number of raw counts per feature necessary to be included in +#' plot labels (default is 1) #' @param repel logical, whether to use geom_text_repel to create a nicely-repelled labels; this is #' slow when a lot of points are being plotted. If using repel, set xnudge and ynudge to 0, (Default is TRUE). #' @param custom_labels A custom set of features to label instead of the features most different between @@ -749,6 +751,7 @@ CellBender_Diff_Plot <- function( num_features = NULL, label = TRUE, num_labels = 20, + min_count_label = 1, repel = TRUE, custom_labels = NULL, plot_line = TRUE, @@ -767,9 +770,9 @@ CellBender_Diff_Plot <- function( ) { # Remove unshared features feature_diff_df_filtered <- feature_diff_df %>% - drop_na(.data[["Raw_Counts"]], .data[["CellBender_Counts"]]) + drop_na(all_of(c("Raw_Counts", "CellBender_Counts"))) - diff_features <- symdiff(x = rownames(feature_diff_df), y = rownames(feature_diff_df_filtered)) + diff_features <- symdiff(x = rownames(x = feature_diff_df), y = rownames(x = feature_diff_df_filtered)) if (length(x = diff_features > 0)) { cli_warn(message = c("The following features are not present in both assays and were omitted:", @@ -813,9 +816,23 @@ CellBender_Diff_Plot <- function( } # Label points - if (label) { + if (isTRUE(x = label)) { if (is.null(x = custom_labels)) { - plot <- LabelPoints(plot = plot, points = rownames(x = feature_diff_df_filtered)[1:num_labels], repel = repel, xnudge = xnudge, ynudge = ynudge, max.overlaps = max.overlaps, color = label_color, fontface = fontface, size = label_size, bg.color = bg.color, bg.r = bg.r, ...) + # Subset the labels based on min count threshold + labels_use <- feature_diff_df_filtered %>% + filter(.data[["Raw_Counts"]] >= min_count_label) %>% + rownames() + + # Return message of features not found + if (length(x = labels_use) == 0) { + cli_warn(message = c("No features met the labeling criteria.", + "i" = "Try adjusting {.field min_count_label} and/or {.field pct_diff_threshold}.") + ) + + plot <- plot + } else { + plot <- LabelPoints(plot = plot, points = labels_use[1:num_labels], repel = repel, xnudge = xnudge, ynudge = ynudge, max.overlaps = max.overlaps, color = label_color, fontface = fontface, size = label_size, bg.color = bg.color, bg.r = bg.r, ...) + } } else { # check for features features_list <- Gene_Present(data = feature_diff_df_filtered, gene_list = custom_labels, omit_warn = FALSE, print_msg = FALSE, case_check_msg = FALSE, return_none = TRUE) @@ -845,7 +862,7 @@ CellBender_Diff_Plot <- function( } } - if (plot_line) { + if (isTRUE(x = plot_line)) { plot <- plot + geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "red") } diff --git a/R/Utilities.R b/R/Utilities.R index 53f11dbd13..d2a92905ed 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1,5 +1,5 @@ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### HELPERS #################### +#################### OBJECT HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Check if genes/features are present @@ -22,7 +22,9 @@ #' @param seurat_assay Name of assay to pull feature names from if `data` is Seurat Object. #' Defaults to `DefaultAssay(OBJ)` if NULL. #' +#' @import cli #' @importFrom purrr reduce +#' @importFrom SeuratObject Features #' @importFrom stringr str_to_upper str_to_sentence #' #' @return A list of length 3 containing 1) found features, 2) not found features, 3) features found if @@ -56,7 +58,7 @@ Gene_Present <- function( # set assay (if null set to active assay) assay <- seurat_assay %||% DefaultAssay(object = data) - possible_features <- rownames(x = GetAssayData(object = data, assay = assay)) + possible_features <- Features(x = data, assay = seurat_assay) } else if ((class(x = data)[[1]] == "liger")) { # get complete gene list length_liger <- length(x = data@raw.data) @@ -81,7 +83,7 @@ Gene_Present <- function( bad_features <- gene_list[!gene_list %in% possible_features] found_features <- gene_list[gene_list %in% possible_features] if (length(x = found_features) == 0) { - if (return_none) { + if (isTRUE(x = return_none)) { # Combine into list and return feature_list <- list( found_features = NULL, @@ -95,14 +97,14 @@ Gene_Present <- function( } # Return message of features not found - if (length(x = bad_features) > 0 && omit_warn) { + if (length(x = bad_features) > 0 && isTRUE(x = 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)}}") ) } # Check if features found if case is changed. - if (case_check) { + if (isTRUE(x = case_check)) { upper_bad_features <- str_to_upper(string = bad_features) upper_found_features <- upper_bad_features[upper_bad_features %in% possible_features] @@ -114,7 +116,7 @@ Gene_Present <- function( # Additional messages if found. if (length(x = wrong_case_found_features) > 0) { - if (case_check_msg) { + if (isTRUE(x = case_check_msg)) { cli_warn(message = c("NOTE: However, the following features were found: {.field {glue_collapse_scCustom(input_string = wrong_case_found_features, and = TRUE)}}", "i" = "Please check intended case of features provided.") ) @@ -138,7 +140,7 @@ Gene_Present <- function( } # Print all found message if TRUE - if (print_msg) { + if (isTRUE(x = print_msg)) { cli_inform(message = "All features present.") } @@ -162,9 +164,15 @@ Gene_Present <- function( #' @param case_check_msg logical. Whether to print message to console if alternate case features are #' found in addition to inclusion in returned list. Default is TRUE. #' @param return_features logical. Whether to return vector of alternate case features. Default is TRUE. +#' @param assay Name of assay to pull feature names from. If NULL will use the result of `DefaultAssay(seurat_object)`. +#' +#' @import cli +#' @importFrom SeuratObject Features +#' @importFrom stringr str_to_sentence str_to_upper #' #' @return If features found returns vector of found alternate case features and prints message depending on #' parameters specified. +#' #' @export #' #' @concept helper_util @@ -179,10 +187,14 @@ Case_Check <- function( seurat_object, gene_list, case_check_msg = TRUE, - return_features = TRUE + return_features = TRUE, + assay = NULL ) { + # set assay (if null set to active assay) + assay <- assay %||% DefaultAssay(object = seurat_object) + # get all features - possible_features <- rownames(x = GetAssayData(object = seurat_object)) + possible_features <- Features(x = seurat_object, assay = assay) upper_bad_features <- str_to_upper(string = gene_list) upper_found_features <- upper_bad_features[upper_bad_features %in% possible_features] @@ -195,12 +207,12 @@ Case_Check <- function( # Additional messages if found. if (length(x = wrong_case_found_features) > 0) { - if (case_check_msg) { + if (isTRUE(x = case_check_msg)) { cli_inform(message = c("{col_cyan('*NOTE*')}: However, the following features were found: {.field {glue_collapse_scCustom(input_string = wrong_case_found_features, and = TRUE)}}", "i" = "Please check intended case of features provided.") ) } - if (return_features) { + if (isTRUE(x = return_features)) { return(wrong_case_found_features) } } @@ -251,7 +263,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 (!return_none) { + if (isFALSE(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)}}") @@ -260,7 +272,7 @@ Meta_Present <- function( } # Return message of features not found - if (length(x = bad_meta) > 0 && omit_warn) { + if (length(x = bad_meta) > 0 && isTRUE(x = omit_warn)) { cli_warn(message = c("The following @meta.data columns were omitted as they were not found:", "i" = "{.field {glue_collapse_scCustom(input_string = bad_meta, and = TRUE)}}") ) @@ -276,7 +288,7 @@ Meta_Present <- function( } # Print all found message if TRUE - if (print_msg) { + if (isTRUE(x = print_msg)) { cli_inform(message = "All @meta.data columns present.") } @@ -382,7 +394,7 @@ Reduction_Loading_Present <- function( ) { # If no reductions are present if (length(x = seurat_object@reductions) == 0) { - if (return_none) { + if (isTRUE(x = return_none)) { # Combine into list and return feature_list <- list( found_features = NULL, @@ -390,12 +402,12 @@ Reduction_Loading_Present <- function( ) return(feature_list) } else { - cli_abort(message ="No requested features found.") + cli_abort(message ="No reductions present in object.") } } # Get all reduction names - possible_reduction_names <- unlist(x = lapply(1:length(seurat_object@reductions), function(z) { + possible_reduction_names <- unlist(x = lapply(1:length(x = seurat_object@reductions), function(z) { names <- names(x = seurat_object@reductions[[z]]) }) ) @@ -405,7 +417,7 @@ Reduction_Loading_Present <- function( 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) { + if (isTRUE(x = return_none)) { # Combine into list and return feature_list <- list( found_features = NULL, @@ -418,7 +430,7 @@ Reduction_Loading_Present <- function( } # Return message of features not found - if (length(x = bad_features) > 0 && omit_warn) { + if (length(x = bad_features) > 0 && isTRUE(x = 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)}}") ) @@ -433,7 +445,7 @@ Reduction_Loading_Present <- function( } # Print all found message if TRUE - if (print_msg) { + if (isTRUE(x = print_msg)) { cli_inform(message = "All features present.") } @@ -561,7 +573,7 @@ Merge_Sparse_Data_All <- function( duplicated() %>% any() - if (duplicated_barcodes && is.null(x = add_cell_ids)) { + if (isTRUE(x = duplicated_barcodes) && is.null(x = add_cell_ids)) { cli_abort(message = c("There are overlapping cell barcodes present in the input matrices.", "i" = "Please provide prefixes/suffixes to {.code add_cell_ids} parameter to make unique.") ) @@ -579,14 +591,14 @@ Merge_Sparse_Data_All <- function( }) new_names <- lapply(X = 1:length(x = matrix_list), function(x){ - colnames(x = 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(x = matrix_list[[x]])) }) are_duplicates <- unlist(x = new_names) %>% duplicated() %>% any() - if (are_duplicates) { + if (isTRUE(x = are_duplicates)) { cli_abort(message = c("Supplied {.code add_cell_ids} will result in overlapping barcodes names if provided cell prefixes/suffixes are not unique.", "i" = "Please change and re-run.") ) @@ -610,10 +622,10 @@ Merge_Sparse_Data_All <- function( # Update full cell names if (!is.null(x = add_cell_ids)) { - if (prefix) { - cellnames <- paste0(add_cell_ids [i], cell_id_delimiter, colnames(curr)) + if (isTRUE(x = prefix)) { + cellnames <- paste0(add_cell_ids [i], cell_id_delimiter, colnames(x = curr)) } else { - cellnames <- paste0(colnames(curr), cell_id_delimiter, add_cell_ids [i]) + cellnames <- paste0(colnames(x = curr), cell_id_delimiter, add_cell_ids [i]) } } else { cellnames <- colnames(x = curr) @@ -694,7 +706,7 @@ Extract_Modality <- function( return(modality_list) }) - names(split_list) <- modality_names + names(x = split_list) <- modality_names return(split_list) } @@ -816,87 +828,6 @@ CheckMatrix_scCustom <- function( } -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### OBJECT UTILS #################### -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -#' Merge a list of Seurat Objects -#' -#' Enables easy merge of a list of Seurat Objects. See See \code{\link[SeuratObject]{merge}} for more information, -#' -#' @param list_seurat list composed of multiple Seurat Objects. -#' @param add.cell.ids A character vector of equal length to the number of objects in `list_seurat`. -#' Appends the corresponding values to the start of each objects' cell names. See \code{\link[SeuratObject]{merge}}. -#' @param merge.data Merge the data slots instead of just merging the counts (which requires renormalization). -#' This is recommended if the same normalization approach was applied to all objects. -#' See \code{\link[SeuratObject]{merge}}. -#' @param project Project name for the Seurat object. See \code{\link[SeuratObject]{merge}}. -#' -#' @import cli -#' @importFrom purrr reduce -#' -#' @return A Seurat Object -#' -#' @export -#' -#' @concept object_util -#' -#' @examples -#' \dontrun{ -#' object_list <- list(obj1, obj2, obj3, ...) -#' merged_object <- Merge_Seurat_List(list_seurat = object_list) -#' } -#' - -Merge_Seurat_List <- function( - list_seurat, - add.cell.ids = NULL, - merge.data = TRUE, - project = "SeuratProject" -) { - # Check list_seurat is list - if (!inherits(x = list_seurat, what = "list")) { - cli_abort(message = "{.code list_seurat} must be environmental variable of class {.val list}") - } - - # Check list_seurat is only composed of Seurat objects - for (i in 1:length(x = list_seurat)) { - if (!inherits(x = list_seurat[[i]], what = "Seurat")) { - cli_abort("One or more of entries in {.code list_seurat} are not objects of class {.val Seurat}") - } - } - - # Check all barcodes are unique to begin with - duplicated_barcodes <- list_seurat %>% - lapply(colnames) %>% - unlist() %>% - duplicated() %>% - any() - - if (duplicated_barcodes && is.null(x = add.cell.ids)) { - cli_abort(message = c("There are overlapping cell barcodes present in the input objects", - "i" = "Please rename cells or provide prefixes to {.code add.cell.ids} parameter to make unique.") - ) - } - - # Check right number of suffix/prefix ids are provided - if (!is.null(x = add.cell.ids) && length(x = add.cell.ids) != length(x = list_seurat)) { - cli_abort(message = "The number of prefixes in {.code add.cell.ids} must be equal to the number of objects supplied to {.code list_seurat}.") - } - - # Rename cells if provided - list_seurat <- lapply(1:length(x = list_seurat), function(x) { - list_seurat[[x]] <- RenameCells(object = list_seurat[[x]], add.cell.id = add.cell.ids[x]) - }) - - # Merge objects - merged_object <- reduce(list_seurat, function(x, y) { - merge(x = x, y = y, merge.data = merge.data, project = project) - }) -} - - #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### BARCODE UTILS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -961,7 +892,7 @@ Replace_Suffix <- function( } # Is current suffix found in all cell names - check_suffixes <- sapply(1:length(data), FUN = function(j){ + check_suffixes <- sapply(1:length(x = data), FUN = function(j){ all(grepl(pattern = current_suffix_regexp[[j]], x = current_cell_names[[j]])) }) @@ -1040,7 +971,7 @@ Change_Delim_Suffix <- function( }) # Is current suffix delim found in all cell names - check_suffix_delim <- sapply(1:length(data), FUN = function(j){ + check_suffix_delim <- sapply(1:length(x = data), FUN = function(j){ all(grepl(pattern = current_delim, x = current_cell_names[[j]], fixed = TRUE)) }) @@ -1118,7 +1049,7 @@ Change_Delim_Prefix <- function( }) # Is current prefix delim found in all cell names - check_prefix_delim <- sapply(1:length(data), FUN = function(j){ + check_prefix_delim <- sapply(1:length(x = data), FUN = function(j){ all(grepl(pattern = current_delim, x = current_cell_names[[j]], fixed = TRUE)) }) @@ -1194,7 +1125,7 @@ Change_Delim_All <- function( }) # Is current prefix delim found in all cell names - check_prefix_delim <- sapply(1:length(data), FUN = function(j){ + check_prefix_delim <- sapply(1:length(x = data), FUN = function(j){ all(grepl(pattern = current_delim, x = current_cell_names[[j]], fixed = TRUE)) }) @@ -1283,7 +1214,7 @@ Add_Pct_Diff <- function( # Check if percent difference exists already if ("pct_diff" %in% colnames(marker_dataframe)) { df_name <- deparse(expr = substitute(expr = marker_dataframe)) - if (!overwrite) { + if (isFALSE(x = overwrite)) { cli_abort(message = c("{.val pct_diff} column already present in {.code marker_dataframe}: {.val {df_name}}.", "i" = "To overwrite previous results set `overwrite = TRUE`.") ) @@ -1364,7 +1295,7 @@ Extract_Top_Markers <- function( } # Check gene column is present - if (!gene_column %in% colnames(x = marker_dataframe) && !gene_rownames_to_column) { + if (!gene_column %in% colnames(x = marker_dataframe) && isFALSE(x = gene_rownames_to_column)) { cli_abort(message = c("{.code gene_column}: '{gene_column}' not found in column names of {.code marker_dataframe}.", "i" = "Set {.code gene_rownames_to_column} to move genes from rownames to column.") ) @@ -1385,13 +1316,13 @@ Extract_Top_Markers <- function( column_to_rownames("rownames") } - if (gene_rownames_to_column) { + if (isTRUE(x = gene_rownames_to_column)) { filtered_markers <- filtered_markers %>% rownames_to_column(gene_column) } # return data.frame - if (data_frame) { + if (isTRUE(x = data_frame)) { return(filtered_markers) } @@ -1400,22 +1331,22 @@ Extract_Top_Markers <- function( # should gene list be named # check naming - if (named_vector && is.null(x = group_by)) { + if (isTRUE(x = named_vector) && is.null(x = group_by)) { cli_warn(message = c("Cannot return named vector if {.code group_by} is NULL.", "i" = "Returning unnamed vector.") ) } - if (named_vector && !is.null(x = group_by)) { - if (make_unique) { + if (isTRUE(x = named_vector) && !is.null(x = group_by)) { + if (isTRUE(x = make_unique)) { cli_abort(message = "Cannot return unique list if {.code named_vector = TRUE}.") } - names(gene_list) <- filtered_markers[[group_by]] + names(x = gene_list) <- filtered_markers[[group_by]] return(gene_list) } # make unique - if (make_unique) { + if (isTRUE(x = make_unique)) { gene_list <- unique(x = gene_list) } @@ -1589,12 +1520,12 @@ Pull_Cluster_Annotation <- function( # Create list elements per cluster cell_type_list <- unique(x = annotation_table[[cell_type_col]]) - cluster_annotation_list <- lapply(c(1:length(cell_type_list)), function(x){ + cluster_annotation_list <- lapply(c(1:length(x = cell_type_list)), function(x){ cluster <- annotation_table %>% filter(.data[[cell_type_col]] == cell_type_list[x]) %>% pull(cluster_name_col) }) - names(cluster_annotation_list) <- cell_type_list + names(x = cluster_annotation_list) <- cell_type_list # Create list elements for renaming idents new_cluster_ids <- annotation_table %>% @@ -1605,7 +1536,7 @@ Pull_Cluster_Annotation <- function( secondary_ids_list <- list(secondary_ids) # Name the new cluster ids list names(x = new_cluster_ids_list) <- "new_cluster_idents" - names(x = secondary_ids_list) <- colnames(annotation_table)[[3]] + names(x = secondary_ids_list) <- colnames(x = 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) @@ -1651,7 +1582,7 @@ Rename_Clusters <- function( # Check equivalent lengths if (length(x = new_idents) != length(x = levels(x = seurat_object))) { cli_abort(message = c("Length of {.code new_idents} must be equal to the number of active.idents in Seurat Object.", - "i" = "{.code new_idents} length: {.field {length(x = new_idents)}} Object@active.idents length: {.field {length(levels(x = seurat_object))}}.") + "i" = "{.code new_idents} length: {.field {length(x = new_idents)}} Object@active.idents length: {.field {length(x = levels(x = seurat_object))}}.") ) } @@ -1662,7 +1593,7 @@ Rename_Clusters <- function( # 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))) { cli_abort(message = c("The number of unique names for {.code new idents} is not equal to number of active.idents.", - "i" = "names(new_idents) length: {.field {length(x = unique(x = names(x = new_idents)))} Object@active.idents length: {length(levels(x = seurat_object))}}.") + "i" = "names(new_idents) length: {.field {length(x = unique(x = names(x = new_idents)))} Object@active.idents length: {length(x = levels(x = seurat_object))}}.") ) } diff --git a/R/sysdata.rda b/R/sysdata.rda index 215f02ca6e..b27a976d02 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/zzz.R b/R/zzz.R index 737fae9aee..5b7a0d1da7 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -18,6 +18,9 @@ #' \item{\code{scCustomize_warn_DimPlot_split_type}}{Show message about \code{\link{DimPlot_scCustom}} #' parameter `split.by` and `split_seurat` to alert user to difference in returned plots between #' scCustomize and Seurat.} +#' \item{\code{scCustomize_warn_FeatureScatter_split_type}}{Show message about \code{\link{FeatureScatter_scCustom}} +#' parameter `split.by` and `split_seurat` to alert user to difference in returned plots between +#' scCustomize and Seurat.} #' \item{\code{scCustomize_warn_LIGER_dim_labels_plotFactors}}{Show message about \code{\link{plotFactors_scCustom}} #' parameter `reduction_label` as LIGER objects do not store dimensionality reduction name and #' and therefore needs to be set manually.} @@ -41,7 +44,8 @@ scCustomize_default_options <- list( scCustomize_warn_vln_raster_iterative = TRUE, scCustomize_warn_LIGER_dim_labels = TRUE, scCustomize_warn_LIGER_dim_labels_plotFactors = TRUE, - scCustomize_warn_DimPlot_split_type = TRUE + scCustomize_warn_DimPlot_split_type = TRUE, + scCustomize_warn_FeatureScatter_split_type = TRUE ) diff --git a/cran-comments.md b/cran-comments.md index 8b4edf7166..e461b8f7ce 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,9 @@ ## Minor Version Update -This is a hotfix minor update from v1.1.2 to v1.1.3. In this version I have: +This is a major version update to v2.0.0. In this version I have: -- Fixed parameter documentation in function help/manual that slipped through release (see News.md). I'm sorry this was missed in submission yesterday. Parameter input changed substantially in v1.1.2 and therefore accurate documentation is required with hotfix instead of waiting until next release. +- Added a number of new functions, added new function parameters, and fixed bugs (see News.md). +- Ensured compatibility with major version of Seurat package. +- Fixed in example code causing current CRAN check errors with current package version (v1.1.3). ## R CMD check results @@ -9,7 +11,7 @@ This is a hotfix minor update from v1.1.2 to v1.1.3. In this version I have: 0 errors | 0 warnings | 1 notes ### Test environments -- Run locally, R4.1.2, Platform: x86_64-apple-darwin17.0 (64-bit) with `devtools:check()`. +- Run locally, R4.3.1, Platform: x86_64-apple-darwin17.0 (64-bit) with `devtools:check()`. - Also run via GitHub Actions via `usethis::use_github_action_check_standard` - macos-latest (release), windows-latest (release), ubuntu-latest (devel), ubuntu-latest (release), ubuntu-latest (oldrel-1). @@ -20,4 +22,9 @@ This is a hotfix minor update from v1.1.2 to v1.1.3. In this version I have: use conditionally. - I have worked to move/remove as many IMPORTS to SUGGESTS as possible. This package aims to simplify a number of different visualizations/code tasks in scRNA-seq analysis and as such does have diverse array of dependencies. I will monitor - to ensure package functionality. + to ensure package functionality. +2. Suggests or Enhances not in mainstream repositories: + rliger + - I hope this issue to be fixed soon as the maintainers have assigned team member to fix issue + (https://github.com/welch-lab/liger/issues/293). However, in the interim this loss will not effect package global package + functionality. Those looking for rliger functionality can still easily download versions from CRAN archive and GitHub. diff --git a/data/ieg_gene_list.rda b/data/ieg_gene_list.rda new file mode 100644 index 0000000000..76b4f7025f Binary files /dev/null and b/data/ieg_gene_list.rda differ diff --git a/data/msigdb_qc_gene_list.rda b/data/msigdb_qc_gene_list.rda new file mode 100644 index 0000000000..0f1718201a Binary files /dev/null and b/data/msigdb_qc_gene_list.rda differ diff --git a/docs/404.html b/docs/404.html index b65dbfdbab..88ade6edaa 100644 --- a/docs/404.html +++ b/docs/404.html @@ -32,7 +32,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/LICENSE.html b/docs/LICENSE.html index 04a68c5fb8..417168d373 100644 --- a/docs/LICENSE.html +++ b/docs/LICENSE.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/articles/Cell_Bender_Functions.html b/docs/articles/Cell_Bender_Functions.html index b7789d33f7..91f4535750 100644 --- a/docs/articles/Cell_Bender_Functions.html +++ b/docs/articles/Cell_Bender_Functions.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -130,7 +130,8 @@
@@ -491,7 +502,7 @@

Stacked Violin Plots# Create Plots Stacked_VlnPlot(seurat_object = marsh_human_pm, features = gene_list_plot, x_lab_rotate = TRUE, colors_use = human_colors_list)

-

+

Stacked_VlnPlot also supports any additional parameters @@ -505,7 +516,7 @@
Stacked_VlnPlot(seurat_object = marsh_human_pm, features = gene_list_plot, x_lab_rotate = TRUE, colors_use = sample_colors, split.by = "orig.ident")
-*Example plot adding the `split.by` parameter to view expression by sample and cell type.*

+*Example plot adding the `split.by` parameter to view expression by sample and cell type.*

Example plot adding the split.by parameter to view expression by sample and cell type.

@@ -525,7 +536,7 @@
Adjust Vertical Plot Spacing# Double the space between plots Stacked_VlnPlot(seurat_object = pbmc, features = c("CD3E", "CD14", "MS4A1", "FCER1A", "PPBP"), x_lab_rotate = TRUE, plot_spacing = 0.3)
-

+

Adjusting Plot Size @@ -542,7 +553,7 @@
 Stacked_VlnPlot(seurat_object = marsh_human_pm, features = c("percent_mito", "percent_ribo"), x_lab_rotate = TRUE,
     colors_use = human_colors_list)
-

+

Point Size and Rasterization @@ -571,7 +582,7 @@
VlnPlot(object = pbmc, features = "PTPRC") VlnPlot_scCustom(seurat_object = pbmc, features = "PTPRC")
-***A.** Default `VlnPlot` with ggplot2 default color scheme.  **B.** `VlnPlot_scCustom` shares color palette choice with other scCustomize functions.*

+***A.** Default `VlnPlot` with ggplot2 default color scheme.  **B.** `VlnPlot_scCustom` shares color palette choice with other scCustomize functions.*

A. Default VlnPlot with ggplot2 default color scheme. B. VlnPlot_scCustom shares color palette choice with other scCustomize functions. @@ -593,12 +604,28 @@

Support for RasterizationVlnPlot_scCustom(seurat_object = pbmc, features = "PTPRC", raster = FALSE) VlnPlot_scCustom(seurat_object = pbmc, features = "PTPRC", raster = TRUE)
-***A.** `raster = FALSE`.  **B.** `raster = TRUE`.*

+***A.** `raster = FALSE`.  **B.** `raster = TRUE`.*

A. raster = FALSE. B. raster = TRUE.

+
+
Further customization +
+

scCustomize VlnPlot_scCustom can be further customized +to display the median value for each idenity or add boxplot on top of +the violin.

+
+VlnPlot_scCustom(seurat_object = pbmc, features = "PTPRC", plot_median = TRUE) & NoLegend()
+VlnPlot_scCustom(seurat_object = pbmc, features = "PTPRC", plot_boxplot = TRUE) & NoLegend()
+
+***A.** Add median value to plot.  **B.** Add boxplot on top of plot.*

+A. Add median value to plot. B. +Add boxplot on top of plot. +

+
+

Custom DotPlots @@ -610,14 +637,14 @@

DotPlot_scCustom() allows for plotting with custom gradients.
-
+
 micro_genes <- c("P2ry12", "Fcrls", "Trem2", "Tmem119", "Cx3cr1", "Hexb", "Tgfbr1", "Sparc", "P2ry13",
     "Olfml3", "Adgrg1", "C1qa", "C1qb", "C1qc", "Csf1r", "Fcgr3", "Ly86", "Laptm5")
 
 DotPlot(object = marsh_mouse_micro, features = micro_genes[1:6], cols = viridis_plasma_dark_high)
 DotPlot_scCustom(seurat_object = marsh_mouse_micro, features = micro_genes[1:6], colors_use = viridis_plasma_dark_high)
-***A.** Default `DotPlot` only takes the first few colors when a gradient is provided.  **B.** `DotPlot_scCustom` allows for use of gradients in full while maintaining visualization.*

+***A.** Default `DotPlot` only takes the first few colors when a gradient is provided.  **B.** `DotPlot_scCustom` allows for use of gradients in full while maintaining visualization.*

A. Default DotPlot only takes the first few colors when a gradient is provided. B. DotPlot_scCustom allows for use of gradients in full while @@ -644,7 +671,7 @@

+
 DotPlot_scCustom(seurat_object = marsh_mouse_micro, features = micro_genes[1:6], x_lab_rotate = TRUE)
 DotPlot_scCustom(seurat_object = marsh_mouse_micro, features = micro_genes[1:6], y_lab_rotate = TRUE)
 DotPlot_scCustom(seurat_object = marsh_mouse_micro, features = micro_genes[1:6], flip_axes = T,
@@ -652,7 +679,7 @@ 
DotPlot_scCustom(seurat_object = marsh_mouse_micro, features = micro_genes[1:6], flip_axes = T, remove_axis_titles = FALSE)
-***A.** Rotate x-axis text, **B.** Rotate y-axis text, **C.** flip axes and rotate x-axis text, and **D.** Add axis labels (removed by default).*

+***A.** Rotate x-axis text, **B.** Rotate y-axis text, **C.** flip axes and rotate x-axis text, and **D.** Add axis labels (removed by default).*

A. Rotate x-axis text, B. Rotate y-axis text, C. flip axes and rotate x-axis text, and D. Add axis labels (removed by default). @@ -670,23 +697,26 @@

Clustered DotPlotsposted on his blog. Function is included with permission, authorship, and assistance.

-
-all_markers <- FindAllMarkers(object = pbmc)
+
+# Find markers and limit to those expressed in greater than 75% of target population
+all_markers <- FindAllMarkers(object = pbmc) %>%
+    Add_Pct_Diff() %>%
+    filter(pct_diff > 0.6)
 
-top5_markers <- Extract_Top_Markers(marker_dataframe = all_markers, num_genes = 5, named_vector = FALSE,
+top_markers <- Extract_Top_Markers(marker_dataframe = all_markers, num_genes = 7, named_vector = FALSE,
     make_unique = TRUE)
 
-Clustered_DotPlot(seurat_object = pbmc, features = top5_markers)
-

+Clustered_DotPlot(seurat_object = pbmc, features = top_markers)
+

Cluster Plot on Gene Expression Patterns

By default Clustered_DotPlot performs k-means clustering with k value set to 1. However, users can change this value to enable better visualization of expression patterns.

-
-Clustered_DotPlot(seurat_object = pbmc, features = top5_markers, k = 9)
-

+
+Clustered_DotPlot(seurat_object = pbmc, features = top_markers, k = 8)
+

Clustered_DotPlot() k-means Clustering Optional Parameters @@ -698,7 +728,7 @@
Clustered_DotP Clustered_DotPlot will return this plot when using the function. However, it can be turned off by setting plot_km_elbow = FALSE. -

+

The number of k values plotted must be 1 less than number of features. Default is to plot 20 values but users can customize number of k values plotted using elbow_kmax parameter.

@@ -730,18 +760,18 @@
Clustered_DotPlo of exp_color_min/exp_color_max but can be modified if a skewed visualization is desired. -
-Clustered_DotPlot(seurat_object = pbmc, features = top5_markers, k = 7, print_exp_quantiles = T)
-
Quantiles of gene expression data are:
-       10%        50%        90%        99% 
--0.6555988 -0.3595223  1.7742718  2.6666597
+
+Clustered_DotPlot(seurat_object = pbmc, features = top_markers, k = 8, print_exp_quantiles = T)
+
Quantiles of gene expression data are:
+       10%        50%        90%        99% 
+-0.6555988 -0.3595223  1.7742718  2.6666597

Here we can adjust the expression clipping based on the range of the data in this specific dataset and list of features and change the color scale to use Seurat::PurpleAndYellow()

-
-Clustered_DotPlot(seurat_object = pbmc, features = top5_markers, k = 7, exp_color_min = -1, exp_color_max = 2,
+
+Clustered_DotPlot(seurat_object = pbmc, features = top_markers, k = 8, exp_color_min = -1, exp_color_max = 2,
     colors_use_exp = PurpleAndYellow())
-

+

Clustered_DotPlot() Other Optional Parameters @@ -767,25 +797,38 @@
Clustered_DotPlot() Other O
-

-Split_FeatureScatter() +

FeatureScater Plots

-

This is simple function to add functionality that -Seurat::FeatureScatter() lacks.

-

FeatureScatter() plots can be very useful when comparing -between two genes/features or comparing module scores. However, Seurat’s -implementation lacks the ability to split the plot by a meta data -variable.

-
+

The scCustomize function FeatureScatter_scCustom() is a +slightly modified version of Seurat::FeatureScatter() with +some different default settings and parameter options.

+

FeatureScatter_scCustom() plots can be very useful when +comparing between two genes/features or comparing module scores. By +default scCustomize version sets shuffle = TRUE to ensure +that points are not hidden due to order of plotting.

+
 # Create Plots
-Split_FeatureScatter(seurat_object = marsh_mouse_micro, feature1 = "exAM_Score1", feature2 = "Microglia_Score1",
+FeatureScatter_scCustom(seurat_object = marsh_mouse_micro, feature1 = "exAM_Score1", feature2 = "Microglia_Score1",
+    colors_use = mouse_colors, group.by = "ident", num_columns = 2, pt.size = 1)
+

+
+
Split FeatureScatter Plots +
+

scCustomize previously contained function +Split_FeatureScatter as Seurat’s plot lacked that +functionality. However, that is now present and +Split_FeatureScatter has therefore been deprecated and it’s +functionality moved within FeatureScatter_scCustom.

+

FeatureScatter_scCustom() contains two options for +splitting plots (similar to DimPlot_scCustom. The default +is to return each plot with their own x and y axes, which has a number +of advantages (see DimPlot_scCustom section).

+
+# Create Plots
+FeatureScatter_scCustom(seurat_object = marsh_mouse_micro, feature1 = "exAM_Score1", feature2 = "Microglia_Score1",
     colors_use = mouse_colors, split.by = "Transcription_Method", group.by = "ident", num_columns = 2,
     pt.size = 1)
-
-*`Split_FeatureScatter()` solves this issue and allows for splitting of `FeatureScatter` plots by meta variable.*

-Split_FeatureScatter() solves this issue and allows for -splitting of FeatureScatter plots by meta variable. -

+

@@ -817,11 +860,11 @@
New default color palettes

To best demonstrate rationale for this I’m going to use over-clustered version of the marsh_mouse_micro object.

-
+
 DimPlot(object = marsh_mouse_over)
 DimPlot_scCustom(seurat_object = marsh_mouse_over)
-*`DimPlot_scCustom` also sets `label = TRUE` if `group.by = NULL` by default.*

+*`DimPlot_scCustom` also sets `label = TRUE` if `group.by = NULL` by default.*

DimPlot_scCustom also sets label = TRUE if group.by = NULL by default.

@@ -837,11 +880,11 @@
Shuffle Points

Here is example when plotting by donor in the human dataset to determine how well the dataset integration worked.

-
+
 DimPlot(object = marsh_human_pm, group.by = "sample_id")
 DimPlot_scCustom(seurat_object = marsh_human_pm, group.by = "sample_id")
-***A.** Cannot tell how well integrated the samples are due to plotting one on top of the other.  **B.** Default plot using scCustomize `DimPlot_scCustom`.*

+***A.** Cannot tell how well integrated the samples are due to plotting one on top of the other.  **B.** Default plot using scCustomize `DimPlot_scCustom`.*

A. Cannot tell how well integrated the samples are due to plotting one on top of the other. B. Default plot using scCustomize DimPlot_scCustom. @@ -854,11 +897,11 @@

Split DimPlotsWhen plotting a split plot Seurat::DimPlot() simplifies the axes by implementing shared axes depending on the number of columns specified.

-
+
 DimPlot(object = pbmc, split.by = "treatment")
 DimPlot(object = pbmc, split.by = "sample_id", ncol = 4)
-***A.** The default Seurat split.by looks ok when plots are all present on single row.  **B.** However, the visualization isn't so good when you starting wrapping plots into multiple rows.*

+***A.** The default Seurat split.by looks ok when plots are all present on single row.  **B.** However, the visualization isn't so good when you starting wrapping plots into multiple rows.*

A. The default Seurat split.by looks ok when plots are all present on single row. B. However, the visualization isn’t so good when you starting wrapping plots into @@ -868,10 +911,10 @@

Split DimPlotsBy default when using split.by with DimPlot_scCustom the layout is returned with an axes for each plot to make visualization of large numbers of splits easier.

-
+
 DimPlot_scCustom(seurat_object = pbmc, split.by = "treatment", num_columns = 4, repel = TRUE)
-*Simplified visualization without having to think about the number of variables that are being plotted.*

+*Simplified visualization without having to think about the number of variables that are being plotted.*

Simplified visualization without having to think about the number of variables that are being plotted.

@@ -880,9 +923,9 @@
Split DimPlotsDimPlot_scCustom by supplying split_seurat = TRUE

-
+
 DimPlot_scCustom(seurat_object = pbmc, split.by = "treatment", num_columns = 4, repel = TRUE, split_seurat = TRUE)
-

+

Figure Plotting @@ -891,9 +934,9 @@
Figure PlottingDimPlot_scCustom simply set figure_plot = TRUE.

-
+
 DimPlot_scCustom(seurat_object = pbmc, figure_plot = TRUE)
-

+

@@ -910,14 +953,14 @@

Highlight Cluster(s)
+
 Cluster_Highlight_Plot(seurat_object = marsh_mouse_over, cluster_name = "7", highlight_color = "navy",
     background_color = "lightgray")
 
 Cluster_Highlight_Plot(seurat_object = marsh_mouse_over, cluster_name = "8", highlight_color = "forestgreen",
     background_color = "lightgray")
-*`Cluster_Highlight_Plot` takes identity or vector of identities and plots them in front of remaining unselected cells.*

+*`Cluster_Highlight_Plot` takes identity or vector of identities and plots them in front of remaining unselected cells.*

Cluster_Highlight_Plot takes identity or vector of identities and plots them in front of remaining unselected cells.

@@ -927,10 +970,10 @@
Highlight 2+ clusters in the same

Cluster_Highlight_Plot() also supports the ability to plot multiple identities in the same plot.

-
+
 Cluster_Highlight_Plot(seurat_object = marsh_mouse_over, cluster_name = c("7", "8"), highlight_color = c("navy",
     "forestgreen"))
-

+

NOTE: If no value is provided to highlight_color then all clusters provided to cluster_name will be plotted using single default color (navy).

@@ -945,10 +988,10 @@

Highlight Meta Data
+
 Meta_Highlight_Plot(seurat_object = marsh_mouse_micro, meta_data_column = "Transcription_Method",
     meta_data_highlight = "ENZYMATIC_NONE", highlight_color = "firebrick", background_color = "lightgray")
-

+

Highlight 2+ factor levels in the same plot
@@ -956,11 +999,11 @@
Highlight 2+ factor levels i levels from the same meta data column in the same plot, similar to plotting multiple identities with Cluster_Highlight_Plot()

-
+
 Meta_Highlight_Plot(seurat_object = marsh_mouse_micro, meta_data_column = "Transcription_Method",
     meta_data_highlight = c("ENZYMATIC_NONE", "DOUNCE_NONE"), highlight_color = c("firebrick", "dodgerblue"),
     background_color = "lightgray")
-

+

@@ -973,7 +1016,7 @@

Highlight Cellscells_highlight parameter must be a named list.

Let’s say we want to highlight cells with expression of MS4A1 above certain threshold.

-
+
 # Get cell names
 MS4A1 <- WhichCells(object = pbmc, expression = MS4A1 > 3)
 
@@ -982,7 +1025,7 @@ 

Highlight Cells # Plot Cell_Highlight_Plot(seurat_object = pbmc, cells_highlight = cells)

-

+

Highlight 2+ sets of cells in the same plot
@@ -990,7 +1033,7 @@
Highlight 2+ sets of cells i sets of cells in the same plot, similar to plotting multiple identities with Cluster_Highlight_Plot()/Meta_Highlight_Plot().

-
+
 # Get cell names and make list
 MS4A1 <- WhichCells(object = pbmc, expression = MS4A1 > 3)
 GZMB <- WhichCells(object = pbmc, expression = GZMB > 3)
@@ -998,7 +1041,7 @@ 
Highlight 2+ sets of cells i cells <- list(MS4A1 = MS4A1, GZMB = GZMB) # Plot Cell_Highlight_Plot(seurat_object = pbmc, cells_highlight = cells)
-

+

@@ -1007,19 +1050,19 @@

DimPlot Layout Plots
+
 DimPlot_All_Samples(seurat_object = pbmc, meta_data_column = "sample_id", num_col = 3, pt.size = 0.5)
-*Visualize all samples in simple plot layout.*

+*Visualize all samples in simple plot layout.*

Visualize all samples in simple plot layout.

Can unique color each plot by providing a vector of colors instead of single value

-
+
 DimPlot_All_Samples(seurat_object = marsh_mouse_micro, meta_data_column = "Transcription", num_col = 2,
     pt.size = 0.5, color = c("firebrick3", "dodgerblue3"))
-

+

diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-20-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-20-1.png index 6035355012..fc37820017 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-20-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-20-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-26-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-26-1.png index 62a22c1d4d..87b1e495a2 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-26-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-26-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-27-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-27-1.png index e7dafed081..62a22c1d4d 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-27-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-27-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-28-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-28-1.png new file mode 100644 index 0000000000..e7dafed081 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-28-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-30-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-30-1.png index 498c11a2d7..c3a6a55106 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-30-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-30-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-31-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-31-1.png new file mode 100644 index 0000000000..498c11a2d7 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-31-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-33-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-33-1.png new file mode 100644 index 0000000000..005883c48a Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-33-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-35-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-35-1.png new file mode 100644 index 0000000000..141c1bb300 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-35-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-37-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-37-1.png new file mode 100644 index 0000000000..49ebf4d69a Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-37-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-39-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-39-1.png new file mode 100644 index 0000000000..d5cf01bb1f Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-39-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-41-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-41-1.png index e060bd6b60..416000e3f0 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-41-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-41-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-43-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-43-1.png index 46c9fec4b8..dd89ed7c90 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-43-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-43-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-44-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-44-1.png index 46c9fec4b8..dd89ed7c90 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-44-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-44-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-46-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-46-1.png new file mode 100644 index 0000000000..54e1b71d33 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-46-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-47-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-47-1.png new file mode 100644 index 0000000000..54e1b71d33 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-47-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-48-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-48-1.png new file mode 100644 index 0000000000..42ae682b08 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-48-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-5-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-5-1.png index ce11aa2728..c10b781550 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-5-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-5-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-52-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-52-1.png new file mode 100644 index 0000000000..2f1685f937 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-52-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-53-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-53-1.png new file mode 100644 index 0000000000..2f1685f937 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-53-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-54-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-54-1.png index 0a702cc982..dda6aff359 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-54-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-54-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-55-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-55-1.png new file mode 100644 index 0000000000..40f3479384 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-55-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-58-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-58-1.png index 7f3e7d73ca..0a702cc982 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-58-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-58-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-60-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-60-1.png index 3f245b4b56..d43c63bef0 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-60-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-60-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-62-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-62-1.png new file mode 100644 index 0000000000..7f3e7d73ca Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-62-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-64-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-64-1.png new file mode 100644 index 0000000000..d5e64f8b79 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-64-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-65-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-65-1.png index a61b24eea0..f01148dcfc 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-65-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-65-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-67-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-67-1.png index 6ff6d09964..9349c1f0ed 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-67-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-67-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-69-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-69-1.png index 236a9e9ded..a61b24eea0 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-69-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-69-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-71-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-71-1.png index ff4d12e1e9..6ff6d09964 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-71-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-71-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-72-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-72-1.png new file mode 100644 index 0000000000..4f589ee43f Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-72-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-73-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-73-1.png index 3ec97ac4f7..236a9e9ded 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-73-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-73-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-75-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-75-1.png index 9db85a5c13..ff4d12e1e9 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-75-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-75-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-77-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-77-1.png new file mode 100644 index 0000000000..3ec97ac4f7 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-77-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-78-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-78-1.png new file mode 100644 index 0000000000..0651fa673d Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-78-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-79-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-79-1.png new file mode 100644 index 0000000000..9db85a5c13 Binary files /dev/null and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-79-1.png differ diff --git a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-8-1.png b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-8-1.png index 8ca2f52d40..341e8d05f4 100644 Binary files a/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-8-1.png and b/docs/articles/Gene_Expression_Plotting_files/figure-html/unnamed-chunk-8-1.png differ diff --git a/docs/articles/Helpers_and_Utilities.html b/docs/articles/Helpers_and_Utilities.html index 2fb2fc1a05..870788b4c6 100644 --- a/docs/articles/Helpers_and_Utilities.html +++ b/docs/articles/Helpers_and_Utilities.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041

@@ -130,7 +130,8 @@
-

Add Cell Complexity/Novelty QC Metric +

Add Cell Complexity/Novelty QC Metrics

+

In addition to metrics like number of features and UMIs it can often +be helpful to analyze the complexity of expression within a single cell. +scCustomize provides functions to add two of these metrics to meta +data.

+
+

Cell Complexity (log10(nFeature) / log10(nCount)) +

scCustomize contains easy shortcut function to add a measure of cell complexity/novelty that can sometimes be useful to filter low quality cells. The metric is calculated by calculating the result of @@ -453,6 +463,38 @@

Add Cell Complexity/Novelty QC Met

NOTE: There is analogous function for LIGER objects (see: Add_Cell_Complexity_LIGER()).

+
+

Add Top Percent Expression QC Metric +

+

Additionally, (or alternatively), scCustomize contains another metric +of complexity which is the top percent expression. The user supplies an +integer value for num_top_genes (default is 50) which +species the number of genes and the function returns percentage of +counts occupied by top XX genes in each cell.

+
+# These defaults can be run just by providing accepted species name
+pbmc <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc, num_top_genes = 50)
+
+
+
+

Add All Cell QC Metrics with Single Function +

+

To simplify the process of adding cell QC metrics scCustomize +contains a wrapper function which can be customized to add all or some +of the available QC metrics. The default parameters of the function +Add_Cell_QC_Metrics will add:

+
    +
  • Mitochondrial and Ribosomal Percentages (default and custom +species).
  • +
  • Cell Complexity (log10(nFeature) / log10(nCount).
  • +
  • Top XX Gene Percentage.
  • +
  • Percentage of counts for IEG (human and mouse only).
  • +
  • OXPHOS, APOP, and DNA Repair pathways (supported species only).
  • +
  • Cell Cycle Scoring (Human only).
  • +
+
+pbmc <- Add_Cell_QC_Metrics(seurat_object = pbmc, species = "human")
+

Meta Data

@@ -463,7 +505,7 @@

Extract all meta data (cel

Fetch_Meta() functions as simple getter function to obtain meta data from object and return data.frame.

-
+
 meta_data <- Fetch_Meta(object = pbmc)
 
 head(meta_data, 10)
@@ -508,10 +550,10 @@

Extract all meta data (cel Memory CD4 T -sample5 +sample2 -Batch1 +Batch2 @@ -534,7 +576,7 @@

Extract all meta data (cel sample1 -Batch1 +Batch2 @@ -554,7 +596,7 @@

Extract all meta data (cel Memory CD4 T -sample3 +sample5 Batch2 @@ -577,10 +619,10 @@

Extract all meta data (cel CD14+ Mono -sample3 +sample2 -Batch2 +Batch1 @@ -623,7 +665,7 @@

Extract all meta data (cel Memory CD4 T -sample5 +sample4 Batch2 @@ -646,10 +688,10 @@

Extract all meta data (cel CD8 T -sample6 +sample4 -Batch1 +Batch2 @@ -669,7 +711,7 @@

Extract all meta data (cel CD8 T -sample5 +sample4 Batch1 @@ -692,10 +734,10 @@

Extract all meta data (cel Naive CD4 T -sample6 +sample1 -Batch2 +Batch1 @@ -715,7 +757,7 @@

Extract all meta data (cel FCGR3A+ Mono -sample2 +sample6 Batch1 @@ -730,7 +772,7 @@

Extract sample-level meta da

While cell-level meta data is helpful in some situations often all that is required is sample-level meta data. This can easily be extracted and filtered using Extract_Sample_Meta().

-
+
 sample_meta <- Extract_Sample_Meta(object = pbmc, sample_name = "sample_id")
@@ -764,7 +806,7 @@

Extract sample-level meta da sample1

@@ -775,13 +817,13 @@

Extract sample-level meta da pbmc3k

@@ -792,7 +834,7 @@

Extract sample-level meta da pbmc3k

@@ -843,7 +885,7 @@

Extract sample-level meta da pbmc3k

@@ -267,28 +270,28 @@

Cells Per Identity -133 +123

@@ -302,28 +305,28 @@

Cells Per Identity -116 +121

@@ -337,28 +340,28 @@

Cells Per Identity -83 +85

@@ -372,28 +375,28 @@

Cells Per Identity -80 +72

@@ -407,28 +410,28 @@

Cells Per Identity -47 +32

@@ -442,28 +445,28 @@

Cells Per Identity -40 +48

@@ -477,28 +480,28 @@

Cells Per Identity -7 +4

@@ -512,28 +515,28 @@

Cells Per Identity -6 +2

@@ -547,25 +550,25 @@

Cells Per Identity -689 +677

@@ -639,16 +642,16 @@

Cells Per Identity -242 +236

@@ -662,16 +665,16 @@

Cells Per Identity -229 +242

@@ -685,16 +688,16 @@

Cells Per Identity -165 +154

@@ -708,16 +711,16 @@

Cells Per Identity -137 +136

@@ -731,16 +734,16 @@

Cells Per Identity -82 +80

@@ -754,16 +757,16 @@

Cells Per Identity -78 +86

@@ -777,16 +780,16 @@

Cells Per Identity -15 +12

@@ -800,16 +803,16 @@

Cells Per Identity -6 +4

@@ -823,16 +826,16 @@

Cells Per Identity -1312 +1314

@@ -959,10 +962,10 @@

Change grouping variable

@@ -994,16 +997,16 @@

Change grouping variable

@@ -1021,10 +1024,10 @@

Split within groups

- + @@ -1081,52 +1084,52 @@

Split within groups -8.259587 +6.868132

@@ -1369,19 +1372,19 @@

Basic Use -2170.5 +2222

@@ -1389,19 +1392,19 @@

Basic Use -2191.0 +2230

@@ -1409,19 +1412,19 @@

Basic Use -2250.5 +2241

@@ -1429,10 +1432,10 @@

Basic Use -2213.0 +2213

@@ -1509,22 +1512,22 @@

Additional Variables -2170.5 +2222

@@ -1532,22 +1535,22 @@

Additional Variables -2191.0 +2230

@@ -1555,22 +1558,22 @@

Additional Variables -2250.5 +2241

@@ -1578,10 +1581,10 @@

Additional Variables -2213.0 +2213

+ + + + @@ -224,6 +232,10 @@

Basic Analysis QC Plots

Functions plotting various QC from Seurat Objects.

+ + @@ -295,6 +307,10 @@

Seurat Plotting Functions FeaturePlot_scCustom()

+ + @@ -508,6 +524,10 @@

Helper Utilities (Seurat) Add_Cell_Complexity_Seurat()

+ + @@ -516,6 +536,10 @@

Helper Utilities (Seurat) Add_Sample_Meta()

+ + @@ -616,6 +640,10 @@

Statistics Functions Cluster_Stats_All_Samples()

+ + @@ -660,6 +688,14 @@

Data

ensembl_ribo_id

+ + + +
-Batch1 +Batch2
-FCGR3A+ Mono +Memory CD4 T sample2 -Batch1 +Batch2
-Memory CD4 T +NA sample3 @@ -832,7 +874,7 @@

Extract sample-level meta da sample5

-Batch1 +Batch2
-CD8 T +FCGR3A+ Mono sample6 @@ -863,7 +905,7 @@
Remove columns tha may want to remove other columns too. This can be achieved using either positive or negative selection using variables_include or variables_exclude parameters.

-
+
 sample_meta <- Extract_Sample_Meta(object = pbmc, sample_name = "sample_id", variables_exclude = c("nFeature_RNA",
     "nCount_RNA", "seurat_annotations", "orig.ident"))
@@ -886,7 +928,7 @@
Remove columns tha sample1
@@ -897,7 +939,7 @@
Remove columns tha sample2
@@ -930,7 +972,7 @@
Remove columns tha sample5
@@ -954,7 +996,7 @@
Merge with sample-level can be valuable to get summary information for those variables. This can be achieved by merging outputs with Median_Stats function.

-
+
 sample_meta <- Extract_Sample_Meta(object = pbmc, sample_name = "sample_id", variables_exclude = c("nFeature_RNA",
     "nCount_RNA", "seurat_annotations", "orig.ident"))
 
@@ -987,13 +1029,13 @@ 
Merge with sample-level sample1
@@ -1004,13 +1046,13 @@
Merge with sample-level sample2
@@ -1024,10 +1066,10 @@
Merge with sample-level Batch2
@@ -1041,10 +1083,10 @@
Merge with sample-level Batch2
@@ -1055,13 +1097,13 @@
Merge with sample-level sample5
@@ -1075,10 +1117,10 @@
Merge with sample-level Batch1
@@ -1092,7 +1134,7 @@
Merge with sample-level NA
@@ -253,25 +256,25 @@

Percent Difference in Expression

@@ -279,25 +282,25 @@

Percent Difference in Expression

@@ -305,25 +308,25 @@

Percent Difference in Expression

@@ -331,25 +334,25 @@

Percent Difference in Expression

@@ -410,28 +413,28 @@

Use Add_Pct_Diff 1

@@ -439,28 +442,28 @@

Use Add_Pct_Diff 2

@@ -468,28 +471,28 @@

Use Add_Pct_Diff 3

@@ -497,28 +500,28 @@

Use Add_Pct_Diff 4

@@ -526,28 +529,28 @@

Use Add_Pct_Diff 5

@@ -586,10 +589,10 @@

Returns a Named Vector (Default)# with) top_5 <- Extract_Top_Markers(marker_dataframe = all_markers, num_genes = 5, rank_by = "avg_log2FC") head(top_5, 10) -
##  Naive CD4 T  Naive CD4 T  Naive CD4 T  Naive CD4 T  Naive CD4 T Memory CD4 T 
-##       "CCR7"    "LDLRAP1"       "LDHB"       "LEF1"  "PRKCQ-AS1"        "LTB" 
-## Memory CD4 T Memory CD4 T Memory CD4 T Memory CD4 T 
-##       "AQP3"        "CD2"       "IL32"       "IL7R"
+
##   Naive CD4 T   Naive CD4 T   Naive CD4 T   Naive CD4 T   Naive CD4 T 
+##      "GTSCR1"        "REG4"         "NOG"  "ST6GALNAC1"       "AXIN2" 
+##  Memory CD4 T  Memory CD4 T  Memory CD4 T  Memory CD4 T  Memory CD4 T 
+##     "HSD11B1" "RP11-90D4.3"       "RFPL2"       "CCL27"       "CCR10"

Return data.frame (Optional) @@ -631,25 +634,25 @@

Return data.frame (Optional) -0 +0.00e+00

@@ -657,25 +660,25 @@

Return data.frame (Optional) -0 +0.00e+00

@@ -683,25 +686,25 @@

Return data.frame (Optional) -0 +0.00e+00

@@ -709,25 +712,25 @@

Return data.frame (Optional) -0 +8.71e-05

@@ -735,155 +738,155 @@

Return data.frame (Optional) -0 +8.67e-05

@@ -924,7 +927,7 @@

Unique Vectors named_vector = FALSE) any(duplicated(x = top_5)) -
## [1] TRUE
+
## [1] FALSE
 # Set `make_unique = TRUE`
 top_5_unique <- Extract_Top_Markers(marker_dataframe = all_markers, num_genes = 5, rank_by = "avg_log2FC",
diff --git a/docs/articles/Misc_Functions.html b/docs/articles/Misc_Functions.html
index 66d3de9577..ff6f406faf 100644
--- a/docs/articles/Misc_Functions.html
+++ b/docs/articles/Misc_Functions.html
@@ -33,7 +33,7 @@
       
       
         scCustomize
-        1.1.3
+        1.9.9.9041
       
     
@@ -129,7 +129,8 @@ @@ -130,7 +130,8 @@

-Batch1 +Batch2
-Batch1 +Batch2
-Batch1 +Batch2
-Batch1 +Batch2 -2213.0 +2258 -824.0 +829.0
-Batch1 +Batch2 -2130.5 +2226 -812.0 +815.0
-2222.0 +2209 -829.0 +810.0
-2268.0 +2137 -824.5 +807.0
-Batch1 +Batch2 -2172.0 +2151 -800.0 +816.0
-2175.0 +2192 -808.0 +828.5
-2196.0 +2196 816.0 @@ -1121,7 +1163,7 @@

Add sample-level meta data to obje information in Seurat object and sample-level meta data.

This is example command:

-
+
 obj <- Add_Sample_Meta(seurat_object = obj, meta_data = sample_meta, join_by_seurat = "orig.ident",
     join_by_meta = "sample_id")
@@ -1156,7 +1198,7 @@

-
+
 # Example gene list with all examples (found genes, wrong case (lower) and misspelled (CD8A
 # forgetting to un-shift when typing 8))
 gene_input_list <- c("CD14", "CD3E", "Cd4", "CD*A")
@@ -1167,7 +1209,7 @@ 

## Warning: NOTE: However, the following features were found: CD4
 ##  Please check intended case of features provided.

Now let’s look at the output:

-
+
 genes_present
## $found_features
 ## [1] "CD14" "CD3E"
@@ -1207,7 +1249,7 @@ 

Check for updated gene symbols
+
 gene_input_list <- c("CD14", "CD3E", "Cd4", "CD*A", "SEPT1")
 
 genes_present <- Gene_Present(data = pbmc, gene_list = gene_input_list)
@@ -1215,7 +1257,7 @@

Check for updated gene symbols## Cd4 and CD*A

## Warning: NOTE: However, the following features were found: CD4
 ##  Please check intended case of features provided.
-
+
 check_symbols <- UpdateSymbolList(symbols = genes_present[[2]], verbose = TRUE)
## Warning: No updated symbols found
@@ -1240,7 +1282,7 @@

Merging raw dataorig.ident when creating Seurat objects. See Read & Write Vignette for more info on the data import functions.

-
+
 # Read in data
 GEO_10X <- Read10X_GEO(data_dir = "assets/GSE152183_RAW_Marsh/")
 
@@ -1260,7 +1302,7 @@ 

Merging List of Seurat Objectspurrr::reduce() to merge all objects in list into single combined object

-
+
 list_of_objects <- list(obj1, obj2, obj2, ..., obj10)
 
 merged_seurat <- Merge_Seurat_List(list_seurat = list_of_objects)
@@ -1279,7 +1321,7 @@ 

Storing Misc Information in scCustomize contains two functions Store_Misc_Info_Seurat and a wrapper around that function Store_Palette_Seurat to make this process easy.

-
+
 # Data can be vectors or data.frames
 misc_info <- "misc_vector_dataframe_list_etc"
 
@@ -1291,7 +1333,7 @@ 

Storing Lists
+
 # Create list
 misc_info <- list("misc_item1", "misc_item2", etc)
 
@@ -1311,7 +1353,7 @@ 

Storing Color PalettesStore_Palette_Seurat.

-
+
 # Data can be vectors or data.frames
 annotated_color_palette <- c("color1", "color2", "color3", "etc")
 
@@ -1335,7 +1377,7 @@ 

Replace Suffixes

Replace_Suffix can be used on single matrix/data.frame or list of matrices/data.frames to modify to remove suffixes

-
+
 # For single object
 data_mod <- Replace_Suffix(data = raw_data, current_suffix = "-1", new_suffix = "-2")
 
@@ -1360,7 +1402,7 @@ 

Strip Suffixes

Replace_Suffix can also be used to strip suffixes from data

-
+
 # For single object
 data_mod <- Replace_Suffix(data = raw_data, current_suffix = "-1", new_suffix = "")
@@ -1381,7 +1423,7 @@

Change Prefix/Suffix Delimiters

These functions all take identical inputs and can be applied to either single matrix/data.frames or lists of matrices/data.frames.

-
+
 data_mod <- Change_Delim_Prefix(data = raw_data, current_delim = ".", new_delim = "_")
 
 data_mod <- Change_Delim_Suffix(data = raw_data, current_delim = ".", new_delim = "_")
diff --git a/docs/articles/Installation.html b/docs/articles/Installation.html
index 2bb3dbbf62..53ab0dcc28 100644
--- a/docs/articles/Installation.html
+++ b/docs/articles/Installation.html
@@ -33,7 +33,7 @@
       
       
         scCustomize
-        1.1.3
+        1.9.9.9041
       
     
@@ -129,7 +129,8 @@
+pak::pkg_install("scCustomize")

Non-CRAN packages

@@ -164,7 +165,7 @@

Non-CRAN packagesinstall.packages("BiocManager") -BiocManager::install(c("ComplexHeatmap", "dittoSeq", "DropletUtils", "Nebulosa"))

+BiocManager::install(c("ComplexHeatmap", "dittoSeq", "DropletUtils", "Nebulosa"))

Optional CRAN packages diff --git a/docs/articles/Iterative_Plotting.html b/docs/articles/Iterative_Plotting.html index 7fc87f0fe8..b9b1a5829e 100644 --- a/docs/articles/Iterative_Plotting.html +++ b/docs/articles/Iterative_Plotting.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041

@@ -129,7 +129,8 @@ @@ -129,7 +129,8 @@

-0 +0.00e+00 -1.330040 +7.115580 -0.436 +0.016 -0.110 +0.000 -0 +0.0004033 Naive CD4 T -CCR7 +GTSCR1
-0 +0.00e+00 -1.101679 +5.853999 -0.245 +0.022 -0.084 +0.001 -0 +0.0000122 Naive CD4 T -LDLRAP1 +REG4
-0 +0.00e+00 -1.053259 +4.791871 -0.901 +0.034 -0.594 +0.003 -0 +0.0000001 Naive CD4 T -LDHB +NOG
-0 +8.71e-05 -1.052644 +4.425698 -0.336 +0.010 -0.104 +0.001 -0 +1.0000000 Naive CD4 T -LEF1 +ST6GALNAC1
-0 +8.67e-05 -1.027161 +4.423395 -0.331 +0.010 -0.110 +0.001 -0 +1.0000000 Naive CD4 T -PRKCQ-AS1 +AXIN2
-0 +0.00e+00 -1.330040 +7.115580 -0.436 +0.016 -0.110 +0.000 -0 +0.0004033 Naive CD4 T -CCR7 +GTSCR1 -0.326 +0.016
-0 +0.00e+00 -1.101679 +5.853999 -0.245 +0.022 -0.084 +0.001 -0 +0.0000122 Naive CD4 T -LDLRAP1 +REG4 -0.161 +0.021
-0 +0.00e+00 -1.053259 +4.791871 -0.901 +0.034 -0.594 +0.003 -0 +0.0000001 Naive CD4 T -LDHB +NOG -0.307 +0.031
-0 +8.71e-05 -1.052644 +4.425698 -0.336 +0.010 -0.104 +0.001 -0 +1.0000000 Naive CD4 T -LEF1 +ST6GALNAC1 -0.232 +0.009
-0 +8.67e-05 -1.027161 +4.423395 -0.331 +0.010 -0.110 +0.001 -0 +1.0000000 Naive CD4 T -PRKCQ-AS1 +AXIN2 -0.221 +0.009
-1.330040 +7.115580 -0.436 +0.016 -0.110 +0.000 -0 +0.0004033 Naive CD4 T -CCR7 +GTSCR1
-1.101679 +5.853999 -0.245 +0.022 -0.084 +0.001 -0 +0.0000122 Naive CD4 T -LDLRAP1 +REG4
-1.053259 +4.791871 -0.901 +0.034 -0.594 +0.003 -0 +0.0000001 Naive CD4 T -LDHB +NOG
-1.052644 +4.425698 -0.336 +0.010 -0.104 +0.001 -0 +1.0000000 Naive CD4 T -LEF1 +ST6GALNAC1
-1.027161 +4.423395 -0.331 +0.010 -0.110 +0.001 -0 +1.0000000 Naive CD4 T -PRKCQ-AS1 +AXIN2
-948 +2584 -0 +0.00e+00 -1.287053 +7.049508 -0.981 +0.017 -0.642 +0.000 -0 +0.0000302 Memory CD4 T -LTB +HSD11B1
-949 +2585 -0 +2.30e-06 -1.238703 +6.574363 -0.422 +0.010 -0.110 +0.000 -0 +0.0313519 Memory CD4 T -AQP3 +RP11-90D4.3
-950 +2586 -0 +3.30e-05 -1.234832 +5.049954 -0.652 +0.012 -0.244 +0.001 -0 +0.4521838 Memory CD4 T -CD2 +RFPL2
-951 +2587 -0 +3.78e-05 -1.208094 +4.002013 -0.948 +0.010 -0.464 +0.000 -0 +0.5180331 Memory CD4 T -IL32 +CCL27
-952 +2588 -0 +0.00e+00 -1.175375 +3.725109 -0.747 +0.039 -0.325 +0.004 -0 +0.0000000 Memory CD4 T -IL7R +CCR10
@@ -630,6 +741,9 @@

Calculate Median Values &

+ @@ -651,6 +765,9 @@

Calculate Median Values &

+ + + + + + + + +
Median_percent_mito_ribo +Median_log10GenesPerUMI +
46.43790 +0.8506316 +
@@ -671,6 +788,9 @@

Calculate Median Values &

46.87269 +0.8505270 +
@@ -691,6 +811,9 @@

Calculate Median Values &

44.10722 +0.8483425 +
@@ -711,6 +834,9 @@

Calculate Median Values &

37.96850 +0.8645139 +
@@ -731,6 +857,9 @@

Calculate Median Values &

45.33713 +0.8360196 +
@@ -751,6 +880,9 @@

Calculate Median Values &

46.70119 +0.8522162 +
@@ -771,6 +903,9 @@

Calculate Median Values &

48.20765 +0.8477172 +
@@ -791,6 +926,9 @@

Calculate Median Values &

48.96420 +0.8406128 +
@@ -811,13 +949,16 @@

Calculate Median Values &

45.40989 +0.8494067 +

The Median_Stats function has some column names stored by default but will also calculate medians for additional meta.data columns using the optional median_var parameter

-
+
 median_stats <- Median_Stats(seurat_object = hca_bm, group_by_var = "orig.ident", median_var = "meta_data_column_name")
@@ -844,12 +985,12 @@

Plotting Median Values -
+
 Plot_Median_Genes(seurat_object = hca_bm, group_by = "group")
 Plot_Median_UMIs(seurat_object = hca_bm, group_by = "group")
 Plot_Median_Mito(seurat_object = hca_bm, group_by = "group")
 Plot_Median_Other(seurat_object = hca_bm, median_var = "percent_ribo", group_by = "group")
-

+

Plot Number of Cells/Nuclei per Sample @@ -859,7 +1000,7 @@

Plot Number of Cells/Nuclei per S

Since the HCA Bone Marrow dataset has exactly the same number of cells per sample we will use the microglia object from the Analysis Plots vignette.

-

+

diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-13-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-13-1.png index 8b4bbac87b..45e58acc56 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-13-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-13-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-14-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-14-1.png index 8b4bbac87b..50dbfe7c60 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-14-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-14-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-15-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-15-1.png index 805c6542f5..f27142b50e 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-15-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-15-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-16-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-16-1.png index 805c6542f5..cc17f29529 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-16-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-16-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-17-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-17-1.png index 4da425c380..5d0e3b17b0 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-17-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-17-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-19-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-19-1.png new file mode 100644 index 0000000000..9eec4c9e5a Binary files /dev/null and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-19-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-21-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-21-1.png index 6abf046d1c..3c994a7436 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-21-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-21-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-22-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-22-1.png index 6abf046d1c..e8d92ca66a 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-22-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-22-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-23-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-23-1.png index 211b6355e9..30106c593a 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-23-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-23-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-24-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-24-1.png index 211b6355e9..0d1c719651 100644 Binary files a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-24-1.png and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-24-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-29-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-29-1.png new file mode 100644 index 0000000000..6abf046d1c Binary files /dev/null and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-29-1.png differ diff --git a/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-31-1.png b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-31-1.png new file mode 100644 index 0000000000..be4e93ac69 Binary files /dev/null and b/docs/articles/QC_Plots_files/figure-html/unnamed-chunk-31-1.png differ diff --git a/docs/articles/Read_and_Write_Functions.html b/docs/articles/Read_and_Write_Functions.html index 4553ca3f4c..146d0a6634 100644 --- a/docs/articles/Read_and_Write_Functions.html +++ b/docs/articles/Read_and_Write_Functions.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -129,7 +129,8 @@ diff --git a/docs/articles/Statistics.html b/docs/articles/Statistics.html index 9ed9e990fb..3870da4c7c 100644 --- a/docs/articles/Statistics.html +++ b/docs/articles/Statistics.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -130,7 +130,8 @@
-148 +169 -181 +174 -191 +164 -25.6894049 +28.0649926 -23.8709677 +25.840979 -29.052969 +27.3155416 -27.0538244 +24.4776119
-113 +114 -109 +113 -128 +133 -19.3033382 +18.1683900 -18.2258065 +17.431193 -17.495987 +17.7394035 -18.1303116 +19.8507463
-119 +117 -113 +121 -132 +121 -16.8359942 +17.8729690 -19.1935484 +17.889908 -18.138042 +18.9952904 -18.6968839 +18.0597015
-90 +92 -82 +69 -89 +98 -12.0464441 +12.5553914 -14.5161290 +14.067278 -13.162119 +10.8320251 -12.6062323 +14.6268657
70 -57 +64 -64 +65 -11.6110305 +10.6351551 -11.2903226 +10.703364 -9.149278 +10.0470958 -9.0651558 +9.7014925
-30 +40 -35 +48 -50 +42 -6.8214804 +4.7267356 -4.8387097 +6.116208 -5.617978 +7.5353218 -7.0821530 +6.2686567
-39 +36 38 -38 +33 -5.8055152 +7.0901034 -6.2903226 +5.504587 -6.099519 +5.9654631 -5.3824363 +4.9253731
-4 +11 8 -13 +9 -1.0159652 +0.5908419 -0.6451613 +1.681957 -1.284109 +1.2558870 -1.8413598 +1.3432836
-7 +5 -0 +2 -1 +5 -0.8708273 +0.2954210 -1.1290323 +0.764526 -0.000000 +0.3139717 -0.1416431 +0.7462687
-620 +654 -623 +637 -706 +670 100.0000000 -100.0000000 +100.000000 -100.000000 +100.0000000 100.0000000 @@ -616,16 +619,16 @@

Cells Per Identity -358 +364

-339 +333 -27.2865854 +27.701674 -25.5656109 +25.151057
-241 +247 -18.4451220 +17.960426 -18.1749623 +18.655589
-251 +238 -17.4542683 +18.417047 -18.9291101 +17.975831
-179 +190 -12.5762195 +11.719939 -13.4992459 +14.350453
-134 +135 -10.4420732 +10.350076 -10.1055807 +10.196375
-80 +82 -6.2500000 +6.088280 -6.0331825 +6.193353
-77 +69 -5.9451220 +6.544901 -5.8069382 +5.211480
-17 +20 -1.1432927 +0.913242 -1.2820513 +1.510574
-8 +10 -0.4573171 +0.304414 -0.6033183 +0.755287
-1326 +1324 -100.0000000 +100.000000 -100.0000000 +100.000000
-sample2 +sample1 -sample1 +sample2 sample4 @@ -977,16 +980,16 @@

Change grouping variable

-11.12903 +12.25997 -10.59507 +12.38532 -14.730878 +11.04478 -10.11236 +11.14600
-11.77419 +11.66913 -14.36865 +12.99694 -9.490085 +10.89552 -11.55698 +11.61695
-Naive.CD4.T_Group.2 +Naive.CD4.T_Group.1 -Naive.CD4.T_Group.1 +Naive.CD4.T_Group.2 Memory.CD4.T_Group.1 @@ -1033,10 +1036,10 @@

Split within groups -CD14..Mono_Group.1 +CD14..Mono_Group.2

-CD14..Mono_Group.2 +CD14..Mono_Group.1 B_Group.2 @@ -1045,34 +1048,34 @@

Split within groups -CD8.T_Group.2 -

CD8.T_Group.1 -FCGR3A..Mono_Group.1 +CD8.T_Group.2 FCGR3A..Mono_Group.2 -NK_Group.2 +FCGR3A..Mono_Group.1 NK_Group.1 +NK_Group.2 + DC_Group.2 DC_Group.1 -Platelet_Group.1 +Platelet_Group.2 -Platelet_Group.2 +Platelet_Group.1
-5.307263 +6.606607 -14.87603 +15.254237 -17.012448 +16.599190 -21.397380 +23.52941 -27.0916335 +25.206612 -1.117318 +1.578947 -1.818182 +1.298701 -2.985075 +3.676471 -2.189781 +1.481481 -19.512195 +28.048780 -35.0 +26.25 0.000000 -1.282051 +1.449275 -11.76471 +35 -60.000000 +33.333333 0 @@ -1140,52 +1143,52 @@

Split within groups -12.684366 +13.461538

-13.966480 +13.213213 -11.15702 +8.898305 -6.639004 +8.906883 -3.056769 +2.10084 -0.7968127 +1.652893 -2.234637 +2.105263 -3.030303 +3.246753 -50.000000 +47.794118 -51.094890 +53.333333 -4.878049 +7.317073 -2.5 +0.00 -7.792208 +9.302326 -8.974359 +7.246377 -0.00000 +0 -6.666667 +8.333333 0 @@ -1349,19 +1352,19 @@

Basic Use -2217.0 +2176

-825 +808.0 -1.979265 +2.002913 -37.05882 +37.39130 -39.01665 +39.80222
-818 +822.5 -2.048064 +1.999851 -36.95382 +36.89857 -39.07426 +39.04069
-809 +817.0 -2.033599 +2.048627 -36.66191 +36.05276 -38.80668 +37.88958
-823 +825.0 -1.983932 +1.983199 -37.06706 +36.95436 -39.41305 +39.06344
-819 +819.0 2.010702 @@ -1486,22 +1489,22 @@

Additional Variables -2217.0 +2176

-825 +808.0 -1.979265 +2.002913 -37.05882 +37.39130 -39.01665 +39.80222 --0.1320305 +-0.0577693
-818 +822.5 -2.048064 +1.999851 -36.95382 +36.89857 -39.07426 +39.04069 --0.1394421 +-0.0969207
-809 +817.0 -2.033599 +2.048627 -36.66191 +36.05276 -38.80668 +37.88958 --0.0468948 +-0.0460250
-823 +825.0 -1.983932 +1.983199 -37.06706 +36.95436 -39.41305 +39.06344 --0.0621651 +-0.1508095
-819 +819.0 2.010702 @@ -1599,6 +1602,140 @@

Additional Variables +

Calculate Median Absolute Deviations +

+

In addition to calculating the median values scCustomize includes +function to calculate the median absolute deviation for each of those +features with function MAD_Stats. By setting the parameter +mad_num the function will retrun the MAD*mad_num.

+
+mad <- MAD_Stats(seurat_object = pbmc, group_by_var = "orig.ident", mad_num = 2)
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+orig.ident + +MAD x 2 nCount_RNA + +MAD x 2 nFeature_RNA + +MAD x 2 percent_mito + +MAD x 2 percent_ribo + +MAD x 2 percent_mito_ribo +
+sample1 + +679.0308 + +203.1162 + +0.7369807 + +11.65896 + +11.28858 +
+sample2 + +706.4589 + +185.3250 + +0.8390032 + +12.07679 + +11.93595 +
+sample3 + +710.1654 + +174.9468 + +0.7349852 + +12.46342 + +12.41119 +
+sample4 + +816.1713 + +197.1858 + +0.7892841 + +11.66762 + +11.61448 +
+Totals (All Cells) + +721.2849 + +189.7728 + +0.7721931 + +11.86828 + +11.69341 +
+

Plotting Median Data @@ -1611,13 +1748,13 @@

Plotting Median DataPlot_Median_Mito()
  • Plot_Median_Other()
  • -
    +
     Plot_Median_Genes(seurat_object = pbmc)
     
     Plot_Median_Genes(seurat_object = pbmc, group_by = "group")
     
     Plot_Median_Other(seurat_object = pbmc, median_var = "module_score1", group_by = "group")
    -

    +

    diff --git a/docs/articles/Statistics_files/figure-html/unnamed-chunk-22-1.png b/docs/articles/Statistics_files/figure-html/unnamed-chunk-22-1.png new file mode 100644 index 0000000000..34244a8fff Binary files /dev/null and b/docs/articles/Statistics_files/figure-html/unnamed-chunk-22-1.png differ diff --git a/docs/articles/index.html b/docs/articles/index.html index ee540cf832..c7a4463e21 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/authors.html b/docs/authors.html index 618de3274a..c9e418a347 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -132,13 +132,14 @@

    Citation

    Marsh S (2023). scCustomize: Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing. -https://github.com/samuel-marsh/scCustomize, https://samuel-marsh.github.io/scCustomize/, https://doi.org/10.5281/zenodo.5706431. +R package version 1.9.9.9041, https://samuel-marsh.github.io/scCustomize/, https://doi.org/10.5281/zenodo.5706431, https://github.com/samuel-marsh/scCustomize.

    @Manual{,
       title = {scCustomize: Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing},
       author = {Samuel Marsh},
       year = {2023},
    -  note = {https://github.com/samuel-marsh/scCustomize, https://samuel-marsh.github.io/scCustomize/, https://doi.org/10.5281/zenodo.5706431},
    +  note = {R package version 1.9.9.9041, https://samuel-marsh.github.io/scCustomize/, https://doi.org/10.5281/zenodo.5706431},
    +  url = {https://github.com/samuel-marsh/scCustomize},
     }
    diff --git a/docs/index.html b/docs/index.html index d08c3aa378..8cdac7a398 100644 --- a/docs/index.html +++ b/docs/index.html @@ -33,7 +33,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/news/index.html b/docs/news/index.html index d1cba74cdb..9bb3be7683 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -104,6 +104,73 @@

    Changelog

    Source: NEWS.md +
    + +
    +

    Added

    +
    • Added support for metrics produced by Cell Ranger multi pipeline to Read10X_Metrics via new parameter cellranger_multi.
    • +
    • Added dot_size parameter to Seq_QC_Plot_* family of functions.
    • +
    • Added two new sequencing QC functions to create and iterate barcode rank plots: Barcode_Plot and Iterate_Barcode_Rank_Plot.
    • +
    • Added ident_legend parameter to QC_Plot_UMIvsGene to control show/hide of the identity legend (#121).
    • +
    • Added support for sparse matrix input in CellBender_Feature_Diff.
    • +
    • Added min_count_label in CellBender_Diff_Plot to better control feature labeling.
    • +
    • Allow specification of meta data column containing sample names/IDs in Iterate_DimPlot_bySample using new sample_column parameter.
    • +
    • Added new function MAD_Stats to calculate to the median absolute deviation of meta.data columns by grouping variable and across entire object.
    • +
    • Added new function Add_Top_Gene_Pct_Seurat to add another QC measure of cell complexity to object meta.data. Returns percentage of counts occupied by top XX genes in each cell.
    • +
    • Added ability to provide set of custom features to VariableFeaturePlot_scCustom using custom_features parameter.
    • +
    • Added new overall cell QC metric function Add_Cell_QC_Metrics to simplify adding cell QC metrics. Single function call to add Mito/Ribo Percentages, Cell Complexity, Top Gene Percentages, MSigDB Percentages, IEG Percentages, and/or Cell Cycle Scoring (human only).
    • +
    • Added 2 new gene lists to package data for use in Add_Cell_QC_Metrics function: “msigdb_qc_gene_list” and “ieg_gene_list”.
    • +
    • Added several internal functions to support new MsigDB and IEG capabilities of Add_Cell_QC_Metrics.
    • +
    • Added new parameters plot_median and plot_boxplot to VlnPlot_scCustom (and VlnPlot_scCustom-based plots; e.g., QC_Plot_* family) for added visualization.
    • +
    • Added QC_Histogram to plot QC features (or any feature) using simple histogram.
    • +
    • Added FeatureScatter_scCustom function to customize Seurat’s FeatureScatter plots.
    • +
    • Added figure_plot parameter to all 2D DR (t-SNE, UMAP, etc) based plots (#127).
    • +
    +
    +

    Changed

    +
    • Large scale under the hood code adjustments to ensure compatibility with Seurat V5 object structure.
    • +
    • Internal code syntax updates independent of Seurat functionality.
    • +
    • +HARD DEPRECATION Split_FeatureScatter function has been completely deprecated and it’s functionality has been moved to new FeatureScatter_scCustom.
    • +
    • +SOFT DEPRECATION The parameter gene_list in Iterate_FeaturePlot_scCustom and Iterate_VlnPlot_scCustom has been soft-deprecated and replaced by features parameter. Specifying gene_list will display deprecation warning but continue to function until next major update.
    • +
    • The above soft deprecation was to clarify that other features besides genes can be plotted and coincides with update to functions to allow for iterative plots of meta.data or reductions in addition to assay features (#123).
    • +
    • Internal rewrite of Read10X_Metrics to use new internal helper functions.
    • +
    • Changed Liger_to_Seurat to transfer the slot in addition to H.norm slot already moved.
    • +
    • Replaced length(x = colnames(x = obj) with length(x = Cells(x = obj) for accurate plotting based on V5 object structure.
    • +
    • +Gene_Present now accepts assay parameter.
    • +
    • Internal reorganization of some functions within R/ for better organization.
    • +
    • Updated default scCustomize color palettes (scCustomize_Palette). Now if number of colors is greater than 2 but less than 8 the default palette will be ColorBlind_Pal (previously it was “polychrome”). Polychrome remains the default when number of colors is between 9-36.
    • +
    • Updated parameter default within scCustomize_Palette to ggplot_default_colors = FALSE to avoid uncessary error when no value supplied.
    • +
    • Minimum version of scattermore package updated to v1.2.
    • +
    • +DimPlot_scCustom will now set label = TRUE if label.box is set to TRUE but label is not changed from default.
    • +
    • Removed loading of full tidyverse in vignettes to remove from package suggests (lessen dependency installs when not completely needed).
    • +
    • Replace Seurat PackageCheck (now deprecated), with rlang::is_installed() for non-dependency checks.
    • +
    • Update vignettes with new features and bug fixes from old code.
    • +
    +
    +

    Fixes

    +
    • Fixed issue in Read10X_Metrics that caused errors when reading files on windows operating system (#115).
    • +
    • Fixed issue in Create_CellBender_Merged_Seurat when feature names are changed (underscore to dash) during object creation (#118).
    • +
    • Fixed error in Read10X_h5_Mutli_Directory when reading Cell Ranger multi directories.
    • +
    • Added new checks to VlnPlot_scCustom, DimPlot_scCustom, and DotPlot_scCustom to avoid otherwise ambiguous error messages (#120).
    • +
    • Fixed internal check message accidentally user facing in VlnPlot_scCustom (#122).
    • +
    • Fixed cli warning in Cell_Highlight_Plot that could cause function to error without proper error message.
    • +
    • Fixed handling of file names in Read_* functions to avoid unnecessary errors.
    • +
    • Replace superseded dplyr syntax/functionality drop_na(.data[[var]], with current dplyr syntax.
    • +
    • Internal code fixes to accelerate plotting functions.
    • +
    • Fixed default plot colors in VlnPlot-based plots when split.by is not NULL.
    • +
    • Fixed error when trying to plot more than two variables with group.by when using DimPlot_scCustom (#128).
    • +
    • Fixed errors in parameter description for Add_Mito_Ribo_Seurat and Add_Mito_Ribo_LIGER which incorrectly stated the names of new meta.data/cell.data columns to be added.
    • +
    • Fixed bug in DotPlot_scCustom that prevented it from working unless group.by parameter was explicitly added.
    • +
    • Fixed bug in Case_Check caused by typo.
    • +
    • Fixed color warning messages in Cluster_Highlight_Plot and Meta_Highlight_Plot that were too verbose.
    • +
    • Fixed bug in Add_Mito_Ribo_Seurat and Add_Mito_Ribo_LIGER which caused error when supplying custom list of features for non-default organism (#133).
    • +
    • Fixed bug in DimPlot_scCustom preventing that errored when trying to split plot and use figure_plot at same time.
    • +
    +
    diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index d967bbc035..91bced9209 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -16,7 +16,7 @@ articles: Read_and_Write_Functions: Read_and_Write_Functions.html Sequencing_QC_Plots: Sequencing_QC_Plots.html Statistics: Statistics.html -last_built: 2023-07-20T21:18Z +last_built: 2023-11-06T12:08Z urls: reference: https://samuel-marsh.github.io/scCustomize/reference article: https://samuel-marsh.github.io/scCustomize/articles diff --git a/docs/reference/Add_CellBender_Diff.html b/docs/reference/Add_CellBender_Diff.html index 4bef6abb35..c58dabf230 100644 --- a/docs/reference/Add_CellBender_Diff.html +++ b/docs/reference/Add_CellBender_Diff.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Add_Cell_Complexity_LIGER.html b/docs/reference/Add_Cell_Complexity_LIGER.html index aebc239b79..1e40a3134b 100644 --- a/docs/reference/Add_Cell_Complexity_LIGER.html +++ b/docs/reference/Add_Cell_Complexity_LIGER.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Add_Cell_Complexity_Seurat.html b/docs/reference/Add_Cell_Complexity_Seurat.html index 3e79016f8f..98aebc63de 100644 --- a/docs/reference/Add_Cell_Complexity_Seurat.html +++ b/docs/reference/Add_Cell_Complexity_Seurat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Add_Cell_QC_Metrics.html b/docs/reference/Add_Cell_QC_Metrics.html new file mode 100644 index 0000000000..3e52081760 --- /dev/null +++ b/docs/reference/Add_Cell_QC_Metrics.html @@ -0,0 +1,304 @@ + +Add Multiple Cell Quality Control Values with Single Function — Add_Cell_QC_Metrics • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Add Mito/Ribo %, Cell Complexity (log10GenesPerUMI), Top Gene Percent with single function call

    +
    + +
    +
    Add_Cell_QC_Metrics(
    +  seurat_object,
    +  add_mito_ribo = TRUE,
    +  add_complexity = TRUE,
    +  add_top_pct = TRUE,
    +  add_MSigDB = TRUE,
    +  add_IEG = TRUE,
    +  add_cell_cycle = TRUE,
    +  species,
    +  mito_name = "percent_mito",
    +  ribo_name = "percent_ribo",
    +  mito_ribo_name = "percent_mito_ribo",
    +  complexity_name = "log10GenesPerUMI",
    +  top_pct_name = NULL,
    +  oxphos_name = "percent_oxphos",
    +  apop_name = "percent_apop",
    +  dna_repair_name = "percent_dna_repair",
    +  ieg_name = "percent_ieg",
    +  mito_pattern = NULL,
    +  ribo_pattern = NULL,
    +  mito_features = NULL,
    +  ribo_features = NULL,
    +  ensembl_ids = FALSE,
    +  num_top_genes = 50,
    +  assay = NULL,
    +  overwrite = FALSE
    +)
    +
    + +
    +

    Arguments

    +
    seurat_object
    +

    object name.

    + + +
    add_mito_ribo
    +

    logical, whether to add percentage of counts belonging to mitochondrial/ribosomal +genes to object (Default is TRUE).

    + + +
    add_complexity
    +

    logical, whether to add Cell Complexity to object (Default is TRUE).

    + + +
    add_top_pct
    +

    logical, whether to add Top Gene Percentages to object (Default is TRUE).

    + + +
    add_MSigDB
    +

    logical, whether to add percentages of counts belonging to genes from of mSigDB hallmark +gene lists: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR" to +object (Default is TRUE).

    + + +
    add_IEG
    +

    logical, whether to add percentage of counts belonging to IEG genes to object (Default is TRUE).

    + + +
    add_cell_cycle
    +

    logical, whether to addcell cycle scores and phase based on +CellCycleScoring. Only applicable if species = "human". (Default is TRUE).

    + + +
    species
    +

    Species of origin for given Seurat Object. If mouse, human, marmoset, zebrafish, rat, +drosophila, or rhesus macaque (name or abbreviation) are provided the function will automatically +generate mito_pattern and ribo_pattern values.

    + + +
    mito_name
    +

    name to use for the new meta.data column containing percent mitochondrial counts. +Default is "percent_mito".

    + + +
    ribo_name
    +

    name to use for the new meta.data column containing percent ribosomal counts. +Default is "percent_ribo".

    + + +
    mito_ribo_name
    +

    name to use for the new meta.data column containing percent +mitochondrial+ribosomal counts. Default is "percent_mito_ribo".

    + + +
    complexity_name
    +

    name to use for new meta data column for Add_Cell_Complexity_Seurat. +Default is "log10GenesPerUMI".

    + + +
    top_pct_name
    +

    name to use for new meta data column for Add_Top_Gene_Pct_Seurat. +Default is "percent_topXX", where XX is equal to the value provided to num_top_genes.

    + + +
    oxphos_name
    +

    name to use for new meta data column for percentage of MSigDB oxidative phosphorylation +counts. Default is "percent_oxphos".

    + + +
    apop_name
    +

    name to use for new meta data column for percentage of MSigDB apoptosis counts. +Default is "percent_apop".

    + + +
    dna_repair_name
    +

    name to use for new meta data column for percentage of MSigDB DNA repair +counts. Default is "percent_dna_repair"..

    + + +
    ieg_name
    +

    name to use for new meta data column for percentage of IEG counts. Default is "percent_ieg".

    + + +
    mito_pattern
    +

    A regex pattern to match features against for mitochondrial genes (will set automatically if +species is mouse or human; marmoset features list saved separately).

    + + +
    ribo_pattern
    +

    A regex pattern to match features against for ribosomal genes +(will set automatically if species is mouse, human, or marmoset).

    + + +
    mito_features
    +

    A list of mitochondrial gene names to be used instead of using regex pattern. +Will override regex pattern if both are present (including default saved regex patterns).

    + + +
    ribo_features
    +

    A list of ribosomal gene names to be used instead of using regex pattern. +Will override regex pattern if both are present (including default saved regex patterns).

    + + +
    ensembl_ids
    +

    logical, whether feature names in the object are gene names or +ensembl IDs (default is FALSE; set TRUE if feature names are ensembl IDs).

    + + +
    num_top_genes
    +

    An integer vector specifying the size(s) of the top set of high-abundance genes. +Used to compute the percentage of library size occupied by the most highly expressed genes in each cell.

    + + +
    assay
    +

    assay to use in calculation. Default is "RNA". Note This should only be changed if +storing corrected and uncorrected assays in same object (e.g. outputs of both Cell Ranger and Cell Bender).

    + + +
    overwrite
    +

    Logical. Whether to overwrite existing an meta.data column. Default is FALSE meaning that +function will abort if column with name provided to meta_col_name is present in meta.data slot.

    + +
    +
    +

    Value

    + + +

    A Seurat Object

    +
    + +
    +

    Examples

    +
    if (FALSE) {
    +obj <- Add_Cell_QC_Metrics(seurat_object = obj, species = "Human")
    +}
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Add_Mito_Ribo_LIGER.html b/docs/reference/Add_Mito_Ribo_LIGER.html index c3441ef470..38f2f601d3 100644 --- a/docs/reference/Add_Mito_Ribo_LIGER.html +++ b/docs/reference/Add_Mito_Ribo_LIGER.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -145,12 +145,12 @@

    Arguments

    ribo_name

    name to use for the new meta.data column containing percent ribosomal counts. -Default is "percent_mito".

    +Default is "percent_ribo".

    mito_ribo_name

    name to use for the new meta.data column containing percent mitochondrial+ribosomal -counts. Default is "percent_mito".

    +counts. Default is "percent_mito_ribo".

    mito_pattern
    diff --git a/docs/reference/Add_Mito_Ribo_Seurat.html b/docs/reference/Add_Mito_Ribo_Seurat.html index cc131a6451..583063797d 100644 --- a/docs/reference/Add_Mito_Ribo_Seurat.html +++ b/docs/reference/Add_Mito_Ribo_Seurat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -146,12 +146,12 @@

    Arguments

    ribo_name

    name to use for the new meta.data column containing percent ribosomal counts. -Default is "percent_mito".

    +Default is "percent_ribo".

    mito_ribo_name

    name to use for the new meta.data column containing percent -mitochondrial+ribosomal counts. Default is "percent_mito".

    +mitochondrial+ribosomal counts. Default is "percent_mito_ribo".

    mito_pattern
    @@ -204,10 +204,9 @@

    Value

    Examples

    -
    library(Seurat)
    -pbmc_small <- Add_Mito_Ribo_Seurat(seurat_object = pbmc_small, species = "human")
    -#> Warning: No Mito features found in object using pattern/feature list provided.
    -#>  No column will be added to meta.data.
    +    
    if (FALSE) {
    +obj <- Add_Mito_Ribo_Seurat(seurat_object = obj, species = "human")
    +}
     
     
    diff --git a/docs/reference/Add_Pct_Diff.html b/docs/reference/Add_Pct_Diff.html index d52e8770ed..f94e0fdfe3 100644 --- a/docs/reference/Add_Pct_Diff.html +++ b/docs/reference/Add_Pct_Diff.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Add_Sample_Meta.html b/docs/reference/Add_Sample_Meta.html index 8584e849de..ed8158c5a7 100644 --- a/docs/reference/Add_Sample_Meta.html +++ b/docs/reference/Add_Sample_Meta.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Add_Top_Gene_Pct_Seurat.html b/docs/reference/Add_Top_Gene_Pct_Seurat.html new file mode 100644 index 0000000000..c5070c898d --- /dev/null +++ b/docs/reference/Add_Top_Gene_Pct_Seurat.html @@ -0,0 +1,198 @@ + +Add Percent of High Abundance Genes — Add_Top_Gene_Pct_Seurat • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Add the percentage of counts occupied by the top XX most highly expressed genes in each cell.

    +
    + +
    +
    Add_Top_Gene_Pct_Seurat(
    +  seurat_object,
    +  num_top_genes = 50,
    +  meta_col_name = NULL,
    +  assay = "RNA",
    +  overwrite = FALSE
    +)
    +
    + +
    +

    Arguments

    +
    seurat_object
    +

    object name.

    + + +
    num_top_genes
    +

    An integer vector specifying the size(s) of the top set of high-abundance genes. +Used to compute the percentage of library size occupied by the most highly expressed genes in each cell.

    + + +
    meta_col_name
    +

    name to use for new meta data column. Default is "percent_topXX", where XX is +equal to the value provided to num_top_genes.

    + + +
    assay
    +

    assay to use in calculation. Default is "RNA". Note This should only be changed if +storing corrected and uncorrected assays in same object (e.g. outputs of both Cell Ranger and Cell Bender).

    + + +
    overwrite
    +

    Logical. Whether to overwrite existing an meta.data column. Default is FALSE meaning that +function will abort if column with name provided to meta_col_name is present in meta.data slot.

    + +
    +
    +

    Value

    + + +

    A Seurat Object

    +
    +
    +

    References

    +

    This function uses scuttle package (license: GPL-3) to calculate the percent of expression +coming from top XX genes in each cell. Parameter description for num_top_genes also from scuttle. +If using this function in analysis, in addition to citing scCustomize, please cite scuttle: +McCarthy DJ, Campbell KR, Lun ATL, Willis QF (2017). “Scater: pre-processing, quality control, +normalisation and visualisation of single-cell RNA-seq data in R.” Bioinformatics, 33, 1179-1186. +doi:10.1093/bioinformatics/btw777.

    +
    + + +
    +

    Examples

    +
    library(Seurat)
    +pbmc_small <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc_small, num_top_genes = 50)
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Barcode_Plot.html b/docs/reference/Barcode_Plot.html new file mode 100644 index 0000000000..a84a46f7bb --- /dev/null +++ b/docs/reference/Barcode_Plot.html @@ -0,0 +1,188 @@ + +Create Barcode Rank Plot — Barcode_Plot • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Plot UMI vs. Barcode Rank with inflection and knee. Requires input from DropletUtils package.

    +
    + +
    +
    Barcode_Plot(
    +  br_out,
    +  pt.size = 6,
    +  plot_title = "Barcode Ranks",
    +  raster_dpi = c(1024, 1024),
    +  plateau = NULL
    +)
    +
    + +
    +

    Arguments

    +
    br_out
    +

    DFrame output from barcodeRanks.

    + + +
    pt.size
    +

    point size for plotting, default is 6.

    + + +
    plot_title
    +

    Title for plot, default is "Barcode Ranks".

    + + +
    raster_dpi
    +

    Pixel resolution for rasterized plots, passed to geom_scattermore(). +Default is c(1024, 1024).

    + + +
    plateau
    +

    numerical value at which to add vertical line designating estimated +empty droplet plateau (default is NULL).

    + +
    +
    +

    Value

    + + +

    A ggplot object

    +
    + +
    +

    Examples

    +
    if (FALSE) {
    +mat <- Read10X_h5(filename = "raw_feature_bc_matrix.h5")
    +
    +br_results <- DropletUtils::barcodeRanks(mat)
    +
    +Barcode_Plot(br_out = br_results)
    +}
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Blank_Theme-1.png b/docs/reference/Blank_Theme-1.png index 886bf2abe3..32c5df352e 100644 Binary files a/docs/reference/Blank_Theme-1.png and b/docs/reference/Blank_Theme-1.png differ diff --git a/docs/reference/Blank_Theme.html b/docs/reference/Blank_Theme.html index 9495be696e..eb4d8ba773 100644 --- a/docs/reference/Blank_Theme.html +++ b/docs/reference/Blank_Theme.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Case_Check.html b/docs/reference/Case_Check.html index fb8e7b63ec..063c332b46 100644 --- a/docs/reference/Case_Check.html +++ b/docs/reference/Case_Check.html @@ -20,7 +20,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -119,7 +119,8 @@

    Check for alternate case features seurat_object, gene_list, case_check_msg = TRUE, - return_features = TRUE + return_features = TRUE, + assay = NULL ) @@ -141,6 +142,10 @@

    Arguments

    return_features

    logical. Whether to return vector of alternate case features. Default is TRUE.

    + +
    assay
    +

    Name of assay to pull feature names from. If NULL will use the result of DefaultAssay(seurat_object).

    +

    Value

    diff --git a/docs/reference/CellBender_Diff_Plot.html b/docs/reference/CellBender_Diff_Plot.html index f60b4444d3..2d7b9ad1a0 100644 --- a/docs/reference/CellBender_Diff_Plot.html +++ b/docs/reference/CellBender_Diff_Plot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    @@ -116,6 +116,7 @@

    Plot Number of Cells/Nuclei per Sample

    num_features = NULL, label = TRUE, num_labels = 20, + min_count_label = 1, repel = TRUE, custom_labels = NULL, plot_line = TRUE, @@ -159,6 +160,11 @@

    Arguments

    Number of features to label if label = TRUE, (default is 20).

    +
    min_count_label
    +

    Minimum number of raw counts per feature necessary to be included in +plot labels (default is 1)

    + +
    repel

    logical, whether to use geom_text_repel to create a nicely-repelled labels; this is slow when a lot of points are being plotted. If using repel, set xnudge and ynudge to 0, (Default is TRUE).

    diff --git a/docs/reference/CellBender_Feature_Diff.html b/docs/reference/CellBender_Feature_Diff.html index 5cf783c6d7..fb3b36a3bd 100644 --- a/docs/reference/CellBender_Feature_Diff.html +++ b/docs/reference/CellBender_Feature_Diff.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -112,7 +112,13 @@

    CellBender Feature Differences

    -
    CellBender_Feature_Diff(seurat_object, raw_assay, cell_bender_assay)
    +
    CellBender_Feature_Diff(
    +  seurat_object = NULL,
    +  raw_assay = NULL,
    +  cell_bender_assay = NULL,
    +  raw_mat = NULL,
    +  cell_bender_mat = NULL
    +)
    @@ -128,6 +134,14 @@

    Arguments

    cell_bender_assay

    Name of the assay containing the CellBender count data.

    + +
    raw_mat
    +

    Name of raw count matrix in environment if not using Seurat object.

    + + +
    cell_bender_mat
    +

    Name of CellBender count matrix in environment if not using Seurat object.

    +

    Value

    diff --git a/docs/reference/Cell_Highlight_Plot.html b/docs/reference/Cell_Highlight_Plot.html index 6dc0a99122..9143abb521 100644 --- a/docs/reference/Cell_Highlight_Plot.html +++ b/docs/reference/Cell_Highlight_Plot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    @@ -117,6 +117,7 @@

    Meta Highlight Plot

    background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -154,6 +155,11 @@

    Arguments

    Default is NULL.

    +
    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.

    + +
    raster

    Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.

    diff --git a/docs/reference/Change_Delim_All.html b/docs/reference/Change_Delim_All.html index 2c2bdf94f4..49e43213e4 100644 --- a/docs/reference/Change_Delim_All.html +++ b/docs/reference/Change_Delim_All.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Change_Delim_Prefix.html b/docs/reference/Change_Delim_Prefix.html index 61bb5ea962..783828aa3b 100644 --- a/docs/reference/Change_Delim_Prefix.html +++ b/docs/reference/Change_Delim_Prefix.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Change_Delim_Suffix.html b/docs/reference/Change_Delim_Suffix.html index 2b56f2b716..b7258cbf07 100644 --- a/docs/reference/Change_Delim_Suffix.html +++ b/docs/reference/Change_Delim_Suffix.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/CheckMatrix_scCustom.html b/docs/reference/CheckMatrix_scCustom.html index 4bed3bd14f..c8d2ff184d 100644 --- a/docs/reference/CheckMatrix_scCustom.html +++ b/docs/reference/CheckMatrix_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Cluster_Highlight_Plot.html b/docs/reference/Cluster_Highlight_Plot.html index 59696ec953..26bee22a5c 100644 --- a/docs/reference/Cluster_Highlight_Plot.html +++ b/docs/reference/Cluster_Highlight_Plot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -117,6 +117,7 @@

    Cluster Highlight Plot

    background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -155,6 +156,11 @@

    Arguments

    Default is NULL.

    +
    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.

    + +
    raster

    Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.

    diff --git a/docs/reference/Cluster_Stats_All_Samples.html b/docs/reference/Cluster_Stats_All_Samples.html index eb5b753cad..876d72df73 100644 --- a/docs/reference/Cluster_Stats_All_Samples.html +++ b/docs/reference/Cluster_Stats_All_Samples.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Clustered_DotPlot-1.png b/docs/reference/Clustered_DotPlot-1.png index de41176034..2a18fdec99 100644 Binary files a/docs/reference/Clustered_DotPlot-1.png and b/docs/reference/Clustered_DotPlot-1.png differ diff --git a/docs/reference/Clustered_DotPlot-2.png b/docs/reference/Clustered_DotPlot-2.png index 19705e6fad..11743bfcbb 100644 Binary files a/docs/reference/Clustered_DotPlot-2.png and b/docs/reference/Clustered_DotPlot-2.png differ diff --git a/docs/reference/Clustered_DotPlot-3.png b/docs/reference/Clustered_DotPlot-3.png index de41176034..2a18fdec99 100644 Binary files a/docs/reference/Clustered_DotPlot-3.png and b/docs/reference/Clustered_DotPlot-3.png differ diff --git a/docs/reference/Clustered_DotPlot.html b/docs/reference/Clustered_DotPlot.html index 1fda4e115e..9e538b6fef 100644 --- a/docs/reference/Clustered_DotPlot.html +++ b/docs/reference/Clustered_DotPlot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/ColorBlind_Pal.html b/docs/reference/ColorBlind_Pal.html index 35e720ad25..f49a9d0c3d 100644 --- a/docs/reference/ColorBlind_Pal.html +++ b/docs/reference/ColorBlind_Pal.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Copy_From_GCP.html b/docs/reference/Copy_From_GCP.html index 84850c3b50..429ab55409 100644 --- a/docs/reference/Copy_From_GCP.html +++ b/docs/reference/Copy_From_GCP.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Copy_To_GCP.html b/docs/reference/Copy_To_GCP.html index de1b18ae21..938da03d2a 100644 --- a/docs/reference/Copy_To_GCP.html +++ b/docs/reference/Copy_To_GCP.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Create_10X_H5.html b/docs/reference/Create_10X_H5.html index de5a353984..d7c97837ba 100644 --- a/docs/reference/Create_10X_H5.html +++ b/docs/reference/Create_10X_H5.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Create_CellBender_Merged_Seurat.html b/docs/reference/Create_CellBender_Merged_Seurat.html index 318ef69f48..62070c83b0 100644 --- a/docs/reference/Create_CellBender_Merged_Seurat.html +++ b/docs/reference/Create_CellBender_Merged_Seurat.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Create_Cluster_Annotation_File.html b/docs/reference/Create_Cluster_Annotation_File.html index 4f4d447857..11874e3a65 100644 --- a/docs/reference/Create_Cluster_Annotation_File.html +++ b/docs/reference/Create_Cluster_Annotation_File.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Dark2_Pal.html b/docs/reference/Dark2_Pal.html index 5d77d78e88..8551ee0d4e 100644 --- a/docs/reference/Dark2_Pal.html +++ b/docs/reference/Dark2_Pal.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/DimPlot_All_Samples.html b/docs/reference/DimPlot_All_Samples.html index 6ec249ec84..c7e621bda5 100644 --- a/docs/reference/DimPlot_All_Samples.html +++ b/docs/reference/DimPlot_All_Samples.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/DimPlot_LIGER.html b/docs/reference/DimPlot_LIGER.html index 608ac4798c..fb4158d96e 100644 --- a/docs/reference/DimPlot_LIGER.html +++ b/docs/reference/DimPlot_LIGER.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/DimPlot_scCustom-1.png b/docs/reference/DimPlot_scCustom-1.png index 68ac4ca57e..d62e83751f 100644 Binary files a/docs/reference/DimPlot_scCustom-1.png and b/docs/reference/DimPlot_scCustom-1.png differ diff --git a/docs/reference/DimPlot_scCustom.html b/docs/reference/DimPlot_scCustom.html index cea2274edb..07e504c77f 100644 --- a/docs/reference/DimPlot_scCustom.html +++ b/docs/reference/DimPlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/DiscretePalette_scCustomize.html b/docs/reference/DiscretePalette_scCustomize.html index 61940eb3e5..fe49464d3c 100644 --- a/docs/reference/DiscretePalette_scCustomize.html +++ b/docs/reference/DiscretePalette_scCustomize.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/DotPlot_scCustom-1.png b/docs/reference/DotPlot_scCustom-1.png index 90b67a0baf..f2b6153e2c 100644 Binary files a/docs/reference/DotPlot_scCustom-1.png and b/docs/reference/DotPlot_scCustom-1.png differ diff --git a/docs/reference/DotPlot_scCustom.html b/docs/reference/DotPlot_scCustom.html index 823ee3c9da..b7d8d56904 100644 --- a/docs/reference/DotPlot_scCustom.html +++ b/docs/reference/DotPlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -113,6 +113,7 @@

    Customized DotPlot

    DotPlot_scCustom(
       seurat_object,
       features,
    +  group.by = NULL,
       colors_use = viridis_plasma_dark_high,
       remove_axis_titles = TRUE,
       x_lab_rotate = FALSE,
    @@ -133,6 +134,11 @@ 

    Arguments

    Features to plot.

    +
    group.by
    +

    Name of one or more metadata columns to group (color) cells by (for example, orig.ident); +default is the current active.ident of the object.

    + +
    colors_use

    specify color palette to used. Default is viridis_plasma_dark_high.

    diff --git a/docs/reference/Extract_Modality.html b/docs/reference/Extract_Modality.html index bbf3d9c1a5..01005a42cc 100644 --- a/docs/reference/Extract_Modality.html +++ b/docs/reference/Extract_Modality.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Extract_Sample_Meta.html b/docs/reference/Extract_Sample_Meta.html index 66c390559f..dd5991fa0a 100644 --- a/docs/reference/Extract_Sample_Meta.html +++ b/docs/reference/Extract_Sample_Meta.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Extract_Top_Markers.html b/docs/reference/Extract_Top_Markers.html index a37886e0a0..5fe2b5b9fb 100644 --- a/docs/reference/Extract_Top_Markers.html +++ b/docs/reference/Extract_Top_Markers.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/FeaturePlot_DualAssay.html b/docs/reference/FeaturePlot_DualAssay.html index eed3aae6e3..16724e648c 100644 --- a/docs/reference/FeaturePlot_DualAssay.html +++ b/docs/reference/FeaturePlot_DualAssay.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -126,7 +126,8 @@

    Customize FeaturePlot of two assays

    na_cutoff = 1e-09, raster = NULL, raster.dpi = c(512, 512), - slot = "data", + slot = deprecated(), + layer = "data", num_columns = NULL, alpha_exp = NULL, alpha_na_exp = NULL, @@ -192,7 +193,11 @@

    Arguments

    slot
    -

    Which slot to pull expression data from? Default is "data".

    +

    [Deprecated] soft-deprecated. See layer

    + + +
    layer
    +

    Which layer to pull expression data from? Default is "data".

    num_columns
    diff --git a/docs/reference/FeaturePlot_scCustom.html b/docs/reference/FeaturePlot_scCustom.html index 95413e36d4..2089324860 100644 --- a/docs/reference/FeaturePlot_scCustom.html +++ b/docs/reference/FeaturePlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -124,8 +124,10 @@

    Customize FeaturePlot

    split.by = NULL, split_collect = NULL, aspect_ratio = NULL, + figure_plot = FALSE, num_columns = NULL, - slot = "data", + slot = deprecated(), + layer = "data", alpha_exp = NULL, alpha_na_exp = NULL, label = FALSE, @@ -195,12 +197,21 @@

    Arguments

    Default is NULL.

    +
    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.

    + +
    num_columns

    Number of columns in plot layout.

    slot
    -

    Which slot to pull expression data from? Default is "data".

    +

    [Deprecated] soft-deprecated. See layer

    + + +
    layer
    +

    Which layer to pull expression data from? Default is "data".

    alpha_exp
    diff --git a/docs/reference/FeatureScatter_scCustom-1.png b/docs/reference/FeatureScatter_scCustom-1.png new file mode 100644 index 0000000000..1d83a1b4b3 Binary files /dev/null and b/docs/reference/FeatureScatter_scCustom-1.png differ diff --git a/docs/reference/FeatureScatter_scCustom.html b/docs/reference/FeatureScatter_scCustom.html new file mode 100644 index 0000000000..f7273cb281 --- /dev/null +++ b/docs/reference/FeatureScatter_scCustom.html @@ -0,0 +1,265 @@ + +Modified version of FeatureScatter — FeatureScatter_scCustom • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Create customized FeatureScatter plots with scCustomize defaults.

    +
    + +
    +
    FeatureScatter_scCustom(
    +  seurat_object,
    +  feature1 = NULL,
    +  feature2 = NULL,
    +  colors_use = NULL,
    +  pt.size = NULL,
    +  group.by = NULL,
    +  split.by = NULL,
    +  split_seurat = FALSE,
    +  shuffle = TRUE,
    +  aspect_ratio = NULL,
    +  title_size = 15,
    +  plot.cor = TRUE,
    +  num_columns = NULL,
    +  raster = NULL,
    +  raster.dpi = c(512, 512),
    +  ggplot_default_colors = FALSE,
    +  color_seed = 123,
    +  ...
    +)
    +
    + +
    +

    Arguments

    +
    seurat_object
    +

    Seurat object name.

    + + +
    feature1
    +

    First feature to plot.

    + + +
    feature2
    +

    Second feature to plot.

    + + +
    colors_use
    +

    color for the points on plot.

    + + +
    pt.size
    +

    Adjust point size for plotting.

    + + +
    group.by
    +

    Name of one or more metadata columns to group (color) cells by (for example, orig.ident). +Default is active ident.

    + + +
    split.by
    +

    Feature to split plots by (i.e. "orig.ident").

    + + +
    split_seurat
    +

    logical. Whether or not to display split plots like Seurat (shared y axis) or as +individual plots in layout. Default is FALSE.

    + + +
    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.

    + + +
    aspect_ratio
    +

    Control the aspect ratio (y:x axes ratio length). Must be numeric value; +Default is NULL.

    + + +
    title_size
    +

    size for plot title labels. Does NOT apply if split_seurat = TRUE.

    + + +
    plot.cor
    +

    Display correlation in plot subtitle (or title if split_seurat = TRUE).

    + + +
    num_columns
    +

    number of columns in final layout plot.

    + + +
    raster
    +

    Convert points to raster format. Default is NULL which will rasterize by default if +greater than 200,000 cells.

    + + +
    raster.dpi
    +

    Pixel resolution for rasterized plots, passed to geom_scattermore(). +Default is c(512, 512).

    + + +
    ggplot_default_colors
    +

    logical. If colors_use = NULL, Whether or not to return plot using +default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes.

    + + +
    color_seed
    +

    random seed for the "varibow" palette shuffle if colors_use = NULL and number of +groups plotted is greater than 36. Default = 123.

    + + +
    ...
    +

    Extra parameters passed to FeatureScatter.

    + +
    +
    +

    Value

    + + +

    A ggplot object

    +
    + +
    +

    Examples

    +
    # \donttest{
    +library(Seurat)
    +pbmc_small$sample_id <- sample(c("sample1", "sample2"), size = ncol(pbmc_small), replace = TRUE)
    +
    +FeatureScatter_scCustom(seurat_object = pbmc_small, feature1 = "nCount_RNA",
    +feature2 = "nFeature_RNA", split.by = "sample_id")
    +#> 
    +#> NOTE: FeatureScatter_scCustom returns split plots as layout of all plots each
    +#> with their own axes as opposed to Seurat which returns with shared x or y axis.
    +#> To return to Seurat behvaior set `split_seurat = TRUE`.
    +#> 
    +#> -----This message will be shown once per session.-----
    +
    +# }
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Fetch_Meta.html b/docs/reference/Fetch_Meta.html index be3623f3eb..d980acb0b2 100644 --- a/docs/reference/Fetch_Meta.html +++ b/docs/reference/Fetch_Meta.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Gene_Present.html b/docs/reference/Gene_Present.html index 52c1909c08..381948fb33 100644 --- a/docs/reference/Gene_Present.html +++ b/docs/reference/Gene_Present.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Hue_Pal.html b/docs/reference/Hue_Pal.html index 96fadc939b..272b1887e3 100644 --- a/docs/reference/Hue_Pal.html +++ b/docs/reference/Hue_Pal.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Iterate_Barcode_Rank_Plot.html b/docs/reference/Iterate_Barcode_Rank_Plot.html new file mode 100644 index 0000000000..70da6d4a73 --- /dev/null +++ b/docs/reference/Iterate_Barcode_Rank_Plot.html @@ -0,0 +1,225 @@ + +Iterative Barcode Rank Plots — Iterate_Barcode_Rank_Plot • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Read data, calculate DropletUtils::barcodeRanks, create barcode rank plots, and outout single PDF output.

    +
    + +
    +
    Iterate_Barcode_Rank_Plot(
    +  dir_path_h5,
    +  multi_directory = TRUE,
    +  h5_filename = "raw_feature_bc_matrix.h5",
    +  cellranger_multi = FALSE,
    +  parallel = FALSE,
    +  num_cores = NULL,
    +  file_path = NULL,
    +  file_name = NULL,
    +  pt.size = 6,
    +  raster_dpi = c(1024, 1024),
    +  plateau = NULL,
    +  ...
    +)
    +
    + +
    +

    Arguments

    +
    dir_path_h5
    +

    path to parent directory (if multi_directory = TRUE) or directory containing +all h5 files (if multi_directory = FALSE).

    + + +
    multi_directory
    +

    logical, whether or not all h5 files are in their own subdirectories or in a +single directory (default is TRUE; each in own subdirectory (e.g. output from Cell Ranger)).

    + + +
    h5_filename
    +

    Either the file name of h5 file (if multi_directory = TRUE) or the shared +suffix (if multi_directory = FALSE)

    + + +
    cellranger_multi
    +

    logical, whether the outputs to be read are from Cell Ranger multi as opposed +to Cell Ranger count (default is FALSE). Only valid if multi_directory = FALSE.

    + + +
    parallel
    +

    logical, should files be read in parallel (default is FALSE).

    + + +
    num_cores
    +

    Number of cores to use in parallel if parallel = TRUE.

    + + +
    file_path
    +

    file path to use for saving PDF output.

    + + +
    file_name
    +

    Name of PDF output file.

    + + +
    pt.size
    +

    point size for plotting, default is 6.

    + + +
    raster_dpi
    +

    Pixel resolution for rasterized plots, passed to geom_scattermore(). +Default is c(1024, 1024).

    + + +
    plateau
    +

    numerical values at which to add vertical line designating estimated +empty droplet plateau (default is NULL). Must be vector equal in length to number of samples.

    + + +
    ...
    +

    Additional parameters passed to Read10X_h5_Multi_Directory or Read10X_h5_GEO.

    + +
    +
    +

    Value

    + + +

    pdf document

    +
    + +
    +

    Examples

    +
    if (FALSE) {
    +Iterate_Barcode_Rank_Plot(dir_path_h5 = "H5_PATH/", multi_directory = TRUE,
    +h5_filename = "raw_feature_bc_matrix", parallel = TRUE, num_cores = 12, file_path = "OUTPUT_PATH",
    +file_name = "Barcode_Rank_Plots")
    +}
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Iterate_Cluster_Highlight_Plot.html b/docs/reference/Iterate_Cluster_Highlight_Plot.html index 0bf0c4ad87..4e95aa721f 100644 --- a/docs/reference/Iterate_Cluster_Highlight_Plot.html +++ b/docs/reference/Iterate_Cluster_Highlight_Plot.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Iterate_DimPlot_bySample.html b/docs/reference/Iterate_DimPlot_bySample.html index c9ff7a7eb1..7a6469cb0c 100644 --- a/docs/reference/Iterate_DimPlot_bySample.html +++ b/docs/reference/Iterate_DimPlot_bySample.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -112,6 +112,7 @@

    Iterate DimPlot By Sample

    Iterate_DimPlot_bySample(
       seurat_object,
    +  sample_column = "orig.ident",
       file_path = NULL,
       file_name = NULL,
       file_type = NULL,
    @@ -132,6 +133,10 @@ 

    Arguments

    Seurat object name.

    +
    sample_column
    +

    name of meta.data column containing sample names/ids (default is "orig.ident").

    + +
    file_path

    directory file path and/or file name prefix. Defaults to current wd.

    diff --git a/docs/reference/Iterate_FeaturePlot_scCustom.html b/docs/reference/Iterate_FeaturePlot_scCustom.html index 9c89f201d8..853f3e0e84 100644 --- a/docs/reference/Iterate_FeaturePlot_scCustom.html +++ b/docs/reference/Iterate_FeaturePlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    @@ -112,7 +112,8 @@

    Iterative Plotting of Gene Lists using Custom FeaturePlots

    Iterate_FeaturePlot_scCustom(
       seurat_object,
    -  gene_list,
    +  features,
    +  gene_list = deprecated(),
       colors_use = viridis_plasma_dark_high,
       na_color = "lightgray",
       na_cutoff = 1e-09,
    @@ -139,11 +140,15 @@ 

    Arguments

    Seurat object name.

    -
    gene_list
    -

    vector of genes to plot. If a named vector is provided then the names for each gene +

    features
    +

    vector of features to plot. If a named vector is provided then the names for each gene will be incorporated into plot title if single_pdf = TRUE or into file name if FALSE.

    +
    gene_list
    +

    [Deprecated] soft-deprecated. See features.

    + +
    colors_use

    color scheme to use.

    diff --git a/docs/reference/Iterate_Meta_Highlight_Plot.html b/docs/reference/Iterate_Meta_Highlight_Plot.html index 0ce5138d5a..de60f95e2c 100644 --- a/docs/reference/Iterate_Meta_Highlight_Plot.html +++ b/docs/reference/Iterate_Meta_Highlight_Plot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Iterate_PC_Loading_Plots.html b/docs/reference/Iterate_PC_Loading_Plots.html index cc3874cb0e..0e1c8f390f 100644 --- a/docs/reference/Iterate_PC_Loading_Plots.html +++ b/docs/reference/Iterate_PC_Loading_Plots.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Iterate_Plot_Density_Custom.html b/docs/reference/Iterate_Plot_Density_Custom.html index e5b1d80b49..bd437cb442 100644 --- a/docs/reference/Iterate_Plot_Density_Custom.html +++ b/docs/reference/Iterate_Plot_Density_Custom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Iterate_Plot_Density_Joint.html b/docs/reference/Iterate_Plot_Density_Joint.html index 872f7ba6a7..fd37f7cdda 100644 --- a/docs/reference/Iterate_Plot_Density_Joint.html +++ b/docs/reference/Iterate_Plot_Density_Joint.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Iterate_VlnPlot_scCustom.html b/docs/reference/Iterate_VlnPlot_scCustom.html index e876ed8df5..c1041c8de4 100644 --- a/docs/reference/Iterate_VlnPlot_scCustom.html +++ b/docs/reference/Iterate_VlnPlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -112,7 +112,8 @@

    Iterative Plotting of Gene Lists using VlnPlot_scCustom

    Iterate_VlnPlot_scCustom(
       seurat_object,
    -  gene_list,
    +  features,
    +  gene_list = deprecated(),
       colors_use = NULL,
       pt.size = NULL,
       group.by = NULL,
    @@ -135,8 +136,12 @@ 

    Arguments

    Seurat object name.

    +
    features
    +

    vector of features to plot.

    + +
    gene_list
    -

    list of genes to plot.

    +

    [Deprecated] soft-deprecated. See features.

    colors_use
    diff --git a/docs/reference/JCO_Four.html b/docs/reference/JCO_Four.html index fbef43b2f2..27e88db8f4 100644 --- a/docs/reference/JCO_Four.html +++ b/docs/reference/JCO_Four.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Liger_to_Seurat.html b/docs/reference/Liger_to_Seurat.html index 2526ed8dc2..43ae0fa3ed 100644 --- a/docs/reference/Liger_to_Seurat.html +++ b/docs/reference/Liger_to_Seurat.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    @@ -119,7 +119,7 @@

    Create a Seurat object containing the data from a liger object

    use.liger.genes = TRUE, by.dataset = FALSE, keep_meta = TRUE, - reduction_label = NULL, + reduction_label = "UMAP", seurat_assay = "RNA" )
    diff --git a/docs/reference/MAD_Stats.html b/docs/reference/MAD_Stats.html new file mode 100644 index 0000000000..71645d679d --- /dev/null +++ b/docs/reference/MAD_Stats.html @@ -0,0 +1,186 @@ + +Median Absolute Deviation Statistics — MAD_Stats • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Get quick values for X x median absolute deviation for Genes, UMIs, %mito per cell grouped by meta.data variable.

    +
    + +
    +
    MAD_Stats(
    +  seurat_object,
    +  group_by_var = "orig.ident",
    +  default_var = TRUE,
    +  mad_var = NULL,
    +  mad_num = 2
    +)
    +
    + +
    +

    Arguments

    +
    seurat_object
    +

    Seurat object name.

    + + +
    group_by_var
    +

    Column in meta.data slot to group results by (default = "orig.ident").

    + + +
    default_var
    +

    logical. Whether to include the default meta.data variables of: "nCount_RNA", +"nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", and "log10GenesPerUMI" +in addition to variables supplied to mad_var.

    + + +
    mad_var
    +

    Column(s) in @meta.data to calculate medians for in addition to defaults. +Must be of class() integer or numeric.

    + + +
    mad_num
    +

    integer value to multiply the MAD in returned data.frame (default is 2). +Often helpful when calculating a outlier range to base of of median + (X*MAD).

    + +
    +
    +

    Value

    + + +

    A data.frame.

    +
    + +
    +

    Examples

    +
    if (FALSE) {
    +mad_stats <- MAD_Stats(seurat_object = obj, group_by_var = "orig.ident")
    +}
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/Median_Stats.html b/docs/reference/Median_Stats.html index 2a6ecfe762..d071641ff1 100644 --- a/docs/reference/Median_Stats.html +++ b/docs/reference/Median_Stats.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -130,7 +130,8 @@

    Arguments

    default_var

    logical. Whether to include the default meta.data variables of: "nCount_RNA", -"nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo" in addition to variables supplied to median_var.

    +"nFeature_RNA", "percent_mito", "percent_ribo", "percent_mito_ribo", and "log10GenesPerUMI" +in addition to variables supplied to median_var.

    median_var
    diff --git a/docs/reference/Merge_Seurat_List.html b/docs/reference/Merge_Seurat_List.html index f8c93eac5f..b2172d4065 100644 --- a/docs/reference/Merge_Seurat_List.html +++ b/docs/reference/Merge_Seurat_List.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -101,12 +101,12 @@
    -

    Enables easy merge of a list of Seurat Objects. See See merge for more information,

    +

    Enables easy merge of a list of Seurat Objects. See See merge for more information,

    @@ -126,17 +126,17 @@

    Arguments

    add.cell.ids

    A character vector of equal length to the number of objects in list_seurat. -Appends the corresponding values to the start of each objects' cell names. See merge.

    +Appends the corresponding values to the start of each objects' cell names. See merge.

    merge.data

    Merge the data slots instead of just merging the counts (which requires renormalization). This is recommended if the same normalization approach was applied to all objects. -See merge.

    +See merge.

    project
    -

    Project name for the Seurat object. See merge.

    +

    Project name for the Seurat object. See merge.

    diff --git a/docs/reference/Merge_Sparse_Data_All.html b/docs/reference/Merge_Sparse_Data_All.html index e1ed3278ed..758ca6ecf2 100644 --- a/docs/reference/Merge_Sparse_Data_All.html +++ b/docs/reference/Merge_Sparse_Data_All.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Merge_Sparse_Multimodal_All.html b/docs/reference/Merge_Sparse_Multimodal_All.html index 8ded21b661..6803b655df 100644 --- a/docs/reference/Merge_Sparse_Multimodal_All.html +++ b/docs/reference/Merge_Sparse_Multimodal_All.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Meta_Highlight_Plot-1.png b/docs/reference/Meta_Highlight_Plot-1.png index 92ef54f861..fb485f46e8 100644 Binary files a/docs/reference/Meta_Highlight_Plot-1.png and b/docs/reference/Meta_Highlight_Plot-1.png differ diff --git a/docs/reference/Meta_Highlight_Plot.html b/docs/reference/Meta_Highlight_Plot.html index 28f1114c2e..bf4dcf7a40 100644 --- a/docs/reference/Meta_Highlight_Plot.html +++ b/docs/reference/Meta_Highlight_Plot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -118,6 +118,7 @@

    Meta Highlight Plot

    background_color = "lightgray", pt.size = NULL, aspect_ratio = NULL, + figure_plot = FALSE, raster = NULL, raster.dpi = c(512, 512), label = FALSE, @@ -159,6 +160,11 @@

    Arguments

    Default is NULL.

    +
    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.

    + +
    raster

    Convert points to raster format. Default is NULL which will rasterize by default if greater than 200,000 cells.

    diff --git a/docs/reference/Meta_Numeric.html b/docs/reference/Meta_Numeric.html index 6ece25bce7..c0f00fc8d5 100644 --- a/docs/reference/Meta_Numeric.html +++ b/docs/reference/Meta_Numeric.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Meta_Present.html b/docs/reference/Meta_Present.html index 72223a6ea8..3678cd2fd4 100644 --- a/docs/reference/Meta_Present.html +++ b/docs/reference/Meta_Present.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Meta_Present_LIGER.html b/docs/reference/Meta_Present_LIGER.html index 140dd72644..7fa51d3466 100644 --- a/docs/reference/Meta_Present_LIGER.html +++ b/docs/reference/Meta_Present_LIGER.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Meta_Remove_Seurat.html b/docs/reference/Meta_Remove_Seurat.html index 8a6e424f33..fb5f462930 100644 --- a/docs/reference/Meta_Remove_Seurat.html +++ b/docs/reference/Meta_Remove_Seurat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Move_Legend.html b/docs/reference/Move_Legend.html index 7913366a84..57f64bc254 100644 --- a/docs/reference/Move_Legend.html +++ b/docs/reference/Move_Legend.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/NavyAndOrange.html b/docs/reference/NavyAndOrange.html index d66f424bf9..664f4ab1a3 100644 --- a/docs/reference/NavyAndOrange.html +++ b/docs/reference/NavyAndOrange.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/PC_Plotting.html b/docs/reference/PC_Plotting.html index 4da9ccf959..df92d184a0 100644 --- a/docs/reference/PC_Plotting.html +++ b/docs/reference/PC_Plotting.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/PalettePlot.html b/docs/reference/PalettePlot.html index 9910f4ed9a..b77f3a867e 100644 --- a/docs/reference/PalettePlot.html +++ b/docs/reference/PalettePlot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Percent_Expressing.html b/docs/reference/Percent_Expressing.html index 7bfb4f5376..bd8f40dad8 100644 --- a/docs/reference/Percent_Expressing.html +++ b/docs/reference/Percent_Expressing.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -117,7 +117,8 @@

    Calculate percent of expressing cells

    group_by = NULL, split_by = NULL, entire_object = FALSE, - slot = "data", + slot = deprecated(), + layer = "data", assay = NULL )
    @@ -150,7 +151,11 @@

    Arguments

    slot
    -

    Slot to pull feature data for. Default is "data".

    +

    [Deprecated] soft-deprecated. See layer

    + + +
    layer
    +

    Which layer to pull expression data from? Default is "data".

    assay
    diff --git a/docs/reference/Plot_Cells_per_Sample.html b/docs/reference/Plot_Cells_per_Sample.html index 859a7130c0..8254480b24 100644 --- a/docs/reference/Plot_Cells_per_Sample.html +++ b/docs/reference/Plot_Cells_per_Sample.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Density_Custom.html b/docs/reference/Plot_Density_Custom.html index 06ebd23a66..2458b6e638 100644 --- a/docs/reference/Plot_Density_Custom.html +++ b/docs/reference/Plot_Density_Custom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Density_Joint_Only.html b/docs/reference/Plot_Density_Joint_Only.html index 7fb9b75717..30b94d475f 100644 --- a/docs/reference/Plot_Density_Joint_Only.html +++ b/docs/reference/Plot_Density_Joint_Only.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Median_Genes.html b/docs/reference/Plot_Median_Genes.html index 58cf7215a5..78c0ea23ee 100644 --- a/docs/reference/Plot_Median_Genes.html +++ b/docs/reference/Plot_Median_Genes.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Median_Mito.html b/docs/reference/Plot_Median_Mito.html index 872f5da571..77ce870e8f 100644 --- a/docs/reference/Plot_Median_Mito.html +++ b/docs/reference/Plot_Median_Mito.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Median_Other.html b/docs/reference/Plot_Median_Other.html index 8452daec14..3efd8dddf9 100644 --- a/docs/reference/Plot_Median_Other.html +++ b/docs/reference/Plot_Median_Other.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Plot_Median_UMIs.html b/docs/reference/Plot_Median_UMIs.html index 3a25b314ba..7ca6a378fb 100644 --- a/docs/reference/Plot_Median_UMIs.html +++ b/docs/reference/Plot_Median_UMIs.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Pull_Cluster_Annotation.html b/docs/reference/Pull_Cluster_Annotation.html index 911d17ab5b..ed9abe3f3b 100644 --- a/docs/reference/Pull_Cluster_Annotation.html +++ b/docs/reference/Pull_Cluster_Annotation.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Pull_Directory_List.html b/docs/reference/Pull_Directory_List.html index 992c0586d3..53f44dc3bf 100644 --- a/docs/reference/Pull_Directory_List.html +++ b/docs/reference/Pull_Directory_List.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/QC_Histogram.html b/docs/reference/QC_Histogram.html new file mode 100644 index 0000000000..1763fea0a5 --- /dev/null +++ b/docs/reference/QC_Histogram.html @@ -0,0 +1,214 @@ + +QC Histogram Plots — QC_Histogram • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Custom histogram for initial QC checks including lines for thresholding

    +
    + +
    +
    QC_Histogram(
    +  seurat_object,
    +  features,
    +  low_cutoff = NULL,
    +  high_cutoff = NULL,
    +  split.by = NULL,
    +  bins = 250,
    +  colors_use = "dodgerblue",
    +  num_columns = NULL,
    +  plot_title = NULL,
    +  assay = NULL,
    +  print_defaults = FALSE
    +)
    +
    + +
    +

    Arguments

    +
    seurat_object
    +

    Seurat object name.

    + + +
    features
    +

    Feature from meta.data, assay features, or feature name shortcut to plot.

    + + +
    low_cutoff
    +

    Plot line a potential low threshold for filtering.

    + + +
    high_cutoff
    +

    Plot line a potential high threshold for filtering.

    + + +
    split.by
    +

    Feature to split plots by (i.e. "orig.ident").

    + + +
    bins
    +

    number of bins to plot default is 250.

    + + +
    colors_use
    +

    color to fill histogram bars, default is "dodgerblue".

    + + +
    num_columns
    +

    Number of columns in plot layout.

    + + +
    plot_title
    +

    optional, vector to use for plot title. Default is the name of the +variable being plotted.

    + + +
    assay
    +

    assay to pull features from, default is active assay.

    + + +
    print_defaults
    +

    return list of accepted default shortcuts to provide to features instead +of full name.

    + +
    +
    +

    Value

    + + +

    A patchwork object

    +
    + +
    +

    Examples

    +
    if (FALSE) {
    +QC_Histogram(seurat_object = object, features = "nFeature_RNA")
    +}
    +
    +
    +
    +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/QC_Plot_GenevsFeature.html b/docs/reference/QC_Plot_GenevsFeature.html index dc69f45bdd..fb66144d40 100644 --- a/docs/reference/QC_Plot_GenevsFeature.html +++ b/docs/reference/QC_Plot_GenevsFeature.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/QC_Plot_UMIvsFeature.html b/docs/reference/QC_Plot_UMIvsFeature.html index d2641524aa..671863e2c7 100644 --- a/docs/reference/QC_Plot_UMIvsFeature.html +++ b/docs/reference/QC_Plot_UMIvsFeature.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/QC_Plot_UMIvsGene.html b/docs/reference/QC_Plot_UMIvsGene.html index 0a46476d29..693d4a503e 100644 --- a/docs/reference/QC_Plot_UMIvsGene.html +++ b/docs/reference/QC_Plot_UMIvsGene.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -125,6 +125,7 @@

    QC Plots Genes vs UMIs

    meta_gradient_low_cutoff = NULL, cells = NULL, combination = FALSE, + ident_legend = TRUE, pt.size = 1, group.by = NULL, raster = NULL, @@ -199,6 +200,11 @@

    Arguments

    plot colored by identity and the meta data gradient plot.

    +
    ident_legend
    +

    logical, whether to plot the legend containing identities (left plot) when +combination = TRUE. Default is TRUE.

    + +
    pt.size

    Passes size of points to both FeatureScatter and geom_point.

    diff --git a/docs/reference/QC_Plots_Combined_Vln.html b/docs/reference/QC_Plots_Combined_Vln.html index 3eb6fa862a..8d11045aea 100644 --- a/docs/reference/QC_Plots_Combined_Vln.html +++ b/docs/reference/QC_Plots_Combined_Vln.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -120,6 +120,7 @@

    QC Plots Genes, UMIs, & % Mito

    pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -170,6 +171,10 @@

    Arguments

    Shape size for the median is plotted.

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    colors_use

    vector of colors to use for plot.

    diff --git a/docs/reference/QC_Plots_Complexity-1.png b/docs/reference/QC_Plots_Complexity-1.png index 657d3e9506..5cfa83e8da 100644 Binary files a/docs/reference/QC_Plots_Complexity-1.png and b/docs/reference/QC_Plots_Complexity-1.png differ diff --git a/docs/reference/QC_Plots_Complexity.html b/docs/reference/QC_Plots_Complexity.html index 480ab41ef9..da4a45e18c 100644 --- a/docs/reference/QC_Plots_Complexity.html +++ b/docs/reference/QC_Plots_Complexity.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -121,6 +121,7 @@

    QC Plots Cell "Complexity"

    high_cutoff = NULL, pt.size = NULL, plot_median = FALSE, + plot_boxplot = FALSE, median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, @@ -175,6 +176,10 @@

    Arguments

    logical, whether to plot median for each ident on the plot (Default is FALSE).

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    median_size

    Shape size for the median is plotted.

    diff --git a/docs/reference/QC_Plots_Feature.html b/docs/reference/QC_Plots_Feature.html index 6be4411955..2433d94972 100644 --- a/docs/reference/QC_Plots_Feature.html +++ b/docs/reference/QC_Plots_Feature.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -122,6 +122,7 @@

    QC Plots Feature

    pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -179,6 +180,10 @@

    Arguments

    Shape size for the median is plotted.

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    colors_use

    vector of colors to use for plot.

    diff --git a/docs/reference/QC_Plots_Genes-1.png b/docs/reference/QC_Plots_Genes-1.png index 456a3df624..e4ffe61125 100644 Binary files a/docs/reference/QC_Plots_Genes-1.png and b/docs/reference/QC_Plots_Genes-1.png differ diff --git a/docs/reference/QC_Plots_Genes.html b/docs/reference/QC_Plots_Genes.html index e01a9e83aa..9e9516da41 100644 --- a/docs/reference/QC_Plots_Genes.html +++ b/docs/reference/QC_Plots_Genes.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -120,6 +120,7 @@

    QC Plots Genes

    high_cutoff = NULL, pt.size = NULL, plot_median = FALSE, + plot_boxplot = FALSE, median_size = 15, colors_use = NULL, x_lab_rotate = TRUE, @@ -170,6 +171,10 @@

    Arguments

    logical, whether to plot median for each ident on the plot (Default is FALSE).

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    median_size

    Shape size for the median is plotted.

    diff --git a/docs/reference/QC_Plots_Mito.html b/docs/reference/QC_Plots_Mito.html index 12be24097a..bbf25edb9b 100644 --- a/docs/reference/QC_Plots_Mito.html +++ b/docs/reference/QC_Plots_Mito.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -122,6 +122,7 @@

    QC Plots Mito

    pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -180,6 +181,10 @@

    Arguments

    Shape size for the median is plotted.

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    colors_use

    vector of colors to use for plot.

    diff --git a/docs/reference/QC_Plots_UMIs-1.png b/docs/reference/QC_Plots_UMIs-1.png index ebc7928464..f58040af96 100644 Binary files a/docs/reference/QC_Plots_UMIs-1.png and b/docs/reference/QC_Plots_UMIs-1.png differ diff --git a/docs/reference/QC_Plots_UMIs.html b/docs/reference/QC_Plots_UMIs.html index a327ce3e7d..b8d8ee1385 100644 --- a/docs/reference/QC_Plots_UMIs.html +++ b/docs/reference/QC_Plots_UMIs.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -121,6 +121,7 @@

    QC Plots UMIs

    pt.size = NULL, plot_median = FALSE, median_size = 15, + plot_boxplot = FALSE, colors_use = NULL, x_lab_rotate = TRUE, y_axis_log = FALSE, @@ -174,6 +175,10 @@

    Arguments

    Shape size for the median is plotted.

    +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + +
    colors_use

    vector of colors to use for plot.

    diff --git a/docs/reference/Read10X_GEO.html b/docs/reference/Read10X_GEO.html index 7326502bb7..f65050df92 100644 --- a/docs/reference/Read10X_GEO.html +++ b/docs/reference/Read10X_GEO.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read10X_Multi_Directory.html b/docs/reference/Read10X_Multi_Directory.html index 714b404011..79db4ad596 100644 --- a/docs/reference/Read10X_Multi_Directory.html +++ b/docs/reference/Read10X_Multi_Directory.html @@ -19,7 +19,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read10X_h5_GEO.html b/docs/reference/Read10X_h5_GEO.html index 7558e34419..aab30531a0 100644 --- a/docs/reference/Read10X_h5_GEO.html +++ b/docs/reference/Read10X_h5_GEO.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read10X_h5_Multi_Directory.html b/docs/reference/Read10X_h5_Multi_Directory.html index 88b42827ad..716b113d8d 100644 --- a/docs/reference/Read10X_h5_Multi_Directory.html +++ b/docs/reference/Read10X_h5_Multi_Directory.html @@ -19,7 +19,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read_CellBender_h5_Mat.html b/docs/reference/Read_CellBender_h5_Mat.html index cd2d817a11..0a6374f326 100644 --- a/docs/reference/Read_CellBender_h5_Mat.html +++ b/docs/reference/Read_CellBender_h5_Mat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read_CellBender_h5_Multi_Directory.html b/docs/reference/Read_CellBender_h5_Multi_Directory.html index bf84141063..8abd16f060 100644 --- a/docs/reference/Read_CellBender_h5_Multi_Directory.html +++ b/docs/reference/Read_CellBender_h5_Multi_Directory.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read_CellBender_h5_Multi_File.html b/docs/reference/Read_CellBender_h5_Multi_File.html index 674cc614ce..fce2f642be 100644 --- a/docs/reference/Read_CellBender_h5_Multi_File.html +++ b/docs/reference/Read_CellBender_h5_Multi_File.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read_GEO_Delim.html b/docs/reference/Read_GEO_Delim.html index f033174e20..126c4992fe 100644 --- a/docs/reference/Read_GEO_Delim.html +++ b/docs/reference/Read_GEO_Delim.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Read_Metrics_10X.html b/docs/reference/Read_Metrics_10X.html index 9f10397a1c..6eaab2e54f 100644 --- a/docs/reference/Read_Metrics_10X.html +++ b/docs/reference/Read_Metrics_10X.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    Read Overall Statistics from 10X Cell Ranger Count

    base_path, secondary_path = NULL, default_10X = TRUE, + cellranger_multi = FALSE, lib_list = NULL, lib_names = NULL )
    @@ -134,6 +135,10 @@

    Arguments

    logical (default TRUE) sets the secondary path variable to the default 10X directory structure.

    +
    cellranger_multi
    +

    logical, whether or not metrics come from Cell Ranger count or from Cell Ranger multi. Default is FALSE.

    + +
    lib_list

    a list of sample names (matching directory names) to import. If NULL will read in all samples in parent directory.

    diff --git a/docs/reference/Reduction_Loading_Present.html b/docs/reference/Reduction_Loading_Present.html index 20881651a2..85d10c550d 100644 --- a/docs/reference/Reduction_Loading_Present.html +++ b/docs/reference/Reduction_Loading_Present.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Rename_Clusters.html b/docs/reference/Rename_Clusters.html index f63f964b84..b0276b775d 100644 --- a/docs/reference/Rename_Clusters.html +++ b/docs/reference/Rename_Clusters.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Replace_Suffix.html b/docs/reference/Replace_Suffix.html index 74b2252770..4ee69c15aa 100644 --- a/docs/reference/Replace_Suffix.html +++ b/docs/reference/Replace_Suffix.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png index 755c64a9bf..a6513c5207 100644 Binary files a/docs/reference/Rplot002.png and b/docs/reference/Rplot002.png differ diff --git a/docs/reference/Rplot003.png b/docs/reference/Rplot003.png index a9dc2ed3ac..2ffbdf1298 100644 Binary files a/docs/reference/Rplot003.png and b/docs/reference/Rplot003.png differ diff --git a/docs/reference/Seq_QC_Plot_Alignment_Combined.html b/docs/reference/Seq_QC_Plot_Alignment_Combined.html index 872f489391..79cd938dd5 100644 --- a/docs/reference/Seq_QC_Plot_Alignment_Combined.html +++ b/docs/reference/Seq_QC_Plot_Alignment_Combined.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment) (Layout)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, patchwork_title = "Sequencing QC Plots: Read Alignment Metrics", significance = FALSE, @@ -136,6 +137,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Antisense.html b/docs/reference/Seq_QC_Plot_Antisense.html index d1fab05844..c08d5712e5 100644 --- a/docs/reference/Seq_QC_Plot_Antisense.html +++ b/docs/reference/Seq_QC_Plot_Antisense.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Basic_Combined.html b/docs/reference/Seq_QC_Plot_Basic_Combined.html index 8a5b95ac0c..28ec628dfc 100644 --- a/docs/reference/Seq_QC_Plot_Basic_Combined.html +++ b/docs/reference/Seq_QC_Plot_Basic_Combined.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Layout)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, patchwork_title = "Sequencing QC Plots: Basic Cell Metrics", significance = FALSE, @@ -136,6 +137,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Exonic.html b/docs/reference/Seq_QC_Plot_Exonic.html index 0018f2f462..5a43b6a61d 100644 --- a/docs/reference/Seq_QC_Plot_Exonic.html +++ b/docs/reference/Seq_QC_Plot_Exonic.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Genes.html b/docs/reference/Seq_QC_Plot_Genes.html index b01aa2b91f..a06449e9a9 100644 --- a/docs/reference/Seq_QC_Plot_Genes.html +++ b/docs/reference/Seq_QC_Plot_Genes.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Genome.html b/docs/reference/Seq_QC_Plot_Genome.html index 05a81555dc..9eccf4fcac 100644 --- a/docs/reference/Seq_QC_Plot_Genome.html +++ b/docs/reference/Seq_QC_Plot_Genome.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Intergenic.html b/docs/reference/Seq_QC_Plot_Intergenic.html index cd8d57462d..e92207c431 100644 --- a/docs/reference/Seq_QC_Plot_Intergenic.html +++ b/docs/reference/Seq_QC_Plot_Intergenic.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Intronic.html b/docs/reference/Seq_QC_Plot_Intronic.html index 9b7d38425c..d8f033130a 100644 --- a/docs/reference/Seq_QC_Plot_Intronic.html +++ b/docs/reference/Seq_QC_Plot_Intronic.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Number_Cells.html b/docs/reference/Seq_QC_Plot_Number_Cells.html index 53166f4351..04a6366ca2 100644 --- a/docs/reference/Seq_QC_Plot_Number_Cells.html +++ b/docs/reference/Seq_QC_Plot_Number_Cells.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Reads_in_Cells.html b/docs/reference/Seq_QC_Plot_Reads_in_Cells.html index f8645b8620..af4a9b95bb 100644 --- a/docs/reference/Seq_QC_Plot_Reads_in_Cells.html +++ b/docs/reference/Seq_QC_Plot_Reads_in_Cells.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Reads_per_Cell.html b/docs/reference/Seq_QC_Plot_Reads_per_Cell.html index ddbce5e9a0..f7e02a473c 100644 --- a/docs/reference/Seq_QC_Plot_Reads_per_Cell.html +++ b/docs/reference/Seq_QC_Plot_Reads_per_Cell.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Saturation.html b/docs/reference/Seq_QC_Plot_Saturation.html index 728a546c57..6fb0b91a8a 100644 --- a/docs/reference/Seq_QC_Plot_Saturation.html +++ b/docs/reference/Seq_QC_Plot_Saturation.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Total_Genes.html b/docs/reference/Seq_QC_Plot_Total_Genes.html index bb4cc4f280..636a4fd011 100644 --- a/docs/reference/Seq_QC_Plot_Total_Genes.html +++ b/docs/reference/Seq_QC_Plot_Total_Genes.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_Transcriptome.html b/docs/reference/Seq_QC_Plot_Transcriptome.html index d5146d57d0..12f983161d 100644 --- a/docs/reference/Seq_QC_Plot_Transcriptome.html +++ b/docs/reference/Seq_QC_Plot_Transcriptome.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics (Alignment)

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Seq_QC_Plot_UMIs.html b/docs/reference/Seq_QC_Plot_UMIs.html index 81584472d6..0fbc656e4d 100644 --- a/docs/reference/Seq_QC_Plot_UMIs.html +++ b/docs/reference/Seq_QC_Plot_UMIs.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -114,6 +114,7 @@

    QC Plots Sequencing metrics

    metrics_dataframe, plot_by = "sample_id", colors_use = NULL, + dot_size = 1, x_lab_rotate = FALSE, significance = FALSE, ... @@ -135,6 +136,10 @@

    Arguments

    less than 8 groups and DiscretePalette_scCustomize(palette = "polychrome") if more than 8.

    +
    dot_size
    +

    size of the dots plotted if plot_by is not sample_id Default is 1.

    + +
    x_lab_rotate

    logical. Whether to rotate the axes labels on the x-axis. Default is FALSE.

    diff --git a/docs/reference/Setup_scRNAseq_Project.html b/docs/reference/Setup_scRNAseq_Project.html index fae44aa42e..19eb84c4aa 100644 --- a/docs/reference/Setup_scRNAseq_Project.html +++ b/docs/reference/Setup_scRNAseq_Project.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Single_Color_Palette.html b/docs/reference/Single_Color_Palette.html index 6869831baf..4533e6adbc 100644 --- a/docs/reference/Single_Color_Palette.html +++ b/docs/reference/Single_Color_Palette.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Split_FeatureScatter.html b/docs/reference/Split_FeatureScatter.html index f6df8939d6..af4ae1261b 100644 --- a/docs/reference/Split_FeatureScatter.html +++ b/docs/reference/Split_FeatureScatter.html @@ -1,5 +1,6 @@ -Split FeatureScatter — Split_FeatureScatter • scCustomizeSplit FeatureScatter — Split_FeatureScatter • scCustomize @@ -17,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -106,7 +107,8 @@

    Split FeatureScatter

    -

    Create FeatureScatter using split.by

    +

    [Deprecated] +Create FeatureScatter using split.by

    @@ -206,12 +208,19 @@

    Value

    Examples

    -
    library(Seurat)
    +    
    if (FALSE) {
    +# Function now DEPRECATED.
    +library(Seurat)
     pbmc_small$sample_id <- sample(c("sample1", "sample2"), size = ncol(pbmc_small), replace = TRUE)
     
    +# OLD Code
     Split_FeatureScatter(seurat_object = pbmc_small, feature1 = "nCount_RNA", feature2 = "nFeature_RNA",
     split.by = "sample_id")
    -
    +
    +# NEW Code
    +FeatureScatter_scCustom(seurat_object = pbmc_small, feature1 = "nCount_RNA",
    +feature2 = "nFeature_RNA", split.by = "sample_id")
    +}
     
     
    diff --git a/docs/reference/Stacked_VlnPlot-1.png b/docs/reference/Stacked_VlnPlot-1.png index 97527401df..a6f40f6f6a 100644 Binary files a/docs/reference/Stacked_VlnPlot-1.png and b/docs/reference/Stacked_VlnPlot-1.png differ diff --git a/docs/reference/Stacked_VlnPlot.html b/docs/reference/Stacked_VlnPlot.html index 739f707a20..baf7f41703 100644 --- a/docs/reference/Stacked_VlnPlot.html +++ b/docs/reference/Stacked_VlnPlot.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Store_Misc_Info_Seurat.html b/docs/reference/Store_Misc_Info_Seurat.html index 1d53d2c911..43467bc955 100644 --- a/docs/reference/Store_Misc_Info_Seurat.html +++ b/docs/reference/Store_Misc_Info_Seurat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/Store_Palette_Seurat.html b/docs/reference/Store_Palette_Seurat.html index 2f1c0558dd..6afe30bf09 100644 --- a/docs/reference/Store_Palette_Seurat.html +++ b/docs/reference/Store_Palette_Seurat.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/Top_Genes_Factor.html b/docs/reference/Top_Genes_Factor.html index 98d4c88cb7..3034b99bc3 100644 --- a/docs/reference/Top_Genes_Factor.html +++ b/docs/reference/Top_Genes_Factor.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/UnRotate_X.html b/docs/reference/UnRotate_X.html index 3876b55e62..cbd1f67242 100644 --- a/docs/reference/UnRotate_X.html +++ b/docs/reference/UnRotate_X.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/VariableFeaturePlot_scCustom.html b/docs/reference/VariableFeaturePlot_scCustom.html index b5a8793f0d..f7f3dbc92c 100644 --- a/docs/reference/VariableFeaturePlot_scCustom.html +++ b/docs/reference/VariableFeaturePlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -113,6 +113,7 @@

    Custom Labeled Variable Features Plot

    VariableFeaturePlot_scCustom(
       seurat_object,
       num_features = 10,
    +  custom_features = NULL,
       label = TRUE,
       pt.size = 1,
       colors_use = c("black", "red"),
    @@ -134,6 +135,11 @@ 

    Arguments

    Number of top variable features to highlight by color/label.

    +
    custom_features
    +

    A vector of custom feature names to label on plot instead of labeling top +variable genes.

    + +
    label

    logical. Whether to label the top features. Default is TRUE.

    diff --git a/docs/reference/Variable_Features_ALL_LIGER.html b/docs/reference/Variable_Features_ALL_LIGER.html index 3d00c1b62a..7e6e4da04d 100644 --- a/docs/reference/Variable_Features_ALL_LIGER.html +++ b/docs/reference/Variable_Features_ALL_LIGER.html @@ -18,7 +18,7 @@ scCustomize - 1.1.3 + 1.9.9.9041
    diff --git a/docs/reference/VlnPlot_scCustom-1.png b/docs/reference/VlnPlot_scCustom-1.png index 9a083c2a07..01575ce7a5 100644 Binary files a/docs/reference/VlnPlot_scCustom-1.png and b/docs/reference/VlnPlot_scCustom-1.png differ diff --git a/docs/reference/VlnPlot_scCustom.html b/docs/reference/VlnPlot_scCustom.html index 210ae4bbe5..2cb2a68b47 100644 --- a/docs/reference/VlnPlot_scCustom.html +++ b/docs/reference/VlnPlot_scCustom.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -117,6 +117,9 @@

    VlnPlot with modified default settings

    pt.size = NULL, group.by = NULL, split.by = NULL, + plot_median = FALSE, + plot_boxplot = FALSE, + median_size = 15, idents = NULL, num_columns = NULL, raster = NULL, @@ -156,6 +159,18 @@

    Arguments

    Feature to split plots by (i.e. "orig.ident").

    +
    plot_median
    +

    logical, whether to plot median for each ident on the plot (Default is FALSE).

    + + +
    plot_boxplot
    +

    logical, whether to plot boxplot inside of violin (Default is FALSE).

    + + +
    median_size
    +

    Shape size for the median is plotted.

    + +
    idents

    Which classes to include in the plot (default is all).

    diff --git a/docs/reference/ensembl_mito_id.html b/docs/reference/ensembl_mito_id.html index 295744d577..04bc736609 100644 --- a/docs/reference/ensembl_mito_id.html +++ b/docs/reference/ensembl_mito_id.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/ensembl_ribo_id.html b/docs/reference/ensembl_ribo_id.html index 111114f506..470d10b583 100644 --- a/docs/reference/ensembl_ribo_id.html +++ b/docs/reference/ensembl_ribo_id.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 diff --git a/docs/reference/figures/assets/Barcode_Rank_Plot_Example.jpg b/docs/reference/figures/assets/Barcode_Rank_Plot_Example.jpg new file mode 100644 index 0000000000..77dbc39aeb Binary files /dev/null and b/docs/reference/figures/assets/Barcode_Rank_Plot_Example.jpg differ diff --git a/docs/reference/ieg_gene_list.html b/docs/reference/ieg_gene_list.html new file mode 100644 index 0000000000..ac18abc3cf --- /dev/null +++ b/docs/reference/ieg_gene_list.html @@ -0,0 +1,158 @@ + +Immediate Early Gene (IEG) gene lists — ieg_gene_list • scCustomize + + +
    +
    + + + +
    +
    + + +
    +

    Gene symbols for immediate early genes

    +
    + +
    +
    ieg_gene_list
    +
    + +
    +

    Format

    +

    A list of seven vectors

    Mus_musculus_IEGs
    +

    Gene symbols for IEGs from source publication (see below)

    + +
    Homo_sapiens_IEGs
    +

    Human gene symbols for homologous genes from mouse gene list

    + + + +
    +
    +

    Source

    +

    Mouse gene list is from: SI Table 4 from doi:doi.org/10.1016/j.neuron.2017.09.026 +. Human +gene list was compiled by first creating homologous gene list using biomaRt and then adding some manually curated +homologs according to HGNC.

    +
    + +
    + +
    + + +
    + +
    +

    Site built with pkgdown 2.0.7.

    +
    + +
    + + + + + + + + diff --git a/docs/reference/index.html b/docs/reference/index.html index 4785a18905..4159ee4847 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -17,7 +17,7 @@ scCustomize - 1.1.3 + 1.9.9.9041 @@ -167,6 +167,14 @@

    Sequencing Metrics QC Plots Seq_QC_Plot_Basic_Combined()

    QC Plots Sequencing metrics (Layout)

    +

    Barcode_Plot()

    +

    Create Barcode Rank Plot

    +

    Iterate_Barcode_Rank_Plot()

    +

    Iterative Barcode Rank Plots

    Seq_QC_Plot_Genes()

    +

    QC_Histogram()

    +

    QC Histogram Plots

    QC_Plot_GenevsFeature()

    QC Plots Genes vs Misc

    Customize FeaturePlot

    +

    FeatureScatter_scCustom()

    +

    Modified version of FeatureScatter

    Meta_Highlight_Plot()

    Add Cell Complexity Value

    +

    Add_Cell_QC_Metrics()

    +

    Add Multiple Cell Quality Control Values with Single Function

    Add_Mito_Ribo_Seurat()

    Add Sample Level Meta Data

    +

    Add_Top_Gene_Pct_Seurat()

    +

    Add Percent of High Abundance Genes

    Extract_Sample_Meta()

    Calculate Cluster Stats

    +

    MAD_Stats()

    +

    Median Absolute Deviation Statistics

    Median_Stats()

    Ensembl Ribo IDs

    +

    ieg_gene_list

    +

    Immediate Early Gene (IEG) gene lists

    +

    msigdb_qc_gene_list

    +

    QC Gene Lists

    diff --git a/docs/reference/scCustomize-package.html b/docs/reference/scCustomize-package.html index df53dccb23..4f674feee3 100644 --- a/docs/reference/scCustomize-package.html +++ b/docs/reference/scCustomize-package.html @@ -1,5 +1,5 @@ -scCustomize: Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing — scCustomize-package • scCustomizescCustomize: Custom Visualizations & Functions for Streamlined Analyses of Single Cell Sequencing — scCustomize-package • scCustomize