From 9e1956d6c3585ca997d012859870fa3c933f2bc8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 29 Feb 2024 07:38:06 -0500 Subject: [PATCH 001/503] bump develop changelog --- NEWS.md | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/NEWS.md b/NEWS.md index 70efe6a955..2206339746 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,18 @@ +# scCustomize 2.X.X (2024-XX-XX) +## Added +- None. + + + +## Changed +- None. + + +## Fixes +- None. + + + # scCustomize 2.1.2 (2024-02-27) ## Added - None. From 4e8e2dde43fb66a4ca5b00455c6ef23a0b481311 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 29 Feb 2024 07:38:15 -0500 Subject: [PATCH 002/503] bump develop version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7a052c4ea4..4d6b2cdfa3 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" RRID:SCR_024675. -Version: 2.1.2 -Date: 2024-02-27 +Version: 2.1.2.9000 +Date: 2024-02-29 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"), From 645767a3c253cd9829dc541e8b77a770364b1142 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 29 Feb 2024 07:46:03 -0500 Subject: [PATCH 003/503] change nebulosa error to warn and github install note --- R/Nebulosa_Plotting.R | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/R/Nebulosa_Plotting.R b/R/Nebulosa_Plotting.R index db786163f0..7f405ecd9b 100644 --- a/R/Nebulosa_Plotting.R +++ b/R/Nebulosa_Plotting.R @@ -51,6 +51,18 @@ Plot_Density_Custom <- function( combine = TRUE, ... ) { + # Temp Nebulosa warning until Bioconductor 3.19 release + if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { + cli_warn(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} functionality are currently restricted GitHub version of Nebulosa.", + "i" = "This can be installed with the following commands: ", + "----------------------------------------", + "{.field `devtools::install_github({symbol$dquote_left}powellgenomicslab/Nebulosa{symbol$dquote_right})`}", + "----------------------------------------"), + .frequency = "once", + .frequency_id = "nebulosa_warn") + } + + # Check Nebulosa installed Nebulosa_check <- is_installed(pkg = "Nebulosa") if (isFALSE(x = Nebulosa_check)) { @@ -64,11 +76,6 @@ Plot_Density_Custom <- function( )) } - # temp ggplot2 version check - if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { - cli_abort(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Custom} functionality is currently restricted to ggplot v3.4.4 or lower.")) - } - # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -162,6 +169,17 @@ Plot_Density_Joint_Only <- function( reduction = NULL, ... ) { + # Temp Nebulosa warning until Bioconductor 3.19 release + if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { + cli_warn(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} functionality are currently restricted GitHub version of Nebulosa.", + "i" = "This can be installed with the following commands: ", + "----------------------------------------", + "{.field `devtools::install_github({symbol$dquote_left}powellgenomicslab/Nebulosa{symbol$dquote_right})`}", + "----------------------------------------"), + .frequency = "once", + .frequency_id = "nebulosa_warn") + } + # Check Nebulosa installed Nebulosa_check <- is_installed(pkg = "Nebulosa") if (isFALSE(x = Nebulosa_check)) { @@ -175,11 +193,6 @@ Plot_Density_Joint_Only <- function( )) } - # temp ggplot2 version check - if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { - cli_abort(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Joint_Only} functionality is currently restricted to ggplot v3.4.4 or lower.")) - } - # Check Seurat Is_Seurat(seurat_object = seurat_object) From 0211ec49a1fcaefc2d4c718da770815e35cfd039 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 29 Feb 2024 07:46:50 -0500 Subject: [PATCH 004/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 2206339746..a9e8aff914 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,7 @@ ## Fixes -- None. +- Allow for Nebulosa plotting with ggplot2 v3.5.0 when using GitHub version of Nebulosa. From 25d4fa83175d77c82de57f0995be96d336ffb749 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 29 Feb 2024 07:47:02 -0500 Subject: [PATCH 005/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4d6b2cdfa3..c157c2955b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9000 +Version: 2.1.2.9001 Date: 2024-02-29 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")), From 2294290f03731a132fc4b13952448e67d3e70187 Mon Sep 17 00:00:00 2001 From: kew24 Date: Thu, 29 Feb 2024 15:42:36 -0500 Subject: [PATCH 006/503] fix typo (sise -> size) --- R/Plotting_Utilities.R | 4 ++-- R/Seurat_Plotting.R | 2 +- man/Clustered_DotPlot.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 9bf60fac83..4395185194 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -441,7 +441,7 @@ Figure_Plot <- function( #' @param cluster_ident logical, whether to cluster and reorder identity axis. Default is TRUE. #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. -#' @param legend_title_size Sise of the legend title text labels. Provided to `title_gp` in Heatmap legend call. +#' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. @@ -941,7 +941,7 @@ Clustered_DotPlot_Single_Group <- function( #' @param cluster_ident logical, whether to cluster and reorder identity axis. Default is TRUE. #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. -#' @param legend_title_size Sise of the legend title text labels. Provided to `title_gp` in Heatmap legend call. +#' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3d64ef4684..5423cb9b49 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -984,7 +984,7 @@ DotPlot_scCustom <- function( #' @param cluster_ident logical, whether to cluster and reorder identity axis. Default is TRUE. #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. -#' @param legend_title_size Sise of the legend title text labels. Provided to `title_gp` in Heatmap legend call. +#' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index 4deca1b5ac..e13fd25089 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -108,7 +108,7 @@ smaller than row_km, but this might mean the original row_km is not a good choic \item{legend_label_size}{Size of the legend text labels. Provided to \code{labels_gp} in Heatmap legend call.} -\item{legend_title_size}{Sise of the legend title text labels. Provided to \code{title_gp} in Heatmap legend call.} +\item{legend_title_size}{Size of the legend title text labels. Provided to \code{title_gp} in Heatmap legend call.} \item{raster}{Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE.} From 96dba5c0a76a4f68bf2e31dfea17a635046671cd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 10:23:44 -0500 Subject: [PATCH 007/503] overwrite fix --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 915d0ead27..d6562c19d6 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -256,7 +256,7 @@ Add_Cell_QC_Metrics <- function( # 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) { + if (isFALSE(x = 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}*") ) From 7e574e6a91182edf29f2c07f8507148f493fc384 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 10:26:09 -0500 Subject: [PATCH 008/503] revert --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index d6562c19d6..915d0ead27 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -256,7 +256,7 @@ Add_Cell_QC_Metrics <- function( # 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 (isFALSE(x = overwrite)) { + 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}*") ) From 3d5e56d1d17a158f592dafb1bf9e5ee62eed93cc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 10:29:50 -0500 Subject: [PATCH 009/503] overwrite fix --- R/Object_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 915d0ead27..1f8274a867 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -256,13 +256,13 @@ Add_Cell_QC_Metrics <- function( # 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) { + if (isFALSE(x = 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.}") + "i" = "Overwriting those columns as {.code overwrite = TRUE.}") ) } From e199056b3de25c088537190be690151134dc035e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 10:31:19 -0500 Subject: [PATCH 010/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index a9e8aff914..e664d43139 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,7 @@ ## Fixes - Allow for Nebulosa plotting with ggplot2 v3.5.0 when using GitHub version of Nebulosa. +- Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). From a7de260fc885e1826d560b90eccd222e215eaec9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 10:31:26 -0500 Subject: [PATCH 011/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c157c2955b..734a0cc91d 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" RRID:SCR_024675. -Version: 2.1.2.9001 -Date: 2024-02-29 +Version: 2.1.2.9002 +Date: 2024-03-07 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"), From e5947a611094e7895f69f37ae908c790cef5d99b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 11:06:29 -0500 Subject: [PATCH 012/503] fix documentation --- R/Seurat_Plotting.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 5423cb9b49..6e426dcce3 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -855,7 +855,7 @@ 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); +#' @param group.by Name of metadata variable (column) to group 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. From 03379524b8f9266a7480326fa393da5dff1a2365 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 11:11:18 -0500 Subject: [PATCH 013/503] update docs --- man/DotPlot_scCustom.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/DotPlot_scCustom.Rd b/man/DotPlot_scCustom.Rd index 95c83f87a8..b74f30edf1 100644 --- a/man/DotPlot_scCustom.Rd +++ b/man/DotPlot_scCustom.Rd @@ -22,7 +22,7 @@ DotPlot_scCustom( \item{features}{Features to plot.} -\item{group.by}{Name of one or more metadata columns to group (color) cells by (for example, orig.ident); +\item{group.by}{Name of metadata variable (column) to group cells by (for example, orig.ident); default is the current active.ident of the object.} \item{colors_use}{specify color palette to used. Default is viridis_plasma_dark_high.} From 8287a194ee454e4127580bd3f46a3013d3128edc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 11:11:38 -0500 Subject: [PATCH 014/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e664d43139..d6aec7e136 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,8 @@ ## Fixes - Allow for Nebulosa plotting with ggplot2 v3.5.0 when using GitHub version of Nebulosa. -- Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). +- Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). +- Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). From 6cf4b3555b0e87965987459ae016410e4ce65d98 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 7 Mar 2024 11:11:45 -0500 Subject: [PATCH 015/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 734a0cc91d..43e79d93a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9002 +Version: 2.1.2.9003 Date: 2024-03-07 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")), From 5769607a863dce09028300678012f85346d9e070 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:01:32 -0500 Subject: [PATCH 016/503] add check for Nebulosa version when ggplot2 is v3.5.0 and allow following Nebulosa patch --- R/Nebulosa_Plotting.R | 45 +++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/R/Nebulosa_Plotting.R b/R/Nebulosa_Plotting.R index 7f405ecd9b..6a124bb75b 100644 --- a/R/Nebulosa_Plotting.R +++ b/R/Nebulosa_Plotting.R @@ -51,18 +51,6 @@ Plot_Density_Custom <- function( combine = TRUE, ... ) { - # Temp Nebulosa warning until Bioconductor 3.19 release - if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { - cli_warn(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} functionality are currently restricted GitHub version of Nebulosa.", - "i" = "This can be installed with the following commands: ", - "----------------------------------------", - "{.field `devtools::install_github({symbol$dquote_left}powellgenomicslab/Nebulosa{symbol$dquote_right})`}", - "----------------------------------------"), - .frequency = "once", - .frequency_id = "nebulosa_warn") - } - - # Check Nebulosa installed Nebulosa_check <- is_installed(pkg = "Nebulosa") if (isFALSE(x = Nebulosa_check)) { @@ -76,6 +64,17 @@ Plot_Density_Custom <- function( )) } + # Check version of Nebulosa and ggplot2 + if (packageVersion(pkg = 'ggplot2') >= "3.5.0" && packageVersion(pkg = 'Nebulosa') < "1.12.1") { + cli_abort(message = c("In order to use {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} with ggplot2 v3.5.0 please update to latest version of Nebulosa package (v1.12.1).", + "i" = "This can be installed with the following commands: ", + "----------------------------------------", + "{.field `BiocManager::install({symbol$dquote_left}Nebulosa{symbol$dquote_right})`}", + "----------------------------------------"), + .frequency = "once", + .frequency_id = "nebulosa_warn") + } + # Check Seurat Is_Seurat(seurat_object = seurat_object) @@ -169,17 +168,6 @@ Plot_Density_Joint_Only <- function( reduction = NULL, ... ) { - # Temp Nebulosa warning until Bioconductor 3.19 release - if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { - cli_warn(message = c("Due to error in Nebulosa package and ggplot2 v3.5.0 {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} functionality are currently restricted GitHub version of Nebulosa.", - "i" = "This can be installed with the following commands: ", - "----------------------------------------", - "{.field `devtools::install_github({symbol$dquote_left}powellgenomicslab/Nebulosa{symbol$dquote_right})`}", - "----------------------------------------"), - .frequency = "once", - .frequency_id = "nebulosa_warn") - } - # Check Nebulosa installed Nebulosa_check <- is_installed(pkg = "Nebulosa") if (isFALSE(x = Nebulosa_check)) { @@ -193,6 +181,17 @@ Plot_Density_Joint_Only <- function( )) } + # Check version of Nebulosa and ggplot2 + if (packageVersion(pkg = 'ggplot2') >= "3.5.0" && packageVersion(pkg = 'Nebulosa') < "1.12.1") { + cli_abort(message = c("In order to use {.field Plot_Density_Custom} & {.field Plot_Density_Joint_Only} with ggplot2 v3.5.0 please update to latest version of Nebulosa package (v1.12.1).", + "i" = "This can be installed with the following commands: ", + "----------------------------------------", + "{.field `BiocManager::install({symbol$dquote_left}Nebulosa{symbol$dquote_right})`}", + "----------------------------------------"), + .frequency = "once", + .frequency_id = "nebulosa_warn") + } + # Check Seurat Is_Seurat(seurat_object = seurat_object) From 3f7c9cbbeb1fe7b144a66f0247c01e08d42b9187 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:01:40 -0500 Subject: [PATCH 017/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index d6aec7e136..a08837527f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,7 @@ ## Fixes -- Allow for Nebulosa plotting with ggplot2 v3.5.0 when using GitHub version of Nebulosa. +- Nebulosa plotting functions `Plot_Density_Custom` and `Plot_Density_Joint_Only` have been re-enabled for users with ggplot2 v3.5.0 following Nebulosa v1.12.1 update patch. - Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). - Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). From be37895bda07adb9084f3f27208e7a93ca8e1ae5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:01:57 -0500 Subject: [PATCH 018/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 43e79d93a9..83544cc4d0 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" RRID:SCR_024675. -Version: 2.1.2.9003 -Date: 2024-03-07 +Version: 2.1.2.9004 +Date: 2024-03-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"), From a0b293d57df19976c1c851fc932fdf5a6785d0b0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:20:38 -0500 Subject: [PATCH 019/503] change storage location for alt_ids --- R/Object_Utilities.R | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 1f8274a867..0081d74d16 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1377,7 +1377,7 @@ Store_Palette_Seurat <- function( #' Add Alternative Feature IDs #' -#' Add alternative feature ids to the assay level meta.data slot in Assay5 compatible object (Seurat V5.0.0 or greater) +#' Add alternative feature ids data.frame to the misc slot of Seurat object. #' #' @param seurat_object object name. #' @param features_tsv_file output file from Cell Ranger used for creation of Seurat object. @@ -1386,11 +1386,14 @@ Store_Palette_Seurat <- function( #' (Either provide this of `features_tsv_file`) #' @param assay name of assay(s) to add the alternative features to. Can specify "all" #' to add to all assays. +#' @param data_name name to use for data.frame when stored in `@misc` slot. +#' @param overwrite logical, whether to overwrite item with the same `data_name` in the +#' `@misc` slot of object (default is FALSE). #' #' @import cli #' @importFrom dplyr filter #' -#' @return Seurat Object with new entries in the `obj@assays$ASSAY@meta.data` slot. +#' @return Seurat Object with new entries in the `obj@misc` slot. #' #' @export #' @@ -1415,7 +1418,9 @@ Add_Alt_Feature_ID <- function( seurat_object, features_tsv_file = NULL, hdf5_file = NULL, - assay = NULL + assay = NULL, + data_name = "feature_id_mapping_table", + overwrite = FALSE ) { if (packageVersion(pkg = 'Seurat') < "5") { cli_abort(message = "Seurat version must be v5.0.0 or greater to add alternative features.") @@ -1443,15 +1448,6 @@ Add_Alt_Feature_ID <- function( assays_use <- assay } - # check they are Assay5 - current_assay_classes <- sapply(assays_use, function(x) { - class(x = seurat_object[[x]]) - }) - - if (isFALSE(x = all(current_assay_classes == "Assay5"))) { - cli_abort(message = "All assays to features must be {.field Assay5}.") - } - # get features object_features <- Features(x = seurat_object, assay = assays_use[1]) @@ -1481,10 +1477,7 @@ Add_Alt_Feature_ID <- function( } # Add to object - for (i in assays_use) { - seurat_object[[i]]@meta.data$Ensembl_ID <- features_present$Ensembl_ID - seurat_object[[i]]@meta.data$Symbol <- features_present$Symbol - } + seurat_object <- Store_Misc_Info_Seurat(seurat_object = seurat_object, data_to_store = features_present, data_name = data_name, overwrite = overwrite) # return object return(seurat_object) From 8abc933a4c6266f67170f89c990c407130aabd93 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:21:02 -0500 Subject: [PATCH 020/503] Update docs --- man/Add_Alt_Feature_ID.Rd | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/man/Add_Alt_Feature_ID.Rd b/man/Add_Alt_Feature_ID.Rd index 51ec203483..e1bfdee96d 100644 --- a/man/Add_Alt_Feature_ID.Rd +++ b/man/Add_Alt_Feature_ID.Rd @@ -8,7 +8,9 @@ Add_Alt_Feature_ID( seurat_object, features_tsv_file = NULL, hdf5_file = NULL, - assay = NULL + assay = NULL, + data_name = "feature_id_mapping_table", + overwrite = FALSE ) } \arguments{ @@ -22,12 +24,17 @@ Add_Alt_Feature_ID( \item{assay}{name of assay(s) to add the alternative features to. Can specify "all" to add to all assays.} + +\item{data_name}{name to use for data.frame when stored in \verb{@misc} slot.} + +\item{overwrite}{logical, whether to overwrite item with the same \code{data_name} in the +\verb{@misc} slot of object (default is FALSE).} } \value{ -Seurat Object with new entries in the \code{obj@assays$ASSAY@meta.data} slot. +Seurat Object with new entries in the \code{obj@misc} slot. } \description{ -Add alternative feature ids to the assay level meta.data slot in Assay5 compatible object (Seurat V5.0.0 or greater) +Add alternative feature ids data.frame to the misc slot of Seurat object. } \examples{ \dontrun{ From 5341656232cd8d17e45f13fe71b5609b9b1775fb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:22:43 -0500 Subject: [PATCH 021/503] update changelog --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index a08837527f..f5bc932e32 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,11 @@ # scCustomize 2.X.X (2024-XX-XX) ## Added -- None. +- Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. ## Changed -- None. +- Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. ## Fixes From a61f9e2a469b8ef5e658501ca8cccaacad326097 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 08:22:57 -0500 Subject: [PATCH 022/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 83544cc4d0..cd75c05aac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9004 +Version: 2.1.2.9005 Date: 2024-03-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")), From 9398f3d3b7196eaee0ab2e8b8a9dc229e8eb9bb0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:07:54 -0500 Subject: [PATCH 023/503] reorganize S3 generics --- R/Object_Utilities.R | 36 ++++++------------------------------ 1 file changed, 6 insertions(+), 30 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 0081d74d16..303a04a442 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1161,40 +1161,15 @@ Extract_Sample_Meta <- function( #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#' Get meta data from object -#' -#' Quick function to properly pull meta.data from objects. -#' -#' @param object Object of class Seurat or liger. -#' -#' @importFrom methods slot -#' -#' @return A data.frame containing cell-level meta data -#' -#' @export -#' -#' @concept get_set_util -#' -#' @rdname Fetch_Meta -#' -#' @examples -#' library(Seurat) -#' meta_data <- Fetch_Meta(object = pbmc_small) -#' head(meta_data, 5) -#' - -Fetch_Meta <- function(object) { - UseMethod(generic = 'Fetch_Meta') -} - - #' @rdname Fetch_Meta +#' @importFrom methods slot #' @export #' @concept get_set_util #' @method Fetch_Meta Seurat Fetch_Meta.Seurat <- function( - object + object, + ... ) { # Pull meta data object_meta <- slot(object = object, name = "meta.data") @@ -1204,14 +1179,15 @@ Fetch_Meta.Seurat <- function( #' @rdname Fetch_Meta +#' @importFrom methods slot #' @export #' @concept liger_object_util #' @method Fetch_Meta liger Fetch_Meta.liger <- function( - object + object, + ... ) { - # Pull meta data object_meta <- object_meta <- slot(object = object, name = "cell.data") From 943ae9f457f7376c0a3ac307f1e547f483ca8b8e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:08:00 -0500 Subject: [PATCH 024/503] reorg generics --- R/Generics.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/R/Generics.R b/R/Generics.R index c82fe753a4..39e7cd6ab8 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -73,3 +73,29 @@ Add_Mito_Ribo <- function(object, ...) { Add_Cell_Complexity <- function(object, ...) { UseMethod(generic = 'Add_Cell_Complexity', object = object) } + + +#' Get meta data from object +#' +#' Quick function to properly pull meta.data from objects. +#' +#' @param object Object of class Seurat or liger. +#' @param ... Arguments passed to other methods +#' +#' @return A data.frame containing cell-level meta data +#' +#' @export +#' +#' @concept get_set_util +#' +#' @rdname Fetch_Meta +#' +#' @examples +#' library(Seurat) +#' meta_data <- Fetch_Meta(object = pbmc_small) +#' head(meta_data, 5) +#' + +Fetch_Meta <- function(object, ...) { + UseMethod(generic = 'Fetch_Meta', object = object) +} From fda58c4c1fdb0246d6c16c787ddb366edbe92082 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:08:34 -0500 Subject: [PATCH 025/503] update docs --- man/Fetch_Meta.Rd | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/man/Fetch_Meta.Rd b/man/Fetch_Meta.Rd index 27c5d04dd4..13bf81a246 100644 --- a/man/Fetch_Meta.Rd +++ b/man/Fetch_Meta.Rd @@ -1,19 +1,21 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Object_Utilities.R +% Please edit documentation in R/Generics.R, R/Object_Utilities.R \name{Fetch_Meta} \alias{Fetch_Meta} \alias{Fetch_Meta.Seurat} \alias{Fetch_Meta.liger} \title{Get meta data from object} \usage{ -Fetch_Meta(object) +Fetch_Meta(object, ...) -\method{Fetch_Meta}{Seurat}(object) +\method{Fetch_Meta}{Seurat}(object, ...) -\method{Fetch_Meta}{liger}(object) +\method{Fetch_Meta}{liger}(object, ...) } \arguments{ \item{object}{Object of class Seurat or liger.} + +\item{...}{Arguments passed to other methods} } \value{ A data.frame containing cell-level meta data From b5b29369efca4b57229b1e1ecb841700b9daff76 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:08:53 -0500 Subject: [PATCH 026/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index cd75c05aac..5a397a6863 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9005 +Version: 2.1.2.9006 Date: 2024-03-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")), From 8de3a10f68b6cbbd5b72c27f2f5fc1582757a2a5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:47:26 -0500 Subject: [PATCH 027/503] Reorganize utils --- R/LIGER_Utilities.R | 247 +++++++++++++++++++++++++------------------ R/Object_Utilities.R | 22 ---- 2 files changed, 144 insertions(+), 125 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ae418923a3..b810757c4d 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1,3 +1,139 @@ +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### DATA ACCESS #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +#' @rdname Fetch_Meta +#' @importFrom methods slot +#' @export +#' @concept liger_object_util +#' @method Fetch_Meta liger + +Fetch_Meta.liger <- function( + object, + ... +) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + # Pull meta data + object_meta <- object_meta <- slot(object = object, name = "cell.data") + + return(object_meta) +} + + +#' Extract Features from LIGER Object +#' +#' Extract all unique features from LIGER object +#' +#' @param liger_object LIGER object name. +#' @param by_dataset logical, whether to return list with vector of features for each dataset in +#' LIGER object or to return single vector of unique features across all datasets in object +#' (default is FALSE; return vector of unique features) +#' +#' @return vector or list depending on `by_dataset` parameter +#' +#' @importFrom utils packageVersion +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return single vector of all unique features +#' all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) +#' +#' # return list of vectors containing features from each individual dataset in object +#' dataset_features <- LIGER_Features(liger_object = object, by_dataset = TRUE) +#' } +#' + +LIGER_Features <- function( + liger_object, + by_dataset = FALSE +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + Is_LIGER(liger_object = liger_object) + + # Extract features + features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { + rownames(x = liger_object@raw.data[[x]]) + }) + + if (isFALSE(x = by_dataset)) { + features <- unique(x = unlist(x = features_by_dataset)) + return(features) + } else { + return(features_by_dataset) + } +} + + +#' Extract top loading genes for LIGER factor +#' +#' Extract vector to the top loading genes for specified LIGER iNMF factor +#' +#' @param liger_object LIGER object name. +#' @param liger_factor LIGER factor number to pull genes from. +#' @param num_genes number of top loading genes to return as vector. +#' +#' @return A LIGER Object +#' +#' @import cli +#' @importFrom utils packageVersion +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' top_genes_factor10 <- Top_Genes_Factor(liger_object = object, num_genes = 10) +#' } +#' + +Top_Genes_Factor <- function( + liger_object, + liger_factor, + num_genes = 10 +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + # LIGER object check + Is_LIGER(liger_object = liger_object) + + # check number of factors present + if (!liger_factor %in% 1:dim(x = liger_object@W)[[1]]) { + cli_abort(message = c("{.code liger_factor} provided: {.field {liger_factor}} not found", + "i" = "{.code liger_object} only contains {.field {dim(x = liger_object@W)[[1]]}} factors.") + ) + } + + # Extract genes + W <- t(liger_object@W) + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) + top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] + return(top_genes) +} + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### QC UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + #' Add Mito and Ribo percentages #' #' @param species Species of origin for given Seurat Object. If mouse, human, marmoset, zebrafish, rat, @@ -292,109 +428,9 @@ Add_Cell_Complexity.liger <- function( } -#' Extract Features from LIGER Object -#' -#' Extract all unique features from LIGER object -#' -#' @param liger_object LIGER object name. -#' @param by_dataset logical, whether to return list with vector of features for each dataset in -#' LIGER object or to return single vector of unique features across all datasets in object -#' (default is FALSE; return vector of unique features) -#' -#' @return vector or list depending on `by_dataset` parameter -#' -#' @importFrom utils packageVersion -#' -#' @export -#' -#' @concept liger_object_util -#' -#' @examples -#' \dontrun{ -#' # return single vector of all unique features -#' all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) -#' -#' # return list of vectors containing features from each individual dataset in object -#' dataset_features <- LIGER_Features(liger_object = object, by_dataset = TRUE) -#' } -#' - -LIGER_Features <- function( - liger_object, - by_dataset = FALSE -) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - - Is_LIGER(liger_object = liger_object) - - # Extract features - features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { - rownames(x = liger_object@raw.data[[x]]) - }) - - if (isFALSE(x = by_dataset)) { - features <- unique(x = unlist(x = features_by_dataset)) - return(features) - } else { - return(features_by_dataset) - } -} - - -#' Extract top loading genes for LIGER factor -#' -#' Extract vector to the top loading genes for specified LIGER iNMF factor -#' -#' @param liger_object LIGER object name. -#' @param liger_factor LIGER factor number to pull genes from. -#' @param num_genes number of top loading genes to return as vector. -#' -#' @return A LIGER Object -#' -#' @import cli -#' @importFrom utils packageVersion -#' -#' @export -#' -#' @concept liger_object_util -#' -#' @examples -#' \dontrun{ -#' top_genes_factor10 <- Top_Genes_Factor(liger_object = object, num_genes = 10) -#' } -#' - -Top_Genes_Factor <- function( - liger_object, - liger_factor, - num_genes = 10 -) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - - # LIGER object check - Is_LIGER(liger_object = liger_object) - - # check number of factors present - if (!liger_factor %in% 1:dim(x = liger_object@W)[[1]]) { - cli_abort(message = c("{.code liger_factor} provided: {.field {liger_factor}} not found", - "i" = "{.code liger_object} only contains {.field {dim(x = liger_object@W)[[1]]}} factors.") - ) - } - - # Extract genes - W <- t(liger_object@W) - rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) - top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] - return(top_genes) -} +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### PLOTTING UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' DimPlot LIGER Version @@ -931,6 +967,11 @@ Plot_By_Meta_LIGER <- function( } +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### ANALYSIS UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + #' Perform variable gene selection over whole dataset #' #' Performs variable gene selection for LIGER object across the entire object instead of by diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 303a04a442..81b5542844 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1156,11 +1156,6 @@ Extract_Sample_Meta <- function( } -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### DATA ACCESS #################### -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - #' @rdname Fetch_Meta #' @importFrom methods slot #' @export @@ -1178,23 +1173,6 @@ Fetch_Meta.Seurat <- function( } -#' @rdname Fetch_Meta -#' @importFrom methods slot -#' @export -#' @concept liger_object_util -#' @method Fetch_Meta liger - -Fetch_Meta.liger <- function( - object, - ... -) { - # Pull meta data - object_meta <- object_meta <- slot(object = object, name = "cell.data") - - return(object_meta) -} - - #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### MISC OBJECT UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From db155b482d5cc394d0f0ebf22fd797a6fe605571 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 10:47:48 -0500 Subject: [PATCH 028/503] Update docs --- man/Fetch_Meta.Rd | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/man/Fetch_Meta.Rd b/man/Fetch_Meta.Rd index 13bf81a246..9ad1bc6508 100644 --- a/man/Fetch_Meta.Rd +++ b/man/Fetch_Meta.Rd @@ -1,16 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Generics.R, R/Object_Utilities.R +% Please edit documentation in R/Generics.R, R/LIGER_Utilities.R, +% R/Object_Utilities.R \name{Fetch_Meta} \alias{Fetch_Meta} -\alias{Fetch_Meta.Seurat} \alias{Fetch_Meta.liger} +\alias{Fetch_Meta.Seurat} \title{Get meta data from object} \usage{ Fetch_Meta(object, ...) -\method{Fetch_Meta}{Seurat}(object, ...) - \method{Fetch_Meta}{liger}(object, ...) + +\method{Fetch_Meta}{Seurat}(object, ...) } \arguments{ \item{object}{Object of class Seurat or liger.} From 10d82bd442c2f4e92e2bd41d93772892de05f2a0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 14:58:38 -0500 Subject: [PATCH 029/503] add seq zeros --- R/Utilities.R | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/R/Utilities.R b/R/Utilities.R index 0ef59c827f..b162ddf5f8 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1779,6 +1779,54 @@ Split_Vector <- function( } +#' Create sequence with zeros +#' +#' Create sequences of numbers like `seq()` but with 0 prefixed to keep numerical order +#' +#' @param seq_length a seqeunce or numbers of numbers to create sequence. +#' Users can provide sequence (1:XX) or number of values to add in sequence (will +#' be used as second number in `seq_len`; 1:XX). +#' @param num_zeros number of zeros to prefix sequence, default is 1 (e.g, 01, 02, 03, ...) +#' +#' @return vector of numbers in sequence +#' +#' @import cli +#' @importFrom stringr str_pad +#' +#' @export +#' +#' @references Base code from stackoverflow post: +#' \url{https://stackoverflow.com/a/38825614} +#' +#' @concept misc_util +#' +#' @examples +#' # Using sequence +#' new_seq <- seq_zeros(seq_length = 1:15, num_zeros = 1) +#' new_seq +#' +#' # Using number +#' new_seq <- seq_zeros(seq_length = 15, num_zeros = 1) +#' new_seq +#' +#' # Sequence with 2 zeros +#' new_seq <- seq_zeros(seq_length = 1:15, num_zeros = 2) +#' new_seq +#' + +seq_zeros <- function( + seq_length, + num_zeros = 1 +) { + # add pad value + padding <- 1 + num_zeros + + # make sequence + new_seq <- str_pad(string = seq, pad = 0, width = padding, side = "left") + + return(new_seq) +} + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### PROJECT ORGANIZATION #################### From e98de5a0dfa5fc8caa388b02ed1ed46c63565a6f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 14:58:47 -0500 Subject: [PATCH 030/503] update docs --- NAMESPACE | 2 ++ man/seq_zeros.Rd | 40 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+) create mode 100644 man/seq_zeros.Rd diff --git a/NAMESPACE b/NAMESPACE index 7506780eb4..7b2a433ea3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -151,6 +151,7 @@ export(as.Seurat) export(as.anndata) export(plotFactors_scCustom) export(scCustomize_Palette) +export(seq_zeros) export(theme_ggprism_mod) export(viridis_dark_high) export(viridis_inferno_dark_high) @@ -271,6 +272,7 @@ importFrom(stringi,stri_replace_last_fixed) importFrom(stringr,str_c) importFrom(stringr,str_detect) importFrom(stringr,str_extract) +importFrom(stringr,str_pad) importFrom(stringr,str_replace) importFrom(stringr,str_replace_na) importFrom(stringr,str_to_lower) diff --git a/man/seq_zeros.Rd b/man/seq_zeros.Rd new file mode 100644 index 0000000000..bfcffddd9c --- /dev/null +++ b/man/seq_zeros.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{seq_zeros} +\alias{seq_zeros} +\title{Create sequence with zeros} +\usage{ +seq_zeros(seq_length, num_zeros = 1) +} +\arguments{ +\item{seq_length}{a seqeunce or numbers of numbers to create sequence. +Users can provide sequence (1:XX) or number of values to add in sequence (will +be used as second number in \code{seq_len}; 1:XX).} + +\item{num_zeros}{number of zeros to prefix sequence, default is 1 (e.g, 01, 02, 03, ...)} +} +\value{ +vector of numbers in sequence +} +\description{ +Create sequences of numbers like \code{seq()} but with 0 prefixed to keep numerical order +} +\examples{ +# Using sequence +new_seq <- seq_zeros(seq_length = 1:15, num_zeros = 1) +new_seq + +# Using number +new_seq <- seq_zeros(seq_length = 15, num_zeros = 1) +new_seq + +# Sequence with 2 zeros +new_seq <- seq_zeros(seq_length = 1:15, num_zeros = 2) +new_seq + +} +\references{ +Base code from stackoverflow post: +\url{https://stackoverflow.com/a/38825614} +} +\concept{misc_util} From 71685f4e03215d47bc8abb64ebabc9543d54de5f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 14:59:36 -0500 Subject: [PATCH 031/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index f5bc932e32..b87b9d33ae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # scCustomize 2.X.X (2024-XX-XX) ## Added - Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. +- Added new function `seq_zeros` to create sequences with preceding zeros. From b475225b09a37fde0db3df4e5b471f8f6657a570 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 14:59:43 -0500 Subject: [PATCH 032/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5a397a6863..fb25e5fcef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9006 +Version: 2.1.2.9007 Date: 2024-03-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")), From 1439cc979de9c51e365a3a02e7ef333d90e83c84 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:01:30 -0500 Subject: [PATCH 033/503] fix typo --- R/Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index b162ddf5f8..61bef6141b 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1822,7 +1822,7 @@ seq_zeros <- function( padding <- 1 + num_zeros # make sequence - new_seq <- str_pad(string = seq, pad = 0, width = padding, side = "left") + new_seq <- str_pad(string = seq_length, pad = 0, width = padding, side = "left") return(new_seq) } From 613dd73e43bd984cbae0e2f002945602c6286d5b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:04:35 -0500 Subject: [PATCH 034/503] fix single use case --- R/Utilities.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/Utilities.R b/R/Utilities.R index 61bef6141b..ec20a56f89 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1821,6 +1821,11 @@ seq_zeros <- function( # add pad value padding <- 1 + num_zeros + # make sequence if single number + if (length(x = seq_length) == 1) { + seq_length <- seq_len(1:seq_length) + } + # make sequence new_seq <- str_pad(string = seq_length, pad = 0, width = padding, side = "left") From b680d6be4928467b70a7487e42b114dc8375814d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:05:59 -0500 Subject: [PATCH 035/503] typo --- R/Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index ec20a56f89..50153c5596 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1823,7 +1823,7 @@ seq_zeros <- function( # make sequence if single number if (length(x = seq_length) == 1) { - seq_length <- seq_len(1:seq_length) + seq_length <- seq_len(seq_length) } # make sequence From 525583f0f003a2b85d74e72af3451c1f26649f72 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:10:22 -0500 Subject: [PATCH 036/503] update manual --- R/Utilities.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index 50153c5596..b06a09f564 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1781,7 +1781,8 @@ Split_Vector <- function( #' Create sequence with zeros #' -#' Create sequences of numbers like `seq()` but with 0 prefixed to keep numerical order +#' Create sequences of numbers like `seq()` or `seq_len()` but with zeros prefixed to +#' keep numerical order #' #' @param seq_length a seqeunce or numbers of numbers to create sequence. #' Users can provide sequence (1:XX) or number of values to add in sequence (will From 5973fae0c9b17d194b785435d7a0c54e12186b0f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:18:43 -0500 Subject: [PATCH 037/503] update docs --- man/seq_zeros.Rd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/man/seq_zeros.Rd b/man/seq_zeros.Rd index bfcffddd9c..2811d1ad86 100644 --- a/man/seq_zeros.Rd +++ b/man/seq_zeros.Rd @@ -17,7 +17,8 @@ be used as second number in \code{seq_len}; 1:XX).} vector of numbers in sequence } \description{ -Create sequences of numbers like \code{seq()} but with 0 prefixed to keep numerical order +Create sequences of numbers like \code{seq()} or \code{seq_len()} but with zeros prefixed to +keep numerical order } \examples{ # Using sequence From 1b7969fc530ab432e32f353bf4032160896f2d0f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 8 Mar 2024 15:18:54 -0500 Subject: [PATCH 038/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fb25e5fcef..6c35241980 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9007 +Version: 2.1.2.9008 Date: 2024-03-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")), From 8f857292e42414268f5216495db1458afdc7eea7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 15:09:56 -0400 Subject: [PATCH 039/503] begin prep for new style liger objects. add new util to pull dimreduc coordinates --- R/LIGER_Utilities.R | 54 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b810757c4d..9677bd8fd0 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -129,6 +129,60 @@ Top_Genes_Factor <- function( } +#' Extract dimensionality reduction coordinates from Liger object +#' +#' Extract data.frame containing dimensionality reduction coordinates from new format of +#' Liger objects +#' +#' @param liger_object LIGER object name. +#' @param reduction name of dimensionality reduction stored in cellMeta slot. Default is +#' "UMAP") +#' +#' @return dimensionality reduction coordinates in 2 column format +#' +#' @import cli +#' @importFrom merthods slotNames +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' umap_coords <- LIGER_DimReduc(liger_object = object) +#' } +#' + +LIGER_DimReduc <- function( + liger_object, + reduction = NULL +) { + # Check new liger object + if (!"cellMeta" %in% slotNames(liger_object)) { + cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + } + + # check reduction in cellMeta + if (reduction %in% names(x = liger_object@cellMeta)) { + # check the right dims + if (length(dim(liger_object@cellMeta[[reduction]])) != 2) { + cli_abort(message = "The cellMeta entry {.field {reduction}} is not 2-dimensional entry.") + } else { + # get coords + reduc_coords <- liger_object@cellMeta[[reduction]] + + # add colnames + colnames(reduc_coords) <- paste0(reduction, "_", 1:2) + } + } else { + cli_abort("The reduction {.field {reduction}} is not present in cellMeta slot.") + } + + # return coords + return(reduc_coords) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### QC UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From 72245f694a2f73441bbe82ef0a34c8ebccd6ac3d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 15:10:36 -0400 Subject: [PATCH 040/503] typo --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 9677bd8fd0..8c901cf514 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -141,7 +141,7 @@ Top_Genes_Factor <- function( #' @return dimensionality reduction coordinates in 2 column format #' #' @import cli -#' @importFrom merthods slotNames +#' @importFrom methods slotNames #' #' @export #' From cb19f8d0d0c72858db668601900c5a0d1b0139f5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 15:10:46 -0400 Subject: [PATCH 041/503] update docs --- NAMESPACE | 2 ++ man/LIGER_DimReduc.Rd | 28 ++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+) create mode 100644 man/LIGER_DimReduc.Rd diff --git a/NAMESPACE b/NAMESPACE index 7b2a433ea3..d07da68e1a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ export(Iterate_Plot_Density_Custom) export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) +export(LIGER_DimReduc) export(LIGER_Features) export(Liger_to_Seurat) export(MAD_Stats) @@ -237,6 +238,7 @@ importFrom(methods,as) importFrom(methods,hasArg) importFrom(methods,new) importFrom(methods,slot) +importFrom(methods,slotNames) importFrom(paletteer,paletteer_c) importFrom(paletteer,paletteer_d) importFrom(patchwork,plot_annotation) diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd new file mode 100644 index 0000000000..5dc66e4d53 --- /dev/null +++ b/man/LIGER_DimReduc.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{LIGER_DimReduc} +\alias{LIGER_DimReduc} +\title{Extract dimensionality reduction coordinates from Liger object} +\usage{ +LIGER_DimReduc(liger_object, reduction = NULL) +} +\arguments{ +\item{liger_object}{LIGER object name.} + +\item{reduction}{name of dimensionality reduction stored in cellMeta slot. Default is +"UMAP")} +} +\value{ +dimensionality reduction coordinates in 2 column format +} +\description{ +Extract data.frame containing dimensionality reduction coordinates from new format of +Liger objects +} +\examples{ +\dontrun{ +umap_coords <- LIGER_DimReduc(liger_object = object) +} + +} +\concept{liger_object_util} From c548813aebfefa16cc4c9f7d1546670cea9087e4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 15:12:14 -0400 Subject: [PATCH 042/503] update changelog --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index b87b9d33ae..ef07afd539 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## Added - Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. - Added new function `seq_zeros` to create sequences with preceding zeros. +- Added new functions to interact with upcoming liger object format change: + - `LIGER_DimReduc` to extract dimensionality reduction coordinates. From 98b7c2dbef2149f47ee3e8e1a2b121886f8e206c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 15:12:34 -0400 Subject: [PATCH 043/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6c35241980..f64aa235e9 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" RRID:SCR_024675. -Version: 2.1.2.9008 -Date: 2024-03-08 +Version: 2.1.2.9009 +Date: 2024-03-11 Authors@R: c( person(given = "Samuel", family = "Marsh", email = "samuel.marsh@childrens.harvard.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3012-6945")), person(given = "Ming", family = "Tang", role = c("ctb"), email = "tangming2005@gmail.com"), From 5ea5517b8073cd467bdb4e173dcca6a4f5d06e13 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:04:23 -0400 Subject: [PATCH 044/503] create rliger version specific plotFactors functions --- R/LIGER_Utilities.R | 650 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 649 insertions(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 8c901cf514..8c496cd669 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -137,6 +137,7 @@ Top_Genes_Factor <- function( #' @param liger_object LIGER object name. #' @param reduction name of dimensionality reduction stored in cellMeta slot. Default is #' "UMAP") +#' @param check_only logical, return `TRUE` if valid reduction is present. #' #' @return dimensionality reduction coordinates in 2 column format #' @@ -155,7 +156,8 @@ Top_Genes_Factor <- function( LIGER_DimReduc <- function( liger_object, - reduction = NULL + reduction = NULL, + check_only = FALSE ) { # Check new liger object if (!"cellMeta" %in% slotNames(liger_object)) { @@ -168,6 +170,9 @@ LIGER_DimReduc <- function( if (length(dim(liger_object@cellMeta[[reduction]])) != 2) { cli_abort(message = "The cellMeta entry {.field {reduction}} is not 2-dimensional entry.") } else { + if (isTRUE(x = check_only)) { + return(TRUE) + } # get coords reduc_coords <- liger_object@cellMeta[[reduction]] @@ -1021,6 +1026,649 @@ Plot_By_Meta_LIGER <- function( } +#' Customized version of plotFactors +#' +#' Modified and optimized version of `plotFactors` function from LIGER package. +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function +#' @param num_genes Number of genes to display for each factor (Default 8). +#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be +#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction +#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), +#' @param pt.size_factors Adjust point size for plotting in the factor plots. +#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. +#' @param reduction Name of dimensionality reduction to use for plotting. +#' @param reduction_label `r lifecycle::badge("deprecated")` deprecated for newer style liger +#' objects. Use `reduction` instead. +#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. +#' Helpful if number of datasets is large to avoid crowding the plot with legend. +#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the +#' dimensionality reduction plots (Default = FALSE). +#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. +#' @param save_plots logical. Whether to save plots. Default is TRUE +#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) +#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). +#' @param reorder_datasets `r lifecycle::badge("deprecated")` deprecated for newer style liger objects +#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "varibow" palette. +#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. +#' +#' @return A list of ggplot/patchwork objects and/or PDF file. +#' +#' @import cli +#' @import ggplot2 +#' @importFrom grDevices dev.off pdf +#' @importFrom lifecycle deprecated +#' @importFrom patchwork wrap_plots +#' @importFrom scattermore geom_scattermore +#' +#' @export +#' +#' @concept liger_plotting +#' +#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) +#' @references Based on `plotFactors` functionality from original LIGER package. +#' +#' @examples +#' \dontrun{ +#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, +#' raster = FALSE, save_plots = TRUE) +#' } +#' + +plotFactors_liger2_scCustom <- function( + liger_object, + num_genes = 8, + colors_use_factors = NULL, + colors_use_dimreduc = c('lemonchiffon', 'red'), + pt.size_factors = 1, + pt.size_dimreduc = 1, + reduction = "UMAP", + reduction_label = deprecated(), + plot_legend = TRUE, + raster = TRUE, + raster.dpi = c(512, 512), + order = FALSE, + plot_dimreduc = TRUE, + save_plots = TRUE, + file_path = NULL, + file_name = NULL, + return_plots = FALSE, + cells.highlight = NULL, + reorder_datasets = deprecated(), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # Check is slot is supplied + if (lifecycle::is_present(reorder_datasets)) { + lifecycle::deprecate_warn(when = "2.2.0", + what = "plotFactors_scCustom(reorder_datasets)", + details = c("i" = "The {.code reorder_datasets} parameter is deprecated for newer style Liger objects.",) + ) + } + + # Check is slot is supplied + if (lifecycle::is_present(reduction_label)) { + lifecycle::deprecate_warn(when = "2.2.0", + what = "plotFactors_scCustom(reduction_label)", + details = c("v" = "The {.code reduction_label} parameter is deprecated for newer style Liger objects.", + "i" = "Use {.code reduction} parameter instead") + ) + } + + # if returning and saving + if (isTRUE(x = save_plots)) { + # Check file path is valid + if (!is.null(x = file_path) && file_path != "") { + if (!dir.exists(paths = file_path)) { + cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") + } + } + + # 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 <- "" + } + + # Check if file name provided + file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) + if (length(x = file_ext) == 0) { + file_name <- file_name + } else { + file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) + } + + if (is.null(x = file_name)) { + cli_abort(message = c("No file name provided.", + "i" = "Please provide a file name using {.code file_name}.") + ) + } + } + + # Extract dataset number + num_datasets <- length(x = liger_object@datasets) + + # Default Colors for Factor Plots + if (is.null(x = colors_use_factors)) { + 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) + } + } + + # Check valid number of colors for tsne/UMAP + if (length(x = colors_use_dimreduc) < 2) { + cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", + "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + ) + } + + # Get Data and Plot Factors + cli_inform(message = "{.field Generating plots}") + k <- ncol(x = liger_object@H.norm) + pb <- txtProgressBar(min = 0, max = k, style = 3) + W <- liger_object@W + rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) + Hs_norm <- liger_object@H.norm + dataset_names <- names(liger_object@datasets) + H_raw_list <- lapply(1:num_datasets, function(x){ + H_raw <- t(liger_object@datasets[[x]]@H) + }) + H_raw = do.call(rbind, H_raw_list) + # Create accurate axis labels + reduc_check <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction, check_only = TRUE) + x_axis_label <- paste0(reduction, "_1") + y_axis_label <- paste0(reduction, "_2") + plot_list = list() + tsne_list = list() + for (i in 1:k) { + top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] + top_genes.W.string <- paste0(top_genes.W, collapse = ", ") + factor_textstring <- paste0("Factor", i) + plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") + h_df = data.frame(x = 1:nrow(Hs_norm), h_norm = Hs_norm[, i], + h_raw = H_raw[, i], dataset = liger_object@cellMeta$dataset, + highlight = FALSE) + 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') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } else { + top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'Raw H Score') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } + + if (!is.null(cells.highlight)) { + h_df[cells.highlight, 'highlight'] = TRUE + if (isTRUE(x = raster)) { + top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + } else { + top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + size = pt.size_factors) + bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + size = pt.size_factors) + } + } + full <- wrap_plots(top, bottom, ncol = 1) + plot_list[[i]] = full + + # plot tSNE/UMAP + if (isTRUE(x = plot_dimreduc)) { + tsne_df <- data.frame(Hs_norm[, i], LIGER_DimReduc(liger_object = liger_object, reduction = reduction)) + factorlab <- paste0("Factor", i) + colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) + + if (isTRUE(x = order)) { + tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] + } + + 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)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } else { + p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + + geom_point(size = pt.size_dimreduc) + + ggtitle(label = paste('Factor', i)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } + + tsne_list[[i]] = p1 + } + setTxtProgressBar(pb, i) + } + + # 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 (isTRUE(x = plot_dimreduc)) { + print(plot_list[[i]]) + print(tsne_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } else { + print(plot_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } + } + close(con = pb) + dev.off() + } + + # return plots + if (isTRUE(x = return_plots)) { + return(list(factor_plots = plot_list, + dimreduc_plots = tsne_list)) + } +} + + +#' Customized version of plotFactors +#' +#' Modified and optimized version of `plotFactors` function from LIGER package. +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function +#' @param num_genes Number of genes to display for each factor (Default 8). +#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be +#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction +#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), +#' @param pt.size_factors Adjust point size for plotting in the factor plots. +#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. +#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of +#' technique and therefore needs to be set manually. Default is "UMAP". +#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. +#' Helpful if number of datasets is large to avoid crowding the plot with legend. +#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the +#' dimensionality reduction plots (Default = FALSE). +#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. +#' @param save_plots logical. Whether to save plots. Default is TRUE +#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) +#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). +#' @param reorder_datasets New order to plot datasets in for the factor plots if different from current +#' factor level order in cell.data slot. +#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "varibow" palette. +#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. +#' +#' @return A list of ggplot/patchwork objects and/or PDF file. +#' +#' @import cli +#' @import ggplot2 +#' @importFrom grDevices dev.off pdf +#' @importFrom patchwork wrap_plots +#' @importFrom scattermore geom_scattermore +#' +#' @export +#' +#' @concept liger_plotting +#' +#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) +#' @references Based on `plotFactors` functionality from original LIGER package. +#' +#' @examples +#' \dontrun{ +#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, +#' raster = FALSE, save_plots = TRUE) +#' } +#' + +plotFactors_liger_scCustom <- function( + liger_object, + num_genes = 8, + colors_use_factors = NULL, + colors_use_dimreduc = c('lemonchiffon', 'red'), + pt.size_factors = 1, + pt.size_dimreduc = 1, + reduction_label = "UMAP", + plot_legend = TRUE, + raster = TRUE, + raster.dpi = c(512, 512), + order = FALSE, + plot_dimreduc = TRUE, + save_plots = TRUE, + file_path = NULL, + file_name = NULL, + return_plots = FALSE, + cells.highlight = NULL, + reorder_datasets = NULL, + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # if returning and saving + if (isTRUE(x = save_plots)) { + + # Check file path is valid + if (!is.null(x = file_path) && file_path != "") { + if (!dir.exists(paths = file_path)) { + cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") + } + } + + # 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 <- "" + } + + # Check if file name provided + file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) + if (length(x = file_ext) == 0) { + file_name <- file_name + } else { + file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) + } + + if (is.null(x = file_name)) { + cli_abort(message = c("No file name provided.", + "i" = "Please provide a file name using {.code file_name}.") + ) + } + } + + if (!is.null(x = reorder_datasets)) { + # Check new order contains same dataset names and number of datasets + if (length(x = levels(x = liger_object@cell.data$dataset)) != length(x = reorder_datasets)) { + cli_abort(message = c("Error reordering datasets (number mismatch).", + "i" = "The number of datasets provided to {.code reorder_datasets} ({.field {length(x = reorder_datasets)}}) does not match number of datasets in LIGER object ({.field {length(x = levels(x = levels(liger_object@cell.data$dataset)))}}).") + ) + } else { + if (!all(levels(x = liger_object@cell.data$dataset) %in% reorder_datasets)) { + cli_abort(message = c("Error reordering datasets (name mismatch).", + "*" = "Dataset names provided to {.code reorder_datasets} do not match names of datasets in LIGER object.", + "i" = "Please check spelling.") + ) + } else { + liger_object@cell.data$dataset <- factor(x = liger_object@cell.data$dataset, levels = reorder_datasets) + } + } + } + + # Create accurate axis labels + x_axis_label <- paste0(reduction_label, "_1") + y_axis_label <- paste0(reduction_label, "_2") + + # Extract dataset number + num_datasets <- length(x = liger_object@scale.data) + + # Default Colors for Factor Plots + if (is.null(x = colors_use_factors)) { + 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) + } + } + + # Check valid number of colors for tsne/UMAP + if (length(x = colors_use_dimreduc) < 2) { + cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", + "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + ) + } + + # Add one time dim label warning + if (getOption(x = 'scCustomize_warn_LIGER_dim_labels_plotFactors', default = TRUE)) { + cli_inform(message = c("", + "NOTE: {.field plotFactors_scCustom} uses the {.code reduction_label} parameter to set axis labels", + "on the dimensionality reduction plots.", + "By default this is set to {.val UMAP}.", + "Please take note of this parameter as LIGER objects do not store the name", + "of reduction technique used and therefore this needs to be set manually.", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_LIGER_dim_labels_plotFactors = FALSE) + } + + # Get Data and Plot Factors + cli_inform(message = "{.field Generating plots}") + k <- ncol(x = liger_object@H.norm) + pb <- txtProgressBar(min = 0, max = k, style = 3) + W <- t(x = liger_object@W) + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) + Hs_norm <- liger_object@H.norm + H_raw = do.call(rbind, liger_object@H) + plot_list = list() + tsne_list = list() + for (i in 1:k) { + top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] + top_genes.W.string <- paste0(top_genes.W, collapse = ", ") + factor_textstring <- paste0("Factor", i) + plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") + 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 (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') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } else { + top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'Raw H Score') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } + + if (!is.null(cells.highlight)) { + h_df[cells.highlight, 'highlight'] = TRUE + if (isTRUE(x = raster)) { + top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + } else { + top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + size = pt.size_factors) + bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + size = pt.size_factors) + } + } + full <- wrap_plots(top, bottom, ncol = 1) + plot_list[[i]] = full + + # plot tSNE/UMAP + 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 (isTRUE(x = order)) { + tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] + } + + 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)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } else { + p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + + geom_point(size = pt.size_dimreduc) + + ggtitle(label = paste('Factor', i)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } + + tsne_list[[i]] = p1 + } + setTxtProgressBar(pb, i) + } + + # 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 (isTRUE(x = plot_dimreduc)) { + print(plot_list[[i]]) + print(tsne_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } else { + print(plot_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } + } + close(con = pb) + dev.off() + } + + # return plots + if (isTRUE(x = return_plots)) { + return(list(factor_plots = plot_list, + dimreduc_plots = tsne_list)) + } +} + + + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### ANALYSIS UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From a0a98ff27a5a6f35b6d8cb18fd133708203a8dd9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:04:57 -0400 Subject: [PATCH 045/503] no export --- R/LIGER_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 8c496cd669..7b4c40b897 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1069,7 +1069,7 @@ Plot_By_Meta_LIGER <- function( #' @importFrom patchwork wrap_plots #' @importFrom scattermore geom_scattermore #' -#' @export +#' @noRd #' #' @concept liger_plotting #' @@ -1384,7 +1384,7 @@ plotFactors_liger2_scCustom <- function( #' @importFrom patchwork wrap_plots #' @importFrom scattermore geom_scattermore #' -#' @export +#' @noRd #' #' @concept liger_plotting #' From d31858890d0b59f3670e0320a93a50d50351fe20 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:05:22 -0400 Subject: [PATCH 046/503] dimreduc update docs --- man/LIGER_DimReduc.Rd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd index 5dc66e4d53..753ef3f719 100644 --- a/man/LIGER_DimReduc.Rd +++ b/man/LIGER_DimReduc.Rd @@ -4,13 +4,15 @@ \alias{LIGER_DimReduc} \title{Extract dimensionality reduction coordinates from Liger object} \usage{ -LIGER_DimReduc(liger_object, reduction = NULL) +LIGER_DimReduc(liger_object, reduction = NULL, check_only = FALSE) } \arguments{ \item{liger_object}{LIGER object name.} \item{reduction}{name of dimensionality reduction stored in cellMeta slot. Default is "UMAP")} + +\item{check_only}{logical, return \code{TRUE} if valid reduction is present.} } \value{ dimensionality reduction coordinates in 2 column format From 124f419fc716fd8fc665e72e80a04c7db9d039a0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:24:12 -0400 Subject: [PATCH 047/503] plotFactors dual version compatibility --- R/LIGER_Plotting.R | 296 ++++++++------------------------------------- 1 file changed, 51 insertions(+), 245 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 2b4fee1793..c4e77234fd 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -267,8 +267,11 @@ DimPlot_LIGER <- function( #' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), #' @param pt.size_factors Adjust point size for plotting in the factor plots. #' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. +#' @param reduction Name of dimensionality reduction to use for plotting. Default is "UMAP". +#' Only for newer style liger objects. #' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of #' technique and therefore needs to be set manually. Default is "UMAP". +#' Only for older style liger objects. #' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. #' Helpful if number of datasets is large to avoid crowding the plot with legend. #' @param raster Convert points to raster format. Default is NULL which will rasterize by default if @@ -284,7 +287,7 @@ DimPlot_LIGER <- function( #' @param return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) #' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). #' @param reorder_datasets New order to plot datasets in for the factor plots if different from current -#' factor level order in cell.data slot. +#' factor level order in cell.data slot. Only for older style liger objects. #' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using #' default ggplot2 "hue" palette instead of default "varibow" palette. #' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. @@ -294,9 +297,9 @@ DimPlot_LIGER <- function( #' @import cli #' @import ggplot2 #' @importFrom grDevices dev.off pdf +#' @importFrom lifecycle deprecated #' @importFrom patchwork wrap_plots #' @importFrom scattermore geom_scattermore -#' @importFrom utils packageVersion #' #' @export #' @@ -334,257 +337,60 @@ plotFactors_scCustom <- function( ggplot_default_colors = FALSE, color_seed = 123 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # Check LIGER Is_LIGER(liger_object = liger_object) - # if returning and saving - if (isTRUE(x = save_plots)) { - - # Check file path is valid - if (!is.null(x = file_path) && file_path != "") { - if (!dir.exists(paths = file_path)) { - cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") - } - } - - # 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 <- "" - } - - # Check if file name provided - file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) - if (length(x = file_ext) == 0) { - file_name <- file_name - } else { - file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) - } - - if (is.null(x = file_name)) { - cli_abort(message = c("No file name provided.", - "i" = "Please provide a file name using {.code file_name}.") - ) - } - } - - if (!is.null(x = reorder_datasets)) { - # Check new order contains same dataset names and number of datasets - if (length(x = levels(x = liger_object@cell.data$dataset)) != length(x = reorder_datasets)) { - cli_abort(message = c("Error reordering datasets (number mismatch).", - "i" = "The number of datasets provided to {.code reorder_datasets} ({.field {length(x = reorder_datasets)}}) does not match number of datasets in LIGER object ({.field {length(x = levels(x = levels(liger_object@cell.data$dataset)))}}).") - ) - } else { - if (!all(levels(x = liger_object@cell.data$dataset) %in% reorder_datasets)) { - cli_abort(message = c("Error reordering datasets (name mismatch).", - "*" = "Dataset names provided to {.code reorder_datasets} do not match names of datasets in LIGER object.", - "i" = "Please check spelling.") - ) - } else { - liger_object@cell.data$dataset <- factor(x = liger_object@cell.data$dataset, levels = reorder_datasets) - } - } - } - - # Create accurate axis labels - x_axis_label <- paste0(reduction_label, "_1") - y_axis_label <- paste0(reduction_label, "_2") - - # Extract dataset number - num_datasets <- length(x = liger_object@scale.data) - - # Default Colors for Factor Plots - if (is.null(x = colors_use_factors)) { - 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) - } - } - - # Check valid number of colors for tsne/UMAP - if (length(x = colors_use_dimreduc) < 2) { - cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", - "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + # rliger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + plotFactors_liger2_scCustom(liger_object = liger_object, + num_genes = num_genes, + colors_use_factors = colors_use_factors, + colors_use_dimreduc = colors_use_dimreduc, + pt.size_factors = pt.size_factors, + pt.size_dimreduc = pt.size_dimreduc, + reduction = reduction, + reduction_label = reduction_label, + plot_legend = plot_legend, + raster = raster, + raster.dpi = raster.dpi, + order = order, + plot_dimreduc = plot_dimreduc, + save_plots = save_plots, + file_path = file_path, + file_name = file_name, + return_plots = return_plots, + cells.highlight = cells.highlight, + reorder_datasets = reorder_datasets, + ggplot_default_colors = ggplot_default_colors, + color_seed = color_seed + ) + } else { + plotFactors_liger_scCustom(liger_object = liger_object, + num_genes = num_genes, + colors_use_factors = colors_use_factors, + colors_use_dimreduc = colors_use_dimreduc, + pt.size_factors = pt.size_factors, + pt.size_dimreduc = pt.size_dimreduc, + reduction = reduction, + reduction_label = reduction_label, + plot_legend = plot_legend, + raster = raster, + raster.dpi = raster.dpi, + order = order, + plot_dimreduc = plot_dimreduc, + save_plots = save_plots, + file_path = file_path, + file_name = file_name, + return_plots = return_plots, + cells.highlight = cells.highlight, + reorder_datasets = reorder_datasets, + ggplot_default_colors = ggplot_default_colors, + color_seed = color_seed ) } - # Add one time dim label warning - if (getOption(x = 'scCustomize_warn_LIGER_dim_labels_plotFactors', default = TRUE)) { - cli_inform(message = c("", - "NOTE: {.field plotFactors_scCustom} uses the {.code reduction_label} parameter to set axis labels", - "on the dimensionality reduction plots.", - "By default this is set to {.val UMAP}.", - "Please take note of this parameter as LIGER objects do not store the name", - "of reduction technique used and therefore this needs to be set manually.", - "", - "-----This message will be shown once per session.-----")) - options(scCustomize_warn_LIGER_dim_labels_plotFactors = FALSE) - } - - # Get Data and Plot Factors - cli_inform(message = "{.field Generating plots}") - k <- ncol(x = liger_object@H.norm) - pb <- txtProgressBar(min = 0, max = k, style = 3) - W <- t(x = liger_object@W) - rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) - Hs_norm <- liger_object@H.norm - H_raw = do.call(rbind, liger_object@H) - plot_list = list() - tsne_list = list() - for (i in 1:k) { - top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] - top_genes.W.string <- paste0(top_genes.W, collapse = ", ") - factor_textstring <- paste0("Factor", i) - plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") - 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 (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') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } - } else { - top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'Raw H Score') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } - } - - if (!is.null(cells.highlight)) { - h_df[cells.highlight, 'highlight'] = TRUE - if (isTRUE(x = raster)) { - top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - } else { - top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - size = pt.size_factors) - bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - size = pt.size_factors) - } - } - full <- wrap_plots(top, bottom, ncol = 1) - plot_list[[i]] = full - - # plot tSNE/UMAP - 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 (isTRUE(x = order)) { - tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] - } - - 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)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } else { - p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + - geom_point(size = pt.size_dimreduc) + - ggtitle(label = paste('Factor', i)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } - - tsne_list[[i]] = p1 - } - setTxtProgressBar(pb, i) - } - - # 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 (isTRUE(x = plot_dimreduc)) { - print(plot_list[[i]]) - print(tsne_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } else { - print(plot_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } - } - close(con = pb) - dev.off() - } - - # return plots - if (isTRUE(x = return_plots)) { - return(list(factor_plots = plot_list, - dimreduc_plots = tsne_list)) - } } From 298a81f3290717da2147b0676568ad5db919693d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:24:19 -0400 Subject: [PATCH 048/503] Update docs --- man/plotFactors_scCustom.Rd | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/man/plotFactors_scCustom.Rd b/man/plotFactors_scCustom.Rd index 8e8ff5260e..5ea1a1f0e8 100644 --- a/man/plotFactors_scCustom.Rd +++ b/man/plotFactors_scCustom.Rd @@ -43,7 +43,8 @@ coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'),} \item{pt.size_dimreduc}{Adjust point size for plotting in dimensionality reduction plots.} \item{reduction_label}{What to label the x and y axes of resulting plots. LIGER does not store name of -technique and therefore needs to be set manually. Default is "UMAP".} +technique and therefore needs to be set manually. Default is "UMAP". +Only for older style liger objects.} \item{plot_legend}{logical, whether to plot the legend on factor loading plots, default is TRUE. Helpful if number of datasets is large to avoid crowding the plot with legend.} @@ -70,12 +71,15 @@ dimensionality reduction plots (Default = FALSE).} \item{cells.highlight}{Names of specific cells to highlight in plot (black) (default NULL).} \item{reorder_datasets}{New order to plot datasets in for the factor plots if different from current -factor level order in cell.data slot.} +factor level order in cell.data slot. Only for older style liger objects.} \item{ggplot_default_colors}{logical. If \code{colors_use_factors = NULL}, Whether or not to return plot using default ggplot2 "hue" palette instead of default "varibow" palette.} \item{color_seed}{random seed for the palette shuffle if \code{colors_use_factors = NULL}. Default = 123.} + +\item{reduction}{Name of dimensionality reduction to use for plotting. Default is "UMAP". +Only for newer style liger objects.} } \value{ A list of ggplot/patchwork objects and/or PDF file. From 328937689911f9eba68d765e01fad02f3d3a8e4d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:26:08 -0400 Subject: [PATCH 049/503] update changelog --- NEWS.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index ef07afd539..be3b759399 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,11 @@ # scCustomize 2.X.X (2024-XX-XX) ## Added - Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. -- Added new function `seq_zeros` to create sequences with preceding zeros. +- Added new function `seq_zeros()` to create sequences with preceding zeros. - Added new functions to interact with upcoming liger object format change: - - `LIGER_DimReduc` to extract dimensionality reduction coordinates. + - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. +- Updated functions to interact with both old and new style liger objects: + - `plotFactors_scCustom()`. From bdf50d7dc3f36f5113026e27963c16cf7d4dbbb4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:26:23 -0400 Subject: [PATCH 050/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f64aa235e9..e32353ad52 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9009 +Version: 2.1.2.9010 Date: 2024-03-11 Authors@R: c( person(given = "Samuel", family = "Marsh", email = "samuel.marsh@childrens.harvard.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3012-6945")), From e8d072645a7bb3c74f932e372dd620efa66d330e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 16:28:43 -0400 Subject: [PATCH 051/503] fix parameter --- R/LIGER_Plotting.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index c4e77234fd..6f3c613708 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -371,7 +371,6 @@ plotFactors_scCustom <- function( colors_use_dimreduc = colors_use_dimreduc, pt.size_factors = pt.size_factors, pt.size_dimreduc = pt.size_dimreduc, - reduction = reduction, reduction_label = reduction_label, plot_legend = plot_legend, raster = raster, From 2bb82332a1e5be4fc5563922b2a8b0709abbc6b9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:28:22 -0400 Subject: [PATCH 052/503] update to new liger object format --- R/LIGER_Utilities.R | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 7b4c40b897..269f88cd68 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -13,13 +13,12 @@ Fetch_Meta.liger <- function( ... ) { if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + object_meta <- rliger2::cellMeta(x = object, as.data.frame = TRUE) + } else { + object_meta <- object_meta <- slot(object = object, name = "cell.data") } - # Pull meta data - object_meta <- object_meta <- slot(object = object, name = "cell.data") - + # return meta return(object_meta) } @@ -55,19 +54,24 @@ LIGER_Features <- function( liger_object, by_dataset = FALSE ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - + # check liger Is_LIGER(liger_object = liger_object) - # Extract features - features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { - rownames(x = liger_object@raw.data[[x]]) - }) + # liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + # Extract features + features_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { + rownames(x = liger_object@datasets[[x]]@featureMeta) + }) + + } else { + # Extract features + features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { + rownames(x = liger_object@raw.data[[x]]) + }) + } + # Return features if (isFALSE(x = by_dataset)) { features <- unique(x = unlist(x = features_by_dataset)) return(features) From ba7b3186687e3b69c799d132bdcc28a4b9c2af0e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:28:30 -0400 Subject: [PATCH 053/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index be3b759399..4415b5b8f9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ - Added new functions to interact with upcoming liger object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - Updated functions to interact with both old and new style liger objects: - - `plotFactors_scCustom()`. + - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, . From 3b921f629878b08f0ac85740827b5f940ddaf684 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:28:42 -0400 Subject: [PATCH 054/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e32353ad52..a114299bd4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9010 +Version: 2.1.2.9011 Date: 2024-03-11 Authors@R: c( person(given = "Samuel", family = "Marsh", email = "samuel.marsh@childrens.harvard.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3012-6945")), From d97fb96e4554144f23f4e574667a72ff94f41392 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:31:53 -0400 Subject: [PATCH 055/503] fix version check for dev testing --- R/LIGER_Plotting.R | 2 +- R/LIGER_Utilities.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 6f3c613708..accab33c2a 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -341,7 +341,7 @@ plotFactors_scCustom <- function( Is_LIGER(liger_object = liger_object) # rliger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { + if (packageVersion(pkg = 'rliger2') > "1.0.1") { plotFactors_liger2_scCustom(liger_object = liger_object, num_genes = num_genes, colors_use_factors = colors_use_factors, diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 269f88cd68..4d352a58d0 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -12,7 +12,7 @@ Fetch_Meta.liger <- function( object, ... ) { - if (packageVersion(pkg = 'rliger') > "1.0.1") { + if (packageVersion(pkg = 'rliger2') > "1.0.1") { object_meta <- rliger2::cellMeta(x = object, as.data.frame = TRUE) } else { object_meta <- object_meta <- slot(object = object, name = "cell.data") @@ -58,7 +58,7 @@ LIGER_Features <- function( Is_LIGER(liger_object = liger_object) # liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { + if (packageVersion(pkg = 'rliger2') > "1.0.1") { # Extract features features_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { rownames(x = liger_object@datasets[[x]]@featureMeta) From 2e1208e37263e543ec6a98d53d8c27f46d98fdab Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:34:19 -0400 Subject: [PATCH 056/503] fix error --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 4d352a58d0..36e9008716 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1114,7 +1114,7 @@ plotFactors_liger2_scCustom <- function( if (lifecycle::is_present(reorder_datasets)) { lifecycle::deprecate_warn(when = "2.2.0", what = "plotFactors_scCustom(reorder_datasets)", - details = c("i" = "The {.code reorder_datasets} parameter is deprecated for newer style Liger objects.",) + details = c("i" = "The {.code reorder_datasets} parameter is deprecated for newer style Liger objects.") ) } From 097a88721748d126074e724fd490a79d876e5ed9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:36:24 -0400 Subject: [PATCH 057/503] fix reduction --- R/LIGER_Plotting.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index accab33c2a..094ec33555 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -322,6 +322,7 @@ plotFactors_scCustom <- function( colors_use_dimreduc = c('lemonchiffon', 'red'), pt.size_factors = 1, pt.size_dimreduc = 1, + reduction = "UMAP", reduction_label = "UMAP", plot_legend = TRUE, raster = TRUE, From 87e163b47d10a032d2cf613c163d2902d6235d70 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 20:36:44 -0400 Subject: [PATCH 058/503] fix --- man/plotFactors_scCustom.Rd | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/man/plotFactors_scCustom.Rd b/man/plotFactors_scCustom.Rd index 5ea1a1f0e8..68d47c5fc2 100644 --- a/man/plotFactors_scCustom.Rd +++ b/man/plotFactors_scCustom.Rd @@ -11,6 +11,7 @@ plotFactors_scCustom( colors_use_dimreduc = c("lemonchiffon", "red"), pt.size_factors = 1, pt.size_dimreduc = 1, + reduction = "UMAP", reduction_label = "UMAP", plot_legend = TRUE, raster = TRUE, @@ -42,6 +43,9 @@ coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'),} \item{pt.size_dimreduc}{Adjust point size for plotting in dimensionality reduction plots.} +\item{reduction}{Name of dimensionality reduction to use for plotting. Default is "UMAP". +Only for newer style liger objects.} + \item{reduction_label}{What to label the x and y axes of resulting plots. LIGER does not store name of technique and therefore needs to be set manually. Default is "UMAP". Only for older style liger objects.} @@ -77,9 +81,6 @@ factor level order in cell.data slot. Only for older style liger objects.} default ggplot2 "hue" palette instead of default "varibow" palette.} \item{color_seed}{random seed for the palette shuffle if \code{colors_use_factors = NULL}. Default = 123.} - -\item{reduction}{Name of dimensionality reduction to use for plotting. Default is "UMAP". -Only for newer style liger objects.} } \value{ A list of ggplot/patchwork objects and/or PDF file. From 676f2de412fd550e4ddd8c4e1069a3f57c83dd45 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 22:57:05 -0400 Subject: [PATCH 059/503] topfactors compatible --- R/LIGER_Utilities.R | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 36e9008716..aed9ddfd49 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -109,12 +109,6 @@ Top_Genes_Factor <- function( liger_factor, num_genes = 10 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # LIGER object check Is_LIGER(liger_object = liger_object) @@ -125,11 +119,19 @@ Top_Genes_Factor <- function( ) } - # Extract genes - W <- t(liger_object@W) - rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) - top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] - return(top_genes) + # temp liger version check + if (packageVersion(pkg = 'rliger2') > "1.0.1") { + W <- liger_object@W + rownames(x = W) <- rownames(x = csf_liger@datasets[[1]]@scaleData) + top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] + return(top_genes) + } else { + # Extract genes + W <- t(liger_object@W) + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) + top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] + return(top_genes) + } } From 220177f3a1822e913cb1bad4940824c6b736ffea Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 22:57:27 -0400 Subject: [PATCH 060/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 4415b5b8f9..4549d51175 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ - Added new functions to interact with upcoming liger object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - Updated functions to interact with both old and new style liger objects: - - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, . + - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. From aee0d9f51281661bc5c4f8f71dce46a2881014ba Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 22:57:42 -0400 Subject: [PATCH 061/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a114299bd4..02456a971d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9011 +Version: 2.1.2.9012 Date: 2024-03-11 Authors@R: c( person(given = "Samuel", family = "Marsh", email = "samuel.marsh@childrens.harvard.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3012-6945")), From 01371c883eed7dc9574e2b22e8f8a504d26b8ff0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 11 Mar 2024 23:14:32 -0400 Subject: [PATCH 062/503] style --- R/LIGER_Plotting.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 094ec33555..69679927d3 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -388,9 +388,4 @@ plotFactors_scCustom <- function( color_seed = color_seed ) } - - - - - } From 2b8b91f79653cc83b21f940dfcb0aea77e1ca309 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 09:03:14 -0400 Subject: [PATCH 063/503] liger factor cor --- R/LIGER_Utilities.R | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index aed9ddfd49..b0d3536fab 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -194,6 +194,44 @@ LIGER_DimReduc <- function( } +#' Find Factor Correlations +#' +#' Calculate correlations between gene loadings for all factors in liger object. +#' +#' @param liger_object LIGER object name. +#' +#' @return correlation matrix +#' +#' @import cli +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' factor_correlations <- Find_Factor_Cor(liger_object = object) +#' } +#' + +Find_Factor_Cor <- function( + liger_object +) { + Is_LIGER(liger_object = liger_object) + + # Get loadings + factor_loadings <- data.frame(rliger2::getMatrix(x = liger_object, slot = "W")) + + # Rename is zero padding + colnames(x = factor_loadings) <- paste0("Factor_", seq_zeros(seq_length = ncol(x = factor_loadings), num_zeros = 1)) + + # Correlation + cor_mat <- cor(x = factor_loadings) + + return(cor_mat) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### QC UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From 8cb6a257b45ea9013b99a61a8bad91959762bfc1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 09:03:21 -0400 Subject: [PATCH 064/503] update docs --- man/Find_Factor_Cor.Rd | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 man/Find_Factor_Cor.Rd diff --git a/man/Find_Factor_Cor.Rd b/man/Find_Factor_Cor.Rd new file mode 100644 index 0000000000..be40dd22ce --- /dev/null +++ b/man/Find_Factor_Cor.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{Find_Factor_Cor} +\alias{Find_Factor_Cor} +\title{Find Factor Correlations} +\usage{ +Find_Factor_Cor(liger_object) +} +\arguments{ +\item{liger_object}{LIGER object name.} +} +\value{ +correlation matrix +} +\description{ +Calculate correlations between gene loadings for all factors in liger object. +} +\examples{ +\dontrun{ +factor_correlations <- Find_Factor_Cor(liger_object = object) +} + +} +\concept{liger_object_util} From 544c06e67c011be3d215090fa6f0ce8476550241 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 09:03:30 -0400 Subject: [PATCH 065/503] update namespace --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index d07da68e1a..03a66d612a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ export(FeaturePlot_scCustom) export(FeatureScatter_scCustom) export(Feature_Present) export(Fetch_Meta) +export(Find_Factor_Cor) export(Gene_Present) export(Hue_Pal) export(Iterate_Barcode_Rank_Plot) From 38c9e14fe8b868e028cc62059ab5d2839ab5e37c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 09:04:40 -0400 Subject: [PATCH 066/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 4549d51175..e7eb63117a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. +- Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. From c5c43abcf5c893613569a9ebac7266168285667b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 09:04:59 -0400 Subject: [PATCH 067/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 02456a971d..52a844833f 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" RRID:SCR_024675. -Version: 2.1.2.9012 -Date: 2024-03-11 +Version: 2.1.2.9013 +Date: 2024-03-13 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"), From 033287bae692576a4e0820a1d7fd134489059a76 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:08:07 -0400 Subject: [PATCH 068/503] update plotting --- R/Plotting_Utilities.R | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 4395185194..054cd57aaa 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -1472,6 +1472,44 @@ Test_Integer <- function( } +#' Modify correlation matrix +#' +#' Modify correlation matrix to keep bottom diagonal values. +#' +#' @param cor_mat correlation matrix created with `cor`. +#' +#' @return modified correlation matrix +#' +#' @noRd +#' + +lower_diag_cor_mat <- function( + cor_mat +) { + new_cormat[upper.tri(x = cor_mat)] <- NA + return(new_cormat) +} + + +#' Modify correlation matrix +#' +#' Modify correlation matrix to keep top diagonal values. +#' +#' @param cor_mat correlation matrix created with `cor`. +#' +#' @return modified correlation matrix +#' +#' @noRd +#' + +upper_diag_cor_mat <- function( + cormat +) { + cor_mat[lower.tri(x = cor_mat)]<- NA + return(cor_mat) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### GGPLOT2/THEMES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From 8c1b60f4727da437930883ee38295053c17c264e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:08:23 -0400 Subject: [PATCH 069/503] add cor plotting --- R/Statistics_Plotting.R | 106 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index a5e1accb3e..4a8277f4b6 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -869,3 +869,109 @@ CellBender_Diff_Plot <- function( # return plot return(plot) } + + +#' Correlation plot +#' +#' Plot of results of correlation matrix using ggplot2 and `geom_tile` +#' +#' @param cor_mat correlation matrix +#' @param colors_use Color palette to use for correlation values. Default is `viridis`. +#' Users can also supply vector of 3 colors (low, mid, high). +#' @param label logical, whether to add correlation values to plot result. +#' @param label_threshold threshold for adding correlation values if `label = TRUE`. Default +#' is 0.5. +#' @param label_size size of correlation labels +#' @param plot_title Plot title. +#' @param plot_type Controls plotting full matrix, or just the upper or lower triangles. +#' Accepted values are: "full" (default), "upper", or "lower". +#' @param x_lab_rotate logical, whether to rotate the axes labels on the x-axis. Default is TRUE +#' +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' @importFrom cowplot theme_cowplot +#' @importFrom dplyr arrange any_of +#' @importFrom magrittr "%>%" +#' @importFrom tibble rownames_to_column +#' @importFrom tidyr drop_na pivot_longer +#' +#' @export +#' +#' @concept stats_plotting +#' +#' @examples +#' \dontrun{ +#' Cor_Plot(cor_mat = cor_mat) +#'} +#' + +Cor_Plot <- function( + cor_mat, + colors_use = viridis_light_high, + label = FALSE, + label_threshold = 0.5, + label_size = 5, + plot_title = NULL, + plot_type = "full", + x_lab_rotate = TRUE +) { + # check plot type + if (!plot_type %in% c("full", "lower", "upper")) { + cli_abort(message = "{.code plot_type} must be one of {.field {glue_collapse_scCustom(input_string = c('full', 'lower,', 'upper'), and = FALSE)}}") + } + + # filter matrix by plot type + if (plot_type == "upper") { + plot_df <- upper_diag_cor_mat(cor_mat = cor_mat) + } + + if (plot_type == "lower") { + plot_df <- lower_diag_cor_mat(cor_mat = cor_mat) + } + + if (plot_type == "full") { + plot_df <- cor_mat + } + + # Reshape for plotting + plot_df <- data.frame(plot_df) %>% + rownames_to_column("rowname") %>% + pivot_longer(cols = !any_of("rowname"), names_to = "Var", values_to = "corr") %>% + drop_na() + + plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) + + if (isTRUE(x = label)) { + plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) + plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) + } + + factor_names <- levels(plot_df$rowname) + + # plot + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + + theme_cowplot() + + geom_tile() + + scale_y_discrete(limits = factor_names) + + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + + xlab("") + + ylab("") + + # modify plot + if (isTRUE(x = label)) { + plot <- suppressMessages(plot + geom_text(aes(label=label), size = label_size)) + } + + if (!is.null(x = plot_title)) { + plot <- plot + ggtitle(plot_title) + theme(plot.title = element_text(hjust = 0.5)) + } + + if (isTRUE(x = x_lab_rotate)) { + plot <- plot + RotatedAxis() + } + + # return plot + return(plot) +} From 7aa70b9764e6a909ff9bbb164aac04685e7a7b02 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:08:52 -0400 Subject: [PATCH 070/503] Update docs --- man/Cor_Plot.Rd | 50 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 man/Cor_Plot.Rd diff --git a/man/Cor_Plot.Rd b/man/Cor_Plot.Rd new file mode 100644 index 0000000000..959cbebbd5 --- /dev/null +++ b/man/Cor_Plot.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Statistics_Plotting.R +\name{Cor_Plot} +\alias{Cor_Plot} +\title{Correlation plot} +\usage{ +Cor_Plot( + cor_mat, + colors_use = viridis_light_high, + label = FALSE, + label_threshold = 0.5, + label_size = 5, + plot_title = NULL, + plot_type = "full", + x_lab_rotate = TRUE +) +} +\arguments{ +\item{cor_mat}{correlation matrix} + +\item{colors_use}{Color palette to use for correlation values. Default is \code{viridis}. +Users can also supply vector of 3 colors (low, mid, high).} + +\item{label}{logical, whether to add correlation values to plot result.} + +\item{label_threshold}{threshold for adding correlation values if \code{label = TRUE}. Default +is 0.5.} + +\item{label_size}{size of correlation labels} + +\item{plot_title}{Plot title.} + +\item{plot_type}{Controls plotting full matrix, or just the upper or lower triangles. +Accepted values are: "full" (default), "upper", or "lower".} + +\item{x_lab_rotate}{logical, whether to rotate the axes labels on the x-axis. Default is TRUE} +} +\value{ +A ggplot object +} +\description{ +Plot of results of correlation matrix using ggplot2 and \code{geom_tile} +} +\examples{ +\dontrun{ +Cor_Plot(cor_mat = cor_mat) +} + +} +\concept{stats_plotting} From d1b8e32fa94528a6e4c7a5e384984ddd67be5347 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:20:57 -0400 Subject: [PATCH 071/503] update docs --- man/{Cor_Plot.Rd => Factor_Cor_Plot.Rd} | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) rename man/{Cor_Plot.Rd => Factor_Cor_Plot.Rd} (70%) diff --git a/man/Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd similarity index 70% rename from man/Cor_Plot.Rd rename to man/Factor_Cor_Plot.Rd index 959cbebbd5..ca3bd44156 100644 --- a/man/Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Statistics_Plotting.R -\name{Cor_Plot} -\alias{Cor_Plot} -\title{Correlation plot} +% Please edit documentation in R/LIGER_Plotting.R +\name{Factor_Cor_Plot} +\alias{Factor_Cor_Plot} +\title{Factor Correlation Plot} \usage{ -Cor_Plot( - cor_mat, +Factor_Cor_Plot( + liger_object, colors_use = viridis_light_high, label = FALSE, label_threshold = 0.5, @@ -16,8 +16,6 @@ Cor_Plot( ) } \arguments{ -\item{cor_mat}{correlation matrix} - \item{colors_use}{Color palette to use for correlation values. Default is \code{viridis}. Users can also supply vector of 3 colors (low, mid, high).} @@ -34,17 +32,20 @@ is 0.5.} Accepted values are: "full" (default), "upper", or "lower".} \item{x_lab_rotate}{logical, whether to rotate the axes labels on the x-axis. Default is TRUE} + +\item{cor_mat}{correlation matrix} } \value{ A ggplot object } \description{ -Plot of results of correlation matrix using ggplot2 and \code{geom_tile} +Plot positive correlations between gene loadings across \code{W} factor matrix in liger object. +Any negative correlations are set to NA and NA values set to bottom color of color gradient. } \examples{ \dontrun{ -Cor_Plot(cor_mat = cor_mat) +Factor_Cor_Plot(liger_object = obj) } } -\concept{stats_plotting} +\concept{liger_plotting} From d94ee7bf0a8ccd7350eb79bc88865e4db221ccef Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:21:05 -0400 Subject: [PATCH 072/503] reorg --- R/LIGER_Plotting.R | 109 ++++++++++++++++++++++++++++++++++++++++ R/Statistics_Plotting.R | 106 -------------------------------------- 2 files changed, 109 insertions(+), 106 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 69679927d3..fdd3dcd367 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -389,3 +389,112 @@ plotFactors_scCustom <- function( ) } } + + +#' Factor Correlation Plot +#' +#' Plot positive correlations between gene loadings across `W` factor matrix in liger object. +#' Any negative correlations are set to NA and NA values set to bottom color of color gradient. +#' +#' @param cor_mat correlation matrix +#' @param colors_use Color palette to use for correlation values. Default is `viridis`. +#' Users can also supply vector of 3 colors (low, mid, high). +#' @param label logical, whether to add correlation values to plot result. +#' @param label_threshold threshold for adding correlation values if `label = TRUE`. Default +#' is 0.5. +#' @param label_size size of correlation labels +#' @param plot_title Plot title. +#' @param plot_type Controls plotting full matrix, or just the upper or lower triangles. +#' Accepted values are: "full" (default), "upper", or "lower". +#' @param x_lab_rotate logical, whether to rotate the axes labels on the x-axis. Default is TRUE +#' +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' @importFrom cowplot theme_cowplot +#' @importFrom dplyr arrange any_of +#' @importFrom magrittr "%>%" +#' @importFrom tibble rownames_to_column +#' @importFrom tidyr drop_na pivot_longer +#' +#' @export +#' +#' @concept liger_plotting +#' +#' @examples +#' \dontrun{ +#' Factor_Cor_Plot(liger_object = obj) +#'} +#' + +Factor_Cor_Plot <- function( + liger_object, + colors_use = viridis_light_high, + label = FALSE, + label_threshold = 0.5, + label_size = 5, + plot_title = NULL, + plot_type = "full", + x_lab_rotate = TRUE +) { + # check plot type + if (!plot_type %in% c("full", "lower", "upper")) { + cli_abort(message = "{.code plot_type} must be one of {.field {glue_collapse_scCustom(input_string = c('full', 'lower,', 'upper'), and = FALSE)}}") + } + + cor_mat <- Find_Factor_Cor(liger_object = liger_object) + + # filter matrix by plot type + if (plot_type == "upper") { + plot_df <- upper_diag_cor_mat(cor_mat = cor_mat) + } + + if (plot_type == "lower") { + plot_df <- lower_diag_cor_mat(cor_mat = cor_mat) + } + + if (plot_type == "full") { + plot_df <- cor_mat + } + + # Reshape for plotting + plot_df <- data.frame(plot_df) %>% + rownames_to_column("rowname") %>% + pivot_longer(cols = !any_of("rowname"), names_to = "Var", values_to = "corr") %>% + drop_na() + + plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) + + if (isTRUE(x = label)) { + plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) + plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) + } + + factor_names <- levels(plot_df$rowname) + + # plot + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + + theme_cowplot() + + geom_tile() + + scale_y_discrete(limits = factor_names) + + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + + xlab("") + + ylab("") + + # modify plot + if (isTRUE(x = label)) { + plot <- suppressMessages(plot + geom_text(aes(label=label), size = label_size)) + } + + if (!is.null(x = plot_title)) { + plot <- plot + ggtitle(plot_title) + theme(plot.title = element_text(hjust = 0.5)) + } + + if (isTRUE(x = x_lab_rotate)) { + plot <- plot + RotatedAxis() + } + + # return plot + return(plot) +} diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index 4a8277f4b6..a5e1accb3e 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -869,109 +869,3 @@ CellBender_Diff_Plot <- function( # return plot return(plot) } - - -#' Correlation plot -#' -#' Plot of results of correlation matrix using ggplot2 and `geom_tile` -#' -#' @param cor_mat correlation matrix -#' @param colors_use Color palette to use for correlation values. Default is `viridis`. -#' Users can also supply vector of 3 colors (low, mid, high). -#' @param label logical, whether to add correlation values to plot result. -#' @param label_threshold threshold for adding correlation values if `label = TRUE`. Default -#' is 0.5. -#' @param label_size size of correlation labels -#' @param plot_title Plot title. -#' @param plot_type Controls plotting full matrix, or just the upper or lower triangles. -#' Accepted values are: "full" (default), "upper", or "lower". -#' @param x_lab_rotate logical, whether to rotate the axes labels on the x-axis. Default is TRUE -#' -#' @return A ggplot object -#' -#' @import cli -#' @import ggplot2 -#' @importFrom cowplot theme_cowplot -#' @importFrom dplyr arrange any_of -#' @importFrom magrittr "%>%" -#' @importFrom tibble rownames_to_column -#' @importFrom tidyr drop_na pivot_longer -#' -#' @export -#' -#' @concept stats_plotting -#' -#' @examples -#' \dontrun{ -#' Cor_Plot(cor_mat = cor_mat) -#'} -#' - -Cor_Plot <- function( - cor_mat, - colors_use = viridis_light_high, - label = FALSE, - label_threshold = 0.5, - label_size = 5, - plot_title = NULL, - plot_type = "full", - x_lab_rotate = TRUE -) { - # check plot type - if (!plot_type %in% c("full", "lower", "upper")) { - cli_abort(message = "{.code plot_type} must be one of {.field {glue_collapse_scCustom(input_string = c('full', 'lower,', 'upper'), and = FALSE)}}") - } - - # filter matrix by plot type - if (plot_type == "upper") { - plot_df <- upper_diag_cor_mat(cor_mat = cor_mat) - } - - if (plot_type == "lower") { - plot_df <- lower_diag_cor_mat(cor_mat = cor_mat) - } - - if (plot_type == "full") { - plot_df <- cor_mat - } - - # Reshape for plotting - plot_df <- data.frame(plot_df) %>% - rownames_to_column("rowname") %>% - pivot_longer(cols = !any_of("rowname"), names_to = "Var", values_to = "corr") %>% - drop_na() - - plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) - - if (isTRUE(x = label)) { - plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) - plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) - } - - factor_names <- levels(plot_df$rowname) - - # plot - plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + - theme_cowplot() + - geom_tile() + - scale_y_discrete(limits = factor_names) + - scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + - xlab("") + - ylab("") - - # modify plot - if (isTRUE(x = label)) { - plot <- suppressMessages(plot + geom_text(aes(label=label), size = label_size)) - } - - if (!is.null(x = plot_title)) { - plot <- plot + ggtitle(plot_title) + theme(plot.title = element_text(hjust = 0.5)) - } - - if (isTRUE(x = x_lab_rotate)) { - plot <- plot + RotatedAxis() - } - - # return plot - return(plot) -} From c211e9c994f58a228b74819bede4456f980fb585 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:21:14 -0400 Subject: [PATCH 073/503] update namespace --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 03a66d612a..cfdcf6c4cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ export(DotPlot_scCustom) export(Extract_Modality) export(Extract_Sample_Meta) export(Extract_Top_Markers) +export(Factor_Cor_Plot) export(FeaturePlot_DualAssay) export(FeaturePlot_scCustom) export(FeatureScatter_scCustom) From 3be8d282203b33238636d21c38b1e0d464106f80 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:26:39 -0400 Subject: [PATCH 074/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e7eb63117a..dd2d9898c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,7 +7,7 @@ - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - +- Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. ## Changed From 56f8309b12c1ee4e2241c70b95f3b8cdfd248700 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 13 Mar 2024 13:26:56 -0400 Subject: [PATCH 075/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 52a844833f..1e3e533566 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9013 +Version: 2.1.2.9014 Date: 2024-03-13 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")), From 87937a56bd110eb1d3b3aef9a21f6d8f0055b025 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:25:44 -0400 Subject: [PATCH 076/503] revert rliger2 to rliger following development update --- R/LIGER_Plotting.R | 2 +- R/LIGER_Utilities.R | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index fdd3dcd367..0700373e88 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -342,7 +342,7 @@ plotFactors_scCustom <- function( Is_LIGER(liger_object = liger_object) # rliger version check - if (packageVersion(pkg = 'rliger2') > "1.0.1") { + if (packageVersion(pkg = 'rliger') > "1.0.1") { plotFactors_liger2_scCustom(liger_object = liger_object, num_genes = num_genes, colors_use_factors = colors_use_factors, diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b0d3536fab..a21b2b30c0 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -12,8 +12,8 @@ Fetch_Meta.liger <- function( object, ... ) { - if (packageVersion(pkg = 'rliger2') > "1.0.1") { - object_meta <- rliger2::cellMeta(x = object, as.data.frame = TRUE) + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object_meta <- rliger::cellMeta(x = object, as.data.frame = TRUE) } else { object_meta <- object_meta <- slot(object = object, name = "cell.data") } @@ -58,12 +58,11 @@ LIGER_Features <- function( Is_LIGER(liger_object = liger_object) # liger version check - if (packageVersion(pkg = 'rliger2') > "1.0.1") { + if (packageVersion(pkg = 'rliger') > "1.0.1") { # Extract features features_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { rownames(x = liger_object@datasets[[x]]@featureMeta) }) - } else { # Extract features features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { @@ -120,7 +119,7 @@ Top_Genes_Factor <- function( } # temp liger version check - if (packageVersion(pkg = 'rliger2') > "1.0.1") { + if (packageVersion(pkg = 'rliger') > "1.0.1") { W <- liger_object@W rownames(x = W) <- rownames(x = csf_liger@datasets[[1]]@scaleData) top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] From 1c7ec7ec1eda6e263e416e6284e2c56a0859c74e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:26:37 -0400 Subject: [PATCH 077/503] update rliger --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index a21b2b30c0..b4916445bb 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -219,7 +219,7 @@ Find_Factor_Cor <- function( Is_LIGER(liger_object = liger_object) # Get loadings - factor_loadings <- data.frame(rliger2::getMatrix(x = liger_object, slot = "W")) + factor_loadings <- data.frame(rliger::getMatrix(x = liger_object, slot = "W")) # Rename is zero padding colnames(x = factor_loadings) <- paste0("Factor_", seq_zeros(seq_length = ncol(x = factor_loadings), num_zeros = 1)) From f84148bc015419c0b87fa2299efe8a11a92860b0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:26:57 -0400 Subject: [PATCH 078/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1e3e533566..a38298857c 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" RRID:SCR_024675. -Version: 2.1.2.9014 -Date: 2024-03-13 +Version: 2.1.2.9015 +Date: 2024-03-14 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"), From 23908258537ab73aa197c3f74cca9fa3c260294f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:56:19 -0400 Subject: [PATCH 079/503] Add hemo percentage function --- R/Generics.R | 19 ++++++ R/Object_Utilities.R | 158 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 177 insertions(+) diff --git a/R/Generics.R b/R/Generics.R index 39e7cd6ab8..772d8b1a71 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -57,6 +57,25 @@ Add_Mito_Ribo <- function(object, ...) { } +#' Add Hemoglobin percentages +#' +#' Add hemoglobin percentages to meta.data slot of Seurat Object or +#' cell.data slot of Liger object +#' +#' @param object Seurat or LIGER object +#' @param ... Arguments passed to other methods +#' +#' @return An object of the same class as `object` with columns added to object meta data. +#' +#' @rdname Add_Hemo +#' @export Add_Hemo +#' + +Add_Hemo <- function(object, ...) { + UseMethod(generic = 'Add_Hemo', object = object) +} + + #' Add Cell Complexity #' #' Add measure of cell complexity/novelty (log10GenesPerUMI) for data QC. diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 81b5542844..7432bf054f 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -511,6 +511,164 @@ Add_Mito_Ribo.Seurat <- function( } +#' @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 hemo_pattern values. +#' @param hemo_name name to use for the new meta.data column containing percent hemoglobin counts. +#' Default is "percent_hemo". +#' @param hemo_pattern A regex pattern to match features against for hemoglobin genes (will set automatically if +#' species is mouse or human; marmoset features list saved separately). +#' @param hemo_features A list of hemoglobin gene names to be used instead of using regex pattern. +#' @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 `hemo_name` is +#' present in meta.data slot. +#' @param list_species_names returns list of all accepted values to use for default species names which +#' contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and +#' rhesus macaque). Default is FALSE. +#' +#' @import cli +#' @importFrom dplyr mutate select intersect all_of +#' @importFrom magrittr "%>%" +#' @importFrom rlang ":=" +#' @importFrom Seurat PercentageFeatureSet AddMetaData +#' @importFrom tibble rownames_to_column column_to_rownames +#' +#' @method Add_Hemo Seurat +#' +#' @export +#' @rdname Add_Hemo +#' +#' @concept qc_util +#' +#' @examples +#' \dontrun{ +#' # Seurat +#' seurat_object <- Add_Hemo(object = seurat_object, species = "human") +#'} +#' + +Add_Hemo.Seurat <- function( + object, + species, + hemo_name = "percent_mito", + hemo_pattern = NULL, + hemo_features = NULL, + assay = NULL, + overwrite = FALSE, + list_species_names = FALSE, + ... +) { + # 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) + ) + + # Return list of accepted default species name options + if (isTRUE(x = list_species_names)) { + return(accepted_names) + stop_quietly() + } + + # Check Seurat + Is_Seurat(seurat_object = object) + + # Overwrite check + if (hemo_name %in% colnames(x = object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Columns with {.val {hemo_name}} already present in meta.data slot.", + "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE} or change {.code hemo_name}*") + ) + } + cli_inform(message = c("Columns with {.val {hemo_name}} already present in meta.data slot.", + "i" = "Overwriting column as {.code overwrite = TRUE.}") + ) + } + + # Checks species + if (is.null(x = species)) { + cli_abort(message = c("No species name or abbreivation was provided to {.code species} parameter.", + "i" = "If not using default species please set {.code species = other}.") + ) + } + + # Set default assay + assay <- assay %||% DefaultAssay(object = object) + + # 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 + + # Assign mito/ribo pattern to stored species + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options) && any(!is.null(x = hemo_pattern))) { + cli_warn(message = c("Pattern expressions for included species are set by default.", + "*" = "Supplied {.code hemo_pattern} and {.code hemo_pattern} will be disregarded.", + "i" = "To override defaults please supply a feature list for hemo genes.") + ) + } + + if (species %in% mouse_options) { + hemo_pattern <- "^Hb[^(P)]" + } + if (species %in% human_options) { + hemo_pattern <- "^HB[^(P)]" + } + if (species %in% c(marmoset_options, macaque_options)) { + hemo_pattern <- "^^HB[^(P)]" + } + if (species %in% zebrafish_options) { + hemo_pattern <- "^hb[^(P)]" + } + if (species %in% rat_options) { + hemo_pattern <- "^Hb[^(P)]" + } + if (species %in% drosophila_options) { + hemo_pattern <- "^glob" + } + + # Check that values are provided for mito and ribo + if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { + cli_abort(message = c("No features or patterns provided for hemo genes.", + "i" = "Please provide a default species name or pattern/features.")) + } + + hemo_features <- hemo_features %||% grep(pattern = hemo_pattern, x = rownames(x = object[[assay]]), value = TRUE) + + # Check features are present in object + length_hemo_features <- length(x = intersect(x = hemo_features, y = rownames(x = object[[assay]]))) + + # Check length of hemo features found in object + if (length_hemo_features < 1) { + cli_warn(message = c("No Hemo features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") + ) + } + + # Add hemo columns + if (length_hemo_features > 0) { + good_hemo <- hemo_features[hemo_features %in% rownames(x = object)] + object[[hemo_name]] <- PercentageFeatureSet(object = object, features = good_hemo, assay = assay) + } + + # Log Command + object <- LogSeuratCommand(object = object) + + # return final object + return(object) +} + + #' Add Cell Complexity Value #' #' @param meta_col_name name to use for new meta data column. Default is "log10GenesPerUMI". From 4fa6f795a5834b7c50fa6fcc93ca1841bf16df70 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:56:26 -0400 Subject: [PATCH 080/503] Update docs --- man/Add_Hemo.Rd | 63 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 man/Add_Hemo.Rd diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd new file mode 100644 index 0000000000..b259213ccd --- /dev/null +++ b/man/Add_Hemo.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Generics.R, R/Object_Utilities.R +\name{Add_Hemo} +\alias{Add_Hemo} +\alias{Add_Hemo.Seurat} +\title{Add Hemoglobin percentages} +\usage{ +Add_Hemo(object, ...) + +\method{Add_Hemo}{Seurat}( + object, + species, + hemo_name = "percent_mito", + hemo_pattern = NULL, + hemo_features = NULL, + assay = NULL, + overwrite = FALSE, + list_species_names = FALSE, + ... +) +} +\arguments{ +\item{object}{Seurat or LIGER object} + +\item{...}{Arguments passed to other methods} + +\item{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 hemo_pattern values.} + +\item{hemo_name}{name to use for the new meta.data column containing percent hemoglobin counts. +Default is "percent_hemo".} + +\item{hemo_pattern}{A regex pattern to match features against for hemoglobin genes (will set automatically if +species is mouse or human; marmoset features list saved separately).} + +\item{hemo_features}{A list of hemoglobin gene names to be used instead of using regex pattern.} + +\item{assay}{Assay to use (default is the current object default assay).} + +\item{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 \code{hemo_name} is +present in meta.data slot.} + +\item{list_species_names}{returns list of all accepted values to use for default species names which +contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and +rhesus macaque). Default is FALSE.} +} +\value{ +An object of the same class as \code{object} with columns added to object meta data. +} +\description{ +Add hemoglobin percentages to meta.data slot of Seurat Object or +cell.data slot of Liger object +} +\examples{ +\dontrun{ +# Seurat +seurat_object <- Add_Hemo(object = seurat_object, species = "human") +} + +} +\concept{qc_util} From d7b612bd803c4b10f9af2640dcc6ad47ed039d71 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 10:56:37 -0400 Subject: [PATCH 081/503] Update namespace --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index cfdcf6c4cb..c99ca83951 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(Add_Cell_Complexity,Seurat) S3method(Add_Cell_Complexity,liger) +S3method(Add_Hemo,Seurat) S3method(Add_Mito_Ribo,Seurat) S3method(Add_Mito_Ribo,liger) S3method(Fetch_Meta,Seurat) @@ -17,6 +18,7 @@ export(Add_Cell_Complexity) export(Add_Cell_Complexity_LIGER) export(Add_Cell_Complexity_Seurat) export(Add_Cell_QC_Metrics) +export(Add_Hemo) export(Add_Mito_Ribo) export(Add_Mito_Ribo_LIGER) export(Add_Mito_Ribo_Seurat) From 1e10009af6a9b650940a05e1c4efdd52a112d9e3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:05:18 -0400 Subject: [PATCH 082/503] add hemo to master qc function --- R/Object_Utilities.R | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 7432bf054f..42a5d812e3 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -98,6 +98,7 @@ Merge_Seurat_List <- function( #' 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_hemo logical, whether to add percentage of counts belonging to homoglobin 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, @@ -120,14 +121,20 @@ Merge_Seurat_List <- function( #' @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 hemo_name name to use for the new meta.data column containing percent hemoglobin counts. +#' Default is "percent_mito". #' @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). +#' (will set automatically if species is in default list). +#' @param hemo_pattern A regex pattern to match features against for hemoglobin genes +#' (will set automatically if species is in default list). #' @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 hemo_features A list of hemoglobin 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. @@ -159,6 +166,7 @@ Add_Cell_QC_Metrics <- function( add_top_pct = TRUE, add_MSigDB = TRUE, add_IEG = TRUE, + add_hemo = TRUE, add_cell_cycle = TRUE, species, mito_name = "percent_mito", @@ -170,10 +178,13 @@ Add_Cell_QC_Metrics <- function( apop_name = "percent_apop", dna_repair_name = "percent_dna_repair", ieg_name = "percent_ieg", + hemo_name = "percent_hemo", mito_pattern = NULL, ribo_pattern = NULL, + hemo_pattern = NULL, mito_features = NULL, ribo_features = NULL, + hemo_features = NULL, ensembl_ids = FALSE, num_top_genes = 50, assay = NULL, @@ -242,6 +253,13 @@ Add_Cell_QC_Metrics <- function( } } + # Add hemo + if (isTRUE(x = add_hemo)) { + cli_inform(message = "Adding {.field Hemo Percentages} to meta.data.") + seurat_object <- Add_Hemo(object = seurat_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, assay = assay, overwrite = overwrite) + } + + # Add cell cycle 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.", @@ -551,7 +569,7 @@ Add_Mito_Ribo.Seurat <- function( Add_Hemo.Seurat <- function( object, species, - hemo_name = "percent_mito", + hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, assay = NULL, From d1ea5ba1bab6c44ac90ae3b1cf580c250f7bdac1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:05:30 -0400 Subject: [PATCH 083/503] Update docs --- man/Add_Cell_QC_Metrics.Rd | 17 ++++++++++++++++- man/Add_Hemo.Rd | 2 +- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/man/Add_Cell_QC_Metrics.Rd b/man/Add_Cell_QC_Metrics.Rd index 7890b8afd2..2201657e27 100644 --- a/man/Add_Cell_QC_Metrics.Rd +++ b/man/Add_Cell_QC_Metrics.Rd @@ -11,6 +11,7 @@ Add_Cell_QC_Metrics( add_top_pct = TRUE, add_MSigDB = TRUE, add_IEG = TRUE, + add_hemo = TRUE, add_cell_cycle = TRUE, species, mito_name = "percent_mito", @@ -22,10 +23,13 @@ Add_Cell_QC_Metrics( apop_name = "percent_apop", dna_repair_name = "percent_dna_repair", ieg_name = "percent_ieg", + hemo_name = "percent_hemo", mito_pattern = NULL, ribo_pattern = NULL, + hemo_pattern = NULL, mito_features = NULL, ribo_features = NULL, + hemo_features = NULL, ensembl_ids = FALSE, num_top_genes = 50, assay = NULL, @@ -48,6 +52,8 @@ object (Default is TRUE).} \item{add_IEG}{logical, whether to add percentage of counts belonging to IEG genes to object (Default is TRUE).} +\item{add_hemo}{logical, whether to add percentage of counts belonging to homoglobin genes to object (Default is TRUE).} + \item{add_cell_cycle}{logical, whether to addcell cycle scores and phase based on \code{\link[Seurat]{CellCycleScoring}}. Only applicable if \code{species = "human"}. (Default is TRUE).} @@ -81,11 +87,17 @@ counts. Default is "percent_dna_repair"..} \item{ieg_name}{name to use for new meta data column for percentage of IEG counts. Default is "percent_ieg".} +\item{hemo_name}{name to use for the new meta.data column containing percent hemoglobin counts. +Default is "percent_mito".} + \item{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).} \item{ribo_pattern}{A regex pattern to match features against for ribosomal genes -(will set automatically if species is mouse, human, or marmoset).} +(will set automatically if species is in default list).} + +\item{hemo_pattern}{A regex pattern to match features against for hemoglobin genes +(will set automatically if species is in default list).} \item{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).} @@ -93,6 +105,9 @@ Will override regex pattern if both are present (including default saved regex p \item{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).} +\item{hemo_features}{A list of hemoglobin gene names to be used instead of using regex pattern. +Will override regex pattern if both are present (including default saved regex patterns).} + \item{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).} diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index b259213ccd..bc1bd68749 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -10,7 +10,7 @@ Add_Hemo(object, ...) \method{Add_Hemo}{Seurat}( object, species, - hemo_name = "percent_mito", + hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, assay = NULL, From 75c67ba327fce3c5dca6c21d2cc43bd13219e66f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:08:00 -0400 Subject: [PATCH 084/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index dd2d9898c1..ea2e6dc54b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,7 @@ - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. +- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. ## Changed From 760871e43f72cc6513975ad417f29fac2e3e72de Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:11:00 -0400 Subject: [PATCH 085/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a38298857c..df5b6b5001 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9015 +Version: 2.1.2.9016 Date: 2024-03-14 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")), From 4807d11b40dc35f69aebb85d9d20a2e745b10419 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:20:18 -0400 Subject: [PATCH 086/503] update description --- R/Generics.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Generics.R b/R/Generics.R index 772d8b1a71..6f979ce3b3 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -60,7 +60,7 @@ Add_Mito_Ribo <- function(object, ...) { #' Add Hemoglobin percentages #' #' Add hemoglobin percentages to meta.data slot of Seurat Object or -#' cell.data slot of Liger object +#' cell.data/cellMeta slot of Liger object #' #' @param object Seurat or LIGER object #' @param ... Arguments passed to other methods From 2aa07c0d88eaacedd4917f657c17437df77d7f98 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 11:20:44 -0400 Subject: [PATCH 087/503] update docs --- man/Add_Hemo.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index bc1bd68749..c9958c358d 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -51,7 +51,7 @@ An object of the same class as \code{object} with columns added to object meta d } \description{ Add hemoglobin percentages to meta.data slot of Seurat Object or -cell.data slot of Liger object +cell.data/cellMeta slot of Liger object } \examples{ \dontrun{ From 39fcd73476828376e28103838019e28b44caace3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 19:39:03 -0400 Subject: [PATCH 088/503] fix cormat helper --- R/Plotting_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 054cd57aaa..333e068c49 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -1503,7 +1503,7 @@ lower_diag_cor_mat <- function( #' upper_diag_cor_mat <- function( - cormat + cor_mat ) { cor_mat[lower.tri(x = cor_mat)]<- NA return(cor_mat) From 6beffcbcafb8fba2d4bc8fb50b50fd47888ca950 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 19:39:16 -0400 Subject: [PATCH 089/503] Update generic --- R/Generics.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Generics.R b/R/Generics.R index 6f979ce3b3..2a3172bb13 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -71,8 +71,8 @@ Add_Mito_Ribo <- function(object, ...) { #' @export Add_Hemo #' -Add_Hemo <- function(object, ...) { - UseMethod(generic = 'Add_Hemo', object = object) +Add_Hemo <- function(object, species, ...) { + UseMethod(generic = 'Add_Hemo', object = object, species = species) } From 13fdb6715542890743b9c75f36ae8502efa3e2b3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 19:39:48 -0400 Subject: [PATCH 090/503] add_hemo update --- man/Add_Hemo.Rd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index c9958c358d..6866e72434 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -5,7 +5,7 @@ \alias{Add_Hemo.Seurat} \title{Add Hemoglobin percentages} \usage{ -Add_Hemo(object, ...) +Add_Hemo(object, species, ...) \method{Add_Hemo}{Seurat}( object, @@ -22,12 +22,12 @@ Add_Hemo(object, ...) \arguments{ \item{object}{Seurat or LIGER object} -\item{...}{Arguments passed to other methods} - \item{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 hemo_pattern values.} +\item{...}{Arguments passed to other methods} + \item{hemo_name}{name to use for the new meta.data column containing percent hemoglobin counts. Default is "percent_hemo".} From 648f19089f351b83b3df851bf917bd46982b77eb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 20:37:14 -0400 Subject: [PATCH 091/503] change generic --- R/Generics.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Generics.R b/R/Generics.R index 2a3172bb13..6f979ce3b3 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -71,8 +71,8 @@ Add_Mito_Ribo <- function(object, ...) { #' @export Add_Hemo #' -Add_Hemo <- function(object, species, ...) { - UseMethod(generic = 'Add_Hemo', object = object, species = species) +Add_Hemo <- function(object, ...) { + UseMethod(generic = 'Add_Hemo', object = object) } From ecb43c3ee3c9effcddb613057ed405c310bb08fb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 20:37:30 -0400 Subject: [PATCH 092/503] revert --- man/Add_Hemo.Rd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index 6866e72434..c9958c358d 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -5,7 +5,7 @@ \alias{Add_Hemo.Seurat} \title{Add Hemoglobin percentages} \usage{ -Add_Hemo(object, species, ...) +Add_Hemo(object, ...) \method{Add_Hemo}{Seurat}( object, @@ -22,12 +22,12 @@ Add_Hemo(object, species, ...) \arguments{ \item{object}{Seurat or LIGER object} +\item{...}{Arguments passed to other methods} + \item{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 hemo_pattern values.} -\item{...}{Arguments passed to other methods} - \item{hemo_name}{name to use for the new meta.data column containing percent hemoglobin counts. Default is "percent_hemo".} From 8ea3e5d88312f744be9b373bd6fb350031b3566b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 14 Mar 2024 20:42:32 -0400 Subject: [PATCH 093/503] spell out hemoglobin --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 42a5d812e3..249fb51a3d 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -255,7 +255,7 @@ Add_Cell_QC_Metrics <- function( # Add hemo if (isTRUE(x = add_hemo)) { - cli_inform(message = "Adding {.field Hemo Percentages} to meta.data.") + cli_inform(message = "Adding {.field Hemoglobin Percentages} to meta.data.") seurat_object <- Add_Hemo(object = seurat_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, assay = assay, overwrite = overwrite) } From 21a5292cc864e67527912cb2b62703847b0f5acf Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 09:24:21 -0400 Subject: [PATCH 094/503] rearrange messages --- R/Object_Utilities.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 249fb51a3d..7eb96c0617 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -215,19 +215,19 @@ Add_Cell_QC_Metrics <- function( # Add mito/ribo if (isTRUE(x = add_mito_ribo)) { - cli_inform(message = "Adding {.field Mito/Ribo Percentages} to meta.data.") + cli_inform(message = c("*" = "Adding {.field Mito/Ribo Percentages} to meta.data.")) seurat_object <- Add_Mito_Ribo(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.") + cli_inform(message = c("*" = "Adding {.field Cell Complexity #1 (log10GenesPerUMI)} to meta.data.")) seurat_object <- Add_Cell_Complexity(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.") + cli_inform(message = c("*" = "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) } @@ -237,7 +237,7 @@ Add_Cell_QC_Metrics <- function( 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.") + cli_inform(message = c("*" = "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) } } @@ -248,14 +248,14 @@ Add_Cell_QC_Metrics <- function( 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 IEG Percentages} to meta.data.") + cli_inform(message = c("*" = "Adding {.field IEG Percentages} to meta.data.")) seurat_object <- Add_IEG_Seurat(seurat_object = seurat_object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite) } } # Add hemo if (isTRUE(x = add_hemo)) { - cli_inform(message = "Adding {.field Hemoglobin Percentages} to meta.data.") + cli_inform(message = c("*" = "Adding {.field Hemoglobin Percentages} to meta.data.")) seurat_object <- Add_Hemo(object = seurat_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, assay = assay, overwrite = overwrite) } @@ -266,6 +266,7 @@ Add_Cell_QC_Metrics <- function( "i" = "To add score for other species supply cell cycle gene list of `CellCycleScoring` function." )) } else { + cli_inform(message = c("*" = "Adding {.field Cell Cycle Scoring} to meta.data.")) 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.")) @@ -285,7 +286,7 @@ Add_Cell_QC_Metrics <- function( } # Add Cell Cycle Scoring - cli_inform(message = "Adding {.field Cell Cycle Scoring} to meta.data.") + cli_inform(message = "Calculating {.field Cell Cycle Scores}.") seurat_object <- CellCycleScoring(object = seurat_object, s.features = Seurat::cc.genes.updated.2019$s.genes, g2m.features = Seurat::cc.genes.updated.2019$g2m.genes) } } From 57765e8240bfa978be78e1b82ffcc6ae79cade7e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 09:26:17 -0400 Subject: [PATCH 095/503] fix docs --- R/Object_Utilities.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 7eb96c0617..4477b9fbe5 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -309,9 +309,11 @@ Add_Cell_QC_Metrics <- function( #' @param mito_ribo_name name to use for the new meta.data column containing percent #' 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). +#' species is mouse, human, zebrafish, rat, drosophila, or rhesus macaque; +#' 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). +#' (will set automatically if species is mouse, human, marmoset, zebrafish, rat, +#' drosophila, or rhesus macaque). #' @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. From 55f67fc1805fa79c123c4a9db2a9bd339b33c79c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 09:26:28 -0400 Subject: [PATCH 096/503] Update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ea2e6dc54b..f6cfd9e465 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,8 @@ - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. -- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. +- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). + ## Changed From 2a897f4fdb4100d01eb2666b55872a55f6ada88a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 09:26:55 -0400 Subject: [PATCH 097/503] Update docs --- man/Add_Mito_Ribo.Rd | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/man/Add_Mito_Ribo.Rd b/man/Add_Mito_Ribo.Rd index b72a76a7b9..e86a009b63 100644 --- a/man/Add_Mito_Ribo.Rd +++ b/man/Add_Mito_Ribo.Rd @@ -61,10 +61,12 @@ Default is "percent_ribo".} mitochondrial+ribosomal counts. Default is "percent_mito_ribo".} \item{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).} +species is mouse, human, zebrafish, rat, drosophila, or rhesus macaque; +marmoset features list saved separately).} \item{ribo_pattern}{A regex pattern to match features against for ribosomal genes -(will set automatically if species is mouse, human, or marmoset).} +(will set automatically if species is mouse, human, marmoset, zebrafish, rat, +drosophila, or rhesus macaque).} \item{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).} From 29915ece36cb880b35fe3da9fa3894f35ff0374d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 09:27:30 -0400 Subject: [PATCH 098/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index df5b6b5001..ae7366de79 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" RRID:SCR_024675. -Version: 2.1.2.9016 -Date: 2024-03-14 +Version: 2.1.2.9017 +Date: 2024-03-15 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"), From 56cbad6e57260a2f84ba0d203f6367feb5f4f9ae Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 10:05:57 -0400 Subject: [PATCH 099/503] add anndata check and informative error messaging --- R/Object_Conversion.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index b1d11e7be3..d416e856e8 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -998,6 +998,14 @@ as.anndata.Seurat <- function( )) } + # Check anndata available + anndata_check <- reticulate::py_module_available(module = "anndata") + if (isFALSE(x = anndata_check)) { + cli_abort(message = c("Necessary python package {.field anndata} not found.", + "i" = "Please install anndata and ensure reticulate is linked to correct python environment.", + "i" = "After installation run {.code reticulate::py_module_available(module = 'anndata')} to confirm successful installation.")) + } + # 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 @@ -1189,6 +1197,14 @@ as.anndata.liger <- function( )) } + # Check anndata available + anndata_check <- reticulate::py_module_available(module = "anndata") + if (isFALSE(x = anndata_check)) { + cli_abort(message = c("Necessary python package {.field anndata} not found.", + "i" = "Please install anndata and ensure reticulate is linked to correct python environment.", + "i" = "After installation run {.code reticulate::py_module_available(module = 'anndata')} to confirm successful installation.")) + } + # Check all barcodes are unique to begin with duplicated_barcodes <- x@raw.data %>% lapply(colnames) %>% From 8cff55bc7ceecc897eca564f4cf3e15db046c507 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 10:07:15 -0400 Subject: [PATCH 100/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index f6cfd9e465..fb46b3af59 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,7 @@ ## Changed - Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. +- Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). ## Fixes From 72424fe39fb1f24a738554cae2b9c93c2c9dfc09 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 10:07:27 -0400 Subject: [PATCH 101/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ae7366de79..3ac5b13c71 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9017 +Version: 2.1.2.9018 Date: 2024-03-15 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")), From 43f6d7b90b95223f5620ea5c03001b2d50003325 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 10:26:46 -0400 Subject: [PATCH 102/503] add informative message --- R/Object_Utilities.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 4477b9fbe5..0d656ba915 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -640,21 +640,27 @@ Add_Hemo.Seurat <- function( } if (species %in% mouse_options) { + species_use <- "Mouse" hemo_pattern <- "^Hb[^(P)]" } if (species %in% human_options) { + species_use <- "Human" hemo_pattern <- "^HB[^(P)]" } if (species %in% c(marmoset_options, macaque_options)) { + species_use <- "Marmoset/Macaque" hemo_pattern <- "^^HB[^(P)]" } if (species %in% zebrafish_options) { + species_use <- "Zebrafish" hemo_pattern <- "^hb[^(P)]" } if (species %in% rat_options) { + species_use <- "Rat" hemo_pattern <- "^Hb[^(P)]" } if (species %in% drosophila_options) { + species_use <- "Drosophila" hemo_pattern <- "^glob" } @@ -677,6 +683,7 @@ Add_Hemo.Seurat <- function( } # Add hemo columns + cli_inform(message = "Adding Percent Hemoglobin for {.field {species_use}} using gene symbol pattern: {.field {hemo_pattern}}.") if (length_hemo_features > 0) { good_hemo <- hemo_features[hemo_features %in% rownames(x = object)] object[[hemo_name]] <- PercentageFeatureSet(object = object, features = good_hemo, assay = assay) From 1589a55fec11cd801260c8431b0bd9f8b22af5e4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 10:30:30 -0400 Subject: [PATCH 103/503] change error message --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 0d656ba915..61612f11d4 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -683,7 +683,7 @@ Add_Hemo.Seurat <- function( } # Add hemo columns - cli_inform(message = "Adding Percent Hemoglobin for {.field {species_use}} using gene symbol pattern: {.field {hemo_pattern}}.") + cli_inform(message = "Adding Percent Hemoglobin for {.field {species_use}} using gene symbol pattern: {.val {hemo_pattern}}.") if (length_hemo_features > 0) { good_hemo <- hemo_features[hemo_features %in% rownames(x = object)] object[[hemo_name]] <- PercentageFeatureSet(object = object, features = good_hemo, assay = assay) From e46507069b1056e8dcd9ccac5ca12aa88b94826a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:16:16 -0400 Subject: [PATCH 104/503] fix no variable features --- R/Object_Conversion.R | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index d416e856e8..e28457dc9e 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -948,7 +948,7 @@ Liger_to_Seurat <- function( #' #' @param file_path directory file path and/or file name prefix. Defaults to current wd. #' @param file_name file name. -#' @param assay Assay containing data to use, (default is "RNA"). +#' @param assay Assay containing data to use, (default is object default assay). #' @param main_layer the layer of data to become default layer in anndata object (default is "data"). #' @param other_layers other data layers to transfer to anndata object (default is "counts"). #' @param transer_dimreduc logical, whether to transfer dimensionality reduction coordinates from @@ -979,7 +979,7 @@ as.anndata.Seurat <- function( x, file_path, file_name, - assay = "RNA", + assay = NULL, main_layer = "data", other_layers = "counts", transer_dimreduc = TRUE, @@ -1047,6 +1047,12 @@ as.anndata.Seurat <- function( # Run update to ensure functionality x <- suppressMessages(UpdateSeuratObject(object = x)) + # Set assay + assay <- assay %||% DefaultAssay(object = x) + if (isTRUE(x = verbose)) { + cli_inform(message = c("*" = "Extracting Data from {.field {assay}} assay.")) + } + # Check Assay5 for multiple layers if (isTRUE(x = Assay5_Check(seurat_object = x, assay = assay))) { layers_check <- Layers(object = x, search = main_layer) @@ -1077,12 +1083,18 @@ as.anndata.Seurat <- function( meta_data <- drop_single_value_cols(df = meta_data) - if (isTRUE(x = Assay5_Check(seurat_object = x, assay = assay))) { - seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.data) + # Variable Features + if (length(x = VariableFeatures(object = x, assay = assay)) == 0) { + seurat_var_info <- NULL } else { - seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.features) + if (isTRUE(x = Assay5_Check(seurat_object = x, assay = assay))) { + seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.data) + } else { + seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.features) + } } + # DimReducs if (isTRUE(x = transer_dimreduc)) { dim_reducs_present <- Reductions(object = x) if (length(x = dim_reducs_present) > 0) { @@ -1097,13 +1109,14 @@ as.anndata.Seurat <- function( dim_reducs_present <- NULL } + # Other layers if (length(x = other_layers) > 0) { other_layers_list <- lapply(other_layers, function(i) { Matrix::t(LayerData(object = x, layer = i, assay = assay)) }) - names(x = other_layers_list) <- other_layers - } else { - other_layers_list <- list() + names(x = other_layers_list) <- paste0(other_layers, assay) + } else { + other_layers_list <- list() } # convert From ae41f6452153115266879b8453421de9a3c4aab5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:16:24 -0400 Subject: [PATCH 105/503] update docs --- man/as.anndata.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/as.anndata.Rd b/man/as.anndata.Rd index b971a6939b..553ebe2a4f 100644 --- a/man/as.anndata.Rd +++ b/man/as.anndata.Rd @@ -12,7 +12,7 @@ as.anndata(x, ...) x, file_path, file_name, - assay = "RNA", + assay = NULL, main_layer = "data", other_layers = "counts", transer_dimreduc = TRUE, @@ -42,7 +42,7 @@ as.anndata(x, ...) \item{file_name}{file name.} -\item{assay}{Assay containing data to use, (default is "RNA").} +\item{assay}{Assay containing data to use, (default is object default assay).} \item{main_layer}{the layer of data to become default layer in anndata object (default is "data").} From 60b73af85cade107e6ddb626bf7c2a407c4b34c5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:29:52 -0400 Subject: [PATCH 106/503] fix naming --- R/Object_Conversion.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index e28457dc9e..aae565255b 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -1114,7 +1114,7 @@ as.anndata.Seurat <- function( other_layers_list <- lapply(other_layers, function(i) { Matrix::t(LayerData(object = x, layer = i, assay = assay)) }) - names(x = other_layers_list) <- paste0(other_layers, assay) + names(x = other_layers_list) <- paste0(other_layers, "_", assay) } else { other_layers_list <- list() } From 8a539eff4d8d1772eaa365c94c4bf4365f7b58c5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:32:53 -0400 Subject: [PATCH 107/503] fix error --- R/Object_Conversion.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index aae565255b..044c02a7f2 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -1103,10 +1103,10 @@ as.anndata.Seurat <- function( }) names(x = dim_reducs_list) <- paste0("X_", str_to_lower(string = dim_reducs_present)) } else { - dim_reducs_present <- NULL + dim_reducs_list <- NULL } } else { - dim_reducs_present <- NULL + dim_reducs_list <- NULL } # Other layers From b0b3ef2ffc4fb4f0174c04bf6aad5d6a108b08e7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:37:15 -0400 Subject: [PATCH 108/503] fix SCT case --- R/Object_Conversion.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index 044c02a7f2..3deccae348 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -1090,7 +1090,11 @@ as.anndata.Seurat <- function( if (isTRUE(x = Assay5_Check(seurat_object = x, assay = assay))) { seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.data) } else { - seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.features) + if (dim(x = x[[assay]]@meta.features)[2] == 0) { + seurat_var_info <- NULL + } else { + seurat_var_info <- drop_single_value_cols(df = x[[assay]]@meta.features) + } } } From c451090d5b8497cc1bd3d5ae227c62b18108d933 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:39:30 -0400 Subject: [PATCH 109/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index fb46b3af59..5b5df71feb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,6 +21,7 @@ - Nebulosa plotting functions `Plot_Density_Custom` and `Plot_Density_Joint_Only` have been re-enabled for users with ggplot2 v3.5.0 following Nebulosa v1.12.1 update patch. - Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). - Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). +- Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). From 1841926680296febca9f48a4e6e3eca23f74f70c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:39:52 -0400 Subject: [PATCH 110/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3ac5b13c71..1120883d45 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9018 +Version: 2.1.2.9019 Date: 2024-03-15 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")), From b87435285c7dfff2002818b706f79665acb1ad7a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 15 Mar 2024 19:40:41 -0400 Subject: [PATCH 111/503] messages update --- R/Object_Conversion.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index 3deccae348..96f798377b 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -1038,7 +1038,7 @@ as.anndata.Seurat <- function( # Run update to ensure functionality if (isTRUE(x = verbose)) { - cli_inform(message = c("*" = "Checking Seurat object validity & Extracting Data")) + cli_inform(message = c("*" = "Checking Seurat object validity")) } # Check Seurat @@ -1050,7 +1050,7 @@ as.anndata.Seurat <- function( # Set assay assay <- assay %||% DefaultAssay(object = x) if (isTRUE(x = verbose)) { - cli_inform(message = c("*" = "Extracting Data from {.field {assay}} assay.")) + cli_inform(message = c("*" = "Extracting Data from {.field {assay}} assay to transfer to anndata.")) } # Check Assay5 for multiple layers From 768bed4da595b6b2934fbf48ba8e63872538e0bc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Sun, 17 Mar 2024 19:17:40 -0400 Subject: [PATCH 112/503] update path and naming --- R/Utilities.R | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index b06a09f564..e9556d8e73 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1507,7 +1507,11 @@ Create_Cluster_Annotation_File <- function( if (is.null(x = file_path)) { dir_path <- getwd() } else { - dir_path <- file_path + if (file_path == "") { + dir_path <- getwd() + } else { + dir_path <- file_path + } } # Check directory path is exists if (!dir.exists(paths = dir_path)) { @@ -1515,8 +1519,17 @@ Create_Cluster_Annotation_File <- function( "i" = "Please create directory or fix {.code file_path} and re-run function.") ) } + + # Check extension + file_ext <- grep(x = file_name, pattern = ".csv$") + + if (length(x = file_ext) == 0) { + file_name <- paste0(file_name, ".csv") + } + + # Confirm no files with same name in the same directory path. - full_path <- file.path(dir_path, paste0(file_name, ".csv")) + full_path <- file.path(dir_path, file_name) if (file.exists(full_path)) { cli_abort(message = c("File with name {.val {file_name}} already exists in directory directory.", "i" = "Please supply a different {.code file_name}.") From 76079f83fc187ff449d893f4a271965e0d4176ab Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Sun, 17 Mar 2024 19:37:34 -0400 Subject: [PATCH 113/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 5b5df71feb..9b49229ab9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,7 @@ - Fixed bug causing error in `Add_Cell_QC_Metrics` when `overwrite = TRUE` ([#165](https://github.com/samuel-marsh/scCustomize/issues/165)). - Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). - Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). +- Fixed errors in `Create_Cluster_Annotation_File` if for file path and csv name errors. From 6de31f9da5f119f893d02240c4d32be4ecbbf380 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Sun, 17 Mar 2024 19:37:42 -0400 Subject: [PATCH 114/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1120883d45..4a3baa91bf 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" RRID:SCR_024675. -Version: 2.1.2.9019 -Date: 2024-03-15 +Version: 2.1.2.9020 +Date: 2024-03-16 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"), From f357c30aadf5590308659c5b2729207842ac7e07 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Sun, 17 Mar 2024 19:40:07 -0400 Subject: [PATCH 115/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 9b49229ab9..51335818cd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -23,6 +23,7 @@ - Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). - Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). - Fixed errors in `Create_Cluster_Annotation_File` if for file path and csv name errors. +- Spelling and style fixes. Thanks @kew24. From a2a45d43764ddca3f661c75458f38f5e444acc05 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Sun, 17 Mar 2024 19:56:03 -0400 Subject: [PATCH 116/503] update dim reduc for new format --- R/LIGER_Utilities.R | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b4916445bb..69d517639e 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -170,20 +170,12 @@ LIGER_DimReduc <- function( } # check reduction in cellMeta - if (reduction %in% names(x = liger_object@cellMeta)) { - # check the right dims - if (length(dim(liger_object@cellMeta[[reduction]])) != 2) { - cli_abort(message = "The cellMeta entry {.field {reduction}} is not 2-dimensional entry.") - } else { + if (reduction %in% names(x = dimReds(x = liger_object))) { if (isTRUE(x = check_only)) { return(TRUE) } # get coords - reduc_coords <- liger_object@cellMeta[[reduction]] - - # add colnames - colnames(reduc_coords) <- paste0(reduction, "_", 1:2) - } + reduc_coords <- dimReds(x = liger_object)[[reduction]] } else { cli_abort("The reduction {.field {reduction}} is not present in cellMeta slot.") } @@ -1228,6 +1220,7 @@ plotFactors_liger2_scCustom <- function( H_raw = do.call(rbind, H_raw_list) # Create accurate axis labels reduc_check <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction, check_only = TRUE) + x_axis_label <- paste0(reduction, "_1") y_axis_label <- paste0(reduction, "_2") plot_list = list() From de5c89b9917698d86c9df065458065dff6730c18 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 18 Mar 2024 09:39:44 -0400 Subject: [PATCH 117/503] update rename clusters --- man/Rename_Clusters.Rd | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/man/Rename_Clusters.Rd b/man/Rename_Clusters.Rd index e7c1c840da..4ab49f1ca0 100644 --- a/man/Rename_Clusters.Rd +++ b/man/Rename_Clusters.Rd @@ -4,7 +4,15 @@ \alias{Rename_Clusters} \title{Rename Cluster Seurat} \usage{ -Rename_Clusters(seurat_object, new_idents, meta_col_name = NULL, ...) +Rename_Clusters( + seurat_object, + new_idents, + old_ident_name = NULL, + new_ident_name = NULL, + meta_col_name = deprecated(), + overwrite = FALSE, + ... +) } \arguments{ \item{seurat_object}{object name.} @@ -26,7 +34,7 @@ Wrapper function to rename active identities in Seurat Object with new idents. \examples{ \dontrun{ obj <- Rename_Clusters(seurat_object = obj_name, new_idents = new_idents_vec, -meta_col_name = "Round01_Res0.6_Idents") +old_ident_name = "Seurat_Idents_Round01", new_ident_name = "Round01_Res0.6_Idents") } } From 3bdf96d29c293e5403ca052b9bd67ca12ab50261 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 18 Mar 2024 09:39:52 -0400 Subject: [PATCH 118/503] update rename clusters --- R/Utilities.R | 56 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 49 insertions(+), 7 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index e9556d8e73..6d54d7679c 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1693,6 +1693,7 @@ Pull_Cluster_Annotation <- function( #' @return Seurat Object with new identities placed in active.ident slot. #' #' @import cli +#' @importFrom lifecycle deprecated #' #' @export #' @@ -1701,19 +1702,57 @@ Pull_Cluster_Annotation <- function( #' @examples #' \dontrun{ #' obj <- Rename_Clusters(seurat_object = obj_name, new_idents = new_idents_vec, -#' meta_col_name = "Round01_Res0.6_Idents") +#' old_ident_name = "Seurat_Idents_Round01", new_ident_name = "Round01_Res0.6_Idents") #' } #' Rename_Clusters <- function( seurat_object, new_idents, - meta_col_name = NULL, + old_ident_name = NULL, + new_ident_name = NULL, + meta_col_name = deprecated(), + overwrite = FALSE, ... ) { + # Deprecation warning + if (lifecycle::is_present(meta_col_name)) { + lifecycle::deprecate_stop(when = "2.2.0", + what = "Rename_Clusters(meta_col_name)", + with = "Rename_Clusters(old_ident_name)", + details = c("i" = "To store old idents please provide name to `old_ident_name`", + "i" = "To store new idents please provide name to `new_ident_name`") + ) + } + # Check Seurat Is_Seurat(seurat_object = seurat_object) + # check old ident name + if (!is.null(x = old_ident_name)) { + if (old_ident_name %in% colnames(x = seurat_object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("The {.code old_ident_name}: {.field {old_ident_name}} is already a column in meta.data", + "i" = "To overwrite current meta.data column set {.code overwrite = TRUE}.")) + } else { + cli_inform(message = "Overwriting old meta.data column: {.field {old_ident_name}} as {.code overwrite = TRUE}") + + } + } else { + seurat_object[[old_ident_name]] <- Idents(object = seurat_object) + } + } + + # check new ident name + if (new_ident_name %in% colnames(x = seurat_object@meta.data)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("The {.code new_ident_name}: {.field {new_ident_name}} is already a column in meta.data", + "i" = "To overwrite current meta.data column set {.code overwrite = TRUE}.")) + } else { + cli_inform(message = "Overwriting new meta.data column: {.field {new_ident_name}} as {.code overwrite = TRUE}") + } + } + # 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.", @@ -1725,6 +1764,7 @@ Rename_Clusters <- function( if (is.null(x = names(x = new_idents))) { names(x = new_idents) <- levels(x = seurat_object) } + # If named check that names are right length if (!is.null(x = names(x = new_idents)) && length(x = unique(x = names(x = new_idents))) != length(x = levels(x = seurat_object))) { cli_abort(message = c("The number of unique names for {.code new idents} is not equal to number of active.idents.", @@ -1732,13 +1772,15 @@ Rename_Clusters <- function( ) } - # Rename meta column for old ident information if desired - if (!is.null(x = meta_col_name)) { - seurat_object[[meta_col_name]] <- Idents(object = seurat_object) + # Add new idents + seurat_object <- RenameIdents(object = seurat_object, new_idents) + + # Add new ident to meta.data information if desired + if (!is.null(x = new_ident_name)) { + seurat_object[[new_ident_name]] <- Idents(object = seurat_object) } - # Add new idents & return object - seurat_object <- RenameIdents(object = seurat_object, new_idents) + # return object return(seurat_object) } From 22b24345bdf67a748d4d82231158d7e10a15ae63 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 18 Mar 2024 09:40:35 -0400 Subject: [PATCH 119/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 51335818cd..37809a4be2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,7 @@ ## Changed - Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. - Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). +- Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. ## Fixes From 715fb51c6ed55c700de49ed1ef11e7924358b9de Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 18 Mar 2024 09:40:49 -0400 Subject: [PATCH 120/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a3baa91bf..db8974782f 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" RRID:SCR_024675. -Version: 2.1.2.9020 -Date: 2024-03-16 +Version: 2.1.2.9021 +Date: 2024-03-18 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"), From 82cc3e92751a221c6678c5209faf671ff11be3f0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 19 Mar 2024 10:01:40 -0400 Subject: [PATCH 121/503] fix plot median --- R/Seurat_Plotting.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 6e426dcce3..b53b7c29bd 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -654,7 +654,7 @@ VlnPlot_scCustom <- function( # 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) + 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)) { From cc64fb0f66da9bbe783fca9cfbac09e9dfbb9a8c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 19 Mar 2024 10:03:24 -0400 Subject: [PATCH 122/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 37809a4be2..283734bc85 100644 --- a/NEWS.md +++ b/NEWS.md @@ -24,7 +24,8 @@ - Fixed wrong description of parameter in manual entry for `DotPlot_scCustom` ([#158](https://github.com/samuel-marsh/scCustomize/issues/158)). - Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). - Fixed errors in `Create_Cluster_Annotation_File` if for file path and csv name errors. -- Spelling and style fixes. Thanks @kew24. +- Fixed error when using `plot_median` and more than one feature in `VlnPlot_scCustom` ([#169](https://github.com/samuel-marsh/scCustomize/issues/169)). +- Spelling and style fixes. Thanks @kew24. From 5faa168471379ce6f4b766d9a050e727c365501b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 19 Mar 2024 10:03:36 -0400 Subject: [PATCH 123/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index db8974782f..4e13cff68d 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" RRID:SCR_024675. -Version: 2.1.2.9021 -Date: 2024-03-18 +Version: 2.1.2.9022 +Date: 2024-03-19 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"), From 345c7f31591a57323c08fdbe03420354ddd3c29f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 19 Mar 2024 10:46:33 -0400 Subject: [PATCH 124/503] add error check --- R/LIGER_Utilities.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 69d517639e..5293f8b079 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1207,8 +1207,12 @@ plotFactors_liger2_scCustom <- function( } # Get Data and Plot Factors - cli_inform(message = "{.field Generating plots}") k <- ncol(x = liger_object@H.norm) + if (is.null(x = k)) { + cli_abort(message = "{.code quantileNorm} must be run before plotting factors.") + } + + cli_inform(message = "{.field Generating plots}") pb <- txtProgressBar(min = 0, max = k, style = 3) W <- liger_object@W rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) From 123678a9af620ee4299b693193721b316660cd84 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 19 Mar 2024 11:10:37 -0400 Subject: [PATCH 125/503] fix rename new name --- R/Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index 6d54d7679c..181ea8bd0e 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1744,7 +1744,7 @@ Rename_Clusters <- function( } # check new ident name - if (new_ident_name %in% colnames(x = seurat_object@meta.data)) { + if (!is.null(x = new_ident_name) && new_ident_name %in% colnames(x = seurat_object@meta.data)) { if (isFALSE(x = overwrite)) { cli_abort(message = c("The {.code new_ident_name}: {.field {new_ident_name}} is already a column in meta.data", "i" = "To overwrite current meta.data column set {.code overwrite = TRUE}.")) From 8d24ad2a30e8d322d05bd0b9e7a65a69d83c4c51 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:11:52 -0400 Subject: [PATCH 126/503] add default dim reduc internal function --- R/LIGER_Utilities.R | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 5293f8b079..24a43ed2ee 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -126,7 +126,7 @@ Top_Genes_Factor <- function( return(top_genes) } else { # Extract genes - W <- t(liger_object@W) + W <- t(x = liger_object@W) rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] return(top_genes) @@ -134,6 +134,40 @@ Top_Genes_Factor <- function( } +#' Extract default dimensionality reduction +#' +#' Extract name of the default dimensionlity reduction for liger object. +#' +#' @param liger_object LIGER object name. +#' +#' @return name of default dimensionality reduction +#' +#' @import cli +#' +#' @noRd +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return dimensionality reduction name +#' dim_reduc_name <- Default_DimReduc_LIGER(liger_object = obj) +#' } +#' + +Default_DimReduc_LIGER <- function( + liger_object +) { + if (length(x = liger_object@dimReds) > 0) { + default_reduc <- liger_object@uns$defaultDimRed + + return(default_reduc) + } else { + cli_abort(message = "No dimensionality reduction present.") + } +} + + #' Extract dimensionality reduction coordinates from Liger object #' #' Extract data.frame containing dimensionality reduction coordinates from new format of @@ -155,6 +189,7 @@ Top_Genes_Factor <- function( #' #' @examples #' \dontrun{ +#' # return dimensionality reduction coordinates #' umap_coords <- LIGER_DimReduc(liger_object = object) #' } #' @@ -169,6 +204,8 @@ LIGER_DimReduc <- function( cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") } + reduction_use <- + # check reduction in cellMeta if (reduction %in% names(x = dimReds(x = liger_object))) { if (isTRUE(x = check_only)) { From 143569b608ae5fe24b4bcb85d3753fc964a90d98 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:13:20 -0400 Subject: [PATCH 127/503] Update examples --- R/LIGER_Utilities.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 24a43ed2ee..2ce7ddbdb7 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -191,6 +191,10 @@ Default_DimReduc_LIGER <- function( #' \dontrun{ #' # return dimensionality reduction coordinates #' umap_coords <- LIGER_DimReduc(liger_object = object) +#' +#' # return logical to see if reduction is present +#' reduc_present <- LIGER_DimReduc(liger_object = object, reduction = "umap", +#' check_only = TRUE) #' } #' From be39352789be6161d783c17aae00bfa8a5928afe Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:13:26 -0400 Subject: [PATCH 128/503] update docs --- man/LIGER_DimReduc.Rd | 1 + 1 file changed, 1 insertion(+) diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd index 753ef3f719..290ab4df6a 100644 --- a/man/LIGER_DimReduc.Rd +++ b/man/LIGER_DimReduc.Rd @@ -23,6 +23,7 @@ Liger objects } \examples{ \dontrun{ +# return dimensionality reduction coordinates umap_coords <- LIGER_DimReduc(liger_object = object) } From f1232dfef8158e87350a105b63efefb128fb84e5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:14:57 -0400 Subject: [PATCH 129/503] set default dimreduc based on object defaults --- R/LIGER_Utilities.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 2ce7ddbdb7..a99cb87cb8 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -208,17 +208,18 @@ LIGER_DimReduc <- function( cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") } - reduction_use <- + # reduction to use + reduction_use <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) # check reduction in cellMeta - if (reduction %in% names(x = dimReds(x = liger_object))) { + if (reduction_use %in% names(x = dimReds(x = liger_object))) { if (isTRUE(x = check_only)) { return(TRUE) } # get coords - reduc_coords <- dimReds(x = liger_object)[[reduction]] + reduc_coords <- dimReds(x = liger_object)[[reduction_use]] } else { - cli_abort("The reduction {.field {reduction}} is not present in cellMeta slot.") + cli_abort("The reduction {.field {reduction_use}} is not present in cellMeta slot.") } # return coords From eecbd1c35bdc0b752764f2431007955ab95657ca Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:16:04 -0400 Subject: [PATCH 130/503] update manual --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index a99cb87cb8..5ea9872e41 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -175,7 +175,7 @@ Default_DimReduc_LIGER <- function( #' #' @param liger_object LIGER object name. #' @param reduction name of dimensionality reduction stored in cellMeta slot. Default is -#' "UMAP") +#' NULL, which will use liger object's default reduction. #' @param check_only logical, return `TRUE` if valid reduction is present. #' #' @return dimensionality reduction coordinates in 2 column format From fa732339c658665f7a79e35ec7a673c954a056ea Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:44:43 -0400 Subject: [PATCH 131/503] update add mito ribo --- R/LIGER_Utilities.R | 42 +++++++++++++++++++++++++++++++----------- man/LIGER_DimReduc.Rd | 4 ++++ 2 files changed, 35 insertions(+), 11 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 5ea9872e41..24e4f6f34a 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -252,6 +252,11 @@ Find_Factor_Cor <- function( ) { Is_LIGER(liger_object = liger_object) + # Check new liger object + if (!"cellMeta" %in% slotNames(liger_object)) { + cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + } + # Get loadings factor_loadings <- data.frame(rliger::getMatrix(x = liger_object, slot = "W")) @@ -478,27 +483,42 @@ Add_Mito_Ribo.liger <- function( # Add mito and ribo percent if (length_mito_features > 0) { good_mito <- mito_features[mito_features %in% all_features] - percent_mito <- unlist(lapply(object@raw.data, function(x) { - (Matrix::colSums(x[good_mito, ])/Matrix::colSums(x))*100})) - object@cell.data[ , mito_name] <- percent_mito + + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(mito_name = good_mito), verbose = FALSE) + } else { + percent_mito <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[good_mito, ])/Matrix::colSums(x))*100})) + object@cell.data[ , mito_name] <- percent_mito + } } if (length_ribo_features > 0){ good_ribo <- ribo_features[ribo_features %in% all_features] - percent_ribo <- unlist(lapply(object@raw.data, function(x) { - (Matrix::colSums(x[good_ribo, ])/Matrix::colSums(x))*100})) - object@cell.data[ , ribo_name] <- percent_ribo + + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(ribo_name = good_ribo), verbose = FALSE) + } else { + percent_ribo <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[good_ribo, ])/Matrix::colSums(x))*100})) + object@cell.data[ , ribo_name] <- percent_ribo + } } # Create combined mito ribo column if both present if (length_mito_features > 0 && length_ribo_features > 0) { - object_meta <- Fetch_Meta(object = object) %>% - rownames_to_column("barcodes") + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object@cellMeta[[mito_ribo_name]] <- csf_liger@cellMeta[[mito_name]] + csf_liger@cellMeta[[ribo_name]] + } else { + object_meta <- Fetch_Meta(object = object) %>% + rownames_to_column("barcodes") + + object_meta <- object_meta %>% + mutate({{mito_ribo_name}} := .data[[mito_name]] + .data[[ribo_name]]) - object_meta <- object_meta %>% - mutate({{mito_ribo_name}} := .data[[mito_name]] + .data[[ribo_name]]) - object@cell.data[ , mito_ribo_name] <- object_meta[[mito_ribo_name]] + object@cell.data[ , mito_ribo_name] <- object_meta[[mito_ribo_name]] + } } # return object diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd index 290ab4df6a..e16f471261 100644 --- a/man/LIGER_DimReduc.Rd +++ b/man/LIGER_DimReduc.Rd @@ -25,6 +25,10 @@ Liger objects \dontrun{ # return dimensionality reduction coordinates umap_coords <- LIGER_DimReduc(liger_object = object) + +# return logical to see if reduction is present +reduc_present <- LIGER_DimReduc(liger_object = object, reduction = "umap", +check_only = TRUE) } } From 209425ff9c0d5300a1ac018568def9aa07fcb752 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:44:52 -0400 Subject: [PATCH 132/503] update docs --- man/LIGER_DimReduc.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd index e16f471261..40defefd19 100644 --- a/man/LIGER_DimReduc.Rd +++ b/man/LIGER_DimReduc.Rd @@ -10,7 +10,7 @@ LIGER_DimReduc(liger_object, reduction = NULL, check_only = FALSE) \item{liger_object}{LIGER object name.} \item{reduction}{name of dimensionality reduction stored in cellMeta slot. Default is -"UMAP")} +NULL, which will use liger object's default reduction.} \item{check_only}{logical, return \code{TRUE} if valid reduction is present.} } From 4de1929b2424443d4b97036e953b1b94fd9c8f80 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:50:19 -0400 Subject: [PATCH 133/503] update mito ribo and complexity for liger 2.0.0 --- R/LIGER_Utilities.R | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 24e4f6f34a..775b38c417 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -371,13 +371,15 @@ Add_Mito_Ribo.liger <- function( } # Overwrite check - if (mito_name %in% colnames(x = object@cell.data) || ribo_name %in% colnames(x = object@cell.data) || mito_ribo_name %in% colnames(x = object@cell.data)) { + meta_names <- colnames(x = Fetch_Meta(object = object)) + + if (mito_name %in% meta_names || ribo_name %in% meta_names || mito_ribo_name %in% meta_names) { if (isFALSE(x = overwrite)) { - cli_abort(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in cell.data slot.", + cli_abort(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in meta data.", "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}.*") ) } - cli_inform(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in cell.data slot.", + cli_inform(message = c("Columns with {.val {mito_name}} and/or {.val {ribo_name}} already present in meta data.", "i" = "Overwriting those columns as {.code overwrite = TRUE}.") ) } @@ -565,19 +567,25 @@ Add_Cell_Complexity.liger <- function( Is_LIGER(liger_object = object) # Check columns for overwrite - if (meta_col_name %in% colnames(x = object@cell.data)) { + meta_names <- colnames(x = Fetch_Meta(object = object)) + + if (meta_col_name %in% meta_names) { if (isFALSE(x = overwrite)) { - cli_abort(message = c("Column {.val {meta_col_name}} already present in cell.data slot.", + cli_abort(message = c("Column {.val {meta_col_name}} already present in meta data.", "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 cell.data slot", + cli_inform(message = c("Column {.val {meta_col_name}} already present in meta data slot", "i" = "Overwriting those columns as `overwrite = TRUE`.") ) } # Add score - object@cell.data[ , meta_col_name] <- log10(object@cell.data$nGene) / log10(object@cell.data$nUMI) + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object@cellMeta[[mito_ribo_name]] <- log10(object@cellMeta$nGene) / log10(object@cellMeta$nUMI) + } else { + object@cell.data[ , meta_col_name] <- log10(object@cell.data$nGene) / log10(object@cell.data$nUMI) + } #return object return(object) From b2a6f3f681fb398905d5f0b74364b84616ea3107 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:52:15 -0400 Subject: [PATCH 134/503] add call to rliger --- R/LIGER_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 775b38c417..2003343de0 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -487,7 +487,7 @@ Add_Mito_Ribo.liger <- function( good_mito <- mito_features[mito_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { - object <- runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(mito_name = good_mito), verbose = FALSE) + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(mito_name = good_mito), verbose = FALSE) } else { percent_mito <- unlist(lapply(object@raw.data, function(x) { (Matrix::colSums(x[good_mito, ])/Matrix::colSums(x))*100})) @@ -499,7 +499,7 @@ Add_Mito_Ribo.liger <- function( good_ribo <- ribo_features[ribo_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { - object <- runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(ribo_name = good_ribo), verbose = FALSE) + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(ribo_name = good_ribo), verbose = FALSE) } else { percent_ribo <- unlist(lapply(object@raw.data, function(x) { (Matrix::colSums(x[good_ribo, ])/Matrix::colSums(x))*100})) From c275141fb2f955dee388d59c567f16a7bb492fc1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:52:25 -0400 Subject: [PATCH 135/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 283734bc85..5efa790240 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ - Added new functions to interact with upcoming liger object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - Updated functions to interact with both old and new style liger objects: - - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`. + - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). From 25c91562ab4645e5ddf7ef4b0cc5af84d5c62eee Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 20 Mar 2024 13:52:43 -0400 Subject: [PATCH 136/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4e13cff68d..e4b4c246c4 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" RRID:SCR_024675. -Version: 2.1.2.9022 -Date: 2024-03-19 +Version: 2.1.2.9023 +Date: 2024-03-20 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"), From c4bc8e54e6e7ff8648929c133cc02e56ae89228d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:04:45 -0400 Subject: [PATCH 137/503] fix typo --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 61612f11d4..8fa0ffc504 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -631,7 +631,7 @@ Add_Hemo.Seurat <- function( drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options - # Assign mito/ribo pattern to stored species + # Assign hemo pattern to stored species if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options) && any(!is.null(x = hemo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code hemo_pattern} and {.code hemo_pattern} will be disregarded.", From 2d354b4b183abe7b17d5fe8c1daa6fcc5213ac3c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:05:16 -0400 Subject: [PATCH 138/503] reorganize R/ liger functions --- R/LIGER_Internal_Utilities.R | 1222 ++++++++++++++++++++++++++++++++++ 1 file changed, 1222 insertions(+) create mode 100644 R/LIGER_Internal_Utilities.R diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R new file mode 100644 index 0000000000..b0d97eddf4 --- /dev/null +++ b/R/LIGER_Internal_Utilities.R @@ -0,0 +1,1222 @@ +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### LIGER INTERNAL UTILS #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' Extract default dimensionality reduction +#' +#' Extract name of the default dimensionlity reduction for liger object. +#' +#' @param liger_object LIGER object name. +#' +#' @return name of default dimensionality reduction +#' +#' @import cli +#' +#' @noRd +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return dimensionality reduction name +#' dim_reduc_name <- Default_DimReduc_LIGER(liger_object = obj) +#' } +#' + +Default_DimReduc_LIGER <- function( + liger_object +) { + if (length(x = liger_object@dimReds) > 0) { + default_reduc <- liger_object@uns$defaultDimRed + + return(default_reduc) + } else { + cli_abort(message = "No dimensionality reduction present.") + } +} + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### INTERNAL LIGER PLOTTING UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' DimPlot LIGER Version +#' +#' Standard and modified version of LIGER's plotByDatasetAndCluster +#' +#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. +#' @param clusters Another clustering to use for coloring second plot (must have same names as +#' clusters slot) (default NULL). +#' @param shuffle Randomly shuffle points so that points from same dataset are not plotted one after +#' the other (default TRUE). +#' @param shuffle_seed Random seed for reproducibility of point shuffling (default 1). +#' @param redorder.idents logical whether to reorder the datasets from default order before plotting (default FALSE). +#' @param new.order new dataset factor order for plotting. must set reorder.idents = TRUE. +#' @param group_by meta data varibale to group plots by +#' @param split_by meta data variable to splot plots by +#' +#' @return A data.frame with information for plotting +#' +#' @importFrom utils packageVersion +#' +#' @references This function is encompasses the first part of the LIGER function plotByDatasetAndCluster. +#' However, this function is modified to allow plotting other meta data variables. In this case the function +#' just returns the data.frame needed for plotting rather than plots themselves. +#' \url{https://github.com/welch-lab/liger}. (License: GPL-3). +#' +#' @noRd +#' +#' @concept liger_plotting_util +#' + +Generate_Plotting_df_LIGER <- function(object, + clusters = NULL, + shuffle = TRUE, + shuffle_seed = 1, + reorder.idents = FALSE, + new.order = NULL, + group_by = "dataset", + split_by = NULL +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + tsne_df <- data.frame(object@tsne.coords) + colnames(x = tsne_df) <- c("tsne1", "tsne2") + tsne_df[[group_by]] <- object@cell.data[[group_by]] + if (!is.null(x = split_by)) { + tsne_df[[split_by]] <- object@cell.data[[split_by]] + } + + if (isTRUE(x = reorder.idents)) { + tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) + } + c_names <- names(x = object@clusters) + if (is.null(x = clusters)) { + # if clusters have not been set yet + if (length(x = object@clusters) == 0) { + clusters <- rep(1, nrow(x = object@tsne.coords)) + names(x = clusters) <- c_names <- rownames(x = object@tsne.coords) + } else { + clusters <- object@clusters + c_names <- names(x = object@clusters) + } + } + tsne_df[['Cluster']] <- clusters[c_names] + + if (isTRUE(x = shuffle)) { + set.seed(shuffle_seed) + idx <- sample(x = 1:nrow(tsne_df)) + tsne_df <- tsne_df[idx, ] + } + return(tsne_df) +} + + +#' LIGER plot by cluster. +#' +#' Modified version of LIGER's plotByDatasetAndCluster just for plotting clusters. +#' +#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. +#' @param colors_use colors to use for plotting by cluster. 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 \code{\link{DiscretePalette_scCustomize}}. +#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. +#' If `combination = TRUE` will plot both clusters and meta data variable. +#' @param split_by meta data variable to split plots by (i.e. "dataset"). +#' @param title plot title. +#' @param pt_size Adjust point size for plotting. +#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store +#' name of technique and therefore needs to be set manually. Default is "UMAP". +#' @param num_columns Number of columns to plot by if `split_by` is not NULL. +#' @param shuffle logical. Whether to randomly shuffle the order of points. This can be useful for +#' crowded plots if points of interest are being buried. (Default is TRUE). +#' @param shuffle_seed Sets the seed if randomly shuffling the order of points. +#' @param legend.size what to set legend size to. +#' @param label logical. Whether or not to label the clusters. Default is TRUE. +#' @param label_size size of cluster labels. +#' @param label_repel logical. Whether to repel cluster labels from each other if plotting by +#' cluster (if `group_by = NULL` or `group_by = "cluster`). Default is FALSE. +#' @param label_box logical. Whether to put a box around the label text (uses `geom_text` vs `geom_label`). +#' Default is FALSE. +#' @param label_color Color to use for cluster labels. Default is "black". +#' @param redorder.idents logical. should the idents plotted by reordered. Default is FALSE. +#' @param new.order What should the new ident order be if `reorder.idents = 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(). +#' 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. +#' +#' @return A ggplot/patchwork object +#' +#' @import ggplot2 +#' @importFrom cowplot theme_cowplot +#' @importFrom dplyr summarize +#' @importFrom ggrepel geom_text_repel geom_label_repel +#' @importFrom patchwork wrap_plots +#' @importFrom scattermore geom_scattermore +#' @importFrom stats median +#' @importFrom utils packageVersion +#' +#' @references This function is encompasses part of the LIGER function plotByDatasetAndCluster. +#' However, this function is modified to just return cluster plots based on `Generate_Plotting_df_LIGER`. +#' \url{https://github.com/welch-lab/liger}. (Licence: GPL-3). +#' +#' @noRd +#' +#' @concept liger_plotting_util +#' + +Plot_By_Cluster_LIGER <- function( + liger_object, + colors_use = NULL, + group_by = "dataset", + split_by = NULL, + title = NULL, + pt_size = NULL, + reduction_label = "UMAP", + num_columns = NULL, + shuffle = TRUE, + shuffle_seed = 1, + legend.size = 5, + label = TRUE, + label_size = NA, + label_repel = FALSE, + label_box = FALSE, + label_color = "black", + reorder.idents = FALSE, + new.order = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + # Create plotting data.frame + tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) + + if (!is.null(x = split_by)) { + list_of_splits <- unique(x = tsne_df[[split_by]]) + } + + # Get length of meta data feature + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + split.by_length <- length(x = list_of_splits) + + # 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.", + "*" = "{.field {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}}.") + ) + } + } + + centers <- tsne_df %>% group_by(.data[['Cluster']]) %>% summarize( + tsne1 = median(x = .data[['tsne1']]), + tsne2 = median(x = .data[['tsne2']]) + ) + + cluster_length <- length(x = unique(x = liger_object@clusters)) + + if (is.null(x = colors_use)) { + # set default plot colors + if (is.null(x = colors_use)) { + colors_use <- scCustomize_Palette(num_groups = cluster_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + } + + # Create accurate axis labels + x_axis_label <- paste0(reduction_label, "_1") + y_axis_label <- paste0(reduction_label, "_2") + + # plot + 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']])) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + }) + } else { + p2 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = .data[['Cluster']])) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + + } + } else { + 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']])) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + }) + } else { + p2 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = .data[['Cluster']])) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + } + } + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + p2 <- wrap_plots(p2) + plot_layout(nrow = num_rows, ncol = num_columns, guides = 'collect') + return(p2) + } + if (!is.null(x = split_by) && is.null(x = num_columns)) { + p2 <- wrap_plots(p2) + plot_layout(guides = 'collect') + return(p2) + } else { + return(p2) + } +} + +#' LIGER plot by meta variables. +#' +#' Modified version of LIGER's plotByDatasetAndCluster just for plotting meta variables. +#' +#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. +#' @param colors_use colors to use for plotting by cluster. 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 \code{\link{DiscretePalette_scCustomize}}. +#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. +#' If `combination = TRUE` will plot both clusters and meta data variable. +#' @param split_by meta data variable to split plots by (i.e. "dataset"). +#' @param title plot title. +#' @param pt_size Adjust point size for plotting. +#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name +#' of technique and therefore needs to be set manually. Default is "UMAP". +#' @param num_columns Number of columns to plot by if `split_by` is not NULL. +#' @param shuffle logical. Whether to randomly shuffle the order of points. This can be useful for +#' crowded plots if points of interest are being buried. (Default is TRUE). +#' @param shuffle_seed Sets the seed if randomly shuffling the order of points. +#' @param legend.size what to set legend size to. +#' @param redorder.idents logical. should the idents plotted by reordered. Default is FALSE. +#' @param new.order What should the new ident order be if `reorder.idents = 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(). +#' 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. +#' +#' @return A ggplot/patchwork object +#' +#' @import ggplot2 +#' @importFrom cowplot theme_cowplot +#' @importFrom patchwork wrap_plots +#' @importFrom rlang sym "!!" +#' @importFrom scattermore geom_scattermore +#' @importFrom utils packageVersion +#' +#' @references This function is encompasses part of the LIGER function plotByDatasetAndCluster. +#' However, this function is modified to just return cluster plots based on `Generate_Plotting_df_LIGER`. +#' \url{https://github.com/welch-lab/liger}. (Licence: GPL-3). +#' +#' @noRd +#' +#' @concept liger_plotting_util +#' + +Plot_By_Meta_LIGER <- function( + liger_object, + colors_use = NULL, + group_by = "dataset", + split_by = NULL, + title = NULL, + pt_size = NULL, + reduction_label = "UMAP", + num_columns = NULL, + shuffle = TRUE, + shuffle_seed = 1, + legend.size = 3, + reorder.idents = FALSE, + new.order = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) + + if (!is.null(x = split_by)) { + list_of_splits <- unique(x = tsne_df[[split_by]]) + } + + # Get length of meta data feature + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + split.by_length <- length(x = list_of_splits) + + # 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.", + "*" = "{.field {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}}.") + ) + } + } + + meta_length <- length(x = unique(x = liger_object@cell.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 = meta_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + } + + # Create accurate axis labels + x_axis_label <- paste0(reduction_label, "_1") + y_axis_label <- paste0(reduction_label, "_2") + + group_by <- sym(x = group_by) + + 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)) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + }) + } else { + p1 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = !!group_by)) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + } + } else { + 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)) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + }) + } else { + p1 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = !!group_by)) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + } + } + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + p1 <- wrap_plots(p1) + plot_layout(nrow = num_rows, ncol = num_columns) + return(p1) + } + if (!is.null(x = split_by) && is.null(x = num_columns)) { + p1 <- wrap_plots(p1) + return(p1) + } else { + return(p1) + } +} + + +#' Customized version of plotFactors +#' +#' Modified and optimized version of `plotFactors` function from LIGER package. +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function +#' @param num_genes Number of genes to display for each factor (Default 8). +#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be +#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction +#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), +#' @param pt.size_factors Adjust point size for plotting in the factor plots. +#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. +#' @param reduction Name of dimensionality reduction to use for plotting. +#' @param reduction_label `r lifecycle::badge("deprecated")` deprecated for newer style liger +#' objects. Use `reduction` instead. +#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. +#' Helpful if number of datasets is large to avoid crowding the plot with legend. +#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the +#' dimensionality reduction plots (Default = FALSE). +#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. +#' @param save_plots logical. Whether to save plots. Default is TRUE +#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) +#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). +#' @param reorder_datasets `r lifecycle::badge("deprecated")` deprecated for newer style liger objects +#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "varibow" palette. +#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. +#' +#' @return A list of ggplot/patchwork objects and/or PDF file. +#' +#' @import cli +#' @import ggplot2 +#' @importFrom grDevices dev.off pdf +#' @importFrom lifecycle deprecated +#' @importFrom patchwork wrap_plots +#' @importFrom scattermore geom_scattermore +#' +#' @noRd +#' +#' @concept liger_plotting +#' +#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) +#' @references Based on `plotFactors` functionality from original LIGER package. +#' +#' @examples +#' \dontrun{ +#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, +#' raster = FALSE, save_plots = TRUE) +#' } +#' + +plotFactors_liger2_scCustom <- function( + liger_object, + num_genes = 8, + colors_use_factors = NULL, + colors_use_dimreduc = c('lemonchiffon', 'red'), + pt.size_factors = 1, + pt.size_dimreduc = 1, + reduction = "UMAP", + reduction_label = deprecated(), + plot_legend = TRUE, + raster = TRUE, + raster.dpi = c(512, 512), + order = FALSE, + plot_dimreduc = TRUE, + save_plots = TRUE, + file_path = NULL, + file_name = NULL, + return_plots = FALSE, + cells.highlight = NULL, + reorder_datasets = deprecated(), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # Check is slot is supplied + if (lifecycle::is_present(reorder_datasets)) { + lifecycle::deprecate_warn(when = "2.2.0", + what = "plotFactors_scCustom(reorder_datasets)", + details = c("i" = "The {.code reorder_datasets} parameter is deprecated for newer style Liger objects.") + ) + } + + # Check is slot is supplied + if (lifecycle::is_present(reduction_label)) { + lifecycle::deprecate_warn(when = "2.2.0", + what = "plotFactors_scCustom(reduction_label)", + details = c("v" = "The {.code reduction_label} parameter is deprecated for newer style Liger objects.", + "i" = "Use {.code reduction} parameter instead") + ) + } + + # if returning and saving + if (isTRUE(x = save_plots)) { + # Check file path is valid + if (!is.null(x = file_path) && file_path != "") { + if (!dir.exists(paths = file_path)) { + cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") + } + } + + # 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 <- "" + } + + # Check if file name provided + file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) + if (length(x = file_ext) == 0) { + file_name <- file_name + } else { + file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) + } + + if (is.null(x = file_name)) { + cli_abort(message = c("No file name provided.", + "i" = "Please provide a file name using {.code file_name}.") + ) + } + } + + # Extract dataset number + num_datasets <- length(x = liger_object@datasets) + + # Default Colors for Factor Plots + if (is.null(x = colors_use_factors)) { + 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) + } + } + + # Check valid number of colors for tsne/UMAP + if (length(x = colors_use_dimreduc) < 2) { + cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", + "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + ) + } + + # Get Data and Plot Factors + k <- ncol(x = liger_object@H.norm) + if (is.null(x = k)) { + cli_abort(message = "{.code quantileNorm} must be run before plotting factors.") + } + + cli_inform(message = "{.field Generating plots}") + pb <- txtProgressBar(min = 0, max = k, style = 3) + W <- liger_object@W + rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) + Hs_norm <- liger_object@H.norm + dataset_names <- names(liger_object@datasets) + H_raw_list <- lapply(1:num_datasets, function(x){ + H_raw <- t(liger_object@datasets[[x]]@H) + }) + H_raw = do.call(rbind, H_raw_list) + # Create accurate axis labels + reduc_check <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction, check_only = TRUE) + + x_axis_label <- paste0(reduction, "_1") + y_axis_label <- paste0(reduction, "_2") + plot_list = list() + tsne_list = list() + for (i in 1:k) { + top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] + top_genes.W.string <- paste0(top_genes.W, collapse = ", ") + factor_textstring <- paste0("Factor", i) + plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") + h_df = data.frame(x = 1:nrow(Hs_norm), h_norm = Hs_norm[, i], + h_raw = H_raw[, i], dataset = liger_object@cellMeta$dataset, + highlight = FALSE) + 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') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } else { + top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'Raw H Score') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } + + if (!is.null(cells.highlight)) { + h_df[cells.highlight, 'highlight'] = TRUE + if (isTRUE(x = raster)) { + top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + } else { + top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + size = pt.size_factors) + bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + size = pt.size_factors) + } + } + full <- wrap_plots(top, bottom, ncol = 1) + plot_list[[i]] = full + + # plot tSNE/UMAP + if (isTRUE(x = plot_dimreduc)) { + tsne_df <- data.frame(Hs_norm[, i], LIGER_DimReduc(liger_object = liger_object, reduction = reduction)) + factorlab <- paste0("Factor", i) + colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) + + if (isTRUE(x = order)) { + tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] + } + + 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)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } else { + p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + + geom_point(size = pt.size_dimreduc) + + ggtitle(label = paste('Factor', i)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } + + tsne_list[[i]] = p1 + } + setTxtProgressBar(pb, i) + } + + # 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 (isTRUE(x = plot_dimreduc)) { + print(plot_list[[i]]) + print(tsne_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } else { + print(plot_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } + } + close(con = pb) + dev.off() + } + + # return plots + if (isTRUE(x = return_plots)) { + return(list(factor_plots = plot_list, + dimreduc_plots = tsne_list)) + } +} + + +#' Customized version of plotFactors +#' +#' Modified and optimized version of `plotFactors` function from LIGER package. +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function +#' @param num_genes Number of genes to display for each factor (Default 8). +#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be +#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction +#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), +#' @param pt.size_factors Adjust point size for plotting in the factor plots. +#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. +#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of +#' technique and therefore needs to be set manually. Default is "UMAP". +#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. +#' Helpful if number of datasets is large to avoid crowding the plot with legend. +#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the +#' dimensionality reduction plots (Default = FALSE). +#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. +#' @param save_plots logical. Whether to save plots. Default is TRUE +#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) +#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). +#' @param reorder_datasets New order to plot datasets in for the factor plots if different from current +#' factor level order in cell.data slot. +#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using +#' default ggplot2 "hue" palette instead of default "varibow" palette. +#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. +#' +#' @return A list of ggplot/patchwork objects and/or PDF file. +#' +#' @import cli +#' @import ggplot2 +#' @importFrom grDevices dev.off pdf +#' @importFrom patchwork wrap_plots +#' @importFrom scattermore geom_scattermore +#' +#' @noRd +#' +#' @concept liger_plotting +#' +#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) +#' @references Based on `plotFactors` functionality from original LIGER package. +#' +#' @examples +#' \dontrun{ +#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, +#' raster = FALSE, save_plots = TRUE) +#' } +#' + +plotFactors_liger_scCustom <- function( + liger_object, + num_genes = 8, + colors_use_factors = NULL, + colors_use_dimreduc = c('lemonchiffon', 'red'), + pt.size_factors = 1, + pt.size_dimreduc = 1, + reduction_label = "UMAP", + plot_legend = TRUE, + raster = TRUE, + raster.dpi = c(512, 512), + order = FALSE, + plot_dimreduc = TRUE, + save_plots = TRUE, + file_path = NULL, + file_name = NULL, + return_plots = FALSE, + cells.highlight = NULL, + reorder_datasets = NULL, + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # if returning and saving + if (isTRUE(x = save_plots)) { + + # Check file path is valid + if (!is.null(x = file_path) && file_path != "") { + if (!dir.exists(paths = file_path)) { + cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") + } + } + + # 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 <- "" + } + + # Check if file name provided + file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) + if (length(x = file_ext) == 0) { + file_name <- file_name + } else { + file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) + } + + if (is.null(x = file_name)) { + cli_abort(message = c("No file name provided.", + "i" = "Please provide a file name using {.code file_name}.") + ) + } + } + + if (!is.null(x = reorder_datasets)) { + # Check new order contains same dataset names and number of datasets + if (length(x = levels(x = liger_object@cell.data$dataset)) != length(x = reorder_datasets)) { + cli_abort(message = c("Error reordering datasets (number mismatch).", + "i" = "The number of datasets provided to {.code reorder_datasets} ({.field {length(x = reorder_datasets)}}) does not match number of datasets in LIGER object ({.field {length(x = levels(x = levels(liger_object@cell.data$dataset)))}}).") + ) + } else { + if (!all(levels(x = liger_object@cell.data$dataset) %in% reorder_datasets)) { + cli_abort(message = c("Error reordering datasets (name mismatch).", + "*" = "Dataset names provided to {.code reorder_datasets} do not match names of datasets in LIGER object.", + "i" = "Please check spelling.") + ) + } else { + liger_object@cell.data$dataset <- factor(x = liger_object@cell.data$dataset, levels = reorder_datasets) + } + } + } + + # Create accurate axis labels + x_axis_label <- paste0(reduction_label, "_1") + y_axis_label <- paste0(reduction_label, "_2") + + # Extract dataset number + num_datasets <- length(x = liger_object@scale.data) + + # Default Colors for Factor Plots + if (is.null(x = colors_use_factors)) { + 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) + } + } + + # Check valid number of colors for tsne/UMAP + if (length(x = colors_use_dimreduc) < 2) { + cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", + "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + ) + } + + # Add one time dim label warning + if (getOption(x = 'scCustomize_warn_LIGER_dim_labels_plotFactors', default = TRUE)) { + cli_inform(message = c("", + "NOTE: {.field plotFactors_scCustom} uses the {.code reduction_label} parameter to set axis labels", + "on the dimensionality reduction plots.", + "By default this is set to {.val UMAP}.", + "Please take note of this parameter as LIGER objects do not store the name", + "of reduction technique used and therefore this needs to be set manually.", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_LIGER_dim_labels_plotFactors = FALSE) + } + + # Get Data and Plot Factors + cli_inform(message = "{.field Generating plots}") + k <- ncol(x = liger_object@H.norm) + pb <- txtProgressBar(min = 0, max = k, style = 3) + W <- t(x = liger_object@W) + rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) + Hs_norm <- liger_object@H.norm + H_raw = do.call(rbind, liger_object@H) + plot_list = list() + tsne_list = list() + for (i in 1:k) { + top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] + top_genes.W.string <- paste0(top_genes.W, collapse = ", ") + factor_textstring <- paste0("Factor", i) + plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") + 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 (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') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } else { + top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'Raw H Score') + + ggtitle(plot_title1) + + theme(legend.position = 'none') + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + top <- top + NoLegend() + } + + bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + + geom_point(size = pt.size_factors) + + labs(x = 'Cell', y = 'H_norm Score') + + theme(legend.position = 'top', + legend.title = element_blank()) + + guides(colour = guide_legend(override.aes = list(size = 2))) + + scale_color_manual(values = colors_use_factors) + + if (isFALSE(x = plot_legend)) { + bottom <- bottom + NoLegend() + } + + } + + if (!is.null(cells.highlight)) { + h_df[cells.highlight, 'highlight'] = TRUE + if (isTRUE(x = raster)) { + top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + pointsize = pt.size_factors, + pixels = raster.dpi) + } else { + top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_raw"]]), + col = "black", + size = pt.size_factors) + bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), + aes(.data[["x"]], .data[["h_norm"]]), + col = "black", + size = pt.size_factors) + } + } + full <- wrap_plots(top, bottom, ncol = 1) + plot_list[[i]] = full + + # plot tSNE/UMAP + 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 (isTRUE(x = order)) { + tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] + } + + 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)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } else { + p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + + geom_point(size = pt.size_dimreduc) + + ggtitle(label = paste('Factor', i)) + + theme(legend.position = 'none') + + xlab(x_axis_label) + + ylab(y_axis_label) + + if (length(x = colors_use_dimreduc) == 2) { + scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) + } else { + scale_color_gradientn(colours = colors_use_dimreduc) + } + } + + tsne_list[[i]] = p1 + } + setTxtProgressBar(pb, i) + } + + # 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 (isTRUE(x = plot_dimreduc)) { + print(plot_list[[i]]) + print(tsne_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } else { + print(plot_list[[i]]) + setTxtProgressBar(pb = pb, value = i) + } + } + close(con = pb) + dev.off() + } + + # return plots + if (isTRUE(x = return_plots)) { + return(list(factor_plots = plot_list, + dimreduc_plots = tsne_list)) + } +} From e7c9aaa4f6d9a9e83aede7ac75976dbeb2a0bb9c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:08:00 -0400 Subject: [PATCH 139/503] update warnings --- R/Object_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 8fa0ffc504..5401742189 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -666,7 +666,7 @@ Add_Hemo.Seurat <- function( # Check that values are provided for mito and ribo if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { - cli_abort(message = c("No features or patterns provided for hemo genes.", + cli_abort(message = c("No features or patterns provided for hemoglobin genes.", "i" = "Please provide a default species name or pattern/features.")) } @@ -677,7 +677,7 @@ Add_Hemo.Seurat <- function( # Check length of hemo features found in object if (length_hemo_features < 1) { - cli_warn(message = c("No Hemo features found in object using pattern/feature list provided.", + cli_warn(message = c("No hemoglobin features found in object using pattern/feature list provided.", "i" = "No column will be added to meta.data.") ) } From 263d43438c7d181fc7f0f0b3367e9af2b8121c6b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:12:32 -0400 Subject: [PATCH 140/503] add percent hemo liger --- R/LIGER_Utilities.R | 1298 ++++--------------------------------------- 1 file changed, 121 insertions(+), 1177 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 2003343de0..904b7ab3ec 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -134,38 +134,7 @@ Top_Genes_Factor <- function( } -#' Extract default dimensionality reduction -#' -#' Extract name of the default dimensionlity reduction for liger object. -#' -#' @param liger_object LIGER object name. -#' -#' @return name of default dimensionality reduction -#' -#' @import cli -#' -#' @noRd -#' -#' @concept liger_object_util -#' -#' @examples -#' \dontrun{ -#' # return dimensionality reduction name -#' dim_reduc_name <- Default_DimReduc_LIGER(liger_object = obj) -#' } -#' - -Default_DimReduc_LIGER <- function( - liger_object -) { - if (length(x = liger_object@dimReds) > 0) { - default_reduc <- liger_object@uns$defaultDimRed - return(default_reduc) - } else { - cli_abort(message = "No dimensionality reduction present.") - } -} #' Extract dimensionality reduction coordinates from Liger object @@ -339,12 +308,6 @@ Add_Mito_Ribo.liger <- function( list_species_names = FALSE, ... ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # Accepted species names accepted_names <- data.frame( Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), @@ -592,1193 +555,174 @@ Add_Cell_Complexity.liger <- function( } -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### PLOTTING UTILITIES #################### -#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -#' DimPlot LIGER Version -#' -#' Standard and modified version of LIGER's plotByDatasetAndCluster -#' -#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. -#' @param clusters Another clustering to use for coloring second plot (must have same names as -#' clusters slot) (default NULL). -#' @param shuffle Randomly shuffle points so that points from same dataset are not plotted one after -#' the other (default TRUE). -#' @param shuffle_seed Random seed for reproducibility of point shuffling (default 1). -#' @param redorder.idents logical whether to reorder the datasets from default order before plotting (default FALSE). -#' @param new.order new dataset factor order for plotting. must set reorder.idents = TRUE. -#' @param group_by meta data varibale to group plots by -#' @param split_by meta data variable to splot plots by -#' -#' @return A data.frame with information for plotting -#' -#' @importFrom utils packageVersion -#' -#' @references This function is encompasses the first part of the LIGER function plotByDatasetAndCluster. -#' However, this function is modified to allow plotting other meta data variables. In this case the function -#' just returns the data.frame needed for plotting rather than plots themselves. -#' \url{https://github.com/welch-lab/liger}. (License: GPL-3). -#' -#' @noRd -#' -#' @concept liger_plotting_util -#' - -Generate_Plotting_df_LIGER <- function(object, - clusters = NULL, - shuffle = TRUE, - shuffle_seed = 1, - reorder.idents = FALSE, - new.order = NULL, - group_by = "dataset", - split_by = NULL -) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - - tsne_df <- data.frame(object@tsne.coords) - colnames(x = tsne_df) <- c("tsne1", "tsne2") - tsne_df[[group_by]] <- object@cell.data[[group_by]] - if (!is.null(x = split_by)) { - tsne_df[[split_by]] <- object@cell.data[[split_by]] - } - - if (isTRUE(x = reorder.idents)) { - tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) - } - c_names <- names(x = object@clusters) - if (is.null(x = clusters)) { - # if clusters have not been set yet - if (length(x = object@clusters) == 0) { - clusters <- rep(1, nrow(x = object@tsne.coords)) - names(x = clusters) <- c_names <- rownames(x = object@tsne.coords) - } else { - clusters <- object@clusters - c_names <- names(x = object@clusters) - } - } - tsne_df[['Cluster']] <- clusters[c_names] - - if (isTRUE(x = shuffle)) { - set.seed(shuffle_seed) - idx <- sample(x = 1:nrow(tsne_df)) - tsne_df <- tsne_df[idx, ] - } - return(tsne_df) -} - - -#' LIGER plot by cluster. -#' -#' Modified version of LIGER's plotByDatasetAndCluster just for plotting clusters. -#' -#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. -#' @param colors_use colors to use for plotting by cluster. 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 \code{\link{DiscretePalette_scCustomize}}. -#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. -#' If `combination = TRUE` will plot both clusters and meta data variable. -#' @param split_by meta data variable to split plots by (i.e. "dataset"). -#' @param title plot title. -#' @param pt_size Adjust point size for plotting. -#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store -#' name of technique and therefore needs to be set manually. Default is "UMAP". -#' @param num_columns Number of columns to plot by if `split_by` is not NULL. -#' @param shuffle logical. Whether to randomly shuffle the order of points. This can be useful for -#' crowded plots if points of interest are being buried. (Default is TRUE). -#' @param shuffle_seed Sets the seed if randomly shuffling the order of points. -#' @param legend.size what to set legend size to. -#' @param label logical. Whether or not to label the clusters. Default is TRUE. -#' @param label_size size of cluster labels. -#' @param label_repel logical. Whether to repel cluster labels from each other if plotting by -#' cluster (if `group_by = NULL` or `group_by = "cluster`). Default is FALSE. -#' @param label_box logical. Whether to put a box around the label text (uses `geom_text` vs `geom_label`). -#' Default is FALSE. -#' @param label_color Color to use for cluster labels. Default is "black". -#' @param redorder.idents logical. should the idents plotted by reordered. Default is FALSE. -#' @param new.order What should the new ident order be if `reorder.idents = 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(). -#' 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 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 hemo_pattern values. +#' @param hemo_name name to use for the new meta.data column containing percent hemoglobin counts. +#' Default is "percent_hemo". +#' @param hemo_pattern A regex pattern to match features against for hemoglobin genes (will set automatically if +#' species is mouse or human; marmoset features list saved separately). +#' @param hemo_features A list of hemoglobin gene names to be used instead of using regex pattern. +#' @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 `hemo_name` is +#' present in meta.data slot. +#' @param list_species_names returns list of all accepted values to use for default species names which +#' contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and +#' rhesus macaque). Default is FALSE. #' -#' @return A ggplot/patchwork object +#' @import cli +#' @importFrom magrittr "%>%" #' -#' @import ggplot2 -#' @importFrom cowplot theme_cowplot -#' @importFrom dplyr summarize -#' @importFrom ggrepel geom_text_repel geom_label_repel -#' @importFrom patchwork wrap_plots -#' @importFrom scattermore geom_scattermore -#' @importFrom stats median -#' @importFrom utils packageVersion +#' @method Add_Hemo liger #' -#' @references This function is encompasses part of the LIGER function plotByDatasetAndCluster. -#' However, this function is modified to just return cluster plots based on `Generate_Plotting_df_LIGER`. -#' \url{https://github.com/welch-lab/liger}. (Licence: GPL-3). +#' @export +#' @rdname Add_Hemo #' -#' @noRd +#' @concept qc_util #' -#' @concept liger_plotting_util +#' @examples +#' \dontrun{ +#' # Seurat +#' liger_object <- Add_Hemo(object = liger_object, species = "human") +#'} #' -Plot_By_Cluster_LIGER <- function( - liger_object, - colors_use = NULL, - group_by = "dataset", - split_by = NULL, - title = NULL, - pt_size = NULL, - reduction_label = "UMAP", - num_columns = NULL, - shuffle = TRUE, - shuffle_seed = 1, - legend.size = 5, - label = TRUE, - label_size = NA, - label_repel = FALSE, - label_box = FALSE, - label_color = "black", - reorder.idents = FALSE, - new.order = NULL, - raster = NULL, - raster.dpi = c(512, 512), - ggplot_default_colors = FALSE, - color_seed = 123 +Add_Hemo.liger <- function( + object, + species, + hemo_name = "percent_hemo", + hemo_pattern = NULL, + hemo_features = NULL, + assay = NULL, + overwrite = FALSE, + list_species_names = FALSE, + ... ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - - # Create plotting data.frame - tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) - - if (!is.null(x = split_by)) { - list_of_splits <- unique(x = tsne_df[[split_by]]) - } - - # Get length of meta data feature - if (!is.null(x = split_by) && !is.null(x = num_columns)) { - split.by_length <- length(x = list_of_splits) - - # 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.", - "*" = "{.field {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}}.") - ) - } - } - - centers <- tsne_df %>% group_by(.data[['Cluster']]) %>% summarize( - tsne1 = median(x = .data[['tsne1']]), - tsne2 = median(x = .data[['tsne2']]) + # 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) ) - cluster_length <- length(x = unique(x = liger_object@clusters)) - - if (is.null(x = colors_use)) { - # set default plot colors - if (is.null(x = colors_use)) { - colors_use <- scCustomize_Palette(num_groups = cluster_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) - } - } - - # Create accurate axis labels - x_axis_label <- paste0(reduction_label, "_1") - y_axis_label <- paste0(reduction_label, "_2") - - # plot - 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']])) + - theme_cowplot() + - geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - ggtitle(list_of_splits[x]) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - - 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 (isTRUE(x = label)) { - geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) - p2 <- p2 + geom.use( - data = centers, - mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, - show.legend = FALSE - ) - } else { - p2 <- p2 - } - }) - } else { - p2 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = .data[['Cluster']])) + - theme_cowplot() + - geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - - 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 (isTRUE(x = label)) { - geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) - p2 <- p2 + geom.use( - data = centers, - mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, - show.legend = FALSE - ) - } else { - p2 <- p2 - } - - } - } else { - 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']])) + - theme_cowplot() + - geom_point(size = pt_size) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - ggtitle(list_of_splits[x]) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - - 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 (isTRUE(x = label)) { - geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) - p2 <- p2 + geom.use( - data = centers, - mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, - show.legend = FALSE - ) - } else { - p2 <- p2 - } - }) - } else { - p2 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = .data[['Cluster']])) + - theme_cowplot() + - geom_point(size = pt_size) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - - 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 (isTRUE(x = label)) { - geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) - p2 <- p2 + geom.use( - data = centers, - mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, - show.legend = FALSE - ) - } else { - p2 <- p2 - } - } - } - if (!is.null(x = split_by) && !is.null(x = num_columns)) { - p2 <- wrap_plots(p2) + plot_layout(nrow = num_rows, ncol = num_columns, guides = 'collect') - return(p2) - } - if (!is.null(x = split_by) && is.null(x = num_columns)) { - p2 <- wrap_plots(p2) + plot_layout(guides = 'collect') - return(p2) - } else { - return(p2) - } -} - -#' LIGER plot by meta variables. -#' -#' Modified version of LIGER's plotByDatasetAndCluster just for plotting meta variables. -#' -#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. -#' @param colors_use colors to use for plotting by cluster. 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 \code{\link{DiscretePalette_scCustomize}}. -#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. -#' If `combination = TRUE` will plot both clusters and meta data variable. -#' @param split_by meta data variable to split plots by (i.e. "dataset"). -#' @param title plot title. -#' @param pt_size Adjust point size for plotting. -#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name -#' of technique and therefore needs to be set manually. Default is "UMAP". -#' @param num_columns Number of columns to plot by if `split_by` is not NULL. -#' @param shuffle logical. Whether to randomly shuffle the order of points. This can be useful for -#' crowded plots if points of interest are being buried. (Default is TRUE). -#' @param shuffle_seed Sets the seed if randomly shuffling the order of points. -#' @param legend.size what to set legend size to. -#' @param redorder.idents logical. should the idents plotted by reordered. Default is FALSE. -#' @param new.order What should the new ident order be if `reorder.idents = 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(). -#' 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. -#' -#' @return A ggplot/patchwork object -#' -#' @import ggplot2 -#' @importFrom cowplot theme_cowplot -#' @importFrom patchwork wrap_plots -#' @importFrom rlang sym "!!" -#' @importFrom scattermore geom_scattermore -#' @importFrom utils packageVersion -#' -#' @references This function is encompasses part of the LIGER function plotByDatasetAndCluster. -#' However, this function is modified to just return cluster plots based on `Generate_Plotting_df_LIGER`. -#' \url{https://github.com/welch-lab/liger}. (Licence: GPL-3). -#' -#' @noRd -#' -#' @concept liger_plotting_util -#' - -Plot_By_Meta_LIGER <- function( - liger_object, - colors_use = NULL, - group_by = "dataset", - split_by = NULL, - title = NULL, - pt_size = NULL, - reduction_label = "UMAP", - num_columns = NULL, - shuffle = TRUE, - shuffle_seed = 1, - legend.size = 3, - reorder.idents = FALSE, - new.order = NULL, - raster = NULL, - raster.dpi = c(512, 512), - ggplot_default_colors = FALSE, - color_seed = 123 -) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - - tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) - - if (!is.null(x = split_by)) { - list_of_splits <- unique(x = tsne_df[[split_by]]) + # Return list of accepted default species name options + if (isTRUE(x = list_species_names)) { + return(accepted_names) + stop_quietly() } - # Get length of meta data feature - if (!is.null(x = split_by) && !is.null(x = num_columns)) { - split.by_length <- length(x = list_of_splits) + # Check Seurat + Is_LIGER(seurat_object = object) - # Calculate number of rows for selected number of columns - num_rows <- ceiling(x = split.by_length/num_columns) + # Overwrite check + # Overwrite check + meta_names <- colnames(x = Fetch_Meta(object = object)) - # 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.", - "*" = "{.field {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}}.") + if (hemo_name %in% meta_names) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Columns with {.val {hemo_name}} already present in meta data.", + "i" = "*To run function and overwrite columns set parameter {.code overwrite = TRUE} or change {.code hemo_name}.*") ) } - } - - meta_length <- length(x = unique(x = liger_object@cell.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 = meta_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) - } - } - - # Create accurate axis labels - x_axis_label <- paste0(reduction_label, "_1") - y_axis_label <- paste0(reduction_label, "_2") - - group_by <- sym(x = group_by) - - 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)) + - theme_cowplot() + - geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - ggtitle(list_of_splits[x]) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - }) - } else { - p1 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = !!group_by)) + - theme_cowplot() + - geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - - } - } else { - 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)) + - theme_cowplot() + - geom_point(size = pt_size) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - ggtitle(list_of_splits[x]) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - }) - } else { - p1 <- ggplot(tsne_df, aes(x = .data[['tsne1']], y = .data[['tsne2']], color = !!group_by)) + - theme_cowplot() + - geom_point(size = pt_size) + - guides(color = guide_legend(override.aes = list(size = legend.size))) + - scale_color_manual(values = colors_use) + - theme(legend.position = "right", - axis.text = element_text(size = rel(0.95)), - plot.title = element_text(hjust = 0.5)) + - guides(col = guide_legend(title = "", override.aes = list(size = 4))) + - xlab(x_axis_label) + - ylab(y_axis_label) - } - } - if (!is.null(x = split_by) && !is.null(x = num_columns)) { - p1 <- wrap_plots(p1) + plot_layout(nrow = num_rows, ncol = num_columns) - return(p1) - } - if (!is.null(x = split_by) && is.null(x = num_columns)) { - p1 <- wrap_plots(p1) - return(p1) - } else { - return(p1) - } -} - - -#' Customized version of plotFactors -#' -#' Modified and optimized version of `plotFactors` function from LIGER package. -#' -#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function -#' @param num_genes Number of genes to display for each factor (Default 8). -#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be -#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. -#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction -#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), -#' @param pt.size_factors Adjust point size for plotting in the factor plots. -#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. -#' @param reduction Name of dimensionality reduction to use for plotting. -#' @param reduction_label `r lifecycle::badge("deprecated")` deprecated for newer style liger -#' objects. Use `reduction` instead. -#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. -#' Helpful if number of datasets is large to avoid crowding the plot with legend. -#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the -#' dimensionality reduction plots (Default = FALSE). -#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. -#' @param save_plots logical. Whether to save plots. Default is TRUE -#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) -#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). -#' @param reorder_datasets `r lifecycle::badge("deprecated")` deprecated for newer style liger objects -#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using -#' default ggplot2 "hue" palette instead of default "varibow" palette. -#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. -#' -#' @return A list of ggplot/patchwork objects and/or PDF file. -#' -#' @import cli -#' @import ggplot2 -#' @importFrom grDevices dev.off pdf -#' @importFrom lifecycle deprecated -#' @importFrom patchwork wrap_plots -#' @importFrom scattermore geom_scattermore -#' -#' @noRd -#' -#' @concept liger_plotting -#' -#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) -#' @references Based on `plotFactors` functionality from original LIGER package. -#' -#' @examples -#' \dontrun{ -#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, -#' raster = FALSE, save_plots = TRUE) -#' } -#' - -plotFactors_liger2_scCustom <- function( - liger_object, - num_genes = 8, - colors_use_factors = NULL, - colors_use_dimreduc = c('lemonchiffon', 'red'), - pt.size_factors = 1, - pt.size_dimreduc = 1, - reduction = "UMAP", - reduction_label = deprecated(), - plot_legend = TRUE, - raster = TRUE, - raster.dpi = c(512, 512), - order = FALSE, - plot_dimreduc = TRUE, - save_plots = TRUE, - file_path = NULL, - file_name = NULL, - return_plots = FALSE, - cells.highlight = NULL, - reorder_datasets = deprecated(), - ggplot_default_colors = FALSE, - color_seed = 123 -) { - # Check is slot is supplied - if (lifecycle::is_present(reorder_datasets)) { - lifecycle::deprecate_warn(when = "2.2.0", - what = "plotFactors_scCustom(reorder_datasets)", - details = c("i" = "The {.code reorder_datasets} parameter is deprecated for newer style Liger objects.") + cli_inform(message = c("Columns with {.val {hemo_name}} already present in meta data.", + "i" = "Overwriting those columns as {.code overwrite = TRUE}.") ) } - # Check is slot is supplied - if (lifecycle::is_present(reduction_label)) { - lifecycle::deprecate_warn(when = "2.2.0", - what = "plotFactors_scCustom(reduction_label)", - details = c("v" = "The {.code reduction_label} parameter is deprecated for newer style Liger objects.", - "i" = "Use {.code reduction} parameter instead") + # Checks species + if (is.null(x = species)) { + cli_abort(message = c("No species name or abbreivation was provided to {.code species} parameter.", + "i" = "If not using default species please set {.code species = other}.") ) } - # if returning and saving - if (isTRUE(x = save_plots)) { - # Check file path is valid - if (!is.null(x = file_path) && file_path != "") { - if (!dir.exists(paths = file_path)) { - cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") - } - } - - # 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 <- "" - } - - # Check if file name provided - file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) - if (length(x = file_ext) == 0) { - file_name <- file_name - } else { - file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) - } - - if (is.null(x = file_name)) { - cli_abort(message = c("No file name provided.", - "i" = "Please provide a file name using {.code file_name}.") - ) - } - } - - # Extract dataset number - num_datasets <- length(x = liger_object@datasets) - - # Default Colors for Factor Plots - if (is.null(x = colors_use_factors)) { - 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) - } - } + # 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 - # Check valid number of colors for tsne/UMAP - if (length(x = colors_use_dimreduc) < 2) { - cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", - "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + # Assign hemo pattern to stored species + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options) && any(!is.null(x = hemo_pattern))) { + cli_warn(message = c("Pattern expressions for included species are set by default.", + "*" = "Supplied {.code hemo_pattern} and {.code hemo_pattern} will be disregarded.", + "i" = "To override defaults please supply a feature list for hemo genes.") ) } - # Get Data and Plot Factors - k <- ncol(x = liger_object@H.norm) - if (is.null(x = k)) { - cli_abort(message = "{.code quantileNorm} must be run before plotting factors.") + if (species %in% mouse_options) { + species_use <- "Mouse" + hemo_pattern <- "^Hb[^(P)]" } - - cli_inform(message = "{.field Generating plots}") - pb <- txtProgressBar(min = 0, max = k, style = 3) - W <- liger_object@W - rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) - Hs_norm <- liger_object@H.norm - dataset_names <- names(liger_object@datasets) - H_raw_list <- lapply(1:num_datasets, function(x){ - H_raw <- t(liger_object@datasets[[x]]@H) - }) - H_raw = do.call(rbind, H_raw_list) - # Create accurate axis labels - reduc_check <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction, check_only = TRUE) - - x_axis_label <- paste0(reduction, "_1") - y_axis_label <- paste0(reduction, "_2") - plot_list = list() - tsne_list = list() - for (i in 1:k) { - top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] - top_genes.W.string <- paste0(top_genes.W, collapse = ", ") - factor_textstring <- paste0("Factor", i) - plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") - h_df = data.frame(x = 1:nrow(Hs_norm), h_norm = Hs_norm[, i], - h_raw = H_raw[, i], dataset = liger_object@cellMeta$dataset, - highlight = FALSE) - 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') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } - - } else { - top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'Raw H Score') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } - - } - - if (!is.null(cells.highlight)) { - h_df[cells.highlight, 'highlight'] = TRUE - if (isTRUE(x = raster)) { - top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - } else { - top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - size = pt.size_factors) - bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - size = pt.size_factors) - } - } - full <- wrap_plots(top, bottom, ncol = 1) - plot_list[[i]] = full - - # plot tSNE/UMAP - if (isTRUE(x = plot_dimreduc)) { - tsne_df <- data.frame(Hs_norm[, i], LIGER_DimReduc(liger_object = liger_object, reduction = reduction)) - factorlab <- paste0("Factor", i) - colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) - - if (isTRUE(x = order)) { - tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] - } - - 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)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } else { - p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + - geom_point(size = pt.size_dimreduc) + - ggtitle(label = paste('Factor', i)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } - - tsne_list[[i]] = p1 - } - setTxtProgressBar(pb, i) + if (species %in% human_options) { + species_use <- "Human" + hemo_pattern <- "^HB[^(P)]" } - - # 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 (isTRUE(x = plot_dimreduc)) { - print(plot_list[[i]]) - print(tsne_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } else { - print(plot_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } - } - close(con = pb) - dev.off() + if (species %in% c(marmoset_options, macaque_options)) { + species_use <- "Marmoset/Macaque" + hemo_pattern <- "^^HB[^(P)]" } - - # return plots - if (isTRUE(x = return_plots)) { - return(list(factor_plots = plot_list, - dimreduc_plots = tsne_list)) + if (species %in% zebrafish_options) { + species_use <- "Zebrafish" + hemo_pattern <- "^hb[^(P)]" } -} - - -#' Customized version of plotFactors -#' -#' Modified and optimized version of `plotFactors` function from LIGER package. -#' -#' @param liger_object \code{liger} liger_object. Need to perform clustering and factorization before calling this function -#' @param num_genes Number of genes to display for each factor (Default 8). -#' @param colors_use_factors colors to use for plotting factor loadings By default datasets will be -#' plotted using "varibow" with shuffle = TRUE from both from \code{\link{DiscretePalette_scCustomize}}. -#' @param colors_use_dimreduc colors to use for plotting factor loadings on dimensionality reduction -#' coordinates (tSNE/UMAP). Default is c('lemonchiffon', 'red'), -#' @param pt.size_factors Adjust point size for plotting in the factor plots. -#' @param pt.size_dimreduc Adjust point size for plotting in dimensionality reduction plots. -#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of -#' technique and therefore needs to be set manually. Default is "UMAP". -#' @param plot_legend logical, whether to plot the legend on factor loading plots, default is TRUE. -#' Helpful if number of datasets is large to avoid crowding the plot with legend. -#' @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 order logical. Whether to plot higher loading cells on top of cells with lower loading values in the -#' dimensionality reduction plots (Default = FALSE). -#' @param plot_dimreduc logical. Whether to plot factor loadings on dimensionality reduction coordinates. Default is TRUE. -#' @param save_plots logical. Whether to save plots. Default is TRUE -#' @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 return_plots logical. Whether or not to return plots to the environment. (Default is FALSE) -#' @param cells.highlight Names of specific cells to highlight in plot (black) (default NULL). -#' @param reorder_datasets New order to plot datasets in for the factor plots if different from current -#' factor level order in cell.data slot. -#' @param ggplot_default_colors logical. If `colors_use_factors = NULL`, Whether or not to return plot using -#' default ggplot2 "hue" palette instead of default "varibow" palette. -#' @param color_seed random seed for the palette shuffle if `colors_use_factors = NULL`. Default = 123. -#' -#' @return A list of ggplot/patchwork objects and/or PDF file. -#' -#' @import cli -#' @import ggplot2 -#' @importFrom grDevices dev.off pdf -#' @importFrom patchwork wrap_plots -#' @importFrom scattermore geom_scattermore -#' -#' @noRd -#' -#' @concept liger_plotting -#' -#' @author Velina Kozareva (Original code for modified function), Sam Marsh (Added/modified functionality) -#' @references Based on `plotFactors` functionality from original LIGER package. -#' -#' @examples -#' \dontrun{ -#' plotFactors_scCustom(liger_object = liger_obj, return_plots = FALSE, plot_dimreduc = TRUE, -#' raster = FALSE, save_plots = TRUE) -#' } -#' - -plotFactors_liger_scCustom <- function( - liger_object, - num_genes = 8, - colors_use_factors = NULL, - colors_use_dimreduc = c('lemonchiffon', 'red'), - pt.size_factors = 1, - pt.size_dimreduc = 1, - reduction_label = "UMAP", - plot_legend = TRUE, - raster = TRUE, - raster.dpi = c(512, 512), - order = FALSE, - plot_dimreduc = TRUE, - save_plots = TRUE, - file_path = NULL, - file_name = NULL, - return_plots = FALSE, - cells.highlight = NULL, - reorder_datasets = NULL, - ggplot_default_colors = FALSE, - color_seed = 123 -) { - # if returning and saving - if (isTRUE(x = save_plots)) { - - # Check file path is valid - if (!is.null(x = file_path) && file_path != "") { - if (!dir.exists(paths = file_path)) { - cli_abort(message = "Provided {.code file_path}: {.val {file_path}} does not exist.") - } - } - - # 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 <- "" - } - - # Check if file name provided - file_ext <- grep(x = file_name, pattern = ".pdf$", ignore.case = TRUE) - if (length(x = file_ext) == 0) { - file_name <- file_name - } else { - file_name <- gsub(pattern = ".pdf", replacement = "", x = file_name, ignore.case = TRUE) - } - - if (is.null(x = file_name)) { - cli_abort(message = c("No file name provided.", - "i" = "Please provide a file name using {.code file_name}.") - ) - } + if (species %in% rat_options) { + species_use <- "Rat" + hemo_pattern <- "^Hb[^(P)]" + } + if (species %in% drosophila_options) { + species_use <- "Drosophila" + hemo_pattern <- "^glob" } - if (!is.null(x = reorder_datasets)) { - # Check new order contains same dataset names and number of datasets - if (length(x = levels(x = liger_object@cell.data$dataset)) != length(x = reorder_datasets)) { - cli_abort(message = c("Error reordering datasets (number mismatch).", - "i" = "The number of datasets provided to {.code reorder_datasets} ({.field {length(x = reorder_datasets)}}) does not match number of datasets in LIGER object ({.field {length(x = levels(x = levels(liger_object@cell.data$dataset)))}}).") - ) - } else { - if (!all(levels(x = liger_object@cell.data$dataset) %in% reorder_datasets)) { - cli_abort(message = c("Error reordering datasets (name mismatch).", - "*" = "Dataset names provided to {.code reorder_datasets} do not match names of datasets in LIGER object.", - "i" = "Please check spelling.") - ) - } else { - liger_object@cell.data$dataset <- factor(x = liger_object@cell.data$dataset, levels = reorder_datasets) - } - } + # Check that values are provided for mito and ribo + if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { + cli_abort(message = c("No features or patterns provided for hemo genes.", + "i" = "Please provide a default species name or pattern/features.")) } - # Create accurate axis labels - x_axis_label <- paste0(reduction_label, "_1") - y_axis_label <- paste0(reduction_label, "_2") + # get all features + all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) - # Extract dataset number - num_datasets <- length(x = liger_object@scale.data) + # get features from patterns + hemo_features <- hemo_features %||% grep(pattern = hemo_pattern, x = all_features, value = TRUE) - # Default Colors for Factor Plots - if (is.null(x = colors_use_factors)) { - 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) - } - } + # Check features are present in object + length_hemo_features <- length(x = intersect(x = hemo_features, y = all_features)) - # Check valid number of colors for tsne/UMAP - if (length(x = colors_use_dimreduc) < 2) { - cli_abort(message = c("Less than two values provided to {.code colors_use_dimreduc}.", - "i" = "Must provided either two colors to use for creating a gradient or a larger color gradient.") + # Check length of hemo features found in object + if (length_hemo_features < 1) { + cli_warn(message = c("No hemoglobin features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") ) } - # Add one time dim label warning - if (getOption(x = 'scCustomize_warn_LIGER_dim_labels_plotFactors', default = TRUE)) { - cli_inform(message = c("", - "NOTE: {.field plotFactors_scCustom} uses the {.code reduction_label} parameter to set axis labels", - "on the dimensionality reduction plots.", - "By default this is set to {.val UMAP}.", - "Please take note of this parameter as LIGER objects do not store the name", - "of reduction technique used and therefore this needs to be set manually.", - "", - "-----This message will be shown once per session.-----")) - options(scCustomize_warn_LIGER_dim_labels_plotFactors = FALSE) - } - - # Get Data and Plot Factors - cli_inform(message = "{.field Generating plots}") - k <- ncol(x = liger_object@H.norm) - pb <- txtProgressBar(min = 0, max = k, style = 3) - W <- t(x = liger_object@W) - rownames(x = W) <- colnames(x = liger_object@scale.data[[1]]) - Hs_norm <- liger_object@H.norm - H_raw = do.call(rbind, liger_object@H) - plot_list = list() - tsne_list = list() - for (i in 1:k) { - top_genes.W <- rownames(x = W)[order(W[, i], decreasing = T)[1:num_genes]] - top_genes.W.string <- paste0(top_genes.W, collapse = ", ") - factor_textstring <- paste0("Factor", i) - plot_title1 <- paste(factor_textstring, "\n", top_genes.W.string, "\n") - 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 (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') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_scattermore(pointsize = pt.size_factors, pixels = raster.dpi) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } + # Add hemo column + cli_inform(message = "Adding Percent Hemoglobin for {.field {species_use}} using gene symbol pattern: {.val {hemo_pattern}}.") + if (length_hemo_features > 0) { + good_hemo <- hemo_features[hemo_features %in% all_features] + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(hemo_name = good_hemo), verbose = FALSE) } else { - top <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_raw"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'Raw H Score') + - ggtitle(plot_title1) + - theme(legend.position = 'none') + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - top <- top + NoLegend() - } - - bottom <- ggplot(h_df, aes(x = .data[["x"]], y=.data[["h_norm"]], col = .data[["dataset"]])) + - geom_point(size = pt.size_factors) + - labs(x = 'Cell', y = 'H_norm Score') + - theme(legend.position = 'top', - legend.title = element_blank()) + - guides(colour = guide_legend(override.aes = list(size = 2))) + - scale_color_manual(values = colors_use_factors) - - if (isFALSE(x = plot_legend)) { - bottom <- bottom + NoLegend() - } - + percent_hemo <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[good_hemo, ])/Matrix::colSums(x))*100})) + object@cell.data[ , hemo] <- percent_hemo } - - if (!is.null(cells.highlight)) { - h_df[cells.highlight, 'highlight'] = TRUE - if (isTRUE(x = raster)) { - top <- top + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - bottom <- bottom + geom_scattermore(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - pointsize = pt.size_factors, - pixels = raster.dpi) - } else { - top <- top + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_raw"]]), - col = "black", - size = pt.size_factors) - bottom <- bottom + geom_point(data = subset(h_df, .data[["highlight"]] == TRUE), - aes(.data[["x"]], .data[["h_norm"]]), - col = "black", - size = pt.size_factors) - } - } - full <- wrap_plots(top, bottom, ncol = 1) - plot_list[[i]] = full - - # plot tSNE/UMAP - 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 (isTRUE(x = order)) { - tsne_df <- tsne_df[order(tsne_df[,1], decreasing = FALSE),] - } - - 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)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } else { - p1 <- ggplot(tsne_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[[factorlab]])) + - geom_point(size = pt.size_dimreduc) + - ggtitle(label = paste('Factor', i)) + - theme(legend.position = 'none') + - xlab(x_axis_label) + - ylab(y_axis_label) + - if (length(x = colors_use_dimreduc) == 2) { - scale_color_gradient(low = colors_use_dimreduc[1], high = colors_use_dimreduc[2]) - } else { - scale_color_gradientn(colours = colors_use_dimreduc) - } - } - - tsne_list[[i]] = p1 - } - setTxtProgressBar(pb, i) } - # 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 (isTRUE(x = plot_dimreduc)) { - print(plot_list[[i]]) - print(tsne_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } else { - print(plot_list[[i]]) - setTxtProgressBar(pb = pb, value = i) - } - } - close(con = pb) - dev.off() - } - - # return plots - if (isTRUE(x = return_plots)) { - return(list(factor_plots = plot_list, - dimreduc_plots = tsne_list)) - } + # return final object + return(object) } - - - #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### ANALYSIS UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From cd9d20d86bae1777138ee5a53ad2006068587578 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:19:58 -0400 Subject: [PATCH 141/503] fix typo --- R/Internal_Utilities.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 9d49cf9f5d..5d4ac488f9 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -695,7 +695,7 @@ Retrieve_Ensembl_Ribo <- function( 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 + # Add meta data columns if (length(x = oxphos_found) > 0) { seurat_object[[oxphos_name]] <- PercentageFeatureSet(object = seurat_object, features = oxphos_found, assay = assay) } @@ -714,7 +714,6 @@ Retrieve_Ensembl_Ribo <- function( } - #' Add IEG Gene List Percentages #' #' Adds percentage of counts from IEG genes from mouse and human. From d208d0bb219da87e2f3e62c2df9aaec585325017 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:22:08 -0400 Subject: [PATCH 142/503] typo --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 904b7ab3ec..36bb4d050b 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -715,7 +715,7 @@ Add_Hemo.liger <- function( } else { percent_hemo <- unlist(lapply(object@raw.data, function(x) { (Matrix::colSums(x[good_hemo, ])/Matrix::colSums(x))*100})) - object@cell.data[ , hemo] <- percent_hemo + object@cell.data[ , hemo_name] <- percent_hemo } } From fe40d07f4213acee1725ff0404e1952ede95e7a0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:24:13 -0400 Subject: [PATCH 143/503] remove assay from liger version --- R/LIGER_Utilities.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 36bb4d050b..19bbdf064e 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -563,7 +563,6 @@ Add_Cell_Complexity.liger <- function( #' @param hemo_pattern A regex pattern to match features against for hemoglobin genes (will set automatically if #' species is mouse or human; marmoset features list saved separately). #' @param hemo_features A list of hemoglobin gene names to be used instead of using regex pattern. -#' @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 `hemo_name` is #' present in meta.data slot. @@ -594,7 +593,6 @@ Add_Hemo.liger <- function( hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, - assay = NULL, overwrite = FALSE, list_species_names = FALSE, ... From 84cb26a8fe6c16783efc120daa166f9b5d5de993 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:24:44 -0400 Subject: [PATCH 144/503] add msigdb liger internal --- R/LIGER_Internal_Utilities.R | 125 ++++++++++++++++++++++++++++++++++- 1 file changed, 124 insertions(+), 1 deletion(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index b0d97eddf4..fc3ebe4df4 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -38,7 +38,7 @@ Default_DimReduc_LIGER <- function( #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### INTERNAL LIGER PLOTTING UTILITIES #################### +#################### LIGER PLOTTING UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1220,3 +1220,126 @@ plotFactors_liger_scCustom <- function( dimreduc_plots = tsne_list)) } } + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### QC UTILITIES #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' 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 liger_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 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 liger object +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Add_MSigDB_LIGER <- function( + liger_object, + species, + oxphos_name = "percent_oxphos", + apop_name = "percent_apop", + dna_repair_name = "percent_dna_repair", + 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_LIGER(liger_object = liger_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 + meta_names <- colnames(x = Fetch_Meta(object = liger_object)) + + if (oxphos_name %in% meta_names || apop_name %in% meta_names || dna_repair_name %in% meta_names) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Columns with {.val {oxphos_name}} and/or {.val {apop_name}} already present in meta data.", + "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.", + "i" = "Overwriting those columns as {.code overwrite = TRUE.}") + ) + } + + # Retrieve gene lists + msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + + # Check features are present in object + all_features <- LIGER_Features(liger_object = liger_object, by_dataset = FALSE) + + oxphos_found <- intersect(x = msigdb_gene_list[["oxphos"]], y = all_features) + apop_found <- intersect(x = msigdb_gene_list[["apop"]], y = all_features) + dna_repair_found <- intersect(x = msigdb_gene_list[["dna_repair"]], y = all_features) + + # Add meta data columns + if (oxphos_found > 0) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(oxphos_name = oxphos_found), verbose = FALSE) + } else { + percent_oxphos <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[oxphos_found, ])/Matrix::colSums(x))*100})) + object@cell.data[ , oxphos_name] <- percent_oxphos + } + } + + if (apop_found > 0) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(apop_name = apop_found), verbose = FALSE) + } else { + percent_apop <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[apop_found, ])/Matrix::colSums(x))*100})) + object@cell.data[ , apop_name] <- percent_apop + } + } + + if (dna_repair_found > 0) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(dna_repair_name = dna_repair_found), verbose = FALSE) + } else { + percent_dna_repair <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[dna_repair_found, ])/Matrix::colSums(x))*100})) + object@cell.data[ , dna_repair_name] <- percent_dna_repair + } + } + + # return final object + return(liger_object) +} From 1877c95ac3c69936f9d1b5507d204dc57bbeff85 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:24:58 -0400 Subject: [PATCH 145/503] update docs --- man/Add_Hemo.Rd | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index c9958c358d..6de1b54727 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -1,12 +1,26 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Generics.R, R/Object_Utilities.R +% Please edit documentation in R/Generics.R, R/LIGER_Utilities.R, +% R/Object_Utilities.R \name{Add_Hemo} \alias{Add_Hemo} +\alias{Add_Hemo.liger} \alias{Add_Hemo.Seurat} \title{Add Hemoglobin percentages} \usage{ Add_Hemo(object, ...) +\method{Add_Hemo}{liger}( + object, + species, + hemo_name = "percent_hemo", + hemo_pattern = NULL, + hemo_features = NULL, + assay = NULL, + overwrite = FALSE, + list_species_names = FALSE, + ... +) + \method{Add_Hemo}{Seurat}( object, species, @@ -54,6 +68,11 @@ Add hemoglobin percentages to meta.data slot of Seurat Object or cell.data/cellMeta slot of Liger object } \examples{ +\dontrun{ +# Seurat +liger_object <- Add_Hemo(object = liger_object, species = "human") +} + \dontrun{ # Seurat seurat_object <- Add_Hemo(object = seurat_object, species = "human") From 912c399ff39276c5345cc868126492893a489a0c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:25:06 -0400 Subject: [PATCH 146/503] Update namespace --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index c99ca83951..efd9a23585 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ S3method(Add_Cell_Complexity,Seurat) S3method(Add_Cell_Complexity,liger) S3method(Add_Hemo,Seurat) +S3method(Add_Hemo,liger) S3method(Add_Mito_Ribo,Seurat) S3method(Add_Mito_Ribo,liger) S3method(Fetch_Meta,Seurat) From e1b0e28ceecc7baf9657d734e8b4ac3286fb2e44 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:25:49 -0400 Subject: [PATCH 147/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 5efa790240..2e2b789839 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,7 @@ - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. -- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). +- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. From 1d261d9666e299ccda25a4b2b3a05cdc1c849716 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 09:26:07 -0400 Subject: [PATCH 148/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e4b4c246c4..9b52cf5777 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" RRID:SCR_024675. -Version: 2.1.2.9023 -Date: 2024-03-20 +Version: 2.1.2.9024 +Date: 2024-03-22 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"), From c458aaec94569fc1cc0abea9eba54a8a436277f4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:04:14 -0400 Subject: [PATCH 149/503] add top gene generic --- R/Generics.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/R/Generics.R b/R/Generics.R index 6f979ce3b3..01e65b65f6 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -94,6 +94,21 @@ Add_Cell_Complexity <- function(object, ...) { } +#' Add Percent of High Abundance Genes +#' +#' Add the percentage of counts occupied by the top XX most highly expressed genes in each cell. +#' +#' @param object Seurat or liger object name. +#' +#' @rdname Add_Top_Gene_Pct +#' @export Add_Top_Gene_Pct +#' + +Add_Top_Gene_Pct <- function(object, ...) { + UseMethod(generic = 'Add_Top_Gene_Pct', object = object) +} + + #' Get meta data from object #' #' Quick function to properly pull meta.data from objects. From e8cc9c0688c5e0f1a6a96f01f0bb590e3fb53f4e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:04:28 -0400 Subject: [PATCH 150/503] update top gene percent to generic --- R/LIGER_Utilities.R | 118 +++++++++++++++++++++++++++++++++++++++++++ R/Object_Utilities.R | 28 +++++----- 2 files changed, 131 insertions(+), 15 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 19bbdf064e..97ff206d98 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -721,6 +721,124 @@ Add_Hemo.liger <- function( return(object) } + +#' @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 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. +#' @param verbose logical, whether to print messages with status updates, default is TRUE. +#' +#' @import cli +#' @importFrom dplyr select all_of bind_rows +#' @importFrom magrittr "%>%" +#' @importFrom rlang is_installed +#' +#' @return A liger Object +#' +#' @method Add_Top_Gene_Pct Seurat +#' +#' @export +#' @rdname Add_Top_Gene_Pct +#' +#' @concept qc_util +#' +#' @examples +#' \dontrun{ +#' library(Seurat) +#' pbmc_small <- Add_Top_Gene_Pct_Seurat(object = pbmc_small, num_top_genes = 50) +#' } +#' + +Add_Top_Gene_Pct.liger <- function( + object, + num_top_genes = 50, + meta_col_name = NULL, + overwrite = FALSE, + verbose = TRUE +){ + # 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_LIGER(liger_object = object) + + # 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 + meta_names <- colnames(x = Fetch_Meta(object = object)) + + if (meta_col_name %in% meta_names) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Column {.val {meta_col_name}} already present in meta data.", + "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.", + "i" = "Overwriting those columns as {.code overwrite = TRUE}.") + ) + } + + # Get number of datasets + if (packageVersion(pkg = 'rliger') > "1.0.1") { + num_datasets <- length(x = object@datasets) + } else { + num_datasets <- length(x = object@raw.data) + } + + # Extract matrix + if (isTRUE(x = verbose)) { + cli_inform(message = "Calculating percent expressing top {num_top_genes} across all datasets.") + } + + # apply over all datasets + res_list <- lapply(1:num_datasets, function(x) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + dataset_mat <- rliger::getMatrix(x = object, slot = "rawData")[[x]] + } else { + dataset_mat <- object@raw.data[[x]] + } + + # run scuttle + dataset_res <- as.data.frame(scuttle::perCellQCMetrics(x = dataset_mat, percent.top = num_top_genes)) + # select results column + dataset_res <- dataset_res %>% + select(all_of(scuttle_colname)) + }) + + # combine results + if (isTRUE(x = verbose)) { + cli_inform(message = "Combining data from all datasets.") + } + res <- bind_rows(res_list) + + # Add to object and return + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object@cellMeta[[meta_col_name]] <- res + } else { + object@cell.data[ , meta_col_name] <- res + } + + # return object + return(object) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### ANALYSIS UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 5401742189..4e043a85a2 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -764,11 +764,6 @@ 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 @@ -787,7 +782,10 @@ Add_Cell_Complexity.Seurat <- function( #' #' @return A Seurat Object #' +#' @method Add_Top_Gene_Pct Seurat +#' #' @export +#' @rdname Add_Top_Gene_Pct #' #' @concept qc_util #' @@ -806,8 +804,8 @@ Add_Cell_Complexity.Seurat <- function( #' } #' -Add_Top_Gene_Pct_Seurat <- function( - seurat_object, +Add_Top_Gene_Pct.Seurat <- function( + object, num_top_genes = 50, meta_col_name = NULL, assay = "RNA", @@ -828,7 +826,7 @@ Add_Top_Gene_Pct_Seurat <- function( } # Check Seurat - Is_Seurat(seurat_object = seurat_object) + Is_Seurat(seurat_object = object) # Add assay warning message if (assay != "RNA") { @@ -844,7 +842,7 @@ Add_Top_Gene_Pct_Seurat <- function( } # Check columns for overwrite - if (meta_col_name %in% colnames(x = seurat_object@meta.data)) { + if (meta_col_name %in% colnames(x = 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}*.") @@ -855,7 +853,7 @@ Add_Top_Gene_Pct_Seurat <- function( ) } - count_layers_present <- Layers(object = seurat_object, search = "counts") + count_layers_present <- Layers(object = object, search = "counts") # Extract matrix if (length(x = count_layers_present) == 1) { @@ -863,7 +861,7 @@ Add_Top_Gene_Pct_Seurat <- function( cli_inform(message = "Calculating percent expressing top {num_top_genes} for layer: {.field {count_layers_present}}") } - count_mat <- LayerData(object = seurat_object, assay = assay, layer = "counts") + count_mat <- LayerData(object = object, assay = assay, layer = "counts") # calculate res <- as.data.frame(scuttle::perCellQCMetrics(x = count_mat, percent.top = num_top_genes)) @@ -881,7 +879,7 @@ Add_Top_Gene_Pct_Seurat <- function( } # Get layer data - layer_count <- LayerData(object = seurat_object, assay = assay, layer = count_layers_present[x]) + layer_count <- LayerData(object = object, assay = assay, layer = count_layers_present[x]) # run scuttle layer_res <- as.data.frame(scuttle::perCellQCMetrics(x = layer_count, percent.top = num_top_genes)) @@ -898,12 +896,12 @@ Add_Top_Gene_Pct_Seurat <- function( } # Add to object and return - seurat_object <- AddMetaData(object = seurat_object, metadata = res, col.name = meta_col_name) + object <- AddMetaData(object = object, metadata = res, col.name = meta_col_name) # Log Command - seurat_object <- LogSeuratCommand(object = seurat_object) + object <- LogSeuratCommand(object = object) - return(seurat_object) + return(object) } From 8e33063600159bce87fe646ab1a2676d13ddd33f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:04:38 -0400 Subject: [PATCH 151/503] update add hemo --- man/Add_Hemo.Rd | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index 6de1b54727..f679b2fef0 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -15,7 +15,6 @@ Add_Hemo(object, ...) hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, - assay = NULL, overwrite = FALSE, list_species_names = FALSE, ... @@ -50,8 +49,6 @@ species is mouse or human; marmoset features list saved separately).} \item{hemo_features}{A list of hemoglobin gene names to be used instead of using regex pattern.} -\item{assay}{Assay to use (default is the current object default assay).} - \item{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 \code{hemo_name} is present in meta.data slot.} @@ -59,6 +56,8 @@ present in meta.data slot.} \item{list_species_names}{returns list of all accepted values to use for default species names which contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). Default is FALSE.} + +\item{assay}{Assay to use (default is the current object default assay).} } \value{ An object of the same class as \code{object} with columns added to object meta data. From 8efde1d46bfa9f9c0a481633edb94ef6079600dd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:05:59 -0400 Subject: [PATCH 152/503] update deprecated --- R/Deprecated.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/Deprecated.R b/R/Deprecated.R index 47e881b8bd..4c685ab214 100644 --- a/R/Deprecated.R +++ b/R/Deprecated.R @@ -75,3 +75,15 @@ Add_Cell_Complexity_LIGER <- function(...) { Meta_Present_LIGER <- function(...) { lifecycle::deprecate_stop(when = "2.1.0", what = "Meta_Present_LIGER()", with = "Meta_Present()") } + + +#' @description +#' Use [Add_Top_Gene_Pct()] instead of `Add_Top_Gene_Pct_Seurat()`. +#' +#' @export +#' @keywords internal +#' @rdname deprecated + +Add_Top_Gene_Pct_Seurat <- function(...) { + lifecycle::deprecate_stop(when = "2.2.0", what = "Add_Top_Gene_Pct_Seurat()", with = "Add_Top_Gene_Pct()") +} From 5b32ea3948737f93f184c691d36ef4bdbec75f03 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:06:07 -0400 Subject: [PATCH 153/503] update docs --- ...Gene_Pct_Seurat.Rd => Add_Top_Gene_Pct.Rd} | 38 ++++++++++++++----- 1 file changed, 29 insertions(+), 9 deletions(-) rename man/{Add_Top_Gene_Pct_Seurat.Rd => Add_Top_Gene_Pct.Rd} (77%) diff --git a/man/Add_Top_Gene_Pct_Seurat.Rd b/man/Add_Top_Gene_Pct.Rd similarity index 77% rename from man/Add_Top_Gene_Pct_Seurat.Rd rename to man/Add_Top_Gene_Pct.Rd index 375225b883..3b84cd2681 100644 --- a/man/Add_Top_Gene_Pct_Seurat.Rd +++ b/man/Add_Top_Gene_Pct.Rd @@ -1,11 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Object_Utilities.R -\name{Add_Top_Gene_Pct_Seurat} -\alias{Add_Top_Gene_Pct_Seurat} +% Please edit documentation in R/Generics.R, R/LIGER_Utilities.R, +% R/Object_Utilities.R +\name{Add_Top_Gene_Pct} +\alias{Add_Top_Gene_Pct} +\alias{Add_Top_Gene_Pct.liger} +\alias{Add_Top_Gene_Pct.Seurat} \title{Add Percent of High Abundance Genes} \usage{ -Add_Top_Gene_Pct_Seurat( - seurat_object, +Add_Top_Gene_Pct(object, ...) + +\method{Add_Top_Gene_Pct}{Seurat}( + object, + num_top_genes = 50, + meta_col_name = NULL, + overwrite = FALSE, + verbose = TRUE +) + +\method{Add_Top_Gene_Pct}{Seurat}( + object, num_top_genes = 50, meta_col_name = NULL, assay = "RNA", @@ -14,7 +27,7 @@ Add_Top_Gene_Pct_Seurat( ) } \arguments{ -\item{seurat_object}{object name.} +\item{object}{Seurat or liger object name.} \item{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.} @@ -22,21 +35,28 @@ Used to compute the percentage of library size occupied by the most highly expre \item{meta_col_name}{name to use for new meta data column. Default is "percent_topXX", where XX is equal to the value provided to \code{num_top_genes}.} -\item{assay}{assay to use in calculation. Default is "RNA". \emph{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).} - \item{overwrite}{Logical. Whether to overwrite existing an meta.data column. Default is FALSE meaning that function will abort if column with name provided to \code{meta_col_name} is present in meta.data slot.} \item{verbose}{logical, whether to print messages with status updates, default is TRUE.} + +\item{assay}{assay to use in calculation. Default is "RNA". \emph{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).} } \value{ +A liger Object + A Seurat Object } \description{ Add the percentage of counts occupied by the top XX most highly expressed genes in each cell. } \examples{ +\dontrun{ +library(Seurat) +pbmc_small <- Add_Top_Gene_Pct_Seurat(object = pbmc_small, num_top_genes = 50) +} + \dontrun{ library(Seurat) pbmc_small <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc_small, num_top_genes = 50) From a52e45665500907e91a18bd4f631c818d07cae0e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:06:26 -0400 Subject: [PATCH 154/503] deprecated --- man/deprecated.Rd | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/man/deprecated.Rd b/man/deprecated.Rd index 810a0a0d00..bf44d17f60 100644 --- a/man/deprecated.Rd +++ b/man/deprecated.Rd @@ -8,6 +8,7 @@ \alias{Add_Cell_Complexity_Seurat} \alias{Add_Cell_Complexity_LIGER} \alias{Meta_Present_LIGER} +\alias{Add_Top_Gene_Pct_Seurat} \title{Deprecated functions \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} \usage{ Split_FeatureScatter(...) @@ -21,6 +22,8 @@ Add_Cell_Complexity_Seurat(...) Add_Cell_Complexity_LIGER(...) Meta_Present_LIGER(...) + +Add_Top_Gene_Pct_Seurat(...) } \description{ Use \code{\link[=FeatureScatter_scCustom]{FeatureScatter_scCustom()}} instead of \code{Split_FeatureScatter()}. @@ -34,5 +37,7 @@ Use \code{\link[=Add_Cell_Complexity]{Add_Cell_Complexity()}} instead of \code{A Use \code{\link[=Add_Cell_Complexity]{Add_Cell_Complexity()}} instead of \code{Add_Cell_Complexity_LIGER()}. Use \code{\link[=Meta_Present]{Meta_Present()}} instead of \code{Meta_Present_LIGER()}. + +Use \code{\link[=Add_Top_Gene_Pct]{Add_Top_Gene_Pct()}} instead of \code{Add_Top_Gene_Pct_Seurat()}. } \keyword{internal} From 6302bcd9917adb12b395511e491ddc3b7dec73f5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:06:34 -0400 Subject: [PATCH 155/503] Update namespace --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index efd9a23585..e747be96dc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ S3method(Add_Hemo,Seurat) S3method(Add_Hemo,liger) S3method(Add_Mito_Ribo,Seurat) S3method(Add_Mito_Ribo,liger) +S3method(Add_Top_Gene_Pct,Seurat) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) S3method(as.LIGER,Seurat) @@ -25,6 +26,7 @@ export(Add_Mito_Ribo_LIGER) export(Add_Mito_Ribo_Seurat) export(Add_Pct_Diff) export(Add_Sample_Meta) +export(Add_Top_Gene_Pct) export(Add_Top_Gene_Pct_Seurat) export(Barcode_Plot) export(Blank_Theme) From 8103e27e6739293ff5eccf974da870e50b4d1312 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:07:49 -0400 Subject: [PATCH 156/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 2e2b789839..8527a52fc0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,7 @@ ## Changed +- **BREAKING CHANGES** `Add_Top_Gene_Pct_Seurat` is now S3 generic that works with both Seurat and liger objects and has been renamed `Add_Top_Gene_Pct`. - Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. - Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). - Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. From 82773c0c34365914ea41462228f0256dc2cd2d30 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:08:10 -0400 Subject: [PATCH 157/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9b52cf5777..3903692d8d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9024 +Version: 2.1.2.9025 Date: 2024-03-22 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")), From b82390fc183c3600183d0ca4e41db21ce6345a2e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:12:25 -0400 Subject: [PATCH 158/503] fix typos --- R/LIGER_Internal_Utilities.R | 4 ++-- R/LIGER_Utilities.R | 19 +++++++++---------- R/Object_Utilities.R | 2 +- 3 files changed, 12 insertions(+), 13 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index fc3ebe4df4..0e45fc41ab 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -1233,7 +1233,7 @@ plotFactors_liger_scCustom <- function( #' "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". #' #' @param liger_object object name. -#' @param species Species of origin for given Seurat Object. Only accepted species are: mouse, human, +#' @param species Species of origin for given 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". @@ -1277,7 +1277,7 @@ Add_MSigDB_LIGER <- function( cli_inform(message = "The supplied species ({.field {species}}) is not currently supported.") } - # Check Seurat + # Check liger Is_LIGER(liger_object = liger_object) # Check name collision diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 97ff206d98..c91561d242 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -246,7 +246,7 @@ Find_Factor_Cor <- function( #' Add Mito and Ribo percentages #' -#' @param species Species of origin for given Seurat Object. If mouse, human, marmoset, zebrafish, rat, +#' @param species Species of origin for given 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. @@ -526,7 +526,7 @@ Add_Cell_Complexity.liger <- function( "i" = "Functionality with rliger v2+ is currently in development.")) } - # Check Seurat + # Check liger Is_LIGER(liger_object = object) # Check columns for overwrite @@ -555,7 +555,7 @@ Add_Cell_Complexity.liger <- function( } -#' @param species Species of origin for given Seurat Object. If mouse, human, marmoset, zebrafish, rat, +#' @param species Species of origin for given Object. If mouse, human, marmoset, zebrafish, rat, #' drosophila, or rhesus macaque (name or abbreviation) are provided the function will automatically #' generate hemo_pattern values. #' @param hemo_name name to use for the new meta.data column containing percent hemoglobin counts. @@ -582,7 +582,7 @@ Add_Cell_Complexity.liger <- function( #' #' @examples #' \dontrun{ -#' # Seurat +#' # Liger #' liger_object <- Add_Hemo(object = liger_object, species = "human") #'} #' @@ -614,8 +614,8 @@ Add_Hemo.liger <- function( stop_quietly() } - # Check Seurat - Is_LIGER(seurat_object = object) + # Check liger + Is_LIGER(liger_object = object) # Overwrite check # Overwrite check @@ -737,7 +737,7 @@ Add_Hemo.liger <- function( #' #' @return A liger Object #' -#' @method Add_Top_Gene_Pct Seurat +#' @method Add_Top_Gene_Pct liger #' #' @export #' @rdname Add_Top_Gene_Pct @@ -746,8 +746,7 @@ Add_Hemo.liger <- function( #' #' @examples #' \dontrun{ -#' library(Seurat) -#' pbmc_small <- Add_Top_Gene_Pct_Seurat(object = pbmc_small, num_top_genes = 50) +#' liger_object <- Add_Top_Gene_Pct(object = liger_object, num_top_genes = 50) #' } #' @@ -771,7 +770,7 @@ Add_Top_Gene_Pct.liger <- function( )) } - # Check Seurat + # Check Liger Is_LIGER(liger_object = object) # Set colnames diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 4e043a85a2..5a1e2ce22b 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -800,7 +800,7 @@ Add_Cell_Complexity.Seurat <- function( #' @examples #' \dontrun{ #' library(Seurat) -#' pbmc_small <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc_small, num_top_genes = 50) +#' pbmc_small <- Add_Top_Gene_Pct(seurat_object = pbmc_small, num_top_genes = 50) #' } #' From 40b81be4b7ff76c018d3fb34b96e4c477288d403 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:13:05 -0400 Subject: [PATCH 159/503] Update docs --- NAMESPACE | 1 + man/Add_Hemo.Rd | 2 +- man/Add_Top_Gene_Pct.Rd | 7 +++---- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e747be96dc..2dbb0d5cca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ S3method(Add_Hemo,liger) S3method(Add_Mito_Ribo,Seurat) S3method(Add_Mito_Ribo,liger) S3method(Add_Top_Gene_Pct,Seurat) +S3method(Add_Top_Gene_Pct,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) S3method(as.LIGER,Seurat) diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index f679b2fef0..fdf01ffd3a 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -68,7 +68,7 @@ cell.data/cellMeta slot of Liger object } \examples{ \dontrun{ -# Seurat +# Liger liger_object <- Add_Hemo(object = liger_object, species = "human") } diff --git a/man/Add_Top_Gene_Pct.Rd b/man/Add_Top_Gene_Pct.Rd index 3b84cd2681..6394b15aa6 100644 --- a/man/Add_Top_Gene_Pct.Rd +++ b/man/Add_Top_Gene_Pct.Rd @@ -9,7 +9,7 @@ \usage{ Add_Top_Gene_Pct(object, ...) -\method{Add_Top_Gene_Pct}{Seurat}( +\method{Add_Top_Gene_Pct}{liger}( object, num_top_genes = 50, meta_col_name = NULL, @@ -53,13 +53,12 @@ Add the percentage of counts occupied by the top XX most highly expressed genes } \examples{ \dontrun{ -library(Seurat) -pbmc_small <- Add_Top_Gene_Pct_Seurat(object = pbmc_small, num_top_genes = 50) +liger_object <- Add_Top_Gene_Pct(object = liger_object, num_top_genes = 50) } \dontrun{ library(Seurat) -pbmc_small <- Add_Top_Gene_Pct_Seurat(seurat_object = pbmc_small, num_top_genes = 50) +pbmc_small <- Add_Top_Gene_Pct(seurat_object = pbmc_small, num_top_genes = 50) } } From d0ae2387459b0797d597539800faa1211f75d186 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:25:28 -0400 Subject: [PATCH 160/503] add ability to understand "ident" as grouping variable --- R/Statistics_Plotting.R | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index a5e1accb3e..d0f0081d99 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -51,6 +51,14 @@ Plot_Median_Genes <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # add to meta if grouping by ident + if (group_by == "ident") { + seurat_object[["ident"]] <- Idents(object = seurat_object) + if (is.null(x = legend_title)) { + legend_title <- "Identity" + } + } + # Check group by is valid group_by <- Meta_Present(object = seurat_object, meta_col_names = group_by, print_msg = FALSE)[[1]] @@ -189,6 +197,14 @@ Plot_Median_UMIs <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # add to meta if grouping by ident + if (group_by == "ident") { + seurat_object[["ident"]] <- Idents(object = seurat_object) + if (is.null(x = legend_title)) { + legend_title <- "Identity" + } + } + # Check group by is valid group_by <- Meta_Present(object = seurat_object, meta_col_names = group_by, print_msg = FALSE)[[1]] @@ -328,6 +344,14 @@ Plot_Median_Mito <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # add to meta if grouping by ident + if (group_by == "ident") { + seurat_object[["ident"]] <- Idents(object = seurat_object) + if (is.null(x = legend_title)) { + legend_title <- "Identity" + } + } + # Check group by is valid group_by <- Meta_Present(object = seurat_object, meta_col_names = group_by, print_msg = FALSE)[[1]] @@ -482,6 +506,14 @@ Plot_Median_Other <- function( y_axis_label <- paste0("Median ", median_var) } + # add to meta if grouping by ident + if (group_by == "ident") { + seurat_object[["ident"]] <- Idents(object = seurat_object) + if (is.null(x = legend_title)) { + legend_title <- "Identity" + } + } + # Check group by is valid group_by <- Meta_Present(object = seurat_object, meta_col_names = group_by, print_msg = FALSE)[[1]] @@ -623,6 +655,14 @@ Plot_Cells_per_Sample <- function( cli_abort(message = "Must provide meta data variable to {.code group_by} in order to plot data.") } + # add to meta if grouping by ident + if (group_by == "ident") { + seurat_object[["ident"]] <- Idents(object = seurat_object) + if (is.null(x = legend_title)) { + legend_title <- "Identity" + } + } + # Check group by is valid group_by <- Meta_Present(object = seurat_object, meta_col_names = group_by, print_msg = FALSE)[[1]] From 9c0c27cd59cecb74fe6d006f414a7ccb1c738ab6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:27:34 -0400 Subject: [PATCH 161/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 8527a52fc0..55ea0f07b5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,7 +16,8 @@ - **BREAKING CHANGES** `Add_Top_Gene_Pct_Seurat` is now S3 generic that works with both Seurat and liger objects and has been renamed `Add_Top_Gene_Pct`. - Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. - Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). -- Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. +- Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. +- Updated `Plot_Median_Genes`, `Plot_Median_UMIs`, `Plot_Median_Mito`, `Plot_Median_Other`, `Plot_Cells_per_Sample` to understand "ident" as grouping variable. ## Fixes From c66774f31b3829347a5bee1219ed9e7febed66fe Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 10:27:47 -0400 Subject: [PATCH 162/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3903692d8d..f91f726810 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9025 +Version: 2.1.2.9026 Date: 2024-03-22 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")), From 781bbf7181b199153bb08b58bad1038b2234150f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 13:47:16 -0400 Subject: [PATCH 163/503] remove seurat 5 needed --- R/Object_Utilities.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 5a1e2ce22b..6ff163840f 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1560,10 +1560,6 @@ Add_Alt_Feature_ID <- function( data_name = "feature_id_mapping_table", overwrite = FALSE ) { - if (packageVersion(pkg = 'Seurat') < "5") { - cli_abort(message = "Seurat version must be v5.0.0 or greater to add alternative features.") - } - # check file if (is.null(x = features_tsv_file) && is.null(x = hdf5_file)) { cli_abort(message = "Either {.code features_tsv_file} or {.code hdf5_file} must be provided.") From a6febac7dd143c3a41c33f2a988c43429ee664ff Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:13:37 -0400 Subject: [PATCH 164/503] fix due to new S3 top pct --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 6ff163840f..07dbf1cd5e 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -228,7 +228,7 @@ Add_Cell_QC_Metrics <- function( # Add top gene expression percent if (isTRUE(x = add_top_pct)) { cli_inform(message = c("*" = "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) + seurat_object <- Add_Top_Gene_Pct(object = seurat_object, num_top_genes = num_top_genes, meta_col_name = top_pct_name, assay = assay, overwrite = overwrite) } # Add MSigDB From 84af5097f3aef16ea772c4b912050501b6629b68 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:41:58 -0400 Subject: [PATCH 165/503] Add cell QC now S3 generic and works with Seurat and liger --- R/Generics.R | 20 +++- R/LIGER_Internal_Utilities.R | 80 ++++++++++++++++ R/LIGER_Utilities.R | 174 ++++++++++++++++++++++++++++++++++- R/Object_Utilities.R | 54 +++++------ 4 files changed, 299 insertions(+), 29 deletions(-) diff --git a/R/Generics.R b/R/Generics.R index 01e65b65f6..dd11395907 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -98,7 +98,8 @@ Add_Cell_Complexity <- function(object, ...) { #' #' Add the percentage of counts occupied by the top XX most highly expressed genes in each cell. #' -#' @param object Seurat or liger object name. +#' @param object Seurat or LIGER object. +#' @param ... Arguments passed to other methods #' #' @rdname Add_Top_Gene_Pct #' @export Add_Top_Gene_Pct @@ -109,6 +110,23 @@ Add_Top_Gene_Pct <- function(object, ...) { } +#' Add Multiple Cell Quality Control Values with Single Function +#' +#' Add Mito/Ribo %, Cell Complexity (log10GenesPerUMI), Top Gene Percent with single +#' function call to Seurat or liger objects. +#' +#' @param object Seurat or LIGER object +#' @param ... Arguments passed to other methods +#' +#' @rdname Add_Cell_QC_Metrics +#' @export Add_Cell_QC_Metrics +#' + +Add_Cell_QC_Metrics <- function(object, ...) { + UseMethod(generic = 'Add_Cell_QC_Metrics', object = object) +} + + #' Get meta data from object #' #' Quick function to properly pull meta.data from objects. diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 0e45fc41ab..2ea62ffa6d 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -1343,3 +1343,83 @@ Add_MSigDB_LIGER <- function( # return final object return(liger_object) } + + +#' Add IEG Gene List Percentages +#' +#' Adds percentage of counts from IEG genes from mouse and human. +#' +#' @param liger_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 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 liger object +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Add_IEG_LIGER <- function( + liger_object, + species, + ieg_name = "percent_ieg", + 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_LIGER(liger_object = liger_object) + + # Overwrite check + meta_names <- colnames(x = Fetch_Meta(object = liger_object)) + + if (ieg_name %in% meta_names) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("Column with {.val {ieg_name}} already present in meta data.", + "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.", + "i" = "Overwriting those column as {.code overwrite = TRUE.}") + ) + } + + # Retrieve gene lists + ieg_gene_list <- Retrieve_IEG_Lists(species = species) + + all_features <- LIGER_Features(liger_object = liger_object, by_dataset = FALSE) + + ieg_found <- intersect(x = ieg_gene_list[["ieg"]], y = all_features) + + # Add ieg column + if (length(x = ieg_found) > 0) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object <- rliger::runGeneralQC(object = object, mito = FALSE, ribo = FALSE, hemo = FALSE, features = list(ieg_name = ieg_found), verbose = FALSE) + } else { + percent_ieg <- unlist(lapply(object@raw.data, function(x) { + (Matrix::colSums(x[ieg_found, ])/Matrix::colSums(x))*100})) + object@cell.data[ , ieg_name] <- percent_ieg + } + } + + # return final object + return(liger_object) +} diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index c91561d242..13c77187e2 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -244,6 +244,177 @@ Find_Factor_Cor <- function( #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#' @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 patterns and features. +#' @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_hemo logical, whether to add percentage of counts belonging to homoglobin genes to object (Default is TRUE). +#' @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`. +#' Default is "log10GenesPerUMI". +#' @param top_pct_name name to use for new meta data column for `Add_Top_Gene_Pct`. +#' 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 hemo_name name to use for the new meta.data column containing percent hemoglobin counts. +#' Default is "percent_mito". +#' @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 in default list). +#' @param hemo_pattern A regex pattern to match features against for hemoglobin genes +#' (will set automatically if species is in default list). +#' @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 hemo_features A list of hemoglobin 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 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 +#' +#' @return A liger Object +#' +#' @method Add_Cell_QC_Metrics liger +#' +#' @export +#' @rdname Add_Cell_QC_Metrics +#' +#' +#' @concept qc_util +#' +#' @examples +#' \dontrun{ +#' obj <- Add_Cell_QC_Metrics(object = obj, species = "Human") +#'} +#' + +Add_Cell_QC_Metrics.liger <- function( + object, + add_mito_ribo = TRUE, + add_complexity = TRUE, + add_top_pct = TRUE, + add_MSigDB = TRUE, + add_IEG = TRUE, + add_hemo = 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", + hemo_name = "percent_hemo", + mito_pattern = NULL, + ribo_pattern = NULL, + hemo_pattern = NULL, + mito_features = NULL, + ribo_features = NULL, + hemo_features = NULL, + ensembl_ids = FALSE, + num_top_genes = 50, + assay = NULL, + overwrite = FALSE +) { + # 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 = c("*" = "Adding {.field Mito/Ribo Percentages} to meta.data.")) + liger_object <- Add_Mito_Ribo(object = liger_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, overwrite = overwrite) + } + + # Add complexity + if (isTRUE(x = add_complexity)) { + cli_inform(message = c("*" = "Adding {.field Cell Complexity #1 (log10GenesPerUMI)} to meta.data.")) + liger_object <- Add_Cell_Complexity(object = liger_object, meta_col_name = complexity_name, overwrite = overwrite) + } + + # Add top gene expression percent + if (isTRUE(x = add_top_pct)) { + cli_inform(message = c("*" = "Adding {.field Cell Complexity #2 (Top {num_top_genes} Percentages)} to meta.data.")) + liger_object <- Add_Top_Gene_Pct(object = liger_object, num_top_genes = num_top_genes, meta_col_name = top_pct_name, 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 = c("*" = "Adding {.field MSigDB Oxidative Phosphorylation, Apoptosis, and DNA Repair Percentages} to meta.data.")) + liger_object <- Add_MSigDB_LIGER(liger_object = liger_object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, 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 = c("*" = "Adding {.field IEG Percentages} to meta.data.")) + liger_object <- Add_IEG_LIGER(liger_object = liger_object, species = species, ieg_name = ieg_name, overwrite = overwrite) + } + } + + # Add hemo + if (isTRUE(x = add_hemo)) { + cli_inform(message = c("*" = "Adding {.field Hemoglobin Percentages} to meta.data.")) + liger_object <- Add_Hemo(object = liger_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, overwrite = overwrite) + } + + # return object + return(liger_object) +} + + + #' Add Mito and Ribo percentages #' #' @param species Species of origin for given Object. If mouse, human, marmoset, zebrafish, rat, @@ -755,7 +926,8 @@ Add_Top_Gene_Pct.liger <- function( num_top_genes = 50, meta_col_name = NULL, overwrite = FALSE, - verbose = TRUE + verbose = TRUE, + ... ){ # Check for scuttle first scuttle_check <- is_installed(pkg = "scuttle") diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 07dbf1cd5e..35e36e2459 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -85,11 +85,9 @@ Merge_Seurat_List <- function( #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#' 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 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 patterns and features. #' @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). @@ -101,18 +99,15 @@ Merge_Seurat_List <- function( #' @param add_hemo logical, whether to add percentage of counts belonging to homoglobin 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`. +#' @param complexity_name name to use for new meta data column for `Add_Cell_Complexity`. #' Default is "log10GenesPerUMI". -#' @param top_pct_name name to use for new meta data column for `Add_Top_Gene_Pct_Seurat`. +#' @param top_pct_name name to use for new meta data column for `Add_Top_Gene_Pct`. #' 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". @@ -149,7 +144,10 @@ Merge_Seurat_List <- function( #' #' @return A Seurat Object #' +#' @method Add_Cell_QC_Metrics Seurat +#' #' @export +#' @rdname Add_Cell_QC_Metrics #' #' @concept qc_util #' @@ -159,8 +157,9 @@ Merge_Seurat_List <- function( #'} #' -Add_Cell_QC_Metrics <- function( - seurat_object, +Add_Cell_QC_Metrics.Seurat <- function( + object, + species, add_mito_ribo = TRUE, add_complexity = TRUE, add_top_pct = TRUE, @@ -168,7 +167,6 @@ Add_Cell_QC_Metrics <- function( add_IEG = TRUE, add_hemo = TRUE, add_cell_cycle = TRUE, - species, mito_name = "percent_mito", ribo_name = "percent_ribo", mito_ribo_name = "percent_mito_ribo", @@ -188,7 +186,8 @@ Add_Cell_QC_Metrics <- function( ensembl_ids = FALSE, num_top_genes = 50, assay = NULL, - overwrite = FALSE + overwrite = FALSE, + ... ) { # Set assay assay <- assay %||% DefaultAssay(object = seurat_object) @@ -216,19 +215,19 @@ Add_Cell_QC_Metrics <- function( # Add mito/ribo if (isTRUE(x = add_mito_ribo)) { cli_inform(message = c("*" = "Adding {.field Mito/Ribo Percentages} to meta.data.")) - seurat_object <- Add_Mito_Ribo(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) + object <- Add_Mito_Ribo(object = 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 = c("*" = "Adding {.field Cell Complexity #1 (log10GenesPerUMI)} to meta.data.")) - seurat_object <- Add_Cell_Complexity(object = seurat_object, meta_col_name = complexity_name, assay = assay, overwrite = overwrite) + object <- Add_Cell_Complexity(object = object, meta_col_name = complexity_name, assay = assay, overwrite = overwrite) } # Add top gene expression percent if (isTRUE(x = add_top_pct)) { cli_inform(message = c("*" = "Adding {.field Cell Complexity #2 (Top {num_top_genes} Percentages)} to meta.data.")) - seurat_object <- Add_Top_Gene_Pct(object = seurat_object, num_top_genes = num_top_genes, meta_col_name = top_pct_name, assay = assay, overwrite = overwrite) + object <- Add_Top_Gene_Pct(object = object, num_top_genes = num_top_genes, meta_col_name = top_pct_name, assay = assay, overwrite = overwrite) } # Add MSigDB @@ -238,7 +237,7 @@ Add_Cell_QC_Metrics <- function( "i" = "No columns will be added to object meta.data")) } else { cli_inform(message = c("*" = "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) + object <- Add_MSigDB_Seurat(seurat_object = object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, assay = assay, overwrite = overwrite) } } @@ -249,14 +248,14 @@ Add_Cell_QC_Metrics <- function( "i" = "No column will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field IEG Percentages} to meta.data.")) - seurat_object <- Add_IEG_Seurat(seurat_object = seurat_object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite) + object <- Add_IEG_Seurat(seurat_object = object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite) } } # Add hemo if (isTRUE(x = add_hemo)) { cli_inform(message = c("*" = "Adding {.field Hemoglobin Percentages} to meta.data.")) - seurat_object <- Add_Hemo(object = seurat_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, assay = assay, overwrite = overwrite) + object <- Add_Hemo(object = object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, assay = assay, overwrite = overwrite) } # Add cell cycle @@ -267,14 +266,14 @@ Add_Cell_QC_Metrics <- function( )) } else { cli_inform(message = c("*" = "Adding {.field Cell Cycle Scoring} to meta.data.")) - if (length(grep(x = Layers(object = seurat_object), pattern = "data", value = T)) == 0) { + if (length(grep(x = Layers(object = 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) + object <- NormalizeData(object = 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 ("S.Score" %in% colnames(x = object@meta.data) || "G2M.Score" %in% colnames(x = object@meta.data) || "Phase" %in% colnames(x = object@meta.data)) { if (isFALSE(x = 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}*") @@ -287,15 +286,15 @@ Add_Cell_QC_Metrics <- function( # Add Cell Cycle Scoring cli_inform(message = "Calculating {.field Cell Cycle Scores}.") - seurat_object <- CellCycleScoring(object = seurat_object, s.features = Seurat::cc.genes.updated.2019$s.genes, g2m.features = Seurat::cc.genes.updated.2019$g2m.genes) + object <- CellCycleScoring(object = object, s.features = Seurat::cc.genes.updated.2019$s.genes, g2m.features = Seurat::cc.genes.updated.2019$g2m.genes) } } # Log Command - seurat_object <- LogSeuratCommand(object = seurat_object) + object <- LogSeuratCommand(object = object) # return object - return(seurat_object) + return(object) } @@ -810,7 +809,8 @@ Add_Top_Gene_Pct.Seurat <- function( meta_col_name = NULL, assay = "RNA", overwrite = FALSE, - verbose = TRUE + verbose = TRUE, + ... ){ # Check for scuttle first scuttle_check <- is_installed(pkg = "scuttle") From c6c7483a9473ae021ac7d19e5c13c5c8085d5ee7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:42:09 -0400 Subject: [PATCH 166/503] update docs --- man/Add_Cell_QC_Metrics.Rd | 63 +++++++++++++++++++++++++++++++++----- man/Add_Top_Gene_Pct.Rd | 10 ++++-- 2 files changed, 62 insertions(+), 11 deletions(-) diff --git a/man/Add_Cell_QC_Metrics.Rd b/man/Add_Cell_QC_Metrics.Rd index 2201657e27..e8de22ff7f 100644 --- a/man/Add_Cell_QC_Metrics.Rd +++ b/man/Add_Cell_QC_Metrics.Rd @@ -1,11 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Object_Utilities.R +% Please edit documentation in R/Generics.R, R/LIGER_Utilities.R, +% R/Object_Utilities.R \name{Add_Cell_QC_Metrics} \alias{Add_Cell_QC_Metrics} +\alias{Add_Cell_QC_Metrics.liger} +\alias{Add_Cell_QC_Metrics.Seurat} \title{Add Multiple Cell Quality Control Values with Single Function} \usage{ -Add_Cell_QC_Metrics( - seurat_object, +Add_Cell_QC_Metrics(object, ...) + +\method{Add_Cell_QC_Metrics}{liger}( + object, add_mito_ribo = TRUE, add_complexity = TRUE, add_top_pct = TRUE, @@ -35,9 +40,44 @@ Add_Cell_QC_Metrics( assay = NULL, overwrite = FALSE ) + +\method{Add_Cell_QC_Metrics}{Seurat}( + object, + species, + add_mito_ribo = TRUE, + add_complexity = TRUE, + add_top_pct = TRUE, + add_MSigDB = TRUE, + add_IEG = TRUE, + add_hemo = TRUE, + add_cell_cycle = TRUE, + 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", + hemo_name = "percent_hemo", + mito_pattern = NULL, + ribo_pattern = NULL, + hemo_pattern = NULL, + mito_features = NULL, + ribo_features = NULL, + hemo_features = NULL, + ensembl_ids = FALSE, + num_top_genes = 50, + assay = NULL, + overwrite = FALSE, + ... +) } \arguments{ -\item{seurat_object}{object name.} +\item{object}{Seurat or LIGER object} + +\item{...}{Arguments passed to other methods} \item{add_mito_ribo}{logical, whether to add percentage of counts belonging to mitochondrial/ribosomal genes to object (Default is TRUE).} @@ -59,7 +99,7 @@ object (Default is TRUE).} \item{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.} +generate patterns and features.} \item{mito_name}{name to use for the new meta.data column containing percent mitochondrial counts. Default is "percent_mito".} @@ -70,10 +110,10 @@ Default is "percent_ribo".} \item{mito_ribo_name}{name to use for the new meta.data column containing percent mitochondrial+ribosomal counts. Default is "percent_mito_ribo".} -\item{complexity_name}{name to use for new meta data column for \code{Add_Cell_Complexity_Seurat}. +\item{complexity_name}{name to use for new meta data column for \code{Add_Cell_Complexity}. Default is "log10GenesPerUMI".} -\item{top_pct_name}{name to use for new meta data column for \code{Add_Top_Gene_Pct_Seurat}. +\item{top_pct_name}{name to use for new meta data column for \code{Add_Top_Gene_Pct}. Default is "percent_topXX", where XX is equal to the value provided to \code{num_top_genes}.} \item{oxphos_name}{name to use for new meta data column for percentage of MSigDB oxidative phosphorylation @@ -121,12 +161,19 @@ storing corrected and uncorrected assays in same object (e.g. outputs of both Ce function will abort if column with name provided to \code{meta_col_name} is present in meta.data slot.} } \value{ +A liger Object + A Seurat Object } \description{ -Add Mito/Ribo \%, Cell Complexity (log10GenesPerUMI), Top Gene Percent with single function call +Add Mito/Ribo \%, Cell Complexity (log10GenesPerUMI), Top Gene Percent with single +function call to Seurat or liger objects. } \examples{ +\dontrun{ +obj <- Add_Cell_QC_Metrics(object = obj, species = "Human") +} + \dontrun{ obj <- Add_Cell_QC_Metrics(seurat_object = obj, species = "Human") } diff --git a/man/Add_Top_Gene_Pct.Rd b/man/Add_Top_Gene_Pct.Rd index 6394b15aa6..b656f5d008 100644 --- a/man/Add_Top_Gene_Pct.Rd +++ b/man/Add_Top_Gene_Pct.Rd @@ -14,7 +14,8 @@ Add_Top_Gene_Pct(object, ...) num_top_genes = 50, meta_col_name = NULL, overwrite = FALSE, - verbose = TRUE + verbose = TRUE, + ... ) \method{Add_Top_Gene_Pct}{Seurat}( @@ -23,11 +24,14 @@ Add_Top_Gene_Pct(object, ...) meta_col_name = NULL, assay = "RNA", overwrite = FALSE, - verbose = TRUE + verbose = TRUE, + ... ) } \arguments{ -\item{object}{Seurat or liger object name.} +\item{object}{Seurat or LIGER object.} + +\item{...}{Arguments passed to other methods} \item{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.} From 4364955721b60b8eae157cf39909bd7db3699771 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:42:18 -0400 Subject: [PATCH 167/503] Update NAMESPACE --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 2dbb0d5cca..40b67de34f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,8 @@ S3method(Add_Cell_Complexity,Seurat) S3method(Add_Cell_Complexity,liger) +S3method(Add_Cell_QC_Metrics,Seurat) +S3method(Add_Cell_QC_Metrics,liger) S3method(Add_Hemo,Seurat) S3method(Add_Hemo,liger) S3method(Add_Mito_Ribo,Seurat) From b8a56d12d247eff736744dc21be8b440ab7fa1bd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:43:12 -0400 Subject: [PATCH 168/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 55ea0f07b5..b8c4cf1a3a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,7 @@ ## Changed - **BREAKING CHANGES** `Add_Top_Gene_Pct_Seurat` is now S3 generic that works with both Seurat and liger objects and has been renamed `Add_Top_Gene_Pct`. +- `Add_Cell_QC_Metrics` is now S3 generic and works with both Seurat and liger objects. - Changed storage location for `Add_Alt_Feature_ID` to `@misc` slot of object for safer storage across object filtering. - Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). - Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. From 787d2f0bc888a5e70e501648b7fa1c32e86d2b40 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:43:25 -0400 Subject: [PATCH 169/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f91f726810..c2eb6bd6ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9026 +Version: 2.1.2.9027 Date: 2024-03-22 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")), From 207aeef1e914e83881bbbe21643508810c08cd6b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 14:48:56 -0400 Subject: [PATCH 170/503] replace old code --- R/Object_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 35e36e2459..6d80f19822 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -153,7 +153,7 @@ Merge_Seurat_List <- function( #' #' @examples #' \dontrun{ -#' obj <- Add_Cell_QC_Metrics(seurat_object = obj, species = "Human") +#' obj <- Add_Cell_QC_Metrics(object = obj, species = "Human") #'} #' @@ -190,7 +190,7 @@ Add_Cell_QC_Metrics.Seurat <- function( ... ) { # Set assay - assay <- assay %||% DefaultAssay(object = seurat_object) + assay <- assay %||% DefaultAssay(object = object) # Accepted species names accepted_names <- data.frame( From 4c4835e7410a0c16fea60dfa6af251b4d51dc131 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 15:05:08 -0400 Subject: [PATCH 171/503] updating liger functions --- R/LIGER_Internal_Utilities.R | 31 +++++++++++++++++++------------ R/Object_Conversion.R | 18 +++++++++--------- 2 files changed, 28 insertions(+), 21 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 2ea62ffa6d..70370d8fc1 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -72,6 +72,7 @@ Default_DimReduc_LIGER <- function( #' Generate_Plotting_df_LIGER <- function(object, + reduction = NULL, clusters = NULL, shuffle = TRUE, shuffle_seed = 1, @@ -82,21 +83,27 @@ Generate_Plotting_df_LIGER <- function(object, ) { # temp liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) + + reduc_df <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction) + + c_names <- Fetch_Meta(object = liger_object)[["leiden_cluster"]] + } else { + reduc_df <- data.frame(object@tsne.coords) + colnames(x = reduc_df) <- c("tsne1", "tsne2") + c_names <- names(x = object@clusters) } - tsne_df <- data.frame(object@tsne.coords) - colnames(x = tsne_df) <- c("tsne1", "tsne2") - tsne_df[[group_by]] <- object@cell.data[[group_by]] + reduc_df[[group_by]] <- Fetch_Meta(object = liger_object)[[group_by]] + if (!is.null(x = split_by)) { - tsne_df[[split_by]] <- object@cell.data[[split_by]] + reduc_df[[split_by]] <- Fetch_Meta(object = liger_object)[[split_by]] } if (isTRUE(x = reorder.idents)) { - tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) + reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) } - c_names <- names(x = object@clusters) + if (is.null(x = clusters)) { # if clusters have not been set yet if (length(x = object@clusters) == 0) { @@ -107,14 +114,14 @@ Generate_Plotting_df_LIGER <- function(object, c_names <- names(x = object@clusters) } } - tsne_df[['Cluster']] <- clusters[c_names] + reduc_df[['Cluster']] <- clusters[c_names] if (isTRUE(x = shuffle)) { set.seed(shuffle_seed) - idx <- sample(x = 1:nrow(tsne_df)) - tsne_df <- tsne_df[idx, ] + idx <- sample(x = 1:nrow(x = reduc_df)) + reduc_df <- reduc_df[idx, ] } - return(tsne_df) + return(reduc_df) } diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index 96f798377b..cb4105ffee 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -58,10 +58,10 @@ as.LIGER.Seurat <- function( verbose = TRUE, ... ) { - # temp liger version check + # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + cli_abort(message = c("{.code scCustomize::as.Liger} is for rliger < v2.0.0.", + "i" = "For optimal functionality with rliger v2.0.0+ please use {.code rliger::as.liger}.")) } # Check Seurat @@ -278,10 +278,10 @@ as.LIGER.list <- function( verbose = TRUE, ... ) { - # temp liger version check + # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + cli_abort(message = c("{.code scCustomize::as.Liger} is for rliger < v2.0.0.", + "i" = "For optimal functionality with rliger v2.0.0+ please use {.code rliger::as.liger}.")) } # Check Seurat @@ -527,10 +527,10 @@ as.Seurat.liger <- function( barcode_cell_id_delimiter = "_", ... ) { - # temp liger version check + # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + cli_abort(message = c("{.code scCustomize::as.Seurat} is for rliger < v2.0.0.", + "i" = "For optimal functionality with rliger v2.0.0+ please use {.code rliger::ligerToSeurat}.")) } if (is.null(x = reduction_label)) { From 7a6375eefe0dc6501a95b73d9b65d97be5dc2c03 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 15:05:15 -0400 Subject: [PATCH 172/503] update docs --- man/Add_Cell_QC_Metrics.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/Add_Cell_QC_Metrics.Rd b/man/Add_Cell_QC_Metrics.Rd index e8de22ff7f..992ba36c51 100644 --- a/man/Add_Cell_QC_Metrics.Rd +++ b/man/Add_Cell_QC_Metrics.Rd @@ -175,7 +175,7 @@ obj <- Add_Cell_QC_Metrics(object = obj, species = "Human") } \dontrun{ -obj <- Add_Cell_QC_Metrics(seurat_object = obj, species = "Human") +obj <- Add_Cell_QC_Metrics(object = obj, species = "Human") } } From fc2992b52b937f92fa103f96c5878820be598f83 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 15:06:06 -0400 Subject: [PATCH 173/503] revert until more time to work --- R/LIGER_Internal_Utilities.R | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 70370d8fc1..2ea62ffa6d 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -72,7 +72,6 @@ Default_DimReduc_LIGER <- function( #' Generate_Plotting_df_LIGER <- function(object, - reduction = NULL, clusters = NULL, shuffle = TRUE, shuffle_seed = 1, @@ -83,27 +82,21 @@ Generate_Plotting_df_LIGER <- function(object, ) { # temp liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) - - reduc_df <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction) - - c_names <- Fetch_Meta(object = liger_object)[["leiden_cluster"]] - } else { - reduc_df <- data.frame(object@tsne.coords) - colnames(x = reduc_df) <- c("tsne1", "tsne2") - c_names <- names(x = object@clusters) + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) } - reduc_df[[group_by]] <- Fetch_Meta(object = liger_object)[[group_by]] - + tsne_df <- data.frame(object@tsne.coords) + colnames(x = tsne_df) <- c("tsne1", "tsne2") + tsne_df[[group_by]] <- object@cell.data[[group_by]] if (!is.null(x = split_by)) { - reduc_df[[split_by]] <- Fetch_Meta(object = liger_object)[[split_by]] + tsne_df[[split_by]] <- object@cell.data[[split_by]] } if (isTRUE(x = reorder.idents)) { - reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) + tsne_df[[group_by]] <- factor(x = tsne_df[[group_by]], levels = new.order) } - + c_names <- names(x = object@clusters) if (is.null(x = clusters)) { # if clusters have not been set yet if (length(x = object@clusters) == 0) { @@ -114,14 +107,14 @@ Generate_Plotting_df_LIGER <- function(object, c_names <- names(x = object@clusters) } } - reduc_df[['Cluster']] <- clusters[c_names] + tsne_df[['Cluster']] <- clusters[c_names] if (isTRUE(x = shuffle)) { set.seed(shuffle_seed) - idx <- sample(x = 1:nrow(x = reduc_df)) - reduc_df <- reduc_df[idx, ] + idx <- sample(x = 1:nrow(tsne_df)) + tsne_df <- tsne_df[idx, ] } - return(reduc_df) + return(tsne_df) } From a0973ffcea7ee00c2bd5de70ea1ee44ba860f884 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 15:09:01 -0400 Subject: [PATCH 174/503] update docs --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index b8c4cf1a3a..b47db0e37a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`. +- Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: + - `as.LIGER`, `as.Seurat`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. From bed01c7d22a59f1f40a8af053f3271a3fd88da2a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 22 Mar 2024 15:09:14 -0400 Subject: [PATCH 175/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2eb6bd6ae..6e74937008 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9027 +Version: 2.1.2.9028 Date: 2024-03-22 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")), From 5b0207c65414a6210fd513ce30fe65ec12e3a020 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 28 Mar 2024 09:29:20 -0400 Subject: [PATCH 176/503] dimplot legend fix. guide behavior in ggplot2 3.5.0 --- R/Seurat_Plotting.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index b53b7c29bd..bdea9aa730 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1920,6 +1920,11 @@ DimPlot_scCustom <- function( xlim(x_axis) + ylim(y_axis) + # temp? fix for ggplot2 3.5.0 while evaluating other changes + if (packageVersion(pkg = 'ggplot2') >= "3.5.0") { + plot$layers[[1]]$show.legend <- TRUE + } + # Normalize the colors across all plots plot <- suppressMessages(plot + scale_color_manual(values = colors_overall, drop = FALSE)) From f74eb9dc4ab268efd3ee868d54faf9cf5690538c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 28 Mar 2024 09:29:28 -0400 Subject: [PATCH 177/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index b47db0e37a..f23cff5bc8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,6 +30,7 @@ - Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). - Fixed errors in `Create_Cluster_Annotation_File` if for file path and csv name errors. - Fixed error when using `plot_median` and more than one feature in `VlnPlot_scCustom` ([#169](https://github.com/samuel-marsh/scCustomize/issues/169)). +- Fixed bug while collecting legends for `DimPlot_scCustom` due to changes in guides updated with ggplot2 v3.5.0 ([#171](https://github.com/samuel-marsh/scCustomize/issues/171)) - Spelling and style fixes. Thanks @kew24. From 36d479b850989e45c4a6ff4423d4ade6612c2150 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 28 Mar 2024 09:29:45 -0400 Subject: [PATCH 178/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6e74937008..e1c5aa06e7 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" RRID:SCR_024675. -Version: 2.1.2.9028 -Date: 2024-03-22 +Version: 2.1.2.9029 +Date: 2024-03-28 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"), From 6700a34405975ef73621d8fcfe899d01b5a5d5e4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 5 Apr 2024 09:02:31 -0400 Subject: [PATCH 179/503] update error message for new slot --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 13c77187e2..c48f056585 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -188,7 +188,7 @@ LIGER_DimReduc <- function( # get coords reduc_coords <- dimReds(x = liger_object)[[reduction_use]] } else { - cli_abort("The reduction {.field {reduction_use}} is not present in cellMeta slot.") + cli_abort("The reduction {.field {reduction_use}} is not present in dimReds slot.") } # return coords From 592e7df737168c8d56506cae858b1afd6ff6a156 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:46:52 -0400 Subject: [PATCH 180/503] move dim reduc check internal to 1.0.1 functions --- R/LIGER_Internal_Utilities.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 2ea62ffa6d..f2b5825d40 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -200,10 +200,9 @@ Plot_By_Cluster_LIGER <- function( ggplot_default_colors = FALSE, color_seed = 123 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + # Check dimreduc present + if (length(x = liger_object@tsne.coords) == 0) { + cli_abort(message = "No dimensionality reduction coordinates found.") } # Create plotting data.frame @@ -460,10 +459,9 @@ Plot_By_Meta_LIGER <- function( ggplot_default_colors = FALSE, color_seed = 123 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + # Check dimreduc present + if (length(x = liger_object@tsne.coords) == 0) { + cli_abort(message = "No dimensionality reduction coordinates found.") } tsne_df <- Generate_Plotting_df_LIGER(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed) From c77582b344bc57b4cc2e8036cac28c8198924d70 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:47:10 -0400 Subject: [PATCH 181/503] see previous commit message --- R/LIGER_Plotting.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 0700373e88..936e86ddee 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -86,11 +86,6 @@ DimPlot_LIGER <- function( # Check LIGER Is_LIGER(liger_object = liger_object) - # Check dimreduc present - if (length(x = liger_object@tsne.coords) == 0) { - cli_abort(message = "No dimensionality reduction coordinates found.") - } - # Set group_by defaults if (isFALSE(x = combination) && is.null(x = group_by)) { group_by <- "cluster" From aeeee9c5211849a5b6706cbb5d552daa52b93d7e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:55:47 -0400 Subject: [PATCH 182/503] add LIGER_Cells function --- R/LIGER_Utilities.R | 58 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index c48f056585..c23475dbad 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -80,6 +80,64 @@ LIGER_Features <- function( } +#' Extract Cells from LIGER Object +#' +#' Extract all cell barcodes from LIGER object +#' +#' @param liger_object LIGER object name. +#' @param by_dataset logical, whether to return list with vector of cell barcodes for each +#' dataset in LIGER object or to return single vector of cell barcodes across all +#' datasets in object (default is FALSE; return vector of cells) +#' +#' @return vector or list depending on `by_dataset` parameter +#' +#' @importFrom utils packageVersion +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return single vector of all cells +#' all_features <- LIGER_Cells(liger_object = object, by_dataset = FALSE) +#' +#' # return list of vectors containing cells from each individual dataset in object +#' dataset_features <- LIGER_Cells(liger_object = object, by_dataset = TRUE) +#' } +#' + +LIGER_Cells <- function( + liger_object, + by_dataset = FALSE +) { + # check liger + Is_LIGER(liger_object = liger_object) + + # liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + # Extract features + cells_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { + colnames(x = liger_object@datasets[[x]]) + }) + names(cells_by_dataset) <- names(liger_object@datasets) + } else { + # Extract features + cells_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { + colnames(x = liger_object@raw.data[[x]]) + }) + } + + # Return features + if (isFALSE(x = by_dataset)) { + cells <- x = unlist(x = cells_by_dataset) + return(cells) + } else { + return(cells_by_dataset) + } +} + + #' Extract top loading genes for LIGER factor #' #' Extract vector to the top loading genes for specified LIGER iNMF factor From a2c4c5c5fdbc1710777d4e900a456f9f78ce9d3f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:57:06 -0400 Subject: [PATCH 183/503] Update docs --- NAMESPACE | 1 + man/LIGER_Cells.Rd | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+) create mode 100644 man/LIGER_Cells.Rd diff --git a/NAMESPACE b/NAMESPACE index 40b67de34f..f432e3d5e7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -79,6 +79,7 @@ export(Iterate_Plot_Density_Custom) export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) +export(LIGER_Cells) export(LIGER_DimReduc) export(LIGER_Features) export(Liger_to_Seurat) diff --git a/man/LIGER_Cells.Rd b/man/LIGER_Cells.Rd new file mode 100644 index 0000000000..594cb71b24 --- /dev/null +++ b/man/LIGER_Cells.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{LIGER_Cells} +\alias{LIGER_Cells} +\title{Extract Cells from LIGER Object} +\usage{ +LIGER_Cells(liger_object, by_dataset = FALSE) +} +\arguments{ +\item{liger_object}{LIGER object name.} + +\item{by_dataset}{logical, whether to return list with vector of cell barcodes for each +dataset in LIGER object or to return single vector of cell barcodes across all +datasets in object (default is FALSE; return vector of cells)} +} +\value{ +vector or list depending on \code{by_dataset} parameter +} +\description{ +Extract all cell barcodes from LIGER object +} +\examples{ +\dontrun{ +# return single vector of all cells +all_features <- LIGER_Cells(liger_object = object, by_dataset = FALSE) + +# return list of vectors containing cells from each individual dataset in object +dataset_features <- LIGER_Cells(liger_object = object, by_dataset = TRUE) +} + +} +\concept{liger_object_util} From ba4b38c22e61014ae3e226f3bad47d7067cab97c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:58:05 -0400 Subject: [PATCH 184/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index f23cff5bc8..9dbbff8a52 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ - Added new function `seq_zeros()` to create sequences with preceding zeros. - Added new functions to interact with upcoming liger object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. + - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`. - Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: From d5b4fea1a04804ef1922b49414fe9f00f23cfaaa Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 09:58:30 -0400 Subject: [PATCH 185/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e1c5aa06e7..9d2555c146 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" RRID:SCR_024675. -Version: 2.1.2.9029 -Date: 2024-03-28 +Version: 2.1.2.9030 +Date: 2024-04-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"), From 9ef1088b481f3be5b0660cd2aa2bbe4326948cb6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:29:23 -0400 Subject: [PATCH 186/503] fix code error --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index c23475dbad..df9899c86c 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -130,7 +130,7 @@ LIGER_Cells <- function( # Return features if (isFALSE(x = by_dataset)) { - cells <- x = unlist(x = cells_by_dataset) + cells <- unlist(x = cells_by_dataset) return(cells) } else { return(cells_by_dataset) From 5f7c61928f71fc3568edc6d07f98301025a85dd9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:36:15 -0400 Subject: [PATCH 187/503] liger 2 version of generate plot df --- R/LIGER_Internal_Utilities.R | 49 ++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index f2b5825d40..0a11d3f250 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -118,6 +118,55 @@ Generate_Plotting_df_LIGER <- function(object, } +Generate_Plotting_df_LIGER2 <- function(object, + reduction = NULL, + clusters = NULL, + shuffle = TRUE, + shuffle_seed = 1, + reorder.idents = FALSE, + new.order = NULL, + group_by = "dataset", + split_by = NULL +) { + # Set reduction if null + if (!is.null(x = reduction)) { + LIGER_DimReduc(liger_object = object, reduction = reduction, check_only = TRUE) + } else { + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) + } + + reduc_df <- data.frame(LIGER_DimReduc(liger_object = object, reduction = reduction)) + reduc_df[[group_by]] <- object@cellMeta[[group_by]] + if (!is.null(x = split_by)) { + reduc_df[[split_by]] <- object@cellMeta[[split_by]] + } + + if (isTRUE(x = reorder.idents)) { + reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) + } + c_names <- names(x = object@cellMeta$leiden_cluster) + if (is.null(x = clusters)) { + # if clusters have not been set yet + if (length(x = object@cellMeta$leiden_cluster) == 0) { + clusters <- rep(1, nrow(x = reduc_df)) + names(x = clusters) <- c_names <- rownames(x = reduc_df) + } else { + clusters <- object@cellMeta$leiden_cluster + c_names <- names(x = object@cellMeta$leiden_cluster) + } + } + reduc_df[['Cluster']] <- clusters[c_names] + + if (isTRUE(x = shuffle)) { + set.seed(shuffle_seed) + idx <- sample(x = 1:nrow(reduc_df)) + reduc_df <- reduc_df[idx, ] + } + return(reduc_df) +} + + + #' LIGER plot by cluster. #' #' Modified version of LIGER's plotByDatasetAndCluster just for plotting clusters. From ce8f0e3a43160ed7b7c370f783857adcb4c459f3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:40:01 -0400 Subject: [PATCH 188/503] liger2 versions of plotting utils --- R/LIGER_Internal_Utilities.R | 336 +++++++++++++++++++++++++++++++++++ 1 file changed, 336 insertions(+) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 0a11d3f250..1725ad4725 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -440,6 +440,218 @@ Plot_By_Cluster_LIGER <- function( } } + +Plot_By_Cluster_LIGER2 <- function( + liger_object, + colors_use = NULL, + group_by = "dataset", + split_by = NULL, + title = NULL, + pt_size = NULL, + reduction = NULL, + num_columns = NULL, + shuffle = TRUE, + shuffle_seed = 1, + legend.size = 5, + label = TRUE, + label_size = NA, + label_repel = FALSE, + label_box = FALSE, + label_color = "black", + reorder.idents = FALSE, + new.order = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # Set reduction + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) + + # Create plotting data.frame + reduc_df <- Generate_Plotting_df_LIGER2(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed, reduction = reduction) + + if (!is.null(x = split_by)) { + list_of_splits <- unique(x = reduc_df[[split_by]]) + } + + # Get length of meta data feature + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + split.by_length <- length(x = list_of_splits) + + # 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.", + "*" = "{.field {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}}.") + ) + } + } + + # Create accurate axis labels + x_axis_label <- names(x = reduc_df)[1] + y_axis_label <- names(x = reduc_df)[2] + + centers <<- reduc_df %>% + group_by(.data[['Cluster']]) %>% + summarize(dr1 = median(x = .data[[x_axis_label]]), + dr2 = median(x = .data[[y_axis_label]]) + ) + + colnames(x = centers) <- c("Cluster", x_axis_label, y_axis_label) + + cluster_length <- length(x = unique(x = liger_object@cellMeta$leiden_cluster)) + + if (is.null(x = colors_use)) { + colors_use <- scCustomize_Palette(num_groups = cluster_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + + # plot + if (isTRUE(x = raster)) { + if (!is.null(x = split_by)) { + p2 <- lapply(1:length(x = list_of_splits), function(x){ + p2 <- ggplot(data = subset(reduc_df, reduc_df[[split_by]] %in% list_of_splits[x]), aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[['Cluster']])) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + }) + } else { + p2 <- ggplot(data = reduc_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[['Cluster']])) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + } + } else { + if (!is.null(x = split_by)) { + p2 <- lapply(1:length(x = list_of_splits), function(x){ + p2 <- ggplot(data = subset(reduc_df, reduc_df[[split_by]] %in% list_of_splits[x]), aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[['Cluster']])) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + xlab(x_axis_label) + + ylab(y_axis_label) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + }) + } else { + p2 <- ggplot(data = reduc_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = .data[['Cluster']])) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + 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 (isTRUE(x = label)) { + geom.use <- ifelse(test = label_repel, yes = geom_text_repel, no = geom_text) + p2 <- p2 + geom.use( + data = centers, + mapping = aes(label = .data[['Cluster']]), size = label_size, color = label_color, + show.legend = FALSE + ) + } else { + p2 <- p2 + } + } + } + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + p2 <- wrap_plots(p2) + plot_layout(nrow = num_rows, ncol = num_columns, guides = 'collect') + return(p2) + } + if (!is.null(x = split_by) && is.null(x = num_columns)) { + p2 <- wrap_plots(p2) + plot_layout(guides = 'collect') + return(p2) + } else { + return(p2) + } +} + + #' LIGER plot by meta variables. #' #' Modified version of LIGER's plotByDatasetAndCluster just for plotting meta variables. @@ -623,6 +835,130 @@ Plot_By_Meta_LIGER <- function( } +Plot_By_Meta_LIGER2 <- function( + liger_object, + colors_use = NULL, + group_by = "dataset", + split_by = NULL, + title = NULL, + pt_size = NULL, + reduction = NULL, + num_columns = NULL, + shuffle = TRUE, + shuffle_seed = 1, + legend.size = 3, + reorder.idents = FALSE, + new.order = NULL, + raster = NULL, + raster.dpi = c(512, 512), + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # Set reduction + reduction <- reduction %||% scCustomize:::Default_DimReduc_LIGER(liger_object = liger_object) + + reduc_df <- Generate_Plotting_df_LIGER2(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed, reduction = reduction) + + if (!is.null(x = split_by)) { + list_of_splits <- unique(x = reduc_df[[split_by]]) + } + + # Get length of meta data feature + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + split.by_length <- length(x = list_of_splits) + + # 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.", + "*" = "{.field {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}}.") + ) + } + } + + meta_length <- length(x = unique(x = liger_object@cellMeta[[group_by]])) + + if (is.null(x = colors_use)) { + # set default plot colors + if (is.null(x = colors_use)) { + colors_use <- scCustomize_Palette(num_groups = meta_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) + } + } + + # Create accurate axis labels + x_axis_label <- names(x = reduc_df)[1] + y_axis_label <- names(x = reduc_df)[2] + + group_by <- sym(x = group_by) + + if (isTRUE(x = raster)) { + if (!is.null(x = split_by)) { + p1 <- lapply(1:length(x = list_of_splits), function(x){ + ggplot(subset(reduc_df, reduc_df[[split_by]] %in% list_of_splits[x]), aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = !!group_by)) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + }) + } else { + p1 <- ggplot(reduc_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = !!group_by)) + + theme_cowplot() + + geom_scattermore(pointsize = pt_size, pixels = raster.dpi) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + + } + } else { + if (!is.null(x = split_by)) { + p1 <- lapply(1:length(x = list_of_splits), function(x){ + ggplot(subset(reduc_df, reduc_df[[split_by]] %in% list_of_splits[x]),aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = !!group_by)) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + ggtitle(list_of_splits[x]) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + }) + } else { + p1 <- ggplot(reduc_df, aes(x = .data[[x_axis_label]], y = .data[[y_axis_label]], color = !!group_by)) + + theme_cowplot() + + geom_point(size = pt_size) + + guides(color = guide_legend(override.aes = list(size = legend.size))) + + scale_color_manual(values = colors_use) + + theme(legend.position = "right", + axis.text = element_text(size = rel(0.95)), + plot.title = element_text(hjust = 0.5)) + + guides(col = guide_legend(title = "", override.aes = list(size = 4))) + } + } + if (!is.null(x = split_by) && !is.null(x = num_columns)) { + p1 <- wrap_plots(p1) + plot_layout(nrow = num_rows, ncol = num_columns) + return(p1) + } + if (!is.null(x = split_by) && is.null(x = num_columns)) { + p1 <- wrap_plots(p1) + return(p1) + } else { + return(p1) + } +} + + #' Customized version of plotFactors #' #' Modified and optimized version of `plotFactors` function from LIGER package. From 804886c31aa425c9270baffc635f0b5e5085774d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:51:24 -0400 Subject: [PATCH 189/503] reorg dimplotting across versions --- R/LIGER_Internal_Utilities.R | 484 +++++++++++++++++++++++++++++++++++ 1 file changed, 484 insertions(+) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 1725ad4725..2c58255c71 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -1605,6 +1605,490 @@ plotFactors_liger_scCustom <- function( } +#' DimPlot LIGER Version +#' +#' Standard and modified version of LIGER's plotByDatasetAndCluster +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering before calling this function +#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. +#' If `combination = TRUE` will plot both clusters and meta data variable. +#' @param split_by Variable to split plots by. +#' @param colors_use_cluster colors to use for plotting by clusters. By default if number of levels plotted is +#' less than or equal to 36 will use "polychrome" and if greater than 36 will use "varibow" with shuffle = TRUE +#' both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_meta colors to use for plotting by meta data (cell.data) variable. 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. +#' @param pt_size Adjust point size for plotting. +#' @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 shuffle_seed Sets the seed if randomly shuffling the order of points. +#' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of +#' technique and therefore needs to be set manually. Default is "UMAP". +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. +#' @param label logical. Whether or not to label the clusters. ONLY applies to plotting by cluster. Default is TRUE. +#' @param label_size size of cluster labels. +#' @param label_repel logical. Whether to repel cluster labels from each other if plotting by +#' cluster (if `group_by = NULL` or `group_by = "cluster`). Default is FALSE. +#' @param label_box logical. Whether to put a box around the label text (uses `geom_text` vs `geom_label`). +#' Default is FALSE. +#' @param label_color Color to use for cluster labels. Default is "black". +#' @param combination logical, whether to return patchwork displaying both plots side by side. (Default is FALSE). +#' @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 num_columns Number of columns in plot layout. Only valid if `split.by != NULL`. +#' @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. +#' +#' @return A ggplot/patchwork object +#' +#' @import ggplot2 +#' @importFrom patchwork wrap_plots +#' @importFrom utils packageVersion +#' +#' @noRd +#' +#' @concept liger_plotting +#' +#' @examples +#' \dontrun{ +#' LIGER_DimPlot(liger_object = obj_name, reduction_label = "UMAP") +#' } +#' + +LIGER_DimPlot <- function( + liger_object, + group_by = NULL, + split_by = NULL, + colors_use_cluster = NULL, + colors_use_meta = NULL, + pt_size = NULL, + shuffle = TRUE, + shuffle_seed = 1, + reduction_label = "UMAP", + aspect_ratio = NULL, + label = TRUE, + label_size = NA, + label_repel = FALSE, + label_box = FALSE, + label_color = "black", + combination = FALSE, + raster = NULL, + raster.dpi = c(512, 512), + num_columns = NULL, + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # temp liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", + "i" = "Functionality with rliger v2+ is currently in development.")) + } + + # Check LIGER + Is_LIGER(liger_object = liger_object) + + # Set group_by defaults + if (isFALSE(x = combination) && is.null(x = group_by)) { + group_by <- "cluster" + } + + if (isTRUE(x = combination) && is.null(x = group_by)) { + group_by <- "dataset" + } + + # Group by cluster options + cluster_options <- c("cluster", "Cluster", "clusters", "Clusters") + if (group_by %in% cluster_options) { + group_by <- "cluster" + } + + # Check group_by parameter + if (!group_by == "cluster") + group_by_var <- Meta_Present(object = liger_object, meta_col_names = group_by, print_msg = FALSE, omit_warn = FALSE)[[1]] + + if (!is.null(x = split_by)) { + group_by_var <- Meta_Present(object = liger_object, meta_col_names = split_by, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + if (packageVersion(pkg = 'rliger') < "2.0.0") { + # Add one time dim label warning + if (getOption(x = 'scCustomize_warn_LIGER_dim_labels', default = TRUE)) { + cli_inform(message = c("", + "NOTE: {.field DimPlot_LIGER} uses the {.code reduction_label} parameter to set axis labels ", + "on the plot.", + "By default this is set to {.val UMAP}.", + "Please take note of this parameter as LIGER objects do not store the name", + "of reduction technique used and therefore this needs to be set manually.", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_LIGER_dim_labels = FALSE) + } + } + + # cells in object + cells_total <- LIGER_Cells(liger_object = liger_object) + + # Add raster check for scCustomize + raster <- raster %||% (length(x = cells_total) > 2e5) + + if (isTRUE(x = raster) && (length(x = cells_total) > 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}", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_raster_LIGER = FALSE) + } + + # Add point size + if (is.null(x = pt_size)) { + # modified version of the AutoPointSize() function from Seurat + pt_size <- AutoPointSize_scCustom(data = cells_total, raster = raster) + } + + # plot combination plot + if (isTRUE(x = combination)) { + p1 <- Plot_By_Cluster_LIGER(liger_object = liger_object, + colors_use = colors_use_cluster, + split_by = split_by, + pt_size = pt_size, + reduction_label = reduction_label, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + num_columns = num_columns, + shuffle_seed = shuffle_seed, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + label = label, + color_seed = color_seed) + + p2 <- Plot_By_Meta_LIGER(liger_object = liger_object, + colors_use = colors_use_meta, + group_by = group_by, + pt_size = pt_size, + reduction_label = reduction_label, + num_columns = num_columns, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + split_by = split_by, + color_seed = color_seed, + shuffle_seed = shuffle_seed) + + p3 <- wrap_plots(p1 + p2) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p3 <- p3 & theme(aspect.ratio = aspect_ratio) + } + + return(p3) + } + + # Plot by cluster + if (group_by == "cluster") { + p1 <- Plot_By_Cluster_LIGER(liger_object = liger_object, + colors_use = colors_use_cluster, + split_by = split_by, + pt_size = pt_size, + reduction_label = reduction_label, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + num_columns = num_columns, + shuffle_seed = shuffle_seed, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + label = label, + color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p1 <- p1 & theme(aspect.ratio = aspect_ratio) + } + + return(p1) + } + + # Plot by Meta + if (group_by != "cluster") { + p2 <- Plot_By_Meta_LIGER(liger_object = liger_object, + colors_use = colors_use_meta, + group_by = group_by, + pt_size = pt_size, + reduction_label = reduction_label, + num_columns = num_columns, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + split_by = split_by, + shuffle_seed = shuffle_seed, + color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p2 <- p2 & theme(aspect.ratio = aspect_ratio) + } + + return(p2) + } +} + + + +#' DimPlot LIGER Version +#' +#' Standard and modified version of LIGER's plotByDatasetAndCluster +#' +#' @param liger_object \code{liger} liger_object. Need to perform clustering before calling this function +#' @param group_by Variable to be plotted. If `NULL` will plot clusters from `liger@clusters` slot. +#' If `combination = TRUE` will plot both clusters and meta data variable. +#' @param split_by Variable to split plots by. +#' @param colors_use_cluster colors to use for plotting by clusters. By default if number of levels plotted is +#' less than or equal to 36 will use "polychrome" and if greater than 36 will use "varibow" with shuffle = TRUE +#' both from \code{\link{DiscretePalette_scCustomize}}. +#' @param colors_use_meta colors to use for plotting by meta data (cell.data) variable. 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. +#' @param pt_size Adjust point size for plotting. +#' @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 shuffle_seed Sets the seed if randomly shuffling the order of points. +#' @param reduction specify reduction to use when plotting. Default is current object +#' default reduction. +#' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; +#' Default is NULL. +#' @param label logical. Whether or not to label the clusters. ONLY applies to plotting by cluster. Default is TRUE. +#' @param label_size size of cluster labels. +#' @param label_repel logical. Whether to repel cluster labels from each other if plotting by +#' cluster (if `group_by = NULL` or `group_by = "cluster`). Default is FALSE. +#' @param label_box logical. Whether to put a box around the label text (uses `geom_text` vs `geom_label`). +#' Default is FALSE. +#' @param label_color Color to use for cluster labels. Default is "black". +#' @param combination logical, whether to return patchwork displaying both plots side by side. (Default is FALSE). +#' @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 num_columns Number of columns in plot layout. Only valid if `split.by != NULL`. +#' @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. +#' +#' @return A ggplot/patchwork object +#' +#' @import ggplot2 +#' @importFrom patchwork wrap_plots +#' @importFrom utils packageVersion +#' +#' @noRd +#' +#' @concept liger_plotting +#' +#' @examples +#' \dontrun{ +#' LIGER2_DimPlot(liger_object = obj_name, reduction_label = "UMAP") +#' } +#' + +LIGER2_DimPlot <- function( + liger_object, + group_by = NULL, + split_by = NULL, + colors_use_cluster = NULL, + colors_use_meta = NULL, + pt_size = NULL, + shuffle = TRUE, + shuffle_seed = 1, + aspect_ratio = NULL, + label = TRUE, + label_size = NA, + label_repel = FALSE, + label_box = FALSE, + label_color = "black", + combination = FALSE, + raster = NULL, + raster.dpi = c(512, 512), + num_columns = NULL, + ggplot_default_colors = FALSE, + color_seed = 123 +) { + # Check LIGER + Is_LIGER(liger_object = liger_object) + + # Set group_by defaults + if (isFALSE(x = combination) && is.null(x = group_by)) { + group_by <- "cluster" + } + + if (isTRUE(x = combination) && is.null(x = group_by)) { + group_by <- "dataset" + } + + # Group by cluster options + cluster_options <- c("cluster", "Cluster", "clusters", "Clusters") + if (group_by %in% cluster_options) { + group_by <- "cluster" + } + + # Check group_by parameter + if (!group_by == "cluster") + group_by_var <- Meta_Present(object = liger_object, meta_col_names = group_by, print_msg = FALSE, omit_warn = FALSE)[[1]] + + if (!is.null(x = split_by)) { + group_by_var <- Meta_Present(object = liger_object, meta_col_names = split_by, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + # cells in object + cells_total <- LIGER_Cells(liger_object = liger_object) + + # Add raster check for scCustomize + raster <- raster %||% (length(x = cells_total) > 2e5) + + if (isTRUE(x = raster) && (length(x = cells_total) > 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}", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_raster_LIGER = FALSE) + } + + # Add point size + if (is.null(x = pt_size)) { + # modified version of the AutoPointSize() function from Seurat + pt_size <- AutoPointSize_scCustom(data = cells_total, raster = raster) + } + + # plot combination plot + if (isTRUE(x = combination)) { + p1 <- Plot_By_Cluster_LIGER2(liger_object = liger_object, + colors_use = colors_use_cluster, + split_by = split_by, + pt_size = pt_size, + reduction = reduction, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + num_columns = num_columns, + shuffle_seed = shuffle_seed, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + label = label, + color_seed = color_seed) + + p2 <- Plot_By_Meta_LIGER2(liger_object = liger_object, + colors_use = colors_use_meta, + group_by = group_by, + pt_size = pt_size, + reduction = reduction, + num_columns = num_columns, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + split_by = split_by, + color_seed = color_seed, + shuffle_seed = shuffle_seed) + + p3 <- wrap_plots(p1 + p2) + + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p3 <- p3 & theme(aspect.ratio = aspect_ratio) + } + + return(p3) + } + + # Plot by cluster + if (group_by == "cluster") { + p1 <- Plot_By_Cluster_LIGER2(liger_object = liger_object, + colors_use = colors_use_cluster, + split_by = split_by, + pt_size = pt_size, + reduction = reduction, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + num_columns = num_columns, + shuffle_seed = shuffle_seed, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + label = label, + color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p1 <- p1 & theme(aspect.ratio = aspect_ratio) + } + + return(p1) + } + + # Plot by Meta + if (group_by != "cluster") { + p2 <- Plot_By_Meta_LIGER2(liger_object = liger_object, + colors_use = colors_use_meta, + group_by = group_by, + pt_size = pt_size, + reduction = reduction, + num_columns = num_columns, + shuffle = shuffle, + raster = raster, + raster.dpi = raster.dpi, + ggplot_default_colors = ggplot_default_colors, + split_by = split_by, + shuffle_seed = shuffle_seed, + color_seed = color_seed) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + p2 <- p2 & theme(aspect.ratio = aspect_ratio) + } + + return(p2) + } +} + + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### QC UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From d2162a95e7a367d9b3e86bf6ebcda4e42da2d230 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:51:37 -0400 Subject: [PATCH 190/503] reorg dimplotting across versions exported version --- R/LIGER_Plotting.R | 196 ++++++++++++++++----------------------------- 1 file changed, 70 insertions(+), 126 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 936e86ddee..10e18747dd 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -17,7 +17,10 @@ #' if points of interest are being buried. (Default is TRUE). #' @param shuffle_seed Sets the seed if randomly shuffling the order of points. #' @param reduction_label What to label the x and y axes of resulting plots. LIGER does not store name of -#' technique and therefore needs to be set manually. Default is "UMAP". +#' technique and therefore needs to be set manually. Default is "UMAP". (only valid for +#' rliger < 2.0.0). +#' @param reduction specify reduction to use when plotting. Default is current object +#' default reduction (only valid for rliger v2.0.0 or greater). #' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; #' Default is NULL. #' @param label logical. Whether or not to label the clusters. ONLY applies to plotting by cluster. Default is TRUE. @@ -64,6 +67,7 @@ DimPlot_LIGER <- function( shuffle = TRUE, shuffle_seed = 1, reduction_label = "UMAP", + reduction = NULL, aspect_ratio = NULL, label = TRUE, label_size = NA, @@ -77,12 +81,6 @@ DimPlot_LIGER <- function( ggplot_default_colors = FALSE, color_seed = 123 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # Check LIGER Is_LIGER(liger_object = liger_object) @@ -109,23 +107,28 @@ DimPlot_LIGER <- function( group_by_var <- Meta_Present(object = liger_object, meta_col_names = split_by, print_msg = FALSE, omit_warn = FALSE)[[1]] } - # Add one time dim label warning - if (getOption(x = 'scCustomize_warn_LIGER_dim_labels', default = TRUE)) { - cli_inform(message = c("", - "NOTE: {.field DimPlot_LIGER} uses the {.code reduction_label} parameter to set axis labels ", - "on the plot.", - "By default this is set to {.val UMAP}.", - "Please take note of this parameter as LIGER objects do not store the name", - "of reduction technique used and therefore this needs to be set manually.", - "", - "-----This message will be shown once per session.-----")) - options(scCustomize_warn_LIGER_dim_labels = FALSE) + if (packageVersion(pkg = 'rliger') < "2.0.0") { + # Add one time dim label warning + if (getOption(x = 'scCustomize_warn_LIGER_dim_labels', default = TRUE)) { + cli_inform(message = c("", + "NOTE: {.field DimPlot_LIGER} uses the {.code reduction_label} parameter to set axis labels ", + "on the plot.", + "By default this is set to {.val UMAP}.", + "Please take note of this parameter as LIGER objects do not store the name", + "of reduction technique used and therefore this needs to be set manually.", + "", + "-----This message will be shown once per session.-----")) + options(scCustomize_warn_LIGER_dim_labels = FALSE) + } } + # cells in object + cells_total <- LIGER_Cells(liger_object = liger_object) + # Add raster check for scCustomize - raster <- raster %||% (nrow(x = liger_object@cell.data) > 2e5) + raster <- raster %||% (length(x = cells_total) > 2e5) - if (isTRUE(x = raster) && (nrow(x = liger_object@cell.data) > 2e5) && getOption(x = 'scCustomize_warn_raster_LIGER', default = TRUE)) { + if (isTRUE(x = raster) && (length(x = cells_total) > 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}", @@ -136,117 +139,58 @@ DimPlot_LIGER <- function( # Add point size if (is.null(x = pt_size)) { - cells_total <- nrow(x = liger_object@cell.data) # modified version of the AutoPointSize() function from Seurat pt_size <- AutoPointSize_scCustom(data = cells_total, raster = raster) } - # Create accurate axis labels - x_axis_label <- paste0(reduction_label, "_1") - y_axis_label <- paste0(reduction_label, "_2") - - # plot combination plot - if (isTRUE(x = combination)) { - p1 <- Plot_By_Cluster_LIGER(liger_object = liger_object, - colors_use = colors_use_cluster, - split_by = split_by, - pt_size = pt_size, - reduction_label = reduction_label, - shuffle = shuffle, - raster = raster, - raster.dpi = raster.dpi, - ggplot_default_colors = ggplot_default_colors, - num_columns = num_columns, - shuffle_seed = shuffle_seed, - label_size = label_size, - label_repel = label_repel, - label_box = label_box, - label_color = label_color, - label = label, - color_seed = color_seed) - - p2 <- Plot_By_Meta_LIGER(liger_object = liger_object, - colors_use = colors_use_meta, - group_by = group_by, - pt_size = pt_size, - reduction_label = reduction_label, - num_columns = num_columns, - shuffle = shuffle, - raster = raster, - raster.dpi = raster.dpi, - ggplot_default_colors = ggplot_default_colors, - split_by = split_by, - color_seed = color_seed, - shuffle_seed = shuffle_seed) - - p3 <- wrap_plots(p1 + p2) - - # Aspect ratio changes - if (!is.null(x = aspect_ratio)) { - if (!is.numeric(x = aspect_ratio)) { - cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") - } - p3 <- p3 & theme(aspect.ratio = aspect_ratio) - } - - return(p3) - } - - # Plot by cluster - if (group_by == "cluster") { - p1 <- Plot_By_Cluster_LIGER(liger_object = liger_object, - colors_use = colors_use_cluster, - split_by = split_by, - pt_size = pt_size, - reduction_label = reduction_label, - shuffle = shuffle, - raster = raster, - raster.dpi = raster.dpi, - ggplot_default_colors = ggplot_default_colors, - num_columns = num_columns, - shuffle_seed = shuffle_seed, - label_size = label_size, - label_repel = label_repel, - label_box = label_box, - label_color = label_color, - label = label, - color_seed = color_seed) - # Aspect ratio changes - if (!is.null(x = aspect_ratio)) { - if (!is.numeric(x = aspect_ratio)) { - cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") - } - p1 <- p1 & theme(aspect.ratio = aspect_ratio) - } - - return(p1) - } - - # Plot by Meta - if (group_by != "cluster") { - p2 <- Plot_By_Meta_LIGER(liger_object = liger_object, - colors_use = colors_use_meta, - group_by = group_by, - pt_size = pt_size, - reduction_label = reduction_label, - num_columns = num_columns, - shuffle = shuffle, - raster = raster, - raster.dpi = raster.dpi, - ggplot_default_colors = ggplot_default_colors, - split_by = split_by, - shuffle_seed = shuffle_seed, - color_seed = color_seed) - # Aspect ratio changes - if (!is.null(x = aspect_ratio)) { - if (!is.numeric(x = aspect_ratio)) { - cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") - } - p2 <- p2 & theme(aspect.ratio = aspect_ratio) - } - - return(p2) + # liger version check + if (packageVersion(pkg = 'rliger') > "1.0.1") { + plots <-LIGER2_DimPlot(liger_object = liger_object, + group_by = group_by, + split_by = split_by, + colors_use_cluster = colors_use_cluster, + colors_use_meta = colors_use_meta, + pt_size = pt_size, + shuffle = shuffle, + shuffle_seed = shuffle_seed, + reduction = reduction, + aspect_ratio = aspect_ratio, + label = label, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + combination = combination, + raster = raster, + raster.dpi = raster.dpi, + num_columns = num_columns, + ggplot_default_colors = ggplot_default_colors, + color_seed = color_seed) + } else { + plots <-LIGER_DimPlot(liger_object = liger_object, + group_by = group_by, + split_by = split_by, + colors_use_cluster = colors_use_cluster, + colors_use_meta = colors_use_meta, + pt_size = pt_size, + shuffle = shuffle, + shuffle_seed = shuffle_seed, + reduction_label = reduction_label, + aspect_ratio = aspect_ratio, + label = label, + label_size = label_size, + label_repel = label_repel, + label_box = label_box, + label_color = label_color, + combination = combination, + raster = raster, + raster.dpi = raster.dpi, + num_columns = num_columns, + ggplot_default_colors = ggplot_default_colors, + color_seed = color_seed) } + # return plots + return(plots) } From 225f57fec6f6f5769fc6a09ce6073a2a130e999c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:52:01 -0400 Subject: [PATCH 191/503] update docs --- man/DimPlot_LIGER.Rd | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/man/DimPlot_LIGER.Rd b/man/DimPlot_LIGER.Rd index 0a72d60540..83ce1df79b 100644 --- a/man/DimPlot_LIGER.Rd +++ b/man/DimPlot_LIGER.Rd @@ -14,6 +14,7 @@ DimPlot_LIGER( shuffle = TRUE, shuffle_seed = 1, reduction_label = "UMAP", + reduction = NULL, aspect_ratio = NULL, label = TRUE, label_size = NA, @@ -52,7 +53,11 @@ if points of interest are being buried. (Default is TRUE).} \item{shuffle_seed}{Sets the seed if randomly shuffling the order of points.} \item{reduction_label}{What to label the x and y axes of resulting plots. LIGER does not store name of -technique and therefore needs to be set manually. Default is "UMAP".} +technique and therefore needs to be set manually. Default is "UMAP". (only valid for +rliger < 2.0.0).} + +\item{reduction}{specify reduction to use when plotting. Default is current object +default reduction (only valid for rliger v2.0.0 or greater).} \item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; Default is NULL.} From ac6a3c5be2cb819cddd7013ec225231e1655778b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:52:34 -0400 Subject: [PATCH 192/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9dbbff8a52..1e683434c5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,7 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - Updated functions to interact with both old and new style liger objects: - - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`. + - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`, `DimPlot_LIGER`. - Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: - `as.LIGER`, `as.Seurat`. - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. From c5153db12085e8c4b7c248583ea8190601a9b9a0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 13:52:45 -0400 Subject: [PATCH 193/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9d2555c146..ba67a7a3a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9030 +Version: 2.1.2.9031 Date: 2024-04-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")), From 2b8e2231216a5dccd55f44dc0dbd1f500a0236cd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 14:21:55 -0400 Subject: [PATCH 194/503] fix na_ok bug --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 6d80f19822..96c98419af 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1116,7 +1116,7 @@ Add_Sample_Meta <- function( } # Check NA in meta data - if (anyNA(x = meta_data)) { + if (anyNA(x = meta_data) && isFALSE(x = na_ok)) { cli_abort(message = c("{.code meta_data} contains NA values.", "i" = "If you would like NA values added to Seurat meta data please set {.code na_ok = TRUE}.") ) From 098aca8d5ff9da160bd5ad2fccafbc35cf4169cb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 14:22:47 -0400 Subject: [PATCH 195/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 1e683434c5..0a7ee36f34 100644 --- a/NEWS.md +++ b/NEWS.md @@ -31,7 +31,8 @@ - Fixed several potential errors in `as.anndata` from Seurat conversion that previously caused failures ([#168](https://github.com/samuel-marsh/scCustomize/issues/168)). - Fixed errors in `Create_Cluster_Annotation_File` if for file path and csv name errors. - Fixed error when using `plot_median` and more than one feature in `VlnPlot_scCustom` ([#169](https://github.com/samuel-marsh/scCustomize/issues/169)). -- Fixed bug while collecting legends for `DimPlot_scCustom` due to changes in guides updated with ggplot2 v3.5.0 ([#171](https://github.com/samuel-marsh/scCustomize/issues/171)) +- Fixed bug while collecting legends for `DimPlot_scCustom` due to changes in guides updated with ggplot2 v3.5.0 ([#171](https://github.com/samuel-marsh/scCustomize/issues/171)). +- Fixed error in `Add_Sample_Meta` that still errored when setting `na_ok = TRUE`. - Spelling and style fixes. Thanks @kew24. From a60cf56813b2bf933687c37d4cab608b8197cda6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 14:22:59 -0400 Subject: [PATCH 196/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ba67a7a3a5..f1a39d6a8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9031 +Version: 2.1.2.9032 Date: 2024-04-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")), From 6a69a37226bb528db34bfd4cb726692f2da591cd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 8 Apr 2024 14:24:31 -0400 Subject: [PATCH 197/503] fix rearrange --- R/LIGER_Internal_Utilities.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 2c58255c71..3ff7b753fb 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -1923,6 +1923,7 @@ LIGER2_DimPlot <- function( pt_size = NULL, shuffle = TRUE, shuffle_seed = 1, + reduction = reduction, aspect_ratio = NULL, label = TRUE, label_size = NA, From c8f25a2b68446d641dc6f53ab3b952d5bbb0ff46 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 09:36:11 -0400 Subject: [PATCH 198/503] code styling --- R/Internal_Utilities.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 5d4ac488f9..7ea8e198f1 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -1167,7 +1167,7 @@ Metrics_Count_GEX <- function( file_path <- file.path(base_path, lib_list[x], secondary_path) } - raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = F) + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = FALSE) # 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))}) @@ -1250,7 +1250,7 @@ Metrics_Multi_GEX <- function( 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) + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = FALSE) # Change format to column based and select relevant metrics GEX_metrics <- raw_data %>% @@ -1370,7 +1370,7 @@ Metrics_Multi_VDJT <- function( 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) + raw_data <- read.csv(file = file.path(file_path, "metrics_summary.csv"), stringsAsFactors = FALSE) VDJ_T_Metrics <- raw_data %>% filter(.data[["Grouped.By"]]== "Physical library ID" & .data[["Library.Type"]] == "VDJ T") %>% @@ -1520,7 +1520,7 @@ process_hgnc_data <- function( to ) { # read in data - hgnc_full_data <- data.table::fread(file = from, data.table = F) + hgnc_full_data <- data.table::fread(file = from, data.table = FALSE) # filter data: Approved Genes > select relevant categories hgnc_filtered_data <- hgnc_full_data %>% From 70d53fc0ef24a80cf1d78003c05d28db21ada7ae Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 09:37:36 -0400 Subject: [PATCH 199/503] code styling --- R/Internal_Utilities.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 7ea8e198f1..5fb62936c1 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -1199,7 +1199,6 @@ Metrics_Count_GEX <- function( rownames(x = full_data) <- full_data$sample_id return(full_data) - } From 0e875dd4cbafd5467fa5ba2e5e765d5cae54065d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 09:48:32 -0400 Subject: [PATCH 200/503] Add read CellBender metrics --- R/Read_&_Write_Data.R | 88 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index 05112ea56a..55aeb9ed4a 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -1647,6 +1647,94 @@ Read_Metrics_10X <- function( } +#' Read Overall Statistics from CellBender +#' +#' Get data.frame with all metrics from the CellBender `remove-background` analysis. +#' +#' @param base_path path to the parent directory which contains all of the sub-directories of interest. +#' @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 metrics from CellBender. +#' +#' @import cli +#' @import pbapply +#' @importFrom dplyr bind_rows +#' @importFrom magrittr "%>%" +#' @importFrom utils read.csv +#' +#' @export +#' +#' @concept read_&_write +#' +#' @examples +#' \dontrun{ +#' CB_metrics <- Read_Metrics_CellBender(base_path = "/path/to/directories") +#' } +#' + +Read_Metrics_CellBender <- function( + base_path, + lib_list = NULL, + lib_names = NULL +) { + # Confirm directory exists + if (dir.exists(paths = base_path) == FALSE) { + cli_abort(message = "Directory: {.val {base_path}} specified by {.code base_path} does not exist.") + } + # Detect libraries if lib_list is NULL + if (is.null(x = lib_list)) { + lib_list <- list.dirs(path = base_path, full.names = F, recursive = F) + } + + # Check if full directory path exists + for (i in 1:length(x = lib_list)) { + full_directory_path <- file.path(base_path, lib_list[i]) + if (dir.exists(paths = full_directory_path) == FALSE) { + cli_abort(message = "Full Directory does not exist {.val {full_directory_path}} was not found.") + } + } + + cli_inform(message = "Reading {.field CellBender} Metrics") + raw_data_list <- pblapply(1:length(x = lib_list), function(x) { + # get directory path + file_path <- file.path(base_path, lib_list[x]) + + # full path with file name + full_path <- file.path(file_path, paste0(lib_list[x], "_out_metrics.csv")) + + # read in metrics file + raw_data <- read.csv(file = full_path, stringsAsFactors = FALSE, header = FALSE) + + # Move statistic names to rownames and transpose + raw_data <- raw_data %>% + column_to_rownames("V1") %>% + t() %>% + data.frame() + + # return the new raw_data data.frame + 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 + } + + # Combine the list and add sample_id column + full_data <- bind_rows(raw_data_list, .id = "sample_id") + + # replace nonsense with sample_id as well + rownames(x = full_data) <- full_data$sample_id + + return(full_data) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### READ Utilities #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From d963b0e854e69e54003e5553330faa917da5a123 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 09:48:40 -0400 Subject: [PATCH 201/503] Update docs --- NAMESPACE | 1 + man/Read_Metrics_CellBender.Rd | 30 ++++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+) create mode 100644 man/Read_Metrics_CellBender.Rd diff --git a/NAMESPACE b/NAMESPACE index f432e3d5e7..2f453cd006 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -126,6 +126,7 @@ export(Read_CellBender_h5_Multi_Directory) export(Read_CellBender_h5_Multi_File) export(Read_GEO_Delim) export(Read_Metrics_10X) +export(Read_Metrics_CellBender) export(Reduction_Loading_Present) export(Rename_Clusters) export(Replace_Suffix) diff --git a/man/Read_Metrics_CellBender.Rd b/man/Read_Metrics_CellBender.Rd new file mode 100644 index 0000000000..c7fa7e2509 --- /dev/null +++ b/man/Read_Metrics_CellBender.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Read_&_Write_Data.R +\name{Read_Metrics_CellBender} +\alias{Read_Metrics_CellBender} +\title{Read Overall Statistics from CellBender} +\usage{ +Read_Metrics_CellBender(base_path, lib_list = NULL, lib_names = NULL) +} +\arguments{ +\item{base_path}{path to the parent directory which contains all of the sub-directories of interest.} + +\item{lib_list}{a list of sample names (matching directory names) to import. If \code{NULL} will read +in all samples in parent directory.} + +\item{lib_names}{a set of sample names to use for each sample. If \code{NULL} will set names to the +directory name of each sample.} +} +\value{ +A data frame with sample metrics from CellBender. +} +\description{ +Get data.frame with all metrics from the CellBender \code{remove-background} analysis. +} +\examples{ +\dontrun{ +CB_metrics <- Read_Metrics_CellBender(base_path = "/path/to/directories") +} + +} +\concept{read_&_write} From ca60b55184a1e9ca238f6f2add9b88c571138605 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 10:03:44 -0400 Subject: [PATCH 202/503] add ability to read single file --- R/Read_&_Write_Data.R | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index 55aeb9ed4a..624d31bd10 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -1651,7 +1651,8 @@ Read_Metrics_10X <- function( #' #' Get data.frame with all metrics from the CellBender `remove-background` analysis. #' -#' @param base_path path to the parent directory which contains all of the sub-directories of interest. +#' @param base_path path to the parent directory which contains all of the sub-directories of interest or +#' path to single metrics csv file. #' @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 @@ -1680,6 +1681,33 @@ Read_Metrics_CellBender <- function( lib_list = NULL, lib_names = NULL ) { + # single file vs. multi-sample + if (length(x = grep(pattern = "\\.csv", x = base_path, value = TRUE)) > 0) { + if (file.exists(base_path) == FALSE) { + cli_abort(message = "Metrics file: {.val {base_path}} specified by {.code base_path} does not exist.") + } else { + # read in metrics file + raw_data_single <- read.csv(file = base_path, stringsAsFactors = FALSE, header = FALSE) + + # Move statistic names to rownames and transpose + raw_data_single <- raw_data_single %>% + column_to_rownames("V1") %>% + t() %>% + data.frame() + + # Add sample name + file_name <- basename(path = base_path) + sample_name <- gsub(pattern = "_out_metrics.csv", replacement = "", x = file_name) + + rownames(raw_data_single) <- sample_name + + raw_data_single <- cbind(sample_id = sample_name, raw_data_single) + + # return the new raw_data data.frame + return(raw_data_single) + } + } + # Confirm directory exists if (dir.exists(paths = base_path) == FALSE) { cli_abort(message = "Directory: {.val {base_path}} specified by {.code base_path} does not exist.") @@ -1697,7 +1725,7 @@ Read_Metrics_CellBender <- function( } } - cli_inform(message = "Reading {.field CellBender} Metrics") + cli_inform(message = "Reading {.field CellBender} Metrics for {.field {length(lib_list)} samples}.") raw_data_list <- pblapply(1:length(x = lib_list), function(x) { # get directory path file_path <- file.path(base_path, lib_list[x]) From 4afdaea54525e1f6cc031568dcbabeb2f6867cf1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 10:03:51 -0400 Subject: [PATCH 203/503] Update docs --- man/Read_Metrics_CellBender.Rd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/man/Read_Metrics_CellBender.Rd b/man/Read_Metrics_CellBender.Rd index c7fa7e2509..c8b89b04ff 100644 --- a/man/Read_Metrics_CellBender.Rd +++ b/man/Read_Metrics_CellBender.Rd @@ -7,7 +7,8 @@ Read_Metrics_CellBender(base_path, lib_list = NULL, lib_names = NULL) } \arguments{ -\item{base_path}{path to the parent directory which contains all of the sub-directories of interest.} +\item{base_path}{path to the parent directory which contains all of the sub-directories of interest or +path to single metrics csv file.} \item{lib_list}{a list of sample names (matching directory names) to import. If \code{NULL} will read in all samples in parent directory.} From ca5a46701e80809974b80319f83a49312af6fc05 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 10:04:33 -0400 Subject: [PATCH 204/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 0a7ee36f34..83897bd252 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,7 @@ - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. +- Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. From 4d360d2a2bbfdb1c5fa511dbfb72b5a7e424e43c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 10:04:50 -0400 Subject: [PATCH 205/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f1a39d6a8a..d9a41d7ed5 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" RRID:SCR_024675. -Version: 2.1.2.9032 -Date: 2024-04-08 +Version: 2.1.2.9033 +Date: 2024-04-10 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"), From 5bf05d9e8b339c3b5b279d38fda22327862914c0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 10 Apr 2024 20:27:12 -0400 Subject: [PATCH 206/503] update text regarding liger --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 83897bd252..848a099791 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ## Added - Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. - Added new function `seq_zeros()` to create sequences with preceding zeros. -- Added new functions to interact with upcoming liger object format change: +- Added new functions to interact with liger v2.0.0+ object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - Updated functions to interact with both old and new style liger objects: From b273fb5592361d639bf264fcb6c9b8ac48b7e3fc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 07:30:46 -0400 Subject: [PATCH 207/503] add cells parameter explictly to FeatureScatter_scCustom --- R/Seurat_Plotting.R | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index bdea9aa730..3fcf81bd92 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2182,6 +2182,7 @@ VariableFeaturePlot_scCustom <- function( #' @param seurat_object Seurat object name. #' @param feature1 First feature to plot. #' @param feature2 Second feature to plot. +#' @param cells Cells to include on the scatter 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). @@ -2232,6 +2233,7 @@ FeatureScatter_scCustom <- function( seurat_object, feature1 = NULL, feature2 = NULL, + cells = NULL, colors_use = NULL, pt.size = NULL, group.by = NULL, @@ -2298,21 +2300,24 @@ FeatureScatter_scCustom <- function( } # 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) + if (is.null(x = pt.size)) { + if (is.null(x = cells)) { + if (!is.null(x = 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) + } + } else { + pt.size <- AutoPointSize_scCustom(data = seurat_object) + } } - # 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, ...) + plot <- FeatureScatter(object = seurat_object, feature1 = feature1, feature2 = feature2, cells = cells, 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 + From 266e92f958cddb68cfef4521d04361e857dfa1ba Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 07:30:54 -0400 Subject: [PATCH 208/503] Update docs --- man/FeatureScatter_scCustom.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/FeatureScatter_scCustom.Rd b/man/FeatureScatter_scCustom.Rd index 4e868607c2..3414b274ba 100644 --- a/man/FeatureScatter_scCustom.Rd +++ b/man/FeatureScatter_scCustom.Rd @@ -8,6 +8,7 @@ FeatureScatter_scCustom( seurat_object, feature1 = NULL, feature2 = NULL, + cells = NULL, colors_use = NULL, pt.size = NULL, group.by = NULL, @@ -32,6 +33,8 @@ FeatureScatter_scCustom( \item{feature2}{Second feature to plot.} +\item{cells}{Cells to include on the scatter plot.} + \item{colors_use}{color for the points on plot.} \item{pt.size}{Adjust point size for plotting.} From dfcaff559a3b0956b8adb77c250c98be8e53c60a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 07:31:40 -0400 Subject: [PATCH 209/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 848a099791..8a4754cb3b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,7 @@ - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. - Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. +- Added `cells` parameter explictly to `FeatureScatter_scCustom`. From 310f87149125b317dcea63820b28a34712f08f71 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 07:31:53 -0400 Subject: [PATCH 210/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d9a41d7ed5..09ea05d70e 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" RRID:SCR_024675. -Version: 2.1.2.9033 -Date: 2024-04-10 +Version: 2.1.2.9034 +Date: 2024-04-15 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"), From f7ae9b3e2424d3d443a17fb397c8edf6f7a01708 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 07:56:11 -0400 Subject: [PATCH 211/503] fix point size ordering --- R/Seurat_Plotting.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3fcf81bd92..ebb426cb3f 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2309,9 +2309,11 @@ FeatureScatter_scCustom <- function( max_cells <- max(cells_by_split$Freq) # modified version of the autopointsize function from Seurat pt.size <- AutoPointSize_scCustom(data = max_cells, raster = raster) + } else { + pt.size <- AutoPointSize_scCustom(data = seurat_object) } } else { - pt.size <- AutoPointSize_scCustom(data = seurat_object) + pt.size <- AutoPointSize_scCustom(data = length(x = cells)) } } From c4fc4e709840dc94e420a71357cbe23f8e3ee654 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 15 Apr 2024 14:08:57 -0400 Subject: [PATCH 212/503] fix stats error --- R/Statistics_Plotting.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/Statistics_Plotting.R b/R/Statistics_Plotting.R index d0f0081d99..6c0a1dcb39 100644 --- a/R/Statistics_Plotting.R +++ b/R/Statistics_Plotting.R @@ -52,7 +52,7 @@ Plot_Median_Genes <- function( Is_Seurat(seurat_object = seurat_object) # add to meta if grouping by ident - if (group_by == "ident") { + if (!is.null(x = group_by) && group_by == "ident") { seurat_object[["ident"]] <- Idents(object = seurat_object) if (is.null(x = legend_title)) { legend_title <- "Identity" @@ -198,7 +198,7 @@ Plot_Median_UMIs <- function( Is_Seurat(seurat_object = seurat_object) # add to meta if grouping by ident - if (group_by == "ident") { + if (!is.null(x = group_by) && group_by == "ident") { seurat_object[["ident"]] <- Idents(object = seurat_object) if (is.null(x = legend_title)) { legend_title <- "Identity" @@ -345,7 +345,7 @@ Plot_Median_Mito <- function( Is_Seurat(seurat_object = seurat_object) # add to meta if grouping by ident - if (group_by == "ident") { + if (!is.null(x = group_by) && group_by == "ident") { seurat_object[["ident"]] <- Idents(object = seurat_object) if (is.null(x = legend_title)) { legend_title <- "Identity" @@ -507,7 +507,7 @@ Plot_Median_Other <- function( } # add to meta if grouping by ident - if (group_by == "ident") { + if (!is.null(x = group_by) && group_by == "ident") { seurat_object[["ident"]] <- Idents(object = seurat_object) if (is.null(x = legend_title)) { legend_title <- "Identity" @@ -656,7 +656,7 @@ Plot_Cells_per_Sample <- function( } # add to meta if grouping by ident - if (group_by == "ident") { + if (!is.null(x = group_by) && group_by == "ident") { seurat_object[["ident"]] <- Idents(object = seurat_object) if (is.null(x = legend_title)) { legend_title <- "Identity" From 530297908d04f06fa411a057262b846a023b9fdc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 09:53:20 -0400 Subject: [PATCH 213/503] fix combine --- R/Seurat_Plotting.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index ebb426cb3f..3e1aa40510 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -228,13 +228,13 @@ FeaturePlot_scCustom <- function( 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, alpha = alpha_exp, ...)) plot <- lapply(1:length(x = plot_list), function(i) { - p[[i]] <- suppressMessages(p[[i]] + scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, NA), na.value = na_color)) + plot_list[[i]] <- suppressMessages(plot_list[[i]] + scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, NA), na.value = na_color)) }) } else { 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) { - p[[i]] <- suppressMessages(p[[i]] + scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, NA), na.value = na_color)) + plot_list[[i]] <- suppressMessages(plot_list[[i]] + scale_color_gradientn(colors = colors_use, limits = c(na_cutoff, NA), na.value = na_color)) }) } } From 938613274b9765a0a977bbbab9b3cfa673435891 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 09:55:44 -0400 Subject: [PATCH 214/503] update changelog --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 8a4754cb3b..98f0805a9b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -35,6 +35,8 @@ - Fixed error when using `plot_median` and more than one feature in `VlnPlot_scCustom` ([#169](https://github.com/samuel-marsh/scCustomize/issues/169)). - Fixed bug while collecting legends for `DimPlot_scCustom` due to changes in guides updated with ggplot2 v3.5.0 ([#171](https://github.com/samuel-marsh/scCustomize/issues/171)). - Fixed error in `Add_Sample_Meta` that still errored when setting `na_ok = TRUE`. +- Fixed errors in `Plot_Median_*` family that caused issues when `group_by` parameter was NULL. +- Fixed errors in `FeaturePlot_scCustom` when setting `combine = FALSE`. - Spelling and style fixes. Thanks @kew24. From fe2162f74511e6411063d2375d111a495eed5f3b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 09:55:52 -0400 Subject: [PATCH 215/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 09ea05d70e..9aae9a262c 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" RRID:SCR_024675. -Version: 2.1.2.9034 -Date: 2024-04-15 +Version: 2.1.2.9035 +Date: 2024-04-16 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"), From d160394cf125899ac00c9ee977da680e63f9872a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:20:02 -0400 Subject: [PATCH 216/503] create accepted names function --- R/Internal_Utilities.R | 60 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 54 insertions(+), 6 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 5fb62936c1..5df9a7a1a5 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -341,6 +341,48 @@ yesno <- function(msg, .envir = parent.frame()) { #################### QC HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#' Default Species List +#' +#' Creates list containing accepted default species +#' +#' @param list logical, whether to return species names in list or data.frame format. +#' +#' @return list or data.frame of accepted species names +#' +#' @keywords internal +#' +#' @noRd +#' + +accepted_species_scCustom <- function( + list = TRUE +) { + if (isTRUE(x = list)) { + 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + ) + } else { + 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + ) + } + return(accepted_names) +} + #' Ensembl Mito IDs #' @@ -368,7 +410,8 @@ Retrieve_Ensembl_Mito <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Species Spelling Options @@ -433,7 +476,8 @@ Retrieve_Ensembl_Ribo <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Species Spelling Options @@ -498,7 +542,8 @@ Retrieve_Ensembl_Ribo <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Species Spelling Options @@ -576,7 +621,8 @@ Retrieve_Ensembl_Ribo <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Species Spelling Options @@ -658,7 +704,8 @@ Retrieve_Ensembl_Ribo <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) if (!species %in% unlist(x = accepted_names)) { @@ -750,7 +797,8 @@ Retrieve_Ensembl_Ribo <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) if (!species %in% unlist(x = accepted_names)) { From 02d924d2da2264277879bbb5c58d2b7b5ab303d3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:21:44 -0400 Subject: [PATCH 217/503] remove accepted names function --- R/Internal_Utilities.R | 43 ------------------------------------------ 1 file changed, 43 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 5df9a7a1a5..c44b7f2252 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -341,48 +341,6 @@ yesno <- function(msg, .envir = parent.frame()) { #################### QC HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#' Default Species List -#' -#' Creates list containing accepted default species -#' -#' @param list logical, whether to return species names in list or data.frame format. -#' -#' @return list or data.frame of accepted species names -#' -#' @keywords internal -#' -#' @noRd -#' - -accepted_species_scCustom <- function( - list = TRUE -) { - if (isTRUE(x = list)) { - 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") - ) - } else { - 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") - ) - } - return(accepted_names) -} - #' Ensembl Mito IDs #' @@ -959,7 +917,6 @@ Retrieve_Ensembl_Ribo <- function( } - #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### GENERAL HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From 47e8697ee6a04d2ec0b85d32fb5556beb166b9d5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:23:14 -0400 Subject: [PATCH 218/503] add chicken msigdb --- data/msigdb_qc_gene_list.rda | Bin 8552 -> 9050 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/data/msigdb_qc_gene_list.rda b/data/msigdb_qc_gene_list.rda index 0f1718201a791b514a66b4f8fc8ef420d54fb66f..c61120b9a9e0fa88dfb854cde41655dfaf6b86ba 100644 GIT binary patch literal 9050 zcmV-gBc1N$SrEwTY3W7*0w9Yj5`+L$t9x$z5)NNF!VlmV@P%*f@Rgs)b|zRj=R4I^QcE+E zTAGrgyYoXPkcs>`=j1sbk)HF~dhz?+qbku`)s=jS6_Y|e7T9@=*!(U%TG?8{f)}{TlMF!)t~=$SF~#P`n?W;zHK)Um;jvF z9jIxr=plMFg@ViS5r*BrG^yBdWKH>bli`eOn%avJ)a|J=Zc{62_R?+iICJT?h7DW7 zo`ih~9SH{rXZ?nRri2!>qBR=`G!$rr$n6Q_2qf-vFQLM=?P7DkdC13?Qx zc~4D&<^;>NYy>?h2eU(?9^TdNLsp08Z~cg-P_olQ&&I({zh7=zEmmOzmaayUx_%%Zu`|G3bx!wN#pxhsv06dO5TqO)sRL6s zwW;U2UO5wtnSDv`GJ{slxK+k%IHwlQMvEoQgPBY7pf>Z|X+xqGBC9D7<}Jj1i-swX zC~1m3i@JKY^oHE_rRQ<_HQh3Iu7WS*_A<>wg zXiQHurY9QH6OHMK#`HvE`l7zRsBaTE|(uu@2m9ZV|u8X;v@v! z%c*CU3Z>#+dQ{3&W=mPh8!Q*p^r|<$Buk+HRLug`=K`9m(tSviep^iYX3M6fQesnL zvs@DOBeo=LO4yQ+hH`P$pYqz!h!yAJ%6((}B&nSS2 zz&bgap#QZTO4}j*Q`L4M2~m6gk}9z0uW1ffY}chS%OP87uUwDxwX|Do*P=Rl{VDf_ z0wxVv{fN#bY>2Y73VWkDB_|FiUs632k1WVaj|@hmH*;y2dh>~E(L(Kcps{+(kqPPY zNrkD^Kp>1TQLKreji7^|i=doOM&EwL)%52!0!IL9X5VR)RaW|V+3Iq-+2nMaW^dn7 z%dE#aFHO#QIj2!QA~xNIQ`@5&r&m(v7FCIwi z&D!SVk)I5xlWUXVWJyA&IvMf=QCag5+3nTIi2JUlK#$gxF_|{HkhURR_D^Lp<>IUv zl$kmr)l~WPil*C3Z^_S`4p@~;NA{HL4r4l-lgOK1m3wq$y*kuYvpz{UV>TiK*_g2) zs?GP`OLqe5o{B7VgrfH>)i^gN0x$*-=nk zj=(zBfabNf4xrow23rG?aLakQc%G}Iw-`1|TH)$~!nBuIUb>WLEEnXxs4ibCJyrtL z_{Q%Cf)>wl{6_j5Cy3Kt8Q|Cc-5fc}CA0f{LB;a|j*lRFY@-*yEL0Qk-m;5B~ zepLGlHe;0fVfE@Lg+=<(ad>{IG(E~0^}Q~GtIN^^sW?~cQE+(G3?}R~s|=>3kp|OC zdW(VAXCqDn6M==GiJ*mm1gJ9)IXpDl(cu)$u?RJP4+)()Wa+mhZ>C~vIJ@Y zvihu*u2`^*`%^Y-$7;r~2AH|9-=8d9_8d&ep4Z!b(yud@oPl~j-=x(u@ApvNPRU_Y z)1dEQR@n{4e8{?UJ{w@#f;7#MIrQy(*&=tCPLl(rHotO~CcUsmB>UYy=@TXI2hARU zcKK!%cTUS)?fqD`xwvo?=s|{qr5p=E69B)90%J&*)3n%alAHI49D&A&NMaq4xX%># znFE1_0*wTcHB1EhRG^oLEOJg4Xauh`Yw&=$-h{p5p6#>*0JX;R!Lv!N8D5XA9&hl9 z_7{f7o(-M0Al-yCEfH_d#)9Yaz^XJ2pXbeZWiHhAj)!^S^vSHPF9!W~1C-#<;%8`$ zNUL-)w_R$^5s^$;DD^~YVX^R7mM@lMSL%KEvdJPr!xn8MaaUel+Nj+WFcDY?$n&5; z8`8Z0wmn|o6}CRA%h`bULQA(r(rLLEHO^V9e?BWUp>Z{H$uhrkhwSXUQhPt%TDuFA z{74E|5F{g&ey z;q98&Re@xlB~VkKmOyQRIs$bC;vkSlD^dMDBpS04jaiAttVCm0qA@Gcn3ZTuAnFT5 zeVNG1WS(eCCfbsT+A~pmCTf2pYIwszpqNC${A<#kl}i#J#^r|B`enkp@bazSAbIDi z`OYpBSfVQZmeV(EeTNB`zoy<->35{d+#XY1{Dh=Oq5GcwsYI@bX zK9Ffp01g7d`dmPBRXTt)X}HBMFqIw9xQ9)NAqZ4pOTwmvY?IywJ6;SLv94U)CT}d3 zg^OEWYPDssP1&$mZufhL`e?*aAB{RbX0}ApF3CEL*y=p&_q6Kk8g#10ocVA zLevK@L)0gPs80w{pHMBc73bV=)F-@&X;hDht+n;ePpQV;EtN{6)heNk{F*ZII3{JH zj50E~DvnQcN+mh!6Od`-gj?3=&YH}vnzQv+y91%v|B98TMl=hmPP`{MY&gj~s(nDM zH3l2DAP0Mvyn~oTesz$pRs!%HX++kKGX2WCMbw9SZ0MIJnW2)@Fl8l@Sul+LK&xZq zhhdY9-8)EQHUcYkq^1kI*Ag;1b=rb72Ys@blcX+2S-z)vFuD!indL6W7&q4CGOdg^ z<=U!__Z#k*@%}(HYa5dXeiBh1*Cy+2P9mo|S@Zl*S@DJ}_3C7^rmm|guu3?JvxA_| zj%KS)m;FTv+ZS?L(nH;O)}m1JF+v3={_cjH@z)4;mTSKX)7@c zNWdAh4H?A7jO9>u9)%$XeWEp45w3s3&Zsa5Ib;)V)~q(%NDVl>w#$2(s=Eu=UUPTK zq~=HL{Vi{D-6Szn-rFf?@h-_t*l*xM@3~nN3&6%nP9ntc{FK_}MLSx!!U8dr(LsU* z4Un1_`&mRn+B*c)CB}mN8C8|$8MX+>!%&zI=PW-Ldq3o;&w;mFD$SNflKb>#wZ+$J zC9r>pT?5tS2Fzg%Xku&Y0LpD)v^C(UPh75^=PH?I>xM~7TwPF@{bGlN@{DDc94OU>mB3Fa)daGpY{iu&mGN@vQ>|P3kcO3NzQ+|1SbKs~C4TMUv8L)eoMx<@+ zBrQj{Zl}98&p1Pw1?085XCfTf$TNEB8dPk|6H)2DvIms9V@E-h^EB-5Kw0mT8-5Zv zJgWVS%^0PASiL$y9&^+uI2Jkv`xjgCrnrxc3%P$iqK!bZ zhOIzf33P+VBA;!6HtQ<^TJ%H%^eT(A`Hl?tuLaW-2ff9w)h!ZA@T-0_7iH(5pmE* zX(tZ)WGRdCMb3T&wGGdkG>bLj2f&uRy7W=CDPSV75Rjiifi|Rh^X;d+x+_Z-^UHk{ zGDs7M`D7c6`MlecEq=96$X9%otl77DrFMS2uTCUCu`lJ*pPbBf94)c=QxJI+l7Qc=VsjYfr(W z0z3tePCl04QB?nHc0f}%ZvD}IOE-x-bq=DKCPGj$htV^o!F?;Y?Hm#A2rS|EXv&5 z!GR5y{;1ueZm!r9{sr%j^u2yUr+Y!&9H+G5)M+wMR=aQRk}vF~o4t!yQC_ZszdT;q z`1}36OJTI5Qk9I%>iRLaFX2$ak%T=7%U@zWzk3w@g6uAzJ_Gma+PC}7a#}xE&~@#` zSp)JLZGt*~cJWE)%)ftu=7qXIyJvm3#dqsGvyD$~iaeU;H3b$!hX<1Qw3}Vdw7TaOql@!4ehaRNUuS#x>u<&`dh-r4+LRHzOCreN&*v0CeD{rh z$frN`R*v>JkKTmSnjGHJ2K534cFe@4+l%q!e)D?J zqD~7yQ?&IQ-=ZttA79YKa;61N!6@yN}I# z*t&FdmWg>7T4{8sfp?HSB^s_oChx6ta0jY1MPv+Bt_zi2kbSY= zkiuFXI2QBlP=+9i@2#EDYCS^!#_JK%i+ICmQLfL^S6tE*hxa$1c;ny0cCZ&q`aK1&o*vI!Inanx4>99#6+lYf`si2Ckp&`T#RiB zO_s1BO+RYSa&kU{@4pg9w9Oi9lUA#gk`+HCPbYl$OTUL{by27V_sZTh>i1q1T^7=z84)^7wK=nVaojH#^eo!IJmy|~QAn?|MH10gJ&o4CHGfyGI=$3MjBB?irP=GL zT4A=EG&_zf@vd0m_B^i2a`RGCTc40hsE%t|R);s(Nlda!e-?@To#73pc{k4yf%klz z@F6a_vh_5w+8t0zEt6-ZQc+e5WkRQULA$VE1y(Rx`)XCJ%T$D) z;v(@gwnW3LrR!%TBlatPvuMIr)Z+HH%VbAY4R!}I1<+Zk_Q7QSU$Yq6N82-!gW!&= zFV~ZaeO6BUs)psfeWAe+t!87%KV;VFCZx+AIo+v=WOe!>^kk#U=49%FbnbR9s3p$a z-mz0rce8cT7KltZZLYFsvA;@yaWj|>&&oHbEcw$Z+OK#<5;V)p!KnD(KvON%R+iX-WLm-BsMk z8?%V0HZSh-c@LvErJYv$-Y}GkMJ=%jS+aF)fSJ4*(9q(wmGHo-v?#?fIhE6aw6yJ7 zTTO{Jk$wfa#XVE85= zOfT*1E9-jSy+>Cy$n5rk+3gEvw~x$j zADP|0V0PF2g4yj$xB}Q(i^9nC_9fHXmrQS8GQEAl^gca8@;a2*7sVqI6h2bBt3H10 z#}~|QUog9U!R+>t*{y5T%x-)epmv`gVQ>%Aa(?dLal3tSKfV54esu5o%D>X+y91wtUV^!gqR{2FNBf1PdrCA^8=sU5AkX?@ZtW$tgv>y{NX%uh%Y zY{BEVg{itlhvOEB;#(w&Z-FSj1){hHw>|>ex9ouFuF^bZcgP#B?0wn?>{T17UyMEY zCHG7mukAH)oJ&2*9N!D(_+Bu__kuaT7tHa!V2VM=>t`&nV!;%T1yej` zrg;1{?VKwIreGa5Fr_u1xqbkz=K*-*wM6sAsaOKHBtRTbfHMiohZ;@ACFAz)0>fCTaY2;?;l=rw-B*1@{@2`#7NuNWHLZkxR&)gWxLnh6AbJOKK5fb{Wt zfmZh*KSk5YY0DZApS&Ivd~(hqLb;)mBs2pgmn*|?M}t@inOz*U%JOYAwO#|kU6$oumk~q(3 zZdRBmU0E~9e2paYHIU5LOfo;+97*OYiD{6G4V%pMji#BC2GF)EujCCg&4p2GY%*p{ zZ-{GNQ|8&8mB&Vq&9C`<3gddi%>Qf6HV1Uz`nAJcrmw zt{LI97Eo6k-vA~2?E{o>A1L8IiO`y_DdE%;K61i+;DqyBQ%QOuUvR>Gh?n@16TSjY zxKQlJCEPI04wq$OxYCd@8=FSJ%y6ZQcrFD<4G(}C9w0RwT`JW8so^0|!$YKohd>Pv zff^nnH9SOWc*xZ72&mx^Qo|#rhDSgRkB}N3AvHWgYIuay@Cd2l5mLj~unadq4Zr7! z(A;oFf*igx ztL&K`z8CcH80q0L(!*mx508-^9y2|>8t)@si!t!SWB9sI%pF{d1wT9%{O}n0;R*A@ zmB@~oD@5%L3-CDM?>QvM5l@gKo&ZNYL5_HW9PtD>;t6uZ6X1v^z!6UbM?4W<6-oqS zJQ0lXL@>q^WQ^Af#1l_!Q;%pPkgQ@W&{qQ8AR@~6X>z2DLygE8PmnX7B4<2B&Ung! zqN=9;u>Jzlc#5R)6iDMKkj7IWji*2wPa!^(0%<%2(s+ub@l24$Ga!xE3P796Oj5`* zq>yJwABa1x8I8u%*@*G*@Ik3oc zV3Fs7Mb5uetLDfe&pE18&kGhgt6HFu-vW*N7HQq1WlivO$!iZ=y%_z3Z8-@(rUJ${1t&vRtBsNw05a8CdF4++03O|H44 zrnq3n-j8uk__v-6{=sK~fAD$VN7dO<`Va5?tOOr+$oGFKhvJuV$oJ26toO0E+ZW_2 zdOF(s*KxG>(|O)}p7)P+gm+<=H=6B^+33=Ye>%wf=^*cq`yg-io-?v3f2k*V^JjT} z!jrs@_LgN?tV$m{%ez*b`4c z7gqU#?o_x3MO&H? z5ZzA|t@v016jdFdptbivOyUM) z6z*V4LK>kTA)0VR)SP2%fdu+{(F8aw;4>wzC8EkdG`3KDy#{8khT|zd<+BoeSe)TM zmLu}x#2LONoFJkEe@rysI~@K$zK{RI{Q4iC_x{h;VUHgA$DHyHJK~LTV^~h-@9%oo zu5}V*-{M+FXZj;f^Y8B`{~3MbNBU3aym`^$?cayG$e+C6k9fh=W*nT`-|hr|(C_`h zzU{}{*+odVdveqybQaj7{_H=E3%hQ6Q~2uA4{}U%8FWnlIKJrb>3*&*`vVe+k9(O5 z&_eK_o7qtU2VKA4=1u-M{l_2bF@DTR{Fq<(kMRY|9joyDzUS_>Ama!5aeuI{_Cvh0 zzZM7VFWKc<0QQk;cWdeQ)BaZ8P5cD@R_RqO{HQ0!GnM>{vUKe4qwG%P|Lxtye;6P3 zhc7cf*+y~pzUoE%-bxu z-Q7M?&qF1!o`>?^tLL9QKhITud`RC!n{Dt&W&ikSF{tsMA1(A=wg16M57{BP-tPP_ z_tDOe4;w$rqx8Yb|M@!#Llb`Y9Yx=3$lp7Dx;?0C`tOG-|GNhYK!yMKK=yl;{M(ry zsQ=Yy>{Ji=57zS!50`!NT8 zK42k_tBUeQglstIa~icy$WofqAV{Y^gFlOvv%IIr@l$0{zn4{P=N@R&uwok~`Rb%3 z`&q&hd1Zf0xB`9;I9YT})OR&2$j|3fOCQ2fBmbgMSgAiYW$>~s<44MHUfwv(#+MawxHdnuMB! zDYb-J_^`dOv8LmG1ddF`lyJ-b2%*iR^)B*IWI4{oc2@g6aUTMEm{3c0tK_aW_~YVx z^?1AyevAjFk{Bsmh7I)w8VUNDcQwEEI%7o+K-#j;DMbD`(jHh_|TYXkO7$?fiHV%)DA6AdA4bi%7-WteESY6acirdudcq_ zVGwYa$;_wWMpgE{)NdD3UDuY;!v2Y(fwdDUAK<9-l{SY{1rUPPd>iRZ$E^ENEM^)q10% zvAfIIIhNn#kn~k+w-mL>P5d^K3uhO5JbZWA%Z6MY9G4&<%?G#q?U(xlm-Ta_7;?LR zx2OEV?Wd!+5A4egb+vM>UswjNKv9bzFVaJv8Outz#v4RKBJ#RJYMQxhM91+Eew$u$ zUh_n)5}PAVo;|H!e53bBp$DUYhQ^};BL;1Yl_;`k#M8&P zYp#{iGJfwEX(QY3#oS|S_tGlsl&!se@S^yMomnJ#7JuD=E~ca6jvMx4XMEN%a@vi< zglPw(@e{`mb`}+%iP!5ab7mccFBc;Z*9so8i*)vruB+qIqOaI8$d4$GZa&z7>-#M7 zVA#=I>8lz1uy3?@ENW+?ewM{{*EMcC{8@7|V0!#_7-buH5D%6aUVEEpqLc9bw0)!o zjy(@TB>bE8<|=r^!v-*yc`C$a!>|%}UnACyTj#eb(_J;d)rp``6R`kkYuhgDS@}(R zIo5-GhBqxx)8m4ig^R@10$WgJIFx4$&(PkLlH{7d#Ykm1L`^*Y zvsL%^`67P*ocMiS13rU_*}#nuu1PiyCN1xKdq`TRfyOZf4c~#jK6p^f`20z;H-Ss9 zS{0HNMui%Lad=+_-KD4=GR!7i07>$)8&y>~L9ZL8hCMqH4>-n6$B4(ALWFC*#{IfN zG~dwit;q5Ij3l?!*BAw31F)^wUZ>O>vq`o9F|n#^qn!Km@fAr0myo2tH&;}ypWrQ+ zss=b<+hm0h?^aYQGlm%yFUAYUSPy!yLQbUZzVc9(3Jd3#(ok_oB3DZLaG4{Vxka0U z&_!`oC9+%S!TwHGVWBJ^cw03W63kyEM49zolE!~p1pNF>)nA+#J0U`R^$D2_JG+?2 zIfYLptG=a|p%TYJt52X_xVvHXz?@yZsnNec;MJDD`{%TK(f}Kto`~E}6S4FXV5!%F z6{QFG5lJH84HP_sc-s|lx^NfKCOpVqyCu{fPw@s3YnewF z+n#-x?50=Y;DEc1Y%1i9Eo9D0E~IU&m~gv`7=# z=bIPKBErM@Xn$x1`@ePa*Eq!&G^0z*jBMoFn8;nVwW4KG_9UzvYsJ4)mO>$SGha2+#dW?^qLE8}#M9A18%wB#=)H@go62BYnq=!`6s zUcOX3SrYP8|?+-5q0#&GI^S`F14T%{<< z6|E`-1D1ys^od(_pKlTc;eLy{>f?ueWj;mtO67A0xFv~;FT~0bP-s`3 zu9I0tCC97@M`oSo3ak+w&NzrY0b@7X8kx^Ecb3e~#^6(u-GM&iS!DQQ{tVrv#2X=0 zuY9e6S-AI+?RTcR{%Fu$Ln0ldAKQuHpvKrFSEmF0pQnpZh=$nCkof5ObMR(G@<`g` zM|3NRp$IrdP1&`&pj7X@U@d>iJAR*Do}PDd`^TO50TRoGqJ`MO42Ym}duqI6j#Uw^ zqaJ92|6Z|A_g!E+w2)HwvS*%Tf(F!UU>((6d!NFXq9&Q1@=g;^!?TedRe5G@gUV8> z>RUZ*&siT`1j#!XvAm=$UciJJFvG^nUR=4g6@-M!$7*GOhsw>~VuNFR1R}d`cFeu` zq}J%o$BJn;7Zt|Iya02|G?<6;VYvQ4#+JrD(ii$#OnjO5Eyi{jr$JvV;EATg<(=jF z+8n0$gs+ZDDVD(f|Jp8!?ZLO^9c=KsrYrvZou-*y z)CS;+?C}xFOEg^(2zC=;ru#~gLZgv-Pm03gLCRuH4q>$>50{)8I%ftlL1FBQT2gX& z4|mmcVlxM1IYYco?jD)82BvUS>(jFhlif0152p+svrnWbh9r!DP@Zh`3BSS;}hJ2eQRt*SNmLxo#9GeeCq^aA=EIH4zk)ln26q)#;X#AczV zPR3yfnjG`3bDX?0ky$O>fXg3vS6~w+tJt_}_VU`Pha?`hp3qg21JOxqwGWXrfPyEE zdB==tw_D-#(NZH2(x5e>s{YCZl}b2>z9s+&>sjI!|EO@@Z>9ta}Jh+#+k;~B$ZL7pc6c{Ydwqx(x=-iW-VGEza9Yg7=O zhH%CK8a6X;SJcq~yUJozjo0Jb+H8VVJw>+*0FH5bJUbD!p0+#YEX+K{&F=Mb2 zE)uyd(9giQjHqWYCe5C$D!a*!ys5~oY$qc~pdgABtVL98{g`44`%ppQp{ayK!PhDIlU zC>@r;#X3}I5CGW@fM=8s)tWAWhpUym8OKA3f%}jk%-%}gXlDNwWBhA**G>2emB!)w z*imh|Y}79WuV|u)L_5M4qbCimTjem{WfyOQ%V{oWEvQgH>tH|7Tr$_wVTZvCn!nTb z{Hq+g50hLLf5Xoe_a3Xt@>pJzB4H%}XesbY?+~g&;#q5L?m5~7nI^qv)=~*;Cnd2) zx-t(0o?ZKAm8vx9cBxRLd380l=R^o+ccw)*5) zH#2+Sk7_bcNHf9}*GLa30*~wE)I3&juUNS2fcn`?(u(1THcLmH43HvH{_jpFXT3i( zY!or@UA-#>H~I||%~`o|Aid02{Ggvl<#NFUOh*mr?`9$mwg zIG_lHk7RWnW0sT6HktGE%RE;mB)0i<<4EU*Z@BPo?Y5c217&rb;s`YNyW7zs+NI?o z#+!Ui-ZBQSfANdQ3W@1dN%G27QtQ-uL(BiJ>lPf#Cl@qlk)&C4V_}v@gY_7q76H_s zaO;q2<6910r#`(sCx(g1P^cjlAccnspn@^D4y7{>gucJq)I(sT83;-bdF^6c<9W@c zL^#Qo9*yrT#6xCazN$omR4^x*j?)|jchnB^j zv|@Eq4ZjX#5>@Rmu8#)AyTq(B1@R2!_TgpR`_k>+n%=!>j6Yii-^eh=-UB1Ji*RRR zaeupu(iCGxMW$`$#dJ}{2}IXWAR>Lho6<^!K=Kd*Ne~4Xu&8v~I%cGz=%NG&LwiN& zyo-LEB5#GAnI+pz;MQ7wm%~Fn+O6XV*+eV)6JA!8{LhShSacXc3Ro#)B z{Fm#uinzGa50PHX1LQI}&}rQ~z{fPNX2dCb$oC zpOU=Hq#y$IgZbEd8OOMWkdhc$Z?oH%IE;c-`AEK~BA681qU4dH5Qy1D+E*MLU#Vf4 z@4Rv8p`k#3u*SiZ{s$d3(iA*pFjPvr#-dVYn2LCsvPP%GAeb;;Evz09sg`UvY`Tq% zPEbGvlj(GZhko3X#FOq>lhnK-W%_~_Pw-^tZEwG~C#QdAa&3Ta_kczrsx^L19xDLv zD>dvCM@udYm+v`SPh|<0ciTcEdV{2EDx2J!5S&D{vKNRuMgJ|1s_)I;xqItV^)m#0 zrSGe2-=HP4oKuR4+-ro%e*saI0Pe(PlBtqO`Kw~^fE{c6Rx@r|&`oNYfqh}Q2*E%1 zgE5A>2|$uyB8IS&O&asHN?)3T#apK0UJ z;(a7yPAu8!lzIKo3bv;QEPs>J*QfYwhrs^{bAOjF8mmGjJQV-9yIZ}RCriye3*c^0 z8%9l4Tm8h~=f)i8qwz&E#9&2a*N`$vh|)u7z3!QDZtPLMk8|YoYJ=C!RiNAc+mZc~ zmgF$^H{Qf;N0Shq_rVv6XXEdE5qBe75jt%BT0(us#JZG=mTmmFCi0Mc=_$~@)S84O zul{JUNH8eyD2)!cwp;P0=1qKV3*F!BRPI5YFE_Id_;chs%F*3MPi8U#JZs3dTHo_v z>Fs_5NNlGS`B%w5I-cVQ)RYpsbhE-ImDx;BKdyZ8Bh{~(Bx}X_fGn3cfPqld5g3Jy zjq?kwfT~)Ud;-tl7b0mM<3RrHplsfd62aZ^Id8U?M#)htqU(y6bWt$}#wkysUHNj*s>&ZP8Qhic zI`-tyu{2jocl+6~MNK`v?s;F?5&(BWK_$IX2iX0g9GlEe$V*j!)~S@nyA6u8qYD1| zRns)wP>nvvMWK{ORvl%9ElZn270u?G=1OaPv#ZIe#OID`4%d z14d;ZT%M7<_d38&rfA(TEs_(+#W9jtzB4I8d>-J0K5^kY&N4-InDUV-xZyZkG0(+6 z?Etomr4a8AMp~@?x_8a~aQt+DdDxWif*UfFJ{}6DA5zbaud`jxVuYeZ2D++pOnHDO zwDF5*HqxUAOf2z@{TM>%(7K}imnX`#eQTpKLOUkDPe}-@?cNNeL2%N_&={Ok`BIM- zQK1Oz5+qUd{@VRd*nfE6wiO5I4xoztQh}7^`&-aj%dUiFA?Y`uU^T+97X1cpMKZqZ z{rPiDJ4bE4h3F#D%cY%Z1S(f3n3)3=>`qO_&4mM2rLWT!Nb6LVjj{&7Ow+ijnlf$T zpO2A_}?w^tRTtsA5>uT}rQ&7~P>69?A7) z(fb@SscNtU)w(GT)*ojJcSefMS3tDBek|@h{+cY{g3_0%l<5;wU#A|bVG&KXNa0QS z-~$CYV<={FDUt`zn5M4>zUqFFBZmn%woZr?7%B<;p%g3F?l8N2<5{X6*n2Qq4iNC9wvW3?1dS%{-_ysL{z<&9azkJ>A_WAGksniU2{C@ zVG76JlU!Uo@;W;BNg6(1pL-~W2J)t`l;nIhnPQM1K6}aBE@m67H5Q{ikCV{IJ<=7` z12}`0lkE`)_YPmsei(e}?$8)MRUG%w?pDsm(7e1#Z7k*)9a`S1F zXH2H6+XypL{^0-~=soE7X}0}&Kv;-MkzKJ|Rm*bVwQJ4oG<)THlltu5b-1mC#?7%( zm?BqOVHdgT3_BL88F+k~v2@kSax|f=?G!}EL@QF`O!{Wo+?IKS7yRumr?)Njt0lWUPr*ODJLVAe^WD&Z-a?+!76lH#&v8$Q0(tv=L+1Z8nn!NCRA zCeVpr!~?RsBzCcK`pUzcl5z})-3DT^tfQiVP2=7gvu-VD+94vWgW{y)FIaIU46B8q zlnkdMbMN>Ia&2##^ck!7PFT_9W*qb~@1$*VT+%#O=qp6IQxgh_QVVAu?9_I}Q-3@? zqc#ngW{Y~VjJgPLw1Yy?Ur*>>vl&9@=GOVg7=*J)=+$j z_8uj{%TY1Fmx-#!z-8Eos(tOxATH3iw|L4<7@1DWKE&4a38^&*We|OHUydM*Oo$%VUsOPMRTl@>{ z|6u9e@+a=si3cg}fP@{H`=0$*5B zT3_oQLrYi%WXOZO@MuGZ zBX|k4k$hEv>)ihUfl3?cE)KVMO12dV$=8D&eZ81x?h#-5{>Ukw>=*mMORl35lB){? zIwgh+5Yu=iVga)v4~_2}t0eTLY~h)uJ?U&9Nzcqje99r`aqFSoA|m%0-7bv%;?DWI z&Wcv_Rwn*nOFC0Gqs#?6ZJe^(Ide$RSQ6KYEP2Io(&Z3EEY4$yOcUONtYVBA4`kDq zH+8_B?S{ca%wqf^f_s=?h*F*O|DojX6|P}|eoA#R4>9ZUi*%l0Bcgt?be@mCqusC5 z8_v)_r85Tyf`p)IKk0QT>35HzvFSmYOx80O{|-7A>6(MuazyH6x?VW-ek6ntN6PG)Du?VVVO)={gkU>k8WOb7CY~u?z=Uiaye82m2>$HbQhx^ zxB$g&IW(h7w(209z2dt}m>%IJkJleCU3_g1T_W2^FWMyvI3hSfjOvCnj#1{OYUlbv z2+bj;HIlh)EYs`bLhMxMS7BGzVfv&{Kl9ZHE=}cOEomJYyCDcVwjRDD(>>%1^p(U8qpd1l8U^gqg#%vzx(+@*wvx9^=b?Ry0eW#WTq}up^7NN|6C0>M- z9f5C-tNxLLb>W}iZy^IIDH0grP?2cFJ&Y|*@&-e1XVqCF7cIs`cuCNN#OPuCL{;Vl93qt~`%?!J^$V{L7!Ou!Z z*NFna^b?i|0V9lg;iQ#JjR~WrI0x*LHM$Dpm0eaOrnEoG#hv-4%CFjRR?3biy_Oes zt={c7fi2R`QdA3R@{Cob`d!t51!Adyk#kvFsbS#1iYOT+jQx|jnmH=x=rp- zJTl8TWxMSGXdhIXmtf@zT^<*El*vnse&)hP&-94vWyUxL#dnSJ*H+K>XLI7{T!J}Y zWx}6sV!4qFNu_VX#xF(_gyf}F*qOXKY3dWhG=?$dz?`IBoeVP9${ft-p?W$6iSP)r?tRx<*nyA%3!w<3-HAlwpFGp+uT*MXzxztLY)?&T`< zW8NnaoTmB4!i6^wHzIfkgN^%hYkt?U;lm=MRHhbmq^zPats^{`%Vy3~G+@$7SQQ*Z z{C^Rn0i##KN(S#srFLzcwgFvDbLK?=tIPiZt>> zkCb+1^bmjF{{0Q+Ptg_WRE0eLzDfrh%+s)0zF2qm@(Aj}54D(|7WyXAFJRh3IO@z2 zV$#8_xWC**iz_?i5DRVY-b5$78{i$qg9GKoN+~b?2PSzj`oC}+;2pw)FX%_|43WY~ zEyXMoE)sZ#{(iP%hnqjkH`&DK*IVx^N7XPRjo#UNmnEc;Guw)l=3nH$8}b+>gL7+? zDIMY*a!QfIneD}1mtEwi40-$o`d?g>{143bo#tg1VJSm-L?NoyeazdapHfKDrA)an z{2m@tCeml5%bIEt`zb=V87)$?5@eHl zbhMR6={UK+%&@Q$3x6?`qL;uWzYm=r!AX}3mflqPninUBjkz9mG2%*leC>KO@xBHv zzK4(kzUo)IQc8H{8qnnH)i`%nqJ8`9>7IHcu}STJ6YDXUeACjgj`-Y@O#A|d|TNF*4DMHUiR28p|CBwGtM244jr7;lU003dfgRG_FKtwDXJfQ$YqRyM!>gyJAyxbLc4rca zrCmkvtD&pT7Y%t|eebrp(_7E4IK0pIG-rF^of604or3{C`pW-w7j7pO?cCEBZU;5B zfMAlk4>Ja<6NhZBxDN1WzxQLX&Wyh6iF_NeqMfGz@i7Y3=n`4%lVI`jC7XR@k@3gR zTOCHjTOEBDzXOAP@=7G0?^lLTW`v)$4!-kt_Q3bNSvgVeAVJ(WX{|!S4m(AwW`FLj zijLPvf}0b6ZU$*N&1;?qzt3~N_4>0{OU1fj`*hvs(hh z>3|X3i0OsRT|u7(5AQ|iIh9k3POtKOyReEXk4e;t>G_{8ze}xE-clb2njJSzc<=S7 zZx$4t&IfA_-Ir#(TnZAtQoXwqBz%&SeqOx2Ix#g)dkLz(>0Q q$(??}klJ<1i`^TE_nn~6hiBBB5C>7=d)NElJx5smK8x812>%B{Ga*(0 From 582601f6bde21e5dcb15c942ac06c59a6d6a46f2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:39:39 -0400 Subject: [PATCH 219/503] add chicken ensembl ids --- data/ensembl_mito_id.rda | Bin 973 -> 1082 bytes data/ensembl_ribo_id.rda | Bin 9870 -> 11588 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/data/ensembl_mito_id.rda b/data/ensembl_mito_id.rda index 5bceee7286674e3c4b45104156a6131d6cdc5db5..f38e5dce561caf0fc05d14f67288699944578aaa 100644 GIT binary patch literal 1082 zcmV-A1jYLwiwFP!0000019h3nZzDw%hnp-KF&qZLg+<~7+>okXb#2E%VZs3qQie!# zvzlN9OI}8H!k>?*PCTZ|^}dWeN#5_RUsZLteHBLj~NJTmaez#{{X3_LRM$iO25 zj|@CA2*@A+1D|;n0x}55ARvQ)3<7t63<5HU$ROfAh;nk0UlosMS*$U~O*b{$-fL!K zVpPpZTC>TT+2&Nfv?L{sZdOZLtLBc!bv^OclZbA1UN!f6gU1U;J*8>QqxbQ^o|x4n zQJM0|JG5p=;@jcJPI9}J#hjhK3_%|UhL75ml9fe!T6v}KF^O(YI>Fo$98oE`i#cR{ zEwj!WHUuRJ%1!d>_08e%rE;w|x+1Z<2v3xAxb zCiPe+L$-)@dSih>b`T>mQ5`FKOmNu%16yBer*yp4l`$L5W4%64iLpA-QQ;VYuA|3E zt-d~G?+DIgY42nU`%NOmq;mFYUkjXtQb&-100ZZM&KLs>%F`MV?W0#t^3B`d4<63O zs{4sz`j}Kj3O=hUy-U>t!z7#7YOZOWP(7ed>o}v=apif=Lmi2FHfKv1)Cn;{o$R1% z2_{1whjp@t-gF`{{L1f?X?vz3)g5L2FMY2}q0c>F@+5i?P-UUAUbn&N=*HBu{v}8$CLcy!Q-K76 z*P2Wdm>N?&ZtF?<*2}iJj^}O?*yf79^@^>@wt>w+Axdj%NQB(>mD=>FX*HTAFq$SX z8fBoiuiSQ@6kc^M36g!AD=ACcAdE%{Y+F4Zg-KwGFe-bZ2@FZug^HJAipo7|HoHB( z-F3;55*;al6~SyhDj1V6CU7=GO8rNNDkfnaq~o#c`t5r)kH>7>0nQV-4#yyaglihH z>wwt;Ps)2IV+W`tWZ+Q=$U33oald))8uw1(9gjr4_OyBZ`nS=;K6?o&4wW7ik4iu# zqLNU_q*U*JYQ>_03@kFR$iN~4iwrC>u*kq713?CY3)LV6RA3-K?agY)s7~0 z&t7xbJdwYrv91!GyAO{3FAjknh4hV8UkOP7o5afU$2N7}* z0SAaBp=O*xY5OGNNZK!yzT3bw(i8~Vo$0#=m~C59A%ZJ7I)g)h20UWPFSh(K|9uB zmmJl_cbVk6mm4F&=^ ziONNC@bO}^d`ZsrMn@bMC*d9<;{*^>URe8aOmQLlk3^p`0UK)*h!Z`^+N1#EWZ;cq zoM0^AAbVirIH5S!={C`4130kdskYA!Ssm%Tp?WOo^@xqt8SM~k<3QF-uu`k{M`p*t zdMuiqY{9%a1~y4{AI-G`yC88K&nJRgvIRal_E_=4??{KTa%eQ2TMb(c^fzpCb^*vF^=VF#~ZTGl-Kt$l67dK^za` zWCFPb=K)^A6-@4IxI^z|Ijs z9D%tOMx$;c++aonnh-HUJBPN!l#h$W&V|QKe!tOpdiLpdE?0Ls*T-EE8()h|Wtb`v zZ^ydlzSgp}ukGIT3~OIZwHDVRTN_pdMRv8QVj|``uT;BFRjO<%LpGHm8>OH+uUu!J z6uwGdF1k#$ucWlLqL7VZSf{#Og`QzeAuBUc8OEecp`xXTSh+?GhgaLjU7svM*druj z#6fQXBG4v5n~1#`gp@BG3Y!GuKz0abT|T}S^$_%iGl2Clj)QF=2MP9+Vb&3Pi?~ue zI~isGkpwv)h(ySBf(XHRBb+syorEVIGD@`b4)$o?&c>_FdLM6uuZH)l(d>S8b3g6A zbZ=)juWBC^zAk2q(W6IcVpT#b`NR%5MdKbJ4EX;(NYW{vO{>ZuBs32g}83 varbL7ZAY{5w4E<*+tqr!)O24D+Z*|jw5Q^_EmfN4Pj~zUCEEVloE888h;_s5 diff --git a/data/ensembl_ribo_id.rda b/data/ensembl_ribo_id.rda index cfdd93a641950d768cef1cd360cbb7ddbf98555d..faaf09c301986c47c7f73a7ad12f933ba0e82927 100644 GIT binary patch delta 11529 zcmV+kE%wrmO~hJ%ABzY80000000VuUOV4IUamQZ_D1aM;m2@XV2 z3=#y1MI>wNjLbx~2iXwup|Z^9i&FJ^<~^6^_m8dd<@9sP9i=En5)EGRGN8&4ji%oOm71(saVS~LXxlnB?PHsy6v{`wi&!#ZZ zw&3I;G5EBD8co1@jKQ-73)zBO2Gt8X^_Wd?ms$nQ^$^YsgE4&ZPDk(x!ADz}Ok$_S zx7?{S_O@7n;30c(;_n39s<6#k90JeQb}fR3q-YX28U~$s zXDMD4#~`$gfT_@XQ|VJ{6Id0@MR2~Ld2w<(#3|EHaBBsfsWdzHE@XY66=QGA)_++t zl^#Z$ve9Q_3T|^LO=xz8K}b^*oP5m6axRuIghsrpE1np-vRGSN;yZnB#dqc!4C@)n zps-H^24dB7DH%LnSOuYLu(g}BNn2BJm;8>}PaCdqN65yIfK$MFhRGu6rwiInnZ>$g zSUIC88NAsJ4tx_Hne-6|-_xkdhkp{9!x9qRmy%2hdvgU!HqIt=my}FWM-mva%2KpY zi_%A9Z9-R`Mc`=2dKW&Sx`a*+JqI_ybAwlXv@l`4ap$BQ`Fkh$0SZ6v_A1pQ6sfTFKAId)qlVp0qdr` z9?e4Y!s{vguz$;@I)yr$pn7*1m)SxO31doeinf*Ix?I2@bX#FfB}BzL zTli2CI>NIZMuyU1cNMS>ZaDqzzg@u4U=7xsdRR_q~8VSoEjlBsq+u#0TR?P{DWr@S-n*)S3OUq>Kr>aR-VB-+J&JaSGj(cV(z7gM_H?WEJIg4=NF` z4tc7wCc*+!_D>W1Ex#lzqpfgfn6W-;8HN+yB3lBl%ibdT5)zpCPUaE_ug8`#{$Le? zSGC%N4%>#(DS!6b!piAuDZA0Spaox(F+Oct5y9$QKKNCH*ea*BP`RVy>C*qE>Cf`dCeH<$Om(9+LMe?^jXKX(n{b zu#lxyP(+qN3m7QBrL+zMcSQb9ABq|!PYijXGQ8SU_J2Z%IrW_-V7*l?LBNQR6eEL&PtWGn@52Xi{q@VX&vUQC z5<35S9)H2?^W$!t=dQ4wI*we&(_`zs(n>->tOS$NaFVtjKWSbMSK#H>yU=!8UyqwN zn>2~d6Pvhf{_ve&LFKfaw&@t^-Ww)qse8fWd89mE4y_sd+WOjX#MX{D!R3<%=#%-= zbPR!0GEh~adWK?}%{*P%k3cX^6{ zoPXC{CZT3Xj832$N0Gz@PfCZCjJ1i1N4m{UXun;(088_la4p9be zzBHC;eG>%xk!5%jbwu0+7ubTU6E(Cxkbfy53ybZbytG2hw56aYz*gE$&GdU@kI0c* zBTcC-=4_$+(pd&CAYLVez#ig=34IbZX(b^6QI%ujo(u82uzu28BmO;xBfJNqPqJ!M zopC$e2){$!Le{$sCn*aF&`^~N_Q;={n;^efY{(uf>-O>Mg802jn}3OIA_1O~#V`DO6AlKn2?v9;QQZp0ftCQ7w24*B zlx(9G<^z>@HffWC(*kE97M99A3orU)Xcq9;e4rtDN-n;@q=F4-Z5@dumq}PQ6hlMO z8~J8}pP*VECrs+?a@jpt2)OcLfzuai|u=3RNK%<UYy7^l^OV?6=c-Gze(}) zf*uhs=)?1h>@gTyr*&H;{0^iiOTZgCrg}FLqn;jPn!6G|iL)fy*+Jca_OTKqlD+HW zx^1MQ2pHQ3?J_KJ^vY!ngH|%ox4xZ>y+AcIv3!#Loh+6hXa+cFzJDwEPdsEGiVU7R z256U=H-x_?h_qLx4@4h+sl)+AJ?)9CYG7fygBO-3MCe0axUj1CKbfT5%v!mhH(<)i$&C!_=07ROv z=;H{jprX9wWAI6aWXw&fg}07g=iojlU>Zf5;*&&|z4LZPBF_0GKW@P<`2q1FZbE2+!Y6NgQV*I36WHSwaUD=9mjeiI*bO_jdP*f#D(i52x zg6OYmC}1)sK*(n31&wthTX!_EVu2W?4U9m*E~cGHCT$QmX^(wX^7UroEh;&MR3bNw zVx?w^;giaoZJ|CWLXW$W!y)u1lH6{cLSZJNL4j1bZf8b4SOT&VZ-b1F(0Y-D#pEdG z4OGyQwVH(Xr+@AoR|$whHxru?f<&&NPlGd~WbPnxwoMqDl@%lyLsLThE-30wm3CJ? zNCsKhiv-xfDiU?UH8I^_G{UM(07QQk`W^!&==^U3(B4*NrqD`IjAncuV~p${>`r0i zSU33!LZxJ_pb#}Y`&D3<%g7oHdyJiRjjZV4)8qx6hJSvxIxvZ)RrXqJ6kg_y1p2c} zgnqqf-SyOQ=`6g4iFlegON<&iy7M#ih%qnJ2Scp_+cggXGhvz|NmV57%BY#zElI$N z?&a1N=Cg%5h}6LT!CpyQZ)tZTNg+&HB`R))0oGP9Pbmc;dz~>KVl4CzhD3+tn;Fsw zgBGYMjejzbxI^fo$iRe+EG9?y1SV|sH85~CowWjIeXtXoiBHm@`KdX`MTe-Uvz11k z_*5#%K-fr^*@_Uw|Attdjqa3J5LyA*^T9UIo==UC1k7Z+ft0gYNk{+pFb=RXk!&Nu z7#xq3_&FP${BD@ll*R|byOGdsyBq3N9ZlMb&VT4EQ~|)wvdKsd{6?kH$utZ(KghS9 zlb{Y!X*&TEJmO%Gh$p1mhcQur8Y~l!Afyx$16`>VxqX%Zv2HIMnB;AlHj&b75l8mS zUwT}37SAAuU{!8cbWD}a)<5SdRdkeObOJ-vXmfVM3{w$_~uQjw!MmEVLHpv5tO-tg4~~lJSvh3;XRUPLef% z7+~!#LItR;*FlbwP{P>%UD&;hX%fklP=D?;oTN>P&-YC{)>fT(^2YJ`ZYTtbGatmn zOxu+{X`B3PNoU~Wczz6k9TjuSM{Q($H$!sHetg)SS+;PHxwmYD*mnHEmC zL!sN;DbXbR`l4R7&_BpoP41njk!6C>%Fs#e)v|*5cqb=o=GX;zw7*;fGK5P;)5HhI=+4>;IYgjO3y9RNS1G)K9<*n#n<|tuG301%E)!HZe0J?*qF`9fH&I@PCLoM>{1tA~L7yRE%F{`Vv}4Y)DSb%n0+B^N}k?4b$sI zls1tg2Y-Z#Nxw3Lc0 ztZfQ$*bMfKbE7%&e1FRq9U7LZ2B<(Y4Si^VsIzHYmf4VTWQzoh{i6aE?1YtJ%7n?N zI0nlXmfp06zTV8^zRR0ycM4{PNC4L^e((Ze&QN`iR+BsBVQwL$lMIRM7Mi zaUKV$iRS2Aug(Rz*|HUXjrC~_Gw7`~ieF|!HLhUARs+r|Q8vwZg zYI#K>DWcGF<9`v)iCL+AkdB;DHuT|bPIj8;{2vROOq_0ty>d48Kw(vH5ES|~OXEy* zu6O0EkIeSvSTrkVo#TM$x6eKcNb^{{6fi;KqhW?|hPl}nhQ=N@?`j2C(kjMALyJe+ zX#>4-j;Rc>66E%)5H$p6L%^2F4J^!_vi~aBgm7g|pu<0-V8oOgyF#UY5ro zN1j--7k?{3+9@5`V;yAu*M>QMnZS!(8JKbO%Gu%#yU-0X+@E`^;4xr`I&n;pY_ej3(B4kh5S<@Ss>sRYVD8#FL?=W-Hsk!kP*}07z74dw_axUxNF!1~ zgU51PD=xj6Sb`X+i7h4+a*<1#@kFv?IE_VmIciBO<0y~8;^@1iupF%Vxc0F~+N zSms@bLm2mx>;===Gb4~25Ru$*Y=8Qj7X)G5k#YW@q*OO-=IYC_+f`Np5o%&pZ?>huiy$lUVk8)w1&}% zAV4g)YnXzO9l%851JgWm`w*j?qm4Gnz)mco_^Ap%@t8`3TW5!w$e!Rvnj6zQvb_j* z%w*Tz#73Hq-SdKjajSuWg=j*X2_+e08J#K)cp|v#vXOSTk{yvk;JRc*iv5DpU(B zUdmiKP9g`jJn&?2r3FUZvltQ?2lvBE%Yo1yyVGPA8SaubC6N|x*ds7AqqzYQIx{+V zinE4gnGKbNtWv_*KN<+3$&sTZgSV*U6mpT7W0quQ>SFH+N-ldAFn=hemZ(zV_6wU5 zc(VeEwE}Xh^n&R$&h16qIhA2^nuI&Gp$Q|1#Ap}Uw8naDtC&`}u%&*s!$o*=&cYlR z7+xqcJbNS{Qv!jWow2bKdBe`{*`k}P2f1afp?*>@AmXR1Ax{hRj&dh#DGFBw`rs$C zffY$WEE7z-9bHYL=YJ8pX+8b<$V^GM?*(tb2*8pyGmP6WI3~q;nz{tR$()VFQNdjP zm>a7e4V|NLWJnE-w_|JrqQ}oN$%bVbs&X#!eaLP2T#$=If;XjfV>77X0y9v_P4$Q) zTf@!?`Islck_x_HBAuh?XTxx8VioFajqeJ>jFQAyRN}?0PJa{29zx|uOLt;t>_S!R zd8IL1bxzsK&Yj}2;S+Lut`#q=%`|k8nR7}&$a(O}<+WJclnK|pvGUfq7qIh1fNrAe z-#`d%wl9N@Ss7+VjkgbEsW>P0U>cBdiqXc1WXrCos1gZ31SU^np}dXQJ7>INuj`7r z{8>Uyg0W%lZGY#>%u?p^HH~~L2&S{=Bse$Tk&}WOl5E?=1cK~yLaeu8JyU?4ReVq=YMA=BeBPV$=I{dMVFSHc8N#^W~+q4f$q1(t)z$0eXzT4HoK&vltFDH zf}XH6IP4m*>TF_n-@GRk4{cDEO&O(;NgK8i);Dk{EHqFCRU?^J%fx=vV__jNTmRXs zi9dotyiggV0)j&X@?;rpU@$10_bMpM{bn2=O3Z{3`)1YZs5 zvS5OG_He*M8)%_#Twtsli)oTh;B@N5REEx-gI8fH9?0!C;~@7<44TJwa}#gn%ZBwV zbdjxZ>}nZ^iI)i%w2NzDL$YAFDqwK*a^39kV+(-u94%76@-jc`4JdkRh9q;QfH;`UsiE zIJmGv#CbanbDgKkufiVPjqg>dBIUeelc2mQoHKZ^UH``0Od8iW)PeUMg`Q1TU0#UJ zkAK-{!jhrd(IBgQl}p{6^x08I4&{vLlK4rW>p(```AQVSRxz!rlygj^>a@#La(DD+OqaeR+NGnzSoGJl3^LMVzCpBajPEoo z-;Kv?Um|;K;*QFO+DxWHVm(R0f&h^T<9`?gZ6ZgzVU~NW8Z|ubDj#%-#gIc>{z-=9 zb6p*glw%+5Ff!P+$C14)sCY9AMR>p-N=p zqO|O+4uBO`53_SL{cId>z`PmGfl99-_mV`nVKy{}$A(vQWRg3s8*31jSByR{}Z#idAm(e1;a6^ zf?XdO=SE3FH=@}vD%VIY3=5zKvY9e40F_n-m#3pi8}pF8!wJ)sd%1`1gMR_PUP)et z9N~r`6u%5}$Ixh+-14w;ACV?%msyqTRGFBK(gD9Mh@P7)8!XV4BQu>HgU*>2hD|*> zb{89qNUE~0Ap19CP!1X1tz}pvxeUvt!&oLsvV0OTydHJ?^Q7C zV;hDwgZB_M#Jb61+=j_~@tAUnHV6FHa?)lN_qvYlkO~@elOr%5lYbH)kJ;~oEu8Y# z1QVwQ7I8X;N8GX1?lx+Wn2$*ohh|SC6^|JvsGO~iw`HynFmw#v5C=QjmoW)R?p@I? z4k^XdfOp#miI63bof_ejA&jsCZ$&dG6ToniO4)BgBxI+pihiHPS3u5%wOEVGzZReT z;wD&&E6$S8=y79N%zusV;xV0kUIzyYjF~C-b}qbGY&v>xr(@C8oP|8v0a!%)iY>EN zMg3$sdJ_XrO^LbH7pg6@^G%$13|SwFmBXkTKH z@@#m?caj6c1j}P8_uXoE+gcc@T>gcH3~iv?$u_5iCyv(!KDQJkv^R8pG_<(`-lX-` zIk4l}z$BKuMSp`k^I^9X!_?Nv2?U8Ja13Q|Dc|Na<%S%&EiB8d-19&0k>pOzaPlQ6 z2MI8YQ8a)tzLPyv(5fR(<#RlZy|;WH4EM>I+zHW!>fs zlkpg@pb4xZgRG)8n#~%R^@81y1)_-d9n;0y#LhRtA%Bou4Y_?b-NwGRs8ohogJ@r< zQEd82FxhEgxm^b9IB^Y+I72q@YbOVNUMNcfCY%0p_YP(pNNMKiN_~#XAq(R~*v;+C zJ6C990$4V!K}R43SZxpL8EtzNbiz!|D`<56bq0pHIrLy}VkPA)7zZ9&HlcrHkF%1O zC>1|)xqr{%*bK1a4bY)dW5P6-@@0EAI!n=+uTUA4t+uhu#IS>7h+J-vh$NLQvycGM z%nu!z`x0SQL8^&}v3SwWUYJ*qEe}yyU}d-?+EA&!FC6M6ADs(-g^22Hw}HCw-+&$LqGJ4+tRzFuTA z!^z1QI!;j9)6);*&yU{?|0srk`Y%6u#}&#rB8AtHypy!zh);WQx!&H1L*UuwXkxZn z4iU)=2!S`{Z(PNlmK->CxDR$V}+AKBiw6_g`?{WhB)Jvi=bYg3)VArtQ|IVSVJj+`psFG`GqS&HmKIFb`??<^nuoxI+FzmrAQ0-~on zipz*So4)u?U$yZmxBE_A zoM}y}Q{Nf9)83CL!EHaYReool`as^+=7%MH+fTh}9p@1RYq#12+)nohJ#d%Cvjx}g zVyB84gHA^krx5hWc+maGY`>jPUw?v+)_z<@c;_KSU`TeGV`|KJKJO>Uv@(WRIl7EK z>{Rf?%s>}hdCK!CCNMFORLBME#~sGE{WR}_Tb?efzQg)xZ*s%8e)Lqk&1Q26K6;bv zXPVRaHWYNWLUYKgX#^)f-4AisgpT{q@2BlTGKI-Mc-5Zihhjf#DC}*6Wr>wNnIqXW zp3STmrmVb$m}R|LUR1*)ry}gzDV#F2Ztv9N=B4`z8taLc1?FO;Pv$#jr&QECbczXx zc4Ho5lJCS$_hd}WS_TD!!GHW9AUXs@?bJl^zP970num9~kXifi{omInWR_(%^?qkJ z{LkqZzxu^5-(&Ic3+){v!R0QJoZgvskzJ>eebs-@EAY+lgg)>5 zoxn%&j_rQI)zfU{C?B|w3={91E^)f=)Wthv?JnL~S8eSKgL1*U^M7nd{?2`EM|Jgm z@rbS7YqWa%g^M z*cSU~Zc9L?HRtc-MU6aLYT$f6#ixK|$+sl_}Ft@>-_TK8IL!$vYUtY4<8YO z;8kWztSvM@LBa9PR%=t7BJ5Yi->h|}tdJy2(01|7Fo?Yt0nt^2w&Ck)r=EG@)!sVu zDkU{r-9yN%Q|s0TDw%@sOc#=Ao>~Lm;Z}u)QcrEM@3LM|NpgR+(;;AeZliaH^(;bW z6{RO;GYUcVyMGH9gcUS}3|22mwCz<{5_QxexJ#Ual7L(6w42mwOzD<&4q>s3ef8a)PoW749=?R;FvbwFBxGZg zI-fY7^PReP?Y1|;t6WMzTT0fqBJd#Z9TYT|m)?olj(_%acWyZZf9t1{!h}lLJ+`pbmC+?b^vU2Ry!sE_EmNO z_}M>x_T@KAXxB%XKVi3D<&8v_M|qj!%R1gY8g{f~fA?a`Ov2mrIBaXYl>H>d__d<$ux9cKKyPN6+*3OAU!o?l10j`&F9O zw>@Tu?)eD9eVeNtJ(OP_9csnPqob1Z<B>bNob zg{6&$L)%A5>&v5dhgY^IeE8K7e|x{7d4I6x6IngHIPd2ekJ=qg>Uf}`ecTf8@@U;3 z1v?)~$JI<^ypzJwPU_`X!ybO+ zcb1mY>UwC;Omx1JZNENAzmGop&5PE3^e4NIl#8W%jN~0y{7y}0JioK9IZ4Ne_kViP zY)|hbtkv2Izth(>JK^-syk@DKzO(zqcW`=VuPNT?eTWfT3OeQLRXFd*7ta=!t~j6U zA;+_2!`&tJQ;Z>+JwgTCidV*iz?~s*=X96Q9S@4wj|I=^I5Mgi@tsrSu-nKgTb)8* z0!9&evr)wl{BfbQcWLgK0^mWwn+<(ufiSsF| zE+I>rgs4}+$wN;Sv-Qwvc%*a_e6*ILWJzn2akQQ8a=xFBH6gQF6?~_b-W2C+TTp$! z+S;eJt=9ORP&=!?(>i{6`o+(G@~`=e5bIgnvUsFjqa5dVuD+!6$W=xjBf;n{ahB6a zy~e@LBVCLH#HaX9zt&rvXMel;l1?M1X5!b8tT+`Te)S8T*0#zeCVcwN+?(I2>#7Z$ zX4}^s>C@+jo#K`F`--i(aopNe~ zb6eY-MV$7My!TeOc7LHPAsYj))kq&MPWxtEpXszT#VJfnz^1rZ6Ot+5mUUj=`5;EV z_3jtn{qofpufKk$B7E=N!@vIMk6(ZM#UH=^^pBs%e|+`kleZtg{_^YBUwrcU`yc%C z+b`aJ{PnBfzlrDcgTMdjtIt1w^M~Jk_2y3>|L3buKm8rg^KMrkzWVab+mF9`{Z;<+ zas2Oo_396Qh*!US`_+HF{_M@CJj*|P_|@C5-~Rr0Z$5wZ@fWW@fA!_t&t84~hu2@x vZ~ykASD(h;vAfS>>R0rWzxjErJ-+nWH~+f);_2ys^UwbQZQ%`jU=aZTlgfjJ delta 9798 zcmV-MCb`+fT8>SBABzY80000000ZTnTgzw3Rfjvt48eGj5N{MgZ@d+1RjoQ*#*B#w z6JcT?7edoBHc89Obm*Q)z;EO?^hR9kP4~MG@AH!pLn1gs&tcd8*REQ%&Zqk1qo23$ z{QNu5o;~~4vk$)U&1c{GF#hw|hd=wrAN}=u_Uwai#{YareJWHU;Xp5XW#sjc>L}7^SyZM-`~CV{lERmPe1Q^V44qaOt72qsNsVF!tMw&L!N%ql)S!PL^_wyUCf4ap+pAAw%38tT6i*yg zoOVE4%w~Itk?KtKNh5_}&{ub{Q`?FfgD3Jxd_{1vX>Pm%n=UwPus0e_pPNDHmTtlRg4%f14q6Ww+&mNPOoiT?N}pPrz^Y&_g7XE8b2DhOSJt=*hW+M0s9Oqf>){UY^IXfsR>;yU?40bpL+;Dg;&9m zmUU^PD=$v0K=}e2LBh|DQa!$NfM_Jx}Eq$0g%f1%DMsNP*hU$)RT!emmMqHSfLE*CHe4OZAp z2~qKzEj%R&9pS$YQ$lH~y9!tbw;Y1+v?lzp8G#a9xlE-Idy{b6Y-0q?DSanSTSbOK z)GF_!l5@K$Ex@OsdP^ZAXnPhxjXf41w6vH_`7M<+3*BEu9`+Eh-aeH4sa?=dfAA`y z@5Gt%+5$Q*IE9-FdoCzT*%)&OKDwv!>Td6XO2T>dpF(@l(cFh%9NEy4phm(3$bgUC$i~D4A!SThhdWS2_{oFsh*RjMd?-U@3?xK_SE?uvdQgdg zb;whd0TFhVvT~Z>Z}}x*|7?Xj!;G~~%aEGz3E2{OUG^4{l#sy8cQP+P_%^nT*9WT* zysFhEG}ShgPO;Y(woG43e_4mt1ugiRjPYr?ifC+43KIKKv5(rPpr2KZCDVg{NBK6S z2i;WkGHo-ZkD9a_MebJ!Ea_d59?hTy5kJk`6}4&;HpXg#E9Y-S6d`%9@^KXfon}I} z3_Dm_1w~{Gw19!~PD&dva7X0g^r5Ix^2CrADqE{fWiN!7Q{Pzvf7V;&1!Sy1*!5w6 z3Aly®eE>Q!S3J#lxDQxd;XQJ$b*v9`c?SIjc{C04Vr*GHl?GXpgkN4qHI8U+;+vfcCJVMRq z$K5te5}&NFz&eghf5g*c>-~|m&MOI(uRh(p*TX4yhRMXo^F*AN1s;Cs%O|(PO6uO5 z-cHqqwzD=su;sbYc8;vC%UKqhq;_|By9VyT0_!?5*Di0bN$4{sKrleH7oE;HBBbZH zn|1rh9sP zPJ28}vRd8nb~`z$FK2o9k*>#3=;UYVa13K@!m5#OOr9GN;>c*e(9X1{$6zzyO>@Wg z>CndEv%Gxr2)|t)7et@FVBP0T#VbiITuI%8K8fIjRfiUG{p3Ja(1`nls%i9gFeM_X zau}T#^f5x8f7be-?W84)>qY@%h3K*+?dhU7hh{ z9`3XY4sJZ+?t~{bPJuXbL(~jDO@|hGE=egn>A#n=e`Ez}b`<~9kv-1Rh#K0F6n+70 zA;DO~UPlo<2$5TEl%#8GNb^i-q1uvk9nNC3(%hLVNT)Lx?ZZw49E{UhwE5+B#MrGNLgY3V$;!!Q6#BMuA@mNo_rG`8dd(9QE{Xll$X7d zT5iq2<_^PVpczzzxr}oMNfG0Cu&znTX$uU=kh!D}hGIdV^e``IEGR ze_oMS1()eGcbL~ScU`0-dz<7_^7IGMB$cQ*AV?S+b0ZG!T>(@h^)Nt)K4{&&Z!#xZ zx(jI~1Dswp3+8b1WKNjx%09e8BHA-vju0e8B;f6M@{4#?2qRK0ybQvs>ga)Ln`A>6 zosBH7K>J49X_as=BO5pgB69DW%uY|ye@(k2FHu%E@L4(%U>hW*+y~l#0V%}qfu|Fi zGp~fKqg)ALl{?tQ50r*jHOQ0Wr^wIclSbQ_R>`Vsj<##;hN!_SnzSKFD$Jc}T(rR8 zj)bwHhaqP>asn?4oajQ>1>Y_c8AoxNBxC>?O@7Ldxq^zMtDAvU7yAB0W#Lqze|dv9 z&h3>>#~Z#~*$irpP&4EX>@v)NN|r#t1U(Cl*`uMCC{}_@$x-VKil3v=T$FbI2W{oty+uXQ7-gD7mxR4<3gUC6Qsm*Bd8{3v?3bo+)*-`9V5c z=qE(n!KX=e4h9BRM#-WUL^el0f0#*Nw31HL5SkAddnNNMklSxUpUgrfJ1vARB3nV} zda6CR@)J;4<18mZFc5;+dT<|%VvR;2j!c$7dmeo=0Tc9VwgDJxE8~f@5)>I3X~GBs z`%k)4ASc#Mwp3^*ECCDQ_k-ODyIcnHGL-Vd&Ws}=>ioD=@)Au$KSUiEf7Wc3t-6h} z!Mu?Kd@vd5?M3UZr%n@R*)U8v|HWC7A0lJa7^`#AHCu6XX6yyVM;-zOSeqkBRV41p zsF}JMiKB|{x7HR~8KDs&HL(ArS8@Rd7sSBAB!etgQi+ONpf^1(82(P##a=m#UygQ`e|N}Bl&%Q*N<6Q86*^HWju zMf_J(ph_c8W#34E*=q>}`i7u|jqVg<3^`9WVDJaD0aFhnNitc{CIu>1($Nt(j3Z4< z4ckZp25Tc_c+Q4L+#1Qtwz~=O563XerqE0v8|Z8yT?cvm@@=%Ge@M4auLU|BY9YV< zoaAr_EMezSMXs4?$E@B8PY#*O(eoe8^$5EWerWwU+BvHyxzbhG4C$Ym-XkK9Jk*26D&3{w4h+jXe>|U>6zYpRA2cX;7v>8j_Snmi0_% zlNhnE&}J|n!Y8=)e=I~AYrPBoK8;k+6khD{BX?(J&0`p%yKpiRo&>1aUxnepBoZ{p z8cxzC#HGTto)qMF;{a4QWHW|YHnuCxZM%SyV?mc-c0N1?z>bRfYzbJ>ILgFOZ&*Qy z_UL2`F^bNNitx_h7J{m9G6*v2Fy}Eg8uFZdrf73}C(f1~f057>M4Kt9qWR_pSCXj~KxxYd`hDDqnR+wOsBO$n_N6;VCmiid!=Q7* z1Uxx54D&TTRX^lx#Ma#>2I9-2b%)MI?um?kV{mJrAGvK(;)A3}He@OcD)9}}^5B{1 zsSIc%4m#@gf7vMmPiJuG5iQ2iFjyXE3Gy*0LEq{Yu{tEzO!y&H4%2C}yD(aePRiMsn4KS+CnrqyT|fcTsib1|Ma(ov z3e!8flbtsDV5@FoddD8*#)`So6JIw4TT(D`QUx9Zr@5t2LyHlE78w;sjT-HSkR)U= z4lkU$e^oJpkS03e_e2&J427zFLWN-W1SM>=f-4zolG+l&pVLx~){s{bO>8D6A)_gj zN0QtlOcG2*YjBpC72R*Ae$AJ&WFysi zfgu;!twMkuOSx(3?bMxtibDy*SadT^=^9kOGxi|oQC_a_^zDb1Dr9q4%A3i@Y)g@m znnZ#cUgPL;MW)m?`AlsFLxyzUhf50Rbgmk%k;1EMVGY-I(DJ ze|&=#KMH7Pa7&b`QigGBlWHV097_g5cic`dB#UducyW9Z!-LIGM9)denT2A7QNxZ= z!+{!gkOO+1!vy5qa!!P8m>E4fW->BAX`KsOvFOS?GffC4j)}(;Pp4HZpv$@ptdS(? znocZ=!Farmsl@np-5s-4rePIcb*yIFe<;(MJ1S>+Hw+>hr@1vUno`BX>S)1AQchf znjz9KMYLhUbl^8efDO~a+ZafIf7OWqGl>j2azWd*B3rKmy|)=c;DjWsByuj2=p74* zv$rgMl9RLwYL69LfYfdTlk6bMQi_h@p?;S*L=lN=$iKr#MHd2hAh5#ODi{aMXe?#~ zQrIWc!jbh(tjma%Ad!@ge6S8O+-t*}oXo7la#H3Hy>c37!)7FdZ0?7me{ehoie)5w zL~@;?xWiFIPtN+VPMXp*1I`xc!13bAH6H^@v8^Mrg_L3iYSA%-7RxqCM~7P3Sf1Xn z;w;w9#lGBoVseD6V=OxRw_zP4=7^+$fWGxYVdU%~%=NBF+!NdWv}QyNt#BunUb%6S zW3+QRCQk-;#6D0)XK5Vmf6VS#=nk5MRl$_7d_eS`;B3R7VstNeEDg?kV^L?relxip zY)rtD6!JQUY`_}Hx&{`?JB$Bpdi!+lX&Cd$6bJZZ$W|;(@WGjk$kt6b9110pXwfn%fYdWEd$4hpLdC3i=sKuAE;9)sw~3tAe*0oTM##=1IIh!k|{rmFz8 z$3;p`ayGPJCS`gp(ec3s=JGG%Czc(Pxwi`DoW)}h|L*KLJ6%t8!B|I^O{W$&*&iCk z|3)=26ML}ZL#JJ)eQ%#1>7R0I<-cPp%Dwsa>p#BuD$QTIS^Vq0M5$GSKAV=LFE zb&S4+agFhLf2Ia+3v z88YfZE}Jx>ISCO9|1w<+T{fJ~?xJ=XEk;jg0ckVXjdK{+c{zr^y$&okXq_`hF@-KB z!Nht)tIiuQ&{%;I7EJHhuXkf|aHeBntd8pbgBm)PCN%tHIvFvy9MzVvcTlMe+Zu}` zsL67=e^o?@7B#9`AxF6=g{;xU6BPfGQ(Gq)2*ET-a%YoVu56*io~&I)?!%=wg#}DQ z3np}7E}iUTr|r|#)t9*^Np9a<7tKA<-MCZ5W_>UapS1#xif>Z+A4~z#9yy-2(Y4oh z;~Fv(+B&8LU?q`_*d*t1kUgJ#nxnKNbh~2;e{^?hD_hz`k9Jl!f_~B)Ha+l)j&A3w z8Ea@DSY4=ytV(6Di=z`sf!MF0V<3JADaCmO6Xj*b7}4*8?Qqju&XyPF4=#)v7H8)u zYD%?Z2bt;zf zg~#2HBRlF4dA}una-#>zI1{~wWrz)*I%Z&QR1@=_Wi*=jhL_clND5}zWGxmw-WwTS zSV4Hi71K}aM2~jIzC@V;jeuqJ;kFS$e`%z|XG%AoCAQKCEWvv|PPZan*UfYD4KJPI z+#$9bhuMsfZHDoWDHzyZB)A|_F`I^g4tyO&!yr+?oU_f<)Y3vx*#%j#Z{1NknlqcDUQv1G8~LQkX%gJyz@wk$oe$e;@#F z?&zpJ*3B{9-e@Hu&>6ppqyk9>UbkXc-qJ#fiFFC1JfZJ z=7?liimZ%+g(Gz_TX(E_Ob;uje~9wE6B}CxrmsM>UqHYvc25-U)iluzYGkTB^snM7 zJoIr`CvB!TJYwS(?;flG>l?V0-LAOHPzU*KZ1-Fmyq&f`1}y@;xzLj9)2Qw!8-udL zfxB1doe^}FUF?$7#LhkFTlyqvB^%hxL$^@eC6+y8tOa8k)M7H>&HW*ef26|DDgIWSFmAOV(vp0iX$IEkEZa>EM@jS~nmxrM`n#F2yDQKP{& z4TWwKS-|Kpj)mZTqjLfJe^^inx%QTCtil_Mkgc-noZWLU$rd~IOzxPOo)5fN1?!8m zmId3^lh2#x zz=LcO+8k}hS^~?kRlRqBTPCP*Fmlf?}@F|Di%Noe;_4i)lRnS;wH;;VGh*d zM5;IjejCfy7AI-t3De`oY=%o!<1rac*@qPt7&B8qdoJubI-N4Q<1to4%vs1T&O55; zh%55gKnQY+kBZgEe{)eIh$KLYssw(M>pIZ~TY%u)(>o=x%*uD1RgRExFW@+MZVruI zM>4Arle91=-dWUTuNcf*$Et!>_^uh_I7!2c7lW;1ao)l!3}PK*kj1H?JE#vV)Nv}8 z&hm6F`9vKedk2YI;&AhYOM|f(vT`TetR6s}4U<)8!wV)7f0G#|n8{eV;w;Wm-0#Y< zI`qv9WYk&7Pk7?kulJ#9me8JWCvE7)3V7q?&2wO_;lNl%wov1mR4n{6jB`)+e`eY73;Y%S1yYoPz9Z6?*w;b&jK=z z$<-&5Yk>21e>UXbSdlX)hGPdNJGHC`KxKh8zbf8wmd&n6d#tEYXU7NTu@LRdWL3oP zj^V*Ju}OZg0(M3tTh9hE*uw$Utx#?ezwz?sw3+a3h=o~_=}Vj0!b>bsOCaTG=N9t@1W5c(}9v2a3ZRyShz zB`#Ghl!R!jZA_svENKqe$`!*%Qdts@1c>%!D8m>*a7=beeGoAg8$0fW5u2<5My-Ig z-i~Nre>sAX%>z&c#Xf%7mlx~Mv29ymCPr)~ULF^^0=FgPXlKXV#Jnq%YJdke%+8Pi z#z`=xt1h;8CiS4tVkAltRo5VOOx+GU5`8nF=InU%z4-I#yW#K0@DKm~2k*(h9TAB? z%t#rBGyXPG4zuh!5)$Z9dHcE}0qMuXx{cH$f86zTM^-(qruoB+SYS58O^-YnYX8qi zd>+?y-tq0|Z*_y{IP8_VyDIr ze>WU$RX{XzmId!UWli3{(*<;DIdu5js>^Xn$M0Zd9M?qLSKW%h>+Arj=(O@q{|}7R zBe;Lx&k=RJ!(a5Y$mfAGnV-y@1$@cS5Pr_1qfBmKA|<~ou|wu?vB zk(_ZIaa(3M5)$fiPN$KwoM#K;wDE5;la|+3hF|3O={L&@{7v4e$)}KQ>BXw|(KY!tTlb4Ta#~wC9KN@cv!kH+2Dd&ppInv|^9u5ce{kOE zD8~&|w=>?n~Ik~OP52xg9KlLiV&m#)fZnX)xo!SdO;VzA5 z3;nx`ohoX~i}tEGg`h{qgOD4>e4p>>CbIH&AZ^1r;C~Hus$lMZ}`@a<`=iw>_{%U zb7d1eF)s*G_%;-Dw&d}CR6^h6wi)xptb?xtL$(Qgv%Ut>oaNn%f=Y@Pe};AQB{)(n zx+uI>95$~GQ+%fg%^@4v3Qm6NJ$cuJj=R3@r|m*A_1Olm+A|GO>}L&yy=|~8v2qm6 z-bSYJY-YVMW#t7zEbBv$td9G!Eb>7Z#L_D3Az4JVn7deStS4GlTZ)lBneUjL%H8hJ zDJCG=jd_Skz7sp$lQGfCe{t#k9R`E>K|pi}h}x-T&V6l1U)v|Y=|X1hBaC`qn~+(S znb-TB-SBUxH$M5vKfK4{;TPIFjkK%(>KN&3U$mRkZ>C)&)M;d2wcKMQbaUs~0=KrB ztzYo&G+Q}R`)?zsCe8QR?7|z*`*Gv%jJ3O%ZCy35^KXu{zWdsae_F@;$koGnnr-^v zlgm6RUO`&(;^h2_#pl^p1gzK5PvA!N z^XlO|pTZnGQcsE6f47k_jaS`H*T~*a&Z`(%=3+m)inUoWL35b`CVsP~;4Wd)Gy#L+ zn@>A)uo>U7_E}JHZ;FeZ+7jPRu2w+{VO$IDVtKc&_|8^*r%Xj9);eRNjkW|<6`%Z_ zhZ7Pby)blqUG0W5e;Wd#p&3ucw|VM8bKg%D+`pds)7^P*f1QjW8F^RxnMH7yqU34j zABt6%>58(tkaKYcN-mrl?%y!+lsEo_e#8pADh;KMIvCc?lr$UrYO9}l{16lztV;02 z^Boy?+1Q)F(J%$YY1_Nd|r>DM9H@Nk+1cwc~N^r3?gl1>E2;SQQ=M^WfLuhHI z!tA@$Tmo*{{8PYS4naRb3{7Y#tqQ(lr|Us(5Y4`%@2rr2diTa3|LAXi@n!j~_Huoc zQAE4FmF;pbkFx*yBSpM>H0{*fQl@(7$d{eB!rd+qm+TDz~_PR;b*KN?3U{_%^`+fxvZ z`&`GBe?*TzJd$0HM{V98?Q#2IhI?+u5hS(z384G!t?Z^>*Aw(zb>7#tj+O`Se<86COY8Bi;|`NYmNuRo+CGXIA0M?l zys~x9leZ49?fVVQgUz1E>d6o1{T$;_yQ4`RPiSZ#EioS-t^1=uIlm)7eS(Ey8LvCR z?0IJ}c{AR9k9*zF zfBWPl{XYKqXOEg-z1Z64k!$A3F_L|<`8T!NMH@c-W?duM$B2g!KKM5YYqhq*zX>aI z@(Rkl#x_si+5O_dIsIm@DSp%Y5F@q}bjsDnI`799&lc8-IG^mI$g^dev?caaj3JtB ztpwbPSH^?Dogr}N)I0i)2Sx11g6DJ`e;L(__)d0m=aE&mI)%OjUa!>{qS=E&%oauw zuOMp-8LMKaVm50oFg_@&i!+_qjE2jI^K4;-Z*e}sL&R)rinWC`tMFj7&Ul?AnEai* znn0Xs-YP6seT_?;VX(!S-hFSU+2&UCbGr5BesWcP$C@b~vWwscs|&cLYmzzNf2h|? zsxviS;}PfCmZH<4X0svj+Sd}ZSrZV=Th;`I>?Y2qth$86XcD4c1-}k$RLs^xbK#NF zO>oOvijo+uO~%o7x+CX)KGuX}I^9V9gugY#-`WIGc$@4yvWh2i%_-2fJ zZ|zam#^Ra>&suf`iy7!tB>Bie*5}YzkK!ii|1dw{QSk2uYd94B<)u(-_W~% g{_%^?;_ukq=P~t*>nqQm{b&C9FYI8Kn+xaw0QE!Pr2qf` From cd59649b1b84331e234198e3b51ed6e21b9da7c9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:39:49 -0400 Subject: [PATCH 220/503] Update with chicken defaults --- R/sysdata.rda | Bin 17984 -> 19940 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index b27a976d02ef60b4ed20742124f375e50a14bcdc..4ae036a9a6797d9d6f650c137c04530ac9bfc8d5 100644 GIT binary patch literal 19940 zcmV)CK*GO5T4*^jL0KkKSwuP1D*)F-fBygf+W*gEfABy5|Mb8A|L}kb1py!i1Q7tx zKmY&%;9y>-*m`J}6N{wl8Mi%$JzD#o@$Sa}000000005Fy7z$g11JCh?*Iet4kqkV zuU5xE6b+~agV4p}K%m1w08hRS0Q3jY00M(|(}AZz6aWVh05kwT_rCA|00EEy00G+o z000ZH0009#55BHk&>Yx1X4uXE24v;ks18SV0kaFX=W{}V$0DMI5eTKoHPB>Hvn_^` zs@GgO`wL2 zG&I^xG-zTP05FUo#4-&SgC>mt5kw$OGy-VQCYmCjl)##LpwXtq2dFgA&;vj;4H^wJ zG!h~RhKRxdO)(5p$TWtDnn)T0)MyQ&0MGyfO$kl=v&}?8_)$bswUrPFnFSx0>-~>N z1OR^@;K!f8ztxS$$NIi8hs)yMERX$P>LBMhKV?6c?tfZS%U>WtKWAuM@TT-CE z7hxoqW1f@t6G!>R{!&q_Kd6xCX(TEk{R{e6dV%>I4PFI`h2FoQkN7Mie-7b^y;M!7 z?Zk`}_2^kIGyh-w^gN+YnAD@fNg_}|5BAN7mIec)AEBIWEB`LyDnFBnm_?pP?p-U{ zC*}DQ@}KO*D%*hKR}kPg0v-2W|MGov>}<)jPhLEOxJ@;gSP17B*&rP?9S5s!w`JPz zMvZ-cgF|EOv4J2k!wJt)63Sr_f=PCDha!#{%&~)STJ+SROpYgK40>lDP{a@UII(Ea zKmH}Dl&FgQtTQ#FNj~OwLD-lr-*JSJ>#}6Jr`4LRCOI3{wwV`^ddwHK_RLXAk zC7Qfual_l@GQ4^7AiQ{zT+&2wDDmGI8q8Wbeby?J^d?^?II5aFjD&C{<1^b9Syc>t zux6SVkyA$z<6|sKnX>p}Q1~h=vQVyN-ZLtlQdIF-yjK!?6s_dfYPkZ|yh`l(#}?`v zAu_fjl^x?q&kiRgo9o2U2`6ZJEEb59o;(ag6A00~#r8BlPgzI5HzN*@__?{3Y~{SA zZ<`TuT$&ACMn&ALbsz3j#;*KBJS6ji^HHw==VX>1L-8`^;M&`{I^I&?Ho22S7$!af zN*Ng8E}BUqH-pKC&7ayBP$w%B&LeE=DwQhOIn6B7m=~N2XQbg5tEO_Cv+sF4RcY#y z5)UeA{Jr0{i3WM24KTovy_`^B4PgLlf~Ibquq`X{=e=2_5=*%`x*sAM~CCDs!qO2YQOyKx%G_PnVe># z>j@wsd5tPp3iPP54|uv2Ea~K{s&Gtk3m&CE`sJDyF+%lHl&JbDM-z@5Tv|Mkw6?j0 z-z?^nITCVV#Rdb31~HdC2D+Gy`U|hH)>A5ITjZ%znh#*{C|JGC`*6g(T{oY-h9ck~ zi?+B69}Q*hXl4OA$t1+Y#NcmhcIwVt84M53$?~rv0>{Kyqp+EK*=6in+?lNEgT%2G z8MfsE6}XC@PVQM$c*h!&7iN{1gwbT;)-CiLvn|<2%(Bm7_JJATeavQTgGVWvjNe@% z`$=zfM}*@1Zh_mzT1zb+ruKn+$vTNKHS0Zo7QukZ1ICQLR(L&)P_YL~7Bz99V(v2cyh_Im ztlL7wj>4jt>G+biRI0JvRic@$SgAnpz?#xNgB0Q|T=-aaA{UgD|JiUakwG&5;f!$c ziEwiBJedCpwkIP8a=wBB_ZeW~m6K$Yt)BN*8?}tn$zy_{6&UD{CTA8W1|}7>N+~Gg zWHH=oBzvPEDg<1vNJoIvN9Wt~I6ts}jd(5TQ|bH1ghkV*5%?6XM z@xPZW^<>ZIb+bvooHaFf_I;XVo;~+Fa?8d@eMCM>4XR0GkkndeCZx_zT7HsW5wM)~ zzP0YCQ8x}gd0h`Do<`iNL{^@o=gQ}t+EgxFw*5BML5S20`OkC)gv`T7R&ycy2B@?s zO=guPPXY-lK+eB+Mmj6f)(M&3cPDw{;%jivY`D2OIXM`SjqqN}4ejllo12{47Co3| z^PLN9n2gA=ftGx-FfcGMoD2(>C|qP0m(uHtiaHlgJo{^wOfx4_vD$Dq6Gj<&KN*y1 z7Pa*IT8#BG7@E-^topK_|d71=j+@^+gc z{m1ct7wMK~@mm}AY?6|p&hy1|VED7&k$|iYvAUXWV`pi zj``#)@J@BxHuq$^Au%Z{fXraw#E!Cu&*LOyC`Ek zFUaCSo-ZeJ$;`}__sHa2RJgRkNj`1_>a@pP4`EL4EZ3lPMD=;+7ISpQcTL;z(^zi0 zp1KmtzGg&$d!4STilwHBuYJt&G&EfJQ0-SUmUY3!Ern-^^)4lMOOeXT?y!-W$}KG< z2b&x^5xyLpSoa)vYRiqNl&)u0eXqryIa+<3`ek%8W%QPFDP9>Ji{m{oyIt=mQ;+`1 zy8YGmikJCE|{>KVU#AK z)Mo)T6;n#Yjb)^2F12Q5z>5Vfn-`fG0%>5QIH!zMs6x&-%8iZPt;?{R!o(=JJ69ZY zS(g@PW;XCGLt+G6tH+y^3CCA2LphLU7ZQ<$lUGiwW$Ih5#%=|>D=9H=G4YEgoYZB} zg|kJigLy?%^G#hegN8I!)#XkMEbL~&irdSGgOV*HsRN5@wcxqsaDQYXK!9jGdBXxjD{>s-K!P3C5_2;wkq=znK0y0S(P+$_cZ0)%D9J{ zSrsd9ZuE#6w$&G?8@CEpVtIKvv;nu0BU4oNM%7Ws*PMu%1}jjALFu_k?C)_@y|WRE zn{T0uo~aqE&P+7oU|#K9Mp1bqF}#b}&Dj+&)Mbisu=1;7VsYi{VYoXsvWa3`#7Ivl z?OD^bk{1yU16tfjotoVe%cm|Psmq~hY*8knGi)`e%{W#qCA!VUjfiy2smp>j(UNOa zJj1aCU`u##+$wVy4L0u0R741k*eqE!v9EUMX4wiXs>$7&aV~EvAk{)yb(awrFm`NQ zLVKHAzoMQ|oJXZ0G-I|RsvXj~itS{fi?xpJG7aQYytS8MD-v^a8rYY06L*kRWlEz6 z%i9+))H1Bb)b8V|o>dqIt5HWK8Wp0%U0h5~MrFENO$sfIHgcR9szKt-2@1YcOuS~K zkgerjR^2&S3S(~eQetprA``0J*>OTPAfQbGW{tHPq{yObX2H6vhc$PXm?J6O++0c| z>dC#9T!vz+V;s6dL<%Qp0KoRxECIe;zX z3v~08Hf7#iR%+J8hNMxXWRl^G-B~VJnu{VOY-5?gAEysso4tQ zrkSTwZAgfSHX3}lRAMf&cJO11qzN>kS8hI zW-zFzs&TWmRV#Gkh?(AAV6#(-IGMV~m$*Z!GbdOw=}g^PdgRNytlYcGhpc9mZdRzF zH>2SE9sZB?Y5ViV=g*gK--5Mjr*4sHOmqKO7$B)K8+C2a>h4B#R-L;Qnj@1jN{!{k zP;E@s?V}9tH**zng7F0!QrX?-RNSnR;((y19I$3)iri1>K=)`4f9masc{h1MC8*3@&XGd zZf-HUsc`aWiqjj8CY0;0R4mFNvgW`3tv4*qWo`s zTBWIYl-=&0)n7y;)Lq9$84lxKM2&|y?A1$~$cwF{YIiEET&$X?Q#G4Vw`OLY&THB# z*r*Yrwr-2Euw;sRdws(^93PYM!TBjtN98P(<;#*|m<~n>Bp`nH2#Aa#s)MGz`!-lm zsGtB5azsDTD@6qc6mYE+5`ciJFr**~u?PYx2h#(_1VllwLL_8*epT<@ntrAQ+sSY5 z@XnaO=|6D{qfN_(#(8~z7q3=IQrz->xTwe7{k3CF^G-6^invS18>Szb--ArMiE82S zH)}Hmn={u;tj#9~W2_RY(#4gfBnf8`)Yc~j7FHVuKbd{q^So(!+~=L)s#TA2a!q56 zF79fwH(p)>)@JNhPEH2wWJRZPwrWw+N@djuG_1^Q#3OfYTY&MKsM4)%m9Y~xrlf3> zCES}@b8}_j%#4bs5UeXGR&M4#9ALwXE+VO1f*t9|Su-=ZqZqNMR7^lbZi%^Zm05A8 zY`dv9k&tQJSprBbl1Ua}8NS3A`ypOKIqWHk?dcNTe3+Mq1mNZYV@Jg+x;`1#E3j zWx%H~qh@n!CbD8B+cumfEdhp`G8M|BmAPQ*ag!N>qfK0cVC8IC+@R#d3P43r%W_Oz z%f%33$;Fu^oJ#TIF^#xpYG!twSqUskVxqSmk#d$@8rvx5=1kWWz@s^Ils1sCt*3K* zoQo<|)m)Yi&Qpaj%$i|BV(I~BMk~vls4T3^+No7XH%e4=-YrqGWiaj;!!H_%k|ql_ z$4kjH#eQTWK^#qR3YAE|C%fvmErKTpHu=XSl&<5%aX{Oj;j%zWkM zXZ#j5n8;+QcJ25dMcUG>xeTO=WaG%vuDyPRsE#Al{!d}KD^3JvinOAoz_ie2zI|Vf zD^m7bl`B!l`3+`T7|3-o8kbgf#ldAZ?HJxvvC^T{Yz^wQpxA2Ot1RYXUBtXzUR+@$ z{XB7QrP{8Rz2DjWGIo<4l-;ps42!}^B^+k(^fR(GX7p96!Ulxhme{riBC^rs#&YtN z+O8ZYJ~SPT>p8U6Xgs@EOmp-mEmoABL=@~#`aucy;*7uMAMP@fJOCzfgSTI%h?TKAa8gmW=9@SD0}$&XFv zijAg&mx0k-bDc_bt5m)p%)7tLWt6PBPgxyUyr`QLNp5z1 zy5j6J=SE{_M$=bdF5O+Ttk8Tq+v6=AEl^UH388cj$y0E$x0@a+nm%o%ZR zj<&sNTVohSF6CIXGH6;WJ;xV@rGVhFTwZa8nn zvZn+=HT@0_CtgXHBz7Z~fFyFU3+iSauM0wKibbcqJtaO#2ZRzq=XF8mv+GPIqHzzYRwW=qq(0f0P%w^~{2hD;96*duSFJS@JG99a0f@>V5~`Y#gz0ID3n^aO zE|x|pVFf%mLqX(rC23_CojB}M2fu->V#5q(txNbBh zQ3%AW6%!x*k>j>3gP*tN;xXIimF}m@GJYFBqL*QQlm0Gi;LRvw|w<2N{lZq&0Y~N%^6%rGfgZel1UwvpB1Mw z_hbHF=I5?IPtTShYagE7eFpYl!}<3%FX?Oxe#Ji)_p%~B(izLeX{~wWTvgJ~3j2@6 z`A6pS_y1OwYtI}zjsVZO@0#~hZFWr?)m?5L*~1;S#+IC34b~4$%j6&8+Hk)3q(~T9 z1n_AYKDi{xokP^N%je+9!f^IH{AQ;JVte;p+GX>|XKE~S?bio}LAy-mH^4|`&p8Kx zA5g=}G()R8zI&`$IHwFdWf#9~%|oO;u{re@Syy&8+2%e6fiu&mE$t>$$|ky=^JY<} zMiX4cH)tC@^ULIdf``FA1MMjEejmUVZ_3{h?}37B>DLoRcu6Jh?TU#*&!Ji%NGn99 zFwCg09GN)}$K{$%_NS&T5^|z6&*5&&R=!%wg*yw3`QAM0xtrT^krpMowbzk{9x?VN|mS)Dfrl{l9DWtFiG9xRL6Dev6Nazo8+upLU{C@}J1A->s~V zd-|JwocqEv5x-UB?1@IP0*p=8LUneNI&z@fv2J34lHGYxl~GpzRCZ(Q9Nu?4^SmW% z$mSZQ5A*Z$aPafKO?%-#Up_)PSbTIczCg~7+zf5!b@n>9t1su9I5H!n$s0C_GOnXC zn|a8$ksn!Edud}*CGs)_OuC4GhAw%wJFY|Wy}s)6z3Axuiz?)o6}Mn)K5ODbyLEXn zwqpEQW12~0D@gpApy^~Lc39klIp5EsuV?Z0r^hmTS$?Iph;1ZkM8jl;>U_)Y0u>a@ zd$0#ZB6|oPx8X39h&v59ViO3|g|%?_tDPQf$eTUv{r=m8bV=WU>{9tYNS{vMyWgHi z#IZpPS#Z18#4zz*clCuGtNB8 z7X>4a@bmQ#;^*dH*IsISk=;~GdPaiU#;xOs1UKXBk zM+J$s-Kt${Ik{kc7tp3+r2AoFSE$e53E(o3aVmX$c>(PzgwT@pH)A6d70{gRmv z?)RxTt;%fX^BH-d+OzCBr>!Sa216poag{{2nI;sn# z#K!DYETx-uVw*OJam^)14A)UMO-dA(@ye+(uOB~rRv8aE*Ro-T?5|u_mBDZ9YAdff z*zci4?6sElR;@)u%Z?&~4%x?D@^9rYOI?zga%AqBi{+O=HoCEr8XvydiH&pJWya5y zm(w0yXOCp}(z)u%t(~~A#1LJcD;(XJ zHkfEa+g3N>eij_l)Kt=>7e51Y_MD&Z>-akehp`{S8&Mm#0|D)^T^K>XEYudT)F#$A z$&o=rilu5=1I+7FVD-R!wO82uT>QNK-29{M!gJ7fzI^)QuTR$1UVUy%DXiJ-tsLO{ zUHESwm06V!N!c9e@o)+wg9zYfh>LtAShXxb@tF`^p=i-*5rYdbRnG`Bus#@O(VGh; zb|Se%x1JKv&^y3V2s67iq0y0qXKMyFn?`)_mMp=b&k$VR@Lh+%^~*zZ@AvzCABrp3 z`-zN3zRvUQb|MDvM{|^UXQUMqdi*1+x4q+e4p>8v6o+10lfnmtQg=vC3iOSWN4Ro zJv}pzRhi?p*$%CNIZl`dNDClV9H4TOL^UON&TuM7EGInJPe+6xq1g;Vc_dgxCw{3h z=Gdeb3kY?i)*7sbXM_wu7FMCLs3@x-C@G#Ph++ld;L6U(9y=Yl zGWhOw!P-ct3<`)FNNr5OOFmA_H1lPfJJ9W#uS{BmL{~+17r$M4y*zOBvK^Te4(x)G zbJd!`NU|Ejq)<~k(3~<8SSX|`2|44pT=07d0lRHuvgjBmu%-7F(&jshpL!>LqI$_(d*IFz2=!afJ($vo7Q+yE$9_qWM9`9;@|ay*uvn582&2JiM}>Q~$w?7; zL4k6}qdRv~B+M}G{1R%Jf@(;^ZBPSWHX@n&U3sCYp-f zy)f6*dS3fiRS$iI6&aSI47^Y>{K)ohEcADy*g~4{Lh8>Tcu=wcO4tnfs0<<~T(<&9 zL_{EZW==00&k>V}mq%f}D6<$81D1&asV$U8BQ3;5IOZB;+6r3JTNaWg(Ry05KE>!R zb}ijA%|yzt{TjibpwQ4XtaAY(#N<5RL>;~3c@xju;<|iYu%YTAFt#twL%wATm~e(r zgf%|3HkAxste|3&SC21ICGExp51$uVrB$G#o#U5*d7ylY-AJ<+p2sOH#8y^GQTdIU z8!qa89JMXl$4Lx#UhLMox%+yxt0ho1leQ~V3!(%nr_;%Q_2vr)yXCs{L>e9so(O{D*fZDU2W2rf#u^GA`IM3<%JWGIiy5f zRZPXsT%8sb8i}zAnstt`TwGq&sj8jYo2g_xjxuaYv!h~iCDb|G$|#bMiK61x+ncSu zxf!ulfaV1|8s;EPZmJg*QcO_V$&CqJxr;9^CpT{t{`%e8wcIE-y_tGis;OEh1kKf~ zB<);G3&q0iV~0B^-PNSTx%{6$Kp&KT6ZPkwYL8QhEC4*Vrfr&*v#~j;5q@B#m%S<$((rR>+@x{)mKvV=r@DhfcJVRE|A5_z8$165TLc?)yO0eIX{# z4i#kD4Ad%6!lXE=8>PW|m9H)xDsn{HlB-rn;hpg0@SY32jmn}Tda?*S0`5$9D#0UEo=&^DvjF^SHg;~Hk^-{j zT$A)~6y2%uNUa@;^8*$z?REYy#~t)Z*Q@L50rH>bT7F>f*oBmg*w0g^E{1_gaSeAM);(WK%;fBF)gADYJ&h9NJaQ+4DnA>BoP|; z-Y3E=6AO%!&Lo7dq4pDp-nWs3&Uzts!l8d>cb4keKMmJK_UKU=je-dT68<(poV1(< zQbLaw&`gosv2{~Oj5d&ny0qtsAkQXKXh|Q394nDl(;s3q|C3Ijb5aHoeQ-b~6%~Jk$Kh6aAQ8_zd!~gB zjX3UWVvNs|QI&4Nkc7U&Dv@PCH*2I`7cmfz=JEsxRp)$;;hK|GNKb@N*r|x~+U@y8 zy=38pA;i;`zlsHm2yN2<`wir%splZ_9kB$>I4TkJxDX0Rzg3YZl93~mqJ;~RxJ|xJP{z%O{M1iOCCQPtSS-w6i$(x&4-Bbo3=QjQw zWbCs_o~2M%@=R;VLNoGquJepM4JD}f?vJf~N6x+>*n;_AJ#2 zR!-ZrwpzUz$d{Fwl?1|hnTIO#Mop8pw5+8v!nsz{m~|K>!x3{Z@b1h-L}g_X|D&O1 zJ?h@o(d=c-MbjYM$p)2_@2(uqo5UWrc&#mqy{rudfgJu#ka>19$#qjvhMbm-PITU; ztyRUBbi59@V~uMQLePO|QQ(+!k`|$QkrHhE%F=+6PZ7;-RI$K|jVXZya#8}RM5-c* zJn0g9iQCRfgOudk9j@4O$y5yEjNQzaY2BoMT*zo<4y_RU@oAs%ZlpjT2v;mot#Ds%q`~0&EP>gd42kCslsV%-bP-ifh!8-sIg<~B zfIQt0C0o?&{FD0ob=vtdwmk4NQrn`}lPF@UH}7(5y{^J;Dp8_^_jdB>yX+~8$50ef zqo(%fIy0Yh_vb!>M+;RCRcpBe4p%)k2%b>P0x+qB5CA+(WD+EQIw%vKk$*JvSsj*>qs8mBG9!G|v z`QUa%k%PpYvi~=e-)SL!B>OXOs~|EajtdmCK6>p_wcRi_J-3%qymfWv?oAPsbWb@e zQ3>ajnWd6=J}-z&o`UIMbdSr6RdsntZL7DRN?i2OU{KT@!R1%62-) zK-W}Ypj<`|CF6Gwb?i#ECPNHCcdmL#lzWz<1n`}ipCoH>(La;*ll*_w{v>$ME_&^Kid2Sb1S~QKKx$V zyOfBsL=z|<-0A|Kr&IlE`%H+qVRt_9AJ*^4-u7|jboxbkRb8oxua_SU-Tt4;&&kT! ztq^m&n;WdDq`Q(KFR8cJj=r%YMoBAdwek7k|h5I7Awn^XUWP zxIJ&QD=v{pXUMpbi8#eSP6kwU%;eSXYzy03V7j90;?i>Tm?F;)erlYg#}Vr>=bQ?M zJr9)1zkEsBUKS%%xkZJU5-07;iSbj`^;RX=4ae)cdNJV|#KUI^arvzd7e` z!|0gN+DT219}MkePLl$>p6*-r;EW?^5=KN40(HE}f#fzLd)sL$(E4W#c#~=#WQxIb zwV~YDgA{HzL1oOtT_T*(Ex?mA3wwn4uCF5*zao1KPnA_SX((12c?ZQfB{w~FtoHKx zCdPLO%S0AWr>p;c}S5wbPhe!~W7 z=-#f=6Lg|>Dykvn+}w0Ebaj(88v!|q2B%@hW|FeG8+kcy>uL<$X5+;%kaCtKl^IK@ zWyT!qnu`~d(PZk}lW?ek za#bY-0)@(SafL#A5U~>M#Y&@nu?}KErBAyE+w(Tj4fbv>tVslp1b0KZ4-9!5N1>LkyL@#@4c<+} zt&G__0T$vO zDrVKFWtsD;2%PPVje0!Z)f(@Wc!u=(4EA(D?0B{&#mHwKQ_YlT!E>_&ld>w22gs3A zFw_#4XT}_aCmOJfN0{mfSntG$i=PeN-L{A$4p(dUpe&5E8V6hWo4DvOiuHs~=-B~X05xUyFvn3o~s_LhT zaFaRNi?)@%(Y0+lFz>S&M-0YlXi?Wz=#d9i%?R0RZjlfbTgLKjNd``z>yO*}_-hZo zUuHE&v99c5zO?qx{9nqvJ)cecrr2=Vr30j7?AOACN%& zKT2{H!Hnz`o&b=hPpg(>oXSJ_tT?vTHaoVqYqQnB0 z#cz9(aT{(7m$dxz12t9*TpVuA^w!TqqHglvMa>8rri5YhUY@<$yksprL1RUH?D#Qf?+6J=c6fyh< zY5`85`*q@8V2JP~ux}Z-xVk@57kQ+W=t+V=LBUVKILzfW!fG>+SY^3&U4!}1(V z_EgIi`}VN?9IPb8B6ZuRbyHpH$Pg-R%D9quMowknKJP=i=szV%db}lHV<0Xahzh63 z?Ll$ak7EhDmIQQlL$qR4rW^qyOATg7m#{r-B}|c8Nv*vyS;&8(t;ss zXGvKKv^39mtvCXqY$q!#>(2Q-u58DjYO0RGG32g7C+X}8qgG#)Qbh+)#JiIESh0{@ z(j`BZ#It;9MXu~s*8An?&eNkf;KTxPN`Jb>ij71KKtMt}5J3oVn%kQ^#eI)P5mnm6 z%OM03H;eeFX(&Ak{yz@wx6LkFt>&g&*7KRnZ5THK%czs9@P2Q%>TwWje!obe8#`$1 ziPkVu7_SkNYBXfy%7|MP&70zEGjF z&h|P~qc$kNByGD+W|UY#itWYSF|kI>n#%~XS>y62^~{Q-t zJ9$^yi@4=U3?eM7qqwt)QHB1AC2@80zsJ)avdT`B!Wa<&qtZptFZ{F_bt%N z>@qD_B*&S;wPXdsu}VA8umEJspH9SoF*VOnVUz;7AsM@A> zvuk9~t3q`Nsc~&xEO)Ao5RO@6El-%`cIGJpqW`PAG8sMZo=T{x>BeQmj@8I*8I7i< zQ$W(^&wTQ7j6@NA@*ErT0)-h+={mKPN|i1wlPFmkRY68BIUYQj+S*1b&itVxxPY^Z zI(9OJv@B*g2@DcCCIQf-##0b9nAhxy$h0k)?{qnG&vSMQs~G(4R8Yz}rn|NkV>1ls z$(IljDeb18C6Cy zrxgqngm2jqECWgeYC{-3MC$JDh-FEl0jz@P%Da1+bWChhH4txID`{ZEFmego)~+#0 z(-CwKy%1(+CeG2_YSX$VYg!?h7WZ>0&8&x__NQi!+pO8FjbXQ$EL=tHh`oC^cqeew zg`%>Ux~zk+w88E4UuU5AJBChHb|>^zcZz$n3tx5{s8yYf-fMtH{T^71h_2IS0L%E;ITatVs5aTichB;=q`?aYxKYnJu!W1(#brJ&4o=4?ST zcEk{c=XL4JR_wxeRP0FYNy?{8N#{<3sS;rVS)5Ey3VMfVt<_>vJl3=xW~|DXuV#Fw z&BG@pRIaF6d$|psKu0QtN#Q7y$)yk$>f8Z6}G;65mrfMUU!v&u4LLy_9aD{P#7jj8=sK193qGZ~$<;;lqK1_uW(9!*Qi z&nxL=^|EEVa0u8z_i%ihG+mFKP(7?LZ@r0?=Qg#ixbSCrcrP;)bxN_hSSNH!nCqEQ zQUjdRILrz(XA{LYDus|t+!T;mv&Lel^Vi#M%v@$qSeNWngXnV2x_fZIE7cvD;hj_5 zY+>A8mI=rR67}QyJk5-#%4Co$5P~B{bhs>%-%lP#2yuM@ruAVNznlq4%!)5%Eq|#k3TK)0MQe-}5 zzd6g4je?y&D-x)xPgQb|l$40saPd3wx{NYTigxjN`d$i0|q>9eUDJX@3tkm z_Agp&EW%zN61VDm(M<9USdGr!Lsx?jW^M1(?NnWE#MtX)xz_PFw;m+71-1@4IX%vf zO>ed+sA;YaZhPICyY=jNT;2n7*7dRw(MjkY%=BMF_>eHjwiXqV$%JDTF#N1Pv-?ch zmDg~3bD7Ev7&Qa%;vq;fgb)}Rn0X$~oN#byH%$fOhEUmxWGtePp+iI^r7?_SAnU~& zInS4~tlZ9__Hij*ufMhH%erao-pa)`;<8&Lyxwe2y+_KK%E~KdkzAu%i2|hwicZEF z-F&ZI%Cn-5G4WjO8L3q*0=-hWE~@LTH7k}7b$y71P-kmdvsg9@1=xARcpB_Y^9ZV8 zfnT#ML33&swP@bwbnJ4`+pURq6(POF(gyarf`&tJ27v_vrGx;ig@_qvUO) zBkQ?5Ve^yPg}qKH#e_VIV|7_nlDfc|0A*7W0TeI^L+VxiGLq z5D;-9S12nF-cBq8a%Bsfq%nuw`IKXouEnOuU{&gEF7l-uJ3#!e`MMBASR_Z`Q@NB1 za#)5FZW?Gz5J3~!DKVIDpxiX2MkByzw)M4JIr4gW;8?JgjNJ4dJY9`Wn5IPKt#O=3 znb_Z>R-Nxl98s#q>}X)Y476b-@pl)rV03pk%YlJ_`acihKhxdr-O1SI z<~;|r0W2F@oZo0eOW(vvC*u5n@k13*Xk!hdnHb3lAY%OgpYZ+DQlWFd;iURD{wuwC z4$9eAK!?_tfVm!h5wLeniw6>PSqzDmA(OGA|H16k{5dqa_SuhC3#rZ8+}?!jZYzwu z+s0qUA`i7t1z=GH!*02N%@XGOAPHL*gc;UFN~Vy{Jd%dVKr&dM(6fa#tKUWMWlU|E zdgpwmNBq?qm^7wAIa+X8G>;}2Aiu@41qdPnzT~~XBo0pY3A8$8iQobP(ZhlGxtn0LG#yn-GM`U{Ob7^fYF+_tPu{b{iT z0~1#a8HO8S7iiN}6&xBg{bsmLbevpvgL{zX!;etgNwGG@A_P$eEQ+cqBNYWyL={9x zNg*e-emXJtd2<|h7UreK+c3dy7ZU|Btk)c?cLs%NxMJmV9M=VzaLc0#Hkv7Il@`Gp zX_kdz;Nk_gW>XN`RsgCPfT0@5qKd6GXk6U7)y=_Ll*>yt<|u7wTGSCyF}Ce7b8{5P zQL2|wrDVjBGU636iv^-Ww$mXq41@+25Gi8?ilD_6RYegLaVuJoE~SeiED!~X3Mp8j zSSTuxP*F%KAd1NaBv2$rH*L9?WiBS%6fkC#7FN5C<;PqM+E;6CVq)%>b*>I2Pf$Wn zT=jOJjW%`;#Ct+Xx`d(L!jH&8+;ClU~0e+!iLm^Jx@wsQs#`iGpulYC%*BQlp&=Ue^Hb&b+VZdMns3d zkNo$0zxP|`n{{K7%~_$dE_f`u7wwrDn=1TDH$c&3p`!sj58^o;KX+BGL7*oCl^3U{ zl)~hHBbe-1Zzipo1Z)gl-a^@cGii6qdA}jLA(!gbM7SOYAZ!4~Ji!RLN1a@E^YwW;>g=m#eUZXkF<0h{w& z=-kWL`89Ny0`dY0HTgb_OUmDboh4ve@y_W&;-h60sk)B?Ve>)uU`;SQ!83}M{S>v|myk0l=lj~6#nsAL6qAR#NM z_@@ND%3I|&jx$T|>Gfv9K$Bnm!?y&6jl8Ek(*i&>GEQ-3GT=_ z*z#>;6nx0rMj?hOs4Awji>;}&ZVaD~nG$~cA?p%r2q+qIS|VE+Jwui@G}DyU3-$6| zr2D?Fz0YNJv2jsiPD_1vsvtQ&7{h!7prg6)HodS!D!BFmW{+@H(Sh!DAUvI}1)-s| z)a3M|Pp4s1D!XY|&F^cyjt#OdAeN;!x#X1!vcUWeOWGIQ%>#oKY}vu-3Wg;DL|`6L zQfd79j)mUEOOZd5yn zg7(hQ_J~liCwcUJ_AMV;c(GL`n5;uUp9ijVn^zzE#7@sXvbuJn7KjM`K?q z;t7!X`4)f~ETw5P2uq-#PfGYB6^_-eb*}8T6K7@wu~;HXlo)h3eb?FK>Rs zXBM5~gUeR8^rgw}AGxvFm^qrLiiQu?v1qKzWHnbN(t4ifme&_(ia9XI9Nqr#J&Y@x zIygMcU4z*AtQmnHFV*#Z6tQNv!U%07#RLQ=>WN*il?6hB2DpQ>YQ~4Ix3A}bdgt?6 zcj{DWLodFR5)e*LVWOyld;pf{LutJ38F#zkWRYYfSqQQ~6+uY?C;~DNQUJ_a7LNoaqT1Sw zI5o=97)-&ARUogS0t7d<8sxsM0jCXE@|ZykLO}}g9j)Vo;gSkGyxhmJxvTOsqloQc zhVi8cB!lMPLV(!!tEQS^5_6z~vU{fk(@aF;VCAJIIvbsP4eyg?!!2Qz?P06b^Jvs) z_Em@;=1dr?dP7%GnrjNMOOsiAUPu+mhFSsQH#azKch;%BhE%gxR-n?(P9bxTQ4UpM zE_JyufEc_aPK~&+4r7)fi=~|#+Oar5vQXzey_C_KS2F_yDTzIT(#q^0wPBl3kH0U; zTNY};?%wV0b&n!mW6S|J0IgcMzjSC_slg8I9TKbzlQ7hBKt0& zG<{5fL)P`SMB{K7PAbpG!QzNdIqBg z=MM)K#D&Od36rgm!R>idXH&zG#Fj}U_y2hQL4SQE2>5yA`@4^k7Ei{r`63k^8*wl; zq0Ax@F#-~zB}FDmz`lU^mG=5%{9nWP*#6V*#Kxv2qwLUBr5D&=RK{vXKYr5`!i6tF z7Ld+;r0*6nTKCOgZ5De=Js4WzAHuThqedqWF%2|^a^v@(y8RkUvgUPFS6q@qGvQ@* z!b@l{n0y)6I!DH=(RPV`pPwX?&wKF~gcZ0JWmy;+&9=tYw;+Exu!q4BIU^x6F~TPJ2!W`D191zPkky7axHH9$E_XpNPzfVLvYrLK05H>?z zatFnUwnq8u_v!XeJ5=XT}L^8HvVP9aBE&VQr0!wl%;mu!BjX78*6_(w%( zxOxJW&M~0%+Je1D(8C3Ze4HK**1e{bdb3^5I~4n8IXy~jTTNUyKP;WE=20yNd06K+ zTKmV%k}!{5H<{q+CL>1?q=gw6Q_g3nean~^h{R)Xu%X@_h9K@w3SBbm;9{}WEP~3a zs_R~oiiHO;?J}@GqRYhCcGvsyTg0q|;tXBzLmMBo=lg!oPmMySqsBzU-Wd36CSE&M zbBnPg6jWDNvDa#uNYRtY&eC`iKh*Rw?)8B7;KRPd)bLj8G;7VhedI{GzV>toFvA1c zy+xNvr*3bVY{sLbjLb6(!(eUR>e_^B6Kxq)L=7vdHYPzU3btM6<7uzP4|QK>CL$lb{lJziPPSoPtXXTj~d$1I&U`PFFpA#SON*eg3lk%q@lvK0e~w&ROVQwa@F$N^#&+@w6t!)4_3Z2f)&ANj!Wd z_pE88F_$SzR|57Z$8z0Q=Q-o6VzJLA{FF$r#)8J7RIdE#d0W3TYqeVU+)^Dy>U;!M z1r${jQAHI&MHEp*6j4-IqKZ81`Ck1#JWK2Nl=h$2vmVc0GqE{OsrF;*A#!kF=?Ohq z(j$<~+laRrXe8B*rG3{d{0VCAG`Dq`8O7BtWzqfX&8-i&p=Qa*o&G-Prn{`b^Tw?y zl@%#iW*bIoagELn`7H*XXJZ3?$?$EGOA<+@IK*b}Q6>IcHN;{X7U$G7ydpCdAc%mWyf=&r1{U$h zeO^kYFSco-T+;|TVonSgE8I;51ugKcQsK-p%)a$1>NAe7mEQ_8x4QQ?8;nSZW)>j{ z7;-e0M=;DZREuEb#eQaQsD5K9+uywoTuwU$%-bR!ezar_1~ruka4@MIqx5FD&GaDW zYjziJIE>e+8qET9y-QG4(z9y_pPgDW-(^ zdZ+6nyoiezJBIUIUf}6;KBnV!M5vlWOb-^5Vty_M@d3mr8Y6DrDMHuQu5;6|sZXPp zZJBPISLNk#DvC@>!wgd-q3ZJY)UGG&-wdYacACt) zM?M6M=AfC&+dB7^VUk67$x$CBiORon_kLlF#D<~|d8Ztvf%QfcR)uM&LE7!O zorkJEIkmR8JmNwi#hOb2Fdfw{=Y~rC4+e#b2MR+;wP-H%fpwBA%T#ib#D&^8e_B_A)>5x`@vM))O2_~yIdBYcxEb8=$^$}5X z?<|lBjX3B7!IDAgDwSs>jYR~XoYmWI0%3+2d;5&Dbk#;h2L4KnZam}SQ2bNhP6Wfy ztt#$Ul_CnUe7C^I9D3yn`cD`ly&e;_1KK{EYWxql#KSW^`tNDCBMbdWjP*O_alRK& z22>QLOqf*1ynobekW`e%xXR<*F{=UCFgU51v;MnC50oO^vgL9P+lkG|T$PM0{1`po}C}$p0ZEXhaQyJL|+iAIQ(rsPGaPK-=FxEo4O)G_}{HIo9 z9Y}{HbeX%c)KtXc*vJhBnYy);QHjIgSl%%jSIBy;J}mqmEV|-c{*{}fm~FP(V{Pma z-YP5eX*3k$Tm9TEcVh}2a^6P>@aU3R#>c_vOOb6e z{ThlCIs0?coA_A07o{q)M4X_Qd*c%!(bW+lG|;Ju)T&=8BcLp>dlOkY#G#rLGGO@B zqjQ45k=Vmbi@8!L7E-$T^y#}vMKdpWMH)hkj-m#hUP{fH;kn&$stAg?Ez@$*hece< zflJTtUsBG)XA>&l3FtcniKGu(JTOw8>or9ifSA>p7o}fAp6p__m7jCcQ*W$;9ol7BFU+d&dU|^eIc5sC z9wu&(>SH5+Wfwuv#>Cf=$-KNR*e1rt#>U5@bCqR%w4Z9`RAcjdzK*s z_Kj>HGCup2vw>FRyBj3{c9c|z@g#H<)cKy}ZA&`#@X;E6)@`XBM}Mv*?c^@=uYsM6 zy2n!Rvg2u=If9vnVVGtahMTD~x|4lN)?%pjIs*0#TmU;}#=+OM@DSGJk6g zH=w|cWm*j3f^TZ2P(DTEclB%U*lXTPDkysFc%GYk{Dw9*Ha_pXNi1d=hGDTSs=j9O z%?W)D-X^qcyHfkIx;HL`xzo6rrMZkq4Q6&4Z5h`yRZ=}e8J{7J zzu)?eqC@p>Zpg+!w8fOmn95F$vl_lb4gr{E64q;Bs>-s_Nm*W=i=<5Fa*=Pf6C587 zYLimTSB4y%B07yGgFG9KQl(Tej+B};s-X|1u+<*4!>N}bj$xMC=+i4&$pWiX>`^9x zj-u}iL1m-V*m5ISau!c^OFrSF*0JI?F|o0+vC(*i=u*X)*zN0G%z0T$5**%{fIGHaB3{Z$Fg4u z1r-?Ha57_KW85wjPaB2e@tu*5f58V$3)wtC$^IKw)j&ZLt|aiqj&0ZWUGl%cZd4BI ziSe{k+c@IpUJ`B3|>|BJaIoG3^l9O@N-&iFjl literal 17984 zcmV(?K-a%QT4*^jL0KkKS-o_-m;krifBygf*#FOCfABy5|Mb8A|M&n21py!s01*Jt zKmY(C;8uTq_8cgbK&p`olKYdx}X z%$mRhYPD~ByEGJF0D4~U2R$HA08rR(aNIU%00N9gqEbax^})p`BrMuODMc%}+@$~% zt(hQHRaQJbSj7W22`E?qCM4O3BxnTKZJ7Y7CJG7^04PW*f9usu4&Z2|@$_ zAkY&8WB^SQBT4BJc_v4xqfG~>8hU}CVjh}m4NnjfB%&#&l6f@JG(AAm)CNre00000 z000JrQ}o0X)JUdDvr1v9nKC9d000000MGyc0MH3El1&7F$uOz<39@OR^-1K^(c6DChU0W@Z&m`s>V34lyYL8e0>RS-ac1kjpf2{Dj_ zc?qTv(dq^e(9i%4JxvCHQXF_|*8~PK0TF9Zh=_<%ltLj0W(WX?fPnABU^?qHNuhYJ zpS>YCN_GH%LJ$KTdJRfmRLaN4b9%72~`HtiUb8^~`T+jZ{$Pu)Jn#TQKV<;*tu zrn82obxStM$6Ir&cf$O#j5~fyU-kc75A6Qk4iwT*?=oqeNKlNm_CJ9}?B-ZKdW~8t zDU3@fdlyVNWX^lJaaX7=Wf>jR$dApzk^*& zGOd{@cAbxQ4*b}(*Yf9ci#u&J?aT3zn@<+XnZue^J*(lM)MhSCb^*G&{XVk^_9Bo}i;}J(t z$B46!B1%Q^#hkON?q5|W4C4$)?8D{a!LC@DaaC4q*||8ahYM3qN*O*~9-DMYce!<2 zl%vj~j^w%}#p^`Hc4G_)s4rS2PDC;=nK$EzfrLL@Xvd1tF(N;Cqu16uhL|JEEaQx}0|2Z8{3` zTgji*vgvJYdX+{JZ{Ia#T>D!m*ks7_>h=^qh=`F~i#jFv9<{*==+R5%ORDxz`Ipq#IH4XX#om2! z{y#DDHlC$~=l4Krk^LFoP=6iW^L0Ka<}!+CDyUznXrspuHi~=RRvab(&>7Io#bx2s_(H#KX{xqZ3(aq?(gKIcfGK+%6NIch-9p5H}2b^Rw9S zGLH&PqkO87yvVtW78~u#>N84-e9x&!)|QEejc<`fT8t?>k;D%HhY%Q3hpx%#hf z>pRK|4F=KZFoA;ODbMV(D zKN4_=N3ZaGlRo8Dee1GrQLYok&QaGHvu%Tx8SRDpcE*ySo69B8d!Vj%W`2toBs0DX zB>U9dZ8n__kkw(~d&!j!o83oj@ht8}Yqs@u=DRU5B1{G)>@gOyhh@eD&Ew}TvW{8l zN&`@=ra^6`-8&Dy8?&ZTGnoY`n95vbDW!=U%%n$=Aj&zt@F|1W78e2izX~Mu+Rov< z)2Xj>Qm@T>Zi6bq)xqPGlIv0f%h|QnQBPFTG3g+^V;sCZ1^>-Y>iDdVyxsCV6IOa8>I9bz z)m%UpX}X(uK@_h>RTmm*?qh?3Ay`bcX5OQ>TcUI#tgzPH9jlHxyr)Mtqi+J#HInS! zRzSO)xVwgdfnfmZk}+bcR8h#6PIj?TH;`ih!rG}Zbx={urjCHg5wnd{ zuP#9*(v@x|)rx^xQHeEE)(0=L5xfsD>kAP+q|qdEtRHB>9nEd9f&IeS`J)NR_Qk8 zZc42#_V*TC3!Dlls=e3}u3X+wil?h@ZN0gS%*3}RFZHq=lh7**+PZagr(N2$+Sh3k z4Q?x#W-7#+-9rjDs_zXA%`;(0v$<_l%4Wt|p<5A4U0=t4x+Nsrl`xC$5xzyxbIP=L@JR2 zqgv^sV=2_moSI6-GtJmk39iZ6Qe9)6?ywptXghZrmbleA8LDk=<*eLp@Y*cyQVNT@ z%cP}bQB-yjt$;F#xC?h2WK>W|Z6rk*L6qt;r$fpX-QKye(g&wes~$suE$v!HFD^9+ zdac;Tgo$hsCW#Khs*0VgZM@xgD?qt(VG5;&cMMe=iD1?fOiGHp6MB9Rw!cgJGwtE_ z*L<`b`&94cQHM3p$IvKbXc)&(djNO11xw%#=N%20g~5Rd1*yxKt8PUs$jud_ZsN0H zblRz*d1|T&mg{!pA~y-Ps@6s1#H|xL_bvjylu1`gm@2O564J$Jz;$?oT5wiwtXEt2 zI`j7$E$IZGAeXA*Kt0bKDy51p2XGr@r&P8zlZDG!O59*o8&f)VV@6f^ad2n7di&m8 zto>Y`?%N6HXiW7vR7YyIg8gT66cXD)p6_>NDdN53C{ImL8A^7f3dtDp-CeLUcAj;I zXyfYCLaJ6=5+gSvw#eO^)qH!Ixl3BnvL!tkY9!`ew=@q< z2VLl$&~N~@6|)ZY-XS6F#o)Iybk$k}r4*}BS5o&S2blnD?g%+@%1F&8j*J0@GA9<> zwS?6&jye%qV{ydNoph$E0nFHH>pxj;T61042a(rjw$m516egLIGWx9<3u|=)M`-e1 z?t@M{eU;j*?Z)6uPP=u`cb2Zmk&sxTt~L$iZqo#bhOOVX@%`Kg`qLk0_&&>S2i}nf zqa+wK^A70(5fA1B5fGFhA{zPb-DFAl7;PkyK#vG4WTb=wAWicLBr*~}0F04=2?(+T z0!cqK&b5ar@gL!>6nt%muJP+G`g46Wge)i<%oQ|GVQZ*FpG>K+v zrkPPU7gu=)6wKS4T9q85h-B8~XvG->E0cM-R``i?blY$s-i%X@<8w7ch`NVttg6dV zls4&$#fVfJc-V?|@yu--Lo}OPQ4!QY1A>XkwU2JGUCvg+*R;;&&Xa&}004$?ywHFl z+wnvIgu_XK^vPH&GC^9ASSA7lLkSx4C{um|)b2|> z?^I_9u=pgIj+fk$PSLC#w-uMS&Kf8gDe(vpgcP_q1~f^UE0qY7k+IBjm~!eQ8|4Wl z@eDv|i?=tlW+`k<6%AoCaaawN!gRY+W^T;8h%1h6x;Y@EZk~5V@JA%V(wv-$&C^be zrD^AJC9?-4*g8c9g^_1*aq32*7ztuQ!2uwxuwOLk4imeWlV^e&;G`ho)Sl6tc&gfl z;1Y8}6izXb2Ug@Um?SqaYKoSz(s31dvZ3_jH#OusZ!Yak)r|pY6$=*aF$-r<1ZK;0 zkzAyiTsKzX;F_wnl=813HAQmo3Q-cnPec*56LkWRTeu@FY#5aSOJN~8ww=r^SFx?; zs>;A!#iE5w#9*l|ZOtjl+|31RR}A2E;8a~3xObZZdqb$Q$jO3(?8H*UnoXnGk zS`M1oy0oz=ii+K0iJgrGvtELOGg&GUNKjbQxxP+Clx}A1uyzVh12U09=1$qh-c<;v zb+t}vh3IpaHYD0pCMRWBX3|A-5miz0Vb7TT$mJwCAN&wEe16?VLEUGk92@kTkIrl? zhw*-IkCx5O<44+q?0$nZ$LN<~kLWTP%%+--|ImGo`wDjDGZ7{j@HCd(esfU_4@32O z97|2)CW&c9M)K1^>wNnEij!IDZYfP?AJS|y(7BF=Lt1P%nT@+eHx!vDNAor&;-f*Z z)wwGy>*#fo;^Ok-2+z;IChA*V(yw>!{&@IDEtK7~(3yxrBN_XA(KTlCDJe&oo#xWw z@}j}SOy$J|8@Eh+XFIl@Cc{yQ;oss+c6pN)mXjUi}53>@)nysa!QM)m5M1G z?#YwBU4|6sJSZ>k6yKPv)u_1SXg8V9jaud1`wqX@XOUTPJ!CcH@uF;yC39%%*#^TD z&UFLphE0Sw!cpn3!dkxXi<`&K-YPM^iJbV|H;r5zsHll=!V@b`) zD$-hkQGm#_?rq|>uW(?)7^VzCz1A;s(pOYBV&!bb?X;EVz@e3vE#tJ7osO;OG$UQ0 zwjPP8yWO49nR+Wm8aZ2r>DC+@QBN}?Em=X;wCiUi+X^ZQa=tHnyG;HWPFwZ+9)~k2 z0FXV*d?qFpUB!Kmgkb25G+RC9GRpl5{P?>cqu%~VYLDUh`&KYyRT^e)^yWeG2s|K? z4?BuJmo^X^o!(&|j?%4EOi?(8)T;!76(My+7LFPFn)nL1fdyjozV@nt(s;Bi>J&l_ zgF=_r7D?9}@AJ*H)IzQ|vmdy9hz|+&yzaoZn&59J0>_5p(O{l1!PzJRu|(p0OlJvF})t z5$EGApnX7IWXHCLlWiQd11-ln1_x4Z&7KHvPFJg1NNr)gqsxZ1q~gQIF|22)1(2${ zkD1~*+v}>!n!44WYL^Q{S<-%L2~G7pWdz>`*fZKu;QPODEZ=MBo$xSD9LSn8!bvYP z%M~Pj2*AVwuo+^E%9`twC)j>I$zsx;FLW7JPHC0+Im4wpk}W4~E-}#I$3w8*yN*Wl zkxSg|IrLqjW`0(58Srdh7~0X$`4LrIRm+*>48=MC&$t;AX37P=T~vsm(F5k5YWGKD zd`E)|9%S%O!#)&+1|M2JFIU8Ta=TuAZUp)d3(UW-IU8<4Qb&wk(BbE==lbBD>l%>K z^kQ6z9lG1AutWt)9koG%Yr0!S-_P&T+r6%L&VZcbm|ui`4iI@;=2Uym1 zBz?CRdiDG9?^bzT+!)`G9pR~WekGi>j()PT_R_|t42~vw7(LE&hMAIR6SImbsxn$> zl;b$|mo6pPXM8ihIbDm4W{jS%pIqc4C}+lnbfr?}O(7=DD41-J z-A}c)LXw%^b^z@l$lk9^6(SD9P8=qUNK~~?Iy}jdI(O~+CkEKT<)0=`0`Bj}mG0j1 z`h#MvgrrO(0yz>=3N9`|2q`f&Gd)!@K8>nkcLah?Ud1(;UiGR@CY{a^%82QvfaRM5 zsLYzaXIW6A(ZqgFJ4Gm*VZMWh3@E6KZaOA1(si9i$6oIokR89}8F-!(`8&~}r7QMu z>5`#VxXwB6^rn}L?{x_eNs&*QFvB8>C&bFaJv<6UW}B~Ex7s*27%r=IN8H5fFFvQ# zrefsHvRa>geYbcY98IUFbUs@-1^P#PI{FyAw5J{=rMau@AWqLxlyU4*U~@3L9M+jn zQ^4X$r)0#(R!R)zn|0)y9Wu)_YB%F`6Kfqo zcMQb_W4p)K3e2aCXP}~s-fcLVjt6vK{mRw#OCex%`t~3`u`RfryfPJLJTRA6D7w(^5YVM5 z4Q5euI`@bR*uk=L4%O1yhNNyvb!P5wW)g2j&em@1YnELTOCDWF+%B@`J|DH#{fPR# zdhgpF>}XAHy0yONwhFho(6QIy2RTNI-|>86>LU_D%*6i^Kyt$(roj_ar6l4>d3MA_ zfZ*X!U~^{9X-?BgYAV}O&qa0(3mqsv$w|?3J`S1I2!*hsg|D&sRdV-scse{>&hZ#b8z!9SbQmd{6z0mDP}vkv;*(_9 zU`a{t@jB1A^K+Px+&zBtBkxi0G zQ!<7>7pIqZWpq-tEfRqS8JYCk8roA#_gi8KB?**4RS=Sx!9hqUEK>2XH(?DiMTJ5f zHs{BN$9Vv#8?pstJSbL9cF1x#y2u(uAQz=1teKmKEgC{ZV#7C}82}KCk?m9HQ{-~b z5u?tSwXxR7rl7(|6HVOi%(K~ra}V5SF2_`R-w7ktZ#?#3k~AR5<=>Mb3W|fuh14t- zB(54f1iu%!jSb5T2}Vq9RZNp271OVhQ3Dk&iUq)?eq#e6j{cv1i*|nS6j@ zpF(hbC^CN3$f#q1gpstkRrn%)P++y;_I)=!-0qrk=OIic;c1+_WOT_~M~HS~ za{Fo!lq0(tDwizrT|7()2EF1W?`13@XW+YJX}+rM+u(&@%O;@4}075 z=bVzqq-@FzU3%n1e37NjRm|gIkbGUzF05in zI|++PwwX3{t)4R^qM+P12@aD6jS$q7N>TJ z2jsTq&tp|TpM{26o@*yuEhikq9Cl^hwBhb@EHd}VaHlMFifAQHTeej}G<}X)MLLP; zJLdWyGmZC~a`QNyc{z+Vy`0Snt2UY1VEKE4pqF}y{Ow% z*|27+oa{V??yhhFwQ0b-TrSo|(rDYIB0l%OgP(kT!}ap~dY@pp`A_J4xmbR(FkRvi z8&KtQh|v^7A{+dmzzC1!VhkS*7B|ko)TMa%AnSnh-hN#YP{iWTCfyfsSyQ}`dN@4fTurXj?&(lv!+&MaGB`$|5Hk%eWjQ>j;-5Q3&!jsx;B`=IvbB;I`#O{8(ml#S^2k<^(8N z)B69t=J+J5z`gk|@FDFC`XP4`&!=Xjnp{o>1m94LA9}MOIL}0O;)SZIQ7oTL zW{caPGck}zAeZZ6a?)_hNKsosGDmX7)e0DCA#pWsc!+0{DYehJl?vvqrap+%`LzB= z2|S_mz;dF{tm#G6Gety{n@*$iiZGhZXN0Mr3OpF~OO(99gXrp$#+&wnsp)hhuWz%E z+-zN%uasyj;wUH;F^5qS5 z2g|s)sF>WN5IBj)Dx7qOO3*NXbWoM)5Fip&IXr}k;EW@z4{jekSV&=FM9pP5adv+SUtVE7*Ak;{Ra zy9bperKP1^t32;?+OyLo2BJ5>hJDbnzUoR+oNj6Pn7SP1mEdeIRdjylbf>9 zaAqQRFeOR?VPrVU6PY_uP$v>_=A2Gt6RFg@sbE%{B}~>u^ra2F$Y2?}s(Q)+=vHJQ zS2D=7aw{tFxKRxwHs@`nX;o!hX1m;>i*3@nA_cY}RM?YxQEx@$!O}-gA`A1u9Mi=`N#isj+;fo&hBhL|HV_$C*y+L<;qefCG$<6V z;vsL9RQXCF??mC}25Lv0t@b?|&US3IPQo@pvs)nUtLjEN(U?|QRB^thpTg1X{96n$t03C+b4}jVah;~MlKQ;Qmk)@N5;U85((jo@-53KtVnd(<__d+j$=Y< z%Yx4l5Al!2KRau}g1@lpUkD!{N4BoUB+t9Sx{&~UBIOD-t_y}yA4QNdI%AMHNal<~ z0ToqI$RJtZ>1Ttxq6RA(to)<+`&HU_7kU}^ao3Y5VypKrYiCMPGN~bVH9c;bhh2Su zpvlu)9nJes+Bx(9`B&|EA^Aj2b*1mX!?8vs@w;N7ryPHEc55w;&eZ)gm(%A5b=Gbz znSFRVqE?#hL(U#H5(mK7kdWvS?#x5%x|$qv`}3sB2njjGZZ`y$Q|=;3;Z5WN3@mrdaQK|vw2}= zeD&J5ebUCys$ux2ZuSLsYra|Q^Lga=B}>)${Lp0hoRhnNb?Yu;R)_MD1m&V^7cOGa zNz2&isPfnwp2}!bq+V>U4<1}W?j^?WW7LVTP*F}tY1ycmA=YaiPWjbU(S>e(5Yf3; ze+GIbM5GG?)bxH5L>-P}bhm^rkvj+@#-n7E@Y=q*Zg=?F52&9 zYeLM4QPU1GYderu&-}65FIJK!%3@x77X1sa_T8=hnF^?4{FLpBrlQ+`z z!kXxdfCM8J@J-W^HU)2er<Ikw)i)TtPff-$ps|6A`;pfoY31E5f0vepHIVXHp$D-WrjZ3oW!~r!9h1ByTJZ zO}gg2LpZ2FITu zk^~3DL*g?al@%})x5vHu)Yf%q4mI=bdeE}p1jWB>?g<}CyW6( zM`@dI<&mAj2H8Yh!`B>r^GtmakkS|=CiBVH>*m%BM0oE$;!F4+fdjf@q*`Hdo~o)y z?c24mX6R`F($x}La4G6ZY%Sc~oo!WR!L7Z!Fx}oPOC4oD(L*jU=UmiSyg?JFX3G-7 zO7&sM;)6s;i!5HwPP48v6T4L|&CJL=*<|UHa8Sw;N-+>XfI=FwmE%Xb%eeRB=R|v# z=Q|u)_^0Jr9003Xej0`e{tkSa=~ff2u2R%U@zX zKcNGt`>6Oj<{$x&q0tqCv$5iOq{%k*k|3F{9afGT4T;#7hLVs|mb%xkP*WmIC_Zzr zo(1Gw>#3qUU$=BHd#!lH(l=B2o~Wf4MyM^O8{ZLAMn z>)okl^5Tj*>TtlNiWSai8!1hep+!b)L@@yv6OAm`iIkQi>fvS5Ia^njWTt47RkM1M zv#eC%lR+ESvW5n;WXw?0R%i%AX4yMqZlapG#A_5SpRFGk$pX9Y#rCu$JW_P-qGgob z66cZh<|PlMYbEc}>BWzx5WA5x)f_PJs(dkIKaM@vQSEw9D;%u#PjrREqts8XCwJ6D zVSiJfQ_(VFCloYjQdqCDSn+LEh9fc8YQ64@5DHrr-rO5h(CsI_d14}gtb>muGp64{ zl5VpD=((sGrlSv<_pT>*a zv+?-XQnCm;ww?CG1s$Me+F!0Wx?M9-)VlAyoM+sVaWnMBcbZD{H=KNx9^Dx9n>*$V z9UDjoBREj;W|T=hMIuay{I^~oqm_cCrA}Q>vt8=Qfo)YD3rBQiU19g3_H-YUDlq@|kDPY*nJg9{dXq^?S)6 z=V90`oD~L|QG6D5zg@jfd)~30&7@~(M0CT+GR->#ARUZUc54|r@2z>%(Y8aScpDf@ zs?=W|OIfgTrODXQu_!`_0}ftmJ85n1myskq;|DH+wP8Wv6S|{f=Wg)KNYRuwEZ*ou zT!_kvqjvOOGbb2l6UVh^Ub)DTRi!nAnmL%Hi>yVO7h@`x>ZdbC9^PN#JNgWFdiqhh zu}8@orlRaz-)`=h*kZ#KmjnqNaKE68SmbiAm0j>Un!`%3h~vuc7j*eODu}W=cqg7O zPX^-Uq&ebR2$=?EPD7+gB#=mp+34Hdf|s7mF`3qgr2xm43e~WO2E*?{y@?uoSE1pC zNu&%S>^@oK%H{R39^-;k6wwk#cdrOCnsTl#;UOUQ^p>Ba{g%?VdTFE73s1^)c%BM|YWJvL=gkC-0lq7c-EMDg2aS=l* z0fBNlB@Bs&v`lCk&xa22)+`F?NgG*sFrYQJ%C! zF>^wirbnPexfLyEuJ38q1c7*(N5MA()VHl|_&I=Bf+~JtZy9k5Y$VY&joU+ANeWsmJwu!|x-qy{M9<;{8mdAlKU4Re z8Q}2dSZ1!xH^Bj17>c=DI{?-?t8NjrXy+@C-V=>!m!qnF)`%k{}4^b^CXP#uKP=Ow@-vyn7fM`iz9;>gsua2I-uMsaouDo+r!#){(Z-k@53Qx zc)3*Uso)sU%fpVctB5+nKt!_u)FAV7*}6{0rTK2FTte?Woa)?&t+OJ@}SuOTxnP9zG ztg9BhDY>TB{fVP;$zsj6VT#&{v_=VSB~r_v7NK;kx}_pG;~71C)=y_YI3MUipOmrVDWNZIlYXc7~qLSr^&%rrD`!sD)hJ2Lg$RVL{%`DiI|9V^{GSNbU==- z4qQH;gjq=LQX*zwjjCJS9Go23xx|f*$+{XP6Ec{db4Y0`OYy^+Q_)0V!i?qfJ#|k@ z;hMXfqRz$X99C6UF(2~aK^0(;A6+<^K&HirVKs2kpqLy64eNZFfOB-?+55+M#g2B6BTZc_ z$O4X07}97;YcF*dxk_Pd$EJr!&Ga?Wo#}|pu}IsF4v9)}@?9#W7Ws@==toBssd;Lp z7`CX(OEaft<*S2};emZ_i?d!EQbe77s0DTiYm873zZeom@Tx+amlN!hLEC&jKy33B74Am>9<|Zz+b)*X5tCbl{ zqz$E{Q$h)?7-kg%XsCjF2?FytY$(xTPd)mwF?n#Jlo|3*q^K=93_&g{6ho-6PZt*4 zn3^ecq>P(X=8D==gi0wCn1z*8l@gLF>gxO%6m@+k)_FH>W1Gd>Q^G30z}j3{D3roC zl06Q}<7Nt|-LBKg-`$9LnMAR|pP*qVD;Wv}7J-A5|JUj8{r|bs&9k8UtYJ;9PS{mFi#jqa)D(P6CeasmLX4=-qG@HkkGJzpMMl0TKoRIuV^9!JZGgw+GWfYMjPDK7g5VQQGf!yWI$Qs^-+- z)KVf593mnJOR4?-f5Z4W^9f$2rBM+@H?txv2qFYM9zZ?)z5VQU84Jwkxr%6O zox#>P=t0S_WGXp@VL-^5{8`6jSGhzdwJ!9lQ&CW)q7Ox#>d`4_x<0~hc%&%Q$E14Q z6U#<0;LX*!(R+d(wC}2AF*b++4UTP#H<(3UHLOZL^C8$I(+DUUI2MSO#!lekD8@}< zV<+uwd+GZ=YcAmIvlVqWJ_Uo5!#QIyKtprEwcRO@jQXPLyURAD?`k0B8{;MBD&Ex5 z+f{#8a?LE?TWfii;+{-2!74?S;@6>QvWY#bF;$KVoT6&F(UZ1NjMa)DkK;dTzj zwr`EK&7rY$wY{*L!kWqmfQCX& zu{3sJhNi+IhTD+1eQyEU)_^sIreoa4S^Fm=v{;{xD0QjvG^3n-+RDUH%C+rDggljs z`cko5z8*1sY}{S0)3r${>s^V0?G&-=ZDou?|M!a*%DXjuOr4t_Yh-BipMP_9v9DEO z5e83n*PBY{)m;~-yz{zmX5Rq~5~4b|`{;Ki4Qg#<>dmkbauH^V1(1EaMK~q9@Wiq3V+t22DW8`VwsGmwH_|POrj5$StJI7fRVJO_-^AvD! z@mkMA#R4Us^stX7aKoO9FkW9Bm=WgwjryoS`ZbXwVc(6EZLK8%3gDHx~Z}!=jF-Scpdmh(uXtZ^H_()X6;k+1;8DwrDxYAW72(AJ5R; z(LoU0sQpN7dlZOEwc5NIJlLwtm^Q+6Ow9F*Rwf$bZ`e@tGd$Yc8=fx|q3Vm>DkzGf z9f^+fQzj9Yi#60R8)VV3NXh1O>~iSlq@^kIe-ZP9{zy-$^eOZF2gFUz-LK%Z)2iG> zG0O`f%1TW^!&yzKKB#?zZ23(J397JABhFtvyN+RLtm85nVpS)ynzKVklh^y)6pi&a&1#xKRsvbx_J zXfT*_)vjo|6=Md|FR$A)XP)Q7 z{Qf2I>b`4J^LBAaf>Ls=2p)(pL3*zCgjk(;rAAd1liHbwPxq&CqOY-`MblzjqE?lj zrnNy;6-7~17P}U^a!_2E`h?mi$KGWg-_>$lQS0&FME^T{(^_T450(#hDOS?mNH~P} z={O|D?S(#R2oRh}SS8|rK%GUQsMV^{+A3Po8#$)4broQ#vd!5COiiFOD5?qwiYJ;J zr`0@ViSXuNZ9PRt$=4^c{c(DbW>f0Qth1q!1+b;~{sH$7>8qLz)ZQ)P4>rGMf#=0Z zw!-=A_UH4Sb*Y+$JVbyLD-*~RPWBl^QGJcSukFvu0Rzp#p)oghUKKtnun7pygjd zGwL;UWA~QKYdNusilV5v9b4M9p$&pBP^nc9H77(iqM%7cty8r97MnZX=B@c|w99XL zA;}FW^qvx7U>wTNftyo2>F}i1-g8lugjw$OkmfXfryT_=9MwN2LpWAiRys$i2f5I7 zWXUtf6KzjM4RV`CcqJZ?9&j=-$?Waznmage@*miWB6)VHt458bsxJgUtfxNVc_!Q} z+{OT+h-pj5$dZcK`}vaenlntT_Vy!zt=&oHn|$dUiryp-D6%SwsIw-G0rM;_aP2sf zx+RZg6p;7E6B3B^7DRZDoej1JZ;~K?6oa(t|<8>iW+v!^!2-6{QcOY0eGGJ zLcmdX_@C-1kl;`T1N)AR>}cMJbGf(Z%kmE+_C`eCFll8HnK8Q@>Jkj}p)4{R--O@j#N7 zq2_8SHJGRHm`Zz$-R6ZC!1pwn(E^v>Y3FW)GUkeM5Z^>OsV3o4GO|*$Y$UkV+Dp%)K*i?5*cly&u?NkJ5!3MMR8)`;yzD&$;5=a zGL!wp5zP*xVV|gHJc_c=Ov&q^J*1dsie4%u5b;ymh1wGnS-7y)}p* z!Y2e(%9r3-BtqF7lBX7*F~f3mp1EWo0n<^zLvtk#kKTyx!Q%F#GDkWlQst1EO79cA zRTn>TGK=?_C2o{byp(LFYXpwO@laoOL`G9ia&3zB@TpA-g0EFKCk;nZb)92*Qm}r( z_0noi7Nz;lil$nSe?$(( zInpO0Hujwl&(jk(m)nL6oM#kKMHG1Z=Nr(Q;GUBeL!r$O^$eYq{V_!? zIstK$A-^@jl^_a^@UYc*7!a(hNuV%A^{Pno!9E9n96RzDT!~xJmk6DwtB1|>gi%Ew zgX4k9LP#&~gatI9ItHk{yY zWU_MLT!{;|P1p~A(xQqiL{;R|auUEhVQe`fnL57iiN#L_EE4z`w^uqh6B%5lL`2wV zQD)PjI}LS3$o!^^##;Yp_zt8%cD?K1hEe6FOy+z{oDBzBMK{`n#|J;LDJ@C}V#?zY4kd*}EM_&E8%l`lS*CZk3j2y3>-1tC>TXi` z#NpWKiMHEeNwYQSmkyyFiSUOCaGhTIhngM`^Bg1M?oOT|htZt8hgvA2iaMR4zKw7= zBBIC5JCs`K)vIW^-ddzqCd?L;BxD*@r3sRnhfD`nx9d92HcG0Z0x=X|s;VfWiYTIr zDEiI*Gtm>;N73B_r#?`6R4zja$@rLEJlC3x%+iqJXAV(yYFMVzYKyf55P1oZoKGTe z#?Mr%`52um&1n@CMZwFQVd(W0X)9G#RmvuGG(Go;-8!L`f5`*0N_r!N1xI%6O{qXV z3Dbc)@@1R(Z|jolU({wthjgn;OUIoCRzyzsv^0Z^is8bmAUr@h&~>NeKe#XJEb>Zi z$uO2D<5~5^I0;~?FBTa=awaKz$J$%SLE4fD!y1$A`pt*~n7|fh2pl`cpZL3yDZ+$> H>!sYl3FxiM From 2dfb2f770b3ef048938c4b30e2cdcd45893330a4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:40:47 -0400 Subject: [PATCH 221/503] add chicken to default species --- R/Data.R | 10 ++++++---- R/Internal_Utilities.R | 12 +++++++++++- R/LIGER_Internal_Utilities.R | 6 ++++-- R/LIGER_Utilities.R | 25 +++++++++++++++--------- R/Object_Utilities.R | 38 +++++++++++++++++++++++------------- 5 files changed, 61 insertions(+), 30 deletions(-) diff --git a/R/Data.R b/R/Data.R index a2f9146062..a327d9232a 100644 --- a/R/Data.R +++ b/R/Data.R @@ -10,7 +10,7 @@ #' \item{Rattus_norvegicus_mito_ensembl}{Ensembl IDs for rat mitochondrial genes} #' \item{Drosophila_melanogaster_mito_ensembl}{Ensembl IDs for fly mitochondrial genes} #' \item{Macaca_mulatta_mito_ensembl}{Ensembl IDs for macaque mitochondrial genes} -#' +#' \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken mitochondrial genes} #' } #' @concept data #' @@ -21,7 +21,7 @@ #' #' A list of ensembl ids for ribosomal genes (Ensembl version 105) #' -#' @format A list of seven vectors +#' @format A list of eight vectors #' \describe{ #' \item{Mus_musculus_ribo_ensembl}{Ensembl IDs for mouse ribosomal genes} #' \item{Homo_sapiens_ribo_ensembl}{Ensembl IDs for human ribosomal genes} @@ -30,7 +30,7 @@ #' \item{Rattus_norvegicus_ribo_ensembl}{Ensembl IDs for rat ribosomal genes} #' \item{Drosophila_melanogaster_ribo_ensembl}{Ensembl IDs for fly ribosomal genes} #' \item{Macaca_mulatta_ribo_ensembl}{Ensembl IDs for macaque ribosomal genes} -#' +#' \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken ribosomal genes} #' } #' @concept data #' @@ -62,7 +62,9 @@ #' \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} -#' +#' \item{Gallus_gallus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for chicken} +#' \item{Gallus_gallus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for chicken} +#' \item{Gallus_gallus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for chicken} #' } #' @concept data #' diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index c44b7f2252..d3577860aa 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -380,6 +380,7 @@ Retrieve_Ensembl_Mito <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options if (species %in% marmoset_options) { cli_abort(message = "Marmoset mitochondrial genome is not part of current Ensembl build.") @@ -403,6 +404,9 @@ Retrieve_Ensembl_Mito <- function( if (species %in% macaque_options) { mito_ensembl <- ensembl_mito_id$Macaca_mulatta_mito_ensembl } + if (species %in% chicken_options) { + mito_ensembl <- ensembl_mito_id$Gallus_gallus_mito_ensembl + } return(mito_ensembl) } @@ -446,6 +450,7 @@ Retrieve_Ensembl_Ribo <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options if (species %in% mouse_options) { ribo_ensembl <- ensembl_ribo_id$Mus_musculus_ribo_ensembl @@ -468,6 +473,9 @@ Retrieve_Ensembl_Ribo <- function( if (species %in% macaque_options) { ribo_ensembl <- ensembl_ribo_id$Macaca_mulatta_ribo_ensembl } + if (species %in% chicken) { + ribo_ensembl <- ensembl_ribo_id$Gallus_gallus_ribo_ensembl + } return(ribo_ensembl) } @@ -512,6 +520,7 @@ Retrieve_Ensembl_Ribo <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options if (species %in% marmoset_options) { cli_abort(message = "Marmoset is not currently a part of MSigDB gene list database.") @@ -591,6 +600,7 @@ Retrieve_Ensembl_Ribo <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_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.") @@ -623,7 +633,7 @@ Retrieve_Ensembl_Ribo <- function( #' #' @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) +#' zebrafish, rat, drosophila, rhesus macaque, or chicken (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. diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 3ff7b753fb..5cd702c0f6 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -2138,7 +2138,8 @@ Add_MSigDB_LIGER <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) if (!species %in% unlist(x = accepted_names)) { @@ -2246,7 +2247,8 @@ Add_IEG_LIGER <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) if (!species %in% unlist(x = accepted_names)) { diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index df9899c86c..455c9994f1 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -303,7 +303,7 @@ Find_Factor_Cor <- function( #' @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 +#' drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically #' generate patterns and features. #' @param add_mito_ribo logical, whether to add percentage of counts belonging to mitochondrial/ribosomal #' genes to object (Default is TRUE). @@ -476,7 +476,7 @@ Add_Cell_QC_Metrics.liger <- function( #' Add Mito and Ribo percentages #' #' @param species Species of origin for given Object. If mouse, human, marmoset, zebrafish, rat, -#' drosophila, or rhesus macaque (name or abbreviation) are provided the function will automatically +#' drosophila, rhesus macaque, or chicken (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". @@ -545,7 +545,8 @@ Add_Mito_Ribo.liger <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Return list of accepted default species name options @@ -591,16 +592,17 @@ Add_Mito_Ribo.liger <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options # Check ensembl vs patterns - 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))) { + if (isTRUE(x = ensembl_ids) && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_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.") ) } # Assign mito/ribo pattern to stored species - if (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))) { + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code mito_pattern} and {.code ribo_pattern} will be disregarded.", "i" = "To override defaults please supply a feature list for mito and/or ribo genes.") @@ -616,7 +618,7 @@ Add_Mito_Ribo.liger <- function( mito_pattern <- "^MT-" ribo_pattern <- "^RP[SL]" } - if (species %in% c(marmoset_options, macaque_options)) { + if (species %in% c(marmoset_options, macaque_options, chicken_options)) { mito_features <- c("ATP6", "ATP8", "COX1", "COX2", "COX3", "CYTB", "ND1", "ND2", "ND3", "ND4", "ND4L", "ND5", "ND6") ribo_pattern <- "^RP[SL]" } @@ -785,7 +787,7 @@ Add_Cell_Complexity.liger <- function( #' @param species Species of origin for given Object. If mouse, human, marmoset, zebrafish, rat, -#' drosophila, or rhesus macaque (name or abbreviation) are provided the function will automatically +#' drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically #' generate hemo_pattern values. #' @param hemo_name name to use for the new meta.data column containing percent hemoglobin counts. #' Default is "percent_hemo". @@ -834,7 +836,8 @@ Add_Hemo.liger <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Return list of accepted default species name options @@ -876,9 +879,10 @@ Add_Hemo.liger <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options # Assign hemo pattern to stored species - if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options) && any(!is.null(x = hemo_pattern))) { + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options, chicken_options) && any(!is.null(x = hemo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code hemo_pattern} and {.code hemo_pattern} will be disregarded.", "i" = "To override defaults please supply a feature list for hemo genes.") @@ -909,6 +913,9 @@ Add_Hemo.liger <- function( species_use <- "Drosophila" hemo_pattern <- "^glob" } + if (species %in% chicken_options) { + species_use <- "Chicken" + hemo_pattern <- "^HB[^(P)]" # Check that values are provided for mito and ribo if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 96c98419af..4d104d43e3 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -86,7 +86,7 @@ Merge_Seurat_List <- function( #' @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 +#' drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically #' generate patterns and features. #' @param add_mito_ribo logical, whether to add percentage of counts belonging to mitochondrial/ribosomal #' genes to object (Default is TRUE). @@ -200,7 +200,8 @@ Add_Cell_QC_Metrics.Seurat <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Species Spelling Options @@ -211,6 +212,7 @@ Add_Cell_QC_Metrics.Seurat <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options # Add mito/ribo if (isTRUE(x = add_mito_ribo)) { @@ -243,8 +245,8 @@ Add_Cell_QC_Metrics.Seurat <- function( # 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.", + if (species %in% c(marmoset_options, rat_options, zebrafish_options, macaque_options, drosophila_options, chicken_options)) { + cli_warn(message = c("{.val Rat, Marmoset, Macaque, Zebrafish, Drosophila, Chicken} are not currently supported.", "i" = "No column will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field IEG Percentages} to meta.data.")) @@ -299,7 +301,7 @@ Add_Cell_QC_Metrics.Seurat <- function( #' @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 +#' drosophila, rhesus macaque, or chicken (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". @@ -308,11 +310,11 @@ Add_Cell_QC_Metrics.Seurat <- function( #' @param mito_ribo_name name to use for the new meta.data column containing percent #' 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, human, zebrafish, rat, drosophila, or rhesus macaque; +#' species is mouse, human, zebrafish, rat, drosophila, rhesus macaque, or chicken; #' 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, marmoset, zebrafish, rat, -#' drosophila, or rhesus macaque). +#' drosophila, rhesus macaque, or chicken). #' @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. @@ -372,7 +374,8 @@ Add_Mito_Ribo.Seurat <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Return list of accepted default species name options @@ -419,16 +422,17 @@ Add_Mito_Ribo.Seurat <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options # Check ensembl vs patterns - 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))) { + if (isTRUE(x = ensembl_ids) && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_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.") ) } # Assign mito/ribo pattern to stored species - if (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))) { + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code mito_pattern} and {.code ribo_pattern} will be disregarded.", "i" = "To override defaults please supply a feature list for mito and/or ribo genes.") @@ -443,7 +447,7 @@ Add_Mito_Ribo.Seurat <- function( mito_pattern <- "^MT-" ribo_pattern <- "^RP[SL]" } - if (species %in% c(marmoset_options, macaque_options)) { + if (species %in% c(marmoset_options, macaque_options, chicken_options)) { mito_features <- c("ATP6", "ATP8", "COX1", "COX2", "COX3", "CYTB", "ND1", "ND2", "ND3", "ND4", "ND4L", "ND5", "ND6") ribo_pattern <- "^RP[SL]" } @@ -532,7 +536,7 @@ Add_Mito_Ribo.Seurat <- function( #' @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 +#' drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically #' generate hemo_pattern values. #' @param hemo_name name to use for the new meta.data column containing percent hemoglobin counts. #' Default is "percent_hemo". @@ -587,7 +591,8 @@ Add_Hemo.Seurat <- function( 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) + Macaque_Options = c("Macaque", "macaque", "Rhesus", "macaca", "mmulatta", NA), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") ) # Return list of accepted default species name options @@ -629,9 +634,10 @@ Add_Hemo.Seurat <- function( rat_options <- accepted_names$Rat_Options drosophila_options <- accepted_names$Drosophila_Options macaque_options <- accepted_names$Macaque_Options + chicken_options <- accepted_names$Chicken_Options # Assign hemo pattern to stored species - if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options) && any(!is.null(x = hemo_pattern))) { + if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, macaque_options, chicken_options) && any(!is.null(x = hemo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code hemo_pattern} and {.code hemo_pattern} will be disregarded.", "i" = "To override defaults please supply a feature list for hemo genes.") @@ -662,6 +668,10 @@ Add_Hemo.Seurat <- function( species_use <- "Drosophila" hemo_pattern <- "^glob" } + if (species %in% drosophila_options) { + species_use <- "Chicken" + hemo_pattern <- "^HB[^(P)]" + } # Check that values are provided for mito and ribo if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { From 185bb1cbb7c3800bd1a27f0329959d0b99b3d42a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:42:17 -0400 Subject: [PATCH 222/503] fix missing bracket --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 455c9994f1..fe62e212e1 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -849,7 +849,6 @@ Add_Hemo.liger <- function( # Check liger Is_LIGER(liger_object = object) - # Overwrite check # Overwrite check meta_names <- colnames(x = Fetch_Meta(object = object)) @@ -916,6 +915,7 @@ Add_Hemo.liger <- function( if (species %in% chicken_options) { species_use <- "Chicken" hemo_pattern <- "^HB[^(P)]" + } # Check that values are provided for mito and ribo if (is.null(x = hemo_pattern) && is.null(x = hemo_features)) { From 5921de3f3cf292e51f550acbbbde3a723f6b6554 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:42:51 -0400 Subject: [PATCH 223/503] Update docs --- man/Add_Cell_QC_Metrics.Rd | 2 +- man/Add_Hemo.Rd | 2 +- man/Add_Mito_Ribo.Rd | 6 +++--- man/ensembl_mito_id.Rd | 2 +- man/ensembl_ribo_id.Rd | 4 ++-- man/msigdb_qc_gene_list.Rd | 4 +++- 6 files changed, 11 insertions(+), 9 deletions(-) diff --git a/man/Add_Cell_QC_Metrics.Rd b/man/Add_Cell_QC_Metrics.Rd index 992ba36c51..71cac11bbe 100644 --- a/man/Add_Cell_QC_Metrics.Rd +++ b/man/Add_Cell_QC_Metrics.Rd @@ -98,7 +98,7 @@ object (Default is TRUE).} \code{\link[Seurat]{CellCycleScoring}}. Only applicable if \code{species = "human"}. (Default is TRUE).} \item{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 +drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically generate patterns and features.} \item{mito_name}{name to use for the new meta.data column containing percent mitochondrial counts. diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index fdf01ffd3a..adead8da6f 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -38,7 +38,7 @@ Add_Hemo(object, ...) \item{...}{Arguments passed to other methods} \item{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 +drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically generate hemo_pattern values.} \item{hemo_name}{name to use for the new meta.data column containing percent hemoglobin counts. diff --git a/man/Add_Mito_Ribo.Rd b/man/Add_Mito_Ribo.Rd index e86a009b63..b0f90cdcc0 100644 --- a/man/Add_Mito_Ribo.Rd +++ b/man/Add_Mito_Ribo.Rd @@ -48,7 +48,7 @@ Add_Mito_Ribo(object, ...) \item{...}{Arguments passed to other methods} \item{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 +drosophila, rhesus macaque, or chicken (name or abbreviation) are provided the function will automatically generate mito_pattern and ribo_pattern values.} \item{mito_name}{name to use for the new meta.data column containing percent mitochondrial counts. @@ -61,12 +61,12 @@ Default is "percent_ribo".} mitochondrial+ribosomal counts. Default is "percent_mito_ribo".} \item{mito_pattern}{A regex pattern to match features against for mitochondrial genes (will set automatically if -species is mouse, human, zebrafish, rat, drosophila, or rhesus macaque; +species is mouse, human, zebrafish, rat, drosophila, rhesus macaque, or chicken; marmoset features list saved separately).} \item{ribo_pattern}{A regex pattern to match features against for ribosomal genes (will set automatically if species is mouse, human, marmoset, zebrafish, rat, -drosophila, or rhesus macaque).} +drosophila, rhesus macaque, or chicken).} \item{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).} diff --git a/man/ensembl_mito_id.Rd b/man/ensembl_mito_id.Rd index 168221b7d3..dfc1f4dfc3 100644 --- a/man/ensembl_mito_id.Rd +++ b/man/ensembl_mito_id.Rd @@ -13,7 +13,7 @@ A list of six vectors \item{Rattus_norvegicus_mito_ensembl}{Ensembl IDs for rat mitochondrial genes} \item{Drosophila_melanogaster_mito_ensembl}{Ensembl IDs for fly mitochondrial genes} \item{Macaca_mulatta_mito_ensembl}{Ensembl IDs for macaque mitochondrial genes} - +\item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken mitochondrial genes} } } \usage{ diff --git a/man/ensembl_ribo_id.Rd b/man/ensembl_ribo_id.Rd index 108b1dac94..4459071f1e 100644 --- a/man/ensembl_ribo_id.Rd +++ b/man/ensembl_ribo_id.Rd @@ -5,7 +5,7 @@ \alias{ensembl_ribo_id} \title{Ensembl Ribo IDs} \format{ -A list of seven vectors +A list of eight vectors \describe{ \item{Mus_musculus_ribo_ensembl}{Ensembl IDs for mouse ribosomal genes} \item{Homo_sapiens_ribo_ensembl}{Ensembl IDs for human ribosomal genes} @@ -14,7 +14,7 @@ A list of seven vectors \item{Rattus_norvegicus_ribo_ensembl}{Ensembl IDs for rat ribosomal genes} \item{Drosophila_melanogaster_ribo_ensembl}{Ensembl IDs for fly ribosomal genes} \item{Macaca_mulatta_ribo_ensembl}{Ensembl IDs for macaque ribosomal genes} - +\item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken ribosomal genes} } } \usage{ diff --git a/man/msigdb_qc_gene_list.Rd b/man/msigdb_qc_gene_list.Rd index 2b11feac10..f0ec651e6b 100644 --- a/man/msigdb_qc_gene_list.Rd +++ b/man/msigdb_qc_gene_list.Rd @@ -25,7 +25,9 @@ A list of 18 vectors \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} - +\item{Gallus_gallus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for chicken} +\item{Gallus_gallus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for chicken} +\item{Gallus_gallus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for chicken} } } \source{ From 23a84d415d4b4cda31b4fd53f97871dc81f68b6e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:44:25 -0400 Subject: [PATCH 224/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 98f0805a9b..828b65b736 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,7 @@ - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. - Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. - Added `cells` parameter explictly to `FeatureScatter_scCustom`. +- Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). From 1d9912acba663262f180e3d0ac1e62f088e37cb2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 10:44:32 -0400 Subject: [PATCH 225/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9aae9a262c..4a880ddad8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9035 +Version: 2.1.2.9036 Date: 2024-04-16 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")), From 77a0f1c7882d0bc8c31209ec42ce992fda232370 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 16:14:09 -0400 Subject: [PATCH 226/503] fix Meta_Present --- R/Utilities.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index 181ea8bd0e..ba047feb4a 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -435,13 +435,14 @@ Meta_Present <- function( } # Set possible variables based on object type - if (inherits(x = object, what = "Seurat")) { - possible_features <- colnames(x = object@meta.data) - } - - if (inherits(x = object, what = "liger")) { - possible_features <- colnames(x = object@cell.data) - } + possible_features <- colnames(x = Fetch_Meta(object = object)) + # if (inherits(x = object, what = "Seurat")) { + # possible_features <- colnames(x = object@meta.data) + # } + # + # if (inherits(x = object, what = "liger")) { + # possible_features <- colnames(x = object@cell.data) + # } # If any features not found if (any(!meta_col_names %in% possible_features)) { From 4d0b3318910f1baf2bbf2deafdf906d383a37c65 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 16 Apr 2024 16:43:51 -0400 Subject: [PATCH 227/503] fix test code --- R/LIGER_Internal_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 5cd702c0f6..05e277965c 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -495,7 +495,7 @@ Plot_By_Cluster_LIGER2 <- function( x_axis_label <- names(x = reduc_df)[1] y_axis_label <- names(x = reduc_df)[2] - centers <<- reduc_df %>% + centers <- reduc_df %>% group_by(.data[['Cluster']]) %>% summarize(dr1 = median(x = .data[[x_axis_label]]), dr2 = median(x = .data[[y_axis_label]]) From e51b39d67bdeba7e15d0afdd30a03866328512b8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 17 Apr 2024 11:10:00 -0400 Subject: [PATCH 228/503] fix abbreviations for chicken --- R/Internal_Utilities.R | 12 ++++++------ R/LIGER_Utilities.R | 4 ++-- R/Object_Utilities.R | 6 +++--- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index d3577860aa..85591c0dd3 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -369,7 +369,7 @@ Retrieve_Ensembl_Mito <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Species Spelling Options @@ -439,7 +439,7 @@ Retrieve_Ensembl_Ribo <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Species Spelling Options @@ -509,7 +509,7 @@ Retrieve_Ensembl_Ribo <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Species Spelling Options @@ -589,7 +589,7 @@ Retrieve_Ensembl_Ribo <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Species Spelling Options @@ -673,7 +673,7 @@ Retrieve_Ensembl_Ribo <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) if (!species %in% unlist(x = accepted_names)) { @@ -766,7 +766,7 @@ Retrieve_Ensembl_Ribo <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) if (!species %in% unlist(x = accepted_names)) { diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index fe62e212e1..b9f0eaa1f7 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -546,7 +546,7 @@ Add_Mito_Ribo.liger <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Return list of accepted default species name options @@ -837,7 +837,7 @@ Add_Hemo.liger <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Return list of accepted default species name options diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 4d104d43e3..d361fcfd55 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -201,7 +201,7 @@ Add_Cell_QC_Metrics.Seurat <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Species Spelling Options @@ -375,7 +375,7 @@ Add_Mito_Ribo.Seurat <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Return list of accepted default species name options @@ -592,7 +592,7 @@ Add_Hemo.Seurat <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) # Return list of accepted default species name options From 1369361e6c938e795b5fc52e38385e71f305b347 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:33:24 -0400 Subject: [PATCH 229/503] fix raster plot dimplot --- R/Seurat_Plotting.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3e1aa40510..ba19df2d24 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1763,7 +1763,7 @@ DimPlot_scCustom <- function( } # set size otherwise - pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object) + pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object, raster = raster) # Plot if (is.null(x = split.by)) { From fa017d53a3523049e673ad03535b53ecf6b0a354 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:35:44 -0400 Subject: [PATCH 230/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 828b65b736..72b4b463f7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -38,6 +38,7 @@ - Fixed error in `Add_Sample_Meta` that still errored when setting `na_ok = TRUE`. - Fixed errors in `Plot_Median_*` family that caused issues when `group_by` parameter was NULL. - Fixed errors in `FeaturePlot_scCustom` when setting `combine = FALSE`. +- Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. - Spelling and style fixes. Thanks @kew24. From fd0db67e8ad2a608ee9f2f7fa697b1990aae4c50 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:36:11 -0400 Subject: [PATCH 231/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a880ddad8..a1900045b6 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" RRID:SCR_024675. -Version: 2.1.2.9036 -Date: 2024-04-16 +Version: 2.1.2.9037 +Date: 2024-04-18 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"), From 75c89430808663e5def1cb42bf5dba47bfd93a3f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:57:17 -0400 Subject: [PATCH 232/503] add subset liger for v2.0.0+ objects --- R/LIGER_Utilities.R | 128 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b9f0eaa1f7..41d5f8fc40 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -138,6 +138,134 @@ LIGER_Cells <- function( } +#' Subset LIGER object +#' +#' Subset LIGER object by cluster or other meta data variable. +#' +#' @param liger_object LIGER object name. +#' @param cluster Name(s) of cluster to subset from object. +#' @param cluster_col name of `@cellMeta` column containing cluster names, default is "leiden_cluster". +#' @param ident variable within `ident_col` to use in sub-setting object. +#' @param ident_col column in `@cellMeta` that contains values provided to `ident`. +#' @param invert logical, whether to subset the inverse of the clusters or idents provided, default is FALSE. +#' +#' @return liger object +#' +#' @import cli +#' @importFrom dplyr pull filter +#' @importFrom utils packageVersion +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # subset clusters 3 and 5 +#' sub_liger <- subset_liger(liger_object = liger_object, cluster = c(3, 5)) +#' +#' # subset control samples from column "Treatment" +#' sub_liger <- subset_liger(liger_object = liger_object, ident = "control", +#' ident_col = "Treatment") +#' +#' # subset control samples from column "Treatment" in clusters 3 and 5 +#' sub_liger <- subset_liger(liger_object = liger_object, ident = "control", +#' ident_col = "Treatment", cluster = c(3, 5)) +#' +#' # Remove cluster 9 +#' sub_liger <- subset_liger(liger_object = liger_object, cluster = 9, invert = TRUE) +#' } +#' + +Subset_LIGER <- function( + liger_object, + cluster = NULL, + cluster_col = "leiden_cluster", + ident = NULL, + ident_col = NULL, + invert = FALSE +) { + # Check new liger object + if (!"cellMeta" %in% slotNames(liger_object)) { + cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + } + + # Check value provided + if (is.null(x = cluster) && is.null(x = ident)) { + cli_abort(message = "No values provided to subset object") + } + + # Check meta present + if (!is.null(x = ident_col)) { + ident_col <- Meta_Present(object = liger_object, meta_col_names = ident_col, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + # Check meta present + if (!is.null(x = cluster_col)) { + cluster_col <- Meta_Present(object = liger_object, meta_col_names = cluster_col, print_msg = FALSE, omit_warn = FALSE)[[1]] + } + + # pull meta data + meta <- Fetch_Meta(object = liger_object) + + # check subset value ok + if (!is.null(x = ident)) { + ident_values <- meta %>% + pull(.data[[ident_col]]) %>% + unique() + + if (!all(ident %in% ident_values)) { + cli_abort(message = "One or more of provided ident values ({.field {ident}}) were not found in provided ident_col ({.field {ident_col}})") + } + } + + # check sub set value ok + if (!is.null(x = cluster)) { + cluster_values <- meta %>% + pull(.data[[cluster_col]]) %>% + unique() + + if (!all(cluster %in% cluster_values)) { + cli_abort(message = "One or more of provided cluster values ({.field {cluster}}) were not found in provided cluster_col ({.field {cluster_col}})") + } + } + + # filter just by cluster + if (!is.null(x = cluster) && is.null(x = ident)) { + cells_filter <- meta %>% + filter(.data[[cluster_col]] %in% cluster) %>% + rownames() + } + + # filter just by ident + if (!is.null(x = ident) && is.null(cluster)) { + cells_filter <- meta %>% + filter(.data[[ident_col]] %in% ident) %>% + rownames() + } + + # Filter by ident and cluster + if (!is.null(x = ident) && !is.null(cluster)) { + cells_filter <- meta %>% + filter(.data[[ident_col]] %in% ident & .data[[cluster_col]] %in% cluster) %>% + rownames() + } + + # invert filtering + if (isTRUE(x = invert)) { + # get vector of call cells + all_cells <- LIGER_cells(liger_object = liger_object) + + # setdiff to get inverse + cells_filter <- setdiff(x = all_cells, y = cells_filter) + } + + sub_obj <- rliger::subsetLiger(object = liger_object, cellIdx = cells_filter) + + return(sub_obj) +} + + #' Extract top loading genes for LIGER factor #' #' Extract vector to the top loading genes for specified LIGER iNMF factor From d3de06efe78ad3747b835c9d11261abb39c7c200 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:57:28 -0400 Subject: [PATCH 233/503] Update docs --- NAMESPACE | 1 + man/Subset_LIGER.Rd | 53 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 man/Subset_LIGER.Rd diff --git a/NAMESPACE b/NAMESPACE index 2f453cd006..a3648d5607 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -153,6 +153,7 @@ export(Split_Vector) export(Stacked_VlnPlot) export(Store_Misc_Info_Seurat) export(Store_Palette_Seurat) +export(Subset_LIGER) export(Top_Genes_Factor) export(UnRotate_X) export(Updated_HGNC_Symbols) diff --git a/man/Subset_LIGER.Rd b/man/Subset_LIGER.Rd new file mode 100644 index 0000000000..7c995ab885 --- /dev/null +++ b/man/Subset_LIGER.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{Subset_LIGER} +\alias{Subset_LIGER} +\title{Subset LIGER object} +\usage{ +Subset_LIGER( + liger_object, + cluster = NULL, + cluster_col = "leiden_cluster", + ident = NULL, + ident_col = NULL, + invert = FALSE +) +} +\arguments{ +\item{liger_object}{LIGER object name.} + +\item{cluster}{Name(s) of cluster to subset from object.} + +\item{cluster_col}{name of \verb{@cellMeta} column containing cluster names, default is "leiden_cluster".} + +\item{ident}{variable within \code{ident_col} to use in sub-setting object.} + +\item{ident_col}{column in \verb{@cellMeta} that contains values provided to \code{ident}.} + +\item{invert}{logical, whether to subset the inverse of the clusters or idents provided, default is FALSE.} +} +\value{ +liger object +} +\description{ +Subset LIGER object by cluster or other meta data variable. +} +\examples{ +\dontrun{ +# subset clusters 3 and 5 +sub_liger <- subset_liger(liger_object = liger_object, cluster = c(3, 5)) + +# subset control samples from column "Treatment" +sub_liger <- subset_liger(liger_object = liger_object, ident = "control", +ident_col = "Treatment") + +# subset control samples from column "Treatment" in clusters 3 and 5 +sub_liger <- subset_liger(liger_object = liger_object, ident = "control", +ident_col = "Treatment", cluster = c(3, 5)) + +# Remove cluster 9 +sub_liger <- subset_liger(liger_object = liger_object, cluster = 9, invert = TRUE) +} + +} +\concept{liger_object_util} From a47754dc86919511f08d1ba6ad9440c1ed40b9f4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:58:17 -0400 Subject: [PATCH 234/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 72b4b463f7..afdb989a2b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ - Added new functions to interact with liger v2.0.0+ object format change: - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. + - `Subset_LIGER` to quickly subset by cluster or other meta data variable. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`, `DimPlot_LIGER`. - Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: From 65678a675aca67f138412e24d52453518726a5c6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 07:58:30 -0400 Subject: [PATCH 235/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a1900045b6..18202c46e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9037 +Version: 2.1.2.9038 Date: 2024-04-18 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")), From 0ae671650e4d18206a210e1d5d64f862c24eac97 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 13:54:25 -0400 Subject: [PATCH 236/503] style --- R/LIGER_Utilities.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 41d5f8fc40..ccd47db89f 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -153,6 +153,7 @@ LIGER_Cells <- function( #' #' @import cli #' @importFrom dplyr pull filter +#' @importFrom magrittr "%>%" #' @importFrom utils packageVersion #' #' @export @@ -238,14 +239,14 @@ Subset_LIGER <- function( } # filter just by ident - if (!is.null(x = ident) && is.null(cluster)) { + if (!is.null(x = ident) && is.null(x = cluster)) { cells_filter <- meta %>% filter(.data[[ident_col]] %in% ident) %>% rownames() } # Filter by ident and cluster - if (!is.null(x = ident) && !is.null(cluster)) { + if (!is.null(x = ident) && !is.null(x = cluster)) { cells_filter <- meta %>% filter(.data[[ident_col]] %in% ident & .data[[cluster_col]] %in% cluster) %>% rownames() From 8e11f37ff5f421b45ed92a76225acd866e9a7084 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 18 Apr 2024 13:55:00 -0400 Subject: [PATCH 237/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 18202c46e1..2315e1bd0e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9038 +Version: 2.1.2.9039 Date: 2024-04-18 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")), From d72baddd7cb50d7117b92af48690ff54f854fb94 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:01:49 -0400 Subject: [PATCH 238/503] add spatialdimplot --- R/Seurat_Plotting.R | 157 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 157 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index ba19df2d24..2793f54e0f 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2359,3 +2359,160 @@ FeatureScatter_scCustom <- function( } } } + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### SPATIAL PLOTTING #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +#' SpatialDimPlot with modified default settings +#' +#' Creates SpatialDimPlot with some of the settings modified from their Seurat defaults (colors_use). +#' +#' @param seurat_object Seurat object name. +#' @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`. +#' @param group.by Name of meta.data column to group the data by +#' @param images Name of the images to use in the plot(s) +#' @param image.alpha Adjust the opacity of the background images. Set to 0 to +#' remove. +#' @param crop Crop the plot in to focus on points plotted. Set to \code{FALSE} to show +#' entire background image. +#' } +#' @param cells.highlight A list of character or numeric vectors of cells to +#' highlight. If only one group of cells desired, can simply pass a vector +#' instead of a list. If set, colors selected cells to the color(s) in +#' cols.highlight +#' @param cols.highlight A vector of colors to highlight the cells as; ordered +#' the same as the groups in cells.highlight; last color corresponds to +#' unselected cells. +#' @param facet.highlight When highlighting certain groups of cells, split each +#' group into its own plot +#' @param label Whether to label the clusters +#' @param label.size Sets the size of the labels +#' @param label.color Sets the color of the label text +#' @param label.box Whether to put a box around the label text (geom_text vs +#' geom_label) +#' @param repel Repels the labels to prevent overlap +#' @param ncol Number of columns if plotting multiple plots +#' @param combine Combine plots into a single gg object; note that if TRUE; +#' themeing will not work when plotting multiple features/groupings +#' @param pt.size.factor Scale the size of the spots. +#' @param alpha Controls opacity of spots. Provide as a vector specifying the +#' min and max for SpatialFeaturePlot. For SpatialDimPlot, provide a single +#' alpha value for each plot. +#' @param stroke Control the width of the border around the spots +#' @param interactive Launch an interactive SpatialDimPlot or SpatialFeaturePlot +#' session, see \code{\link{ISpatialDimPlot}} or +#' \code{\link{ISpatialFeaturePlot}} for more details +#' @return A ggplot object +#' +#' @import cli +#' @import ggplot2 +#' +#' @export +#' +#' @references Many of the param names and descriptions are from Seurat to facilitate ease of use as +#' this is simply a wrapper to alter some of the default parameters \url{https://github.com/satijalab/seurat/blob/master/R/visualization.R} (License: GPL-3). +#' +#' @concept seurat_plotting +#' +#' @examples +#' \dontrun{ +#' SpatialDimPlot_scCustom(seurat_object = seurat_object) +#'} +#' + + +SpatialDimPlot_scCustom <- function( + seurat_object, + group.by = NULL, + images = NULL, + colors_use = NULL, + crop = TRUE, + label = FALSE, + label.size = 7, + label.color = "white", + label.box = TRUE, + repel = FALSE, + ncol = NULL, + pt.size.factor = 1.6, + alpha = c(1, 1), + image.alpha = 1, + stroke = 0.25, + interactive = FALSE, + information = NULL, + combine = TRUE, + ggplot_default_colors = FALSE, + color_seed = 123, + ... +) { + # Check Seurat + Is_Seurat(seurat_object = seurat_object) + + # Change label if label.box + if (isTRUE(x = label.box) && is.null(x = label)) { + label <- TRUE + } + + # Add check for group.by before getting to colors + if (length(x = group.by) > 1) { + Meta_Present(object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } else { + if (!is.null(x = group.by) && group.by != "ident") { + Meta_Present(object = seurat_object, meta_col_names = group.by, print_msg = FALSE) + } + } + + label <- label %||% (is.null(x = group.by)) + + # 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]])) + } + } + + # Check colors use vs. ggplot2 color scale + 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}.") + } + + # 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) + } + + # name color palette so that it works + if (is.null(x = group.by)) { + names(colors_use) <- levels(Idents(object = seurat_object)) + } else { + if (isTRUE(x = inherits(x = seurat_object[[group.by]], what = "factor"))) { + names(colors_use) <- levels(seurat_object[[group.by]]) + } else { + names(colors_use) <- unique(seurat_object[[group.by]]) + } + } + + if (isFALSE(x = interactive)) { + plot <- SpatialDimPlot(object = seurat_object, group.by = group.by, images = images, cols = colors_use, crop = crop, label = label, label.size = label.size, label.color = label.color, label.box = label.box, repel = repel, ncol = ncol, combine = combine, alpha = alpha, pt.size.factor = pt.size.factor, image.alpha = image.alpha, stroke = stroke, interactive = interactive, information = information, ...) + + return(plot) + } else { + return(ISpatialDimPlot( + object = seurat_object, + image = images[1], + group.by = group.by, + alpha = alpha + )) + } +} From 6ae4e8da79bf3bb45f53d02c4b54eb9bff7d8054 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:02:41 -0400 Subject: [PATCH 239/503] fix bracket --- R/Seurat_Plotting.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 2793f54e0f..e2e29aae58 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2380,7 +2380,6 @@ FeatureScatter_scCustom <- function( #' remove. #' @param crop Crop the plot in to focus on points plotted. Set to \code{FALSE} to show #' entire background image. -#' } #' @param cells.highlight A list of character or numeric vectors of cells to #' highlight. If only one group of cells desired, can simply pass a vector #' instead of a list. If set, colors selected cells to the color(s) in From 4f314eb635b4b9b9ab73168ab8bd0ecdab9a46a3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:03:09 -0400 Subject: [PATCH 240/503] Update docs --- NAMESPACE | 1 + man/SpatialDimPlot_scCustom.Rd | 104 +++++++++++++++++++++++++++++++++ 2 files changed, 105 insertions(+) create mode 100644 man/SpatialDimPlot_scCustom.Rd diff --git a/NAMESPACE b/NAMESPACE index a3648d5607..ed01a1f0b7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -147,6 +147,7 @@ export(Seq_QC_Plot_Transcriptome) export(Seq_QC_Plot_UMIs) export(Setup_scRNAseq_Project) export(Single_Color_Palette) +export(SpatialDimPlot_scCustom) export(Split_FeatureScatter) export(Split_Layers) export(Split_Vector) diff --git a/man/SpatialDimPlot_scCustom.Rd b/man/SpatialDimPlot_scCustom.Rd new file mode 100644 index 0000000000..a99956919f --- /dev/null +++ b/man/SpatialDimPlot_scCustom.Rd @@ -0,0 +1,104 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Seurat_Plotting.R +\name{SpatialDimPlot_scCustom} +\alias{SpatialDimPlot_scCustom} +\title{SpatialDimPlot with modified default settings} +\usage{ +SpatialDimPlot_scCustom( + seurat_object, + group.by = NULL, + images = NULL, + colors_use = NULL, + crop = TRUE, + label = FALSE, + label.size = 7, + label.color = "white", + label.box = TRUE, + repel = FALSE, + ncol = NULL, + pt.size.factor = 1.6, + alpha = c(1, 1), + image.alpha = 1, + stroke = 0.25, + interactive = FALSE, + information = NULL, + combine = TRUE, + ggplot_default_colors = FALSE, + color_seed = 123, + ... +) +} +\arguments{ +\item{seurat_object}{Seurat object name.} + +\item{group.by}{Name of meta.data column to group the data by} + +\item{images}{Name of the images to use in the plot(s)} + +\item{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 \code{DiscretePalette_scCustomize}.} + +\item{crop}{Crop the plot in to focus on points plotted. Set to \code{FALSE} to show +entire background image.} + +\item{label}{Whether to label the clusters} + +\item{label.size}{Sets the size of the labels} + +\item{label.color}{Sets the color of the label text} + +\item{label.box}{Whether to put a box around the label text (geom_text vs +geom_label)} + +\item{repel}{Repels the labels to prevent overlap} + +\item{ncol}{Number of columns if plotting multiple plots} + +\item{pt.size.factor}{Scale the size of the spots.} + +\item{alpha}{Controls opacity of spots. Provide as a vector specifying the +min and max for SpatialFeaturePlot. For SpatialDimPlot, provide a single +alpha value for each plot.} + +\item{image.alpha}{Adjust the opacity of the background images. Set to 0 to +remove.} + +\item{stroke}{Control the width of the border around the spots} + +\item{interactive}{Launch an interactive SpatialDimPlot or SpatialFeaturePlot +session, see \code{\link{ISpatialDimPlot}} or +\code{\link{ISpatialFeaturePlot}} for more details} + +\item{combine}{Combine plots into a single gg object; note that if TRUE; +themeing will not work when plotting multiple features/groupings} + +\item{cells.highlight}{A list of character or numeric vectors of cells to +highlight. If only one group of cells desired, can simply pass a vector +instead of a list. If set, colors selected cells to the color(s) in +cols.highlight} + +\item{cols.highlight}{A vector of colors to highlight the cells as; ordered +the same as the groups in cells.highlight; last color corresponds to +unselected cells.} + +\item{facet.highlight}{When highlighting certain groups of cells, split each +group into its own plot} +} +\value{ +A ggplot object +} +\description{ +Creates SpatialDimPlot with some of the settings modified from their Seurat defaults (colors_use). +} +\examples{ +\dontrun{ +SpatialDimPlot_scCustom(seurat_object = seurat_object) +} + +} +\references{ +Many of the param names and descriptions are from Seurat to facilitate ease of use as +this is simply a wrapper to alter some of the default parameters \url{https://github.com/satijalab/seurat/blob/master/R/visualization.R} (License: GPL-3). +} +\concept{seurat_plotting} From a1f126b2de2d8d104ff4a0b5bf84027c2c2b1fc4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:04:15 -0400 Subject: [PATCH 241/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index afdb989a2b..3b654bf203 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,7 @@ - Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. - Added `cells` parameter explictly to `FeatureScatter_scCustom`. - Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). +- Added new plotting function `SpatialDimPlot_scCustom`, ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). From 72b073fd0cad0284dfe1974221705b79638f5231 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:04:32 -0400 Subject: [PATCH 242/503] bnump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2315e1bd0e..fd5a90151f 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" RRID:SCR_024675. -Version: 2.1.2.9039 -Date: 2024-04-18 +Version: 2.1.2.9040 +Date: 2024-04-19 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"), From cd9c488e92b199b1decf5c5b31959c177944a840 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:06:58 -0400 Subject: [PATCH 243/503] style --- R/Seurat_Plotting.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index e2e29aae58..b8892080af 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2424,7 +2424,6 @@ FeatureScatter_scCustom <- function( #'} #' - SpatialDimPlot_scCustom <- function( seurat_object, group.by = NULL, From 1ebbe29967242a3729bedcece66f02b57af8ddba Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:38:56 -0400 Subject: [PATCH 244/503] Add readmetrics10X ability to read just a single csv file and format the same way multi-file reads are performed. --- R/Internal_Utilities.R | 147 +++++++++++++++++++++++++++++++++++++++++ R/Read_&_Write_Data.R | 12 +++- 2 files changed, 157 insertions(+), 2 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 85591c0dd3..c3583c1cb9 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -1439,6 +1439,153 @@ Metrics_Multi_VDJT <- function( } +#' Read single Summary Statistics csv from 10X Cell Ranger Count or Multi +#' +#' Get data.frame with all metrics from the Cell Ranger `count` analysis or list of data.frames if using Cell Ranger `multi`. +#' +#' @param base_path path to the metrics file +#' @param cellranger_multi logical, whether or not metrics come from Cell Ranger `count` or from Cell Ranger `multi`. Default is FALSE. +#' +#' @return A data frame or list of data.frames with sample metrics from cell ranger. +#' +#' @import cli +#' @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_metrics <- Metrics_Single_File(base_path = base_path) +#' } +#' + +Metrics_Single_File <- function( + base_path, + cellranger_multi = FALSE +) { + # Read GEX count metrics + if (isFALSE(x = cellranger_multi)) { + raw_data <- read.csv(file = base_path, stringsAsFactors = FALSE) + # 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))}) + + + column_numbers_pct <- grep(pattern = "%", x = raw_data[1, ]) + all_columns <- 1:ncol(x = raw_data) + + 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)}) + + # Change column names to use "_" separator instead of "." for readability + colnames(x = raw_data) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = raw_data)) + + # return data + return(raw_data) + } else { + # GEX metrics + raw_data <- read.csv(file = base_path, stringsAsFactors = FALSE) + + # 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)}) + + # Change column nams to use "_" separator instead of "." for readability + colnames(x = raw_data_gex) <- gsub(pattern = "\\.", replacement = "_", x = colnames(x = raw_data_gex)) + + # Get VDJT metrics + raw_data <- read.csv(file = base_path, stringsAsFactors = FALSE) + + 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() + + 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)}) + + # combine outputs into a list + data_list <- list( + multi_gex_metrics = raw_data_gex, + multi_vdjt_metrics = raw_data_vdjt + ) + + # return data list + return(data_list) + } +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### GENE NAME/FILE CACHE HELPERS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index 624d31bd10..8b92afedc2 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -1547,7 +1547,8 @@ Read_CellBender_h5_Multi_File <- function( #' #' Get data.frame with all metrics from the Cell Ranger count analysis (present in web_summary.html) #' -#' @param base_path path to the parent directory which contains all of the subdirectories of interest. +#' @param base_path path to the parent directory which contains all of the subdirectories of interest or +#' alternatively can provide single csv file to read and format identically to reading multiple files. #' @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. @@ -1557,7 +1558,7 @@ Read_CellBender_h5_Multi_File <- function( #' @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 metrics from cell ranger. +#' @return A data frame or list of data.frames with sample metrics from cell ranger. #' #' @import cli #' @import pbapply @@ -1583,6 +1584,13 @@ Read_Metrics_10X <- function( lib_list = NULL, lib_names = NULL ) { + # Check if single file + file_ending <- grep(pattern = ".csv$", x = base_path, value = TRUE) + if (length(x = file_ending) == 1) { + metrics_data <- Metrics_Single_File(base_path = base_path, cellranger_multi = cellranger_multi) + return(metrics_data) + } + # Confirm directory exists if (dir.exists(paths = base_path) == FALSE) { cli_abort(message = "Directory: {.val {base_path}} specified by {.code base_path} does not exist.") From 321aaf3650e544fd3e3994b84537e76b784292f2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:39:05 -0400 Subject: [PATCH 245/503] Update docs --- man/Read_Metrics_10X.Rd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/man/Read_Metrics_10X.Rd b/man/Read_Metrics_10X.Rd index 488b72dfce..e2fb5fc828 100644 --- a/man/Read_Metrics_10X.Rd +++ b/man/Read_Metrics_10X.Rd @@ -14,7 +14,8 @@ Read_Metrics_10X( ) } \arguments{ -\item{base_path}{path to the parent directory which contains all of the subdirectories of interest.} +\item{base_path}{path to the parent directory which contains all of the subdirectories of interest or +alternatively can provide single csv file to read and format identically to reading multiple files.} \item{secondary_path}{path from the parent directory to count "outs/" folder which contains the "metrics_summary.csv" file.} @@ -30,7 +31,7 @@ in all samples in parent directory.} directory name of each sample.} } \value{ -A data frame with sample metrics from cell ranger. +A data frame or list of data.frames with sample metrics from cell ranger. } \description{ Get data.frame with all metrics from the Cell Ranger count analysis (present in web_summary.html) From 4ec9819202a76fb9be7786438897174fe2ec1f75 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:40:07 -0400 Subject: [PATCH 246/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 3b654bf203..33b10aa427 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,7 @@ - Added `cells` parameter explictly to `FeatureScatter_scCustom`. - Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). - Added new plotting function `SpatialDimPlot_scCustom`, ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). +- Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. From c9956c93ad9894787cc70d7580436e8ccb159156 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:40:22 -0400 Subject: [PATCH 247/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fd5a90151f..11480050b7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9040 +Version: 2.1.2.9041 Date: 2024-04-19 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")), From 5a832bf20fe7a8dbaa309ab87b70a7801feef727 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:49:16 -0400 Subject: [PATCH 248/503] spelling --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 33b10aa427..698e01ab9a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,7 +14,7 @@ - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. - Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. -- Added `cells` parameter explictly to `FeatureScatter_scCustom`. +- Added `cells` parameter explicitly to `FeatureScatter_scCustom`. - Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). - Added new plotting function `SpatialDimPlot_scCustom`, ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). - Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. From 9d792b46008e1aa17f673f04e95b01b346de38e4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 07:49:26 -0400 Subject: [PATCH 249/503] bump version release prep --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 11480050b7..11d489f9f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9041 +Version: 2.1.2.9042 Date: 2024-04-19 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")), From 8213ad1c998c3783f9afacf2d6524fbc947c66ee Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 08:25:02 -0400 Subject: [PATCH 250/503] fix r check issues --- R/LIGER_Internal_Utilities.R | 2 +- R/LIGER_Plotting.R | 2 +- R/LIGER_Utilities.R | 6 +++--- man/Factor_Cor_Plot.Rd | 4 ++-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 05e277965c..7d2c336577 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -855,7 +855,7 @@ Plot_By_Meta_LIGER2 <- function( color_seed = 123 ) { # Set reduction - reduction <- reduction %||% scCustomize:::Default_DimReduc_LIGER(liger_object = liger_object) + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) reduc_df <- Generate_Plotting_df_LIGER2(object = liger_object, group_by = group_by, split_by = split_by, reorder.idents = reorder.idents, shuffle = shuffle, shuffle_seed = shuffle_seed, reduction = reduction) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 10e18747dd..2f9aefe2da 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -335,7 +335,7 @@ plotFactors_scCustom <- function( #' Plot positive correlations between gene loadings across `W` factor matrix in liger object. #' Any negative correlations are set to NA and NA values set to bottom color of color gradient. #' -#' @param cor_mat correlation matrix +#' @param liger_object liger object. #' @param colors_use Color palette to use for correlation values. Default is `viridis`. #' Users can also supply vector of 3 colors (low, mid, high). #' @param label logical, whether to add correlation values to plot result. diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ccd47db89f..b78728a3c4 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -255,7 +255,7 @@ Subset_LIGER <- function( # invert filtering if (isTRUE(x = invert)) { # get vector of call cells - all_cells <- LIGER_cells(liger_object = liger_object) + all_cells <- LIGER_Cells(liger_object = liger_object) # setdiff to get inverse cells_filter <- setdiff(x = all_cells, y = cells_filter) @@ -308,7 +308,7 @@ Top_Genes_Factor <- function( # temp liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { W <- liger_object@W - rownames(x = W) <- rownames(x = csf_liger@datasets[[1]]@scaleData) + rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) top_genes <- rownames(x = W)[order(W[, liger_factor], decreasing = TRUE)[1:num_genes]] return(top_genes) } else { @@ -833,7 +833,7 @@ Add_Mito_Ribo.liger <- function( # Create combined mito ribo column if both present if (length_mito_features > 0 && length_ribo_features > 0) { if (packageVersion(pkg = 'rliger') > "1.0.1") { - object@cellMeta[[mito_ribo_name]] <- csf_liger@cellMeta[[mito_name]] + csf_liger@cellMeta[[ribo_name]] + object@cellMeta[[mito_ribo_name]] <- object@cellMeta[[mito_name]] + object@cellMeta[[ribo_name]] } else { object_meta <- Fetch_Meta(object = object) %>% rownames_to_column("barcodes") diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index ca3bd44156..d3c10c3dc8 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -16,6 +16,8 @@ Factor_Cor_Plot( ) } \arguments{ +\item{liger_object}{liger object.} + \item{colors_use}{Color palette to use for correlation values. Default is \code{viridis}. Users can also supply vector of 3 colors (low, mid, high).} @@ -32,8 +34,6 @@ is 0.5.} Accepted values are: "full" (default), "upper", or "lower".} \item{x_lab_rotate}{logical, whether to rotate the axes labels on the x-axis. Default is TRUE} - -\item{cor_mat}{correlation matrix} } \value{ A ggplot object From 732ad6ae9fad53f54e0b57b869cf605ef2ab77d7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 09:35:20 -0400 Subject: [PATCH 251/503] Updates to fix check failures --- R/Internal_Utilities.R | 2 +- R/LIGER_Internal_Utilities.R | 2 +- R/LIGER_Utilities.R | 9 +++++---- R/Seurat_Plotting.R | 18 +++++++----------- R/Utilities.R | 7 +++++-- man/Add_Cell_QC_Metrics.Rd | 3 ++- man/Rename_Clusters.Rd | 10 ++++++++-- man/SpatialDimPlot_scCustom.Rd | 15 +++++---------- 8 files changed, 34 insertions(+), 32 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index c3583c1cb9..4629319d41 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -473,7 +473,7 @@ Retrieve_Ensembl_Ribo <- function( if (species %in% macaque_options) { ribo_ensembl <- ensembl_ribo_id$Macaca_mulatta_ribo_ensembl } - if (species %in% chicken) { + if (species %in% chicken_options) { ribo_ensembl <- ensembl_ribo_id$Gallus_gallus_ribo_ensembl } diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 7d2c336577..a75f7b95ce 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -2139,7 +2139,7 @@ Add_MSigDB_LIGER <- function( 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "Gg") + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") ) if (!species %in% unlist(x = accepted_names)) { diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b78728a3c4..ed8ce3ed94 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -368,12 +368,12 @@ LIGER_DimReduc <- function( reduction_use <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) # check reduction in cellMeta - if (reduction_use %in% names(x = dimReds(x = liger_object))) { + if (reduction_use %in% names(x = rliger::dimReds(x = liger_object))) { if (isTRUE(x = check_only)) { return(TRUE) } # get coords - reduc_coords <- dimReds(x = liger_object)[[reduction_use]] + reduc_coords <- rliger::dimReds(x = liger_object)[[reduction_use]] } else { cli_abort("The reduction {.field {reduction_use}} is not present in dimReds slot.") } @@ -528,7 +528,8 @@ Add_Cell_QC_Metrics.liger <- function( ensembl_ids = FALSE, num_top_genes = 50, assay = NULL, - overwrite = FALSE + overwrite = FALSE, + ... ) { # Accepted species names accepted_names <- data.frame( @@ -905,7 +906,7 @@ Add_Cell_Complexity.liger <- function( # Add score if (packageVersion(pkg = 'rliger') > "1.0.1") { - object@cellMeta[[mito_ribo_name]] <- log10(object@cellMeta$nGene) / log10(object@cellMeta$nUMI) + object@cellMeta[[meta_col_name]] <- log10(object@cellMeta$nGene) / log10(object@cellMeta$nUMI) } else { object@cell.data[ , meta_col_name] <- log10(object@cell.data$nGene) / log10(object@cell.data$nUMI) } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index b8892080af..52c087882b 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -2380,15 +2380,6 @@ FeatureScatter_scCustom <- function( #' remove. #' @param crop Crop the plot in to focus on points plotted. Set to \code{FALSE} to show #' entire background image. -#' @param cells.highlight A list of character or numeric vectors of cells to -#' highlight. If only one group of cells desired, can simply pass a vector -#' instead of a list. If set, colors selected cells to the color(s) in -#' cols.highlight -#' @param cols.highlight A vector of colors to highlight the cells as; ordered -#' the same as the groups in cells.highlight; last color corresponds to -#' unselected cells. -#' @param facet.highlight When highlighting certain groups of cells, split each -#' group into its own plot #' @param label Whether to label the clusters #' @param label.size Sets the size of the labels #' @param label.color Sets the color of the label text @@ -2406,6 +2397,12 @@ FeatureScatter_scCustom <- function( #' @param interactive Launch an interactive SpatialDimPlot or SpatialFeaturePlot #' session, see \code{\link{ISpatialDimPlot}} or #' \code{\link{ISpatialFeaturePlot}} for more details +#' @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]{DimPlot}}. +#' #' @return A ggplot object #' #' @import cli @@ -2441,7 +2438,6 @@ SpatialDimPlot_scCustom <- function( image.alpha = 1, stroke = 0.25, interactive = FALSE, - information = NULL, combine = TRUE, ggplot_default_colors = FALSE, color_seed = 123, @@ -2502,7 +2498,7 @@ SpatialDimPlot_scCustom <- function( } if (isFALSE(x = interactive)) { - plot <- SpatialDimPlot(object = seurat_object, group.by = group.by, images = images, cols = colors_use, crop = crop, label = label, label.size = label.size, label.color = label.color, label.box = label.box, repel = repel, ncol = ncol, combine = combine, alpha = alpha, pt.size.factor = pt.size.factor, image.alpha = image.alpha, stroke = stroke, interactive = interactive, information = information, ...) + plot <- SpatialDimPlot(object = seurat_object, group.by = group.by, images = images, cols = colors_use, crop = crop, label = label, label.size = label.size, label.color = label.color, label.box = label.box, repel = repel, ncol = ncol, combine = combine, alpha = alpha, pt.size.factor = pt.size.factor, image.alpha = image.alpha, stroke = stroke, interactive = interactive, ...) return(plot) } else { diff --git a/R/Utilities.R b/R/Utilities.R index ba047feb4a..7b076dc6bc 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1687,8 +1687,11 @@ Pull_Cluster_Annotation <- function( #' @param seurat_object object name. #' @param new_idents vector of new cluster names. Must be equal to the length of current active.ident #' in Seurat Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally. -#' @param meta_col_name (Optional). Whether or not to create new named column in `Object@meta.data` -#' to store the old identities. +#' @param meta_col_name `r lifecycle::badge("soft-deprecated")`. See `old_ident_name`. +#' @param old_ident_name optional, name to use for storing current object idents in `Object@meta.data`. +#' @param new_ident_name optional, name to use for storing new object idents in `@meta.data`. +#' @param overwrite logical, whether to overwrite columns in `@meta.data` if they have same +#' names as `old_ident_name` and/or `new_ident_name`. #' @param ... Extra parameters passed to \code{\link[SeuratObject]{RenameIdents}}. #' #' @return Seurat Object with new identities placed in active.ident slot. diff --git a/man/Add_Cell_QC_Metrics.Rd b/man/Add_Cell_QC_Metrics.Rd index 71cac11bbe..808ca19587 100644 --- a/man/Add_Cell_QC_Metrics.Rd +++ b/man/Add_Cell_QC_Metrics.Rd @@ -38,7 +38,8 @@ Add_Cell_QC_Metrics(object, ...) ensembl_ids = FALSE, num_top_genes = 50, assay = NULL, - overwrite = FALSE + overwrite = FALSE, + ... ) \method{Add_Cell_QC_Metrics}{Seurat}( diff --git a/man/Rename_Clusters.Rd b/man/Rename_Clusters.Rd index 4ab49f1ca0..0dd181f445 100644 --- a/man/Rename_Clusters.Rd +++ b/man/Rename_Clusters.Rd @@ -20,8 +20,14 @@ Rename_Clusters( \item{new_idents}{vector of new cluster names. Must be equal to the length of current active.ident in Seurat Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally.} -\item{meta_col_name}{(Optional). Whether or not to create new named column in \code{Object@meta.data} -to store the old identities.} +\item{old_ident_name}{optional, name to use for storing current object idents in \code{Object@meta.data}.} + +\item{new_ident_name}{optional, name to use for storing new object idents in \verb{@meta.data}.} + +\item{meta_col_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#soft-deprecated}{\figure{lifecycle-soft-deprecated.svg}{options: alt='[Soft-deprecated]'}}}{\strong{[Soft-deprecated]}}. See \code{old_ident_name}.} + +\item{overwrite}{logical, whether to overwrite columns in \verb{@meta.data} if they have same +names as \code{old_ident_name} and/or \code{new_ident_name}.} \item{...}{Extra parameters passed to \code{\link[SeuratObject]{RenameIdents}}.} } diff --git a/man/SpatialDimPlot_scCustom.Rd b/man/SpatialDimPlot_scCustom.Rd index a99956919f..ed0267d956 100644 --- a/man/SpatialDimPlot_scCustom.Rd +++ b/man/SpatialDimPlot_scCustom.Rd @@ -21,7 +21,6 @@ SpatialDimPlot_scCustom( image.alpha = 1, stroke = 0.25, interactive = FALSE, - information = NULL, combine = TRUE, ggplot_default_colors = FALSE, color_seed = 123, @@ -73,17 +72,13 @@ session, see \code{\link{ISpatialDimPlot}} or \item{combine}{Combine plots into a single gg object; note that if TRUE; themeing will not work when plotting multiple features/groupings} -\item{cells.highlight}{A list of character or numeric vectors of cells to -highlight. If only one group of cells desired, can simply pass a vector -instead of a list. If set, colors selected cells to the color(s) in -cols.highlight} +\item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using +default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes.} -\item{cols.highlight}{A vector of colors to highlight the cells as; ordered -the same as the groups in cells.highlight; last color corresponds to -unselected cells.} +\item{color_seed}{random seed for the "varibow" palette shuffle if \code{colors_use = NULL} and number of +groups plotted is greater than 36. Default = 123.} -\item{facet.highlight}{When highlighting certain groups of cells, split each -group into its own plot} +\item{...}{Extra parameters passed to \code{\link[Seurat]{DimPlot}}.} } \value{ A ggplot object From 6feb3d360abbce3dd4389ad9ef77c2ca90b519c0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 09:35:36 -0400 Subject: [PATCH 252/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 11d489f9f5..188d8aa307 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9042 +Version: 2.1.2.9043 Date: 2024-04-19 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")), From c00e441b746b4b51bae416e9893e7200fb54a116 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 13:59:17 -0400 Subject: [PATCH 253/503] Add parameter for line thickness in QC plots --- R/QC_Plotting_Seurat.R | 74 +++++++++++++++++++++++++++--------------- 1 file changed, 47 insertions(+), 27 deletions(-) diff --git a/R/QC_Plotting_Seurat.R b/R/QC_Plotting_Seurat.R index 45ca1758bb..0ede10b7b4 100644 --- a/R/QC_Plotting_Seurat.R +++ b/R/QC_Plotting_Seurat.R @@ -14,6 +14,7 @@ #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -52,6 +53,7 @@ QC_Plots_Genes <- function( y_axis_label = "Features", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, plot_boxplot = FALSE, @@ -68,7 +70,7 @@ QC_Plots_Genes <- function( Is_Seurat(seurat_object = 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_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + - geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle(plot_title) + @@ -100,6 +102,7 @@ QC_Plots_Genes <- function( #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -138,6 +141,7 @@ QC_Plots_UMIs <- function( y_axis_label = "UMIs", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -154,7 +158,7 @@ QC_Plots_UMIs <- function( Is_Seurat(seurat_object = 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_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + - geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle(plot_title) + @@ -180,7 +184,7 @@ QC_Plots_UMIs <- function( #' #' @param seurat_object Seurat object name. #' @param mito_name The column name containing percent mitochondrial counts information. Default value is -#' "percent_mito" which is default value created when using `Add_Mito_Ribo_Seurat()`. +#' "percent_mito" which is default value created when using `Add_Mito_Ribo()`. #' @param plot_title Plot Title. #' @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. @@ -188,6 +192,7 @@ QC_Plots_UMIs <- function( #' @param x_axis_label Label for x axis. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -227,6 +232,7 @@ QC_Plots_Mito <- function( y_axis_label = "% Mitochondrial Gene Counts", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -243,7 +249,7 @@ QC_Plots_Mito <- function( Is_Seurat(seurat_object = 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_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + - geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle(plot_title) + @@ -276,6 +282,7 @@ QC_Plots_Mito <- function( #' @param plot_title Plot Title. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -317,6 +324,7 @@ QC_Plots_Feature <- function( plot_title = NULL, low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -336,7 +344,7 @@ QC_Plots_Feature <- function( 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_median = plot_median, plot_boxplot = plot_boxplot, median_size = median_size, ...) + - geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red") + + geom_hline(yintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle(plot_title) + @@ -369,6 +377,7 @@ QC_Plots_Feature <- function( #' @param plot_title Plot Title. #' @param low_cutoff Plot line a potential low threshold for filtering. #' @param high_cutoff Plot line a potential high threshold for filtering. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -409,6 +418,7 @@ QC_Plots_Complexity <- function( plot_title = "Cell Complexity", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, plot_boxplot = FALSE, @@ -421,7 +431,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_boxplot = plot_boxplot, ...) + 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, cutoff_line_width = cutoff_line_width, ...) return(plot) } @@ -438,7 +448,8 @@ QC_Plots_Complexity <- function( #' @param UMI_cutoffs Numeric vector of length 1 or 2 to plot lines for potential low/high threshold for filtering. #' @param mito_cutoffs Numeric vector of length 1 or 2 to plot lines for potential low/high threshold for filtering. #' @param mito_name The column name containing percent mitochondrial counts information. Default value is -#' "percent_mito" which is default value created when using `Add_Mito_Ribo_Seurat()`. +#' "percent_mito" which is default value created when using `Add_Mito_Ribo()`. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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. @@ -478,6 +489,7 @@ QC_Plots_Combined_Vln <- function( UMI_cutoffs = NULL, mito_cutoffs = NULL, mito_name = "percent_mito", + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -511,11 +523,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, plot_boxplot = plot_boxplot, ...) + 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, cutoff_line_width = cutoff_line_width, ...) - 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, ...) + 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, cutoff_line_width = cutoff_line_width, ...) - 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, ...) + 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, cutoff_line_width = cutoff_line_width, ...) # wrap plots plots <- wrap_plots(feature_plot, UMI_plot, mito_plot, ncol = 3) @@ -537,6 +549,7 @@ QC_Plots_Combined_Vln <- function( #' @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 cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @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". @@ -571,6 +584,7 @@ QC_Histogram <- function( features, low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, split.by = NULL, bins = 250, colors_use = "dodgerblue", @@ -633,7 +647,7 @@ QC_Histogram <- function( 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") + + geom_vline(xintercept = c(low_cutoff, high_cutoff), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + ggtitle(plot_titles[x]) }) @@ -699,6 +713,7 @@ QC_Histogram <- function( #' @param high_cutoff_gene Plot line a potential high threshold for filtering genes per cell. #' @param low_cutoff_UMI Plot line a potential low threshold for filtering UMIs per cell. #' @param high_cutoff_UMI Plot line a potential high threshold for filtering UMIs per cell. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @param colors_use vector of colors to use for plotting by identity. #' @param meta_gradient_name Name of continuous meta data variable to color points in plot by. #' (MUST be continuous variable i.e. "percent_mito"). @@ -755,6 +770,7 @@ QC_Plot_UMIvsGene <- function( high_cutoff_gene = Inf, low_cutoff_UMI = -Inf, high_cutoff_UMI = Inf, + cutoff_line_width = NULL, colors_use = NULL, meta_gradient_name = NULL, meta_gradient_color = viridis_plasma_dark_high, @@ -869,8 +885,8 @@ QC_Plot_UMIvsGene <- function( scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + theme_cowplot() + theme(plot.title = element_text(hjust = 0.5)) + - 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle("Genes vs. UMIs per Cell/Nucleus", subtitle = c(paste0("Correlation of full dataset is: ", plot_cor_full, ".", "\nCorrelation of filtered dataset would be: ", plot_cor_filtered, ". ", "\nThe low cutoff for plotting ", meta_gradient_name, " is: ", meta_cutoff_reported))) @@ -881,8 +897,8 @@ QC_Plot_UMIvsGene <- function( scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + theme_cowplot() + theme(plot.title = element_text(hjust = 0.5)) + - 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle("Genes vs. UMIs per Cell/Nucleus", subtitle = c(paste0("Correlation of full dataset is: ", plot_cor_full, ".", "\nCorrelation of filtered dataset would be: ", plot_cor_filtered, ". ", "\nThe low cutoff for plotting ", meta_gradient_name, " is: ", meta_cutoff_reported))) @@ -891,8 +907,8 @@ QC_Plot_UMIvsGene <- function( # Plot by identity 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle("Genes vs. UMIs per Cell/Nucleus", subtitle = c(paste0("Correlation of full dataset is: ", plot_cor_full, ".", "\nCorrelation of filtered dataset would be: ", plot_cor_filtered, "."))) @@ -902,8 +918,8 @@ QC_Plot_UMIvsGene <- function( 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") + - 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) + ggtitle("") @@ -918,8 +934,8 @@ QC_Plot_UMIvsGene <- function( scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + theme_cowplot() + theme(plot.title = element_text(hjust = 0.5)) + - 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) } else { @@ -928,8 +944,8 @@ QC_Plot_UMIvsGene <- function( scale_color_gradientn(colors = meta_gradient_color, limits = c(meta_gradient_low_cutoff, NA), na.value = meta_gradient_na_color) + theme_cowplot() + theme(plot.title = element_text(hjust = 0.5)) + - 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") + + 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", linewidth = cutoff_line_width) + + 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", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) } @@ -953,6 +969,7 @@ QC_Plot_UMIvsGene <- function( #' @param high_cutoff_gene Plot line a potential high threshold for filtering genes per cell. #' @param low_cutoff_feature Plot line a potential low threshold for filtering feature1 per cell. #' @param high_cutoff_feature Plot line a potential high threshold for filtering feature1 per cell. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @param colors_use vector of colors to use for plotting by identity. #' @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). @@ -992,6 +1009,7 @@ QC_Plot_GenevsFeature <- function( high_cutoff_gene = NULL, low_cutoff_feature = NULL, high_cutoff_feature = NULL, + cutoff_line_width = NULL, colors_use = NULL, pt.size = 1, group.by = NULL, @@ -1037,8 +1055,8 @@ QC_Plot_GenevsFeature <- function( # Plot FeatureScatter(object = seurat_object, feature1 = feature1, feature2 = "nFeature_RNA", 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(low_cutoff_gene, high_cutoff_gene), linetype = "dashed", color = "red") + - geom_vline(xintercept = c(low_cutoff_feature, high_cutoff_feature), linetype = "dashed", color = "blue") + + geom_hline(yintercept = c(low_cutoff_gene, high_cutoff_gene), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + + geom_vline(xintercept = c(low_cutoff_feature, high_cutoff_feature), linetype = "dashed", color = "blue", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) } @@ -1056,6 +1074,7 @@ QC_Plot_GenevsFeature <- function( #' @param high_cutoff_UMI Plot line a potential high threshold for filtering UMI per cell. #' @param low_cutoff_feature Plot line a potential low threshold for filtering feature1 per cell. #' @param high_cutoff_feature Plot line a potential high threshold for filtering feature1 per cell. +#' @param cutoff_line_width numerical value for thickness of cutoff lines, default is NULL. #' @param colors_use vector of colors to use for plotting by identity. #' @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). @@ -1095,6 +1114,7 @@ QC_Plot_UMIvsFeature <- function( high_cutoff_UMI = NULL, low_cutoff_feature = NULL, high_cutoff_feature = NULL, + cutoff_line_width = NULL, colors_use = NULL, pt.size = 1, group.by = NULL, @@ -1140,8 +1160,8 @@ QC_Plot_UMIvsFeature <- function( # Plot FeatureScatter(object = seurat_object, feature1 = feature1, feature2 = "nCount_RNA", 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(low_cutoff_UMI, high_cutoff_UMI), linetype = "dashed", color = "red") + - geom_vline(xintercept = c(low_cutoff_feature, high_cutoff_feature), linetype = "dashed", color = "blue") + + geom_hline(yintercept = c(low_cutoff_UMI, high_cutoff_UMI), linetype = "dashed", color = "red", linewidth = cutoff_line_width) + + geom_vline(xintercept = c(low_cutoff_feature, high_cutoff_feature), linetype = "dashed", color = "blue", linewidth = cutoff_line_width) + xlab(x_axis_label) + ylab(y_axis_label) } From fe657de75a84dbf78396357475932d0a9952bdd4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 13:59:30 -0400 Subject: [PATCH 254/503] update docs --- man/QC_Histogram.Rd | 3 +++ man/QC_Plot_GenevsFeature.Rd | 3 +++ man/QC_Plot_UMIvsFeature.Rd | 3 +++ man/QC_Plot_UMIvsGene.Rd | 3 +++ man/QC_Plots_Combined_Vln.Rd | 5 ++++- man/QC_Plots_Complexity.Rd | 3 +++ man/QC_Plots_Feature.Rd | 3 +++ man/QC_Plots_Genes.Rd | 3 +++ man/QC_Plots_Mito.Rd | 5 ++++- man/QC_Plots_UMIs.Rd | 3 +++ 10 files changed, 32 insertions(+), 2 deletions(-) diff --git a/man/QC_Histogram.Rd b/man/QC_Histogram.Rd index e9fdf5d89b..2e9f8d7308 100644 --- a/man/QC_Histogram.Rd +++ b/man/QC_Histogram.Rd @@ -9,6 +9,7 @@ QC_Histogram( features, low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, split.by = NULL, bins = 250, colors_use = "dodgerblue", @@ -27,6 +28,8 @@ QC_Histogram( \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{split.by}{Feature to split plots by (i.e. "orig.ident").} \item{bins}{number of bins to plot default is 250.} diff --git a/man/QC_Plot_GenevsFeature.Rd b/man/QC_Plot_GenevsFeature.Rd index 30eda859a1..07a59a81e3 100644 --- a/man/QC_Plot_GenevsFeature.Rd +++ b/man/QC_Plot_GenevsFeature.Rd @@ -13,6 +13,7 @@ QC_Plot_GenevsFeature( high_cutoff_gene = NULL, low_cutoff_feature = NULL, high_cutoff_feature = NULL, + cutoff_line_width = NULL, colors_use = NULL, pt.size = 1, group.by = NULL, @@ -41,6 +42,8 @@ QC_Plot_GenevsFeature( \item{high_cutoff_feature}{Plot line a potential high threshold for filtering feature1 per cell.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{colors_use}{vector of colors to use for plotting by identity.} \item{pt.size}{Adjust point size for plotting.} diff --git a/man/QC_Plot_UMIvsFeature.Rd b/man/QC_Plot_UMIvsFeature.Rd index b5b0fc9975..cfa8e5d417 100644 --- a/man/QC_Plot_UMIvsFeature.Rd +++ b/man/QC_Plot_UMIvsFeature.Rd @@ -13,6 +13,7 @@ QC_Plot_UMIvsFeature( high_cutoff_UMI = NULL, low_cutoff_feature = NULL, high_cutoff_feature = NULL, + cutoff_line_width = NULL, colors_use = NULL, pt.size = 1, group.by = NULL, @@ -41,6 +42,8 @@ QC_Plot_UMIvsFeature( \item{high_cutoff_feature}{Plot line a potential high threshold for filtering feature1 per cell.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{colors_use}{vector of colors to use for plotting by identity.} \item{pt.size}{Adjust point size for plotting.} diff --git a/man/QC_Plot_UMIvsGene.Rd b/man/QC_Plot_UMIvsGene.Rd index 79fde28437..61621901b3 100644 --- a/man/QC_Plot_UMIvsGene.Rd +++ b/man/QC_Plot_UMIvsGene.Rd @@ -12,6 +12,7 @@ QC_Plot_UMIvsGene( high_cutoff_gene = Inf, low_cutoff_UMI = -Inf, high_cutoff_UMI = Inf, + cutoff_line_width = NULL, colors_use = NULL, meta_gradient_name = NULL, meta_gradient_color = viridis_plasma_dark_high, @@ -45,6 +46,8 @@ QC_Plot_UMIvsGene( \item{high_cutoff_UMI}{Plot line a potential high threshold for filtering UMIs per cell.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{colors_use}{vector of colors to use for plotting by identity.} \item{meta_gradient_name}{Name of continuous meta data variable to color points in plot by. diff --git a/man/QC_Plots_Combined_Vln.Rd b/man/QC_Plots_Combined_Vln.Rd index dccc4428f7..ed7ef8adff 100644 --- a/man/QC_Plots_Combined_Vln.Rd +++ b/man/QC_Plots_Combined_Vln.Rd @@ -11,6 +11,7 @@ QC_Plots_Combined_Vln( UMI_cutoffs = NULL, mito_cutoffs = NULL, mito_name = "percent_mito", + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -37,7 +38,9 @@ default is the current active.ident of the object.} \item{mito_cutoffs}{Numeric vector of length 1 or 2 to plot lines for potential low/high threshold for filtering.} \item{mito_name}{The column name containing percent mitochondrial counts information. Default value is -"percent_mito" which is default value created when using \code{Add_Mito_Ribo_Seurat()}.} +"percent_mito" which is default value created when using \code{Add_Mito_Ribo()}.} + +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} \item{pt.size}{Point size for plotting} diff --git a/man/QC_Plots_Complexity.Rd b/man/QC_Plots_Complexity.Rd index a504a8a271..846eec596e 100644 --- a/man/QC_Plots_Complexity.Rd +++ b/man/QC_Plots_Complexity.Rd @@ -13,6 +13,7 @@ QC_Plots_Complexity( plot_title = "Cell Complexity", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, plot_boxplot = FALSE, @@ -44,6 +45,8 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{pt.size}{Point size for plotting} \item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} diff --git a/man/QC_Plots_Feature.Rd b/man/QC_Plots_Feature.Rd index e3f09a0aaf..95f9f201ef 100644 --- a/man/QC_Plots_Feature.Rd +++ b/man/QC_Plots_Feature.Rd @@ -13,6 +13,7 @@ QC_Plots_Feature( plot_title = NULL, low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -44,6 +45,8 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{pt.size}{Point size for plotting.} \item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} diff --git a/man/QC_Plots_Genes.Rd b/man/QC_Plots_Genes.Rd index 60134b1afe..e96002025e 100644 --- a/man/QC_Plots_Genes.Rd +++ b/man/QC_Plots_Genes.Rd @@ -12,6 +12,7 @@ QC_Plots_Genes( y_axis_label = "Features", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, plot_boxplot = FALSE, @@ -41,6 +42,8 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{pt.size}{Point size for plotting.} \item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} diff --git a/man/QC_Plots_Mito.Rd b/man/QC_Plots_Mito.Rd index 72dbb69100..c3ecdd912c 100644 --- a/man/QC_Plots_Mito.Rd +++ b/man/QC_Plots_Mito.Rd @@ -13,6 +13,7 @@ QC_Plots_Mito( y_axis_label = "\% Mitochondrial Gene Counts", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -30,7 +31,7 @@ QC_Plots_Mito( \item{seurat_object}{Seurat object name.} \item{mito_name}{The column name containing percent mitochondrial counts information. Default value is -"percent_mito" which is default value created when using \code{Add_Mito_Ribo_Seurat()}.} +"percent_mito" which is default value created when using \code{Add_Mito_Ribo()}.} \item{plot_title}{Plot Title.} @@ -45,6 +46,8 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{pt.size}{Point size for plotting.} \item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} diff --git a/man/QC_Plots_UMIs.Rd b/man/QC_Plots_UMIs.Rd index f608315814..c38dac3cf3 100644 --- a/man/QC_Plots_UMIs.Rd +++ b/man/QC_Plots_UMIs.Rd @@ -12,6 +12,7 @@ QC_Plots_UMIs( y_axis_label = "UMIs", low_cutoff = NULL, high_cutoff = NULL, + cutoff_line_width = NULL, pt.size = NULL, plot_median = FALSE, median_size = 15, @@ -41,6 +42,8 @@ default is the current active.ident of the object.} \item{high_cutoff}{Plot line a potential high threshold for filtering.} +\item{cutoff_line_width}{numerical value for thickness of cutoff lines, default is NULL.} + \item{pt.size}{Point size for plotting.} \item{plot_median}{logical, whether to plot median for each ident on the plot (Default is FALSE).} From 32f48381e231798d7aeaf3f90feb0a0fd7fb2a7c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 14:00:28 -0400 Subject: [PATCH 255/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 698e01ab9a..e286ef8eac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,7 @@ - Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). - Added new plotting function `SpatialDimPlot_scCustom`, ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). - Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. +- Added parameter `cutoff_line_width` to the `QC_Plot_*` family of plots to control line thickness of cutoff lines. From 93cd0f20a3094ea945346f1f40ecbda349919f43 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 19 Apr 2024 14:00:40 -0400 Subject: [PATCH 256/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 188d8aa307..d7ce5379ed 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9043 +Version: 2.1.2.9044 Date: 2024-04-19 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")), From f6bbe004668203ea559e99a55678ce637b17ad59 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 08:16:43 -0400 Subject: [PATCH 257/503] change meta present messages to generic (liger and seurat compatible) --- R/Utilities.R | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index 7b076dc6bc..c335bbffb7 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -436,13 +436,6 @@ Meta_Present <- function( # Set possible variables based on object type possible_features <- colnames(x = Fetch_Meta(object = object)) - # if (inherits(x = object, what = "Seurat")) { - # possible_features <- colnames(x = object@meta.data) - # } - # - # if (inherits(x = object, what = "liger")) { - # possible_features <- colnames(x = object@cell.data) - # } # If any features not found if (any(!meta_col_names %in% possible_features)) { @@ -452,14 +445,14 @@ Meta_Present <- function( 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)}}") + "i" = "The following meta data columns were not found: {.field {glue_collapse_scCustom(input_string = bad_meta, and = TRUE)}}") ) } } # Return message of features not found 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:", + 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)}}") ) } @@ -475,7 +468,7 @@ Meta_Present <- function( # Print all found message if TRUE if (isTRUE(x = print_msg)) { - cli_inform(message = "All @meta.data columns present.") + cli_inform(message = "All meta data columns present.") } # Return full input gene list. From f428f3da76f9f136f26ddb56604879a911d0ec8c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:44:45 -0400 Subject: [PATCH 258/503] add cluster name internal function LIGER --- R/LIGER_Utilities.R | 92 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ed8ce3ed94..ba0a168494 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -138,6 +138,98 @@ LIGER_Cells <- function( } +#' Extract Cells by identity +#' +#' Extract all cell barcodes by identity from LIGER object +#' +#' @param liger_object LIGER object name. +#' @param group.by name of meta data column to use, default is current default clustering. +#' @param by_dataset logical, whether to return list with entries for cell barcodes for each +#' identity in `group.by` +#' or to return list of lists (1 entry per dataset and each ident within the dataset) +#' (default is FALSE; return list) +#' +#' @return list or list of lists depending on `by_dataset` parameter +#' +#' @import cli +#' @importFrom dplyr filter select all_of +#' @importFrom magrittr "%>%" +#' @importFrom utils packageVersion +#' +#' @export +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return single vector of all cells +#' cells_by_idents <- LIGER_Cells_by_Identities(liger_object = object, by_dataset = FALSE) +#' +#' # return list of vectors containing cells from each individual dataset in object +#' cells_by_idents_by_dataset <- LIGER_Cells_by_Identities(liger_object = object, by_dataset = TRUE) +#' } +#' + +LIGER_Cells_by_Identities <- function( + liger_object, + group.by = NULL, + by_dataset = FALSE +) { + # Check new liger object + if (!"cellMeta" %in% slotNames(liger_object)) { + cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + } + + # check group.by is valid + if (!is.null(x = group.by)) { + Meta_Present(object = liger_object, meta_col_names = group.by, print_msg = FALSE) + } + + # set group.by if not set + group.by <- group.by %||% LIGER_Default_Cluster(liger_object = liger_object) + + # Check cluster df + cell_df <- Fetch_Meta(object = liger_object) %>% + select(all_of(c(group.by, "dataset"))) + + if (inherits(x = cell_df[[group.by]], what = "factor")) { + ident_levels <- levels(x = cell_df[[group.by]]) + } else { + ident_levels <- unique(x = cell_df[[group.by]]) + } + + # Get cells for object overall + if (isFALSE(x = by_dataset)) { + cells_list <- lapply(ident_levels, function(x) { + cells <- cell_df %>% + filter(.data[[group.by]] == x) %>% + rownames() + }) + + names(cells_list) <- ident_levels + } else { + # Get cells by cluster by dataset + dataset_names <- names(x = rliger::datasets(x = liger_object)) + cells_list <- lapply(1:length(x = dataset_names), function(x) { + sample_cells_df <- cell_df %>% + filter(.data[["dataset"]] == dataset_names[x]) + + sample_cells <- lapply(ident_levels, function(y) { + sample_cells_df %>% + filter(.data[[group.by]] == y) %>% + rownames() + }) + names(sample_cells) <- ident_levels + + return(sample_cells) + }) + names(cells_list) <- dataset_names + } + + return(cells_list) +} + + #' Subset LIGER object #' #' Subset LIGER object by cluster or other meta data variable. From 29d9e0b8ded658768d560d60e7bbc948978e69ea Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:44:59 -0400 Subject: [PATCH 259/503] add cluster name internal function LIGER --- R/LIGER_Internal_Utilities.R | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index a75f7b95ce..7d9d105bb5 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -37,6 +37,40 @@ Default_DimReduc_LIGER <- function( } +#' Extract default clustering +#' +#' Extract name of the default clustering +#' +#' @param liger_object LIGER object name. +#' +#' @return name of default clustering +#' +#' @import cli +#' +#' @noRd +#' +#' @concept liger_object_util +#' +#' @examples +#' \dontrun{ +#' # return dimensionality reduction name +#' dim_reduc_name <- LIGER_Default_Cluster(liger_object = obj) +#' } +#' + +LIGER_Default_Cluster <- function( + liger_object +) { + if (length(x = liger_object@uns$defaultCluster) > 0) { + default_cluster_name <- liger_object@uns$defaultCluster + + return(default_cluster_name) + } else { + cli_abort(message = "No default cluster present.") + } +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### LIGER PLOTTING UTILITIES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From d7b368a234054bc0338cf51b6d554ef37af7d13c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:45:16 -0400 Subject: [PATCH 260/503] Update docs LIGER_Cells_by_Identities --- NAMESPACE | 1 + man/LIGER_Cells_by_Identities.Rd | 35 ++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 man/LIGER_Cells_by_Identities.Rd diff --git a/NAMESPACE b/NAMESPACE index ed01a1f0b7..cc4eab6368 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -80,6 +80,7 @@ export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) export(LIGER_Cells) +export(LIGER_Cells_by_Identities) export(LIGER_DimReduc) export(LIGER_Features) export(Liger_to_Seurat) diff --git a/man/LIGER_Cells_by_Identities.Rd b/man/LIGER_Cells_by_Identities.Rd new file mode 100644 index 0000000000..3ba267c14f --- /dev/null +++ b/man/LIGER_Cells_by_Identities.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{LIGER_Cells_by_Identities} +\alias{LIGER_Cells_by_Identities} +\title{Extract Cells by identity} +\usage{ +LIGER_Cells_by_Identities(liger_object, group.by = NULL, by_dataset = FALSE) +} +\arguments{ +\item{liger_object}{LIGER object name.} + +\item{group.by}{name of meta data column to use, default is current default clustering.} + +\item{by_dataset}{logical, whether to return list with entries for cell barcodes for each +identity in \code{group.by} +or to return list of lists (1 entry per dataset and each ident within the dataset) +(default is FALSE; return list)} +} +\value{ +list or list of lists depending on \code{by_dataset} parameter +} +\description{ +Extract all cell barcodes by identity from LIGER object +} +\examples{ +\dontrun{ +# return single vector of all cells +cells_by_idents <- LIGER_Cells_by_Identities(liger_object = object, by_dataset = FALSE) + +# return list of vectors containing cells from each individual dataset in object +cells_by_idents_by_dataset <- LIGER_Cells_by_Identities(liger_object = object, by_dataset = TRUE) +} + +} +\concept{liger_object_util} From 0f03f3536a1fd810cda5af51eea3340d5245e4e1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:58:45 -0400 Subject: [PATCH 261/503] reexport which cells --- R/Reexports.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/Reexports.R b/R/Reexports.R index 14ad51f459..115fc29486 100644 --- a/R/Reexports.R +++ b/R/Reexports.R @@ -4,3 +4,10 @@ #' #' SeuratObject::as.Seurat + +#' @importFrom SeuratObject WhichCells +#' @export +#' @note See \code{\link{WhichCells.liger}} for scCustomize extension of this generic to extract cell barcodes. +#' +#' +SeuratObject::WhichCells From f96fe9812cd11d50667194bfb5f75191a88b4ccc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:59:01 -0400 Subject: [PATCH 262/503] add WhichCells.liger generic --- R/LIGER_Utilities.R | 88 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 87 insertions(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ba0a168494..85f48a4648 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -176,7 +176,7 @@ LIGER_Cells_by_Identities <- function( by_dataset = FALSE ) { # Check new liger object - if (!"cellMeta" %in% slotNames(liger_object)) { + if (packageVersion(pkg = 'rliger') >= "2.0.0") { cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") } @@ -230,6 +230,92 @@ LIGER_Cells_by_Identities <- function( } +#' Extract Cells for particular identity +#' +#' Extract all cell barcodes for a specific identity +#' +#' @param liger_object LIGER object name. +#' @param idents identities to extract cell barcodes +#' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or +#' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector) +#' +#' @method WhichCells liger +#' @return vector or list depending on `by_dataset` parameter +#' +#' @concept object_conversion +#' +#' @import cli +#' @import Seurat +#' @importFrom dplyr all_of select filter +#' @importFrom magrittr "%>%" +#' +#' @export +#' @rdname WhichCells +#' +#' @examples +#' \dontrun{ +#' ident1_cells <- WhichCells(object = liger_object, idents = 1) +#' } +#' + +WhichCells.liger <- function( + object, + idents = NULL, + by_dataset = FALSE, + ... +) { + # Check new liger object + if (packageVersion(pkg = 'rliger') >= "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") + } + + # Get cells data.frame + default_cluster <- LIGER_Default_Cluster(liger_object = object) + + cell_df <- Fetch_Meta(object = object) %>% + select(all_of(c(default_cluster, "dataset"))) + + # possible idents + if (inherits(x = cell_df[[idents]], what = "factor")) { + ident_levels <- levels(x = cell_df[[default_cluster]]) + } else { + ident_levels <- unique(x = cell_df[[default_cluster]]) + } + + # check idents valid + valid_idents <- intersect(x = idents, y = ident_levels) + if (length(x = valid_idents) == 0) { + cli_abort(message = "None of the provided {.code idents} were found in object.") + } + if (length(x = valid_idents) != idents) { + missing_idents <- setdiff(x = idents, y = valid_idents) + cli_warn(message = c("The following {.code idents} were not found and therefore ignored:", + "i" = "{.field {missing_idents}}")) + } + + # get cells + if (isFALSE(x = by_dataset)) { + cells <- cell_df %>% + filter(.data[[default_cluster]] %in% valid_idents) %>% + rownames() + } else { + dataset_names <- names(x = rliger::datasets(x = object)) + cells <- lapply(dataset_names, function(x) { + sample_cells <- cell_df %>% + filter(.data[["dataset"]] == x & .data[[default_cluster]] %in% valid_idents) %>% + rownames() + }) + + names(x = cells) <- dataset_names + } + + # return cells + return(cells) +} + + + + #' Subset LIGER object #' #' Subset LIGER object by cluster or other meta data variable. From a1c86f0e2bf21ef45649026b6118ff54e2ef38ea Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:59:28 -0400 Subject: [PATCH 263/503] update docs --- NAMESPACE | 3 +++ man/WhichCells.Rd | 29 +++++++++++++++++++++++++++++ man/reexports.Rd | 5 ++++- 3 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 man/WhichCells.Rd diff --git a/NAMESPACE b/NAMESPACE index cc4eab6368..116a95a183 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ S3method(Add_Top_Gene_Pct,Seurat) S3method(Add_Top_Gene_Pct,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) +S3method(WhichCells,liger) S3method(as.LIGER,Seurat) S3method(as.LIGER,list) S3method(as.Seurat,liger) @@ -162,6 +163,7 @@ export(Updated_HGNC_Symbols) export(VariableFeaturePlot_scCustom) export(Variable_Features_ALL_LIGER) export(VlnPlot_scCustom) +export(WhichCells) export(as.LIGER) export(as.Seurat) export(as.anndata) @@ -204,6 +206,7 @@ importFrom(SeuratObject,Features) importFrom(SeuratObject,JoinLayers) importFrom(SeuratObject,LayerData) importFrom(SeuratObject,Layers) +importFrom(SeuratObject,WhichCells) importFrom(SeuratObject,as.Seurat) importFrom(circlize,colorRamp2) importFrom(cowplot,theme_cowplot) diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd new file mode 100644 index 0000000000..a3d664406a --- /dev/null +++ b/man/WhichCells.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{WhichCells.liger} +\alias{WhichCells.liger} +\title{Extract Cells for particular identity} +\usage{ +\method{WhichCells}{liger}(object, idents = NULL, by_dataset = FALSE, ...) +} +\arguments{ +\item{idents}{identities to extract cell barcodes} + +\item{by_dataset}{logical, whether to return vector with cell barcodes for all \code{idents} in or +to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector)} + +\item{liger_object}{LIGER object name.} +} +\value{ +vector or list depending on \code{by_dataset} parameter +} +\description{ +Extract all cell barcodes for a specific identity +} +\examples{ +\dontrun{ +ident1_cells <- WhichCells(object = liger_object, idents = 1) +} + +} +\concept{object_conversion} diff --git a/man/reexports.Rd b/man/reexports.Rd index dbdff0fcba..7e1f294c2c 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -4,9 +4,12 @@ \name{reexports} \alias{reexports} \alias{as.Seurat} +\alias{WhichCells} \title{Objects exported from other packages} \note{ See \code{\link{as.Seurat.liger}} for scCustomize extension of this generic to converting Liger objects. + +See \code{\link{WhichCells.liger}} for scCustomize extension of this generic to extract cell barcodes. } \keyword{internal} \description{ @@ -14,6 +17,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}} + \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{WhichCells}}} }} From 0ee5924347f570d516657618be1c12f6d626c00c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 09:59:38 -0400 Subject: [PATCH 264/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index e286ef8eac..a56e506a0a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - `Subset_LIGER` to quickly subset by cluster or other meta data variable. + - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`, `DimPlot_LIGER`. - Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: From d779b0ce9e755cd3fbbe4093fd174385f92a4de3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 10:00:21 -0400 Subject: [PATCH 265/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index a56e506a0a..4efb2fb486 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,8 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - `Subset_LIGER` to quickly subset by cluster or other meta data variable. - - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. + - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. + - Extended Seurat's `WhichCells` generic to work with liger objects. - Updated functions to interact with both old and new style liger objects: - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`, `DimPlot_LIGER`. - Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: From 840c5d62c1118b1962be42687ecfa30b479df3c6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 10:00:37 -0400 Subject: [PATCH 266/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d7ce5379ed..8f7a60d506 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" RRID:SCR_024675. -Version: 2.1.2.9044 -Date: 2024-04-19 +Version: 2.1.2.9045 +Date: 2024-04-23 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"), From a830b8c971e3420cf71addec5969c92b8b8be602 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 23 Apr 2024 10:07:14 -0400 Subject: [PATCH 267/503] fix version test --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 85f48a4648..ab7236dec3 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -265,7 +265,7 @@ WhichCells.liger <- function( ... ) { # Check new liger object - if (packageVersion(pkg = 'rliger') >= "2.0.0") { + if (packageVersion(pkg = 'rliger') < "2.0.0") { cli_abort(message = "This function is only for objects with rliger >= v2.0.0") } From 21ef057d1287f4652ac3c21e0ca96d45432e3f4d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 06:28:20 -0400 Subject: [PATCH 268/503] Add Features as generic --- R/LIGER_Utilities.R | 230 ++++++++++++++++++++++---------------------- R/Reexports.R | 14 +++ 2 files changed, 131 insertions(+), 113 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ab7236dec3..7151aa5908 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -27,46 +27,49 @@ Fetch_Meta.liger <- function( #' #' Extract all unique features from LIGER object #' -#' @param liger_object LIGER object name. +#' @param x LIGER object name. #' @param by_dataset logical, whether to return list with vector of features for each dataset in #' LIGER object or to return single vector of unique features across all datasets in object #' (default is FALSE; return vector of unique features) #' +#' @method Features liger #' @return vector or list depending on `by_dataset` parameter #' #' @importFrom utils packageVersion #' #' @export +#' @rdname Features #' #' @concept liger_object_util #' #' @examples #' \dontrun{ #' # return single vector of all unique features -#' all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) +#' all_features <- Features(x = object, by_dataset = FALSE) #' #' # return list of vectors containing features from each individual dataset in object -#' dataset_features <- LIGER_Features(liger_object = object, by_dataset = TRUE) +#' dataset_features <- Features(x = object, by_dataset = TRUE) #' } #' -LIGER_Features <- function( - liger_object, - by_dataset = FALSE +Features.liger <- function( + x, + by_dataset = FALSE, + ... ) { # check liger - Is_LIGER(liger_object = liger_object) + Is_LIGER(liger_object = x) # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { # Extract features - features_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { - rownames(x = liger_object@datasets[[x]]@featureMeta) + features_by_dataset <- lapply(1:length(x = x@datasets), function(j) { + rownames(x = x@datasets[[j]]@featureMeta) }) } else { # Extract features - features_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { - rownames(x = liger_object@raw.data[[x]]) + features_by_dataset <- lapply(1:length(x = x@raw.data), function(j) { + rownames(x = x@raw.data[[j]]) }) } @@ -84,47 +87,50 @@ LIGER_Features <- function( #' #' Extract all cell barcodes from LIGER object #' -#' @param liger_object LIGER object name. +#' @param x LIGER object name. #' @param by_dataset logical, whether to return list with vector of cell barcodes for each #' dataset in LIGER object or to return single vector of cell barcodes across all #' datasets in object (default is FALSE; return vector of cells) #' +#' @method Cells liger #' @return vector or list depending on `by_dataset` parameter #' #' @importFrom utils packageVersion #' #' @export +#' @rdname Cells #' #' @concept liger_object_util #' #' @examples #' \dontrun{ #' # return single vector of all cells -#' all_features <- LIGER_Cells(liger_object = object, by_dataset = FALSE) +#' all_features <- Cells(x = object, by_dataset = FALSE) #' #' # return list of vectors containing cells from each individual dataset in object -#' dataset_features <- LIGER_Cells(liger_object = object, by_dataset = TRUE) +#' dataset_features <- Cells(x = object, by_dataset = TRUE) #' } #' -LIGER_Cells <- function( - liger_object, - by_dataset = FALSE +Cells.liger <- function( + x, + by_dataset = FALSE, + ... ) { # check liger - Is_LIGER(liger_object = liger_object) + Is_LIGER(liger_object = x) # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { # Extract features - cells_by_dataset <- lapply(1:length(x = liger_object@datasets), function(x) { - colnames(x = liger_object@datasets[[x]]) + cells_by_dataset <- lapply(1:length(x = x@datasets), function(j) { + colnames(x = x@datasets[[j]]) }) - names(cells_by_dataset) <- names(liger_object@datasets) + names(cells_by_dataset) <- names(x@datasets) } else { # Extract features - cells_by_dataset <- lapply(1:length(x = liger_object@raw.data), function(x) { - colnames(x = liger_object@raw.data[[x]]) + cells_by_dataset <- lapply(1:length(x = x@raw.data), function(j) { + colnames(x = x@raw.data[[j]]) }) } @@ -138,6 +144,90 @@ LIGER_Cells <- function( } +#' Extract Cells for particular identity +#' +#' Extract all cell barcodes for a specific identity +#' +#' @param liger_object LIGER object name. +#' @param idents identities to extract cell barcodes +#' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or +#' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector) +#' +#' @method WhichCells liger +#' @return vector or list depending on `by_dataset` parameter +#' +#' @concept object_conversion +#' +#' @import cli +#' @import Seurat +#' @importFrom dplyr all_of select filter +#' @importFrom magrittr "%>%" +#' +#' @export +#' @rdname WhichCells +#' +#' @examples +#' \dontrun{ +#' ident1_cells <- WhichCells(object = liger_object, idents = 1) +#' } +#' + +WhichCells.liger <- function( + object, + idents = NULL, + by_dataset = FALSE, + ... +) { + # Check new liger object + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") + } + + # Get cells data.frame + default_cluster <- LIGER_Default_Cluster(liger_object = object) + + cell_df <- Fetch_Meta(object = object) %>% + select(all_of(c(default_cluster, "dataset"))) + + # possible idents + if (inherits(x = cell_df[[idents]], what = "factor")) { + ident_levels <- levels(x = cell_df[[default_cluster]]) + } else { + ident_levels <- unique(x = cell_df[[default_cluster]]) + } + + # check idents valid + valid_idents <- intersect(x = idents, y = ident_levels) + if (length(x = valid_idents) == 0) { + cli_abort(message = "None of the provided {.code idents} were found in object.") + } + if (length(x = valid_idents) != idents) { + missing_idents <- setdiff(x = idents, y = valid_idents) + cli_warn(message = c("The following {.code idents} were not found and therefore ignored:", + "i" = "{.field {missing_idents}}")) + } + + # get cells + if (isFALSE(x = by_dataset)) { + cells <- cell_df %>% + filter(.data[[default_cluster]] %in% valid_idents) %>% + rownames() + } else { + dataset_names <- names(x = rliger::datasets(x = object)) + cells <- lapply(dataset_names, function(x) { + sample_cells <- cell_df %>% + filter(.data[["dataset"]] == x & .data[[default_cluster]] %in% valid_idents) %>% + rownames() + }) + + names(x = cells) <- dataset_names + } + + # return cells + return(cells) +} + + #' Extract Cells by identity #' #' Extract all cell barcodes by identity from LIGER object @@ -176,7 +266,7 @@ LIGER_Cells_by_Identities <- function( by_dataset = FALSE ) { # Check new liger object - if (packageVersion(pkg = 'rliger') >= "2.0.0") { + if (packageVersion(pkg = 'rliger') < "2.0.0") { cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") } @@ -230,92 +320,6 @@ LIGER_Cells_by_Identities <- function( } -#' Extract Cells for particular identity -#' -#' Extract all cell barcodes for a specific identity -#' -#' @param liger_object LIGER object name. -#' @param idents identities to extract cell barcodes -#' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or -#' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector) -#' -#' @method WhichCells liger -#' @return vector or list depending on `by_dataset` parameter -#' -#' @concept object_conversion -#' -#' @import cli -#' @import Seurat -#' @importFrom dplyr all_of select filter -#' @importFrom magrittr "%>%" -#' -#' @export -#' @rdname WhichCells -#' -#' @examples -#' \dontrun{ -#' ident1_cells <- WhichCells(object = liger_object, idents = 1) -#' } -#' - -WhichCells.liger <- function( - object, - idents = NULL, - by_dataset = FALSE, - ... -) { - # Check new liger object - if (packageVersion(pkg = 'rliger') < "2.0.0") { - cli_abort(message = "This function is only for objects with rliger >= v2.0.0") - } - - # Get cells data.frame - default_cluster <- LIGER_Default_Cluster(liger_object = object) - - cell_df <- Fetch_Meta(object = object) %>% - select(all_of(c(default_cluster, "dataset"))) - - # possible idents - if (inherits(x = cell_df[[idents]], what = "factor")) { - ident_levels <- levels(x = cell_df[[default_cluster]]) - } else { - ident_levels <- unique(x = cell_df[[default_cluster]]) - } - - # check idents valid - valid_idents <- intersect(x = idents, y = ident_levels) - if (length(x = valid_idents) == 0) { - cli_abort(message = "None of the provided {.code idents} were found in object.") - } - if (length(x = valid_idents) != idents) { - missing_idents <- setdiff(x = idents, y = valid_idents) - cli_warn(message = c("The following {.code idents} were not found and therefore ignored:", - "i" = "{.field {missing_idents}}")) - } - - # get cells - if (isFALSE(x = by_dataset)) { - cells <- cell_df %>% - filter(.data[[default_cluster]] %in% valid_idents) %>% - rownames() - } else { - dataset_names <- names(x = rliger::datasets(x = object)) - cells <- lapply(dataset_names, function(x) { - sample_cells <- cell_df %>% - filter(.data[["dataset"]] == x & .data[[default_cluster]] %in% valid_idents) %>% - rownames() - }) - - names(x = cells) <- dataset_names - } - - # return cells - return(cells) -} - - - - #' Subset LIGER object #' #' Subset LIGER object by cluster or other meta data variable. @@ -433,7 +437,7 @@ Subset_LIGER <- function( # invert filtering if (isTRUE(x = invert)) { # get vector of call cells - all_cells <- LIGER_Cells(liger_object = liger_object) + all_cells <- Cells(x = liger_object) # setdiff to get inverse cells_filter <- setdiff(x = all_cells, y = cells_filter) @@ -955,7 +959,7 @@ Add_Mito_Ribo.liger <- function( ribo_features <- Retrieve_Ensembl_Ribo(species = species) } - all_features <- LIGER_Features(liger_object = object) + all_features <- Features(x = object) # get features from patterns mito_features <- mito_features %||% grep(pattern = mito_pattern, x = all_features, value = TRUE) @@ -1232,7 +1236,7 @@ Add_Hemo.liger <- function( } # get all features - all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) + all_features <- Features(x = object, by_dataset = FALSE) # get features from patterns hemo_features <- hemo_features %||% grep(pattern = hemo_pattern, x = all_features, value = TRUE) diff --git a/R/Reexports.R b/R/Reexports.R index 115fc29486..ba4604d2d4 100644 --- a/R/Reexports.R +++ b/R/Reexports.R @@ -11,3 +11,17 @@ SeuratObject::as.Seurat #' #' SeuratObject::WhichCells + +#' @importFrom SeuratObject Cells +#' @export +#' @note See \code{\link{Cells.liger}} for scCustomize extension of this generic to extract cell barcodes. +#' +#' +SeuratObject::Cells + +#' @importFrom SeuratObject Features +#' @export +#' @note See \code{\link{Features.liger}} for scCustomize extension of this generic to extract dataset features. +#' +#' +SeuratObject::Features From 3e2a3c2eeae14fdf14a2ddd2c17f9e5089fb2405 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 06:28:35 -0400 Subject: [PATCH 269/503] Update downstream Cells and Features calls --- R/LIGER_Internal_Utilities.R | 8 ++++---- R/LIGER_Plotting.R | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 7d9d105bb5..572e8a2cde 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -1766,7 +1766,7 @@ LIGER_DimPlot <- function( } # cells in object - cells_total <- LIGER_Cells(liger_object = liger_object) + cells_total <- Cells(x = liger_object) # Add raster check for scCustomize raster <- raster %||% (length(x = cells_total) > 2e5) @@ -1998,7 +1998,7 @@ LIGER2_DimPlot <- function( } # cells in object - cells_total <- LIGER_Cells(liger_object = liger_object) + cells_total <- Cells(x = liger_object) # Add raster check for scCustomize raster <- raster %||% (length(x = cells_total) > 2e5) @@ -2206,7 +2206,7 @@ Add_MSigDB_LIGER <- function( msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) # Check features are present in object - all_features <- LIGER_Features(liger_object = liger_object, by_dataset = FALSE) + all_features <- Features(x = liger_object, by_dataset = FALSE) oxphos_found <- intersect(x = msigdb_gene_list[["oxphos"]], y = all_features) apop_found <- intersect(x = msigdb_gene_list[["apop"]], y = all_features) @@ -2309,7 +2309,7 @@ Add_IEG_LIGER <- function( # Retrieve gene lists ieg_gene_list <- Retrieve_IEG_Lists(species = species) - all_features <- LIGER_Features(liger_object = liger_object, by_dataset = FALSE) + all_features <- Features(x = liger_object, by_dataset = FALSE) ieg_found <- intersect(x = ieg_gene_list[["ieg"]], y = all_features) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 2f9aefe2da..49a7f19263 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -123,7 +123,7 @@ DimPlot_LIGER <- function( } # cells in object - cells_total <- LIGER_Cells(liger_object = liger_object) + cells_total <- Cells(x = liger_object) # Add raster check for scCustomize raster <- raster %||% (length(x = cells_total) > 2e5) From eac05a154741b2029576b47925e00d77a8687b41 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 06:28:50 -0400 Subject: [PATCH 270/503] Update docs --- NAMESPACE | 7 +++++-- man/{LIGER_Cells.Rd => Cells.Rd} | 12 ++++++------ man/{LIGER_Features.Rd => Features.Rd} | 12 ++++++------ man/reexports.Rd | 8 +++++++- 4 files changed, 24 insertions(+), 15 deletions(-) rename man/{LIGER_Cells.Rd => Cells.Rd} (71%) rename man/{LIGER_Features.Rd => Features.Rd} (71%) diff --git a/NAMESPACE b/NAMESPACE index 116a95a183..1ec9ea2fe1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,8 @@ S3method(Add_Mito_Ribo,Seurat) S3method(Add_Mito_Ribo,liger) S3method(Add_Top_Gene_Pct,Seurat) S3method(Add_Top_Gene_Pct,liger) +S3method(Cells,liger) +S3method(Features,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) S3method(WhichCells,liger) @@ -38,6 +40,7 @@ export(Case_Check) export(CellBender_Diff_Plot) export(CellBender_Feature_Diff) export(Cell_Highlight_Plot) +export(Cells) export(Change_Delim_All) export(Change_Delim_Prefix) export(Change_Delim_Suffix) @@ -66,6 +69,7 @@ export(FeaturePlot_DualAssay) export(FeaturePlot_scCustom) export(FeatureScatter_scCustom) export(Feature_Present) +export(Features) export(Fetch_Meta) export(Find_Factor_Cor) export(Gene_Present) @@ -80,10 +84,8 @@ export(Iterate_Plot_Density_Custom) export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) -export(LIGER_Cells) export(LIGER_Cells_by_Identities) export(LIGER_DimReduc) -export(LIGER_Features) export(Liger_to_Seurat) export(MAD_Stats) export(Median_Stats) @@ -201,6 +203,7 @@ importFrom(Seurat,Read10X_h5) importFrom(Seurat,VariableFeaturePlot) importFrom(Seurat,VizDimLoadings) importFrom(Seurat,VlnPlot) +importFrom(SeuratObject,Cells) importFrom(SeuratObject,DefaultDimReduc) importFrom(SeuratObject,Features) importFrom(SeuratObject,JoinLayers) diff --git a/man/LIGER_Cells.Rd b/man/Cells.Rd similarity index 71% rename from man/LIGER_Cells.Rd rename to man/Cells.Rd index 594cb71b24..38b839a896 100644 --- a/man/LIGER_Cells.Rd +++ b/man/Cells.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/LIGER_Utilities.R -\name{LIGER_Cells} -\alias{LIGER_Cells} +\name{Cells.liger} +\alias{Cells.liger} \title{Extract Cells from LIGER Object} \usage{ -LIGER_Cells(liger_object, by_dataset = FALSE) +\method{Cells}{liger}(x, by_dataset = FALSE, ...) } \arguments{ -\item{liger_object}{LIGER object name.} +\item{x}{LIGER object name.} \item{by_dataset}{logical, whether to return list with vector of cell barcodes for each dataset in LIGER object or to return single vector of cell barcodes across all @@ -22,10 +22,10 @@ Extract all cell barcodes from LIGER object \examples{ \dontrun{ # return single vector of all cells -all_features <- LIGER_Cells(liger_object = object, by_dataset = FALSE) +all_features <- Cells(x = object, by_dataset = FALSE) # return list of vectors containing cells from each individual dataset in object -dataset_features <- LIGER_Cells(liger_object = object, by_dataset = TRUE) +dataset_features <- Cells(x = object, by_dataset = TRUE) } } diff --git a/man/LIGER_Features.Rd b/man/Features.Rd similarity index 71% rename from man/LIGER_Features.Rd rename to man/Features.Rd index 3c3108b5a8..52eef599a1 100644 --- a/man/LIGER_Features.Rd +++ b/man/Features.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/LIGER_Utilities.R -\name{LIGER_Features} -\alias{LIGER_Features} +\name{Features.liger} +\alias{Features.liger} \title{Extract Features from LIGER Object} \usage{ -LIGER_Features(liger_object, by_dataset = FALSE) +\method{Features}{liger}(x, by_dataset = FALSE, ...) } \arguments{ -\item{liger_object}{LIGER object name.} +\item{x}{LIGER object name.} \item{by_dataset}{logical, whether to return list with vector of features for each dataset in LIGER object or to return single vector of unique features across all datasets in object @@ -22,10 +22,10 @@ Extract all unique features from LIGER object \examples{ \dontrun{ # return single vector of all unique features -all_features <- LIGER_Features(liger_object = object, by_dataset = FALSE) +all_features <- Features(x = object, by_dataset = FALSE) # return list of vectors containing features from each individual dataset in object -dataset_features <- LIGER_Features(liger_object = object, by_dataset = TRUE) +dataset_features <- Features(x = object, by_dataset = TRUE) } } diff --git a/man/reexports.Rd b/man/reexports.Rd index 7e1f294c2c..84e140bb6f 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -5,11 +5,17 @@ \alias{reexports} \alias{as.Seurat} \alias{WhichCells} +\alias{Cells} +\alias{Features} \title{Objects exported from other packages} \note{ See \code{\link{as.Seurat.liger}} for scCustomize extension of this generic to converting Liger objects. See \code{\link{WhichCells.liger}} for scCustomize extension of this generic to extract cell barcodes. + +See \code{\link{Cells.liger}} for scCustomize extension of this generic to extract cell barcodes. + +See \code{\link{Features.liger}} for scCustomize extension of this generic to extract dataset features. } \keyword{internal} \description{ @@ -17,6 +23,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{WhichCells}}} + \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{Cells}}, \code{\link[SeuratObject:Cells]{Features}}, \code{\link[SeuratObject]{WhichCells}}} }} From 706515bd26a664ce9d660b991812daa403da4e1b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 06:43:08 -0400 Subject: [PATCH 271/503] Update changelog --- NEWS.md | 40 +++++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4efb2fb486..39c3ec384b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,24 +1,38 @@ -# scCustomize 2.X.X (2024-XX-XX) +# scCustomize 2.2.0 (2024-XX-XX) ## Added -- Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. -- Added new function `seq_zeros()` to create sequences with preceding zeros. -- Added new functions to interact with liger v2.0.0+ object format change: +- **Major Updates to Functionality with rliger package:** +- *Added new utility functions to interact with liger v2.0.0+ object format change:* - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - - `LIGER_Cells` to extract vector of all cells or list vectors of cells by dataset. - `Subset_LIGER` to quickly subset by cluster or other meta data variable. - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. - - Extended Seurat's `WhichCells` generic to work with liger objects. -- Updated functions to interact with both old and new style liger objects: - - `plotFactors_scCustom()`, `Fetch_Meta`, `LIGER_Features`, `Top_Genes_Factor`, `Add_Mito_Ribo`, `Add_Cell_Complexity`, `DimPlot_LIGER`. -- Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+: - - `as.LIGER`, `as.Seurat`. -- Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. -- Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. +- *Extended the following Seurat/SeuratObject functions to work seamlessly with liger objects:* + - `Cells` to extract vector of all cells or list vectors of cells by dataset. + - `Features` to extract vector of all features or list vectors of features by dataset. + - `WhichCells` to extract vector or list of cells matching identity criteria. +- *Updated functions to interact with both old and new style liger objects:* + - `plotFactors_scCustom()` + - `Fetch_Meta` + - `Top_Genes_Factor` + - `Add_Mito_Ribo` + - `Add_Cell_Complexity` + - `DimPlot_LIGER` +- *New functions compatible with old and new style liger objects:* +- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. +- *New functions for rliger v2.0.0+ only:* + - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. + - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. +- *Updated functions to recommend new rliger equivalents for users with rliger v2.0.0+:* + - `as.LIGER` + - `as.Seurat` + +- **General scCustomize Updates:** - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. +- Added new parameters `data_name` and `overwrite` to `Add_Alt_Feature_ID` to support new storage location. +- Added new function `seq_zeros()` to create sequences with preceding zeros. - Added new function `Read_Metrics_CellBender` to read in the summary metrics csv file produced by CellBender. Can either read all metrics files from parent directory of output folders or a single metrics file. - Added `cells` parameter explicitly to `FeatureScatter_scCustom`. - Added Chicken (Gallus gallus) to default species for QC functions. Thanks @dpearton; ([#176](https://github.com/samuel-marsh/scCustomize/issues/176)). -- Added new plotting function `SpatialDimPlot_scCustom`, ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). +- Added new plotting function `SpatialDimPlot_scCustom`. Thanks for encouragement @puapinyoying @nina-hahn ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). - Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. - Added parameter `cutoff_line_width` to the `QC_Plot_*` family of plots to control line thickness of cutoff lines. From 74be019d35108d3fcfef9b20255613fd13f8ff16 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 06:43:23 -0400 Subject: [PATCH 272/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8f7a60d506..36a45cd3f3 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" RRID:SCR_024675. -Version: 2.1.2.9045 -Date: 2024-04-23 +Version: 2.1.2.9046 +Date: 2024-04-24 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"), From 20adc5f7a4287684b7475ac88a49e56ce906ca18 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 07:50:05 -0400 Subject: [PATCH 273/503] add invert to which cells --- R/LIGER_Utilities.R | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 7151aa5908..2431347d82 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -151,7 +151,8 @@ Cells.liger <- function( #' @param liger_object LIGER object name. #' @param idents identities to extract cell barcodes #' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or -#' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector) +#' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector). +#' @param invert logical, invert the selection of cells (default is FALSE). #' #' @method WhichCells liger #' @return vector or list depending on `by_dataset` parameter @@ -176,6 +177,7 @@ WhichCells.liger <- function( object, idents = NULL, by_dataset = FALSE, + invert = FALSE, ... ) { # Check new liger object @@ -212,6 +214,9 @@ WhichCells.liger <- function( cells <- cell_df %>% filter(.data[[default_cluster]] %in% valid_idents) %>% rownames() + if (isTRUE(x = invert)) { + cells <- setdiff(x = Cells(x = object, by_dataset = FALSE), y = cells) + } } else { dataset_names <- names(x = rliger::datasets(x = object)) cells <- lapply(dataset_names, function(x) { @@ -219,6 +224,12 @@ WhichCells.liger <- function( filter(.data[["dataset"]] == x & .data[[default_cluster]] %in% valid_idents) %>% rownames() }) + if (isTRUE(x = invert)) { + all_cells <- Cells(x = object, by_dataset = TRUE) + cells <- lapply(1:length(x = cells), function(x) { + cells_inverted <- setdiff(x = all_cells[[x]], y = cells[[x]]) + }) + } names(x = cells) <- dataset_names } @@ -391,7 +402,7 @@ Subset_LIGER <- function( # pull meta data meta <- Fetch_Meta(object = liger_object) - # check subset value ok + # check subset value ok idents if (!is.null(x = ident)) { ident_values <- meta %>% pull(.data[[ident_col]]) %>% @@ -402,7 +413,7 @@ Subset_LIGER <- function( } } - # check sub set value ok + # check subset value ok idents if (!is.null(x = cluster)) { cluster_values <- meta %>% pull(.data[[cluster_col]]) %>% @@ -443,6 +454,7 @@ Subset_LIGER <- function( cells_filter <- setdiff(x = all_cells, y = cells_filter) } + # subset object sub_obj <- rliger::subsetLiger(object = liger_object, cellIdx = cells_filter) return(sub_obj) From 5e623a2ebf0b39b1449c397d0557490e30309919 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 07:50:33 -0400 Subject: [PATCH 274/503] update docs --- man/WhichCells.Rd | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd index a3d664406a..d239bf9d04 100644 --- a/man/WhichCells.Rd +++ b/man/WhichCells.Rd @@ -4,13 +4,15 @@ \alias{WhichCells.liger} \title{Extract Cells for particular identity} \usage{ -\method{WhichCells}{liger}(object, idents = NULL, by_dataset = FALSE, ...) +\method{WhichCells}{liger}(object, idents = NULL, by_dataset = FALSE, invert = FALSE, ...) } \arguments{ \item{idents}{identities to extract cell barcodes} \item{by_dataset}{logical, whether to return vector with cell barcodes for all \code{idents} in or -to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector)} +to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector).} + +\item{invert}{logical, invert the selection of cells (default is FALSE).} \item{liger_object}{LIGER object name.} } From eecac9875bf1b1391ef68ec4892eb31e54b7f9e3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:03:29 -0400 Subject: [PATCH 275/503] add ident_col --- R/LIGER_Utilities.R | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 2431347d82..4114cf3361 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -149,7 +149,9 @@ Cells.liger <- function( #' Extract all cell barcodes for a specific identity #' #' @param liger_object LIGER object name. -#' @param idents identities to extract cell barcodes +#' @param idents identities to extract cell barcodes. +#' @param ident_col name of meta data column to use when subsetting cells by identity values. +#' Default is NULL, which will use the objects default clustering as the `ident_col`. #' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or #' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector). #' @param invert logical, invert the selection of cells (default is FALSE). @@ -169,13 +171,18 @@ Cells.liger <- function( #' #' @examples #' \dontrun{ +#' # Extract cells from ident =1 in current default clustering #' ident1_cells <- WhichCells(object = liger_object, idents = 1) +#' +#' # Extract all cells from "stim" treatment from object +#' stim_cells <- WhichCells(object = liger_object, idents = "stim", ident_col = "Treatment") #' } #' WhichCells.liger <- function( object, - idents = NULL, + ident = NULL, + ident_col = NULL, by_dataset = FALSE, invert = FALSE, ... @@ -186,20 +193,21 @@ WhichCells.liger <- function( } # Get cells data.frame - default_cluster <- LIGER_Default_Cluster(liger_object = object) + ident_col <- ident_col %||% LIGER_Default_Cluster(liger_object = object) cell_df <- Fetch_Meta(object = object) %>% - select(all_of(c(default_cluster, "dataset"))) + select(all_of(c(ident_col, "dataset"))) # possible idents if (inherits(x = cell_df[[idents]], what = "factor")) { - ident_levels <- levels(x = cell_df[[default_cluster]]) + ident_levels <- levels(x = cell_df[[ident_col]]) } else { - ident_levels <- unique(x = cell_df[[default_cluster]]) + ident_levels <- unique(x = cell_df[[ident_col]]) } # check idents valid valid_idents <- intersect(x = idents, y = ident_levels) + if (length(x = valid_idents) == 0) { cli_abort(message = "None of the provided {.code idents} were found in object.") } @@ -212,7 +220,7 @@ WhichCells.liger <- function( # get cells if (isFALSE(x = by_dataset)) { cells <- cell_df %>% - filter(.data[[default_cluster]] %in% valid_idents) %>% + filter(.data[[ident_col]] %in% valid_idents) %>% rownames() if (isTRUE(x = invert)) { cells <- setdiff(x = Cells(x = object, by_dataset = FALSE), y = cells) @@ -221,7 +229,7 @@ WhichCells.liger <- function( dataset_names <- names(x = rliger::datasets(x = object)) cells <- lapply(dataset_names, function(x) { sample_cells <- cell_df %>% - filter(.data[["dataset"]] == x & .data[[default_cluster]] %in% valid_idents) %>% + filter(.data[["dataset"]] == x & .data[[ident_col]] %in% valid_idents) %>% rownames() }) if (isTRUE(x = invert)) { @@ -426,7 +434,8 @@ Subset_LIGER <- function( # filter just by cluster if (!is.null(x = cluster) && is.null(x = ident)) { - cells_filter <- meta %>% + cells_filter <- WhichCells.liger() + meta %>% filter(.data[[cluster_col]] %in% cluster) %>% rownames() } From a78a980398f1bfddf99303089b8960097290f4d7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:03:36 -0400 Subject: [PATCH 276/503] Update docs --- man/WhichCells.Rd | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd index d239bf9d04..1a17574d1e 100644 --- a/man/WhichCells.Rd +++ b/man/WhichCells.Rd @@ -4,10 +4,18 @@ \alias{WhichCells.liger} \title{Extract Cells for particular identity} \usage{ -\method{WhichCells}{liger}(object, idents = NULL, by_dataset = FALSE, invert = FALSE, ...) +\method{WhichCells}{liger}( + object, + ident = NULL, + ident_col = NULL, + by_dataset = FALSE, + invert = FALSE, + ... +) } \arguments{ -\item{idents}{identities to extract cell barcodes} +\item{ident_col}{name of meta data column to use when subsetting cells by identity values. +Default is NULL, which will use the objects default clustering as the \code{ident_col}.} \item{by_dataset}{logical, whether to return vector with cell barcodes for all \code{idents} in or to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector).} @@ -15,6 +23,8 @@ to return list (1 entry per dataset with vector of cells) (default is FALSE; ret \item{invert}{logical, invert the selection of cells (default is FALSE).} \item{liger_object}{LIGER object name.} + +\item{idents}{identities to extract cell barcodes.} } \value{ vector or list depending on \code{by_dataset} parameter @@ -24,7 +34,11 @@ Extract all cell barcodes for a specific identity } \examples{ \dontrun{ +# Extract cells from ident =1 in current default clustering ident1_cells <- WhichCells(object = liger_object, idents = 1) + +# Extract all cells from "stim" treatment from object +stim_cells <- WhichCells(object = liger_object, idents = "stim", ident_col = "Treatment") } } From f0f8bf5675d874b082df20e6373d7d9ae5a9d998 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:09:35 -0400 Subject: [PATCH 277/503] Update subset_Liger to use WhichCells --- R/LIGER_Utilities.R | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 4114cf3361..0c8ff28a8e 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -434,24 +434,20 @@ Subset_LIGER <- function( # filter just by cluster if (!is.null(x = cluster) && is.null(x = ident)) { - cells_filter <- WhichCells.liger() - meta %>% - filter(.data[[cluster_col]] %in% cluster) %>% - rownames() + cells_filter <- WhichCells(object = liger_object, ident = cluster, ident_col = cluster_col) } # filter just by ident if (!is.null(x = ident) && is.null(x = cluster)) { - cells_filter <- meta %>% - filter(.data[[ident_col]] %in% ident) %>% - rownames() + cells_filter <- WhichCells(object = liger_object, ident = ident, ident_col = ident_col) } # Filter by ident and cluster if (!is.null(x = ident) && !is.null(x = cluster)) { - cells_filter <- meta %>% - filter(.data[[ident_col]] %in% ident & .data[[cluster_col]] %in% cluster) %>% - rownames() + cells_filter_cluster <- WhichCells(object = liger_object, ident = cluster, ident_col = cluster_col) + cells_filter_ident <- WhichCells(object = liger_object, ident = ident, ident_col = ident_col) + + cells_filter <- intersect(x = cells_filter_cluster, y = cells_filter_ident) } # invert filtering From 7e19649bea6a82c41b70603b96441f23d66fec06 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:10:26 -0400 Subject: [PATCH 278/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 39c3ec384b..ab0c5f3aa7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,7 +17,7 @@ - `Add_Cell_Complexity` - `DimPlot_LIGER` - *New functions compatible with old and new style liger objects:* -- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque) and works with both Seurat and liger objects. +- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. - *New functions for rliger v2.0.0+ only:* - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. From 11e412d89b39ecfca278f04cbeee9729d2933a3f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:10:45 -0400 Subject: [PATCH 279/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 36a45cd3f3..7fb5a37128 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9046 +Version: 2.1.2.9047 Date: 2024-04-24 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")), From e18ab4a7b0a50b6cebeeef48cbddcb1be2d01060 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:31:27 -0400 Subject: [PATCH 280/503] replace LIGER_Features --- R/Object_Conversion.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Conversion.R b/R/Object_Conversion.R index cb4105ffee..dc7e69fdd7 100644 --- a/R/Object_Conversion.R +++ b/R/Object_Conversion.R @@ -1299,7 +1299,7 @@ as.anndata.liger <- function( # pull var genes liger_var_genes <- x@var.genes - total_features <- data.frame("all_genes" = LIGER_Features(liger_object = x)) + total_features <- data.frame("all_genes" = Features(x = x)) liger_var_df <- total_features %>% mutate("variable_genes" = ifelse(.data[["all_genes"]] %in% liger_var_genes, .data[["all_genes"]], NA)) %>% From 859b3f87225fd994df88c8f1d54f02a391f1f707 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:32:33 -0400 Subject: [PATCH 281/503] Add Embeddings generic --- R/LIGER_Utilities.R | 60 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 0c8ff28a8e..726c78ea63 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -148,7 +148,7 @@ Cells.liger <- function( #' #' Extract all cell barcodes for a specific identity #' -#' @param liger_object LIGER object name. +#' @param object LIGER object name. #' @param idents identities to extract cell barcodes. #' @param ident_col name of meta data column to use when subsetting cells by identity values. #' Default is NULL, which will use the objects default clustering as the `ident_col`. @@ -181,7 +181,7 @@ Cells.liger <- function( WhichCells.liger <- function( object, - ident = NULL, + idents = NULL, ident_col = NULL, by_dataset = FALSE, invert = FALSE, @@ -466,6 +466,62 @@ Subset_LIGER <- function( } +#' Extract matrix of embeddings +#' +#' Extract matrix containing iNMF or dimensionality reduction embeddings. +#' +#' @param reduction name of dimensionality reduction to pull +#' @param iNMF logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings. +#' +#' @method Embeddings liger +#' @return matrix +#' +#' @concept object_conversion +#' +#' @import cli +#' @import Seurat +#' +#' @export +#' @rdname Embeddings +#' +#' @examples +#' \dontrun{ +#' # Extract embedding matrix for current dimensionality reduction +#' UMAP_coord <- Embeddings(object = liger_object) +#' +#' # Extract iNMF h.norm matrix +#' iNMF_mat <- Embeddings(object = liger_object, reduction = "iNMF") +#' } +#' + +Embeddings.liger <- function( + object, + reduction = NULL, + iNMF = FALSE, + ... +) { + # return iNMF h.norm + if (isTRUE(x = iNMF)) { + embeddings <- object@h.norm + return(embeddings) + } + + # check options + if (!is.null(x = reduction)) { + if (!reduction %in% c(names(x = object@dimReds))) { + cli_abort(message = "The reduction {.field {reduction}} was not found in object.") + } + } + + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) + + embeddings <- object@dimReds[[reduction]] + + # return embeddings + return(embeddings) +} + + #' Extract top loading genes for LIGER factor #' #' Extract vector to the top loading genes for specified LIGER iNMF factor From 716d5a2f131496f3f734fd8be29e00063c8477eb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:32:41 -0400 Subject: [PATCH 282/503] reexports --- R/Reexports.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/Reexports.R b/R/Reexports.R index ba4604d2d4..7fedb6dab9 100644 --- a/R/Reexports.R +++ b/R/Reexports.R @@ -25,3 +25,10 @@ SeuratObject::Cells #' #' SeuratObject::Features + +#' @importFrom SeuratObject Embeddings +#' @export +#' @note See \code{\link{Embeddings.liger}} for scCustomize extension of this generic to extract embeddings. +#' +#' +SeuratObject::Embeddings From b9196dd50a9a184fb4342825461850bef5183b7f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:32:56 -0400 Subject: [PATCH 283/503] Update docs --- NAMESPACE | 3 +++ man/Embeddings.Rd | 30 ++++++++++++++++++++++++++++++ man/WhichCells.Rd | 4 ++-- man/reexports.Rd | 5 ++++- 4 files changed, 39 insertions(+), 3 deletions(-) create mode 100644 man/Embeddings.Rd diff --git a/NAMESPACE b/NAMESPACE index 1ec9ea2fe1..78e4f640e4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(Add_Mito_Ribo,liger) S3method(Add_Top_Gene_Pct,Seurat) S3method(Add_Top_Gene_Pct,liger) S3method(Cells,liger) +S3method(Embeddings,liger) S3method(Features,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) @@ -61,6 +62,7 @@ export(DimPlot_LIGER) export(DimPlot_scCustom) export(DiscretePalette_scCustomize) export(DotPlot_scCustom) +export(Embeddings) export(Extract_Modality) export(Extract_Sample_Meta) export(Extract_Top_Markers) @@ -205,6 +207,7 @@ importFrom(Seurat,VizDimLoadings) importFrom(Seurat,VlnPlot) importFrom(SeuratObject,Cells) importFrom(SeuratObject,DefaultDimReduc) +importFrom(SeuratObject,Embeddings) importFrom(SeuratObject,Features) importFrom(SeuratObject,JoinLayers) importFrom(SeuratObject,LayerData) diff --git a/man/Embeddings.Rd b/man/Embeddings.Rd new file mode 100644 index 0000000000..d5a00bdb45 --- /dev/null +++ b/man/Embeddings.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{Embeddings.liger} +\alias{Embeddings.liger} +\title{Extract matrix of embeddings} +\usage{ +\method{Embeddings}{liger}(object, reduction = NULL, iNMF = FALSE, ...) +} +\arguments{ +\item{reduction}{name of dimensionality reduction to pull} + +\item{iNMF}{logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings.} +} +\value{ +matrix +} +\description{ +Extract matrix containing iNMF or dimensionality reduction embeddings. +} +\examples{ +\dontrun{ +# Extract embedding matrix for current dimensionality reduction +UMAP_coord <- Embeddings(object = liger_object) + +# Extract iNMF h.norm matrix +iNMF_mat <- Embeddings(object = liger_object, reduction = "iNMF") +} + +} +\concept{object_conversion} diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd index 1a17574d1e..d89c6e3f72 100644 --- a/man/WhichCells.Rd +++ b/man/WhichCells.Rd @@ -14,6 +14,8 @@ ) } \arguments{ +\item{object}{LIGER object name.} + \item{ident_col}{name of meta data column to use when subsetting cells by identity values. Default is NULL, which will use the objects default clustering as the \code{ident_col}.} @@ -22,8 +24,6 @@ to return list (1 entry per dataset with vector of cells) (default is FALSE; ret \item{invert}{logical, invert the selection of cells (default is FALSE).} -\item{liger_object}{LIGER object name.} - \item{idents}{identities to extract cell barcodes.} } \value{ diff --git a/man/reexports.Rd b/man/reexports.Rd index 84e140bb6f..8edbb048bd 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -7,6 +7,7 @@ \alias{WhichCells} \alias{Cells} \alias{Features} +\alias{Embeddings} \title{Objects exported from other packages} \note{ See \code{\link{as.Seurat.liger}} for scCustomize extension of this generic to converting Liger objects. @@ -16,6 +17,8 @@ See \code{\link{WhichCells.liger}} for scCustomize extension of this generic to See \code{\link{Cells.liger}} for scCustomize extension of this generic to extract cell barcodes. See \code{\link{Features.liger}} for scCustomize extension of this generic to extract dataset features. + +See \code{\link{Embeddings.liger}} for scCustomize extension of this generic to extract embeddings. } \keyword{internal} \description{ @@ -23,6 +26,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{Cells}}, \code{\link[SeuratObject:Cells]{Features}}, \code{\link[SeuratObject]{WhichCells}}} + \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{Cells}}, \code{\link[SeuratObject]{Embeddings}}, \code{\link[SeuratObject:Cells]{Features}}, \code{\link[SeuratObject]{WhichCells}}} }} From e13e9875418e434727f0f0afeec5ae85c8134b07 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:33:41 -0400 Subject: [PATCH 284/503] update docs --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index ab0c5f3aa7..9ce4450284 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,7 @@ - `Cells` to extract vector of all cells or list vectors of cells by dataset. - `Features` to extract vector of all features or list vectors of features by dataset. - `WhichCells` to extract vector or list of cells matching identity criteria. + - `Embeddings` to extract matrix containing dimensionality reduction embeddings or iNMF h.norm matrix. - *Updated functions to interact with both old and new style liger objects:* - `plotFactors_scCustom()` - `Fetch_Meta` From e7723e1a9e2e0b68b8c7744ad4c2d5e931923c8f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 08:33:57 -0400 Subject: [PATCH 285/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7fb5a37128..e044908d78 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9047 +Version: 2.1.2.9048 Date: 2024-04-24 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")), From 0ade7c968e3af26c0a41b84d8ac489254bd68053 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 10:27:01 -0400 Subject: [PATCH 286/503] update docs fix check warnings --- R/LIGER_Utilities.R | 5 ++++- man/Cells.Rd | 4 +++- man/Features.Rd | 2 ++ man/WhichCells.Rd | 6 ++++-- 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 726c78ea63..002b2a1d1d 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -31,6 +31,7 @@ Fetch_Meta.liger <- function( #' @param by_dataset logical, whether to return list with vector of features for each dataset in #' LIGER object or to return single vector of unique features across all datasets in object #' (default is FALSE; return vector of unique features) +#' @param ... Arguments passed to other methods #' #' @method Features liger #' @return vector or list depending on `by_dataset` parameter @@ -90,7 +91,8 @@ Features.liger <- function( #' @param x LIGER object name. #' @param by_dataset logical, whether to return list with vector of cell barcodes for each #' dataset in LIGER object or to return single vector of cell barcodes across all -#' datasets in object (default is FALSE; return vector of cells) +#' datasets in object (default is FALSE; return vector of cells). +#' @param ... Arguments passed to other methods #' #' @method Cells liger #' @return vector or list depending on `by_dataset` parameter @@ -155,6 +157,7 @@ Cells.liger <- function( #' @param by_dataset logical, whether to return vector with cell barcodes for all `idents` in or #' to return list (1 entry per dataset with vector of cells) (default is FALSE; return vector). #' @param invert logical, invert the selection of cells (default is FALSE). +#' @param ... Arguments passed to other methods #' #' @method WhichCells liger #' @return vector or list depending on `by_dataset` parameter diff --git a/man/Cells.Rd b/man/Cells.Rd index 38b839a896..8fcb32313c 100644 --- a/man/Cells.Rd +++ b/man/Cells.Rd @@ -11,7 +11,9 @@ \item{by_dataset}{logical, whether to return list with vector of cell barcodes for each dataset in LIGER object or to return single vector of cell barcodes across all -datasets in object (default is FALSE; return vector of cells)} +datasets in object (default is FALSE; return vector of cells).} + +\item{...}{Arguments passed to other methods} } \value{ vector or list depending on \code{by_dataset} parameter diff --git a/man/Features.Rd b/man/Features.Rd index 52eef599a1..f7fa5c32f8 100644 --- a/man/Features.Rd +++ b/man/Features.Rd @@ -12,6 +12,8 @@ \item{by_dataset}{logical, whether to return list with vector of features for each dataset in LIGER object or to return single vector of unique features across all datasets in object (default is FALSE; return vector of unique features)} + +\item{...}{Arguments passed to other methods} } \value{ vector or list depending on \code{by_dataset} parameter diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd index d89c6e3f72..e305150e9c 100644 --- a/man/WhichCells.Rd +++ b/man/WhichCells.Rd @@ -6,7 +6,7 @@ \usage{ \method{WhichCells}{liger}( object, - ident = NULL, + idents = NULL, ident_col = NULL, by_dataset = FALSE, invert = FALSE, @@ -16,6 +16,8 @@ \arguments{ \item{object}{LIGER object name.} +\item{idents}{identities to extract cell barcodes.} + \item{ident_col}{name of meta data column to use when subsetting cells by identity values. Default is NULL, which will use the objects default clustering as the \code{ident_col}.} @@ -24,7 +26,7 @@ to return list (1 entry per dataset with vector of cells) (default is FALSE; ret \item{invert}{logical, invert the selection of cells (default is FALSE).} -\item{idents}{identities to extract cell barcodes.} +\item{...}{Arguments passed to other methods} } \value{ vector or list depending on \code{by_dataset} parameter From b2640b42b9d6b8f6de3896ce9bb14c1000d011f8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 11:00:50 -0400 Subject: [PATCH 287/503] fix check errors --- R/LIGER_Utilities.R | 2 ++ man/Embeddings.Rd | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 002b2a1d1d..322bed9e1f 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -473,8 +473,10 @@ Subset_LIGER <- function( #' #' Extract matrix containing iNMF or dimensionality reduction embeddings. #' +#' @param object LIGER object name. #' @param reduction name of dimensionality reduction to pull #' @param iNMF logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings. +#' @param ... Arguments passed to other methods #' #' @method Embeddings liger #' @return matrix diff --git a/man/Embeddings.Rd b/man/Embeddings.Rd index d5a00bdb45..eaa386801d 100644 --- a/man/Embeddings.Rd +++ b/man/Embeddings.Rd @@ -7,9 +7,13 @@ \method{Embeddings}{liger}(object, reduction = NULL, iNMF = FALSE, ...) } \arguments{ +\item{object}{LIGER object name.} + \item{reduction}{name of dimensionality reduction to pull} \item{iNMF}{logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings.} + +\item{...}{Arguments passed to other methods} } \value{ matrix From 7b2c989edfd7d4e88ea46d54b7a74eddc7ea2fb9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 11:01:06 -0400 Subject: [PATCH 288/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e044908d78..2d6f8aee6b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9048 +Version: 2.1.2.9049 Date: 2024-04-24 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")), From 6461e407667badb38fb6d14ea84be54939a8aa9c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 13:32:45 -0400 Subject: [PATCH 289/503] fix leiden_cluster hard code --- R/LIGER_Internal_Utilities.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 572e8a2cde..6c331f8987 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -178,15 +178,19 @@ Generate_Plotting_df_LIGER2 <- function(object, if (isTRUE(x = reorder.idents)) { reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) } - c_names <- names(x = object@cellMeta$leiden_cluster) + + c_ident <- rliger::defaultCluster(x = object) + c_names <- names(x = object@cellMeta[["c_ident"]]) + + if (is.null(x = clusters)) { # if clusters have not been set yet - if (length(x = object@cellMeta$leiden_cluster) == 0) { + if (length(x = object@cellMeta[["c_ident"]]) == 0) { clusters <- rep(1, nrow(x = reduc_df)) names(x = clusters) <- c_names <- rownames(x = reduc_df) } else { - clusters <- object@cellMeta$leiden_cluster - c_names <- names(x = object@cellMeta$leiden_cluster) + clusters <- object@cellMeta[["c_ident"]] + c_names <- names(x = object@cellMeta[["c_ident"]]) } } reduc_df[['Cluster']] <- clusters[c_names] @@ -537,7 +541,7 @@ Plot_By_Cluster_LIGER2 <- function( colnames(x = centers) <- c("Cluster", x_axis_label, y_axis_label) - cluster_length <- length(x = unique(x = liger_object@cellMeta$leiden_cluster)) + cluster_length <- length(x = unique(x = liger_object@cellMeta[["c_ident"]])) if (is.null(x = colors_use)) { colors_use <- scCustomize_Palette(num_groups = cluster_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) From 795e8e9a6b8ca7b2c8aa87d2a30f8161ec222c17 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 13:54:22 -0400 Subject: [PATCH 290/503] try fix idents --- R/LIGER_Internal_Utilities.R | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 6c331f8987..06c6b6a33d 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -178,19 +178,16 @@ Generate_Plotting_df_LIGER2 <- function(object, if (isTRUE(x = reorder.idents)) { reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) } - - c_ident <- rliger::defaultCluster(x = object) - c_names <- names(x = object@cellMeta[["c_ident"]]) - - + cluster_col <- LIGER_Default_Cluster(liger_object = object) + c_names <- names(x = object@cellMeta[[cluster_col]]) if (is.null(x = clusters)) { # if clusters have not been set yet - if (length(x = object@cellMeta[["c_ident"]]) == 0) { + if (length(x = object@cellMeta[[cluster_col]]) == 0) { clusters <- rep(1, nrow(x = reduc_df)) names(x = clusters) <- c_names <- rownames(x = reduc_df) } else { - clusters <- object@cellMeta[["c_ident"]] - c_names <- names(x = object@cellMeta[["c_ident"]]) + clusters <- object@cellMeta[[cluster_col]] + c_names <- names(x = object@cellMeta[[cluster_col]]) } } reduc_df[['Cluster']] <- clusters[c_names] @@ -541,7 +538,7 @@ Plot_By_Cluster_LIGER2 <- function( colnames(x = centers) <- c("Cluster", x_axis_label, y_axis_label) - cluster_length <- length(x = unique(x = liger_object@cellMeta[["c_ident"]])) + cluster_length <- length(x = unique(x = liger_object@cellMeta$leiden_cluster)) if (is.null(x = colors_use)) { colors_use <- scCustomize_Palette(num_groups = cluster_length, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed) From b75f22e84c3e515835b6c2faf0abf3961afe027b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:29:23 -0400 Subject: [PATCH 291/503] Rename_Clusters to S3 generic --- R/Generics.R | 21 +++++++++ R/LIGER_Utilities.R | 108 ++++++++++++++++++++++++++++++++++++++++++++ R/Utilities.R | 23 ++++------ 3 files changed, 138 insertions(+), 14 deletions(-) diff --git a/R/Generics.R b/R/Generics.R index dd11395907..5d5fc7ea74 100644 --- a/R/Generics.R +++ b/R/Generics.R @@ -151,3 +151,24 @@ Add_Cell_QC_Metrics <- function(object, ...) { Fetch_Meta <- function(object, ...) { UseMethod(generic = 'Fetch_Meta', object = object) } + + +#' Rename Clusters +#' +#' Wrapper function to rename active cluster identity in Seurat or Liger Object with new idents. +#' +#' @param object Object of class Seurat or liger. +#' @param ... Arguments passed to other methods +#' +#' @return An object of the same class as `object` with updated default identities. +#' +#' @export +#' +#' @concept get_set_util +#' +#' @rdname Rename_Clusters +#' + +Rename_Clusters <- function(object, ...) { + UseMethod(generic = 'Rename_Clusters', object = object) +} diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 322bed9e1f..f381ba5191 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -342,6 +342,114 @@ LIGER_Cells_by_Identities <- function( } +#' @param new_idents vector of new cluster names. Must be equal to the length of current default identity +#' of Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally. +#' @param meta_col_name `r lifecycle::badge("soft-deprecated")`. See `old_ident_name`. +#' @param old_ident_name optional, name to use for storing current object idents in object meta data slot. +#' @param new_ident_name optional, name to use for storing new object idents in object meta data slot. +#' @param overwrite logical, whether to overwrite columns in object meta data slot. if they have same +#' names as `old_ident_name` and/or `new_ident_name`. +#' +#' @method Rename_Clusters liger +#' +#' @import cli +#' @importFrom dplyr right_join +#' @importFrom tibble rownames_to_column column_to_rownames +#' +#' @rdname Rename_Clusters +#' @export +#' +#' @concept marker_annotation_util +#' +#' @examples +#' \dontrun{ +#' # Liger version +#' obj <- Rename_Clusters(object = obj_name, new_idents = new_idents_vec, +#' old_ident_name = "LIGER_Idents_Round01", new_ident_name = "LIGER_Idents_Round02") +#' } +#' + +Rename_Clusters.liger <- function( + object, + new_idents, + old_ident_name = NULL, + new_ident_name = NULL, + overwrite = FALSE, + ... +) { + # Check Seurat + Is_LIGER(liger_object = object) + + # check old ident name + if (!is.null(x = old_ident_name)) { + if (old_ident_name %in% colnames(x = object@cellMeta)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("The {.code old_ident_name}: {.field {old_ident_name}} is already a column in meta data", + "i" = "To overwrite current meta data column set {.code overwrite = TRUE}.")) + } else { + cli_inform(message = "Overwriting old meta data column: {.field {old_ident_name}} as {.code overwrite = TRUE}") + + } + } else { + object@cellMeta[[old_ident_name]] <- rliger::defaultCluster(x = object) + } + } + + # check new ident name + if (!is.null(x = new_ident_name) && new_ident_name %in% colnames(x = object@cellMeta)) { + if (isFALSE(x = overwrite)) { + cli_abort(message = c("The {.code new_ident_name}: {.field {new_ident_name}} is already a column in meta data", + "i" = "To overwrite current meta data column set {.code overwrite = TRUE}.")) + } else { + cli_inform(message = "Overwriting new meta data column: {.field {new_ident_name}} as {.code overwrite = TRUE}") + } + } + + # Check equivalent lengths + if (length(x = new_idents) != length(x = levels(x = rliger::defaultCluster(x = object)))) { + cli_abort(message = c("Length of {.code new_idents} must be equal to the number of clusters in Liger Object.", + "i" = "{.code new_idents} length: {.field {length(x = new_idents)}} object 'defaultCluster' length: {.field {length(x = levels(x = rliger::defaultCluster(x = object)))}}.") + ) + } + + # Name the new idents vector + if (is.null(x = names(x = new_idents))) { + names(x = new_idents) <- levels(x = rliger::defaultCluster(x = object)) + } + + # If named check that names are right length + if (!is.null(x = names(x = new_idents)) && length(x = unique(x = names(x = new_idents))) != length(x = levels(x = rliger::defaultCluster(x = object)))) { + cli_abort(message = c("The number of unique names for {.code new idents} is not equal to number of clusters.", + "i" = "names(new_idents) length: {.field {length(x = unique(x = names(x = new_idents)))} object 'defaultCluster' length: {length(x = levels(x = defaultCluster(x = object)))}}.") + ) + } + + # Add new idents + ident_df <- data.frame(rliger::defaultCluster(x = object)) + colnames(x = ident_df) <- "current_idents" + ident_df <- ident_df %>% + rownames_to_column("barcodes") + + new_idents_df <- data.frame("current_idents" = names(x = new_idents), + "new_idents" = new_idents) + + new_idents_meta <- suppressMessages(right_join(x = ident_df, y = new_idents_df)) %>% + column_to_rownames("barcodes") + + suppressMessages(rliger::defaultCluster(x = object) <- new_idents_meta$new_idents) + cli_inform(message = c("v" = "{.code defaultCluster} updated and stored as: {.val defaultCluster} in object cellMeta slot.")) + + # Add new ident to meta.data information if desired + if (!is.null(x = new_ident_name)) { + object@cellMeta[[new_ident_name]] <- rliger::defaultCluster(x = object) + cli_inform(message = c("i" = "{.code new_idents} also stored as: {.val new_ident_name} in object cellMeta slot.")) + } + + # return object + return(object) +} + + #' Subset LIGER object #' #' Subset LIGER object by cluster or other meta data variable. diff --git a/R/Utilities.R b/R/Utilities.R index c335bbffb7..6ffd552a9f 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1673,25 +1673,20 @@ Pull_Cluster_Annotation <- function( } -#' Rename Cluster Seurat -#' -#' Wrapper function to rename active identities in Seurat Object with new idents. -#' -#' @param seurat_object object name. -#' @param new_idents vector of new cluster names. Must be equal to the length of current active.ident -#' in Seurat Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally. +#' @param new_idents vector of new cluster names. Must be equal to the length of current default identity +#' of Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally. #' @param meta_col_name `r lifecycle::badge("soft-deprecated")`. See `old_ident_name`. -#' @param old_ident_name optional, name to use for storing current object idents in `Object@meta.data`. -#' @param new_ident_name optional, name to use for storing new object idents in `@meta.data`. -#' @param overwrite logical, whether to overwrite columns in `@meta.data` if they have same +#' @param old_ident_name optional, name to use for storing current object idents in object meta data slot. +#' @param new_ident_name optional, name to use for storing new object idents in object meta data slot. +#' @param overwrite logical, whether to overwrite columns in object meta data slot. if they have same #' names as `old_ident_name` and/or `new_ident_name`. -#' @param ... Extra parameters passed to \code{\link[SeuratObject]{RenameIdents}}. #' -#' @return Seurat Object with new identities placed in active.ident slot. +#' @method Rename_Clusters Seurat #' #' @import cli #' @importFrom lifecycle deprecated #' +#' @rdname Rename_Clusters #' @export #' #' @concept marker_annotation_util @@ -1703,8 +1698,8 @@ Pull_Cluster_Annotation <- function( #' } #' -Rename_Clusters <- function( - seurat_object, +Rename_Clusters.Seurat <- function( + object, new_idents, old_ident_name = NULL, new_ident_name = NULL, From 9fdec6bd43775615200bdd6e9b1e094aab477103 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:29:37 -0400 Subject: [PATCH 292/503] update docs --- NAMESPACE | 3 +++ man/Rename_Clusters.Rd | 48 ++++++++++++++++++++++++++++++------------ 2 files changed, 37 insertions(+), 14 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 78e4f640e4..c7711006d8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,8 @@ S3method(Embeddings,liger) S3method(Features,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) +S3method(Rename_Clusters,Seurat) +S3method(Rename_Clusters,liger) S3method(WhichCells,liger) S3method(as.LIGER,Seurat) S3method(as.LIGER,list) @@ -234,6 +236,7 @@ importFrom(dplyr,mutate) importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,rename) +importFrom(dplyr,right_join) importFrom(dplyr,select) importFrom(dplyr,setdiff) importFrom(dplyr,slice) diff --git a/man/Rename_Clusters.Rd b/man/Rename_Clusters.Rd index 0dd181f445..52c2ebc716 100644 --- a/man/Rename_Clusters.Rd +++ b/man/Rename_Clusters.Rd @@ -1,11 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Utilities.R +% Please edit documentation in R/Generics.R, R/LIGER_Utilities.R, R/Utilities.R \name{Rename_Clusters} \alias{Rename_Clusters} -\title{Rename Cluster Seurat} +\alias{Rename_Clusters.liger} +\alias{Rename_Clusters.Seurat} +\title{Rename Clusters} \usage{ -Rename_Clusters( - seurat_object, +Rename_Clusters(object, ...) + +\method{Rename_Clusters}{liger}( + object, + new_idents, + old_ident_name = NULL, + new_ident_name = NULL, + overwrite = FALSE, + ... +) + +\method{Rename_Clusters}{Seurat}( + object, new_idents, old_ident_name = NULL, new_ident_name = NULL, @@ -15,33 +28,40 @@ Rename_Clusters( ) } \arguments{ -\item{seurat_object}{object name.} +\item{object}{Object of class Seurat or liger.} -\item{new_idents}{vector of new cluster names. Must be equal to the length of current active.ident -in Seurat Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally.} +\item{...}{Arguments passed to other methods} -\item{old_ident_name}{optional, name to use for storing current object idents in \code{Object@meta.data}.} +\item{new_idents}{vector of new cluster names. Must be equal to the length of current default identity +of Object. Will accept named vector (with old idents as names) or will name the new_idents vector internally.} -\item{new_ident_name}{optional, name to use for storing new object idents in \verb{@meta.data}.} +\item{old_ident_name}{optional, name to use for storing current object idents in object meta data slot.} -\item{meta_col_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#soft-deprecated}{\figure{lifecycle-soft-deprecated.svg}{options: alt='[Soft-deprecated]'}}}{\strong{[Soft-deprecated]}}. See \code{old_ident_name}.} +\item{new_ident_name}{optional, name to use for storing new object idents in object meta data slot.} -\item{overwrite}{logical, whether to overwrite columns in \verb{@meta.data} if they have same +\item{overwrite}{logical, whether to overwrite columns in object meta data slot. if they have same names as \code{old_ident_name} and/or \code{new_ident_name}.} -\item{...}{Extra parameters passed to \code{\link[SeuratObject]{RenameIdents}}.} +\item{meta_col_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#soft-deprecated}{\figure{lifecycle-soft-deprecated.svg}{options: alt='[Soft-deprecated]'}}}{\strong{[Soft-deprecated]}}. See \code{old_ident_name}.} } \value{ -Seurat Object with new identities placed in active.ident slot. +An object of the same class as \code{object} with updated default identities. } \description{ -Wrapper function to rename active identities in Seurat Object with new idents. +Wrapper function to rename active cluster identity in Seurat or Liger Object with new idents. } \examples{ +\dontrun{ +# Liger version +obj <- Rename_Clusters(object = obj_name, new_idents = new_idents_vec, +old_ident_name = "LIGER_Idents_Round01", new_ident_name = "LIGER_Idents_Round02") +} + \dontrun{ obj <- Rename_Clusters(seurat_object = obj_name, new_idents = new_idents_vec, old_ident_name = "Seurat_Idents_Round01", new_ident_name = "Round01_Res0.6_Idents") } } +\concept{get_set_util} \concept{marker_annotation_util} From 5d75ea552324c0e90b965386d46979877e6577ed Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:34:44 -0400 Subject: [PATCH 293/503] remove temp warning --- R/LIGER_Utilities.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index f381ba5191..ca094c95af 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1249,12 +1249,6 @@ Add_Cell_Complexity.liger <- function( overwrite = FALSE, ... ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # Check liger Is_LIGER(liger_object = object) From dd9d61e346abbc73b03b95477c1cb49239dd363f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:40:50 -0400 Subject: [PATCH 294/503] Update rliger version checks and warnings --- R/LIGER_Internal_Utilities.R | 12 --------- R/LIGER_Utilities.R | 49 ++++++++++++++++++++++-------------- 2 files changed, 30 insertions(+), 31 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 06c6b6a33d..e8cc84245d 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -114,12 +114,6 @@ Generate_Plotting_df_LIGER <- function(object, group_by = "dataset", split_by = NULL ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - tsne_df <- data.frame(object@tsne.coords) colnames(x = tsne_df) <- c("tsne1", "tsne2") tsne_df[[group_by]] <- object@cell.data[[group_by]] @@ -1719,12 +1713,6 @@ LIGER_DimPlot <- function( ggplot_default_colors = FALSE, color_seed = 123 ) { - # temp liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) - } - # Check LIGER Is_LIGER(liger_object = liger_object) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index ca094c95af..597bfbf62f 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -58,9 +58,6 @@ Features.liger <- function( by_dataset = FALSE, ... ) { - # check liger - Is_LIGER(liger_object = x) - # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { # Extract features @@ -119,9 +116,6 @@ Cells.liger <- function( by_dataset = FALSE, ... ) { - # check liger - Is_LIGER(liger_object = x) - # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { # Extract features @@ -287,6 +281,9 @@ LIGER_Cells_by_Identities <- function( group.by = NULL, by_dataset = FALSE ) { + # check liger + Is_LIGER(liger_object = liger_object) + # Check new liger object if (packageVersion(pkg = 'rliger') < "2.0.0") { cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") @@ -377,8 +374,10 @@ Rename_Clusters.liger <- function( overwrite = FALSE, ... ) { - # Check Seurat - Is_LIGER(liger_object = object) + # Check new liger object + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") + } # check old ident name if (!is.null(x = old_ident_name)) { @@ -439,7 +438,7 @@ Rename_Clusters.liger <- function( suppressMessages(rliger::defaultCluster(x = object) <- new_idents_meta$new_idents) cli_inform(message = c("v" = "{.code defaultCluster} updated and stored as: {.val defaultCluster} in object cellMeta slot.")) - # Add new ident to meta.data information if desired + # Add new ident to cellMeta information if desired if (!is.null(x = new_ident_name)) { object@cellMeta[[new_ident_name]] <- rliger::defaultCluster(x = object) cli_inform(message = c("i" = "{.code new_idents} also stored as: {.val new_ident_name} in object cellMeta slot.")) @@ -498,9 +497,12 @@ Subset_LIGER <- function( ident_col = NULL, invert = FALSE ) { + # check liger + Is_LIGER(liger_object = liger_object) + # Check new liger object - if (!"cellMeta" %in% slotNames(liger_object)) { - cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") } # Check value provided @@ -613,6 +615,11 @@ Embeddings.liger <- function( iNMF = FALSE, ... ) { + # Check new liger object + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") + } + # return iNMF h.norm if (isTRUE(x = iNMF)) { embeddings <- object@h.norm @@ -673,7 +680,7 @@ Top_Genes_Factor <- function( ) } - # temp liger version check + # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { W <- liger_object@W rownames(x = W) <- rownames(x = liger_object@datasets[[1]]@scaleData) @@ -727,9 +734,12 @@ LIGER_DimReduc <- function( reduction = NULL, check_only = FALSE ) { + # check liger + Is_LIGER(liger_object = liger_object) + # Check new liger object - if (!"cellMeta" %in% slotNames(liger_object)) { - cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") } # reduction to use @@ -774,11 +784,12 @@ LIGER_DimReduc <- function( Find_Factor_Cor <- function( liger_object ) { + # check liger Is_LIGER(liger_object = liger_object) # Check new liger object - if (!"cellMeta" %in% slotNames(liger_object)) { - cli_abort(message = "This function is only for objects created with rliger >= v2.0.0") + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") } # Get loadings @@ -1620,12 +1631,12 @@ Variable_Features_ALL_LIGER <- function( pt.size = 0.3, chunk=1000 ) { - # temp liger version check + # liger version check if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Liger functionality is currently restricted to rliger v1.0.1 or lower.", - "i" = "Functionality with rliger v2+ is currently in development.")) + cli_abort(message = c("Functionality is currently restricted to rliger v1.0.1 or lower.")) } + # check liger Is_LIGER(liger_object = liger_object) raw_data <- liger_object@raw.data From 72ef91f5f2507e0f7252da025e537dd3aba14f01 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:43:02 -0400 Subject: [PATCH 295/503] update changelog --- NEWS.md | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9ce4450284..a6dffb9fba 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,8 +17,11 @@ - `Add_Mito_Ribo` - `Add_Cell_Complexity` - `DimPlot_LIGER` -- *New functions compatible with old and new style liger objects:* -- Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. +- *Updated functions compatible with old and new style liger objects:* + - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. +- *New generics to function across both Seurat and Liger objects* + - `Add_Hemo` (see above). + - `Rename_Clusters` now S3 generic for setting new active.ident (Seurat) or defaultCluster (Liger). - *New functions for rliger v2.0.0+ only:* - Added new function `Find_Factor_Cor` to return correlation matrix between factor gene loadings from liger object. - Added new function `Factor_Cor_Plot` to plot positive correlations from liger object. From 34fd2e914837ac66c1a4d5f7e9ea90d6a5b5b56f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 14:43:21 -0400 Subject: [PATCH 296/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2d6f8aee6b..3204a6c365 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9049 +Version: 2.1.2.9050 Date: 2024-04-24 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")), From 3e4eea0ee79e93fef95b885d647cae23c632d714 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 17:06:17 -0400 Subject: [PATCH 297/503] fix WhichCells.liger errors --- R/LIGER_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 597bfbf62f..45af89d39c 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -196,7 +196,7 @@ WhichCells.liger <- function( select(all_of(c(ident_col, "dataset"))) # possible idents - if (inherits(x = cell_df[[idents]], what = "factor")) { + if (inherits(x = cell_df[[ident_col]], what = "factor")) { ident_levels <- levels(x = cell_df[[ident_col]]) } else { ident_levels <- unique(x = cell_df[[ident_col]]) @@ -208,7 +208,7 @@ WhichCells.liger <- function( if (length(x = valid_idents) == 0) { cli_abort(message = "None of the provided {.code idents} were found in object.") } - if (length(x = valid_idents) != idents) { + if (length(x = valid_idents) != length(x = idents)) { missing_idents <- setdiff(x = idents, y = valid_idents) cli_warn(message = c("The following {.code idents} were not found and therefore ignored:", "i" = "{.field {missing_idents}}")) From c646e7b6e5131c0dd45ed057b78ba8c31f767c9d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 24 Apr 2024 19:19:56 -0400 Subject: [PATCH 298/503] update changelog --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index a6dffb9fba..0c49778606 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `Subset_LIGER` to quickly subset by cluster or other meta data variable. - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. -- *Extended the following Seurat/SeuratObject functions to work seamlessly with liger objects:* +- *Extended the following Seurat/SeuratObject generic functions to work seamlessly with liger objects:* - `Cells` to extract vector of all cells or list vectors of cells by dataset. - `Features` to extract vector of all features or list vectors of features by dataset. - `WhichCells` to extract vector or list of cells matching identity criteria. @@ -19,7 +19,7 @@ - `DimPlot_LIGER` - *Updated functions compatible with old and new style liger objects:* - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. -- *New generics to function across both Seurat and Liger objects* +- *New scCustomize generics to function across both Seurat and Liger objects* - `Add_Hemo` (see above). - `Rename_Clusters` now S3 generic for setting new active.ident (Seurat) or defaultCluster (Liger). - *New functions for rliger v2.0.0+ only:* From 107bcade639d89a2e67660c036d8c4c3b032aa8d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 07:33:25 -0400 Subject: [PATCH 299/503] Update StoreMisc to use Seurat accessor/setter function Misc() --- R/Object_Utilities.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index d361fcfd55..70a68de498 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -1441,7 +1441,8 @@ Store_Misc_Info_Seurat <- function( } # Add data - seurat_object@misc[[data_name]] <- data_to_store + Misc(object = seurat_object, slot = data_name) <- data_to_store + # seurat_object@misc[[data_name]] <- data_to_store cli_inform(message = c("Seurat Object now contains the following items in @misc slot: ", "i" = "{.field {paste(shQuote(names(x = seurat_object@misc)), collapse=", ")}}") ) @@ -1457,7 +1458,8 @@ Store_Misc_Info_Seurat <- function( # Add data for (i in 1:data_list_length) { - seurat_object@misc[[data_name[i]]] <- data_to_store[[i]] + Misc(object = seurat_object, slot = data_name[[i]]) <- data_to_store[[i]] + # seurat_object@misc[[data_name[i]]] <- data_to_store[[i]] } cli_inform(message = c("Seurat Object now contains the following items in @misc slot: ", "i" = "{.field {paste(shQuote(names(x = seurat_object@misc)), collapse=", ")}}") @@ -1470,7 +1472,8 @@ Store_Misc_Info_Seurat <- function( } # Add data - seurat_object@misc[[data_name]] <- data_to_store + Misc(object = seurat_object, slot = data_name) <- data_to_store + # seurat_object@misc[[data_name]] <- data_to_store misc_names <- shQuote(string = names(x = seurat_object@misc)) cli_inform(message = c("Seurat Object now contains the following items in @misc slot: ", "i" = "{.field {glue_collapse_scCustom(input_string = misc_names, and = TRUE)}}") From 080bd599db0307447afbfceca192a4d48ab915e5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 07:34:57 -0400 Subject: [PATCH 300/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 0c49778606..aa51bb0686 100644 --- a/NEWS.md +++ b/NEWS.md @@ -49,6 +49,7 @@ - Added error check in `as.anndata` to explicitly check for installation of anndata before starting conversion ([#162](https://github.com/samuel-marsh/scCustomize/issues/162)). - Update `RenameClusters` to enable storgae of both old idents and new idents in meta.data within the function. - Updated `Plot_Median_Genes`, `Plot_Median_UMIs`, `Plot_Median_Mito`, `Plot_Median_Other`, `Plot_Cells_per_Sample` to understand "ident" as grouping variable. +- Updated `Store_Misc_Info_Seurat` to use Seurat accessor/setter function `Seurat::Misc()`. ## Fixes From f9e2b2235f5bf9ea24b904f19c4423ddfd0a99d3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 07:35:15 -0400 Subject: [PATCH 301/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3204a6c365..eee7eb2495 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" RRID:SCR_024675. -Version: 2.1.2.9050 -Date: 2024-04-24 +Version: 2.1.2.9051 +Date: 2024-04-25 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"), From 0f4eb69c8fed03847eb8a9effe2bf76c6b1e4c5a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 10:35:12 -0400 Subject: [PATCH 302/503] fix changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index aa51bb0686..1160c7de56 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,7 +17,7 @@ - `Add_Mito_Ribo` - `Add_Cell_Complexity` - `DimPlot_LIGER` -- *Updated functions compatible with old and new style liger objects:* +- *New functions compatible with old and new style liger objects:* - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. - *New scCustomize generics to function across both Seurat and Liger objects* - `Add_Hemo` (see above). From 1e32ce2139b0cfb310d438b0d6eb961c95eb2cba Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 10:42:33 -0400 Subject: [PATCH 303/503] Fix Seurat Rename_Clusters --- R/Utilities.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index 6ffd552a9f..f62eace279 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1718,11 +1718,11 @@ Rename_Clusters.Seurat <- function( } # Check Seurat - Is_Seurat(seurat_object = seurat_object) + Is_Seurat(seurat_object = object) # check old ident name if (!is.null(x = old_ident_name)) { - if (old_ident_name %in% colnames(x = seurat_object@meta.data)) { + if (old_ident_name %in% colnames(x = object@meta.data)) { if (isFALSE(x = overwrite)) { cli_abort(message = c("The {.code old_ident_name}: {.field {old_ident_name}} is already a column in meta.data", "i" = "To overwrite current meta.data column set {.code overwrite = TRUE}.")) @@ -1731,12 +1731,12 @@ Rename_Clusters.Seurat <- function( } } else { - seurat_object[[old_ident_name]] <- Idents(object = seurat_object) + object[[old_ident_name]] <- Idents(object = object) } } # check new ident name - if (!is.null(x = new_ident_name) && new_ident_name %in% colnames(x = seurat_object@meta.data)) { + if (!is.null(x = new_ident_name) && new_ident_name %in% colnames(x = object@meta.data)) { if (isFALSE(x = overwrite)) { cli_abort(message = c("The {.code new_ident_name}: {.field {new_ident_name}} is already a column in meta.data", "i" = "To overwrite current meta.data column set {.code overwrite = TRUE}.")) @@ -1746,34 +1746,34 @@ Rename_Clusters.Seurat <- function( } # Check equivalent lengths - if (length(x = new_idents) != length(x = levels(x = seurat_object))) { + if (length(x = new_idents) != length(x = levels(x = 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(x = levels(x = seurat_object))}}.") + "i" = "{.code new_idents} length: {.field {length(x = new_idents)}} Object@active.idents length: {.field {length(x = levels(x = object))}}.") ) } # Name the new idents vector if (is.null(x = names(x = new_idents))) { - names(x = new_idents) <- levels(x = seurat_object) + names(x = new_idents) <- levels(x = object) } # If named check that names are right length - if (!is.null(x = names(x = new_idents)) && length(x = unique(x = names(x = new_idents))) != length(x = levels(x = seurat_object))) { + if (!is.null(x = names(x = new_idents)) && length(x = unique(x = names(x = new_idents))) != length(x = levels(x = 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(x = 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 = object))}}.") ) } # Add new idents - seurat_object <- RenameIdents(object = seurat_object, new_idents) + object <- RenameIdents(object = object, new_idents) # Add new ident to meta.data information if desired if (!is.null(x = new_ident_name)) { - seurat_object[[new_ident_name]] <- Idents(object = seurat_object) + object[[new_ident_name]] <- Idents(object = object) } # return object - return(seurat_object) + return(object) } From e3b7c53ebba42a9be8a8c7d38fb82204e252128c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 10:43:00 -0400 Subject: [PATCH 304/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index eee7eb2495..cc059a1ff0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9051 +Version: 2.1.2.9052 Date: 2024-04-25 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")), From 7c210664630157a09d528459211ea44a93239e2a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 13:21:11 -0400 Subject: [PATCH 305/503] reorg script --- R/LIGER_Utilities.R | 173 +++++++++++++++++++++++--------------------- 1 file changed, 89 insertions(+), 84 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 45af89d39c..5f55a1e7b6 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1,27 +1,7 @@ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#################### DATA ACCESS #################### +#################### EXTENDED SEURAT GENERICS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -#' @rdname Fetch_Meta -#' @importFrom methods slot -#' @export -#' @concept liger_object_util -#' @method Fetch_Meta liger - -Fetch_Meta.liger <- function( - object, - ... -) { - if (packageVersion(pkg = 'rliger') > "1.0.1") { - object_meta <- rliger::cellMeta(x = object, as.data.frame = TRUE) - } else { - object_meta <- object_meta <- slot(object = object, name = "cell.data") - } - - # return meta - return(object_meta) -} - #' Extract Features from LIGER Object #' @@ -244,6 +224,94 @@ WhichCells.liger <- function( } +#' Extract matrix of embeddings +#' +#' Extract matrix containing iNMF or dimensionality reduction embeddings. +#' +#' @param object LIGER object name. +#' @param reduction name of dimensionality reduction to pull +#' @param iNMF logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings. +#' @param ... Arguments passed to other methods +#' +#' @method Embeddings liger +#' @return matrix +#' +#' @concept object_conversion +#' +#' @import cli +#' @import Seurat +#' +#' @export +#' @rdname Embeddings +#' +#' @examples +#' \dontrun{ +#' # Extract embedding matrix for current dimensionality reduction +#' UMAP_coord <- Embeddings(object = liger_object) +#' +#' # Extract iNMF h.norm matrix +#' iNMF_mat <- Embeddings(object = liger_object, reduction = "iNMF") +#' } +#' + +Embeddings.liger <- function( + object, + reduction = NULL, + iNMF = FALSE, + ... +) { + # Check new liger object + if (packageVersion(pkg = 'rliger') < "2.0.0") { + cli_abort(message = "This function is only for objects with rliger >= v2.0.0") + } + + # return iNMF h.norm + if (isTRUE(x = iNMF)) { + embeddings <- object@h.norm + return(embeddings) + } + + # check options + if (!is.null(x = reduction)) { + if (!reduction %in% c(names(x = object@dimReds))) { + cli_abort(message = "The reduction {.field {reduction}} was not found in object.") + } + } + + reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) + + embeddings <- object@dimReds[[reduction]] + + # return embeddings + return(embeddings) +} + + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +#################### DATA ACCESS #################### +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +#' @rdname Fetch_Meta +#' @importFrom methods slot +#' @export +#' @concept liger_object_util +#' @method Fetch_Meta liger + +Fetch_Meta.liger <- function( + object, + ... +) { + if (packageVersion(pkg = 'rliger') > "1.0.1") { + object_meta <- rliger::cellMeta(x = object, as.data.frame = TRUE) + } else { + object_meta <- object_meta <- slot(object = object, name = "cell.data") + } + + # return meta + return(object_meta) +} + + #' Extract Cells by identity #' #' Extract all cell barcodes by identity from LIGER object @@ -579,69 +647,6 @@ Subset_LIGER <- function( } -#' Extract matrix of embeddings -#' -#' Extract matrix containing iNMF or dimensionality reduction embeddings. -#' -#' @param object LIGER object name. -#' @param reduction name of dimensionality reduction to pull -#' @param iNMF logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings. -#' @param ... Arguments passed to other methods -#' -#' @method Embeddings liger -#' @return matrix -#' -#' @concept object_conversion -#' -#' @import cli -#' @import Seurat -#' -#' @export -#' @rdname Embeddings -#' -#' @examples -#' \dontrun{ -#' # Extract embedding matrix for current dimensionality reduction -#' UMAP_coord <- Embeddings(object = liger_object) -#' -#' # Extract iNMF h.norm matrix -#' iNMF_mat <- Embeddings(object = liger_object, reduction = "iNMF") -#' } -#' - -Embeddings.liger <- function( - object, - reduction = NULL, - iNMF = FALSE, - ... -) { - # Check new liger object - if (packageVersion(pkg = 'rliger') < "2.0.0") { - cli_abort(message = "This function is only for objects with rliger >= v2.0.0") - } - - # return iNMF h.norm - if (isTRUE(x = iNMF)) { - embeddings <- object@h.norm - return(embeddings) - } - - # check options - if (!is.null(x = reduction)) { - if (!reduction %in% c(names(x = object@dimReds))) { - cli_abort(message = "The reduction {.field {reduction}} was not found in object.") - } - } - - reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) - - embeddings <- object@dimReds[[reduction]] - - # return embeddings - return(embeddings) -} - - #' Extract top loading genes for LIGER factor #' #' Extract vector to the top loading genes for specified LIGER iNMF factor From 9e62bfd8eeea3e24eebe4a5dc49879fa75e0de2c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 13:31:00 -0400 Subject: [PATCH 306/503] Embeddings supersedes liger_DimReduc --- R/LIGER_Internal_Utilities.R | 8 ++-- R/LIGER_Utilities.R | 90 ++++++------------------------------ 2 files changed, 19 insertions(+), 79 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index e8cc84245d..ff2d00c532 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -158,12 +158,12 @@ Generate_Plotting_df_LIGER2 <- function(object, ) { # Set reduction if null if (!is.null(x = reduction)) { - LIGER_DimReduc(liger_object = object, reduction = reduction, check_only = TRUE) + Embeddings(object = object, reduction = reduction, check_only = TRUE) } else { reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) } - reduc_df <- data.frame(LIGER_DimReduc(liger_object = object, reduction = reduction)) + reduc_df <- data.frame(Embeddings(object = object, reduction = reduction)) reduc_df[[group_by]] <- object@cellMeta[[group_by]] if (!is.null(x = split_by)) { reduc_df[[split_by]] <- object@cellMeta[[split_by]] @@ -1150,7 +1150,7 @@ plotFactors_liger2_scCustom <- function( }) H_raw = do.call(rbind, H_raw_list) # Create accurate axis labels - reduc_check <- LIGER_DimReduc(liger_object = liger_object, reduction = reduction, check_only = TRUE) + reduc_check <- Embeddings(object = liger_object, reduction = reduction, check_only = TRUE) x_axis_label <- paste0(reduction, "_1") y_axis_label <- paste0(reduction, "_2") @@ -1243,7 +1243,7 @@ plotFactors_liger2_scCustom <- function( # plot tSNE/UMAP if (isTRUE(x = plot_dimreduc)) { - tsne_df <- data.frame(Hs_norm[, i], LIGER_DimReduc(liger_object = liger_object, reduction = reduction)) + tsne_df <- data.frame(Hs_norm[, i], Embeddings(object = liger_object, reduction = reduction)) factorlab <- paste0("Factor", i) colnames(x = tsne_df) <- c(factorlab, x_axis_label, y_axis_label) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 5f55a1e7b6..d171bfd573 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -136,7 +136,7 @@ Cells.liger <- function( #' @method WhichCells liger #' @return vector or list depending on `by_dataset` parameter #' -#' @concept object_conversion +#' @concept liger_object_util #' #' @import cli #' @import Seurat @@ -231,12 +231,13 @@ WhichCells.liger <- function( #' @param object LIGER object name. #' @param reduction name of dimensionality reduction to pull #' @param iNMF logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings. +#' @param check_only logical, return `TRUE` if valid reduction is present. #' @param ... Arguments passed to other methods #' #' @method Embeddings liger #' @return matrix #' -#' @concept object_conversion +#' @concept liger_object_util #' #' @import cli #' @import Seurat @@ -258,6 +259,7 @@ Embeddings.liger <- function( object, reduction = NULL, iNMF = FALSE, + check_only = FALSE, ... ) { # Check new liger object @@ -271,16 +273,19 @@ Embeddings.liger <- function( return(embeddings) } - # check options - if (!is.null(x = reduction)) { - if (!reduction %in% c(names(x = object@dimReds))) { - cli_abort(message = "The reduction {.field {reduction}} was not found in object.") - } - } - + # set reduction if not supplied reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) - embeddings <- object@dimReds[[reduction]] + # check reduction in cellMeta + if (reduction %in% names(x = rliger::dimReds(x = liger_object))) { + if (isTRUE(x = check_only)) { + return(TRUE) + } + # get coords + embeddings <- rliger::dimReds(x = liger_object)[[reduction]] + } else { + cli_abort("The reduction {.field {reduction}} is not present in dimReds slot.") + } # return embeddings return(embeddings) @@ -701,71 +706,6 @@ Top_Genes_Factor <- function( } - - - -#' Extract dimensionality reduction coordinates from Liger object -#' -#' Extract data.frame containing dimensionality reduction coordinates from new format of -#' Liger objects -#' -#' @param liger_object LIGER object name. -#' @param reduction name of dimensionality reduction stored in cellMeta slot. Default is -#' NULL, which will use liger object's default reduction. -#' @param check_only logical, return `TRUE` if valid reduction is present. -#' -#' @return dimensionality reduction coordinates in 2 column format -#' -#' @import cli -#' @importFrom methods slotNames -#' -#' @export -#' -#' @concept liger_object_util -#' -#' @examples -#' \dontrun{ -#' # return dimensionality reduction coordinates -#' umap_coords <- LIGER_DimReduc(liger_object = object) -#' -#' # return logical to see if reduction is present -#' reduc_present <- LIGER_DimReduc(liger_object = object, reduction = "umap", -#' check_only = TRUE) -#' } -#' - -LIGER_DimReduc <- function( - liger_object, - reduction = NULL, - check_only = FALSE -) { - # check liger - Is_LIGER(liger_object = liger_object) - - # Check new liger object - if (packageVersion(pkg = 'rliger') < "2.0.0") { - cli_abort(message = "This function is only for objects with rliger >= v2.0.0") - } - - # reduction to use - reduction_use <- reduction %||% Default_DimReduc_LIGER(liger_object = liger_object) - - # check reduction in cellMeta - if (reduction_use %in% names(x = rliger::dimReds(x = liger_object))) { - if (isTRUE(x = check_only)) { - return(TRUE) - } - # get coords - reduc_coords <- rliger::dimReds(x = liger_object)[[reduction_use]] - } else { - cli_abort("The reduction {.field {reduction_use}} is not present in dimReds slot.") - } - - # return coords - return(reduc_coords) -} - - #' Find Factor Correlations #' #' Calculate correlations between gene loadings for all factors in liger object. From 37d42a89d5bbbafdb64f6c5030bdd27fffe9e457 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 13:31:48 -0400 Subject: [PATCH 307/503] Update docs --- NAMESPACE | 2 -- man/Embeddings.Rd | 6 ++++-- man/LIGER_DimReduc.Rd | 35 ----------------------------------- man/WhichCells.Rd | 2 +- 4 files changed, 5 insertions(+), 40 deletions(-) delete mode 100644 man/LIGER_DimReduc.Rd diff --git a/NAMESPACE b/NAMESPACE index c7711006d8..8e7ea10d3b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,7 +89,6 @@ export(Iterate_Plot_Density_Joint) export(Iterate_VlnPlot_scCustom) export(JCO_Four) export(LIGER_Cells_by_Identities) -export(LIGER_DimReduc) export(Liger_to_Seurat) export(MAD_Stats) export(Median_Stats) @@ -265,7 +264,6 @@ importFrom(methods,as) importFrom(methods,hasArg) importFrom(methods,new) importFrom(methods,slot) -importFrom(methods,slotNames) importFrom(paletteer,paletteer_c) importFrom(paletteer,paletteer_d) importFrom(patchwork,plot_annotation) diff --git a/man/Embeddings.Rd b/man/Embeddings.Rd index eaa386801d..a0c7ac36b2 100644 --- a/man/Embeddings.Rd +++ b/man/Embeddings.Rd @@ -4,7 +4,7 @@ \alias{Embeddings.liger} \title{Extract matrix of embeddings} \usage{ -\method{Embeddings}{liger}(object, reduction = NULL, iNMF = FALSE, ...) +\method{Embeddings}{liger}(object, reduction = NULL, iNMF = FALSE, check_only = FALSE, ...) } \arguments{ \item{object}{LIGER object name.} @@ -13,6 +13,8 @@ \item{iNMF}{logical, whether to extract iNMF h.norm matrix instead of dimensionality reduction embeddings.} +\item{check_only}{logical, return \code{TRUE} if valid reduction is present.} + \item{...}{Arguments passed to other methods} } \value{ @@ -31,4 +33,4 @@ iNMF_mat <- Embeddings(object = liger_object, reduction = "iNMF") } } -\concept{object_conversion} +\concept{liger_object_util} diff --git a/man/LIGER_DimReduc.Rd b/man/LIGER_DimReduc.Rd deleted file mode 100644 index 40defefd19..0000000000 --- a/man/LIGER_DimReduc.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/LIGER_Utilities.R -\name{LIGER_DimReduc} -\alias{LIGER_DimReduc} -\title{Extract dimensionality reduction coordinates from Liger object} -\usage{ -LIGER_DimReduc(liger_object, reduction = NULL, check_only = FALSE) -} -\arguments{ -\item{liger_object}{LIGER object name.} - -\item{reduction}{name of dimensionality reduction stored in cellMeta slot. Default is -NULL, which will use liger object's default reduction.} - -\item{check_only}{logical, return \code{TRUE} if valid reduction is present.} -} -\value{ -dimensionality reduction coordinates in 2 column format -} -\description{ -Extract data.frame containing dimensionality reduction coordinates from new format of -Liger objects -} -\examples{ -\dontrun{ -# return dimensionality reduction coordinates -umap_coords <- LIGER_DimReduc(liger_object = object) - -# return logical to see if reduction is present -reduc_present <- LIGER_DimReduc(liger_object = object, reduction = "umap", -check_only = TRUE) -} - -} -\concept{liger_object_util} diff --git a/man/WhichCells.Rd b/man/WhichCells.Rd index e305150e9c..57130d96d8 100644 --- a/man/WhichCells.Rd +++ b/man/WhichCells.Rd @@ -44,4 +44,4 @@ stim_cells <- WhichCells(object = liger_object, idents = "stim", ident_col = "Tr } } -\concept{object_conversion} +\concept{liger_object_util} From 28d7efd851874449cc2ce1fbab6a0670d57ddf17 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 13:32:18 -0400 Subject: [PATCH 308/503] Update news --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 1160c7de56..f6470ed835 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,6 @@ ## Added - **Major Updates to Functionality with rliger package:** - *Added new utility functions to interact with liger v2.0.0+ object format change:* - - `LIGER_DimReduc()` to extract dimensionality reduction coordinates. - `Subset_LIGER` to quickly subset by cluster or other meta data variable. - `LIGER_Cells_by_Identities` to extract list of barcodes sorted by values within given meta data column. - *Extended the following Seurat/SeuratObject generic functions to work seamlessly with liger objects:* From 11b21a0b003f8c98cc459ecd31a92488958e9a07 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 13:32:35 -0400 Subject: [PATCH 309/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index cc059a1ff0..90b3a011e4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9052 +Version: 2.1.2.9053 Date: 2024-04-25 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")), From c44a1289c1e36f244c5c0413da49638762d55799 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 14:59:32 -0400 Subject: [PATCH 310/503] add Idents.liger and Idents<-.liger --- R/LIGER_Internal_Utilities.R | 13 +++-- R/LIGER_Utilities.R | 101 ++++++++++++++++++++++++++++++++++- R/Reexports.R | 14 +++++ 3 files changed, 119 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index ff2d00c532..1b596e6d7c 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -54,19 +54,18 @@ Default_DimReduc_LIGER <- function( #' @examples #' \dontrun{ #' # return dimensionality reduction name -#' dim_reduc_name <- LIGER_Default_Cluster(liger_object = obj) +#' dim_reduc_name <- LIGER_Default_Cluster_Name(liger_object = obj) #' } #' -LIGER_Default_Cluster <- function( +LIGER_Default_Cluster_Name <- function( liger_object ) { - if (length(x = liger_object@uns$defaultCluster) > 0) { + if (is.null(x = rliger::defaultCluster(x = object))) { + cli_abort(message = "No default cell identity/cluster present in object.") + } else { default_cluster_name <- liger_object@uns$defaultCluster - return(default_cluster_name) - } else { - cli_abort(message = "No default cluster present.") } } @@ -172,7 +171,7 @@ Generate_Plotting_df_LIGER2 <- function(object, if (isTRUE(x = reorder.idents)) { reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) } - cluster_col <- LIGER_Default_Cluster(liger_object = object) + cluster_col <- LIGER_Default_Cluster_Name(liger_object = object) c_names <- names(x = object@cellMeta[[cluster_col]]) if (is.null(x = clusters)) { # if clusters have not been set yet diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index d171bfd573..172528209a 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -170,7 +170,7 @@ WhichCells.liger <- function( } # Get cells data.frame - ident_col <- ident_col %||% LIGER_Default_Cluster(liger_object = object) + ident_col <- ident_col %||% LIGER_Default_Cluster_Name(liger_object = object) cell_df <- Fetch_Meta(object = object) %>% select(all_of(c(ident_col, "dataset"))) @@ -292,6 +292,103 @@ Embeddings.liger <- function( } +#' Extract or set default identities from object +#' +#' Extract default identities from object in factor form. +#' +#' @param object LIGER object name. +#' @param reduction name of dimensionality reduction to pull +#' @param ... Arguments passed to other methods +#' +#' @method Idents liger +#' @return factor +#' +#' @concept liger_object_util +#' +#' @import cli +#' @import Seurat +#' @importFrom dplyr pull +#' @importFrom magrittr "%>%" +#' +#' @export +#' @rdname Idents +#' +#' @examples +#' \dontrun{ +#' # Extract idents +#' object_idents <- Idents(object = liger_object) +#' } +#' + +Idents.liger <- function( + object, + ... +) { + # Check default cluster present + if (is.null(x = rliger::defaultCluster(x = object))) { + cli_abort(message = "No default cell identity/cluster present in object.") + } + + # get current default ident name + identity_name <- LIGER_Default_Cluster_Name(liger_object = object) + + # pull active ident column + active_idents <- Fetch_Meta(object = object) %>% + pull(.data[[identity_name]]) + + # return active idents + return(active_idents) +} + + +#' Set default identities of object +#' +#' @param object LIGER object name. +#' @param value name of column in cellMeta slot to set as new default cluster/ident +#' @param ... Arguments passed to other methods +#' +#' @method Idents<- liger +#' @return object +#' +#' @note Use of Idents<- is only for setting new default ident/cluster from column already present in cellMeta. +#' To add new column with new cluster values to cellMeta and set as default see \code{\link{Rename_Clusters}}. +#' +#' @concept liger_object_util +#' +#' @import cli +#' @import Seurat +#' +#' @export +#' @rdname Idents +#' +#' @examples +#' \dontrun{ +#' # Set idents +#' Idents(object = liger_object) <- "new_annotation" +#' } +#' + +"Idents<-.liger" <- function( + object, + value, + ... +) { + # Check new ident value is present in cellMeta + new_ident_name <- Meta_Present(object = object, meta_col_names = value, print_msg = FALSE, omit_warn = FALSE)[[1]] + + if (length(x = new_ident_name) == 0) { + cli_abort(message = c("The provided {.code value} ({.field {value}}) is not present in obect cellMeta slot.", + "i" = "Provide different value or use {.field Rename_Clusters} to add vector of new idents to cellMeta.")) + } + + # change defaults + rliger::defaultCluster(x = object) <- new_ident_name + + # return object + return(object) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### DATA ACCESS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -368,7 +465,7 @@ LIGER_Cells_by_Identities <- function( } # set group.by if not set - group.by <- group.by %||% LIGER_Default_Cluster(liger_object = liger_object) + group.by <- group.by %||% LIGER_Default_Cluster_Name(liger_object = liger_object) # Check cluster df cell_df <- Fetch_Meta(object = liger_object) %>% diff --git a/R/Reexports.R b/R/Reexports.R index 7fedb6dab9..10fdeb53f8 100644 --- a/R/Reexports.R +++ b/R/Reexports.R @@ -32,3 +32,17 @@ SeuratObject::Features #' #' SeuratObject::Embeddings + +#' @importFrom SeuratObject Embeddings +#' @export +#' @note See \code{\link{Idents.liger}} for scCustomize extension of this generic to extract cell identities. +#' +#' +SeuratObject::Idents + +#' @importFrom SeuratObject Idents +#' @export +#' @note See \code{\link{Idents.liger}} for scCustomize extension of this generic to extract cell identities. +#' +#' +SeuratObject::`Idents<-` From bd6ba4db85e7022703b7f44834a0dd46e59d4504 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:02:31 -0400 Subject: [PATCH 311/503] Update docs --- NAMESPACE | 6 ++++++ R/Reexports.R | 6 +++--- man/Idents.Rd | 45 +++++++++++++++++++++++++++++++++++++++++++++ man/reexports.Rd | 8 +++++++- 4 files changed, 61 insertions(+), 4 deletions(-) create mode 100644 man/Idents.Rd diff --git a/NAMESPACE b/NAMESPACE index 8e7ea10d3b..5ee790daba 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method("Idents<-",liger) S3method(Add_Cell_Complexity,Seurat) S3method(Add_Cell_Complexity,liger) S3method(Add_Cell_QC_Metrics,Seurat) @@ -15,6 +16,7 @@ S3method(Embeddings,liger) S3method(Features,liger) S3method(Fetch_Meta,Seurat) S3method(Fetch_Meta,liger) +S3method(Idents,liger) S3method(Rename_Clusters,Seurat) S3method(Rename_Clusters,liger) S3method(WhichCells,liger) @@ -23,6 +25,7 @@ S3method(as.LIGER,list) S3method(as.Seurat,liger) S3method(as.anndata,Seurat) S3method(as.anndata,liger) +export("Idents<-") export(Add_Alt_Feature_ID) export(Add_CellBender_Diff) export(Add_Cell_Complexity) @@ -78,6 +81,7 @@ export(Fetch_Meta) export(Find_Factor_Cor) export(Gene_Present) export(Hue_Pal) +export(Idents) export(Iterate_Barcode_Rank_Plot) export(Iterate_Cluster_Highlight_Plot) export(Iterate_DimPlot_bySample) @@ -206,10 +210,12 @@ importFrom(Seurat,Read10X_h5) importFrom(Seurat,VariableFeaturePlot) importFrom(Seurat,VizDimLoadings) importFrom(Seurat,VlnPlot) +importFrom(SeuratObject,"Idents<-") importFrom(SeuratObject,Cells) importFrom(SeuratObject,DefaultDimReduc) importFrom(SeuratObject,Embeddings) importFrom(SeuratObject,Features) +importFrom(SeuratObject,Idents) importFrom(SeuratObject,JoinLayers) importFrom(SeuratObject,LayerData) importFrom(SeuratObject,Layers) diff --git a/R/Reexports.R b/R/Reexports.R index 10fdeb53f8..0548023b75 100644 --- a/R/Reexports.R +++ b/R/Reexports.R @@ -33,16 +33,16 @@ SeuratObject::Features #' SeuratObject::Embeddings -#' @importFrom SeuratObject Embeddings +#' @importFrom SeuratObject Idents #' @export #' @note See \code{\link{Idents.liger}} for scCustomize extension of this generic to extract cell identities. #' #' SeuratObject::Idents -#' @importFrom SeuratObject Idents +#' @importFrom SeuratObject Idents<- #' @export -#' @note See \code{\link{Idents.liger}} for scCustomize extension of this generic to extract cell identities. +#' @note See \code{\link{Idents.liger}} for scCustomize extension of this generic to set cell identities. #' #' SeuratObject::`Idents<-` diff --git a/man/Idents.Rd b/man/Idents.Rd new file mode 100644 index 0000000000..87b955f29d --- /dev/null +++ b/man/Idents.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LIGER_Utilities.R +\name{Idents.liger} +\alias{Idents.liger} +\alias{Idents<-.liger} +\title{Extract or set default identities from object} +\usage{ +\method{Idents}{liger}(object, ...) + +\method{Idents}{liger}(object, ...) <- value +} +\arguments{ +\item{object}{LIGER object name.} + +\item{...}{Arguments passed to other methods} + +\item{value}{name of column in cellMeta slot to set as new default cluster/ident} + +\item{reduction}{name of dimensionality reduction to pull} +} +\value{ +factor + +object +} +\description{ +Extract default identities from object in factor form. +} +\note{ +Use of Idents<- is only for setting new default ident/cluster from column already present in cellMeta. +To add new column with new cluster values to cellMeta and set as default see \code{\link{Rename_Clusters}}. +} +\examples{ +\dontrun{ +# Extract idents +object_idents <- Idents(object = liger_object) +} + +\dontrun{ +# Set idents +Idents(object = liger_object) <- "new_annotation" +} + +} +\concept{liger_object_util} diff --git a/man/reexports.Rd b/man/reexports.Rd index 8edbb048bd..0efc73e219 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -8,6 +8,8 @@ \alias{Cells} \alias{Features} \alias{Embeddings} +\alias{Idents} +\alias{Idents<-} \title{Objects exported from other packages} \note{ See \code{\link{as.Seurat.liger}} for scCustomize extension of this generic to converting Liger objects. @@ -19,6 +21,10 @@ See \code{\link{Cells.liger}} for scCustomize extension of this generic to extra See \code{\link{Features.liger}} for scCustomize extension of this generic to extract dataset features. See \code{\link{Embeddings.liger}} for scCustomize extension of this generic to extract embeddings. + +See \code{\link{Idents.liger}} for scCustomize extension of this generic to extract cell identities. + +See \code{\link{Idents.liger}} for scCustomize extension of this generic to set cell identities. } \keyword{internal} \description{ @@ -26,6 +32,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{Cells}}, \code{\link[SeuratObject]{Embeddings}}, \code{\link[SeuratObject:Cells]{Features}}, \code{\link[SeuratObject]{WhichCells}}} + \item{SeuratObject}{\code{\link[SeuratObject]{as.Seurat}}, \code{\link[SeuratObject]{Cells}}, \code{\link[SeuratObject]{Embeddings}}, \code{\link[SeuratObject:Cells]{Features}}, \code{\link[SeuratObject]{Idents}}, \code{\link[SeuratObject:Idents]{Idents<-}}, \code{\link[SeuratObject]{WhichCells}}} }} From 152e1dc1f6440c37ef2d53ca89ed372482c86980 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:06:57 -0400 Subject: [PATCH 312/503] fix find defaults --- R/LIGER_Internal_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 1b596e6d7c..db36e15c11 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -61,7 +61,7 @@ Default_DimReduc_LIGER <- function( LIGER_Default_Cluster_Name <- function( liger_object ) { - if (is.null(x = rliger::defaultCluster(x = object))) { + if (is.null(x = rliger::defaultCluster(x = liger_object))) { cli_abort(message = "No default cell identity/cluster present in object.") } else { default_cluster_name <- liger_object@uns$defaultCluster From ae4aeddd125914c6dda409e6dabcad959d3dd76f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:12:36 -0400 Subject: [PATCH 313/503] fix object param naming --- R/LIGER_Internal_Utilities.R | 2 +- R/LIGER_Utilities.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index db36e15c11..93bcbaaaa1 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -79,7 +79,7 @@ LIGER_Default_Cluster_Name <- function( #' #' Standard and modified version of LIGER's plotByDatasetAndCluster #' -#' @param liger_object Name of LIGER object. Need to perform clustering before calling this function. +#' @param object Name of LIGER object. Need to perform clustering before calling this function. #' @param clusters Another clustering to use for coloring second plot (must have same names as #' clusters slot) (default NULL). #' @param shuffle Randomly shuffle points so that points from same dataset are not plotted one after diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 172528209a..b8c9b8bf04 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -277,12 +277,12 @@ Embeddings.liger <- function( reduction <- reduction %||% Default_DimReduc_LIGER(liger_object = object) # check reduction in cellMeta - if (reduction %in% names(x = rliger::dimReds(x = liger_object))) { + if (reduction %in% names(x = rliger::dimReds(x = object))) { if (isTRUE(x = check_only)) { return(TRUE) } # get coords - embeddings <- rliger::dimReds(x = liger_object)[[reduction]] + embeddings <- rliger::dimReds(x = object)[[reduction]] } else { cli_abort("The reduction {.field {reduction}} is not present in dimReds slot.") } From 831c3d3e5121903fae9719f985104d75fd1e05c5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:22:31 -0400 Subject: [PATCH 314/503] fix plotting internals --- R/LIGER_Internal_Utilities.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 93bcbaaaa1..911c90f92e 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -172,18 +172,16 @@ Generate_Plotting_df_LIGER2 <- function(object, reduc_df[[group_by]] <- factor(x = reduc_df[[group_by]], levels = new.order) } cluster_col <- LIGER_Default_Cluster_Name(liger_object = object) - c_names <- names(x = object@cellMeta[[cluster_col]]) if (is.null(x = clusters)) { # if clusters have not been set yet if (length(x = object@cellMeta[[cluster_col]]) == 0) { clusters <- rep(1, nrow(x = reduc_df)) - names(x = clusters) <- c_names <- rownames(x = reduc_df) + names(x = clusters) <- rownames(x = reduc_df) } else { clusters <- object@cellMeta[[cluster_col]] - c_names <- names(x = object@cellMeta[[cluster_col]]) } } - reduc_df[['Cluster']] <- clusters[c_names] + reduc_df[['Cluster']] <- clusters if (isTRUE(x = shuffle)) { set.seed(shuffle_seed) From ea037c556db0e94d97897805eedece6e834eb30b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:25:15 -0400 Subject: [PATCH 315/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index f6470ed835..7600770423 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,7 @@ - `Features` to extract vector of all features or list vectors of features by dataset. - `WhichCells` to extract vector or list of cells matching identity criteria. - `Embeddings` to extract matrix containing dimensionality reduction embeddings or iNMF h.norm matrix. + - `Idents` and `Idents<-` to extract and set default identities/clusters. - *Updated functions to interact with both old and new style liger objects:* - `plotFactors_scCustom()` - `Fetch_Meta` From a4b21950a389961c32e925adf42eb62d977a2d95 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 25 Apr 2024 15:25:28 -0400 Subject: [PATCH 316/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90b3a011e4..6c4208f13a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9053 +Version: 2.1.2.9054 Date: 2024-04-25 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")), From 115c53395252f8e93bcbd9f07f87e0c309974413 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 29 Apr 2024 16:21:52 -0400 Subject: [PATCH 317/503] Idents.liger fixes --- R/LIGER_Utilities.R | 5 ++--- man/Idents.Rd | 2 -- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index b8c9b8bf04..5307e065a7 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -297,7 +297,6 @@ Embeddings.liger <- function( #' Extract default identities from object in factor form. #' #' @param object LIGER object name. -#' @param reduction name of dimensionality reduction to pull #' @param ... Arguments passed to other methods #' #' @method Idents liger @@ -370,8 +369,8 @@ Idents.liger <- function( "Idents<-.liger" <- function( object, - value, - ... + ..., + value ) { # Check new ident value is present in cellMeta new_ident_name <- Meta_Present(object = object, meta_col_names = value, print_msg = FALSE, omit_warn = FALSE)[[1]] diff --git a/man/Idents.Rd b/man/Idents.Rd index 87b955f29d..1109e55b1c 100644 --- a/man/Idents.Rd +++ b/man/Idents.Rd @@ -15,8 +15,6 @@ \item{...}{Arguments passed to other methods} \item{value}{name of column in cellMeta slot to set as new default cluster/ident} - -\item{reduction}{name of dimensionality reduction to pull} } \value{ factor From 704f15f1f93be480aae292cc961ad3f34b476aa5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 29 Apr 2024 16:51:58 -0400 Subject: [PATCH 318/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6c4208f13a..a41bbbad63 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" RRID:SCR_024675. -Version: 2.1.2.9054 -Date: 2024-04-25 +Version: 2.1.2.9055 +Date: 2024-04-29 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"), From 1edadb5a0336547fe57fc8b0a9bc15ee73ffcb99 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Mon, 29 Apr 2024 20:51:14 -0400 Subject: [PATCH 319/503] style --- R/LIGER_Utilities.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 5307e065a7..3db730e2d3 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -392,6 +392,7 @@ Idents.liger <- function( #################### DATA ACCESS #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + #' @rdname Fetch_Meta #' @importFrom methods slot #' @export From 8e0e8164631556265fd37f8ba938d8f4edabe122 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:20:26 -0400 Subject: [PATCH 320/503] fix mad stats --- R/Statistics.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Statistics.R b/R/Statistics.R index d45240b002..4f0c6409b0 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -366,11 +366,11 @@ MAD_Stats <- function( mad_by_group <- meta_data %>% group_by(.data[[group_by_var]]) %>% - summarise(across(all_of(all_variables), mad)) + summarise(across(all_of(all_variables), mad)*mad_num) # Calculate overall medians mad_overall <- meta_data %>% - summarise(across(all_of(all_variables), mad)) + summarise(across(all_of(all_variables), mad)*mad_num) # Create data.frame with group_by_var as column name meta_col_name_df <- data.frame(col_name = "Totals (All Cells)") From 8d7844146f701299d336bd9b5153a9918ec9faf8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:20:34 -0400 Subject: [PATCH 321/503] bump changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 7600770423..e9cdb32a7a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -64,6 +64,7 @@ - Fixed errors in `Plot_Median_*` family that caused issues when `group_by` parameter was NULL. - Fixed errors in `FeaturePlot_scCustom` when setting `combine = FALSE`. - Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. +- Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). - Spelling and style fixes. Thanks @kew24. From fd048351572bee458b3a674c767ff6d7f99e2903 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:21:06 -0400 Subject: [PATCH 322/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a41bbbad63..0502f0b73d 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" RRID:SCR_024675. -Version: 2.1.2.9055 -Date: 2024-04-29 +Version: 2.1.2.9056 +Date: 2024-05-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"), From d0dae63e7cc0a0b02b3d6b3ed7e485cd43e686c8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:24:09 -0400 Subject: [PATCH 323/503] check mad_num is valid --- R/Statistics.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/Statistics.R b/R/Statistics.R index 4f0c6409b0..573ea4496f 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -335,6 +335,11 @@ MAD_Stats <- function( mad_var = NULL, mad_num = 2 ) { + # check mad_num + if (mad_num <= 0) { + cli_abort(message = "The {.code mad_num} parameter must be greater than 0.") + } + # Check Seurat Is_Seurat(seurat_object = seurat_object) From 1aafeedc0b2451d9c368b71c5bd80252b471cf9c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:25:25 -0400 Subject: [PATCH 324/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e9cdb32a7a..fc0cbf39ab 100644 --- a/NEWS.md +++ b/NEWS.md @@ -64,7 +64,8 @@ - Fixed errors in `Plot_Median_*` family that caused issues when `group_by` parameter was NULL. - Fixed errors in `FeaturePlot_scCustom` when setting `combine = FALSE`. - Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. -- Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). +- Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). +- Fixed bug in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0. - Spelling and style fixes. Thanks @kew24. From e767f21984c85d7d3ed68fe7ab15150e846db3ee Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:36:09 -0400 Subject: [PATCH 325/503] allow setting active ident --- R/Statistics.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/Statistics.R b/R/Statistics.R index 573ea4496f..14bba04130 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -349,6 +349,12 @@ MAD_Stats <- function( default_var <- NULL } + # set to active ident if "ident" is provided + if (group_by_var == "ident") { + seurat_object[["active.ident"]] <- Idents(object = seurat_object) + group_by_var <- "active.ident" + } + # Check group variable present group_by_var <- Meta_Present(object = seurat_object, meta_col_names = group_by_var, print_msg = FALSE)[[1]] From 919e49d06519d88dbe1f1187672b749622576d34 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:36:51 -0400 Subject: [PATCH 326/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index fc0cbf39ab..068e7d18bc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -65,7 +65,7 @@ - Fixed errors in `FeaturePlot_scCustom` when setting `combine = FALSE`. - Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. - Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). -- Fixed bug in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0. +- Fixed bugs in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0 and returned error if setting `group_by_var` to "ident". - Spelling and style fixes. Thanks @kew24. From fea4f402d62a4b8594ef9401fd49fc2c1fea56de Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 8 May 2024 10:37:14 -0400 Subject: [PATCH 327/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0502f0b73d..eef7970b4e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9056 +Version: 2.1.2.9057 Date: 2024-05-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")), From 8a6edc9e90030e7ec4ae533d30f2daddc5f6d60d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:03:05 -0400 Subject: [PATCH 328/503] cluster stats sort by frequency --- R/Statistics.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/Statistics.R b/R/Statistics.R index 14bba04130..7ae8079b64 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -40,12 +40,14 @@ Cluster_Stats_All_Samples <- function( # Extract total percents total_percent <- prop.table(x = table(seurat_object@active.ident)) * 100 total_percent <- data.frame(total_percent) %>% - rename(Cluster = all_of("Var1")) + rename(Cluster = all_of("Var1")) %>% + arrange(desc(.data[["Freq"]])) # Extract total cell number per cluster across all samples total_cells <- table(seurat_object@active.ident) %>% data.frame() %>% - rename(Cluster = all_of("Var1"), Number = all_of("Freq")) + rename(Cluster = all_of("Var1"), Number = all_of("Freq")) %>% + arrange(desc(.data[["Number"]])) # Cluster overall stats across all animals cluster_stats <- suppressMessages(left_join(total_cells, total_percent)) From 5540f720c4bb76ebbd4c50860d21fb616d4b1632 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:04:34 -0400 Subject: [PATCH 329/503] repalce .data[["var"]] with all_of --- R/Statistics.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/Statistics.R b/R/Statistics.R index 7ae8079b64..9ee46a1944 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -6,7 +6,7 @@ #' @param group_by_var meta data column to classify samples (default = "orig.ident"). #' #' @import cli -#' @importFrom dplyr left_join rename all_of +#' @importFrom dplyr left_join rename all_of arrange desc #' @importFrom janitor adorn_totals #' @importFrom magrittr "%>%" #' @importFrom tibble rownames_to_column column_to_rownames @@ -58,7 +58,7 @@ Cluster_Stats_All_Samples <- function( rename(Cluster = all_of("Var1"), group_by_var = all_of("Var2"), cell_number = all_of("Freq")) cells_per_cluster_2 <- cells_per_cluster_2 %>% - pivot_wider(names_from = group_by_var, values_from = .data[["cell_number"]]) + pivot_wider(names_from = group_by_var, values_from = all_of("cell_number")) # Merge cells per metadata column per cluster with cluster stats cluster_stats_2 <- suppressMessages(left_join(cluster_stats, cells_per_cluster_2)) @@ -68,7 +68,7 @@ Cluster_Stats_All_Samples <- function( percent_per_cluster_2 <- data.frame(percent_per_cluster_2) %>% rename(cluster = all_of("Var1"), group_by_var = all_of("Var2"), percent = all_of("Freq")) percent_per_cluster_2 <- percent_per_cluster_2 %>% - pivot_wider(names_from = group_by_var, values_from = .data[["percent"]]) %>% + pivot_wider(names_from = group_by_var, values_from = all_of("percent")) %>% column_to_rownames("cluster") colnames(x = percent_per_cluster_2) <- paste(colnames(x = percent_per_cluster_2), "%", sep = "_") From 72729778d5ab1be7f1bf8d914a8a508483920fb0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:05:37 -0400 Subject: [PATCH 330/503] edit docs --- R/Statistics.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Statistics.R b/R/Statistics.R index 9ee46a1944..a4a01f23bc 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -1,6 +1,6 @@ #' Calculate Cluster Stats #' -#' Calculates both overall and per sample cell number and percentages per cluster based on orig.ident +#' Calculates both overall and per sample cell number and percentages per cluster based on orig.ident. #' #' @param seurat_object Seurat object name. #' @param group_by_var meta data column to classify samples (default = "orig.ident"). @@ -12,7 +12,7 @@ #' @importFrom tibble rownames_to_column column_to_rownames #' @importFrom tidyr pivot_wider #' -#' @return A data.frame +#' @return A data.frame with rows in order of frequency #' #' @export #' From c87302eba1cd60d5cdd3e6bf26aa7c2796cfa7cc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:06:58 -0400 Subject: [PATCH 331/503] Update docs --- man/Cluster_Stats_All_Samples.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/Cluster_Stats_All_Samples.Rd b/man/Cluster_Stats_All_Samples.Rd index 4af64f8c06..7526815527 100644 --- a/man/Cluster_Stats_All_Samples.Rd +++ b/man/Cluster_Stats_All_Samples.Rd @@ -12,10 +12,10 @@ Cluster_Stats_All_Samples(seurat_object, group_by_var = "orig.ident") \item{group_by_var}{meta data column to classify samples (default = "orig.ident").} } \value{ -A data.frame +A data.frame with rows in order of frequency } \description{ -Calculates both overall and per sample cell number and percentages per cluster based on orig.ident +Calculates both overall and per sample cell number and percentages per cluster based on orig.ident. } \examples{ \dontrun{ From 2102288184bb46f1706981e47e238a86276e70cd Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:33:23 -0400 Subject: [PATCH 332/503] update changelog --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 068e7d18bc..b40e01c45a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -39,6 +39,7 @@ - Added new plotting function `SpatialDimPlot_scCustom`. Thanks for encouragement @puapinyoying @nina-hahn ([#160](https://github.com/samuel-marsh/scCustomize/issues/160)). - Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. - Added parameter `cutoff_line_width` to the `QC_Plot_*` family of plots to control line thickness of cutoff lines. +- `Cluster_Stats_All_Samples` now returns data.frame with row order reflecting the frequency of cells. @@ -66,6 +67,7 @@ - Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. - Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). - Fixed bugs in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0 and returned error if setting `group_by_var` to "ident". +- Replaced deprecated tidyr code .data[["var"]] with update `all_of`/`any_of` syntax. - Spelling and style fixes. Thanks @kew24. From b4eada121e6bc2b13ee6426e5d14c85b92623a56 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 09:33:44 -0400 Subject: [PATCH 333/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index eef7970b4e..a80520ca8f 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" RRID:SCR_024675. -Version: 2.1.2.9057 -Date: 2024-05-08 +Version: 2.1.2.9058 +Date: 2024-05-09 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"), From 6b89fe2db1f1cfe3bf90313137ab641cab2af2c2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 12:47:50 -0400 Subject: [PATCH 334/503] add prop plot option --- R/Plotting_Utilities.R | 76 ++++++++++++++++++++++++++++++++++++++++++ R/Seurat_Plotting.R | 40 ++++++++++++++++++++++ 2 files changed, 116 insertions(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 333e068c49..2750d1d2ac 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -345,6 +345,82 @@ scCustomze_Split_FeatureScatter <- function( } +#' Plot identity proportions +#' +#' Horizontal bar plot of either the total number of cells per identity or the percent of cells per identity +#' +#' @param seurat_object seurat object +#' @param group.by Identity to group by in plot +#' @param percent logical, whether to x-axis represents total number of cells or percentage of +#' total cells, default is FALSE; plot total number. +#' @param colors_use named vector of colors or hex values. Names must match levels of `group.by`. +#' @param x_axis_log logical, whether to plot x-axis in log10 scale, default is FALSE. +#' +#' @return ggplot2 plot +#' +#' @import ggplot2 +#' @import patchwork +#' @importFrom dplyr select all_of +#' @importFrom forcats fct_rev +#' @importFrom magrittr "%>%" +#' +#' @references functionality inspired by `sc_dim_count` from ggsc package: \url{https://bioconductor.org/packages/ggsc/}. +#' +#' @noRd +#' + +Overall_Prop_Plot <- function( + seurat_object, + group.by = NULL, + freq = FALSE, + colors_use, + x_axis_log = FALSE +) { + # Set active ident + if (!is.null(x = group.by) && group.by != "ident") { + Idents(object = seurat_object) <- group.by + } + + # Get stats and filter + all_stats <- Cluster_Stats_All_Samples(seurat_object = seurat_object) + + fil_stats <- all_stats %>% + select(all_of(c("Cluster", "Number", "Freq"))) + + num_clusters <- nrow(x = fil_stats) - 1 + + fil_stats <- fil_stats[1:num_clusters,] + + # Create factor for prop plot based on that respects number of cells per cluster from Cluster_Stats_All_Samples + fil_stats$Cluster <- factor(fil_stats$Cluster, levels = fil_stats$Cluster) + + if (isFALSE(x = percent)) { + plot <- ggplot(fil_stats, aes(x = .data[["Number"]], y = fct_rev(.data[["Cluster"]]), fill = .data[["Cluster"]])) + + geom_col() + + scale_fill_manual(values = colors_use) + + theme_ggprism_mod() + + xlab("Number of Cells") + + ylab(NULL) + + NoLegend() + } else { + plot <- ggplot(fil_stats, aes(x = .data[["Freq"]], y = fct_rev(.data[["Cluster"]]), fill = .data[["Cluster"]])) + + geom_col() + + scale_fill_manual(values = colors_use) + + theme_ggprism_mod() + + xlab("Percent of Cells") + + ylab(NULL) + + NoLegend() + } + + # mod x axis if needed + if (isTRUE(x = x_axis_log)) { + plot <- plot + scale_x_log10() + } + + return(plot) +} + + #' Figure Plots #' #' Removes the axes from 2D DR plots and makes them into plot label. diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 52c087882b..1ecec512d4 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1666,6 +1666,9 @@ DimPlot_scCustom <- function( split_seurat = FALSE, figure_plot = FALSE, aspect_ratio = NULL, + add_prop_plot = FALSE, + prop_plot_percent = FALSE, + prop_plot_x_log = FALSE, shuffle = TRUE, seed = 1, label = NULL, @@ -1765,6 +1768,23 @@ DimPlot_scCustom <- function( # set size otherwise pt.size <- pt.size %||% AutoPointSize_scCustom(data = seurat_object, raster = raster) + # prop plot colors + if (isTRUE(x = add_prop_plot)) { + if (is.null(x = group.by)) { + ident_levels <- levels(x = Idents(object = pbmc)) + } else { + meta <- Fetch_Meta(pbmc) + if (is.factor(x = meta[,group.by])) { + ident_levels <- levels(x = meta[,group.by]) + } else { + ident_levels <- sort(unique(x = meta[,group.by])) + } + } + # create new variable and name + prop_colors_use <- colors_use + names(prop_colors_use) <- ident_levels + } + # 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, ...) @@ -1806,6 +1826,10 @@ DimPlot_scCustom <- function( plot_figure <- plot_figure & theme(aspect.ratio = aspect_ratio) } + if (isTRUE(x = add_prop_plot)) { + plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + } + return(plot_figure) } else { # Aspect ratio changes @@ -1816,6 +1840,10 @@ DimPlot_scCustom <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + if (isTRUE(x = add_prop_plot)) { + plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + } + return(plot) } @@ -1861,6 +1889,10 @@ DimPlot_scCustom <- function( plot_figure <- plot_figure & theme(aspect.ratio = aspect_ratio) } + if (isTRUE(x = add_prop_plot)) { + plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + } + return(plot_figure) } else { # Aspect ratio changes @@ -1871,6 +1903,10 @@ DimPlot_scCustom <- function( plot <- plot & theme(aspect.ratio = aspect_ratio) } + if (isTRUE(x = add_prop_plot)) { + plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + } + return(plot) } } else { @@ -1946,6 +1982,10 @@ DimPlot_scCustom <- function( plots <- plots & theme(aspect.ratio = aspect_ratio) } + if (isTRUE(x = add_prop_plot)) { + plots <- plots + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + } + return(plots) } } From d45d2c5b4b5d4407d4594cb5ca5548b2097ab062 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 12:47:59 -0400 Subject: [PATCH 335/503] update docs --- NAMESPACE | 1 + man/DimPlot_scCustom.Rd | 3 +++ 2 files changed, 4 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 5ee790daba..aff94b0c58 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -250,6 +250,7 @@ importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(dplyr,union) importFrom(forcats,fct_relevel) +importFrom(forcats,fct_rev) importFrom(ggbeeswarm,geom_quasirandom) importFrom(ggplot2,theme) importFrom(ggprism,theme_prism) diff --git a/man/DimPlot_scCustom.Rd b/man/DimPlot_scCustom.Rd index 372e717f2e..6e91d25b74 100644 --- a/man/DimPlot_scCustom.Rd +++ b/man/DimPlot_scCustom.Rd @@ -14,6 +14,9 @@ DimPlot_scCustom( split_seurat = FALSE, figure_plot = FALSE, aspect_ratio = NULL, + add_prop_plot = FALSE, + prop_plot_percent = FALSE, + prop_plot_x_log = FALSE, shuffle = TRUE, seed = 1, label = NULL, From e9b66b410c16fd98ca10eeb7777d30d19c7f8707 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 12:48:14 -0400 Subject: [PATCH 336/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a80520ca8f..c92bd4888d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9058 +Version: 2.1.2.9059 Date: 2024-05-09 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")), From e7cea8a3bbd19355ae379c164dc90f192df8f269 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 12:51:18 -0400 Subject: [PATCH 337/503] fix error --- R/Plotting_Utilities.R | 2 +- R/Seurat_Plotting.R | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 2750d1d2ac..b5d31d003c 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -372,7 +372,7 @@ scCustomze_Split_FeatureScatter <- function( Overall_Prop_Plot <- function( seurat_object, group.by = NULL, - freq = FALSE, + percent = FALSE, colors_use, x_axis_log = FALSE ) { diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 1ecec512d4..7f18efe4c1 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1827,7 +1827,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1841,7 +1841,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot) @@ -1890,7 +1890,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1904,7 +1904,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot) @@ -1983,7 +1983,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plots <- plots + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, freq = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plots <- plots + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plots) From 0ddd224ed985178302fec4f824bff2bb75503526 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 15:06:42 -0400 Subject: [PATCH 338/503] change patchwork --- R/Seurat_Plotting.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 7f18efe4c1..82aaa4253e 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1890,7 +1890,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1983,7 +1983,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plots <- plots + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plots <- plots | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plots) From e0aae8679e5ec31142baf4f0b861517e83ee8f98 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 15:27:56 -0400 Subject: [PATCH 339/503] fix spacing --- R/Internal_Utilities.R | 420 ++++++++++++++++++++--------------------- 1 file changed, 210 insertions(+), 210 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 4629319d41..250c39489d 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -497,9 +497,9 @@ Retrieve_Ensembl_Ribo <- function( #' @noRd #' - Retrieve_MSigDB_Lists <- function( +Retrieve_MSigDB_Lists <- function( species - ) { +) { # Accepted species names accepted_names <- data.frame( Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), @@ -559,7 +559,7 @@ Retrieve_Ensembl_Ribo <- function( ) return(qc_gene_list) - } +} #' Retrieve IEG Gene Lists @@ -577,9 +577,9 @@ Retrieve_Ensembl_Ribo <- function( #' @noRd #' - Retrieve_IEG_Lists <- function( +Retrieve_IEG_Lists <- function( species - ) { +) { # Accepted species names accepted_names <- data.frame( Mouse_Options = c("Mouse", "mouse", "Ms", "ms", "Mm", "mm"), @@ -623,7 +623,7 @@ Retrieve_Ensembl_Ribo <- function( ) return(qc_gene_list) - } +} #' Add MSigDB Gene Lists Percentages @@ -655,78 +655,78 @@ Retrieve_Ensembl_Ribo <- function( #' - 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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") - ) +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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) - if (!species %in% unlist(x = accepted_names)) { - cli_inform(message = "The supplied species ({.field {species}}) is not currently supported.") - } + 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 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.") - } + # 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.}") - ) - } + # 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) + # Set default assay + assay <- assay %||% DefaultAssay(object = seurat_object) - # Retrieve gene lists - msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + # 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"]]) + 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 meta data 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) - } + # Add meta data 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) + } - # Log Command - seurat_object <- LogSeuratCommand(object = seurat_object) + # Log Command + seurat_object <- LogSeuratCommand(object = seurat_object) - # return final object - return(seurat_object) - } + # return final object + return(seurat_object) +} #' Add IEG Gene List Percentages @@ -750,63 +750,63 @@ Retrieve_Ensembl_Ribo <- function( #' - Add_IEG_Seurat <- function( +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), - Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") - ) +) { + # 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) - if (!species %in% unlist(x = accepted_names)) { - cli_inform(message = "The supplied species ({.field {species}}) is not currently supported.") - } + 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.}") - ) - } + # Check Seurat + Is_Seurat(seurat_object = seurat_object) - # Set default assay - assay <- assay %||% DefaultAssay(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.}") + ) + } - # Retrieve gene lists - ieg_gene_list <- Retrieve_IEG_Lists(species = species) + # Set default assay + assay <- assay %||% DefaultAssay(object = seurat_object) - ieg_found <- Feature_PreCheck(object = seurat_object, features = ieg_gene_list[["ieg"]]) + # Retrieve gene lists + ieg_gene_list <- Retrieve_IEG_Lists(species = species) - # Add mito and ribo columns - if (length(x = ieg_found) > 0) { - seurat_object[[ieg_name]] <- PercentageFeatureSet(object = seurat_object, features = ieg_found, assay = assay) - } + ieg_found <- Feature_PreCheck(object = seurat_object, features = ieg_gene_list[["ieg"]]) - # Log Command - seurat_object <- LogSeuratCommand(object = seurat_object) + # Add mito and ribo columns + if (length(x = ieg_found) > 0) { + seurat_object[[ieg_name]] <- PercentageFeatureSet(object = seurat_object, features = ieg_found, assay = assay) + } + + # Log Command + seurat_object <- LogSeuratCommand(object = seurat_object) - # return final object - return(seurat_object) - } + # return final object + return(seurat_object) +} #' Return default QC features @@ -826,105 +826,105 @@ Retrieve_Ensembl_Ribo <- function( #' @noRd #' - Return_QC_Defaults <- function( +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") - ) +) { + # 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() - } + # 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 - } + # 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) + # 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)] + # 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 - ) + # create return list + feat_list <- list( + found_defaults = all_found_defaults, + not_found_defaults = not_found_defaults + ) - # return feature list - return(feat_list) - } + # return feature list + return(feat_list) +} #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -996,8 +996,8 @@ ExtractField <- function(string, field = 1, delim = "_") { #' Middle_Number <- function( - min, - max + min, + max ) { min_max <- c(min, max) middle <- min_max[-length(min_max)] + diff(min_max) / 2 @@ -1023,8 +1023,8 @@ Middle_Number <- function( #' symdiff <- function( - x, - y + x, + y ) { setdiff(x = union(x = x, y = y), intersect(x = x, y = y)) } @@ -1085,7 +1085,7 @@ drop_single_value_cols <- function( single_val_columns <- sapply(df, function(x) { length(x = unique(x = x)) == 1 - }) + }) col_names_single <- df %>% select(which(single_val_columns)) %>% @@ -1603,9 +1603,9 @@ Metrics_Single_File <- function( .get_bioc_cache <- function( ) { - cache <- tools::R_user_dir(package = "scCustomize", which="cache") - BiocFileCache::BiocFileCache(cache) - } + cache <- tools::R_user_dir(package = "scCustomize", which="cache") + BiocFileCache::BiocFileCache(cache) +} #' Download HGNC Dataset From 6ec76264ec0162d59559ef1e09d069148f67dd31 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 15:46:15 -0400 Subject: [PATCH 340/503] add dual species mito ribo --- R/Internal_Utilities.R | 183 +++++++++++++++++++++++++++++++++++++++++ R/Object_Utilities.R | 136 +++++++++++++++++------------- 2 files changed, 261 insertions(+), 58 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 250c39489d..87d8ead28e 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -626,6 +626,189 @@ Retrieve_IEG_Lists <- function( } +#' Retrieve dual species gene lists mitochondrial +#' +#' Returns vector of all mitochondrial genes across all species in dataset. +#' +#' @param seurat_object object name. +#' @param species Species of origin for given Seurat Object. Only accepted species are: mouse, human, +#' zebrafish, rat, drosophila, rhesus macaque, or chicken (name or abbreviation). +#' @param species_prefix the species prefix in front of gene symbols in object. +#' @param assay Assay to use (default is the current object default assay). +#' +#' @return vector of gene ids +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_Dual_Mito_Features <- function( + object, + species, + species_prefix, + assay +) { + # 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) + + # 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 + chicken_options <- accepted_names$Chicken_Options + + + mito_features_list <- lapply(1:length(x = species), function(x) { + if (species[x] %in% mouse_options) { + mito_pattern <- "mt-" + } + if (species[x] %in% human_options) { + mito_pattern <- "MT-" + } + if (species[x] %in% c(marmoset_options, macaque_options, chicken_options)) { + mito_features <- c("ATP6", "ATP8", "COX1", "COX2", "COX3", "CYTB", "ND1", "ND2", "ND3", "ND4", "ND4L", "ND5", "ND6") + } + if (species[x] %in% zebrafish_options) { + mito_pattern <- "mt-" + } + if (species[x] %in% rat_options) { + mito_pattern <- "Mt-" + } + if (species[x] %in% drosophila_options) { + mito_pattern <- "mt:" + } + + mito_pattern <- paste0("^", species_prefix[x], mito_pattern) + + mito_features <- grep(pattern = mito_pattern, x = rownames(x = object[[assay]]), value = TRUE) + + # Check features are present in object + length_mito_features <- length(x = intersect(x = mito_features, y = rownames(x = object[[assay]]))) + + # Check length of mito and ribo features found in object + if (length_mito_features < 1) { + cli_warn(message = c("No Mito features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") + ) + } + mito_features + }) + + # combine the lists + full_list <- unlist(x = mito_features_list) + + return(full_list) +} + + +#' Retrieve dual species gene lists ribosomal +#' +#' Returns vector of all ribosomal genes across all species in dataset. +#' +#' @param seurat_object object name. +#' @param species Species of origin for given Seurat Object. Only accepted species are: mouse, human, +#' zebrafish, rat, drosophila, rhesus macaque, or chicken (name or abbreviation). +#' @param species_prefix the species prefix in front of gene symbols in object. +#' @param assay Assay to use (default is the current object default assay). +#' +#' @return vector of gene ids +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_Dual_Ribo_Features <- function( + object, + species, + species_prefix, + assay = NULL +) { + # 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) + + # 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 + chicken_options <- accepted_names$Chicken_Options + + + ribo_features_list <- lapply(1:length(x = species), function(x) { + if (species[x] %in% mouse_options) { + ribo_pattern <- "Rp[sl]" + } + if (species[x] %in% human_options) { + ribo_pattern <- "RP[SL]" + } + if (species[x] %in% c(marmoset_options, macaque_options, chicken_options)) { + ribo_pattern <- "RP[SL]" + } + if (species[x] %in% zebrafish_options) { + ribo_pattern <- "rp[sl]" + } + if (species[x] %in% rat_options) { + ribo_pattern <- "Rp[sl]" + } + if (species[x] %in% drosophila_options) { + ribo_pattern <- "Rp[SL]" + } + + ribo_pattern <- paste0("^", species_prefix[x], ribo_pattern) + + ribo_features <- grep(pattern = ribo_pattern, x = rownames(x = object[[assay]]), value = TRUE) + + # Check features are present in object + length_ribo_features <- length(x = intersect(x = ribo_features, y = rownames(x = object[[assay]]))) + + # Check length of mito and ribo features found in object + if (length_ribo_features < 1) { + cli_warn(message = c("No Ribo features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") + ) + } + + ribo_features + }) + + # combine the lists + full_list <- unlist(x = ribo_features_list) + + return(full_list) +} + + #' Add MSigDB Gene Lists Percentages #' #' Adds percentage of counts from 3 hallmark MSigDB hallmark gene sets: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 70a68de498..5ba9519214 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -326,8 +326,10 @@ Add_Cell_QC_Metrics.Seurat <- function( #' 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. #' @param list_species_names returns list of all accepted values to use for default species names which -#' contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and -#' rhesus macaque). Default is FALSE. +#' contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and +#' chicken). Default is FALSE. +#' @param species_prefix the species prefix in front of gene symbols in object if providing two species for +#' multi-species aligned dataset. #' #' @import cli #' @importFrom dplyr mutate select intersect all_of @@ -364,6 +366,7 @@ Add_Mito_Ribo.Seurat <- function( assay = NULL, overwrite = FALSE, list_species_names = FALSE, + species_prefix = NULL, ... ) { # Accepted species names @@ -411,6 +414,11 @@ Add_Mito_Ribo.Seurat <- function( ) } + # Dual species checks + if (length(x = species) > 1 && length(x = species) != length(x = species_prefix)) { + cli_abort(message = "The length of {.code species} must be equal to length of {.code species_prefix}.") + } + # Set default assay assay <- assay %||% DefaultAssay(object = object) @@ -425,81 +433,93 @@ Add_Mito_Ribo.Seurat <- function( chicken_options <- accepted_names$Chicken_Options # Check ensembl vs patterns - if (isTRUE(x = ensembl_ids) && species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_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) && all(species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_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.") ) } # Assign mito/ribo pattern to stored species - if (species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_options) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern))) { + if (all(species %in% c(mouse_options, human_options, marmoset_options, zebrafish_options, rat_options, drosophila_options, chicken_options)) && any(!is.null(x = mito_pattern), !is.null(x = ribo_pattern))) { cli_warn(message = c("Pattern expressions for included species are set by default.", "*" = "Supplied {.code mito_pattern} and {.code ribo_pattern} will be disregarded.", "i" = "To override defaults please supply a feature list for mito and/or ribo genes.") ) } - if (species %in% mouse_options) { - mito_pattern <- "^mt-" - ribo_pattern <- "^Rp[sl]" - } - if (species %in% human_options) { - mito_pattern <- "^MT-" - ribo_pattern <- "^RP[SL]" - } - if (species %in% c(marmoset_options, macaque_options, chicken_options)) { - mito_features <- c("ATP6", "ATP8", "COX1", "COX2", "COX3", "CYTB", "ND1", "ND2", "ND3", "ND4", "ND4L", "ND5", "ND6") - ribo_pattern <- "^RP[SL]" - } - if (species %in% zebrafish_options) { - mito_pattern <- "^mt-" - ribo_pattern <- "^rp[sl]" - } - if (species %in% rat_options) { - mito_pattern <- "^Mt-" - ribo_pattern <- "^Rp[sl]" - } - if (species %in% drosophila_options) { - mito_pattern <- "^mt:" - ribo_pattern <- "^Rp[SL]" - } + if (length(x = species) == 1) { + if (species %in% mouse_options) { + mito_pattern <- "^mt-" + ribo_pattern <- "^Rp[sl]" + } + if (species %in% human_options) { + mito_pattern <- "^MT-" + ribo_pattern <- "^RP[SL]" + } + if (species %in% c(marmoset_options, macaque_options, chicken_options)) { + mito_features <- c("ATP6", "ATP8", "COX1", "COX2", "COX3", "CYTB", "ND1", "ND2", "ND3", "ND4", "ND4L", "ND5", "ND6") + ribo_pattern <- "^RP[SL]" + } + if (species %in% zebrafish_options) { + mito_pattern <- "^mt-" + ribo_pattern <- "^rp[sl]" + } + if (species %in% rat_options) { + mito_pattern <- "^Mt-" + ribo_pattern <- "^Rp[sl]" + } + if (species %in% drosophila_options) { + mito_pattern <- "^mt:" + ribo_pattern <- "^Rp[SL]" + } - # 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_features)) { - cli_abort(message = c("No features or patterns provided for mito/ribo genes.", - "i" = "Please provide a default species name or pattern/features.")) - } + # 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_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 (isTRUE(x = ensembl_ids)) { - mito_features <- Retrieve_Ensembl_Mito(species = species) - ribo_features <- Retrieve_Ensembl_Ribo(species = species) - } + # Retrieve ensembl ids if TRUE + if (isTRUE(x = ensembl_ids)) { + mito_features <- Retrieve_Ensembl_Mito(species = species) + ribo_features <- Retrieve_Ensembl_Ribo(species = species) + } - mito_features <- mito_features %||% grep(pattern = mito_pattern, x = rownames(x = object[[assay]]), value = TRUE) + mito_features <- mito_features %||% grep(pattern = mito_pattern, x = rownames(x = object[[assay]]), value = TRUE) - ribo_features <- ribo_features %||% grep(pattern = ribo_pattern, x = rownames(x = object[[assay]]), value = TRUE) + ribo_features <- ribo_features %||% grep(pattern = ribo_pattern, x = rownames(x = object[[assay]]), value = TRUE) - # Check features are present in object - length_mito_features <- length(x = intersect(x = mito_features, y = rownames(x = object[[assay]]))) + # Check features are present in object + length_mito_features <- length(x = intersect(x = mito_features, y = rownames(x = object[[assay]]))) - length_ribo_features <- length(x = intersect(x = ribo_features, y = rownames(x = object[[assay]]))) + length_ribo_features <- length(x = intersect(x = ribo_features, y = rownames(x = object[[assay]]))) - # Check length of mito and ribo features found in object - if (length_mito_features < 1 && length_ribo_features < 1) { - cli_abort(message = c("No Mito or Ribo features found in object using patterns/feature list provided.", - "i" = "Please check pattern/feature list and/or gene names in object.") - ) - } - if (length_mito_features < 1) { - cli_warn(message = c("No Mito features found in object using pattern/feature list provided.", - "i" = "No column will be added to meta.data.") - ) - } - if (length_ribo_features < 1) { - cli_warn(message = c("No Ribo features found in object using pattern/feature list provided.", - "i" = "No column will be added to meta.data.") - ) + # Check length of mito and ribo features found in object + if (length_mito_features < 1 && length_ribo_features < 1) { + cli_abort(message = c("No Mito or Ribo features found in object using patterns/feature list provided.", + "i" = "Please check pattern/feature list and/or gene names in object.") + ) + } + if (length_mito_features < 1) { + cli_warn(message = c("No Mito features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") + ) + } + if (length_ribo_features < 1) { + cli_warn(message = c("No Ribo features found in object using pattern/feature list provided.", + "i" = "No column will be added to meta.data.") + ) + } + } else { + # get dual species gene lists + mito_features <- Retrieve_Dual_Mito_Features(object = object, species = species, species_prefix = species_prefix, assay = assay) + + ribo_features <- Retrieve_Dual_Ribo_Features(object = object, species = species, species_prefix = species_prefix, assay = assay) + + # Check features are present in object + length_mito_features <- length(x = intersect(x = mito_features, y = rownames(x = object[[assay]]))) + + length_ribo_features <- length(x = intersect(x = ribo_features, y = rownames(x = object[[assay]]))) } # Add mito and ribo columns From d7a182fc5c9106f780d1c3e57f69dcacec3ecd9e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 15:46:26 -0400 Subject: [PATCH 341/503] update docs --- man/Add_Mito_Ribo.Rd | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/man/Add_Mito_Ribo.Rd b/man/Add_Mito_Ribo.Rd index b0f90cdcc0..09226782d8 100644 --- a/man/Add_Mito_Ribo.Rd +++ b/man/Add_Mito_Ribo.Rd @@ -39,6 +39,7 @@ Add_Mito_Ribo(object, ...) assay = NULL, overwrite = FALSE, list_species_names = FALSE, + species_prefix = NULL, ... ) } @@ -82,10 +83,13 @@ function will abort if columns with any one of the names provided to \code{mito_ \code{mito_ribo_name} is present in meta.data slot.} \item{list_species_names}{returns list of all accepted values to use for default species names which -contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and -rhesus macaque). Default is FALSE.} +contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and +chicken). Default is FALSE.} \item{assay}{Assay to use (default is the current object default assay).} + +\item{species_prefix}{the species prefix in front of gene symbols in object if providing two species for +multi-species aligned dataset.} } \value{ An object of the same class as \code{object} with columns added to object meta data. From 8346652a8fcb4b6c427fd61189f74bf96040a13e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 15:46:39 -0400 Subject: [PATCH 342/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c92bd4888d..b16cde83b0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9059 +Version: 2.1.2.9060 Date: 2024-05-09 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")), From b3c571ed5547f369888cf359e5aa9e0bc083b1cb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 16:05:39 -0400 Subject: [PATCH 343/503] update dimplot params for prop plot --- R/Seurat_Plotting.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 82aaa4253e..eee5025a85 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1614,6 +1614,12 @@ Cell_Highlight_Plot <- function( #' axes labels. (Default is FALSE). Requires `split_seurat = TRUE`. #' @param aspect_ratio Control the aspect ratio (y:x axes ratio length). Must be numeric value; #' Default is NULL. +#' @param add_prop_plot logical, whether to add plot to returned layout with the number of cells per identity +#' (or percent of cells per identity). Default is FALSE. +#' @param prop_plot_percent logical, if `add_prop_plot = TRUE` this parameter controls whether +#' proportion plot shows raw cell number or percent of cells per identity. Default is FALSE; plots raw cell number. +#' @param prop_plot_x_log logical, if `add_prop_plot = TRUE` this parameter controls whether to change x axis +#' to log10 scale (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 seed Sets the seed if randomly shuffling the order of points. @@ -1827,7 +1833,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1841,7 +1847,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot) @@ -1904,7 +1910,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot + Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) } return(plot) From d48c97538bc4f852a7e7a80d2c311287ce1fa91a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 16:05:47 -0400 Subject: [PATCH 344/503] update docs --- man/DimPlot_scCustom.Rd | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/man/DimPlot_scCustom.Rd b/man/DimPlot_scCustom.Rd index 6e91d25b74..35288d2c2a 100644 --- a/man/DimPlot_scCustom.Rd +++ b/man/DimPlot_scCustom.Rd @@ -58,6 +58,15 @@ axes labels. (Default is FALSE). Requires \code{split_seurat = TRUE}.} \item{aspect_ratio}{Control the aspect ratio (y:x axes ratio length). Must be numeric value; Default is NULL.} +\item{add_prop_plot}{logical, whether to add plot to returned layout with the number of cells per identity +(or percent of cells per identity). Default is FALSE.} + +\item{prop_plot_percent}{logical, if \code{add_prop_plot = TRUE} this parameter controls whether +proportion plot shows raw cell number or percent of cells per identity. Default is FALSE; plots raw cell number.} + +\item{prop_plot_x_log}{logical, if \code{add_prop_plot = TRUE} this parameter controls whether to change x axis +to log10 scale (Default is FALSE).} + \item{shuffle}{logical. Whether to randomly shuffle the order of points. This can be useful for crowded plots if points of interest are being buried. (Default is TRUE).} From 1127bdfebcce64c2cab514aaf5bc363aea2a9b04 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 16:05:55 -0400 Subject: [PATCH 345/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index b40e01c45a..632d803ffe 100644 --- a/NEWS.md +++ b/NEWS.md @@ -40,6 +40,7 @@ - Added ability of `Read_Metrics_10X` to read a single metrics csv file and return data formatted the same way as when reading multiple files. - Added parameter `cutoff_line_width` to the `QC_Plot_*` family of plots to control line thickness of cutoff lines. - `Cluster_Stats_All_Samples` now returns data.frame with row order reflecting the frequency of cells. +- `Add_Mito_Ribo` now supports datasets aligned to multi-species reference genomes ([#184](https://github.com/samuel-marsh/scCustomize/issues/184)). From 4b1ff261d9cc0216dce00877a2fd66931b978d32 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 16:06:59 -0400 Subject: [PATCH 346/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 632d803ffe..55dea7ba2b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -41,6 +41,7 @@ - Added parameter `cutoff_line_width` to the `QC_Plot_*` family of plots to control line thickness of cutoff lines. - `Cluster_Stats_All_Samples` now returns data.frame with row order reflecting the frequency of cells. - `Add_Mito_Ribo` now supports datasets aligned to multi-species reference genomes ([#184](https://github.com/samuel-marsh/scCustomize/issues/184)). +- Added parameter `add_prop_plot` to `DimPlot_scCustom` to return plot showing number or percent of cells per identity along with the DimPlot. From 8b3f42fc9f50540fb3b0439e2f9b7ead136272f0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 9 May 2024 16:07:14 -0400 Subject: [PATCH 347/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b16cde83b0..461ef94871 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9060 +Version: 2.1.2.9061 Date: 2024-05-09 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")), From 34c773133417dee0bde4e4b32d121a8d10669c73 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:19:16 -0400 Subject: [PATCH 348/503] add dual assay plot dual color option --- R/Seurat_Plotting.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index eee5025a85..9aee1afd2f 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -364,6 +364,7 @@ FeaturePlot_scCustom <- function( #' @param assay1 name of assay one. Default is "RAW" as featured in \code{\link{Create_CellBender_Merged_Seurat}} #' @param assay2 name of assay two Default is "RNA" as featured in \code{\link{Create_CellBender_Merged_Seurat}} #' @param colors_use list of colors or color palette to use. +#' @param colors_use_assay2 optional, a second color palette to use for the second assay. #' @param na_color color to use for points below lower limit. #' @param order whether to move positive cells to the top (default = TRUE). #' @param pt.size Adjust point size for plotting. @@ -410,6 +411,7 @@ FeaturePlot_DualAssay <- function( assay1 = "RAW", assay2 = "RNA", colors_use = viridis_plasma_dark_high, + colors_use_assay2 = NULL, na_color = "lightgray", order = TRUE, pt.size = NULL, @@ -479,15 +481,20 @@ FeaturePlot_DualAssay <- function( # Change assay and plot raw DefaultAssay(object = seurat_object) <- 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) + plot_assay1 <- 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, 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) + if (is.null(x = colors_use_assay2)) { + plot_assay2 <- 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) + } else { + plot_assay2 <- FeaturePlot_scCustom(seurat_object = seurat_object, features = features, layer = layer, colors_use = colors_use_assay2, 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) + plots <- wrap_plots(plot_assay1, plot_assay2, ncol = num_columns) # Aspect ratio changes if (!is.null(x = aspect_ratio)) { From 03a0f393b2e0ea503518d03c0404549d200ac56a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:19:42 -0400 Subject: [PATCH 349/503] update docs --- man/FeaturePlot_DualAssay.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/FeaturePlot_DualAssay.Rd b/man/FeaturePlot_DualAssay.Rd index b99eb025a4..1dbad50567 100644 --- a/man/FeaturePlot_DualAssay.Rd +++ b/man/FeaturePlot_DualAssay.Rd @@ -10,6 +10,7 @@ FeaturePlot_DualAssay( assay1 = "RAW", assay2 = "RNA", colors_use = viridis_plasma_dark_high, + colors_use_assay2 = NULL, na_color = "lightgray", order = TRUE, pt.size = NULL, @@ -37,6 +38,8 @@ FeaturePlot_DualAssay( \item{colors_use}{list of colors or color palette to use.} +\item{colors_use_assay2}{optional, a second color palette to use for the second assay.} + \item{na_color}{color to use for points below lower limit.} \item{order}{whether to move positive cells to the top (default = TRUE).} From ae4b1c913a6adbf529beca7d691dc41634fcb372 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:22:39 -0400 Subject: [PATCH 350/503] update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 55dea7ba2b..df1f19de0b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -42,6 +42,7 @@ - `Cluster_Stats_All_Samples` now returns data.frame with row order reflecting the frequency of cells. - `Add_Mito_Ribo` now supports datasets aligned to multi-species reference genomes ([#184](https://github.com/samuel-marsh/scCustomize/issues/184)). - Added parameter `add_prop_plot` to `DimPlot_scCustom` to return plot showing number or percent of cells per identity along with the DimPlot. +- Added optional parameter `colors_use_assay2` to `FeaturePlot_DualAssay` which allows for specification of different palettes for the two plots ([#182](https://github.com/samuel-marsh/scCustomize/issues/182)). @@ -69,7 +70,7 @@ - Fixed bug in `DimPlot_scCustom` that could cause blank plot when rasterizing points. - Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). - Fixed bugs in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0 and returned error if setting `group_by_var` to "ident". -- Replaced deprecated tidyr code .data[["var"]] with update `all_of`/`any_of` syntax. +- Replaced lingering instances of deprecated tidyr code .data[["var"]] with update `all_of`/`any_of` syntax. - Spelling and style fixes. Thanks @kew24. From 39e2ed6d328a1b439bdf98237a9c033e0c181f20 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:22:54 -0400 Subject: [PATCH 351/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 461ef94871..c2f5dd62d6 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" RRID:SCR_024675. -Version: 2.1.2.9061 -Date: 2024-05-09 +Version: 2.1.2.9062 +Date: 2024-05-10 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"), From 2be9cad9b715b84fc817c29d6a17e92fba03acec Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:35:24 -0400 Subject: [PATCH 352/503] Update cellbender dual assay plot vignette for 2.2.0 release --- vignettes/articles/Cell_Bender_Functions.Rmd | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/vignettes/articles/Cell_Bender_Functions.Rmd b/vignettes/articles/Cell_Bender_Functions.Rmd index 1485358014..5f75ff923a 100644 --- a/vignettes/articles/Cell_Bender_Functions.Rmd +++ b/vignettes/articles/Cell_Bender_Functions.Rmd @@ -286,3 +286,11 @@ Now let's plot normally astrocyte restricted gene. If Cell Bender has worked we ```{r echo=FALSE, fig.height=4, fig.width=10, fig.align='center'} FeaturePlot_DualAssay(seurat_object = astrocytes_cortex, features = "Gja1", assay1 = "RNA", assay2 = "RAW") ``` + +### Optional Parameters +`FeaturePlot_DualAssay` also contains optional parameter (`colors_use_assay2`) that allows for returning plots with different color palettes for each assay. +```{r echo=FALSE, fig.height=4, fig.width=10, fig.align='center'} +assay2_pal <- turbo(n = 20) + +FeaturePlot_DualAssay(seurat_object = astrocytes_cortex, features = "Gja1", assay1 = "RNA", assay2 = "RAW", colors_use_assay2 = assay2_pal) +``` From 8b35757f101668c4303465ed99d6817ae896e7e1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:35:40 -0400 Subject: [PATCH 353/503] Remove fully deprecated param --- R/Read_&_Write_Data.R | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/R/Read_&_Write_Data.R b/R/Read_&_Write_Data.R index 8b92afedc2..085c02b2d0 100644 --- a/R/Read_&_Write_Data.R +++ b/R/Read_&_Write_Data.R @@ -745,8 +745,6 @@ Read10X_Multi_Directory <- function( #' then use full file name. By default function uses Cell Ranger name: "filtered_feature_bc_matrix.h5". #' If h5 files have sample specific prefixes (i.e. from Cell Bender) then use only the shared part of file #' name (e.g., "_filtered_out.h5"). -#' @param cell_bender `r lifecycle::badge("deprecated")` CellBender read functions are now independent family of functions. -#' See `Read_CellBender_*` functions. #' @param sample_list a vector of sample directory names if only specific samples are desired. If `NULL` will #' read in subdirectories in parent directory. #' @param sample_names a set of sample names to use for each sample entry in returned list. If `NULL` will @@ -788,7 +786,6 @@ Read10X_h5_Multi_Directory <- function( default_10X_path = TRUE, cellranger_multi = FALSE, h5_filename = "filtered_feature_bc_matrix.h5", - cell_bender = deprecated(), sample_list = NULL, sample_names = NULL, replace_suffix = FALSE, @@ -798,16 +795,6 @@ Read10X_h5_Multi_Directory <- function( merge = FALSE, ... ) { - # Deprecated - if (lifecycle::is_present(cell_bender)) { - lifecycle::deprecate_stop(when = "1.1.2", - what = "Read10X_h5_Multi_Directory(cell_bender)", - with = "Read_CellBender_h5_Multi_Directory()", - details = c("v" = "CellBender read capabilities are now indepdent functions. See `Read_CellBender_h5_Multi_Directory`", - "i" = "Parameter and warning will be fully removed in v1.2.0.") - ) - } - # Confirm num_cores specified if (isTRUE(x = parallel) && is.null(x = num_cores)) { cli_abort("If {.code parallel = TRUE} then {.code num_cores} must be specified.") From a2b766cb71e533097109b3cab1cbc0c69459a124 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:40:55 -0400 Subject: [PATCH 354/503] move Gene_Present to deprecated warnings. --- R/Utilities.R | 164 -------------------------------------------------- 1 file changed, 164 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index f62eace279..be1b7a0b81 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -161,170 +161,6 @@ Feature_Present <- function( } - -#' Check if genes/features are present `r lifecycle::badge("soft-deprecated")` -#' -#' Check if genes are present in object and return vector of found genes. Return warning messages for -#' genes not found. -#' -#' @param data Name of input data. Currently only data of classes: Seurat, liger, data.frame, -#' dgCMatrix, dgTMatrix, tibble are accepted. Gene_IDs must be present in rownames of the data. -#' @param gene_list vector of genes to check. -#' @param case_check logical. Whether or not to check if features are found if the case is changed from the -#' input list (Sentence case to Upper and vice versa). Default is TRUE. -#' @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 print_msg logical. Whether message should be printed if all features are found. Default is TRUE. -#' @param omit_warn logical. Whether to print message about features that are not found in current object. -#' Default is TRUE. -#' @param return_none logical. Whether list of found vs. bad features should still be returned if no -#' features are found. Default is FALSE. -#' @param seurat_assay Name of assay to pull feature names from if `data` is Seurat Object. -#' Default is NULL which will check against features from all assays present. -#' -#' @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 -#' case was modified. -#' -#' @export -#' -#' @concept check_util -#' -#' @examples -#' \dontrun{ -#' features <- Gene_Present(data = obj_name, gene_list = DEG_list, print_msg = TRUE, case_check = TRUE) -#' found_features <- features[[1]] -#' } -#' - -Gene_Present <- function( - data, - gene_list, - case_check = TRUE, - case_check_msg = TRUE, - print_msg = TRUE, - omit_warn = TRUE, - return_none = FALSE, - seurat_assay = NULL -) { - lifecycle::deprecate_soft(when = "2.1.0", - what = "Gene_Present()", - with = "Feature_Present()", - details = c("i" = "Please adjust code now to prepare for full deprecation.") - ) - - # Check object type - # Seurat - accepted_types <- c("data.frame", "dgCMatrix", "dgTMatrix", "tibble") - if (inherits(x = data, what = "Seurat")) { - # set assay (if null set to active assay) - assays_present <- seurat_assay %||% Assays(object = data) - - possible_features <- lapply(assays_present, function(j) { - Features(x = data, assay = j) - }) - - possible_features <- unlist(possible_features) - } else if ((class(x = data)[[1]] == "liger")) { - # get complete gene list - length_liger <- length(x = data@raw.data) - - list_genes <- lapply(1:length_liger, function(x){ - rownames(x = data@raw.data[[x]]) - }) - - possible_features <- reduce(list_genes, function(x, y) { - union(x = x, y = y)}) - } else if ((class(x = data) %in% accepted_types)) { - possible_features <- rownames(x = data) - } else { - all_accepted <- c(accepted_types, "Seurat", "liger") - cli_abort(message = c("Input data is currently accepted only in the following formats:", - "i" = "{.field {glue_collapse_scCustom(input_string = all_accepted, and = FALSE)}}.") - ) - } - - # If any features not found - if (any(!gene_list %in% possible_features)) { - 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 (isTRUE(x = return_none)) { - # Combine into list and return - feature_list <- list( - found_features = NULL, - bad_features = bad_features, - wrong_case_found_features = NULL - ) - return(feature_list) - } else { - cli_abort(message ="No requested features found.") - } - } - - # Return message of features not found - 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 (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] - - sentence_bad_features <- str_to_sentence(string = bad_features) - sentence_found_features <- sentence_bad_features[sentence_bad_features %in% possible_features] - - # Combine case check - wrong_case_found_features <- c(upper_found_features, sentence_found_features) - - # Additional messages if found. - if (length(x = wrong_case_found_features) > 0) { - 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.") - ) - } - # Combine into list and return - feature_list <- list( - found_features = found_features, - bad_features = bad_features, - wrong_case_found_features = wrong_case_found_features - ) - return(feature_list) - } - } - # Combine into list and return - feature_list <- list( - found_features = found_features, - bad_features = bad_features, - wrong_case_found_features = "NA (check not performed. Set 'case_check = TRUE' to perform check." - ) - return(feature_list) - } - - # Print all found message if TRUE - if (isTRUE(x = print_msg)) { - cli_inform(message = "All features present.") - } - - # Return full input gene list. - # Combine into list and return - feature_list <- list( - found_features = gene_list, - bad_features = NULL, - wrong_case_found_features = NULL - ) - return(feature_list) -} - - #' Check for alternate case features # #' Checks Seurat object for the presence of features with the same spelling but alternate case. From 1321578c0bcedbe28d3c471f8096418b2d499360 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:42:09 -0400 Subject: [PATCH 355/503] Add additional message for full removal of deprecation errors (currently next major version). New full deprecations will now have this message with length of >=2 major versions going forward. --- R/Deprecated.R | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/R/Deprecated.R b/R/Deprecated.R index 4c685ab214..a6c6669d98 100644 --- a/R/Deprecated.R +++ b/R/Deprecated.R @@ -13,7 +13,7 @@ #' @rdname deprecated Split_FeatureScatter <- function(...) { - lifecycle::deprecate_stop(when = "2.0.0", what = "Split_FeatureScatter()", with = "FeatureScatter_scCustom()") + lifecycle::deprecate_stop(when = "2.0.0", what = "Split_FeatureScatter()", with = "FeatureScatter_scCustom()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -25,7 +25,7 @@ Split_FeatureScatter <- function(...) { #' @name deprecated Add_Mito_Ribo_Seurat <- function(...) { - lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Mito_Ribo_Seurat()", with = "Add_Mito_Ribo()") + lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Mito_Ribo_Seurat()", with = "Add_Mito_Ribo()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -37,7 +37,7 @@ Add_Mito_Ribo_Seurat <- function(...) { #' @rdname deprecated Add_Mito_Ribo_LIGER <- function(...) { - lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Mito_Ribo_LIGER()", with = "Add_Mito_Ribo()") + lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Mito_Ribo_LIGER()", with = "Add_Mito_Ribo()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -49,7 +49,7 @@ Add_Mito_Ribo_LIGER <- function(...) { #' @rdname deprecated Add_Cell_Complexity_Seurat <- function(...) { - lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Cell_Complexity_Seurat()", with = "Add_Cell_Complexity()") + lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Cell_Complexity_Seurat()", with = "Add_Cell_Complexity()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -61,7 +61,7 @@ Add_Cell_Complexity_Seurat <- function(...) { #' @rdname deprecated Add_Cell_Complexity_LIGER <- function(...) { - lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Cell_Complexity_LIGER()", with = "Add_Cell_Complexity()") + lifecycle::deprecate_stop(when = "2.1.0", what = "Add_Cell_Complexity_LIGER()", with = "Add_Cell_Complexity()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -73,7 +73,7 @@ Add_Cell_Complexity_LIGER <- function(...) { #' @rdname deprecated Meta_Present_LIGER <- function(...) { - lifecycle::deprecate_stop(when = "2.1.0", what = "Meta_Present_LIGER()", with = "Meta_Present()") + lifecycle::deprecate_stop(when = "2.1.0", what = "Meta_Present_LIGER()", with = "Meta_Present()", details = "Deprecation error when calling function will be removed in v2.3.0+") } @@ -85,5 +85,16 @@ Meta_Present_LIGER <- function(...) { #' @rdname deprecated Add_Top_Gene_Pct_Seurat <- function(...) { - lifecycle::deprecate_stop(when = "2.2.0", what = "Add_Top_Gene_Pct_Seurat()", with = "Add_Top_Gene_Pct()") + lifecycle::deprecate_stop(when = "2.2.0", what = "Add_Top_Gene_Pct_Seurat()", with = "Add_Top_Gene_Pct()", details = "Deprecation error when calling function will be removed in v2.4.0+") +} + +#' @description +#' Use [Feature_Present()] instead of `Gene_Present()`. +#' +#' @export +#' @keywords internal +#' @rdname deprecated + +Gene_Present <- function(...) { + lifecycle::deprecate_stop(when = "2.2.0", what = "Gene_Present()", with = "Feature_Present()", details = "Deprecation error when calling function will be removed in v2.3.0+") } From 92dc0776d45ae6d3e9253fcbf53a1c641e14ee6b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:42:55 -0400 Subject: [PATCH 356/503] remove deprecated param --- R/Utilities.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index be1b7a0b81..d0ca3b496e 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -231,7 +231,6 @@ Case_Check <- function( #' Return warning messages for meta data columns not found. #' #' @param object Seurat or Liger object name. -#' @param seurat_object `r lifecycle::badge("deprecated")` deprecated. Please use `object` instead. #' @param meta_col_names vector of column names to check. #' @param print_msg logical. Whether message should be printed if all features are found. Default is TRUE. #' @param omit_warn logical. Whether to print message about features that are not found in current object. Default is TRUE. @@ -254,22 +253,11 @@ Case_Check <- function( Meta_Present <- function( object, - seurat_object = deprecated(), meta_col_names, print_msg = TRUE, omit_warn = TRUE, return_none = FALSE ) { - # Check is slot is supplied - if (lifecycle::is_present(seurat_object)) { - lifecycle::deprecate_warn(when = "2.1.0", - what = "Meta_Present(seurat_object)", - with = "Meta_Present(object)", - details = c("!" = "Please adjust code now to prepare for full deprecation in v2.2.0.") - ) - - } - # Set possible variables based on object type possible_features <- colnames(x = Fetch_Meta(object = object)) From 79e17f3faa53b97338c23df6066c4d627469da2b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:44:06 -0400 Subject: [PATCH 357/503] update docs --- man/Gene_Present.Rd | 56 ------------------------------- man/Meta_Present.Rd | 3 -- man/Read10X_h5_Multi_Directory.Rd | 4 --- man/deprecated.Rd | 5 +++ 4 files changed, 5 insertions(+), 63 deletions(-) delete mode 100644 man/Gene_Present.Rd diff --git a/man/Gene_Present.Rd b/man/Gene_Present.Rd deleted file mode 100644 index ea8cddc9cd..0000000000 --- a/man/Gene_Present.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Utilities.R -\name{Gene_Present} -\alias{Gene_Present} -\title{Check if genes/features are present \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#soft-deprecated}{\figure{lifecycle-soft-deprecated.svg}{options: alt='[Soft-deprecated]'}}}{\strong{[Soft-deprecated]}}} -\usage{ -Gene_Present( - data, - gene_list, - case_check = TRUE, - case_check_msg = TRUE, - print_msg = TRUE, - omit_warn = TRUE, - return_none = FALSE, - seurat_assay = NULL -) -} -\arguments{ -\item{data}{Name of input data. Currently only data of classes: Seurat, liger, data.frame, -dgCMatrix, dgTMatrix, tibble are accepted. Gene_IDs must be present in rownames of the data.} - -\item{gene_list}{vector of genes to check.} - -\item{case_check}{logical. Whether or not to check if features are found if the case is changed from the -input list (Sentence case to Upper and vice versa). Default is TRUE.} - -\item{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.} - -\item{print_msg}{logical. Whether message should be printed if all features are found. Default is TRUE.} - -\item{omit_warn}{logical. Whether to print message about features that are not found in current object. -Default is TRUE.} - -\item{return_none}{logical. Whether list of found vs. bad features should still be returned if no -features are found. Default is FALSE.} - -\item{seurat_assay}{Name of assay to pull feature names from if \code{data} is Seurat Object. -Default is NULL which will check against features from all assays present.} -} -\value{ -A list of length 3 containing 1) found features, 2) not found features, 3) features found if -case was modified. -} -\description{ -Check if genes are present in object and return vector of found genes. Return warning messages for -genes not found. -} -\examples{ -\dontrun{ -features <- Gene_Present(data = obj_name, gene_list = DEG_list, print_msg = TRUE, case_check = TRUE) -found_features <- features[[1]] -} - -} -\concept{check_util} diff --git a/man/Meta_Present.Rd b/man/Meta_Present.Rd index a07bba23b0..b8b35ccb43 100644 --- a/man/Meta_Present.Rd +++ b/man/Meta_Present.Rd @@ -6,7 +6,6 @@ \usage{ Meta_Present( object, - seurat_object = deprecated(), meta_col_names, print_msg = TRUE, omit_warn = TRUE, @@ -16,8 +15,6 @@ Meta_Present( \arguments{ \item{object}{Seurat or Liger object name.} -\item{seurat_object}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} deprecated. Please use \code{object} instead.} - \item{meta_col_names}{vector of column names to check.} \item{print_msg}{logical. Whether message should be printed if all features are found. Default is TRUE.} diff --git a/man/Read10X_h5_Multi_Directory.Rd b/man/Read10X_h5_Multi_Directory.Rd index a0f1e4f6a1..cbc5c2add2 100644 --- a/man/Read10X_h5_Multi_Directory.Rd +++ b/man/Read10X_h5_Multi_Directory.Rd @@ -10,7 +10,6 @@ Read10X_h5_Multi_Directory( default_10X_path = TRUE, cellranger_multi = FALSE, h5_filename = "filtered_feature_bc_matrix.h5", - cell_bender = deprecated(), sample_list = NULL, sample_names = NULL, replace_suffix = FALSE, @@ -36,9 +35,6 @@ then use full file name. By default function uses Cell Ranger name: "filtered_f If h5 files have sample specific prefixes (i.e. from Cell Bender) then use only the shared part of file name (e.g., "_filtered_out.h5").} -\item{cell_bender}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} CellBender read functions are now independent family of functions. -See \verb{Read_CellBender_*} functions.} - \item{sample_list}{a vector of sample directory names if only specific samples are desired. If \code{NULL} will read in subdirectories in parent directory.} diff --git a/man/deprecated.Rd b/man/deprecated.Rd index bf44d17f60..c0f6d1a827 100644 --- a/man/deprecated.Rd +++ b/man/deprecated.Rd @@ -9,6 +9,7 @@ \alias{Add_Cell_Complexity_LIGER} \alias{Meta_Present_LIGER} \alias{Add_Top_Gene_Pct_Seurat} +\alias{Gene_Present} \title{Deprecated functions \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} \usage{ Split_FeatureScatter(...) @@ -24,6 +25,8 @@ Add_Cell_Complexity_LIGER(...) Meta_Present_LIGER(...) Add_Top_Gene_Pct_Seurat(...) + +Gene_Present(...) } \description{ Use \code{\link[=FeatureScatter_scCustom]{FeatureScatter_scCustom()}} instead of \code{Split_FeatureScatter()}. @@ -39,5 +42,7 @@ Use \code{\link[=Add_Cell_Complexity]{Add_Cell_Complexity()}} instead of \code{A Use \code{\link[=Meta_Present]{Meta_Present()}} instead of \code{Meta_Present_LIGER()}. Use \code{\link[=Add_Top_Gene_Pct]{Add_Top_Gene_Pct()}} instead of \code{Add_Top_Gene_Pct_Seurat()}. + +Use \code{\link[=Feature_Present]{Feature_Present()}} instead of \code{Gene_Present()}. } \keyword{internal} From 29ab1209e4d358c0ded2bcd3fc671c59326b037f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:45:29 -0400 Subject: [PATCH 358/503] remove deprecated parameters --- R/Seurat_Plotting.R | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 9aee1afd2f..dda0b23074 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -29,7 +29,6 @@ #' @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 `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. @@ -91,17 +90,6 @@ 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 = "FeaturePlot_scCustom(slot)", - with = "FeaturePlot_scCustom(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(object = seurat_object, meta_col_names = split.by, print_msg = FALSE, omit_warn = FALSE)[[1]] @@ -376,7 +364,6 @@ 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 `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` @@ -420,7 +407,6 @@ FeaturePlot_DualAssay <- function( na_cutoff = 0.000000001, raster = NULL, raster.dpi = c(512, 512), - slot = deprecated(), layer = "data", num_columns = NULL, alpha_exp = NULL, @@ -430,17 +416,6 @@ FeaturePlot_DualAssay <- 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 = "FeaturePlot_DualAssay(slot)", - with = "FeaturePlot_DualAssay(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]] From 95f1361b121752a8a8b423ffe6fb682c92f3bf50 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:45:57 -0400 Subject: [PATCH 359/503] update docs --- man/FeaturePlot_DualAssay.Rd | 3 --- man/FeaturePlot_scCustom.Rd | 2 -- 2 files changed, 5 deletions(-) diff --git a/man/FeaturePlot_DualAssay.Rd b/man/FeaturePlot_DualAssay.Rd index 1dbad50567..d32aecabbd 100644 --- a/man/FeaturePlot_DualAssay.Rd +++ b/man/FeaturePlot_DualAssay.Rd @@ -19,7 +19,6 @@ FeaturePlot_DualAssay( na_cutoff = 1e-09, raster = NULL, raster.dpi = c(512, 512), - slot = deprecated(), layer = "data", num_columns = NULL, alpha_exp = NULL, @@ -59,8 +58,6 @@ greater than 200,000 cells.} \item{raster.dpi}{Pixel resolution for rasterized plots, passed to geom_scattermore(). Default is c(512, 512).} -\item{slot}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} soft-deprecated. See \code{layer}} - \item{layer}{Which layer to pull expression data from? Default is "data".} \item{num_columns}{Number of columns in plot layout. If number of features > 1 then \code{num_columns} diff --git a/man/FeaturePlot_scCustom.Rd b/man/FeaturePlot_scCustom.Rd index 10706c8b29..252a4efd6d 100644 --- a/man/FeaturePlot_scCustom.Rd +++ b/man/FeaturePlot_scCustom.Rd @@ -68,8 +68,6 @@ axes labels. (Default is FALSE). Requires \code{split_seurat = TRUE}.} \item{num_columns}{Number of columns in plot layout.} -\item{slot}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} soft-deprecated. See \code{layer}} - \item{layer}{Which layer to pull expression data from? Default is "data".} \item{alpha_exp}{new alpha level to apply to expressing cell color palette (\code{colors_use}). Must be From 5ce415a9616c35ac216fba2e539b0fb32c6ab76f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:47:47 -0400 Subject: [PATCH 360/503] remove deprecated parameters --- R/Seurat_Iterative_Plotting.R | 26 -------------------------- 1 file changed, 26 deletions(-) diff --git a/R/Seurat_Iterative_Plotting.R b/R/Seurat_Iterative_Plotting.R index 47cce6caba..47170ff23d 100644 --- a/R/Seurat_Iterative_Plotting.R +++ b/R/Seurat_Iterative_Plotting.R @@ -826,7 +826,6 @@ Iterate_Meta_Highlight_Plot <- function( #' @param seurat_object Seurat object name. #' @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`. @@ -879,7 +878,6 @@ Iterate_Meta_Highlight_Plot <- function( Iterate_FeaturePlot_scCustom <- function( seurat_object, features, - gene_list = deprecated(), colors_use = viridis_plasma_dark_high, na_color = "lightgray", na_cutoff = 0.000000001, @@ -901,17 +899,6 @@ Iterate_FeaturePlot_scCustom <- function( alpha_na_exp = NULL, ... ) { - # Deprecation warning - if (lifecycle::is_present(gene_list)) { - lifecycle::deprecate_warn(when = "2.0.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)) @@ -1187,7 +1174,6 @@ Iterate_FeaturePlot_scCustom <- function( #' #' @param seurat_object Seurat object name. #' @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`. @@ -1247,18 +1233,6 @@ 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) From b66befe8b01a4fdb271d626a34618ea5d2f36d90 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:47:58 -0400 Subject: [PATCH 361/503] Update docs --- man/Iterate_FeaturePlot_scCustom.Rd | 3 --- man/Iterate_VlnPlot_scCustom.Rd | 2 -- 2 files changed, 5 deletions(-) diff --git a/man/Iterate_FeaturePlot_scCustom.Rd b/man/Iterate_FeaturePlot_scCustom.Rd index 91056cff6e..95204b28d3 100644 --- a/man/Iterate_FeaturePlot_scCustom.Rd +++ b/man/Iterate_FeaturePlot_scCustom.Rd @@ -7,7 +7,6 @@ Iterate_FeaturePlot_scCustom( seurat_object, features, - gene_list = deprecated(), colors_use = viridis_plasma_dark_high, na_color = "lightgray", na_cutoff = 1e-09, @@ -36,8 +35,6 @@ Iterate_FeaturePlot_scCustom( \item{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 \code{single_pdf = TRUE} or into file name if \code{FALSE}.} -\item{gene_list}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} soft-deprecated. See \code{features}.} - \item{colors_use}{color scheme to use.} \item{na_color}{color for non-expressed cells.} diff --git a/man/Iterate_VlnPlot_scCustom.Rd b/man/Iterate_VlnPlot_scCustom.Rd index 325cd8d4b1..0308ffc31c 100644 --- a/man/Iterate_VlnPlot_scCustom.Rd +++ b/man/Iterate_VlnPlot_scCustom.Rd @@ -28,8 +28,6 @@ Iterate_VlnPlot_scCustom( \item{features}{vector of features to plot.} -\item{gene_list}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} soft-deprecated. See \code{features}.} - \item{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 \code{DiscretePalette_scCustomize}.} From 7fbdcb8d039c7696e0534df2ba4ff411395d77eb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:48:45 -0400 Subject: [PATCH 362/503] remove deprecated parameters --- R/Statistics.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/R/Statistics.R b/R/Statistics.R index a4a01f23bc..506e4c9d70 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -93,7 +93,6 @@ 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 `r lifecycle::badge("deprecated")` soft-deprecated. See `layer` #' @param layer Which layer to pull expression data from? Default is "data". #' #' @return A data.frame @@ -128,17 +127,6 @@ Percent_Expressing <- 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 = "Percent_Expressing(slot)", - with = "Percent_Expressing(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) From 23c9e94ccf691455256cce3ce7709223c52c9be8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:49:11 -0400 Subject: [PATCH 363/503] update docs --- man/Percent_Expressing.Rd | 2 -- 1 file changed, 2 deletions(-) diff --git a/man/Percent_Expressing.Rd b/man/Percent_Expressing.Rd index 6749712d3e..6d56e62a9c 100644 --- a/man/Percent_Expressing.Rd +++ b/man/Percent_Expressing.Rd @@ -30,8 +30,6 @@ Percent_Expressing( \item{entire_object}{logical (default = FALSE). Whether to calculate percent of expressing cells across the entire object as opposed to by cluster or by \code{group_by} variable.} -\item{slot}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} soft-deprecated. See \code{layer}} - \item{layer}{Which layer to pull expression data from? Default is "data".} \item{assay}{Assay to pull feature data from. Default is active assay.} From 20ca58a94942f31503cc603eb2dc1e694553984b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 08:51:40 -0400 Subject: [PATCH 364/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2f5dd62d6..6b157e273b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9062 +Version: 2.1.2.9063 Date: 2024-05-10 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")), From 079eeaae908b36459549f7f6829ffa0087940e0b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 10:33:42 -0400 Subject: [PATCH 365/503] update warning --- R/Object_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 5ba9519214..07e214bb1e 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -263,8 +263,8 @@ Add_Cell_QC_Metrics.Seurat <- function( # Add cell cycle 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." + cli_warn(message = c("x" = "Cell Cycle Scoring is only supported for human in this function.", + "i" = "To add score for other species, use {.code Seurat::CellCycleScoring} function separately with correct species cell cycle gene list." )) } else { cli_inform(message = c("*" = "Adding {.field Cell Cycle Scoring} to meta.data.")) From b977023b3f0f50e4ab575fbf621a488b7d15f1c5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 10:36:07 -0400 Subject: [PATCH 366/503] fix warning --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 07e214bb1e..746ce5bbcd 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -263,7 +263,7 @@ Add_Cell_QC_Metrics.Seurat <- function( # Add cell cycle if (isTRUE(x = add_cell_cycle)) { if (!species %in% human_options) { - cli_warn(message = c("x" = "Cell Cycle Scoring is only supported for human in this function.", + cli_warn(message = c("!" = "Cell Cycle Scoring is only supported for human in this function.", "i" = "To add score for other species, use {.code Seurat::CellCycleScoring} function separately with correct species cell cycle gene list." )) } else { From 6cbfb179977eb442a3d2ef54f9a91495e3070780 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 10:38:58 -0400 Subject: [PATCH 367/503] revert to x --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 746ce5bbcd..07e214bb1e 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -263,7 +263,7 @@ Add_Cell_QC_Metrics.Seurat <- function( # Add cell cycle if (isTRUE(x = add_cell_cycle)) { if (!species %in% human_options) { - cli_warn(message = c("!" = "Cell Cycle Scoring is only supported for human in this function.", + cli_warn(message = c("x" = "Cell Cycle Scoring is only supported for human in this function.", "i" = "To add score for other species, use {.code Seurat::CellCycleScoring} function separately with correct species cell cycle gene list." )) } else { From 59da39c1b2cbcfb03f0d81173c14c4e465e3ee43 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 11:00:12 -0400 Subject: [PATCH 368/503] fix return --- R/Statistics.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/Statistics.R b/R/Statistics.R index 506e4c9d70..f6cb9287d1 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -78,6 +78,8 @@ Cluster_Stats_All_Samples <- function( # Merge percent cells per metadata column per cluster with cluster stats and add Totals column cluster_stats <- suppressMessages(left_join(cluster_stats_2, percent_per_cluster_2)) %>% adorn_totals("row") + + return(cluster_stats) } From df2069280580a57bd16112449282e9c0ac5a4644 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:06:12 -0400 Subject: [PATCH 369/503] fix prop plot --- R/Seurat_Plotting.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index dda0b23074..a5f9681239 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1759,9 +1759,9 @@ DimPlot_scCustom <- function( # prop plot colors if (isTRUE(x = add_prop_plot)) { if (is.null(x = group.by)) { - ident_levels <- levels(x = Idents(object = pbmc)) + ident_levels <- levels(x = Idents(object = seurat_object)) } else { - meta <- Fetch_Meta(pbmc) + meta <- Fetch_Meta(seurat_object) if (is.factor(x = meta[,group.by])) { ident_levels <- levels(x = meta[,group.by]) } else { From 26583e1c69daaaba29348a61ff2cd9378ce348c2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:32:20 -0400 Subject: [PATCH 370/503] prop label --- R/Plotting_Utilities.R | 12 +++++++++++- R/Seurat_Plotting.R | 12 +++++++----- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index b5d31d003c..5aa39ca878 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -355,6 +355,7 @@ scCustomze_Split_FeatureScatter <- function( #' total cells, default is FALSE; plot total number. #' @param colors_use named vector of colors or hex values. Names must match levels of `group.by`. #' @param x_axis_log logical, whether to plot x-axis in log10 scale, default is FALSE. +#' @param prop_label logical, whether to add label to each bar with total number of cells, default is FALSE. #' #' @return ggplot2 plot #' @@ -374,7 +375,8 @@ Overall_Prop_Plot <- function( group.by = NULL, percent = FALSE, colors_use, - x_axis_log = FALSE + x_axis_log = FALSE, + prop_label = FALSE ) { # Set active ident if (!is.null(x = group.by) && group.by != "ident") { @@ -417,6 +419,14 @@ Overall_Prop_Plot <- function( plot <- plot + scale_x_log10() } + if (isTRUE(x = prop_label)) { + if (isFALSE(x = percent)) { + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + } else { + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(.data[["Freq"]]), "%"), hjust = -0.5, fontface = "bold")) + } + } + return(plot) } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index a5f9681239..7ce728f48f 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1602,6 +1602,7 @@ Cell_Highlight_Plot <- function( #' proportion plot shows raw cell number or percent of cells per identity. Default is FALSE; plots raw cell number. #' @param prop_plot_x_log logical, if `add_prop_plot = TRUE` this parameter controls whether to change x axis #' to log10 scale (Default is FALSE). +#' @param prop_plot_label logical, if `add_prop_plot = TRUE` this parameter controls whether to label the bars with total number of cells or percentages; 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 seed Sets the seed if randomly shuffling the order of points. @@ -1657,6 +1658,7 @@ DimPlot_scCustom <- function( add_prop_plot = FALSE, prop_plot_percent = FALSE, prop_plot_x_log = FALSE, + prop_plot_label = FALSE, shuffle = TRUE, seed = 1, label = NULL, @@ -1815,7 +1817,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log, prop_label = prop_plot_label) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1829,7 +1831,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log, prop_label = prop_plot_label) + plot_layout(widths = c(1, 0.5)) } return(plot) @@ -1878,7 +1880,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot_figure <- plot_figure | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log, prop_label = prop_plot_label) + plot_layout(widths = c(1, 0.5)) } return(plot_figure) @@ -1892,7 +1894,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plot <- plot | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log, prop_label = prop_plot_label) + plot_layout(widths = c(1, 0.5)) } return(plot) @@ -1971,7 +1973,7 @@ DimPlot_scCustom <- function( } if (isTRUE(x = add_prop_plot)) { - plots <- plots | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log) + plot_layout(widths = c(1, 0.5)) + plots <- plots | Overall_Prop_Plot(seurat_object = seurat_object, group.by = group.by, percent = prop_plot_percent, colors_use = prop_colors_use, x_axis_log = prop_plot_x_log, prop_label = prop_plot_label) + plot_layout(widths = c(1, 0.5)) } return(plots) From adab84c6af49bf4a5534120d823e840bc1db38a0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:32:30 -0400 Subject: [PATCH 371/503] update docs --- man/DimPlot_scCustom.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/DimPlot_scCustom.Rd b/man/DimPlot_scCustom.Rd index 35288d2c2a..8578afeed7 100644 --- a/man/DimPlot_scCustom.Rd +++ b/man/DimPlot_scCustom.Rd @@ -17,6 +17,7 @@ DimPlot_scCustom( add_prop_plot = FALSE, prop_plot_percent = FALSE, prop_plot_x_log = FALSE, + prop_plot_label = FALSE, shuffle = TRUE, seed = 1, label = NULL, @@ -67,6 +68,8 @@ proportion plot shows raw cell number or percent of cells per identity. Default \item{prop_plot_x_log}{logical, if \code{add_prop_plot = TRUE} this parameter controls whether to change x axis to log10 scale (Default is FALSE).} +\item{prop_plot_label}{logical, if \code{add_prop_plot = TRUE} this parameter controls whether to label the bars with total number of cells or percentages; Default is FALSE.} + \item{shuffle}{logical. Whether to randomly shuffle the order of points. This can be useful for crowded plots if points of interest are being buried. (Default is TRUE).} From 9f363f39d1917728f8c26710d8f73916227c663e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:40:22 -0400 Subject: [PATCH 372/503] fix cutoff values --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 5aa39ca878..64aa31eb11 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -421,9 +421,9 @@ Overall_Prop_Plot <- function( if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { - plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = c(0.05, 0)) } else { - plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(.data[["Freq"]]), "%"), hjust = -0.5, fontface = "bold")) + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = c(0.05, 0)) } } From 1fc090ed7a6ff14ac68ff9b11dad7f807a98a2f4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:43:05 -0400 Subject: [PATCH 373/503] expand futher --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 64aa31eb11..dd8ebe6c39 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -421,9 +421,9 @@ Overall_Prop_Plot <- function( if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { - plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = c(0.05, 0)) + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = c(0.1, 0)) } else { - plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = c(0.05, 0)) + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = c(0.1, 0)) } } From b59a40094e9260a229cfa822ad1a1d00d45e783e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:44:53 -0400 Subject: [PATCH 374/503] change expansion --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index dd8ebe6c39..60ebe0b6e3 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -421,9 +421,9 @@ Overall_Prop_Plot <- function( if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { - plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = c(0.1, 0)) + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .1))) } else { - plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = c(0.1, 0)) + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = expansion(mult = c(0, .1))) } } From 647a04f5a2c8842b15d70a30212790790752c031 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:48:48 -0400 Subject: [PATCH 375/503] expand more --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 60ebe0b6e3..7b71f09585 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -421,9 +421,9 @@ Overall_Prop_Plot <- function( if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { - plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .1))) + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .25))) } else { - plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = expansion(mult = c(0, .1))) + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = expansion(mult = c(0, .25))) } } From e54cfba475845d8fab8dbf8ade8c11299f386992 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 15:54:08 -0400 Subject: [PATCH 376/503] fixing overlap --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 7b71f09585..c5061d721f 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -421,9 +421,9 @@ Overall_Prop_Plot <- function( if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { - plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.5, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .25))) + plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.1, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .25))) } else { - plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.5, fontface = "bold")) + scale_x_continuous(expand = expansion(mult = c(0, .25))) + plot <- plot + geom_text(data = fil_stats, aes(label = paste0(format(round(.data[["Freq"]], digits = 1)), "%"), hjust = -0.1, fontface = "bold")) + scale_x_continuous(expand = expansion(mult = c(0, .25))) } } From e23ca06718a59afae594ea41594c888366f41fe2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 10 May 2024 16:06:31 -0400 Subject: [PATCH 377/503] move log10 change --- R/Plotting_Utilities.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index c5061d721f..7a505cb957 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -414,11 +414,6 @@ Overall_Prop_Plot <- function( NoLegend() } - # mod x axis if needed - if (isTRUE(x = x_axis_log)) { - plot <- plot + scale_x_log10() - } - if (isTRUE(x = prop_label)) { if (isFALSE(x = percent)) { plot <- plot + geom_text(data = fil_stats, aes(label = .data[["Number"]]), hjust = -0.1, fontface = "bold") + scale_x_continuous(expand = expansion(mult = c(0, .25))) @@ -427,6 +422,11 @@ Overall_Prop_Plot <- function( } } + # mod x axis if needed + if (isTRUE(x = x_axis_log)) { + plot <- plot + scale_x_log10(expand = expansion(mult = c(0, .25))) + } + return(plot) } From b1fab2911b295d2dbec29bdb1b9b1ddd7844bcba Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 16 May 2024 09:01:51 -0400 Subject: [PATCH 378/503] update code to appropriate internals --- R/Utilities.R | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index d0ca3b496e..29f3cdd4de 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -417,34 +417,34 @@ Reduction_Loading_Present <- function( # If any features not found if (any(!reduction_names %in% possible_reduction_names)) { - bad_features <- reduction_names[!reduction_names %in% possible_reduction_names] - found_features <- reduction_names[reduction_names %in% possible_reduction_names] - if (length(x = found_features) == 0) { + bad_reductions <- reduction_names[!reduction_names %in% possible_reduction_names] + found_reductions <- reduction_names[reduction_names %in% possible_reduction_names] + if (length(x = found_reductions) == 0) { if (isTRUE(x = return_none)) { # Combine into list and return - feature_list <- list( - found_features = NULL, - bad_features = bad_features + reduction_list <- list( + found_reductions = NULL, + bad_reductions = bad_reductions ) - return(feature_list) + return(reduction_list) } else { cli_abort(message ="No requested features found.") } } # Return message of features not found - if (length(x = bad_features) > 0 && isTRUE(x = omit_warn)) { + if (length(x = bad_reductions) > 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)}}") ) } # Combine into list and return - feature_list <- list( - found_features = found_features, - bad_features = bad_features + reduction_list <- list( + found_reductions = found_reductions, + bad_reductions = bad_reductions ) - return(feature_list) + return(reduction_list) } # Print all found message if TRUE @@ -454,11 +454,11 @@ Reduction_Loading_Present <- function( # Return full input gene list. # Combine into list and return - feature_list <- list( - found_features = reduction_names, - bad_features = NULL + reduction_list <- list( + found_reductions = reduction_names, + bad_reductions = NULL ) - return(feature_list) + return(reduction_list) } From e75e567ca1d4e8b28b81c2650c020f735f90ea08 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 16 May 2024 09:03:54 -0400 Subject: [PATCH 379/503] replace incorrect example code --- R/Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index 29f3cdd4de..97238bf2af 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -384,7 +384,7 @@ Meta_Numeric <- function( #' @examples #' \dontrun{ #' reductions <- Reduction_Loading_Present(seurat_object = obj_name, reduction_name = "PC_1") -#' found_features <- features[[1]] +#' found_reductions <- reductions[[1]] #' } #' From 77ed29329c6012a6d9ca3fe66358609547d9ccea Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 24 May 2024 14:24:17 -0400 Subject: [PATCH 380/503] fix case check manual --- R/Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index 97238bf2af..8b0a378962 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -162,7 +162,7 @@ Feature_Present <- function( #' Check for alternate case features -# +#' #' Checks Seurat object for the presence of features with the same spelling but alternate case. #' #' @param seurat_object Seurat object name. From 2e81c00349e03a7006ddc307f7b117765780555e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 24 May 2024 16:47:15 -0400 Subject: [PATCH 381/503] update docs --- man/Case_Check.Rd | 4 +--- man/Reduction_Loading_Present.Rd | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/man/Case_Check.Rd b/man/Case_Check.Rd index 3366c12665..7efb36b584 100644 --- a/man/Case_Check.Rd +++ b/man/Case_Check.Rd @@ -2,8 +2,7 @@ % Please edit documentation in R/Utilities.R \name{Case_Check} \alias{Case_Check} -\title{Check for alternate case features -Checks Seurat object for the presence of features with the same spelling but alternate case.} +\title{Check for alternate case features} \usage{ Case_Check( seurat_object, @@ -30,7 +29,6 @@ If features found returns vector of found alternate case features and prints mes parameters specified. } \description{ -Check for alternate case features Checks Seurat object for the presence of features with the same spelling but alternate case. } \examples{ diff --git a/man/Reduction_Loading_Present.Rd b/man/Reduction_Loading_Present.Rd index df976fa035..cc9d0e8e3a 100644 --- a/man/Reduction_Loading_Present.Rd +++ b/man/Reduction_Loading_Present.Rd @@ -35,7 +35,7 @@ warning messages for genes not found. \examples{ \dontrun{ reductions <- Reduction_Loading_Present(seurat_object = obj_name, reduction_name = "PC_1") -found_features <- features[[1]] +found_reductions <- reductions[[1]] } } From 4e2dea696ad9a4156d76dd5436d22539c4b8a653 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:14:38 -0400 Subject: [PATCH 382/503] update build ignore --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index a0a7ebaa8b..d5393a8d21 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,4 @@ vignettes/*.orig$ ^README\.Rmd$ ^cran-comments\.md$ ^CRAN-SUBMISSION$ +^data-raw$ From ee84b177ade9766d6a8aecfcc964abc2c7fc1c34 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:35:03 -0400 Subject: [PATCH 383/503] Create data-raw and add scripts for generation of package data --- ...e_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R | 159 ++++++++ .../Create_msigdb_Gene_Lists_scCustomize.R | 362 ++++++++++++++++++ 2 files changed, 521 insertions(+) create mode 100644 R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R create mode 100644 data-raw/Create_msigdb_Gene_Lists_scCustomize.R diff --git a/R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R b/R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R new file mode 100644 index 0000000000..a1a0c71579 --- /dev/null +++ b/R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R @@ -0,0 +1,159 @@ +# Code and functions to create the lists of ensembl IDs for mitochondrial and ribosomal genes + + +# Functions ----------------------------------------------------------------------------------- +library(tidyverse) +library(AnnotationHub) + +Create_Ensembl_Ribo_List <- function( +) { + + refreshHub(hubClass="AnnotationHub") + + species_list <- c("Mus musculus", "Homo sapiens", "Callithrix jacchus", "Danio rerio", "Rattus norvegicus", "Drosophila melanogaster", "Macaca mulatta", "Gallus gallus") + ribo_pattern_list <- c("^Rp[sl]", "^RP[SL]", "^RP[SL]", "^rp[sl]", "^Rp[sl]", "^Rp[SL]", "^RP[SL]", "^RP[SL]") + + ah <- AnnotationHub() + + ribo_list <- lapply(1:length(x = species_list), function(x){ + + cli::cli_inform("Retrieving ensembl ID for {species_list[x]}") + # Access the Ensembl database for organism + ahDb <- query(ah, + pattern = c(species_list[x], "EnsDb"), + ignore.case = TRUE) + + # Check versions of databases available + ahDb %>% + mcols() + + + # Acquire the latest annotation files + id <- ahDb %>% + mcols() %>% + rownames() %>% + tail(n = 1) + + # Download the appropriate Ensembldb database + edb <- ah[[id]] + + + # Extract gene-level information from database + annotations <- genes(edb, + return.type = "data.frame") + + + # Select annotations of interest + annotations <- annotations %>% + dplyr::select(gene_id, gene_name, gene_biotype, seq_name, description, entrezid) + + ribo_ids <- annotations %>% + dplyr::filter(str_detect(string = gene_name, pattern = ribo_pattern_list[x]), gene_biotype != "LRG_gene") %>% + dplyr::pull(gene_id) + + + cli::cli_alert("Complete") + return(ribo_ids) + + }) + + names(ribo_list) <- paste0(gsub(pattern = " ", replacement = "_", x = species_list), "_ribo_ensembl") + + return(ribo_list) +} + + +Create_Ensembl_Mito_List <- function( +) { + + refreshHub(hubClass="AnnotationHub") + + species_list <- c("Mus musculus", "Homo sapiens", "Danio rerio", "Rattus norvegicus", "Drosophila melanogaster", "Macaca mulatta", "Gallus gallus") + + ah <- AnnotationHub() + + mito_list <- lapply(species_list, function(x){ + + cli::cli_inform("Retrieving ensembl ID for {x}") + # Access the Ensembl database for organism + ahDb <- query(ah, + pattern = c(x, "EnsDb"), + ignore.case = TRUE) + + # Check versions of databases available + ahDb %>% + mcols() + + + # Acquire the latest annotation files + id <- ahDb %>% + mcols() %>% + rownames() %>% + tail(n = 1) + + # Download the appropriate Ensembldb database + edb <- ah[[id]] + + + # Extract gene-level information from database + annotations <- genes(edb, + return.type = "data.frame") + + + # Select annotations of interest + annotations <- annotations %>% + dplyr::select(gene_id, gene_name, gene_biotype, seq_name, description, entrezid) + + if (x == "Drosophila melanogaster") { + mito_ids <- annotations %>% + dplyr::filter(seq_name == "mitochondrion_genome") %>% + dplyr::pull(gene_id) + } else { + mito_ids <- annotations %>% + dplyr::filter(seq_name == "MT") %>% + dplyr::pull(gene_id) + } + + cli::cli_alert("Complete") + return(mito_ids) + + + }) + + names(mito_list) <- paste0(gsub(pattern = " ", replacement = "_", x = species_list), "_mito_ensembl") + + return(mito_list) +} + + +# Create & Save Lists ------------------------------------------------------------------------- +ensembl_mito_id <- Create_Ensembl_Mito_List() + +save(ensembl_mito_id, file = "data/ensembl_mito_id.rda") + +ensembl_ribo_id <- Create_Ensembl_Ribo_List() + +save(ensembl_ribo_id, file = "data/ensembl_ribo_id.rda") + + + +# Deprecated Code ----------------------------------------------------------------------------- +# OLD MARMOSET VERSION +# library(biomaRt) +# mart <- useMart(biomart = "ensembl", dataset = "cjacchus_gene_ensembl") +# listDatasets(mart = mart) +# attributes <- c("ensembl_gene_id", "entrezgene_id", "external_gene_name", "chromosome_name", "start_position", "end_position", "strand", "gene_biotype", "description") +# +# marmoset_ensembl_ids <- getBM(attributes = attributes, mart = mart) +# +# dplyr::filter(str_detect(string = gene_name, pattern = ribo_pattern_list[2]), gene_biotype != "LRG_gene") +# +# marmoset_ribo_ids <- marmoset_ensembl_ids %>% +# filter(str_detect(string = external_gene_name, pattern = "^RP[SL]"), gene_biotype != "LRG_gene") %>% +# dplyr::pull(ensembl_gene_id) +# +# +# ensembl_ribo_id[["Callithrix_jacchus_ribo_ensembl"]] <- marmoset_ribo_ids + + + diff --git a/data-raw/Create_msigdb_Gene_Lists_scCustomize.R b/data-raw/Create_msigdb_Gene_Lists_scCustomize.R new file mode 100644 index 0000000000..61539133a4 --- /dev/null +++ b/data-raw/Create_msigdb_Gene_Lists_scCustomize.R @@ -0,0 +1,362 @@ +# Instructions for creation of package msigdb gene lists + + +# Create Gene Symbol Lists -------------------------------------------------------------------- +library(dplyr) +library(msigdbr) + +msigdbr_species() + +msig_dbr <- msigdbr(species = "Homo sapiens", category = "H") + +msig_oxphos_direct <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_apoptosis_direct <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_DNA_repair_direct <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + + + +msig_mouse_dbr <- msigdbr(species = "Mus musculus", category = "H") + +msig_mouse_oxphos_direct <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_mouse_apoptosis_direct <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_mouse_DNA_repair_direct <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + +# zebrafish +msig_zebra_dbr <- msigdbr(species = "Danio rerio", category = "H") + +msig_zebra_oxphos_direct <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_zebra_apoptosis_direct <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_zebra_DNA_repair_direct <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + +# rat +msig_rat_dbr <- msigdbr(species = "Rattus norvegicus", category = "H") + +msig_rat_oxphos_direct <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_rat_apoptosis_direct <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_rat_DNA_repair_direct <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + + +# fly +msig_fly_dbr <- msigdbr(species = "Drosophila melanogaster", category = "H") + +msig_fly_oxphos_direct <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_fly_apoptosis_direct <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_fly_DNA_repair_direct <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + +# macaque +msig_macaque_dbr <- msigdbr(species = "Macaca mulatta", category = "H") + +msig_macaque_oxphos_direct <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_macaque_apoptosis_direct <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_macaque_DNA_repair_direct <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + +msig_chicken_dbr <- msigdbr(species = "Gallus gallus", category = "H") + +msig_chicken_oxphos_direct <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(gene_symbol) %>% + unique() + + +msig_chicken_apoptosis_direct <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(gene_symbol) %>% + unique() + + +msig_chicken_DNA_repair_direct <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(gene_symbol) %>% + unique() + + + +msigdb_qc_gene_list <- list( + Homo_sapiens_msigdb_oxphos = msig_oxphos_direct, + Homo_sapiens_msigdb_apop = msig_apoptosis_direct, + Homo_sapiens_msigdb_dna_repair = msig_DNA_repair_direct, + Mus_musculus_msigdb_oxphos = msig_mouse_oxphos_direct, + Mus_musculus_msigdb_apop = msig_mouse_apoptosis_direct, + Mus_musculus_msigdb_dna_repair = msig_mouse_DNA_repair_direct, + Rattus_norvegicus_msigdb_oxphos = msig_rat_oxphos_direct, + Rattus_norvegicus_msigdb_apop = msig_rat_apoptosis_direct, + Rattus_norvegicus_msigdb_dna_repair = msig_rat_DNA_repair_direct, + Drosophila_melanogaster_msigdb_oxphos = msig_fly_oxphos_direct, + Drosophila_melanogaster_msigdb_apop = msig_fly_apoptosis_direct, + Drosophila_melanogaster_msigdb_dna_repair = msig_fly_DNA_repair_direct, + Dario_rerio_msigdb_oxphos = msig_zebra_oxphos_direct, + Dario_rerio_msigdb_apop = msig_zebra_apoptosis_direct, + Dario_rerio_msigdb_dna_repair = msig_zebra_DNA_repair_direct, + Macaca_mulatta_msigdb_oxphos = msig_macaque_oxphos_direct, + Macaca_mulatta_msigdb_apop = msig_macaque_apoptosis_direct, + Macaca_mulatta_msigdb_dna_repair = msig_macaque_DNA_repair_direct, + Gallus_gallus_msigdb_oxphos = msig_chicken_oxphos_direct, + Gallus_gallus_msigdb_apop = msig_chicken_apoptosis_direct, + Gallus_gallus_msigdb_dna_repair = msig_chicken_DNA_repair_direct +) + +save(msigdb_qc_gene_list, file = "data/msigdb_qc_gene_list.rda") + +# Create Ensembl ID Lists -------------------------------------------------------------------- +library(dplyr) +library(msigdbr) + +msigdbr_species() + +msig_dbr <- msigdbr(species = "Homo sapiens", category = "H") + +msig_oxphos_direct_ensembl <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_apoptosis_direct_ensembl <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_DNA_repair_direct_ensembl <- msig_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + + + +msig_mouse_dbr <- msigdbr(species = "Mus musculus", category = "H") + +msig_mouse_oxphos_direct_ensembl <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_mouse_apoptosis_direct_ensembl <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_mouse_DNA_repair_direct_ensembl <- msig_mouse_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + +# zebrafish +msig_zebra_dbr <- msigdbr(species = "Danio rerio", category = "H") + +msig_zebra_oxphos_direct_ensembl <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_zebra_apoptosis_direct_ensembl <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_zebra_DNA_repair_direct_ensembl <- msig_zebra_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + +# rat +msig_rat_dbr <- msigdbr(species = "Rattus norvegicus", category = "H") + +msig_rat_oxphos_direct_ensembl <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_rat_apoptosis_direct_ensembl <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_rat_DNA_repair_direct_ensembl <- msig_rat_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + + +# fly +msig_fly_dbr <- msigdbr(species = "Drosophila melanogaster", category = "H") + +msig_fly_oxphos_direct_ensembl <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_fly_apoptosis_direct_ensembl <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_fly_DNA_repair_direct_ensembl <- msig_fly_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + +# macaque +msig_macaque_dbr <- msigdbr(species = "Macaca mulatta", category = "H") + +msig_macaque_oxphos_direct_ensembl <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_macaque_apoptosis_direct_ensembl <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_macaque_DNA_repair_direct_ensembl <- msig_macaque_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + +msig_chicken_dbr <- msigdbr(species = "Gallus gallus", category = "H") + +msig_chicken_oxphos_direct_ensembl <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_OXIDATIVE_PHOSPHORYLATION") %>% + pull(ensembl_gene) %>% + unique() + + +msig_chicken_apoptosis_direct_ensembl <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_APOPTOSIS") %>% + pull(ensembl_gene) %>% + unique() + + +msig_chicken_DNA_repair_direct_ensembl <- msig_chicken_dbr %>% + dplyr::filter(gs_name == "HALLMARK_DNA_REPAIR") %>% + pull(ensembl_gene) %>% + unique() + + + +msigdb_qc_ensembl_list <- list( + Homo_sapiens_msigdb_oxphos = msig_oxphos_direct_ensembl, + Homo_sapiens_msigdb_apop = msig_apoptosis_direct_ensembl, + Homo_sapiens_msigdb_dna_repair = msig_DNA_repair_direct_ensembl, + Mus_musculus_msigdb_oxphos = msig_mouse_oxphos_direct_ensembl, + Mus_musculus_msigdb_apop = msig_mouse_apoptosis_direct_ensembl, + Mus_musculus_msigdb_dna_repair = msig_mouse_DNA_repair_direct_ensembl, + Rattus_norvegicus_msigdb_oxphos = msig_rat_oxphos_direct_ensembl, + Rattus_norvegicus_msigdb_apop = msig_rat_apoptosis_direct_ensembl, + Rattus_norvegicus_msigdb_dna_repair = msig_rat_DNA_repair_direct_ensembl, + Drosophila_melanogaster_msigdb_oxphos = msig_fly_oxphos_direct_ensembl, + Drosophila_melanogaster_msigdb_apop = msig_fly_apoptosis_direct_ensembl, + Drosophila_melanogaster_msigdb_dna_repair = msig_fly_DNA_repair_direct_ensembl, + Dario_rerio_msigdb_oxphos = msig_zebra_oxphos_direct_ensembl, + Dario_rerio_msigdb_apop = msig_zebra_apoptosis_direct_ensembl, + Dario_rerio_msigdb_dna_repair = msig_zebra_DNA_repair_direct_ensembl, + Macaca_mulatta_msigdb_oxphos = msig_macaque_oxphos_direct_ensembl, + Macaca_mulatta_msigdb_apop = msig_macaque_apoptosis_direct_ensembl, + Macaca_mulatta_msigdb_dna_repair = msig_macaque_DNA_repair_direct_ensembl, + Gallus_gallus_msigdb_oxphos = msig_chicken_oxphos_direct_ensembl, + Gallus_gallus_msigdb_apop = msig_chicken_apoptosis_direct_ensembl, + Gallus_gallus_msigdb_dna_repair = msig_chicken_DNA_repair_direct_ensembl +) + +save(msigdb_qc_ensembl_list, file = "data/msigdb_qc_ensembl_list.rda") From a8fe03f8081d207a528394746b9514ed034ebb1d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:35:14 -0400 Subject: [PATCH 384/503] Add msigdb ensebl list --- R/Data.R | 45 ++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 42 insertions(+), 3 deletions(-) diff --git a/R/Data.R b/R/Data.R index a327d9232a..006c659ab7 100644 --- a/R/Data.R +++ b/R/Data.R @@ -13,6 +13,8 @@ #' \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken mitochondrial genes} #' } #' @concept data +#' @source See data-raw directory for scripts used to create gene list. +#' #' "ensembl_mito_id" @@ -33,6 +35,7 @@ #' \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken ribosomal genes} #' } #' @concept data +#' @source See data-raw directory for scripts used to create gene list. #' "ensembl_ribo_id" @@ -42,7 +45,7 @@ #' 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 +#' @format A list of 21 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} @@ -68,11 +71,47 @@ #' } #' @concept data #' -#' @source MSigDB gene sets via msigdbr package \url{https://cran.r-project.org/package=msigdbr} +#' @source MSigDB gene sets (gene symbols) via msigdbr package \url{https://cran.r-project.org/package=msigdbr}. See data-raw directory for scripts used to create gene list. #' "msigdb_qc_gene_list" +#' QC Gene Lists +#' +#' Ensembl IDs 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 21 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} +#' \item{Gallus_gallus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for chicken} +#' \item{Gallus_gallus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for chicken} +#' \item{Gallus_gallus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for chicken} +#' } +#' @concept data +#' +#' @source MSigDB gene sets (ensembl IDs) via msigdbr package \url{https://cran.r-project.org/package=msigdbr}. See data-raw directory for scripts used to create gene list. +#' +"msigdb_qc_ensembl_list" + + #' Immediate Early Gene (IEG) gene lists #' #' Gene symbols for immediate early genes @@ -87,6 +126,6 @@ #' #' @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. +#' homologs according to HGNC. See data-raw directory for scripts used to create gene list. #' "ieg_gene_list" From 2e10cc94b77c59946bab8cbe6a0d8887ef257dc3 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:35:22 -0400 Subject: [PATCH 385/503] add ensembl list --- data/msigdb_qc_ensembl_list.rda | Bin 0 -> 13990 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 data/msigdb_qc_ensembl_list.rda diff --git a/data/msigdb_qc_ensembl_list.rda b/data/msigdb_qc_ensembl_list.rda new file mode 100644 index 0000000000000000000000000000000000000000..e0657d1a77e4e47e94b725f9f28b6eff08b92416 GIT binary patch literal 13990 zcmV;XHd)CZiwFP!000001D%~u?{3L)*KdroNLUbo0wfTE6tQ4|)K%4gmq8}Z0td+u zDZ9~)Gjc{6&lrylh$XKfutZ|Z8VQL7TUhb}cr8HHbMO6~K7Hylk@;COwx9Dn=X6(B zed}9)PWKPL_b2x2fAZ_^-o5)P@4ow8|M#!@|9tnWfBY~0;2+I*@4ovT|3AO-?z``P z&Hwvv{^Xl4e*9;D`q{ty(Py83_08u$`O_~y`|^u#e*W&=cm9T7{Z0SpH~gRf{qfs> z?VtS7KmUG-KQYn19v_!p){y77`!H$Gk7blrpC7L-V?6IYbc~sN+|-^Uky5JY^W!Qu zlaaJON-`ZavyzP4Cz;H$`Xnv6x2h$xl(JeflHR%|BU!6!aucmGl3BJTE0KvcTgh}< zZSoYX^i}lvZGU3z*|&$zWb)E$OGeVi?3t+Q(C5eg$Z45ENXz6cqe?Q%*=9OG8x9m7k*|-_|K<~m*PlX2^q znFRY-i6`-4ShftM*+{d>y`~rGt`_~GS%!O z1ygqo$+yd_BSoKCGM7=RJJQUJwgd_s2mMBwk(eZ^={BEz+h>^#u=kqz%Rs`XY8Lkm z$#lfjN(M8o$;qNwFR4OQ_vp#$_!BeWaJ@=IGOq&Ub}^0B+i4DhNmj^tyPRf6_G zEfTbMbsarX%~4y1CpPkri)Bp7<()3EGmB*0IvtV|!Mau@(-DW0NXG3^Ll*Ctd(4c)yF1E!gPUdIU|f+i=jCL$CBWfCDbqm@qmvLTqS4G9 z#kyq@94oP%xJg2wO4V9ZZa-5!DH+U^VJ%4tgyYT(Ft~7ngD%&MLlh6+vU|6gab(A& zG)QeVqvg%{ddAs&brQk$mByEDe;H7BYZ>Ec&Tq4fh$~x0SUp(DY{v~SBWDqgW)L>h zal5>;P{m1ahCU?)YL``d6Ibud0Bai6`AUwATKKAEVA^XEcKS0l;}Cx9>?V;`$-+0s z>FnFJW@N!>ZyHFpp6cLqR{8EjF7LlSFHiT?nQT0IN^>-lsi^btnh8NA!&=v^ET(eb zmO0-%1riyZEVQleITAIBY*9AuF*7x4Rx-Dwt7bBpT9aA6@>#ixX2}7y6c0-+Gb7xN zLg}|N+7)CuL*}+D6RbO{M01^u)hvK_HOU0)v^7hw^qPio%cG|>v>n+pKsw7uokubm zYYz{eslAz`ftjOOa&ITgS;BjinmMuX>kYCtj^0zrLeA9F3&u$PojPJX~|%yWSQ*|S)>dhN@hFZbkl;)N+<8L%p!tiSr#`)eg;ZrX?4XTvlL7tdp;xm6tojI(%!t#( zglnpM?j#Iy{GLhd?f9LM1vRxSns#ZYoh6RFnLF~aB>3$Lk+e1!9{zK()OBUfV1?=?08%xn-AQOyR>7$~11Hy`jMdbUmaM14cs9VfGQu6* zOd0zfsRxJb#WYKCrD~cr^66*YE80`vHuHqZs2NQ9u(NuPRZA*;)CJ-pUm7{Cmf5FM zhAe=09M6gY9`~f7?UXco?&Hf+eKSjwOBtHE(@>PO7|@e@zmf)7zEJbXvF7~|CfT<~ zYbi;qGjRqU*Gk$j-t4Ui)Mix_z_a=yoRWM7H z71I<QlbNn@(sCG%;+H91q{o+V72_owY+vt$(7H8xuvjV8Y2 z+h$qVtkxvU7Fnx_o;W3*DFO6=ARD)N8PSpz7hieiQVS>Rxk6;L#YR@OEzX5AJ~*9h zX71m52EEa&kfBel8JKF7EYagkDdXR+fmxK~NS)n#bIK&3QiFw%Uo zrHO~g0%YxDmL;fk^t^k;RWlV;ON+Q3QD*2PEemZ&bUY?&*=N?}1~pCO?Yt@rnlus*AEN31@$vFs_sc){<4;m^ zhk1PFh@8^~Ira1R2p(F5{AYADc2j4fEeEepk+xIJxWr8d9Vm9Zf*PDwwpEKSl z>~Xg(7kXTAz7D@>*Lt2;Y~`}nHfAoJh<)-=OTRjkj^FevNq??SpZN&H&-KjgGprh^bLFWi`!4y$TPBUHU=N0y!I$Gd2Rj(eL<2N3V<}#?|YV$s>c>E6f z=IEFI#{Xu1C2GL%9Jva1CsK?CdQdM)cw)%)-ruQJ3et&63p{6BFD@RxX%jR=>%}(? z=`^x>ry>>XXO^0yi)sVubi0ZWr&e9Lv2*1vwsGoC@A=)_E6m)2n_X`SJW#ol+ywoC zfd#vgf(5%PDf!skn}OUk+PU-jY?+P|T?WY7q=UzZcMfumcZyvA50;=rN6jS~Z^?mW ziGj~@U)ITfu6H61eVbRo_`KU{;F-!59G&Z<G#y@4yf#`3fN$v7-+9e&^N2ZN1Lt=cXQ8> zkD#_i-fYsSJ*ER4bvp%&SG^jy&-rv`aysJk@A;`%ad5o3rVyX+;BlUq)Tz)A&8bVLG;_o1y%*~9-t(E-_nJ4ukz)_-*(Mkf}flQ?tllx>SQ z89=)zFYfXmM(tc0eiKHSUzw}J+L{>TpvqRRI1ytsup>8riVg~8DTl$` z6l2?{wh}H>SRY?)(w#ObqCl*7JOvFgYlMx1d>3cI0_s6~CwcbJ9niNyS-lbQ4*4#? z68F(Yu`SAaA@6CJTa7m!Np~ne)=;aQ=7MLB9Vn2`W4r|sxpOFpdfn>5rxdOx^dWF% zQLf9wAdI^g<~SIs zRgfuEXIO?+C8O-rwguOLqZ4!Nm9o2z{}B1hx8xoKGThb;cwFq!13Eg0lNsi%oR3fy zW*Xqmw`3gq1e=R4HmW8x;7aihPd=a3sS2ap<`oByR;+8a3YCGf?W%C1808|}wn5gB z>LPzyAoHv?345)8cQywk%0W?PCa!R9#f(L*e6yg+} z7*{Qwe4`sM#2S^ZL<2r$W{g<0OAgkw4Dt(gQGL^c5Wo=Yu-dVyCDhzX0Tgq2Qr)ql zcXk}58t;PKP;BZ1zZnVCPp=iftkAClKBX*D@2D7&sITy*9&z-kjIS#BVqjj{E^yVP2*h>$nv%V{=s8T z(B2VuB!36-Ro+{Wc;;TTFJcAm=xAibgvIUm`@dTx;sCLL# zxB(M0UPi328p>^w#z(>rR$)^1qjiV@`nLJeAyJR`h>sYpTyNOVLq5{&hqK6F!SS|c zF1P55B-=LNaXKj%=`lQb++mgChANatn3YCQ$m7N<7!Z-mAaq%V{YgfBU9&+g(d7wM zIgi6A9!9^dbyCN%#|_wN3K}2nv6N+*ARQ~%+s1K&2O*HV8`%B0Iy}d^f!~fD?I@}m z*u|%WNElUdMR!Q2T#68%mqk3=c|PE1Z42U5kGly+rvR62rr29;)S>H4A2hLGj&L+! z0kN|c)*r#2`dU*4$Y`dq9WF&k*k^-%gk{@;`jjAul{B6r*IJ2KV30n#)?&y$61~QoH8! zscT98oWAbws%&d2CbmXyY4g`n|9EUIxAU8nV<&}nYwrHe(nGIUoIt+m9Jp*zJj%sIr5Qc zxo4txy{mu=t*gM@>Kge7+O{**X)S6Xi!n)8=Y$bBGwY~%!w1$x&OXuj44BZvv*cboSb-2R+rp zUj5m1)W8q*dhc}J$2KeAX;XtMV-l9Ed(CQ>n*eSHVZaecex(fq59P``!L~hE1pBdG zXcg|=-n%VyWm^FIX-mN7jJ$xX242nMp$f8Y1vFl4(Q~3#3b=&T*dtX}% zfR7v{*Q(e!5Jv4+K%(2$K8M`ay>Dc<1tF{oik#zHufWzK-Jh>qY=Hn*)&lH}*N4e3 zG{l_-epO~Oko6)BaTFW*6%R^*smRgwwEyPb^Lj&t<8w#4&pAg zfSryqjV#M1_!5~gHva{pm;lQaq31-}9K3UFu%@w73fZZEbfVG-U+O6 zHPC}vAd)Dx09H9(Q&eCEnpiyY2Z`GKt&E**ERd)h5O}jlV^W-@lYHwUDia2Dy)L*8))L|JlotiE{s0< zBrE9)7>dWipoyjeStDouWLZ;TwPTa_d_H|FU^TIYKFr4&>A?yX{e0Kw##q4<#x8cG z`3qw8=zc;R$ zBLLu-5p)usHeg=yCNto|B44Z+2SvFNGmn&y8^ms6YfQ{!faaTZ(5j}LVs*@d#Thwd zuM2!}Y{CL}b2KAwvjo_*E?Dizslk;tff+~h8Che2JWuNb{DX=@d>`o?cur|Fw&M+p zn=K6RQ2rc>u8mkn>EKi1Bsla#l*uRqxL>@6gn32C1jY%+lt<{qrWa+A-ApmwqP%$! zddjH@_>@v9gBpCEe14~R*rbAn^a?&Q4zvb|>VW9lLqW>6b)!1XER>5}LRE!rZ`DKJ zJm7jm)5%@H#*lUS6HM~^ep^Rd-AA&=0sfvh=8DU&KVv8!f2pC0Gdl6MAF?na(A zYyo_U31w<4#kR3WFV)c|J*QE&VBZz{M7}aWqLtW_b1}-3u1R=Z8|ho^-;$5TEG7BI z+K`)5uFJ8XBFjRxQ3X^eb&!ELT+@{fd4xFe7-LSV)2%_-w(S(_ z(;6$Rf_rVM?X3a~rA?!Xm&aQa2Mwy=#W8vL*i3PKI!LD+?+fm>AjErhQoMESUbEkg zs->~-!!Mgl(KreLR)KOUu{R0CsZt6=Fw{ZoeFFW|0~(77n&OXIv;i0c~FcC=BqixXDJ2{^lfs*m*!`8e55Vm|rrfSf>d z!R4#*E%}PE2utEcJJ2D;JVJ#iMBI=;){CmmuEd0mBX$q|wmulqLV1`)7%59vE(@nj zgekQ^Ebw~m9=LNSJs(Q!qbvG7Vqn4EVKvIV2X@!4No(tR2iRp)cZf5pAUmNH3%K6{ z9MXbSrh?fP?sCAYv#Tm$*S3TDX-AZ~6*cTRDpb*%1+!F(a{Ia*L54zz{R6fGz5OSlFlJdH~iqtI(B!UA{udw}fJ- zJ`iCG@%loMlFms;(FRtkm2$?`i1%QXRuz{KE<_#EnG zh!7^fG7MI`EUKreDCvO_yJ^QRUArD2yAg~Zq)=5;sIxViGhnrQ2UZh(WMCzedS2sI zU0}v>)DXzJQ#IHI#WsUF4V^iF-wq~3F@OO7jhDu$_l&xP;$1fE=YSEI7FeHesjn}= zOe%E}Xfa}{ty3P;K?FvP*}bat8_@|oF~UWPekne2UqakvD0OiObyFC39xv=gtsVGI z*eOI+vlCiQ1s)PFYk{wy(KGQO`u%SozwuZ9;2;0^tBB^W(_TM*RJXS--o7>89Ob8v z`V|{|`l!}71^M`qZoAif{3vR><-FH*Sn{Wjg|cwxmce*n%67LpML1h@D$Fvnr_}iSWe+cxwc;V^wH|)a(Jw# z(d5r#gz4q-}*Sp_uL%qtO+Yjw|`}13R^)G+?*0gqr@byD|e(M;7 zj*I_%8rK-*oc5OEd|U0Sap&VlP5K)Oz3J+;CHkk2%9U&X^wIXB^0h(_y_e@|*Q<~E z?OWGtd~dpX?HBoGd{@ZTEA9#(WsemJfcD{d_1uZ2W%O(6u$ooALFB7H;hVo06Zm@A4RGd5r57 zL7yLq9+nn+1DuBZ)QLEw_!va&NO}%puJiV>H~#rV(NkA#UXk|otAM zLrvz=$4B*C+BhxYbWL6R!z;AI_+G6q5B$20QNEt|)YWyacD%N5tWb>v+JS|tCs@@{ z9$0AYl&UY8or7rQbgVW?IUTFmDG8?q~rFu?Vw?@x5 z%xUMhWVDC+x|ZCh?Kr;J)KH0WB zD6G4_CzpHJ_UtE3j~zo#;i#SR3i9{_(G!N8Pn6RXW;snEaxI77?zSE@YS@FN>4_#9 zn}nZ>Hth5r7QIs^q}7K`sGaNRN}}hu$~b+kZQFQV<9av>xl)>+urP-4pi!s###RoW z_FnkIQ*Mut#NF%T1`&Urig0y&zez++sv#aUo|;|i=}p5GoZ8sysR**2*nVNpJVE}+ z^TWG60q}&jfW-5oDi1x|3Tkh+f4G8J_jA=%pE1KTK&azXm*^gSKyE$d<#KpJmoYtf#lx+%hr6rg+Scf8+H$(6*Xal6w?;dWv*@`(bKCRl;|h)0 zPhE|pM~^2qDGxP~2fK~V!-w@g&`#@mxB|cb8DoupMgvybNzI~->jCl)v(iydGWa^b z{=EHl!0yLE%vv7-d#Uvdl|-K*$s@jfdec`R`3MlKoK&NXQzv{7>!B0%)QO-@M=%>* zi4R@XQ&*jl9vU5C#A8CD{RHOGP8<3FriZ+Sed-zc*XJ6Dp3^sZ*pkgtjr-OU@o5(N z$ZAwAXGkvPLHAyf=(#NQG{OYFyF8q>+tMQ`rw>9N=jJ}pZl3wDB##o&_DQ0h$vwb9 z%PFt29uTr-e|l9r5nUhn>OS>klhM<5BEfp3X-KKahMXimN#5r16|s=e*A^(L=JN-?&1I;lo^cxG#MX3d(@ z_7f&sU#BV9nSp!pibwo?y{K?4+Tk!>3hCcmxQRlvmVFo$%1~;iOkN zYdrQ$o5pzz4=<_@ORJCcq{<`2w4o1hufbbCkemPY@lq5GzxVq;{8U!facg6^uJ~_n zO{dqDvr%lnaz7ycx-$BGi{a~vbb3xbj$+%!Htq)w@AJ7gKwekcEO0ju?ru%u+i&c? zo#r-byT53%&-A|e@b;T{bteB!Bve2K_w81;yRBOCE33_wOEk(mAkpJM_3b(1zQMyb z>M4?s+P!{VsRkp64%K|7apWh z3-;3%*iTFuyXVfn`a%zZ`k3sn~tHyj|A!Lu2>#xo<$YVorLL0e zTfEB-npm6VcUw(IE&~?<$gOM1WgwCI0^FJRgGV+^Y;%#vC}0a7y!0H&BWs;M$JbN< z-{v4Bue5TJQv%D9mg~-|B|9Cpyv|kz?A1oPb8iCOk^Fv`;%+};x!gQ_YPp@3V=K&U z7397RBTVwQo=c};R{aDYN&jKWmV?E(+s`<(V?f{BuGtl1G zjwOKc3cBMS7(A0&uOyv&!}=ysS+Lr6yqvT>XRCRh+N%xx_Ugcdsu3!y-48ImvyJ>p zH5>T|T++EOiD(4Iwyfq7jds_3O{1N&fCtjF&GeCa^1XUQ?-^#UDO$t=J}hX)zJ z94h$*w?(kI+U^@6?|Lu*UBrnHAbGjJvbD2Yg;>UHknR-V@$x!X4J=DQ26}9)xnbhC zZ)&{zZ3FMzj?K<@4Qasad=VPNfUb$4JDr%F8$Do%T0=ia9(_a$6mVtD(NbQ!N|GMr z>k}{JKx8Dy@MBl8d_GME=yj_TaCCG73wEvy@u{Of%+%w_To0ri$6(&99%S8)1JHIx zO#C4B03d4=&{3Hk@NKOHJ~;aCK@EX}rx>d8aI04dtYF;RkufOjqxG*R1q zbKdRBpt#-%F)$$ynkZMJ#3=@9Rb)tkhxD22LA0V);)wz*+F2E7yb}lD@wRoKp4vOe zvV6HAn(|S@Dy*LCK}3`gpE{!;q)?-{UOL2pQS<~mT@V$NNQqOXgyJ7D%6ddYL>!p# z8}IHL2kaQUK=Y%46|BE5h*Px>@PrNXJnlMR^kY!=@LTdc#~};*-2~#{vQ)fO9q=BkVt+_(VG7pxW`u==Pg3^E^VlstBCSBP7CY*SP$OQV!Rd zN~3(=vGvf-dlaJ42(F10g8le~4muhoZ;0MhAsUT0Mu8QU0vVH+0s~`hz+prS%(PJi z8@>y20*;oHuPB675!%Ate9*|v!M0-&NZ$m;)>kKQQx)=KQO5>M?39Cw_ZR@lZ4HWP zD7NjfcyPA{5t5r6L=`^bkm|( z9WXK69Aw|MPpW6k2G5B)5Mk9&K)z!O-rau4XRTEsYZRvv!ur%o_1a^L*X=ols--CiBEE9K6QjNl-gynm&~2SI#|Q?kk9$q1 zctxWxYDlhC;kO~C8OMRFH?9n^dhEIn{07u(Ukd7jb#!G3GeHXASj(S&|c@66mn+bl1hyQ(U z{i;xRa@Yi(pkq*9%51qM%j<>5{5i4!gWIIl7-IliiwcLoEf zX{~|gkK-usZET%bR0tdDoU1|<|Jtk{WMII_qCW|qBMa&$4ki#$NR{_Vru368o#A~rIYE!DT>am62HtGS06g_mg{XC9Kxv>uN-|=34zH-MA zw>z7rF3W~YzZZ%H-P_=5)7YF%11d|M5JUS<$hM_`UxDid|xa zZh*uflN+%gaxel@{M%^@{H_AMB0UZ67nq|D@4<4N?%W)K{35N9` z2R^D|4eH1f8`P)Phz-^vz$qe^50#>ZtaAvgLT#0}%PdgoXp`#dQfUN{_XV5N3ek?o zTOhYlr~+z3D9fT~3ueGahfp3nHpPL6LK`uB0aTV3LxA}xWcmB(kU8sGA;%#YT{|98 z*3|`?qrVuh>3|L#t||8k@o?;b37QzCJ;HP@gXR9nO6^C43H@7p(i@Pj{o^Q(7X zd|f&D$acl8o9yWM--wh@&3!QFOBKHkEuPbfd`R{(W1-~gr$LTgU zrBOR8958CT`|o|!_oH^UD;|vIS9+Z_A6q*zC;JHQePr8w`aP?2`wd9PW5iobb6v4x zYus&YtCK{ljC|DbRv$=b4$Vgp8#LxuqC}m~RGN_P9F_e|2E{-VRqn@R+^&p#K5@tb ztU|r_joj7;G(@U_hKK_oNJsAPcI+A=4X%{?Aw1hmZQPjG4MR#kws4=Q2OziDPzS8U z?iK3oH*Jtsm3!aAwmu#q<@1RH400Jro1h`ldj?~(`=K@a`rNyAwkujE$jv%wNQ7d5 z*Y|h+wy}wpTsqNA4hY*jt?9VullI><()g+!tg+vZ2HrJZ4P+qqj+I?|@3psm1oxc& zrf=oWa(CS6o%GGXvfO75u+!LA8J;siLxQN}HrMN-yHz87t46Z6d!6Ry%>ey<)HG8S zBcD~k>ZRVRv-@gK;1vECCBJP07)rbMv)_ILY(qSB$>$T>^ugV<54hW!;J0Pf1=!mK ztkD?~pubuL+m^Nf{bP$7z=L@|dids@={KvBm6T=qOg-`k3+@pGz}+h7&TB_D@{M36 zu~#?zW|IGrI2bI~5WQC|wwcEHRxqD?e6o+tlq|Ra!k$O*?cBux6MY1dOH{Rj&BdM; zgs=sk6RHRrzXl**G_&OMX+?>PxibUiUGCNMU2cQ?LTwNk`2|4O*fX83RAM#8eoiLX z_H2Mv9x^pRWx40ncB`+GG`J?9 zVQgjvHKc-u=(hRQiOP#O-#|ZC7RAm=xTA{LYXXsLllxK1`}!>4A+ikow%-dR`g%u= zbd+Lrr?4=BI>3HhN68k@Z?{l+z-u)c+x>lzeLms0KjhT@BmCBY$7!j+6IAX8i|*D! z5rsrM68wg^MJX7)afab|PkHBYgYtcC!3bhULzwBTkkN_}0Jk`fblO>=04t2zDCr%I ztyh7pUcCJd7%ca9j<*q51&MkW;T#aU0V zrd7b(1i1i|abd%iv zB7xlE@B+xps8S7NRY1OI<_2Hlv;#chY?O~}b5Mq%10L9Fq}L*_KF;$YZg6f6^Ktzk z&)%g_6kiD`Y5}iVkAu&4yVALvP!F}5x{jgvWs8zb7rRvC{Y)-EOBFoqg5V+W+HFbrfNO?OW z=+t5#ZO&JEGnwUrNBtKKaAI>oN zI^o>}&{;ZEB4XPB%HdHRS_|bK+N`ubjnM2{IwG`z?Y&Mi2Ade|r2eGV)!eP)^eQH}tkSW929W>kS4Oli2N=stQ!ibni*=BgYMW z0cJ%hp8WTKTvr*3xYAgFa}L~4d#j7;4FOh|v85d0aUlGT!A5A=(B}*Gi}-xtN+FI} zjy)51y`~sCcE=$GfqCC%)PL!qNS#Z>^j{nOfWcx~PcmPPrBvK^#xA`YT;eXdE0t+^r)G5xT8KyeF9XWjvPC% z=#VzxXu%k*K~7Dq0!xdygfyg3oo-Hu+Ty4h7(u1zBU*u}YC*XNE!2}Cy+fWSHok&7 z-NL>hp|=TKdjSue2T|@jTEgFbh=>2n_KolV{y&Xx$ZMT$k;`>O``yO3-<12ia@UnG zf61@Zd1C|H-Sl3&-tTs|*X=jG-J+ds)Z@P6{dTv0&p2&Y+I_#$eQfvBV7BM90wajc zh;!-ayzgtj%i2mVYt{Q+(I2mr7cU+8sP%X&XS-7GY;Bj@-IBK}tD_#w23NF~WYn(_ zv>SuielzZG>unNUs=2J?h~l^Bgn(dd23K^>1tX~UGg7uI^WHhR>*#&w%I%7iLRg=5 z&!FvB?j7~JhA7>wNzH##`YfQMHV6-d0l1_048u*|;$gMBJDxVIZ@}$*1v&s9|WPt_O zd%b(N)BCO)H>@(i(Pe}?((yN~B{O}w)dus?vIfkw+~0@Z=cC{;TyCWCssc7wbbxJF zQ+m!K+!^;B{BKxABhY(1ypN!QmvK0N5oj@xs2q{YuDx9e6Yu@2`%LfqnC$D*aeeN+ z+&fm?_t)E>GfT2Q@z)2fTv6~$Za;*4b-;Yw=sU5e3N{xT0f8PAME@$lT|^gnnF!Gc zM+e}wi?qNhtdXt42Vs+R#=`j+AcYU0foA3`ahdO{+p3;3i;6A2UZ^$3-Uh@g+@0T zahFc~O(x0OCULPoiHn(nr}fB);>Idqjd3tD-Oa!QI>J(Os&JH zUnidA_$CFSLuYRla8xSHM~4y%829}MZ+JaG6HSOCxu{`m<6ix}F;(Jk)BpYMLq6%> zfp!(j0G0a=jQf=VEH}1zA`4p-jV{aB+G{liGVuGEuKNfIAV$1B1t?>cc7x~ zNj@dA5`?q@%*)Lbyl1>w0k|UtytHx-$|Ggc(Fu4^3`bCmEbBN?bz8Z*DDxaIh38() zC_^XK=x)cG2sar3#z*@q%+v`H`BfvX)GMve7!-HU0&!iO1_K%r8+#I;hbytK5unTJ zkUfkr2z+Bx;(pyA*Hy-(^=aP{SyDvN74k`rufQ$b|3H?qw3cb_2j2*M#L)$_p`HA~ zM061&9BmcZMu+$$1V=HN0FHX((h)7eoB4czwa3x&~|aVoFHtm+DMMqFQ6Cd@RU-)wd_?Bg@{Y=CY_l?FtF`(s(nUYyvagvl3hD z4Kk@Z1aQth2j_nQPqkF4eDy+DqMcSwl(G_PB)2+9I*PbZQFr_TR9b5#WSVK*5P!`; zqGeQIH_`@W7z))>cmuH3oP=h#Cxhx zwrwn`+hUEv874?47M1#-3@{{IF!=@S<1q3VqG{K`%Ln%cOrfIlPX3zDqScnjQoj4{cl^q)eEi0*e)aw*pMUc) z0Qt?2AO7|qe*KfLKl|qWPrvy5t8YI0$v0p8_|N|Iv#~SMNXj+2=of|HaQfJ?96%@Qc6r=10Hy@)z)&>>K-Yvg?oM{O%9m|NQ5E z{j0Bk_OCww@fSaWhy4zIZF}PH;g=qd{RiLs+1KBE{nJ1H;>-7+{p9m6-+%S>kKcdu z^Ur^lKK%Fok}q#V_=kVVS04lUt?#}6*%x2?XYuds;eRXn!uG)5NiIJg@^^pm{zv{F zUyUzaLhsY({C57G?NNU}|Hk8Kf9Lz}zl Date: Wed, 29 May 2024 11:35:29 -0400 Subject: [PATCH 386/503] Update sysdata --- R/sysdata.rda | Bin 19940 -> 30673 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index 4ae036a9a6797d9d6f650c137c04530ac9bfc8d5..9677730073449644ff6413a9567994bf3d63800d 100644 GIT binary patch literal 30673 zcmV(&K;geaT4*^jL0KkKS=Tp-d;x0J|Nj5~+yBpFfABy5|Mb8A|L~9r2LT`!1d#yH zKm-5*;GCaP00k%t5-0&xQ~)1(w$Kz6Pk;b`1m7MR%U;W?g|{TSH)k=5QB_uElwG^f0p~?3(_Xa3yLSWI06ld< z-mRBxc1Tf~fUfliI#mhnn`X>HYf1?T7RFB6sYiL^zIoGJDIp~kszrMa_22>P)CDCGLR65Z_q+$7sV`Y7iYq|UMLB~-6$(zn z3Q7oDGrR#(6aWPPJ|6&-00C{6-TQNP&-G*eE%{s9s~mE_j=vzHsy)YXLW~$lK?nU`#&=ih^bQg9?*0-M0qzK( zf#CBxx_EgmU|(iY@3w!V0aXBZKoLM+7x)Z>ilMcCkl5S*I!5$(pQE7R#FSbpKWLmk z5r1Tmwx7yG?luuCANkYx6Tu#SqlvG?wJA>o{Nz7+(g*W&6rZX<-hOO|Vw72_Ghk`{ zfBNciN>QNLkmDG@qL8H)Oie^B^FN6@EZrZ~`ieT}^T{ON zh{TwG5qOX8zXyJgr5l$*E~+fcm~JzjytT8dS?!>8*Sg1iFv}>zf4OY`$MpZsDg9s9 z{W{)?n-aHrr8Kyhp&4%Ne_2l*CU`w~Cf#+T>WdUB3VG=rSfkJAV${{DkLs0bl0pgk ztu!sf2>nXghRC6J3(R9Jw#^(2En~ar9y&?=6}TLiB+o=b* zzY++ks#V&sy3z>bRP#nhoCXy1wb^hdjsp-B&M~O*OA}IhC0;(m=Uq}dy$Mdtrjds) z&{V*2^d6oZh~BY)#D@*=d9=x^uj{odN-0H8i!ohP`5A~}OHov4QYi!!U5rxalnnyC zC$c4!5-GFiL<8oJODsl77I+F-1Cxj!2Uo%CXBN)}KG!0LrT7?e{3RRviO9|0fljYz zu~!Eptu%bHECMtu{L>WG0)xYeKu}F>Nfak~IQ8f`H&&FB)}Qi9(y|EzrxDMSKv<8Z z93#@Ak~yGx59Katcc(zvogSEEYc}Q_@JeIIel0s3+%Us3Secn7BqEGjP@^x9!-`5V zmb!?*UiT9nJwC6-kr^#V9EIK6B$6eH9VaQ!VqkGDqN9u)m(7xb-?haMOA*OX_>L=D zJiV^pOhs|zo`$!kj@C$r$yH~!D{*@(qRiait?z_#Yg^xuT)U#&oXZ>{^0{^6MUWS6 zi>Q3u&bmWKzq#^T)-^%a;T>|XD5qpwjc&=JxWSCgWT#`|t19@fS5@wem6vm!FYNyB z?f%E45+{MN&akajk-~VSI~>_x59j{x@5FheqjJ2gfZ+T#@^RO#_e=WnNc%-IBsGxU zWananpE0?!&Gog4A3Q4i9=66$v7njAEpkZz<0gmNr77r=DoA;yLlg`#d2r$-#nwzt z=}>DlkSHcGNr=QnGLkwNz@Sy=Nj~!t_CB=0aycDK9)i$3i76OILpf+y-oEt;1kNzh zRZQeho+PAJq`}yZ98geDWHCp_2emm7f@k8?`Y*_Vf$=ab?<$`wO+AcxFzGyK_!yOm z4y=oYk0P)>?p@YzG_Jhcsk`qa?5g@$uQIzCki z^%B9LI4BkYkX+b3+*lISnb zT3T})BvecCvN@5G&ymTnWmHzOjSag`qr(i?8lZWs)9AtC_BTQTn&3dID~J)w$+FW9a63{{9!zXzQo>(|>yog^lmN3^`8|Lg{}AK=dOgZc6Dp9jSJ4C45%#InR+$X+P% z!_ESyy)$}xZ}7vfuT6Qh`!Bk2;nDjR%sgFgxls=5+o?11i~Ym?DUS4vqZ46qsGUZV zg5&a%@D~~nOe{}oQjj`^KAGA6PCSkI(kNJtM)_GIiIjjyksL48gGPjChv7bS8yIRL zcXyYB22QYEGA5uH%yr#L&*v$B2J7*j!Q_kocph}#*W`H#i{AbJbk*0gLyFufleo#?y$r(+7~*=I2%nVZcodeJQ(|6~j4|ar=MvQM zY2x|GOm!Y?OiT<56lrOfiDv9%Rx6$;u?H~$=%b3o8ROt+fL4(V(|K*A2)I&gk2o4n zM^Rjy>|0i+$!zVQm8#3u=#FM7S3$encBvB05_E-DVcK)H$3n%5LHn7{Wf^I9yP*o_ z7{@%Mt0_jvQ5QK!US`d@4p?Wp7;fDfipFndOW^lGTuS3+h?6Eap-GD$d@h>s#clye^ZgH;AyEG|L){_14#-p=L4)G4=v zRIkm0aDyts<;CNalI>Ch%o(=VSzM~7csliQ3RVo~(%UaqO)15Smm3cQ+?DNPg)4Yy$e>BeZ+7nID zA#bpX^=_*&H={PJY(tMLoPRSiVc@Y(T1s5D8BN=M*Q)omVew?u(WXOY#^JKJa`g^V z3jaFnJDxq$%!oW%V$`LxY1EqsPJ2NL$>QKwT(hO`s^~SDjoMD=lbv$e$%&n1_Sb9G z>4V$w(ArxST}8St zX_|^6LFc!f;ojBBw~u1oFdyMtD&_myI8pUnm%Uls405u0*;&A&b-4P@^&J9&<+x3yTq~^U6m(wqXwUr=eWi4c$2WNTCalK}IoU8E zp)~D0@DlEu#${!42$1eRJG(BfP%(4vu6><#ko7T~bHz^$nuAsAzP|2#vQbMyt2Zoj zm*U5}E)49xn?-W2%&VAYt?hIMr!jRQyJIZ)PF92ijW^i1p5-fhX!l{(RYkhIRRGy; zW=1UbFppT8!FlHfqq1u8S5ube$F#y7d)96A*>_`dp@{J`h&2Zh?ZppUo26z8Sxg<*jCX0?8zy0w zYkBRwJvvSmb=-t3E;J-oaPHAtH#eP7i*m1uE|+CT=JFG$<1ewkd*&C5kzT~6mN^@Y0VYFl%&d$OKdHg;2Ut}?4!xyZ}chS}M*luQYU zZbFQswP%MiO-sDX%CpH^tn7W&h$e`g+ zc1o9JcJuE3Gg`)J9*QQhi}$v&Oj{1+zisO^r=wC7C{4De!?IB_uy1ao*NQvIHoL#4=-eS}q z0Y)uzUq-O)oW7H=m07i{iYdPC#cr>z!Jr)hj6`pa1(d*T$_=?|9Gf?4^*fSYUJwTz z$=HI*Lfh-riJHo~VqImE3v@Lny=yRsivBI2#8cc}tT?T{t~=>2ua*tNG7Ix+k9l8T{7JEQ9_LN1R~euKHel*`*4v`8UoNc~#boWJRu1*@$wQt3HAKz>aUoW8 zyL&F3Tvyb2Qa)t(e8X6@mf+-mjdxWu{*@Sy=x{ z{?7k@_&r}IAJ6C67vIXC9xX)3MCJMayBHZ#WEh0@(UQ(x3+MRdJ(QP0Tfsl@J2q>W zGEG+AiF@b9Jf)Aq$CSRk@tCixSPJ(e7#EY3l3H zZh5gl<>f$cFN)@()ciL0slNvqYdbSm?pT$#kAr;Uy2|VW7CO+za>g^wNhB>s=C~d9 zikNI`@T;&++{z^#&9}Tal?TQ>|35kV(*jv{24Wy}(^s4=0w&a`@7l?EH*;niS5EUz z9hy=vCvRL~ZG%y9q;z#o?mA=d-1X&BUG}*A=PyYq9C?r$S-_2cJy5%(`4T6?(XjH?(XjH?~S(Kx!vzjvME}V zE1JW=gXG-mH=UIYMt5amNaeAql~#orc499yyv9*ft%@e_tl~hr(b89AhYYE~-KSyW zvr8uRZasaSu*_CwYTw^_YPQ|i|Hk%fre~;A&Rk)dr<1|I{>!$JrdIm5(J3QDP(F=j zowE|U*}EX2Rhq03skon3^q5N#H`- z9d4qofAtqN$mU66WO3CwR;AS;Z8yS~D9voGwzUlc?)OW(<2S;<(*wO)uc6G%dv7lq zb<%>zXkgK?9F(3aTX`r0m`W8E_GKMu4VRNHQyp64Y-S)i`QM9lzWQ0RWpO=??qowW0Ir7Bd2yu85(WQMNAz0j(9nA z9j+@8ypZCB5X!We?l^o(^v8Oz3L5L3T(+oN#`=Y~nD@BSnT($=COjZJ%vzN?=4`Q+ zo{%aYDI3lk3z`LQCzmq1i@tfBJ1?tT{Uys8>?_}DPkOE1Ub}eV9TJTRZKhV}sjm}T znQt$p-3oN?lBdDHX-n{Ki9ov{2*(TrcZNM`M z>Rdg@{Z#T^!*M-YcMZRE8iQzI)+?V!NBC6BbWgC;UEcR)wWfE7ST$K}4RvRk0qGl? zk+z;P#9c2a#<6x%-$*C?<&4V{$T%8j$axwX%0z~J5 zbC}IMIkS|suWLH8FS)dGjJ+oF1w881M!OMU);IQ@|IXSwM+lR%nC zs9v+IbL;?e?0E~vNG$#ZyvoByp56OIn(uR3(8o1YY$}6_7;{sy-RQ{hiw|=0P-6uV z6H~aVLb-3_QtuWNee>Ky73lU|6~5lit~;jIN!+iGK{EnHF;a#O@Y@a#7JkQW_HO&{ zz1`j2-QC^Xq>|*FO2gJqEf}Ycp4R3-x2jEMzbfg#!4rBO>@C3HVhlmaHtbIAmxw*= zZ)Nn9yC(zO7Jx6R<|@hAHo+Ovrip~dmgR)5>D%iU8O-fi9=ZdMXr-{?yR=>A<5VWy z9}eeCm#H_3*5efTNo?0qe9gwUC1orz3kw!hjyvIb%-$W4$=GWIwlI}d)guY_nAUTY4FUu#8K$a13YeLy%+4&|?m|5? z-JZ1=^;p?Tm7%uDE#$!OYu4NsDc2j=Cnb!ByTcpR#-bQ4&|{rt-7+h&Ur}AM?v6BF zsmE4zhwcACD;W6WQjCDI)<6YIy0V-AVMulT*s{3K0e<>7x z>b%!-;e71-*=Gy6n{TIG2Nyd=s8)!Xno4AuwG)#%3%!~f|2%WGCGRe#-xBhZ;VUJZ zTC3Vy3zlt8V)HDAW@3`_I5iEB7`{O1oOj2}S6yx)4tRKW>+sT!4i93>mj)qEZuKTV zk6+HeURUZ%Z)5tl_Af6*biOUpyBABP*Hm#6=zyvq{}7-62@w?pckma4Iyxxmn4+)% zKuM6u5DHaPLIUSVDzu=1Xn=qMQiBi$Sdjn$0sibBFa!Wc1b~5I@%?oCx4HknGD59s zh8i7fOZS)chEeK@u2xkP{6BB?+@E@)NV`mbf(ZzIv%WhrqW_r~&u&W}F1)QV+8gm% zrt(U>_Rqp{=`{v28t~m`R9Q(0g%)s&q%ghg1Qtc!c;?eDvM=BlYGs-;T;3N0~ND~*=;*k>eqcpP1rP4MokC#08; zxp$$<)@z)6yR%7BRaHus=~=$!RUlOptuSO_NAUuoA^;L1k^qE=jDj)FiX?&rf((j*Agn?tC=v>y$O54v3X%vTAfSYbiy|r#A_#>QBxH)r z>1dE4AZfb_h{9x$iHirREVU#eX%W2D5H&;$t$h$h$_NNS!GvZgNQ%{Ms?!Z>2JH0u zopPYajEwLWOt7mM!EdK-lzNR*6vAYdUNdH9$g#UJW_nq0GAuH}9Slg`8ST$^DQu)6 zP$ni)Wh!6-LoHgUjcWEx)kShMEZLaW<>^|mq~_-AmhR2bfX_Q~v8}bVVVNTZ11XlR zw%P;=lT;Pi-giq%s|BKyLXFTQ2?c{CMnz#kmKFtbE@hm^vkNGD|K!G4eG?__aC~gkjC2`UUFLJ55$m}RWR1LLClN9Z)tE9w` zEsLZjzNxv0Iy9CHNa*QkSJ~Xw*CORsmmCm;foTj@C1SFb-#c}J=A8v33bfq2*B-gM z)=EsOV#2YsfnQxjUM@YWtSKNs2#xH>#YT3PhPCxyGYZ}g#y%8xo>}8&vaZ|Bm8Utm zp>vCpPLNybOjU&ottcc%Nf(>E+LJ|%2?7MR-6k!~mzb%>kW~Uef|A!ALXx(`?d8EN zn|HltsVF3&NnNz46)9u!BV|&{YJpXit@AgxdUEu$4BfW`%-zsR8MgY1yLRv`-#ZXc zQiUbf(l~Ngb>fLE*2uR)LI4$TO;D&6nA)u#X{t=BtU0Gu70I_eCOBNyUL1upMLogz3DXsmkO=j?A%W&G%SyTu4&eQTB)e8q}s@-YG#d0LuqJMQnv|RC@PnD zNRrqUv1qN8Q&)=?CMAU?REfJC0!l0_ZufV`)}8m3@(jmgky*XUP|FWF3PHiXTXOjp z0Pva=LzeS(cGe9PNv@8gf%#w=O5D7?-aEpeCQ{2?b)qY+X14_;qTQuBwIq_LG)8Pi zPC}!2WtW9!+3RJuHV$h^F!Q>3ePlyIatKvUQY@7=#WTqE>NF=!>d~D#ks7Sj(?I8) zMNO;5UDDaT2(33yDl{}p4W{a}O!y{94qaS>j6>cy!G}xCQJ}>DD0;r~`K@b@FMNV? zc84pK!wxP3H><8}q1;x3y^jVgZA4BuatJ1kZM5Rsq$aB*jJd-)EZ1_pxzeMWH9nDO zD#uDfwz1w=QkIl@#zHJ8xhl-vRJ6S|l)TG1C>20jJ3z2nU3pR`sd)_yt`@A+mt@{oe>t){8* zrAiA$O&x+&_KaP3U8`=!aAMqeXu(ZS8WwzRoK>Bs_fju0SrX>NM9RvWC`#F#-Mm5~ zL}J_(Z*V!w#@?Zj!!sYgBMj-W8X1stfYC6b;y! zChY}|w5`R8D_NOPsHM_~0Vc!>A>-UkU9e!t)thsa=OJvai@9m5T?Qu9Osmx6$8Txt z;;T8P;+bv`Ee3QgfaAlmwqo5N^cy9%C5*xa?dDM6RR|1+ zU+z|Z;(jSa&(@biPvV(VL72^2c=-M&?5B;zd-EB{q|uKfT3>>G>TDs9^gqw)FIrr2 zAvh()HK!8eQKJerel;e<^-iRzHXOfv+GnLq$8nI@ovPcDif1?P6yR2wYDe~_;NX@f zqj9r>SXTVQT3i~8 zslbw&u}-7CMU|%2G#n9$a5#=O-F}YlkN96cl`S21KdZ|My!Y~Ti&wq$W5-nzof@ud zF2`znW@W}26rK;CIgE;V@H`S18jim6u`fDMk~=!gP|TrvQV-^y#Kf%CL7Z;0D{JPK zy)_x~CdA5XGvrK{n|!j)tSFVrDID(0m%?2Pm0X@Qn0N}DGbM(-W#?I>;AcJ+?3aJ? zCqLRV$gsUAu!hW@RL>*{UfOrgJ~h>KHH+NY9?;)8r#_8 zbe;@0>ievtYKDi?6We#nB8CnuO6$P|tsSDqGWSMM=c2^jXw|dX&B)vWTD}j5EUjm& z6&lW$mz*PZ3e_eRSv5TE<*%BkBd418P*Fu=9L&J@=;PLPyEHN8bamWqQokaQ@>Q2~ zcpl!T(K;nJG@mir$V!@ z(@tmT(B~RihYqFgC12|CM=Y0`^6I8Ws4E}hVicJRNACDCKmd97#aR^{kx_&}DkwVO z4Mi;h2?QhrNd~B(4Cwa5No=Vmx-E@oYHmZ`9965RNYj`ja0oAAy{$R zu}KsYe@-PiAG=tOtH9%}gSeqqFLG>Gp=(92^xJ^zpEbDT<}Co1N+)l)F`Q{l&$hYQ zrLDJ(g&`?v!uN9ktQXlD4f)Z7e`fH`MK;%T*S@;J0o}P=fya~H=)ugkK(ka86vaI= z2kJ5W_+8N*&w3Hb*#*zuIm@7{rafLs7xU}gQ{FuvJ`Z|J$))R3rID>&O%8<=IwqYI z`e)voNIP!RS?oNCETkzyG2~SDJCVIInY6U_=-U`T=kEw; zw!FKZ0)RhX}?zBR3Iv*?QTK z-|fS00sWvQAr5*ydaZwS_okoStrb$JwX;4QI}+JYw#2G*C9fwfrEyVfA5|onbYf8v z^nYif<2?}W7dXVsSz=gGm-aNtlVeKq5Hk@O0voTW-^&)&zWrrVxQ?)%scYo}~H5G1gp1ooim%y>Cg!t%f!sH&B~$U)+9Q#B7JBTjHt7 zwC6Mg>&#|i{JC*eR*Z8>E_$rtHCAlYKCX2egbAOw@3_%9>Ex~POQ!ns4{`m!J_XEc z$y;p8B(+exbllXB!1UprF`MBajSYr`M#zfzTz*Kk@5J@PZS!gH>~10{p+TeWt%djE zofi!u@!e0C>4gf=lrWjt;kyT7F+n1w!;(=e#}TdD4Ts3Q-$Kp;cFY(YLSZSMI1=IR zb30x)dEj-f(a6>-eHjgBW`jfCZt9syVE#2_S)!rHug83!fHrB)2M%oMh3d z`%O^aNmn+uw~iXfBJuvmp$Oa|bDa^vB!lV(Bk)8QOeTb-h(H&-3Jj|kV(vRND_ezmN)ck5q0@o;WVqJ3WC zu8sDNUq1t@N4yy-*T(4%N4+QB7b$Rxg?58-3NzVx9^gl+D|Tv_=1p|SJG_R`vvCsV z2*NVjjoH5bwY@5K$iD5;vqfRmD>KS#XwH{!Fg0p$-p^0v^uwbMF10+I>%sSv6z~&cVg5zZYAZ z4H{J&2-ju)+xg#MVBe9Cq^_t0jC8YHgNql#?%f4_R!Iqq{VCBy(Q#KEs)8$dakDa) zs-~s>ufOVj-TU*{e^>N{i5Qq4r3HFl?-NgZ-tS`k?ysy-5_4lS$EdHB3}#$SzI@Hj zE9_kTqSVi-D*WpohO@TJoxOnG{FO4TN0%sRC4*2kb|U!`osTPYQI@W-s!7`MCim9w z6w+vUrh>mxnCm_de~zYBaHGggjsiTAh!9h0twQ<{~O8eFxJBvD_zc6_l;TNz7S?%Cg_ zcdtfl%6gTx0f=066ovg*uL%~>?FrUooBI7upmKun(E6!RWB_;O&&T0x(nWlS&1{es zYSN*sjWyR(=S`MbQdqI2T$L|G(47%Erw*X%KBV}M?Bjld=E}_3+3M`ZZ2Ds;$`V+* zdEU~9({%JcnrYl%6lI)CctlFc=8xHy4>?wizsfztktC=gdc;WvyIjsC%bglHm*#F8 zs1lU!IJLzlRdtZHMCnt{9b=y`JHfl)rUG>mp9!Dat zu5m+0M7uvnkE}8$QazO!;Gn zqR)cr^G451*PJ602JZCZY~-b?BoWT>@E%=Ckg(A5kDhvbtL;RJp8DK9)2NIXgxSo( zimRD88dGz96R^D$AeM3bH$Ch&8MIg2)tFNVAA${!OYeTZT6s@t={UP1y>q~KPn2cq zdQt6nxuLNv_qcS@u~x{?Iq&z?Q^t3}LPOGMr_mT;kwp_xm4teF6$;Hh{@&jH3&O5> z4_BehG%pOjQsA3Tw9b90_LWUDCcZN2el~aC=6trCjR<%jJ{_Tkq2C_q_?jSGkI~qd z7iP1(f>6&=q;XHd6vaFYZ_%3LDa}2J$tnjM&rY&rIi|8&((Lsm11_t6T1zR5RZFZl z@K58BnEf5e9tqTw(r_}E8jb0vaoUbeXK3>=nKGQDkS@I+&mC8t{b{^_nM0kl-2B-o zIZ&EXx2I&uomnYN<-7J|o{dt=IM#8|eKXCmA5n)a=~10Mp1#bMnU6~o%@k35Qv~Fi z(~5BMHWpc=@jIzV9x1fDwJuGCWYd;Hk?p&d+#|!TU6(d$rJFZ7(}bm{p4#$}H9LjV zCSvaRrlmegO5R?o|2H{XK<_?~@g&e&B$JP1B$y0;w~vG`8x3@TgM?f9J{mtxgJx`p;kyEatedUtD$4U{^Q#YSRWym^>&P1_k`Hug-iBBE^F?Cu9i zrxJI$vot@Rkh>AktOE)DMj@q0bgSDkDtVZ=#5~+o+vGC`%SsG{@`WLuq*oD&TTI zl4Sx-HOf%=xzy+~kSGp|sE|Z$I4%LA?(*^dps3L#P{@$Ix<3bW?oq^vr7W)P86?OA?vR=>(Nd+(Mh9L z)Jy8}PG`*XbC|ZuaKfVK)b?9iGn3>&^JR_hlF=DEzdwBx@FTrlp)3aYY1wvT_j?id z^r6JUPlRUnI7E>wAgU1E)3`Wr;5zPSqljTkf^shT&7SA0r1jW@B#>8|lp&2K9N zxKikgVMxwOr~={6c-9rw(AAIdAmt)Rir|>j-o2t?eop~ zq?ou;;F3^Gue2n$<5gCC*F5p(f>tDy+e*ZlRJ%Ge1li3ar|pxJ_`D=8>b9yGjsuKBGbyVj}{z=EZ`$w63pB?>`Rs^`O# z+)B7o*p@bcDyW$ff}`*NqNqXI9Eo<5*Hqssy1_ z45%asWgM`31Jv>7P1|Xm@K;dQ7A>n7MPku-%+QoBEZ+Hi&#T^MpHHyC+nwc71y(<{ z(q5HF66LC#B1kf01i~ewuH`m?I8lxT^td<1t72P26A}eWLWUxsy4t0sZmUKRF^eI1 zhE=Nh;AIr3vN9>0R`T#0*;pl9Y0}`(mIxP{xk|5Vrma?r=(Z|0)gVl&3Z-CGAkU7e zS!Grk*H!af`1|K`TUzm?u%$>UAt0*NdetaZih`JAZ0>1Hz)!(;NskY19VeExd#BDz zK#q+mt+GmjwH~f3NPB#8cf6_ca77K@W@Lw03vthDsBVh0Bt;cm0{0_wU^0lI*GPm;zEhEfm#Je87H%ecdd zwntnTH<#ET!!m+D73|amdy)?A^5mQrYgVP-LT}Dfx5GI$@GZr4E-iX?>v_2p*=t_) zSj)24oKZNUci&O7URT|&*Dnk)t8TeSIS1RZC4B`F@XTz=p|H=}CKC&I=jaB#?8l+H z!Am!q@xE_4x$oNcD-O1oN@qpc?D-##T58H-eu}xAiV0$gtwnj<3@~n*{4id>3=@25um2Ehz4fcR3=$jb)4zF%vasM3imBL=S@HM3KVY-gCU` zn%p7kJzgZ424)1O6vbnJgLuIYS9N078oy!BYt`nq1{-oTz>!F~?$_CQ=}nZ4u?j`; zsE3?X!woa@Z{Gv2H%)qtQrgPss+QHv+(DE|w0*O;M4X=&gi<3{$YVKn0I}Ztzjw0- zy@(CRc32{Or67yAf+*3h9(t~5pkVpDbXl2SQ=3OSlUU*1Q;YSdPcqYHV-wDxvUQk< zjP!-goS1q2y5-GN?`BGLI3aL4L8_>C@EJu75hr0c%aL-{ZhO&V5`fQ~J_g*dA`yM5 zkToD?f%+)Z8IC5#Cjk+1f%Y~o)rdPtNe{mFp2(|t&lyU3`V7swGbTwpF%hcWKq*n7 zJr&$^MjA|5`RPP>!sWQDXQu0SQYk9)mCuTnxbIAFHo()v$SE6ZnuHPCgj`MFI7$ttAFYoMAy&cL{5=zoqQ-AK1zEy` z{Gz5T$QZHCG=xK2>{Eeo(e3B2&);Ik-Nw6@I-Lr=oZdY8`r94JUecb-!zYQD+Bzxk zNT#y`+;ok(3kwL=enW=k&&sclZp7uZXumD^HjA3dJiV)OX07JZg~@VIJ5!OzX6*bo zn)vEF3)4S@$0D72w<4O!SDy{_(oR0~>&z-}D5&tC)}K+I449kSVscJ-I|dr=or$F{ z?-6q0O*dtg$x2vNQPEOZejXBqJmv4FzH`Yvej>uCLA<%jS9Ur~vW*86CJxC<8M7T_ zA^P?{Jq~(tKWDO7E8VW;Yo;DY#&UFqqozEl0DQ)c_zS(vQE|P!&n0%>PTe}rnq0Y1 z464B@UByR13EzEKG7P)(jS3# z`69cGYI&#mhj_R|_?%+kkr;PfeZyH%7_|{?D!lkhf4*mc&nXJ)C@*sEg-S@SHH3R1 z#|k`-=M#~`QISeD`9abl5fEd?*@a&ux@K% zuFSCfHfjS=8y3|8nKL0=2ym++V1{YkbK1oRxg4B1u(IXli#t(&E@bmIPdUaaxh*QF z{x9l$xv1UwXXv11A@E0^Eo~i}ky-jC?K+&vj!q-1!B7G`M7+Fr-roV@xki!N6w`Ix?hjJCze;Yp4WJ^nvkId z;UEh4uXlbEp^f2_9jMn5@T^byU&;Ps@6h^=`v;0#7AY#3_0`ASW4W&)KE^Un)2;}1 zL2hC`+katV0T@zPxzy$3Lh~YfT#JUvJUuebgF5QYTkl{?lLYBr3t>b}JCWOB4~6U{ zvCW%gDp_W-=|Oi7&5A?q*q6WAO3B6d(?{trq2!Sr;(^|04NY2j+YrtS_4aB~z2Lw1jk{Ud3|x?_PG{EGv>p2c=JW9+RrPlg_bxzPlXk z3379jc-oFGuodoNI--Hf5Hu`D$m$b9MU%@Mw7CyORb?bN0r*CHNyc5qOTqTzzq z;pgB9UY^py>R%*PN5Uu5ea&kfA^K*qHpNY@otE9#s!Qt6)3{a=bcz53TI<=SGrRR(wzmeI>_h zxN)+FMO@L6vWU?!Gis1QHxc%MIxo&=G8vm7lf{8&;h4$2@5LM>`mzL&eap_($2i0U zyhQMEK$Yn{$IH(m=%eM6l1PSl$^3ckcJ|kCcZkrQ#L31yBP^^J-SFcK8lv`!4X2|= zmrixW$5^~?6RSAhj+5g{UEW&RZNI>M$IPS7{AZBEp4Awh{0(J@Qt2Ce_sau!cqTSa z89H&CoC#kQiK2z$fI<2}0$=P(F%GbQxlx0IZF?Vv^i#Al9(`!}l-=D8i!kR(?U#)%Tj#qV!#0JlA zIq5?{J4??-ubNqj->6XAEsc%*eRtF?`CFZl!*Se&#N47a;c+uF-@61o7SH5;v~Pco(t8@tu|zOnA~a#_)cb=|weH72T+8_CXMoMI;QB@OJ>#)`_w z(>t9X7V+?{Yv8AsC$9=FQZJ}6tZ z4lPg=FjET_P3ydofWlCnEh2~}gTmN0ycT_T4RsEP$#|Is@?VaZm|&cqTH%vxhI6e7 zrOM}DP3y@H&q?848$3JTanG5h*Io6mjWi#`tNV5LD$FfBNZi+fbGP%cj~1T4x9NTo zdgkfvZbJ1_&*SaK>U%P5`a+%zV@7@29 z4k%AzGpl^OTK9F>7FO=)*Eg$j0nqR|&SIl5#8z5&usg*&w%(zt)=E74vUBR>lDTT1 zc9p#%?cgb>3YNrgtCi-<*!y#qyg$oL_rB#oYc+BhMo@M^Cxd0xT`aBL!er!Rjc;+6 zq23Xbaweh#P)V^et=d6c`B34@+1admT}~S05u+$&iqmv^JSuC;N{Q~aa@SdCjVKj- zt!8MPX>!wXq_|tOU6EMz?pT?|saw3mTZE+8)*S9FP+secWzt@G829s2-khqOORHzq zb2*6G^o`2t$_3Oyg(Rb-^CV{Zz}jZlGrPAdCSM(?WY_4G3pEAds)^=N=S#g+JJdoD zXrvFcc`&Mo1sjC&T(_3xXiP!jqw%Ju`R|?f^VPJtB+tY*%yD3+&nGlK>v24Lj=dHv zPu)4LK1--1d&jF#_s>r|-tMDf>s-?dJ&V)JbXQ9BUGuX=!N{6Y^%jUP!8Dh*E9Lyh z^X;6VKGad=FRQO{Uhj6sNI|h$z(Cepjj0$EI>A_kR6%*?Oqo7GG3_y>(cOQ>n&XZr z#^08Z2-F~CNzbaG?o13L&iw3-^I4sW3AUeA<3;wPrX&hYb9rEIO)VbHEgIU^{PJ(< zg(UsS*o*oz3ofgEK>;_i3>wW2q4hj}g>r3qM;&Ra+1}=AE!)dqoZ zT304*;j*|_H^NMpFSa{aT*N}A$`V8wJ_kRRdmf(DrD}|c4?#47o>0O)kZqbBV-s8j{u(Cxa3LypN3W0xe#Q7Bk%!K1wQOE!kKr`nUo z&T#nUh}&naoi1K9Nev4WIWE%ktK=qyK#QoEM5)ECYVq%`9&)+N z9}Pt(q)!yE{F)>?eDiJ{#eRdbT}M7unibK^Y5cl^TYc%Z)g?}zxYr!-*_gX6^>Z;N zdLnN0KY!NR4;*z?oYTs=(Ge%>dnkY1~6i4I$-~qEYOvtvCr$uUy zsGaGXS6u4OCcCX`>E{LZbjo*sl|y}|Z=XFi59XC-G2PiLO zW}eL5bnVdX-A>ZZUFhdvT;v;9zAf3FXzv=y?b_zl&vPY5VrOk_aBR**%V@cviO8ou zN~d_oxsof4ZQdRxg)5fq%(8K#-mN1!RnTRRU?UBs$U46A_*3s@^hO%_i{Z$+>Uq-Q zV)z(2Q$s4eihE2x#AFGHJaOkko^yPu7ERB8Ci~4ZQIRNRi6VO!eP#mN&zfo0R>$;g z80Bzvw3YDdr@U64IlLbYv1dhZKQ)W^fIjXk=Uvcw3!EUj!8dyyAx@Yhv?9Is>wa<9 zlnc5h!6ay^X;@e#ny)r)MMWL(gu-}A8ZmswHI9)v`o7bZ_+-@l61(Gjc6PwudE!V> zh53RLx^{6?qf)SGr}Y=dm&vbt!SjpjACb)DUr)nR)Awaf;nsWJs|%g`ryyqBg(>q- zSlap6?>o)nBc4FB)gn7p&_`{tL6}W%(yC@Z=pfm@%_c z`N)EE%a=_$G-h*VF-0pfvD~Qi#s>$or7CwsdA`U!9%4c6CD)HHa(hW8^i&j4>E4~2 zNu)X^;pGpZRb3cZ=h8#>f42Q!qF%xW>ivJXVR!o6cwl|xv(yG{bn0E&>tN7^EO~<< zsP^_5yt2~}bq(Zj>&Bz2vA{}|y@#6JMzJYbRGP7!qZe?CjWt_(Cmq^a-vJiQgOb88 zrv;zMXMGvngVBD)6th|w!7vM3iAOQ}+{s%vDh!Trxq_~(aG0jn_-^ZXYRHR64%O(y zM`O-zw^o!gWleGz3wL`?y91r4xrv><-HjbHPUiRW9IQH!DA6ZHUXyxh^q$^1n}xDp zrmc505ahBOJ=8^FW*fkHO68& z*OT+lgZzT`qe}XZcjbo$;aA9rY(ciI*qm4OSApJ*gx)%r8B%s8O{emQ9oOIOoaf)X z&ey!}9v)|}<%H!IA33*FGu&b!+_|v!PcPH9dECL?)I>7_cRED!txR*|Q<#hQB8Ur* zz4OwHxU9m2evje!LNU$u+l5K{+UcQ%*uC86+9qzjI{zI*5KRzvu07zOZ2ERH8jXp(qQCCe@qQkAGnO+lHho*aLnsveo z9!<{&yLw*Z=VcU0C?aY6`RMoFT;W2)3HzO0m#r7=p*7897q={Qm!qJ=l3;~p?U7R$U&{gieUMuO|FWjA`FY#vQ|t{l0)Yh&OwSe^R-z{ zmut}Cp3eD;H_aZR{de1=<+S!`<@x;i)xP=<&zB<4evhpZ9QWyOc3@304n6EmCtEi& zQ)6vzYq*D#hj88T^iXJLIn~&#t&E6_QqNv@MGo;eaocJ;U2qcISKS(V)Unf&7|iWW zl#-pCbJ$Y(kx8ZG=Qk?*CN5tqn5BTE?6F4({WQ)uXJ^}GrCq1RGv@h|gF=)IF zxvUc(WAK`@L7z9G#QZ03)IDpr=eN69<_o%Gh(x^Xaa~a1U7QePWo{8t6MccF4!#w+ zwHh%lS0ZtX5@+Q}jqf9ZBh2;|4&MF0d+*BjvEtYj-0NH)Ni$xgdfv8?yUcE`AQ+fB zYg)QMsiy9wwa5eqT-N4Zb?(yA4zFlht0&rVKQg2tHCcKUV4xe)*z;<+DtyUdrDBCu zbVVaVe290%F7{ke%lYka;q?8p=fHX2fcX17h0FO_8CWj@jm}Iw832=VwM8c}b(ej0 zIg9yLhtyHNFd!G@T@dP4A01e?7v3xH&U16BE-y9qasG`9h1QR$HL8V2z%r4l%d)Xx zm#$3sfXb7;#ZbK0dIuI7sm00slOLpiG_e6^gTk7>MS9P1XwRY7N@W|cQ$ts@=jJUk zEwn=mQ3)+$+RIO2c+X1|ybBOVC!bej4zF*muNfvhcb|De{fF2=JLY#qri_+Q?KnTS zgGzd(Sr1qoZR7m?{g0oqACKC9hqwGEG-9hOb*F0MBJfDfh*V`hYRx`my{7lB-I3X5 zU0*EBHQW5IXy2U9ZylahI}$@6hTYWos-Z%iITKkLPCd*hKsc?jlsldG0MrTh4ct!W zN=^<5*|{~$9hh&9u^rxE51}3mESoQC;_Zcjkki6k?5vJmm)$V6u+Zo1@Wz}yR<-6# z_ui$)w1NcwLEJEVvYmSe9Bd5Jmq7aKX5$NPQ#(-gwS2j0R*bL&HY!y)msBQJxOp*x z?=D8vvvrOqBAJ$OZZy_z9S}^x*N}C<+M1j;(Xev%P7XHqWe%;SR>WBMJ9Df9urvlc z>!PyqgU%N5q{|08BH9ISYY>F>@iT&FhY@OJNCsuUIY63IO0ienrC98pIbxTN%Y2}q=0d} zho@jtfjc5!Fi!V4ac+l`y@{$Z*Za@2k<1rCaO~y13q9?Zh}TQ9z}j1Cm(`x%Y-F0J zOw~VU&D{AM9A5`Z){ z)|mqrPBNb$HC=$SkSN25y^Pi>3Q+N8B07VX49-nMk%gR#6@P(`X81fbPoWwvoqhT5 zNZm*{plR!m7EQLZOGrIg@ynw7$;QWCTdor+X0q|c&+egi16>U+?fKN}En$$}qUxnx z$f7$>#LKF!VRuw@@vD$h)3ZAf&MbZ)b8gi4cY{*ny~YT(AGvV1%c~w=z!&beb*Sk}jvnM;9dRSLOMbs6#iJCgQe4cX+x>KfSgmy<8 z8xdF~QFGH5cL15tW5~O_7n1sn^;Q!D4v@owhizXwk#Nqj3r`i&w#BUDvo%oE{+dIB z4EAJR6K_bL2cAjr38MsDTWjB5BR3TH+8k~s;OA8Mc$hwH=X%!E*d&U*e3YxoiRT7v zZ+xpADS1-n(^5J0l>CLHQa*#Eh*fU9j#Eh|ByXTe2M7n3_KZI?6FmhJ>DF3Zf85_TH}<&`l(e+zP6QQ94!!yFqI6$G>ANDv^%`fcnT+}(CJYC9>0<8We2aUmn=o$Dl6gFRz54V#&QjRUY3K=*wXOmKD+1 zk99ITBfPFu`z&z1#5;(xHY=`ZIt$J;HZ-?)I1C(~%%;_(&}Vw*a1h>3r;e>rCfUgUi!KT1M*ZsG zhpl_JP}0rKVwP!o^BSx}H+FVw)U%?uFdW+J#`6?clZ8&LY;HC!q^60S>$cOHB1x>Q zsfRNpwlep7B9$sYF7k74h;|)@E7YR#BH- zZsuuAiuE_9TDO;^;7y^OgZqo`{|b*h*FE#q_w9Xd;k|SPDz@Xbg29&8U9P9oN*mLY zRO)j}*6t*Jnx^6eeMjz}VS1DZI)8gIY%?bpLH}}R^0X}I1Rb1MHc!8i}(ZvK&6 zDN6ZhM@~m$cWcw{hNVnV=jtDbba8XnZ#}fjl)W+9A}0`2OUNG?(Bf)`HsA|CkQ$o3 za%KHC6rRGa%gN|!4oRy{vfS;e1zjZegH~W>%h8d&5^B_w1>@RI_#M+qO(1!$;&OH_ zeZKRj5zdyh7!we_)i!JlSbg^AhHfj64otY)ipar}gSmMz_wD@DMHR8QemBjlk6ggm z+Tnhh*|8K(Ubz~o999yAQ(SYcPH^>I33N>pfRbL()Gsgb>`wS~yr0zmNgeNcVhvZ+ z4pS7c&wZMg@N#g+eqP#3g7%fp7>K?$-+YxOImnZ>xU;vTMo6db`hLC&rQym%Z4OHy zHfl<=*8<5xU|vB?KZin`zGWD??)f`_DTC7lH|?j=B5AKCG7$sj_HQRN=2{Be9P*gaI@=8yRSmK%A_M>k&9KGhw`O z7qs%K47;#$$>U=2eR| zOsK8fd=nsE10^nE6l7xT;`vCD_tZAFpTRD7m(Xs^o+qI1>^kIkLN5441tVm8kYy6f zek)34oZ>MuRbNq@iOVCFq=nBzE})CeG0BQzcv|mV`MB<$;OI>fJQyo-q*Uv6i(ovU z$LGCqMWmAQe$A}C=U0$tuu2X^KOGP;opVv}fA+;#VzoiRY* zs;ki>Igxfy!d_Iw8{E9AdC@#I4e;Vu+%K2PVWnXEVWY^p7|(sYTlSidiD$##&wdk@o9^h7PKm(i zbQfMKgHBO=6tSrt8n;F`?Q_r6)P1p_t!ur=x0uJm@KmTx(Zr~>jLX)u3f_ZD*(Ppe z$;(bl&8OMEW(glUx@NTOBLp|qxvO2->wb1m3o19}3|A*>v75CJRh;iu@s@C~cV1oU z#^ziat4A!^jMf!+SQdGmovWU_YY&rVP*&Ql0MOjb1w1>sX?UX;@28P8m^g)LR}S`e z*B(8RKt#6hPASHA@~G6S&3S_9tF~aw)=RJ2**7_y`t#`@uKXGx43hu) za4(GUqf_hPnDk-&Gx~Q=za!ng&u0kCw*bY@%{#MO7mh8}Scf`UA&i+7Wx;xKDz&cq znqY7um*v;BqCQX3OWUt#DVjaeB*x=AVy8t5J@zSKsHGtV1rW1&m0xQU4DGTRORdxD z@pFMeuID|k7FuL2IB7iQ1pA8x)pHT=4P8jg?B4Wl;1d<6k1kiXX}PW-xph=XpZa2Y&(!-uEGagWa7xG>14~c;c3ZmgK3nw_OyC%({+xArPv<G#CZX$s?7Y@_CGpCBAViTvUhC4lu z@LL8h(`Xkt&FP$Li;*}HpqC6bi5;%UlRiXt2S}-oKQ=bQyhdCYcfOm|W20v}M%1Viq_?hE3Fbs`4nVa2tBY!LD}1Okx^byF~7G zv2?oKZt7J#j@pV0uc-Wfb2pcDU1}piyX;N3JG4b?VU3Aw_j{A&abG(EU_#30F3(eS z#iNygx?JBlM^5$V%Y({cMNaEGUC}hda!R$cif=nKrjy#9(hhGtXuhr~yte-j7>21l z&Xt);*{q3KJyO)nwQX{_@M~V@UQ*Z1ptsJY^ceYHCFq&m-SzZR|9jCDDeGnn9LXK!X6Jh-sNxlxZ3yAW1D0n@j4ePdDA zr!tsmGhN-9o^`H@)90*cx0Mah+6izpPD5{X+@v zpiemvln9@2au<)@K-!-(UMOIzLAr60Hx$UdN6e*`rX3EiA5>0c8}OOp*)s2hqVXa= z6Y?73fv(I12S$^2kD{g&@}9Zyc68qXgr*?mH>aSOd($!A8gpJz>fo)mF4U0DEpeQg zQ&P50-*yYdF{1lkZ0qL=Z7Tt9Iam)+UA3tUmn~J@e22$zd+icP6@{b<_^=OmeWlHT zTE!ZTwXa&8={erTuT9G~FKs*Za#x5?+moX)-6&JUwsyOeEXkc5?@YjQM>b=Wx}|jX z@x&h)4O%7)g5=Pr8>!|6hcX(FR3eX780Em>vnhCau;56M4X$!>*xJu1j3cA8q)F+r ziM+$K(St`RK27-gFS)bw6}R#oe*8%|oecb68@_pJlGX3MSc&!QTk%(1%Fdy;-EJ&7 zuQ+OqEzL>}d0nd4uGPvzQyv8Es#*RBLPs*%jNlK3?is9f&@mrss9zQenl$2za!>DgQ} z?4<6a1ugh|^lb}=$bfxF=F+F%0PFXZp{wg5R8|9gfrfDRvJQQAht&_3=e>_*adJEH zcjdkgN50kel{l=NMkh|Gn1QQxV`9soaP}@CJ>%l^w+x?s(sz6<#LAWOSJiklJa2fhzZ+{ z48Jb~UQLXQHzOqSnz4r|?#3`qR%@B4nR7P9W{`rO_9(eq(VIDsbF?p%_+%P*v{}OC zxy#{P7@~l6yhwbIUat8wqu+hp-K!J?91qKipouC*i`@7ZfZg7ExB9p9Sj6Ix-1({d zlklq)wzG0BBy74PZ=7Aoo-`{CP0S!i1%@lM(z*3db3YMK6e>M>LB=w%bo7S6iaafj zBQdj6!+W#5<#3L}8dml$!VzG)nDpn9f@i)H%~{VkJ!y*i((j4*R(jU`ziGAVg`q4f z=I~2^V7aOza?R#yII(HiSkqfp{!Hw!CU50E5XkpX^{n~J?5-yNo} zOS$mo+}in^a1YM(xo=Gm!ft+hJDt>K8y+u3Y;bywtx<+qN0Yle*ubi2j5*R^$Eo>| z^*dXiAnSX<$nCfv$dEHq20pg}oL_SFrt=0SLGf2DZT1_iIir*Qn`nJjFPM8^=w~r@h?jZ2i!j8FH#{!jRtwK+cE_3Jg4AV7@^<)mbADDj2|1DxWc z7m$Gg;yvTRRuEL6yJ-t0G)PlTM5Wxq5QHf7=$w3~!=G81PD1n2j!xgny~*XybX&nv z)SppdD`SDc+>XH^QRofy!cNZh4we_>Tz)}cDOsi*@J^l4ruw$ zPw2zJxOLDDFN4LvI-gUTxneO0&oj{2^f#v_EuTTc%@5Ivd86qDT)`Q1GVx@71YIqga~yKmsBqw^e0mSa%l`)Xf%)7 z`b#sG80g!3ye|11Dd{d*v63F2=&OQ4NfHbvwv7u=6k<~X!+NoD;Mjoz5a}pw8yDP4 zv2u!pVPGZ`&iFg@KHD}u#^TK_9X2LYtiBFm6GHk)z^f^`bR*3NbvdEeT&1AcPEh9*E)6s{z#?A z(tJH>JbXq#_-<$I5wnr;| zH&=8H)*+#_pxvG?CNPFxX9gA_AYbiFoV6fwdRSHw*Hq;1Y0p*NE6KpUj9xFeM-7iB z14jYe#0Z@I>MFL{#vy~VC#-CEQ10Z%rQ-195#sdNdl{S?X~g~asnF=@WDuZ(9D_J# zpH(JNH(=HTqh{~QbkiR>*V&C6J5K!fb}1x`jAVf%jD%qzF_M!AV#K0kp<$L5Mp(rJ zmPS#S5n>sPWKxtQl?GuMW@ctp`M$HYqisgr+OC?-)w{jDky@b&iH&{arx4S)<0)HT zM7GK>Bv3;E)NKN8MTDr`TXCk^!8qH;0;M*X(_w`&MwEzGa@B z&{HH)#3*ImArvu@wQft5C5i-&1WlkwQYR<~B+$0*=m$49w_9tvUWYKd2b*)3Z*{$! zhU^KB?&-X>+lD5MJdmqHupJCZf^D&hj3F5UhIQTNc+O0Bo_U$&(Je>{-L0G5T(GrG z-ATK)q9*p|H+kDTcHCWN%;kn#EreN#Yc-j>wi<@+WvtPeyEc%Tn{L}`*_zBO)|ruwVGi13ovoPd(AB4FF77$DwC2p|n%yS5dmG!!cVZ)5*{<%79!Q=vGEKK+#`(3{ z)!Vza?{@~vP|j;qY{rXinYz;utu4%D5EO|bQMy{hP2FzkEpF+ywcXRJYqsZdD(6>A zd%JF}^UWi*rfUk?GrY~tZurd$XPsIy^7C_hYrA!6B+Zsi-j{DC?Rbh1h>nKDh}w>t zDUCGKO^vj~(7<5W3h9bKW2l@%ZZ<~PiW_hs+d%09EKs(Xn@pxAnAMPx5NbF_0jSg} zK>`|)vY4c(ql8h7CdNcaM#utDwF(HEAkOTT?=5ca&MwmA-L;)A?(4B@yK?MnJ9jl3 zcU)HGj?On#l-vYv?Ut)Csf@yirgrVSo2zi$*(RHrC>W!caF*d%S_B3P=FF4M+zi?>bk?es0Va#%LTG}|n@%)7Y~7&HbtWF54|>8LdX*z#Jtf*XQugQpCY znRwb2p&|*{BW*M!+ent21!!u^Ab}KBwvk2-5Ks_f$!$dn#@kXx(HN*v3>0xVlrT+O zrmSX5x>ltWu1LaLsEd*qGYpZqp-xK{tS^Fy0o3ig3A@Xr=M1xhQ!|bN-z!%)&t<~Uk9Y!nULyh1~3CRaa}|GA5r%o z(pxOyH85$Yre%u+D1-*bdEEZ)!KbEz+hd+>USmp-GD|Ya7d@A z?Y37jY}3PS=NH1fxeYv`8?49r?IEe!(rO_!6duh#pTF%t{CAeqKQ_{rp3_?BPMD^B zN&9m{Lg!Dwr-RK_$Teakfd3JY?EW6q+YxRw6zb?~*w=mu`!x@w+h4_^F1%tbV$?scDjSL&88gA!WM8Zys&LdnfB8XO)7S6*KH)1uj}LOT}Y&I3mXrpk#nDD(5&k?ng6}2hK^pd8H)~(9$r4STQSut?e5#t-H<5F6&gM;N6!42d!w% zojxoBR;M6A0~f)~=a!DjZt%I>-2CbK0o3O3&<_ZJY<|pL&MiHUp}V@E84w{x-$Uon z$iFvf$(?Q$Rk_~8>S2?Um5}|jnD7oPdOi2__@)9*f^A)H?#B4A?P<;R@dF|efortu z0Tet;a(Or%AsuXUG>=1Pt?fHb*OHHeXQ|lhb&UXu9SWeY4S#3E{YUC8e8+EXYl^}i zdZm~cC}HxsfPJ4ou=kdZry+u8PkLw%^6}}tBB|IN;y`kCq#PSYM67x19iyqG+2G*$ z0^NlPI>>gAwS!pL28by6?)J8(Fx9>LiG~dgI^4NFmy^#8jMI&a@{V?NpQPNAE~*MV=P**ab?^b9NyTdXjmvl1InFFI{?AyclMfH z=I2Immcc>oMjt6E%5qb)uW#TR7+{@PO%gwiP z+s@ibmDy%-A#;e{r@V%`_z6HYGb{7j^`??%8nmrFUnDc54c$hOG#lh6p1LE#;$y`6DCnxos9UFN^ zH5LKe@f%upNfG3Lu%kP6iV7P6%thrwTn!d&`5P!4VYH#(?JZ`oZjCyBgf) z^E7vlW9q;*0X~1E{U_)xfrNSjiji0}P*XjXXWKiFz%D?KSbDmiq_gbke|q8a>-ass ze&<(eNAl}K674pG!PR!x0-RzT4wJlT>3V$4?)o1xDIGXA6hSj^Q+dtB+CE*+oaoV} z-wj~;VF?t8N@0=&7?ep;NrZtEMqq|O6vixJn54v%VlYB6ln4re2oPjQLPP>ZP>c{{ zvoNZtvWqN}EQ<(=EX*pyA`Ga=$f(OHiZd`X2`I2A2q=RLGb1xHlFTKOFtIE%FtReR zQzD}*AYw8M6odzOZ!8EPc5mA?bowU;co1X`tei)qQlfzLxDE9$tA22di3qPy@NyjA z4M2#eFH5j{99zFzTb&1k800pw3L*A%*swSryWF{Q!v`CL33c*I2J4oDFuF@s6gHcV zhi>zw^f)*TH;pfI8@@-IX5(kF?1SFXn=a&$yR1#yLhLEj-k&qc0{WQKU_8T%i=PLk z_fD2HrVZVC!*&j*K*iI@M^)IEyIo8`4IVTnYll-Kuytq}JFs^-H)DhXmV+B}yG6*{ zscTp)K%&rhl|?t+Lkq^Ru|LgE*L(~cu={#m9q!TOQ_OjQCqM|HcJ7bw4UBcUq2IaO zmtfIV8;+$=S6zrd;?`p>P(lVp59|TC^)vwNxtJ&3UndMGKdz?X#K7scT_3Ux{ zf5ZAzU(9}r3LsELzWT@ydVS=sb5i!B@vDD91FiSHu}nnak+>8 zw!-`2PDUJL7I8F}pQQdAHES==p{uUTBNym%?Xt(l>P%)i>esYg3iLs>OYHmeMv5?Y zLjZbRiEebTnTeJ(MlseO>oN?v*_~n*2&E>0Rg0_|*Cl4rOGQ|im@`;FxtWU+rU^=B zkydm}WScOk%#13vJ@BaFLQYl>!8QS9B%AqQP*G) zJpf+Oci-)VSfP0(W>poRp1jLx_de*!^E%->H#{KicAqo4B#eZFjI!0T?39DLv4_i#@%cIw)G%sbk)7 zH+#xXc90+#Hf{JFd#8uM5v=2rbaW;)vK?5H(I$% zp<}}PN33;Z$5!2X(Zy$hmDf>%O88qFXNwH&gyv{-I|{a&$YBd%ELqBpES<2Ze-OsA zX)0(6XUcYN+w>Sz>t5Gh9;1iaSFUxKd@#|k)*s3(3^+ikIzkklo6s!SeTF!uMEJ0G zw$$~Uhb6mjW5lc1N!H|%xi_0Q^*cO#aOhJiPU69tdu;9LLT0nF9uEg2fZ zZ{k${2@)nrnt?@DOzwNb=z<>RXMC7s{v$_C_JtU@I5|B#i?=RISJrLBC*#HV98Yc^ z&S>x~?L*)Z4}BF03H6)5H{aRpfI#zbs7#-JUOP#rhV;^MY>0tPWtIA!yV7YDgnXH` zo#b8Ud6{~>9yxfZ-!stfOSYP}=-{7e0u5(!v&X2SgOz;*&#c$KN6@-v!?BGDDvF}w zZ{XWzr0*HvM`o*?udzI=Lnu3A?LS8Izu$XS+x2kXWxK#c>jP3fD1?|;2Vr6EGizs^ zzUqyQ=Q?tbi#^`59LArzfzVRH&0F$hGlhl4gQR+pdz}YZO(ycjeplr|eH<9{G)-tt zNLh@t<-^Qe>c=mv{xuav6xF#+dUWnCQFwwOVOD;jdee3`^)ZMjq8gI{@+6|RkAImj zNyc+l`@N)bHamKGrtdn3BDawP*%n1nRTgQdNPNpn+&fl+SH!jKqLLo?!epX7MUfs- z+-`==$!j>D^CSo;rlQrQD@*?I6Uy!y7j4U~aXpz*;;8{zNkvh0Xsanq>JT5SW16z2 zBk@4+0RKra3hrNGA5a;6f{73{ZlBZE{hzDe#W;(|@Z1)Hi^It^8u}h4Ck@nMyQ3%( zo@b5(p4S5})4RU{7ufQiBwwnlQGrEO1(nAxjsW=@_gQyqg*@kb~<8cNg9hH6fx9priz4w!Nu~F!*9Un_zQD9 zhtu=+r9LN*lzxN56tVkB$U6?F$caG*SzVu>p97!XJ)3J|e*=)Kf<6pDHsRBEQ3B0iTQwx$ikr6a_Mpjk6K9F{%Vpw#!VZu-$Di%`tKx=5fqY& zDO6-0jxcp;c}I%-^PNlA8Ii@cCx*1_k0RgC_$#XCph8Mu2brv>*l17ingw0vZv#q; z;(N_Ta75RBjpxUISRGukeIj|`At50lF{G$?-)!#X=`6meGDqxspQ>0o(KI zLAmNTvZ3Y#GTl#}?ugx&CnZkRacbk_K2LnpkqLClQSu;;Xm2)|_l)O}R$582dg)JW zlN`}Z1w^JEO9QUYX?fde^|`*`O$1GY+~ZzZ8i!X0&cqVp-C|ys#A}Xg=+MK1i_TC; zXw|8KP&@8p&pl3F6F82DN^BOURIHNP1d_lZvH)xxu14}Z_Ni}B4P9xk!0N(^goK2I zgp_+tMj}?NhR;v07x7r={l+0-@ywocPBEQ&JClx2B2*>_1sez?8Q2!Y37YcK2YR9) zdC4T2NW!v`KY6pqekclx3JQycV#;_yD`|31rvegJpq*_`gE|>Q1L$$HldB@+h1r!k zL7iH4(iibO(3kCa*8vZB`00CepOE7T70%m&&!`M=^d@PozK1LyeIRE*sTCCzN}=34 z+-`~mMNsBvW7>*r#B5ZvCZna~GV?j}IsVz#tq|}{f+y$%!y=BSnYMgnmQNmmkyKp%1k_)w$t$%YmSm@O zQ?y9#Phx`n84(#xS;_5Jua#R3N$`zkf38IE($itpmzBOB)sPvec{l1U_xl1?BV^d6Gi zX;}S9hkk`l`WYEvW#DKQeaQ@>Zx^g#lu;285d=g;L_~yygoK3GMSA;Tt`d;LPFRbJ zkDGWM8jM45A72q;tO|aX4`=LlA0wg?5)u-qs6>$w5fMJ;@NCb#&sz0<7qz^+y?=q~ z`Q{UeC#PVEUT72)lN{(k%yu0+*%p#(a^c7nuVzSd<)5J+{+Ua zJ=Py{dbncQ^!ayg$8{o`44yL0qKyu+4ZR+PYX$ScFo{x&1iVD*pI)qc63L|^OQ+nP z^wOf~5mLuKicb)VEJM=X{8C4?G*(m81kIWNz(ljK>D842>XT1XkrI3?*R7Z`p1~YN zm>AL|ln-jyB0PZ;ufZ)*V)_i}YEj$vCMOYfR3*0yu{P3H9#L{#@0?@uB;#8nkVQB+kIRR>*#o+h*FPK9P)W1S*`BXDW~{T|L| zFNfqN``n57xH#(r2`ps^3m_iS?drY*g?NsE@m$FplBD&}@GbqtGQe&}hnqQa>m;=& z%&HK{(|h$|_C_Cs&CU`M5)uJ;Om^zTivrDEWS%Ov; za)?eIp(G&ygas5q6?)ozXcmFp3!&DEWZ&}bPD*&OY6cK9by-3;BSf!LAc3^fqR&>8 z=xnYoN98o;GTHo}ux|uG+c+l zvIdmqkxmx@GmD?mDlSS$Xk~GrL&V(dHPOiKFfeKmm%XnY_ytcqfxf;h4;W-oUF0$9 zmy9sO3lum;{-&&KAuu0!V@58|WP#cTNOqXBme*e*0r7O}IKo0gLP9+~fhUiN6%|E~ zns=zSRj*#*bG*4otWCJBNJ!#VTU}2bdkbcU%jLx4XG>B^ApnG7Au<4nh=_=Z@Gno} zUi%li3)g5BQ$Pz-0eBeDQOL&nKX!~whIVPpaYKhfcXv!*1Hu!*5iVhv8X@sB{M-I+ z&+Sp8x5>Q55)+N5GK;r_n$+6@5Fr8_kmd!uCHfHe=@Y9@(1)+F`r8Ob-tPy&)E5Is z#M1nFr`3Y-*m`J}6N{wl8Mi%$JzD#o@$Sa}000000005Fy7z$g11JCh?*Iet4kqkV zuU5xE6b+~agV4p}K%m1w08hRS0Q3jY00M(|(}AZz6aWVh05kwT_rCA|00EEy00G+o z000ZH0009#55BHk&>Yx1X4uXE24v;ks18SV0kaFX=W{}V$0DMI5eTKoHPB>Hvn_^` zs@GgO`wL2 zG&I^xG-zTP05FUo#4-&SgC>mt5kw$OGy-VQCYmCjl)##LpwXtq2dFgA&;vj;4H^wJ zG!h~RhKRxdO)(5p$TWtDnn)T0)MyQ&0MGyfO$kl=v&}?8_)$bswUrPFnFSx0>-~>N z1OR^@;K!f8ztxS$$NIi8hs)yMERX$P>LBMhKV?6c?tfZS%U>WtKWAuM@TT-CE z7hxoqW1f@t6G!>R{!&q_Kd6xCX(TEk{R{e6dV%>I4PFI`h2FoQkN7Mie-7b^y;M!7 z?Zk`}_2^kIGyh-w^gN+YnAD@fNg_}|5BAN7mIec)AEBIWEB`LyDnFBnm_?pP?p-U{ zC*}DQ@}KO*D%*hKR}kPg0v-2W|MGov>}<)jPhLEOxJ@;gSP17B*&rP?9S5s!w`JPz zMvZ-cgF|EOv4J2k!wJt)63Sr_f=PCDha!#{%&~)STJ+SROpYgK40>lDP{a@UII(Ea zKmH}Dl&FgQtTQ#FNj~OwLD-lr-*JSJ>#}6Jr`4LRCOI3{wwV`^ddwHK_RLXAk zC7Qfual_l@GQ4^7AiQ{zT+&2wDDmGI8q8Wbeby?J^d?^?II5aFjD&C{<1^b9Syc>t zux6SVkyA$z<6|sKnX>p}Q1~h=vQVyN-ZLtlQdIF-yjK!?6s_dfYPkZ|yh`l(#}?`v zAu_fjl^x?q&kiRgo9o2U2`6ZJEEb59o;(ag6A00~#r8BlPgzI5HzN*@__?{3Y~{SA zZ<`TuT$&ACMn&ALbsz3j#;*KBJS6ji^HHw==VX>1L-8`^;M&`{I^I&?Ho22S7$!af zN*Ng8E}BUqH-pKC&7ayBP$w%B&LeE=DwQhOIn6B7m=~N2XQbg5tEO_Cv+sF4RcY#y z5)UeA{Jr0{i3WM24KTovy_`^B4PgLlf~Ibquq`X{=e=2_5=*%`x*sAM~CCDs!qO2YQOyKx%G_PnVe># z>j@wsd5tPp3iPP54|uv2Ea~K{s&Gtk3m&CE`sJDyF+%lHl&JbDM-z@5Tv|Mkw6?j0 z-z?^nITCVV#Rdb31~HdC2D+Gy`U|hH)>A5ITjZ%znh#*{C|JGC`*6g(T{oY-h9ck~ zi?+B69}Q*hXl4OA$t1+Y#NcmhcIwVt84M53$?~rv0>{Kyqp+EK*=6in+?lNEgT%2G z8MfsE6}XC@PVQM$c*h!&7iN{1gwbT;)-CiLvn|<2%(Bm7_JJATeavQTgGVWvjNe@% z`$=zfM}*@1Zh_mzT1zb+ruKn+$vTNKHS0Zo7QukZ1ICQLR(L&)P_YL~7Bz99V(v2cyh_Im ztlL7wj>4jt>G+biRI0JvRic@$SgAnpz?#xNgB0Q|T=-aaA{UgD|JiUakwG&5;f!$c ziEwiBJedCpwkIP8a=wBB_ZeW~m6K$Yt)BN*8?}tn$zy_{6&UD{CTA8W1|}7>N+~Gg zWHH=oBzvPEDg<1vNJoIvN9Wt~I6ts}jd(5TQ|bH1ghkV*5%?6XM z@xPZW^<>ZIb+bvooHaFf_I;XVo;~+Fa?8d@eMCM>4XR0GkkndeCZx_zT7HsW5wM)~ zzP0YCQ8x}gd0h`Do<`iNL{^@o=gQ}t+EgxFw*5BML5S20`OkC)gv`T7R&ycy2B@?s zO=guPPXY-lK+eB+Mmj6f)(M&3cPDw{;%jivY`D2OIXM`SjqqN}4ejllo12{47Co3| z^PLN9n2gA=ftGx-FfcGMoD2(>C|qP0m(uHtiaHlgJo{^wOfx4_vD$Dq6Gj<&KN*y1 z7Pa*IT8#BG7@E-^topK_|d71=j+@^+gc z{m1ct7wMK~@mm}AY?6|p&hy1|VED7&k$|iYvAUXWV`pi zj``#)@J@BxHuq$^Au%Z{fXraw#E!Cu&*LOyC`Ek zFUaCSo-ZeJ$;`}__sHa2RJgRkNj`1_>a@pP4`EL4EZ3lPMD=;+7ISpQcTL;z(^zi0 zp1KmtzGg&$d!4STilwHBuYJt&G&EfJQ0-SUmUY3!Ern-^^)4lMOOeXT?y!-W$}KG< z2b&x^5xyLpSoa)vYRiqNl&)u0eXqryIa+<3`ek%8W%QPFDP9>Ji{m{oyIt=mQ;+`1 zy8YGmikJCE|{>KVU#AK z)Mo)T6;n#Yjb)^2F12Q5z>5Vfn-`fG0%>5QIH!zMs6x&-%8iZPt;?{R!o(=JJ69ZY zS(g@PW;XCGLt+G6tH+y^3CCA2LphLU7ZQ<$lUGiwW$Ih5#%=|>D=9H=G4YEgoYZB} zg|kJigLy?%^G#hegN8I!)#XkMEbL~&irdSGgOV*HsRN5@wcxqsaDQYXK!9jGdBXxjD{>s-K!P3C5_2;wkq=znK0y0S(P+$_cZ0)%D9J{ zSrsd9ZuE#6w$&G?8@CEpVtIKvv;nu0BU4oNM%7Ws*PMu%1}jjALFu_k?C)_@y|WRE zn{T0uo~aqE&P+7oU|#K9Mp1bqF}#b}&Dj+&)Mbisu=1;7VsYi{VYoXsvWa3`#7Ivl z?OD^bk{1yU16tfjotoVe%cm|Psmq~hY*8knGi)`e%{W#qCA!VUjfiy2smp>j(UNOa zJj1aCU`u##+$wVy4L0u0R741k*eqE!v9EUMX4wiXs>$7&aV~EvAk{)yb(awrFm`NQ zLVKHAzoMQ|oJXZ0G-I|RsvXj~itS{fi?xpJG7aQYytS8MD-v^a8rYY06L*kRWlEz6 z%i9+))H1Bb)b8V|o>dqIt5HWK8Wp0%U0h5~MrFENO$sfIHgcR9szKt-2@1YcOuS~K zkgerjR^2&S3S(~eQetprA``0J*>OTPAfQbGW{tHPq{yObX2H6vhc$PXm?J6O++0c| z>dC#9T!vz+V;s6dL<%Qp0KoRxECIe;zX z3v~08Hf7#iR%+J8hNMxXWRl^G-B~VJnu{VOY-5?gAEysso4tQ zrkSTwZAgfSHX3}lRAMf&cJO11qzN>kS8hI zW-zFzs&TWmRV#Gkh?(AAV6#(-IGMV~m$*Z!GbdOw=}g^PdgRNytlYcGhpc9mZdRzF zH>2SE9sZB?Y5ViV=g*gK--5Mjr*4sHOmqKO7$B)K8+C2a>h4B#R-L;Qnj@1jN{!{k zP;E@s?V}9tH**zng7F0!QrX?-RNSnR;((y19I$3)iri1>K=)`4f9masc{h1MC8*3@&XGd zZf-HUsc`aWiqjj8CY0;0R4mFNvgW`3tv4*qWo`s zTBWIYl-=&0)n7y;)Lq9$84lxKM2&|y?A1$~$cwF{YIiEET&$X?Q#G4Vw`OLY&THB# z*r*Yrwr-2Euw;sRdws(^93PYM!TBjtN98P(<;#*|m<~n>Bp`nH2#Aa#s)MGz`!-lm zsGtB5azsDTD@6qc6mYE+5`ciJFr**~u?PYx2h#(_1VllwLL_8*epT<@ntrAQ+sSY5 z@XnaO=|6D{qfN_(#(8~z7q3=IQrz->xTwe7{k3CF^G-6^invS18>Szb--ArMiE82S zH)}Hmn={u;tj#9~W2_RY(#4gfBnf8`)Yc~j7FHVuKbd{q^So(!+~=L)s#TA2a!q56 zF79fwH(p)>)@JNhPEH2wWJRZPwrWw+N@djuG_1^Q#3OfYTY&MKsM4)%m9Y~xrlf3> zCES}@b8}_j%#4bs5UeXGR&M4#9ALwXE+VO1f*t9|Su-=ZqZqNMR7^lbZi%^Zm05A8 zY`dv9k&tQJSprBbl1Ua}8NS3A`ypOKIqWHk?dcNTe3+Mq1mNZYV@Jg+x;`1#E3j zWx%H~qh@n!CbD8B+cumfEdhp`G8M|BmAPQ*ag!N>qfK0cVC8IC+@R#d3P43r%W_Oz z%f%33$;Fu^oJ#TIF^#xpYG!twSqUskVxqSmk#d$@8rvx5=1kWWz@s^Ils1sCt*3K* zoQo<|)m)Yi&Qpaj%$i|BV(I~BMk~vls4T3^+No7XH%e4=-YrqGWiaj;!!H_%k|ql_ z$4kjH#eQTWK^#qR3YAE|C%fvmErKTpHu=XSl&<5%aX{Oj;j%zWkM zXZ#j5n8;+QcJ25dMcUG>xeTO=WaG%vuDyPRsE#Al{!d}KD^3JvinOAoz_ie2zI|Vf zD^m7bl`B!l`3+`T7|3-o8kbgf#ldAZ?HJxvvC^T{Yz^wQpxA2Ot1RYXUBtXzUR+@$ z{XB7QrP{8Rz2DjWGIo<4l-;ps42!}^B^+k(^fR(GX7p96!Ulxhme{riBC^rs#&YtN z+O8ZYJ~SPT>p8U6Xgs@EOmp-mEmoABL=@~#`aucy;*7uMAMP@fJOCzfgSTI%h?TKAa8gmW=9@SD0}$&XFv zijAg&mx0k-bDc_bt5m)p%)7tLWt6PBPgxyUyr`QLNp5z1 zy5j6J=SE{_M$=bdF5O+Ttk8Tq+v6=AEl^UH388cj$y0E$x0@a+nm%o%ZR zj<&sNTVohSF6CIXGH6;WJ;xV@rGVhFTwZa8nn zvZn+=HT@0_CtgXHBz7Z~fFyFU3+iSauM0wKibbcqJtaO#2ZRzq=XF8mv+GPIqHzzYRwW=qq(0f0P%w^~{2hD;96*duSFJS@JG99a0f@>V5~`Y#gz0ID3n^aO zE|x|pVFf%mLqX(rC23_CojB}M2fu->V#5q(txNbBh zQ3%AW6%!x*k>j>3gP*tN;xXIimF}m@GJYFBqL*QQlm0Gi;LRvw|w<2N{lZq&0Y~N%^6%rGfgZel1UwvpB1Mw z_hbHF=I5?IPtTShYagE7eFpYl!}<3%FX?Oxe#Ji)_p%~B(izLeX{~wWTvgJ~3j2@6 z`A6pS_y1OwYtI}zjsVZO@0#~hZFWr?)m?5L*~1;S#+IC34b~4$%j6&8+Hk)3q(~T9 z1n_AYKDi{xokP^N%je+9!f^IH{AQ;JVte;p+GX>|XKE~S?bio}LAy-mH^4|`&p8Kx zA5g=}G()R8zI&`$IHwFdWf#9~%|oO;u{re@Syy&8+2%e6fiu&mE$t>$$|ky=^JY<} zMiX4cH)tC@^ULIdf``FA1MMjEejmUVZ_3{h?}37B>DLoRcu6Jh?TU#*&!Ji%NGn99 zFwCg09GN)}$K{$%_NS&T5^|z6&*5&&R=!%wg*yw3`QAM0xtrT^krpMowbzk{9x?VN|mS)Dfrl{l9DWtFiG9xRL6Dev6Nazo8+upLU{C@}J1A->s~V zd-|JwocqEv5x-UB?1@IP0*p=8LUneNI&z@fv2J34lHGYxl~GpzRCZ(Q9Nu?4^SmW% z$mSZQ5A*Z$aPafKO?%-#Up_)PSbTIczCg~7+zf5!b@n>9t1su9I5H!n$s0C_GOnXC zn|a8$ksn!Edud}*CGs)_OuC4GhAw%wJFY|Wy}s)6z3Axuiz?)o6}Mn)K5ODbyLEXn zwqpEQW12~0D@gpApy^~Lc39klIp5EsuV?Z0r^hmTS$?Iph;1ZkM8jl;>U_)Y0u>a@ zd$0#ZB6|oPx8X39h&v59ViO3|g|%?_tDPQf$eTUv{r=m8bV=WU>{9tYNS{vMyWgHi z#IZpPS#Z18#4zz*clCuGtNB8 z7X>4a@bmQ#;^*dH*IsISk=;~GdPaiU#;xOs1UKXBk zM+J$s-Kt${Ik{kc7tp3+r2AoFSE$e53E(o3aVmX$c>(PzgwT@pH)A6d70{gRmv z?)RxTt;%fX^BH-d+OzCBr>!Sa216poag{{2nI;sn# z#K!DYETx-uVw*OJam^)14A)UMO-dA(@ye+(uOB~rRv8aE*Ro-T?5|u_mBDZ9YAdff z*zci4?6sElR;@)u%Z?&~4%x?D@^9rYOI?zga%AqBi{+O=HoCEr8XvydiH&pJWya5y zm(w0yXOCp}(z)u%t(~~A#1LJcD;(XJ zHkfEa+g3N>eij_l)Kt=>7e51Y_MD&Z>-akehp`{S8&Mm#0|D)^T^K>XEYudT)F#$A z$&o=rilu5=1I+7FVD-R!wO82uT>QNK-29{M!gJ7fzI^)QuTR$1UVUy%DXiJ-tsLO{ zUHESwm06V!N!c9e@o)+wg9zYfh>LtAShXxb@tF`^p=i-*5rYdbRnG`Bus#@O(VGh; zb|Se%x1JKv&^y3V2s67iq0y0qXKMyFn?`)_mMp=b&k$VR@Lh+%^~*zZ@AvzCABrp3 z`-zN3zRvUQb|MDvM{|^UXQUMqdi*1+x4q+e4p>8v6o+10lfnmtQg=vC3iOSWN4Ro zJv}pzRhi?p*$%CNIZl`dNDClV9H4TOL^UON&TuM7EGInJPe+6xq1g;Vc_dgxCw{3h z=Gdeb3kY?i)*7sbXM_wu7FMCLs3@x-C@G#Ph++ld;L6U(9y=Yl zGWhOw!P-ct3<`)FNNr5OOFmA_H1lPfJJ9W#uS{BmL{~+17r$M4y*zOBvK^Te4(x)G zbJd!`NU|Ejq)<~k(3~<8SSX|`2|44pT=07d0lRHuvgjBmu%-7F(&jshpL!>LqI$_(d*IFz2=!afJ($vo7Q+yE$9_qWM9`9;@|ay*uvn582&2JiM}>Q~$w?7; zL4k6}qdRv~B+M}G{1R%Jf@(;^ZBPSWHX@n&U3sCYp-f zy)f6*dS3fiRS$iI6&aSI47^Y>{K)ohEcADy*g~4{Lh8>Tcu=wcO4tnfs0<<~T(<&9 zL_{EZW==00&k>V}mq%f}D6<$81D1&asV$U8BQ3;5IOZB;+6r3JTNaWg(Ry05KE>!R zb}ijA%|yzt{TjibpwQ4XtaAY(#N<5RL>;~3c@xju;<|iYu%YTAFt#twL%wATm~e(r zgf%|3HkAxste|3&SC21ICGExp51$uVrB$G#o#U5*d7ylY-AJ<+p2sOH#8y^GQTdIU z8!qa89JMXl$4Lx#UhLMox%+yxt0ho1leQ~V3!(%nr_;%Q_2vr)yXCs{L>e9so(O{D*fZDU2W2rf#u^GA`IM3<%JWGIiy5f zRZPXsT%8sb8i}zAnstt`TwGq&sj8jYo2g_xjxuaYv!h~iCDb|G$|#bMiK61x+ncSu zxf!ulfaV1|8s;EPZmJg*QcO_V$&CqJxr;9^CpT{t{`%e8wcIE-y_tGis;OEh1kKf~ zB<);G3&q0iV~0B^-PNSTx%{6$Kp&KT6ZPkwYL8QhEC4*Vrfr&*v#~j;5q@B#m%S<$((rR>+@x{)mKvV=r@DhfcJVRE|A5_z8$165TLc?)yO0eIX{# z4i#kD4Ad%6!lXE=8>PW|m9H)xDsn{HlB-rn;hpg0@SY32jmn}Tda?*S0`5$9D#0UEo=&^DvjF^SHg;~Hk^-{j zT$A)~6y2%uNUa@;^8*$z?REYy#~t)Z*Q@L50rH>bT7F>f*oBmg*w0g^E{1_gaSeAM);(WK%;fBF)gADYJ&h9NJaQ+4DnA>BoP|; z-Y3E=6AO%!&Lo7dq4pDp-nWs3&Uzts!l8d>cb4keKMmJK_UKU=je-dT68<(poV1(< zQbLaw&`gosv2{~Oj5d&ny0qtsAkQXKXh|Q394nDl(;s3q|C3Ijb5aHoeQ-b~6%~Jk$Kh6aAQ8_zd!~gB zjX3UWVvNs|QI&4Nkc7U&Dv@PCH*2I`7cmfz=JEsxRp)$;;hK|GNKb@N*r|x~+U@y8 zy=38pA;i;`zlsHm2yN2<`wir%splZ_9kB$>I4TkJxDX0Rzg3YZl93~mqJ;~RxJ|xJP{z%O{M1iOCCQPtSS-w6i$(x&4-Bbo3=QjQw zWbCs_o~2M%@=R;VLNoGquJepM4JD}f?vJf~N6x+>*n;_AJ#2 zR!-ZrwpzUz$d{Fwl?1|hnTIO#Mop8pw5+8v!nsz{m~|K>!x3{Z@b1h-L}g_X|D&O1 zJ?h@o(d=c-MbjYM$p)2_@2(uqo5UWrc&#mqy{rudfgJu#ka>19$#qjvhMbm-PITU; ztyRUBbi59@V~uMQLePO|QQ(+!k`|$QkrHhE%F=+6PZ7;-RI$K|jVXZya#8}RM5-c* zJn0g9iQCRfgOudk9j@4O$y5yEjNQzaY2BoMT*zo<4y_RU@oAs%ZlpjT2v;mot#Ds%q`~0&EP>gd42kCslsV%-bP-ifh!8-sIg<~B zfIQt0C0o?&{FD0ob=vtdwmk4NQrn`}lPF@UH}7(5y{^J;Dp8_^_jdB>yX+~8$50ef zqo(%fIy0Yh_vb!>M+;RCRcpBe4p%)k2%b>P0x+qB5CA+(WD+EQIw%vKk$*JvSsj*>qs8mBG9!G|v z`QUa%k%PpYvi~=e-)SL!B>OXOs~|EajtdmCK6>p_wcRi_J-3%qymfWv?oAPsbWb@e zQ3>ajnWd6=J}-z&o`UIMbdSr6RdsntZL7DRN?i2OU{KT@!R1%62-) zK-W}Ypj<`|CF6Gwb?i#ECPNHCcdmL#lzWz<1n`}ipCoH>(La;*ll*_w{v>$ME_&^Kid2Sb1S~QKKx$V zyOfBsL=z|<-0A|Kr&IlE`%H+qVRt_9AJ*^4-u7|jboxbkRb8oxua_SU-Tt4;&&kT! ztq^m&n;WdDq`Q(KFR8cJj=r%YMoBAdwek7k|h5I7Awn^XUWP zxIJ&QD=v{pXUMpbi8#eSP6kwU%;eSXYzy03V7j90;?i>Tm?F;)erlYg#}Vr>=bQ?M zJr9)1zkEsBUKS%%xkZJU5-07;iSbj`^;RX=4ae)cdNJV|#KUI^arvzd7e` z!|0gN+DT219}MkePLl$>p6*-r;EW?^5=KN40(HE}f#fzLd)sL$(E4W#c#~=#WQxIb zwV~YDgA{HzL1oOtT_T*(Ex?mA3wwn4uCF5*zao1KPnA_SX((12c?ZQfB{w~FtoHKx zCdPLO%S0AWr>p;c}S5wbPhe!~W7 z=-#f=6Lg|>Dykvn+}w0Ebaj(88v!|q2B%@hW|FeG8+kcy>uL<$X5+;%kaCtKl^IK@ zWyT!qnu`~d(PZk}lW?ek za#bY-0)@(SafL#A5U~>M#Y&@nu?}KErBAyE+w(Tj4fbv>tVslp1b0KZ4-9!5N1>LkyL@#@4c<+} zt&G__0T$vO zDrVKFWtsD;2%PPVje0!Z)f(@Wc!u=(4EA(D?0B{&#mHwKQ_YlT!E>_&ld>w22gs3A zFw_#4XT}_aCmOJfN0{mfSntG$i=PeN-L{A$4p(dUpe&5E8V6hWo4DvOiuHs~=-B~X05xUyFvn3o~s_LhT zaFaRNi?)@%(Y0+lFz>S&M-0YlXi?Wz=#d9i%?R0RZjlfbTgLKjNd``z>yO*}_-hZo zUuHE&v99c5zO?qx{9nqvJ)cecrr2=Vr30j7?AOACN%& zKT2{H!Hnz`o&b=hPpg(>oXSJ_tT?vTHaoVqYqQnB0 z#cz9(aT{(7m$dxz12t9*TpVuA^w!TqqHglvMa>8rri5YhUY@<$yksprL1RUH?D#Qf?+6J=c6fyh< zY5`85`*q@8V2JP~ux}Z-xVk@57kQ+W=t+V=LBUVKILzfW!fG>+SY^3&U4!}1(V z_EgIi`}VN?9IPb8B6ZuRbyHpH$Pg-R%D9quMowknKJP=i=szV%db}lHV<0Xahzh63 z?Ll$ak7EhDmIQQlL$qR4rW^qyOATg7m#{r-B}|c8Nv*vyS;&8(t;ss zXGvKKv^39mtvCXqY$q!#>(2Q-u58DjYO0RGG32g7C+X}8qgG#)Qbh+)#JiIESh0{@ z(j`BZ#It;9MXu~s*8An?&eNkf;KTxPN`Jb>ij71KKtMt}5J3oVn%kQ^#eI)P5mnm6 z%OM03H;eeFX(&Ak{yz@wx6LkFt>&g&*7KRnZ5THK%czs9@P2Q%>TwWje!obe8#`$1 ziPkVu7_SkNYBXfy%7|MP&70zEGjF z&h|P~qc$kNByGD+W|UY#itWYSF|kI>n#%~XS>y62^~{Q-t zJ9$^yi@4=U3?eM7qqwt)QHB1AC2@80zsJ)avdT`B!Wa<&qtZptFZ{F_bt%N z>@qD_B*&S;wPXdsu}VA8umEJspH9SoF*VOnVUz;7AsM@A> zvuk9~t3q`Nsc~&xEO)Ao5RO@6El-%`cIGJpqW`PAG8sMZo=T{x>BeQmj@8I*8I7i< zQ$W(^&wTQ7j6@NA@*ErT0)-h+={mKPN|i1wlPFmkRY68BIUYQj+S*1b&itVxxPY^Z zI(9OJv@B*g2@DcCCIQf-##0b9nAhxy$h0k)?{qnG&vSMQs~G(4R8Yz}rn|NkV>1ls z$(IljDeb18C6Cy zrxgqngm2jqECWgeYC{-3MC$JDh-FEl0jz@P%Da1+bWChhH4txID`{ZEFmego)~+#0 z(-CwKy%1(+CeG2_YSX$VYg!?h7WZ>0&8&x__NQi!+pO8FjbXQ$EL=tHh`oC^cqeew zg`%>Ux~zk+w88E4UuU5AJBChHb|>^zcZz$n3tx5{s8yYf-fMtH{T^71h_2IS0L%E;ITatVs5aTichB;=q`?aYxKYnJu!W1(#brJ&4o=4?ST zcEk{c=XL4JR_wxeRP0FYNy?{8N#{<3sS;rVS)5Ey3VMfVt<_>vJl3=xW~|DXuV#Fw z&BG@pRIaF6d$|psKu0QtN#Q7y$)yk$>f8Z6}G;65mrfMUU!v&u4LLy_9aD{P#7jj8=sK193qGZ~$<;;lqK1_uW(9!*Qi z&nxL=^|EEVa0u8z_i%ihG+mFKP(7?LZ@r0?=Qg#ixbSCrcrP;)bxN_hSSNH!nCqEQ zQUjdRILrz(XA{LYDus|t+!T;mv&Lel^Vi#M%v@$qSeNWngXnV2x_fZIE7cvD;hj_5 zY+>A8mI=rR67}QyJk5-#%4Co$5P~B{bhs>%-%lP#2yuM@ruAVNznlq4%!)5%Eq|#k3TK)0MQe-}5 zzd6g4je?y&D-x)xPgQb|l$40saPd3wx{NYTigxjN`d$i0|q>9eUDJX@3tkm z_Agp&EW%zN61VDm(M<9USdGr!Lsx?jW^M1(?NnWE#MtX)xz_PFw;m+71-1@4IX%vf zO>ed+sA;YaZhPICyY=jNT;2n7*7dRw(MjkY%=BMF_>eHjwiXqV$%JDTF#N1Pv-?ch zmDg~3bD7Ev7&Qa%;vq;fgb)}Rn0X$~oN#byH%$fOhEUmxWGtePp+iI^r7?_SAnU~& zInS4~tlZ9__Hij*ufMhH%erao-pa)`;<8&Lyxwe2y+_KK%E~KdkzAu%i2|hwicZEF z-F&ZI%Cn-5G4WjO8L3q*0=-hWE~@LTH7k}7b$y71P-kmdvsg9@1=xARcpB_Y^9ZV8 zfnT#ML33&swP@bwbnJ4`+pURq6(POF(gyarf`&tJ27v_vrGx;ig@_qvUO) zBkQ?5Ve^yPg}qKH#e_VIV|7_nlDfc|0A*7W0TeI^L+VxiGLq z5D;-9S12nF-cBq8a%Bsfq%nuw`IKXouEnOuU{&gEF7l-uJ3#!e`MMBASR_Z`Q@NB1 za#)5FZW?Gz5J3~!DKVIDpxiX2MkByzw)M4JIr4gW;8?JgjNJ4dJY9`Wn5IPKt#O=3 znb_Z>R-Nxl98s#q>}X)Y476b-@pl)rV03pk%YlJ_`acihKhxdr-O1SI z<~;|r0W2F@oZo0eOW(vvC*u5n@k13*Xk!hdnHb3lAY%OgpYZ+DQlWFd;iURD{wuwC z4$9eAK!?_tfVm!h5wLeniw6>PSqzDmA(OGA|H16k{5dqa_SuhC3#rZ8+}?!jZYzwu z+s0qUA`i7t1z=GH!*02N%@XGOAPHL*gc;UFN~Vy{Jd%dVKr&dM(6fa#tKUWMWlU|E zdgpwmNBq?qm^7wAIa+X8G>;}2Aiu@41qdPnzT~~XBo0pY3A8$8iQobP(ZhlGxtn0LG#yn-GM`U{Ob7^fYF+_tPu{b{iT z0~1#a8HO8S7iiN}6&xBg{bsmLbevpvgL{zX!;etgNwGG@A_P$eEQ+cqBNYWyL={9x zNg*e-emXJtd2<|h7UreK+c3dy7ZU|Btk)c?cLs%NxMJmV9M=VzaLc0#Hkv7Il@`Gp zX_kdz;Nk_gW>XN`RsgCPfT0@5qKd6GXk6U7)y=_Ll*>yt<|u7wTGSCyF}Ce7b8{5P zQL2|wrDVjBGU636iv^-Ww$mXq41@+25Gi8?ilD_6RYegLaVuJoE~SeiED!~X3Mp8j zSSTuxP*F%KAd1NaBv2$rH*L9?WiBS%6fkC#7FN5C<;PqM+E;6CVq)%>b*>I2Pf$Wn zT=jOJjW%`;#Ct+Xx`d(L!jH&8+;ClU~0e+!iLm^Jx@wsQs#`iGpulYC%*BQlp&=Ue^Hb&b+VZdMns3d zkNo$0zxP|`n{{K7%~_$dE_f`u7wwrDn=1TDH$c&3p`!sj58^o;KX+BGL7*oCl^3U{ zl)~hHBbe-1Zzipo1Z)gl-a^@cGii6qdA}jLA(!gbM7SOYAZ!4~Ji!RLN1a@E^YwW;>g=m#eUZXkF<0h{w& z=-kWL`89Ny0`dY0HTgb_OUmDboh4ve@y_W&;-h60sk)B?Ve>)uU`;SQ!83}M{S>v|myk0l=lj~6#nsAL6qAR#NM z_@@ND%3I|&jx$T|>Gfv9K$Bnm!?y&6jl8Ek(*i&>GEQ-3GT=_ z*z#>;6nx0rMj?hOs4Awji>;}&ZVaD~nG$~cA?p%r2q+qIS|VE+Jwui@G}DyU3-$6| zr2D?Fz0YNJv2jsiPD_1vsvtQ&7{h!7prg6)HodS!D!BFmW{+@H(Sh!DAUvI}1)-s| z)a3M|Pp4s1D!XY|&F^cyjt#OdAeN;!x#X1!vcUWeOWGIQ%>#oKY}vu-3Wg;DL|`6L zQfd79j)mUEOOZd5yn zg7(hQ_J~liCwcUJ_AMV;c(GL`n5;uUp9ijVn^zzE#7@sXvbuJn7KjM`K?q z;t7!X`4)f~ETw5P2uq-#PfGYB6^_-eb*}8T6K7@wu~;HXlo)h3eb?FK>Rs zXBM5~gUeR8^rgw}AGxvFm^qrLiiQu?v1qKzWHnbN(t4ifme&_(ia9XI9Nqr#J&Y@x zIygMcU4z*AtQmnHFV*#Z6tQNv!U%07#RLQ=>WN*il?6hB2DpQ>YQ~4Ix3A}bdgt?6 zcj{DWLodFR5)e*LVWOyld;pf{LutJ38F#zkWRYYfSqQQ~6+uY?C;~DNQUJ_a7LNoaqT1Sw zI5o=97)-&ARUogS0t7d<8sxsM0jCXE@|ZykLO}}g9j)Vo;gSkGyxhmJxvTOsqloQc zhVi8cB!lMPLV(!!tEQS^5_6z~vU{fk(@aF;VCAJIIvbsP4eyg?!!2Qz?P06b^Jvs) z_Em@;=1dr?dP7%GnrjNMOOsiAUPu+mhFSsQH#azKch;%BhE%gxR-n?(P9bxTQ4UpM zE_JyufEc_aPK~&+4r7)fi=~|#+Oar5vQXzey_C_KS2F_yDTzIT(#q^0wPBl3kH0U; zTNY};?%wV0b&n!mW6S|J0IgcMzjSC_slg8I9TKbzlQ7hBKt0& zG<{5fL)P`SMB{K7PAbpG!QzNdIqBg z=MM)K#D&Od36rgm!R>idXH&zG#Fj}U_y2hQL4SQE2>5yA`@4^k7Ei{r`63k^8*wl; zq0Ax@F#-~zB}FDmz`lU^mG=5%{9nWP*#6V*#Kxv2qwLUBr5D&=RK{vXKYr5`!i6tF z7Ld+;r0*6nTKCOgZ5De=Js4WzAHuThqedqWF%2|^a^v@(y8RkUvgUPFS6q@qGvQ@* z!b@l{n0y)6I!DH=(RPV`pPwX?&wKF~gcZ0JWmy;+&9=tYw;+Exu!q4BIU^x6F~TPJ2!W`D191zPkky7axHH9$E_XpNPzfVLvYrLK05H>?z zatFnUwnq8u_v!XeJ5=XT}L^8HvVP9aBE&VQr0!wl%;mu!BjX78*6_(w%( zxOxJW&M~0%+Je1D(8C3Ze4HK**1e{bdb3^5I~4n8IXy~jTTNUyKP;WE=20yNd06K+ zTKmV%k}!{5H<{q+CL>1?q=gw6Q_g3nean~^h{R)Xu%X@_h9K@w3SBbm;9{}WEP~3a zs_R~oiiHO;?J}@GqRYhCcGvsyTg0q|;tXBzLmMBo=lg!oPmMySqsBzU-Wd36CSE&M zbBnPg6jWDNvDa#uNYRtY&eC`iKh*Rw?)8B7;KRPd)bLj8G;7VhedI{GzV>toFvA1c zy+xNvr*3bVY{sLbjLb6(!(eUR>e_^B6Kxq)L=7vdHYPzU3btM6<7uzP4|QK>CL$lb{lJziPPSoPtXXTj~d$1I&U`PFFpA#SON*eg3lk%q@lvK0e~w&ROVQwa@F$N^#&+@w6t!)4_3Z2f)&ANj!Wd z_pE88F_$SzR|57Z$8z0Q=Q-o6VzJLA{FF$r#)8J7RIdE#d0W3TYqeVU+)^Dy>U;!M z1r${jQAHI&MHEp*6j4-IqKZ81`Ck1#JWK2Nl=h$2vmVc0GqE{OsrF;*A#!kF=?Ohq z(j$<~+laRrXe8B*rG3{d{0VCAG`Dq`8O7BtWzqfX&8-i&p=Qa*o&G-Prn{`b^Tw?y zl@%#iW*bIoagELn`7H*XXJZ3?$?$EGOA<+@IK*b}Q6>IcHN;{X7U$G7ydpCdAc%mWyf=&r1{U$h zeO^kYFSco-T+;|TVonSgE8I;51ugKcQsK-p%)a$1>NAe7mEQ_8x4QQ?8;nSZW)>j{ z7;-e0M=;DZREuEb#eQaQsD5K9+uywoTuwU$%-bR!ezar_1~ruka4@MIqx5FD&GaDW zYjziJIE>e+8qET9y-QG4(z9y_pPgDW-(^ zdZ+6nyoiezJBIUIUf}6;KBnV!M5vlWOb-^5Vty_M@d3mr8Y6DrDMHuQu5;6|sZXPp zZJBPISLNk#DvC@>!wgd-q3ZJY)UGG&-wdYacACt) zM?M6M=AfC&+dB7^VUk67$x$CBiORon_kLlF#D<~|d8Ztvf%QfcR)uM&LE7!O zorkJEIkmR8JmNwi#hOb2Fdfw{=Y~rC4+e#b2MR+;wP-H%fpwBA%T#ib#D&^8e_B_A)>5x`@vM))O2_~yIdBYcxEb8=$^$}5X z?<|lBjX3B7!IDAgDwSs>jYR~XoYmWI0%3+2d;5&Dbk#;h2L4KnZam}SQ2bNhP6Wfy ztt#$Ul_CnUe7C^I9D3yn`cD`ly&e;_1KK{EYWxql#KSW^`tNDCBMbdWjP*O_alRK& z22>QLOqf*1ynobekW`e%xXR<*F{=UCFgU51v;MnC50oO^vgL9P+lkG|T$PM0{1`po}C}$p0ZEXhaQyJL|+iAIQ(rsPGaPK-=FxEo4O)G_}{HIo9 z9Y}{HbeX%c)KtXc*vJhBnYy);QHjIgSl%%jSIBy;J}mqmEV|-c{*{}fm~FP(V{Pma z-YP5eX*3k$Tm9TEcVh}2a^6P>@aU3R#>c_vOOb6e z{ThlCIs0?coA_A07o{q)M4X_Qd*c%!(bW+lG|;Ju)T&=8BcLp>dlOkY#G#rLGGO@B zqjQ45k=Vmbi@8!L7E-$T^y#}vMKdpWMH)hkj-m#hUP{fH;kn&$stAg?Ez@$*hece< zflJTtUsBG)XA>&l3FtcniKGu(JTOw8>or9ifSA>p7o}fAp6p__m7jCcQ*W$;9ol7BFU+d&dU|^eIc5sC z9wu&(>SH5+Wfwuv#>Cf=$-KNR*e1rt#>U5@bCqR%w4Z9`RAcjdzK*s z_Kj>HGCup2vw>FRyBj3{c9c|z@g#H<)cKy}ZA&`#@X;E6)@`XBM}Mv*?c^@=uYsM6 zy2n!Rvg2u=If9vnVVGtahMTD~x|4lN)?%pjIs*0#TmU;}#=+OM@DSGJk6g zH=w|cWm*j3f^TZ2P(DTEclB%U*lXTPDkysFc%GYk{Dw9*Ha_pXNi1d=hGDTSs=j9O z%?W)D-X^qcyHfkIx;HL`xzo6rrMZkq4Q6&4Z5h`yRZ=}e8J{7J zzu)?eqC@p>Zpg+!w8fOmn95F$vl_lb4gr{E64q;Bs>-s_Nm*W=i=<5Fa*=Pf6C587 zYLimTSB4y%B07yGgFG9KQl(Tej+B};s-X|1u+<*4!>N}bj$xMC=+i4&$pWiX>`^9x zj-u}iL1m-V*m5ISau!c^OFrSF*0JI?F|o0+vC(*i=u*X)*zN0G%z0T$5**%{fIGHaB3{Z$Fg4u z1r-?Ha57_KW85wjPaB2e@tu*5f58V$3)wtC$^IKw)j&ZLt|aiqj&0ZWUGl%cZd4BI ziSe{k+c@IpUJ`B3|>|BJaIoG3^l9O@N-&iFjl From 86a6d3b6bf3fb39c36d03fcc34afd73f62998835 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:36:12 -0400 Subject: [PATCH 387/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6b157e273b..340d305f38 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" RRID:SCR_024675. -Version: 2.1.2.9063 -Date: 2024-05-10 +Version: 2.1.2.9064 +Date: 2024-05-29 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"), From 6ed8de72697b5c6d797d13437834bc1868a9a43e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:39:52 -0400 Subject: [PATCH 388/503] Add msigdb ensembl ID retrieval --- R/Internal_Utilities.R | 81 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 87d8ead28e..331f8d8654 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -562,6 +562,87 @@ Retrieve_MSigDB_Lists <- function( } +#' Retrieve MSigDB Ensembl Lists +#' +#' Retrieves species specific gene lists (ensembl IDs) 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 ensembl IDs +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_MSigDB_Ensembl_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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) + + # 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 + chicken_options <- accepted_names$Chicken_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_ensembl_list[[oxphos]], + apop = msigdb_qc_ensembl_list[[apop]], + dna_repair = msigdb_qc_ensembl_list[[dna_repair]] + ) + + return(qc_gene_list) +} + + #' Retrieve IEG Gene Lists #' #' Retrieves species specific IEG gene lists From de4753616fffafc30947e1f97797d9a9b1288bf2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:44:36 -0400 Subject: [PATCH 389/503] move script --- {R => data-raw}/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {R => data-raw}/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R (100%) diff --git a/R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R b/data-raw/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R similarity index 100% rename from R/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R rename to data-raw/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R From 6c32f982f20850ad374eb4bbd652c01da2080a92 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:45:14 -0400 Subject: [PATCH 390/503] update docs --- man/ensembl_mito_id.Rd | 3 +++ man/ensembl_ribo_id.Rd | 3 +++ man/ieg_gene_list.Rd | 2 +- man/msigdb_qc_ensembl_list.Rd | 44 +++++++++++++++++++++++++++++++++++ man/msigdb_qc_gene_list.Rd | 4 ++-- 5 files changed, 53 insertions(+), 3 deletions(-) create mode 100644 man/msigdb_qc_ensembl_list.Rd diff --git a/man/ensembl_mito_id.Rd b/man/ensembl_mito_id.Rd index dfc1f4dfc3..63453e440a 100644 --- a/man/ensembl_mito_id.Rd +++ b/man/ensembl_mito_id.Rd @@ -16,6 +16,9 @@ A list of six vectors \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken mitochondrial genes} } } +\source{ +See data-raw directory for scripts used to create gene list. +} \usage{ ensembl_mito_id } diff --git a/man/ensembl_ribo_id.Rd b/man/ensembl_ribo_id.Rd index 4459071f1e..ac0dae4158 100644 --- a/man/ensembl_ribo_id.Rd +++ b/man/ensembl_ribo_id.Rd @@ -17,6 +17,9 @@ A list of eight vectors \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken ribosomal genes} } } +\source{ +See data-raw directory for scripts used to create gene list. +} \usage{ ensembl_ribo_id } diff --git a/man/ieg_gene_list.Rd b/man/ieg_gene_list.Rd index 7315c8c751..4e48ebb688 100644 --- a/man/ieg_gene_list.Rd +++ b/man/ieg_gene_list.Rd @@ -15,7 +15,7 @@ A list of seven vectors \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. +homologs according to HGNC. See data-raw directory for scripts used to create gene list. } \usage{ ieg_gene_list diff --git a/man/msigdb_qc_ensembl_list.Rd b/man/msigdb_qc_ensembl_list.Rd new file mode 100644 index 0000000000..cc786570d3 --- /dev/null +++ b/man/msigdb_qc_ensembl_list.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Data.R +\docType{data} +\name{msigdb_qc_ensembl_list} +\alias{msigdb_qc_ensembl_list} +\title{QC Gene Lists} +\format{ +A list of 21 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} +\item{Gallus_gallus_msigdb_oxphos}{Genes in msigdb "HALLMARK_OXIDATIVE_PHOSPHORYLATION" list for chicken} +\item{Gallus_gallus_msigdb_apop}{Genes in msigdb "HALLMARK_APOPTOSIS" list for chicken} +\item{Gallus_gallus_msigdb_dna_repair}{Genes in msigdb "HALLMARK_DNA_REPAIR" list for chicken} +} +} +\source{ +MSigDB gene sets (ensembl IDs) via msigdbr package \url{https://cran.r-project.org/package=msigdbr}. See data-raw directory for scripts used to create gene list. +} +\usage{ +msigdb_qc_ensembl_list +} +\description{ +Ensembl IDs for qc percentages from MSigDB database. The gene sets are from 3 MSigDB lists: +"HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". +} +\concept{data} +\keyword{datasets} diff --git a/man/msigdb_qc_gene_list.Rd b/man/msigdb_qc_gene_list.Rd index f0ec651e6b..d9ebad375f 100644 --- a/man/msigdb_qc_gene_list.Rd +++ b/man/msigdb_qc_gene_list.Rd @@ -5,7 +5,7 @@ \alias{msigdb_qc_gene_list} \title{QC Gene Lists} \format{ -A list of 18 vectors +A list of 21 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} @@ -31,7 +31,7 @@ A list of 18 vectors } } \source{ -MSigDB gene sets via msigdbr package \url{https://cran.r-project.org/package=msigdbr} +MSigDB gene sets (gene symbols) via msigdbr package \url{https://cran.r-project.org/package=msigdbr}. See data-raw directory for scripts used to create gene list. } \usage{ msigdb_qc_gene_list From a249e3825d157dfc199cc980090d9807a6e847e7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 11:46:05 -0400 Subject: [PATCH 391/503] Add msigdb ensembl IDs --- R/Internal_Utilities.R | 10 +++++++++- R/Object_Utilities.R | 2 +- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 331f8d8654..7cbaf27ad5 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -904,6 +904,8 @@ Retrieve_Dual_Ribo_Features <- function( #' 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 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 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 @@ -925,6 +927,7 @@ Add_MSigDB_Seurat <- function( oxphos_name = "percent_oxphos", apop_name = "percent_apop", dna_repair_name = "percent_dna_repair", + ensembl_ids = FALSE, assay = NULL, overwrite = FALSE ) { @@ -968,7 +971,12 @@ Add_MSigDB_Seurat <- function( assay <- assay %||% DefaultAssay(object = seurat_object) # Retrieve gene lists - msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + if (isFALSE(x = ensembl_ids)) { + msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + } else { + msigdb_gene_list <- Retrieve_MSigDB_Ensembl_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"]]) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 07e214bb1e..5eb0f4b1f3 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -239,7 +239,7 @@ Add_Cell_QC_Metrics.Seurat <- function( "i" = "No columns will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field MSigDB Oxidative Phosphorylation, Apoptosis, and DNA Repair Percentages} to meta.data.")) - object <- Add_MSigDB_Seurat(seurat_object = object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, assay = assay, overwrite = overwrite) + object <- Add_MSigDB_Seurat(seurat_object = object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, assay = assay, overwrite = overwrite, ensembl_ids = ensembl_ids) } } From 994e543b3ab05491c945f4a2a90dff9be213b08b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 12:05:53 -0400 Subject: [PATCH 392/503] Update and rename after adding hemo list creation --- ...mbl_ID_Mito_Ribo_Hemo_Lists_scCuztomize.R} | 67 ++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) rename data-raw/{Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R => Create_Ensembl_ID_Mito_Ribo_Hemo_Lists_scCuztomize.R} (71%) diff --git a/data-raw/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R b/data-raw/Create_Ensembl_ID_Mito_Ribo_Hemo_Lists_scCuztomize.R similarity index 71% rename from data-raw/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R rename to data-raw/Create_Ensembl_ID_Mito_Ribo_Hemo_Lists_scCuztomize.R index a1a0c71579..87ef7bf745 100644 --- a/data-raw/Create_Ensembl_ID_Mito_Ribo_Lists_scCuztomize.R +++ b/data-raw/Create_Ensembl_ID_Mito_Ribo_Hemo_Lists_scCuztomize.R @@ -1,4 +1,4 @@ -# Code and functions to create the lists of ensembl IDs for mitochondrial and ribosomal genes +# Code and functions to create the lists of ensembl IDs for mitochondrial, ribosomal, and hemoglobin genes # Functions ----------------------------------------------------------------------------------- @@ -126,6 +126,67 @@ Create_Ensembl_Mito_List <- function( } +Create_Ensembl_Hemo_List <- function( +) { + + refreshHub(hubClass="AnnotationHub") + + species_list <- c("Mus musculus", "Homo sapiens", "Callithrix jacchus", "Danio rerio", + "Rattus norvegicus", "Drosophila melanogaster", "Macaca mulatta", "Gallus gallus") + hemo_pattern_list <- c("^Hb[^(P)]", "^HB[^(P)]", "^HB[^(P)]", "^hb[^(P)]", + "^Hb[^(P)]", "^glob", "^HB[^(P)]", "^HB[^(P)]") + + ah <- AnnotationHub() + + hemo_list <- lapply(1:length(x = species_list), function(x){ + + cli::cli_inform("Retrieving ensembl ID for {species_list[x]}") + # Access the Ensembl database for organism + ahDb <- query(ah, + pattern = c(species_list[x], "EnsDb"), + ignore.case = TRUE) + + # Check versions of databases available + ahDb %>% + mcols() + + + # Acquire the latest annotation files + id <- ahDb %>% + mcols() %>% + rownames() %>% + tail(n = 1) + + # Download the appropriate Ensembldb database + edb <- ah[[id]] + + + # Extract gene-level information from database + annotations <- genes(edb, + return.type = "data.frame") + + + # Select annotations of interest + annotations <- annotations %>% + dplyr::select(gene_id, gene_name, gene_biotype, seq_name, description, entrezid) + + ribo_ids <- annotations %>% + dplyr::filter(str_detect(string = gene_name, pattern = hemo_pattern_list[x]), gene_biotype != "LRG_gene") %>% + dplyr::pull(gene_id) + + + cli::cli_alert("Complete") + return(ribo_ids) + + }) + + names(hemo_list) <- paste0(gsub(pattern = " ", replacement = "_", x = species_list), "_hemo_ensembl") + + return(hemo_list) +} + + + # Create & Save Lists ------------------------------------------------------------------------- ensembl_mito_id <- Create_Ensembl_Mito_List() @@ -135,6 +196,10 @@ ensembl_ribo_id <- Create_Ensembl_Ribo_List() save(ensembl_ribo_id, file = "data/ensembl_ribo_id.rda") +ensembl_hemo_id <- Create_Ensembl_Hemo_List() + +save(ensembl_hemo_id, file = "data/ensembl_hemo_id.rda") + # Deprecated Code ----------------------------------------------------------------------------- From 19f4c2a8e8481e21a619c5d7a0b85cc52ed5d686 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 12:06:06 -0400 Subject: [PATCH 393/503] Add hemo ensembl IDs --- data/ensembl_hemo_id.rda | Bin 0 -> 741 bytes man/ensembl_hemo_id.Rd | 29 +++++++++++++++++++++++++++++ 2 files changed, 29 insertions(+) create mode 100644 data/ensembl_hemo_id.rda create mode 100644 man/ensembl_hemo_id.Rd diff --git a/data/ensembl_hemo_id.rda b/data/ensembl_hemo_id.rda new file mode 100644 index 0000000000000000000000000000000000000000..6e23e6f2d69bee8983c6c8a11aad6daf290d0e69 GIT binary patch literal 741 zcmV&KyfagAgfFN~PW+ z6Raf2iK{q8{CdQ+wQIYcO=LTnXLk18o%QTah8Jf4Vn0ceon$cJ`!4@XcF%vDe8eOf zJmfzQl0ou>p9k5x%vL}1=^|Sd)8(%udH9OWdwf0T>qX`E^7HB0`21|7ZazR1f=Hb6 zibUdxKqkQ`Z=!AFezel$M8bf)L;x&#SpixkS%J0|#b~UWtdi$I8zpN)qahLvy@p6M z9hn1kLB$jRhAM*xb)wm0RF5eb+c#^|@?$ozbQr8_}6aY~3>}^iK7?ffWWNn6)ufP4J^u3XZ=XH47B1NUXumi_j1NZ=xiC zOgt(h5*0kp)~&|FmdEgDQhBft8$@CqSRExsB*8&v2{*)9o(++Z^(eP7pskmQ4|l7e zOEfx=$K$D4@qOZCZ9yBk9}1ihksv7)74SlGM3FW&hzbClRkAijW0Xv|E=36Ol**YS zBliP}-*K@G6X#?C-h-HJ9*>f>aWo(42OMt#)hd40@|c`{uipUc42Z-AMJSS>xO$7k z@C;If1eDuo(w$ABO)x^Z1Z!EfMu12^s;OxA<^a8w38!7xTft7{@$}@=e9Z$223^Ob z9dCuc>!pKtb%1uM8;{THp#XLg&=Ac Date: Wed, 29 May 2024 12:06:14 -0400 Subject: [PATCH 394/503] Add hemo ensembl ids --- R/Data.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/R/Data.R b/R/Data.R index 006c659ab7..37c443ca4f 100644 --- a/R/Data.R +++ b/R/Data.R @@ -40,6 +40,27 @@ "ensembl_ribo_id" +#' Ensembl Hemo IDs +#' +#' A list of ensembl ids for hemoglobin genes (Ensembl version 112) +#' +#' @format A list of six vectors +#' \describe{ +#' \item{Mus_musculus_hemo_ensembl}{Ensembl IDs for mouse hemoglobin genes} +#' \item{Homo_sapiens_hemo_ensembl}{Ensembl IDs for human hemoglobin genes} +#' \item{Danio_rerio_hemo_ensembl}{Ensembl IDs for zebrafish hemoglobin genes} +#' \item{Rattus_norvegicus_hemo_ensembl}{Ensembl IDs for rat hemoglobin genes} +#' \item{Drosophila_melanogaster_hemo_ensembl}{Ensembl IDs for fly hemoglobin genes} +#' \item{Macaca_mulatta_hemo_ensembl}{Ensembl IDs for macaque hemoglobin genes} +#' \item{Gallus_gallus_ribo_ensembl}{Ensembl IDs for chicken hemoglobin genes} +#' } +#' @concept data +#' @source See data-raw directory for scripts used to create gene list. +#' +#' +"ensembl_hemo_id" + + #' QC Gene Lists #' #' Gene symbols for qc percentages from MSigDB database. The gene sets are from 3 MSigDB lists: From e59c432420ba36179aaef2bbc004a6397f0525a9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 12:06:26 -0400 Subject: [PATCH 395/503] remove redundant mark --- R/Object_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 5eb0f4b1f3..a2eb7904a1 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -674,7 +674,7 @@ Add_Hemo.Seurat <- function( } if (species %in% c(marmoset_options, macaque_options)) { species_use <- "Marmoset/Macaque" - hemo_pattern <- "^^HB[^(P)]" + hemo_pattern <- "^HB[^(P)]" } if (species %in% zebrafish_options) { species_use <- "Zebrafish" From 1e473d37f2b5b1c0e797557eacc0bc7c6e638246 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 12:12:30 -0400 Subject: [PATCH 396/503] Add hemo ensembl IDs --- R/Internal_Utilities.R | 69 ++++++++++++++++++++++++++++++++++++++++-- R/Object_Utilities.R | 8 +++++ man/Add_Hemo.Rd | 4 +++ 3 files changed, 78 insertions(+), 3 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index 7cbaf27ad5..ba4414ba2e 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -458,9 +458,6 @@ Retrieve_Ensembl_Ribo <- function( 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 } @@ -481,6 +478,72 @@ Retrieve_Ensembl_Ribo <- function( } +#' Ensembl Hemo IDs +#' +#' Retrieves Ensembl IDs for hemoglobin genes +#' +#' @param species species to retrieve IDs. +#' +#' @return vector of Ensembl Gene IDs +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_Ensembl_Hemo <- 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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) + + # 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 + chicken_options <- accepted_names$Chicken_Options + + if (species %in% mouse_options) { + hemo_ensembl <- ensembl_hemo_id$Mus_musculus_hemo_ensembl + } + if (species %in% human_options) { + hemo_ensembl <- ensembl_hemo_id$Homo_sapiens_hemo_ensembl + } + if (species %in% zebrafish_options) { + hemo_ensembl <- ensembl_hemo_id$Danio_rerio_hemo_ensembl + } + if (species %in% rat_options) { + hemo_ensembl <- ensembl_hemo_id$Rattus_norvegicus_hemo_ensembl + } + if (species %in% drosophila_options) { + hemo_ensembl <- ensembl_hemo_id$Drosophila_melanogaster_hemo_ensembl + } + if (species %in% macaque_options) { + hemo_ensembl <- ensembl_hemo_id$Macaca_mulatta_hemo_ensembl + } + if (species %in% chicken_options) { + hemo_ensembl <- ensembl_hemo_id$Gallus_gallus_hemo_ensembl + } + + return(hemo_ensembl) +} + + #' Retrieve MSigDB Gene Lists #' #' Retrieves species specific gene lists for MSigDB QC Hallmark lists: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index a2eb7904a1..618c108e48 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -563,6 +563,8 @@ Add_Mito_Ribo.Seurat <- function( #' @param hemo_pattern A regex pattern to match features against for hemoglobin genes (will set automatically if #' species is mouse or human; marmoset features list saved separately). #' @param hemo_features A list of hemoglobin gene names to be used instead of using regex pattern. +#' @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 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 `hemo_name` is @@ -598,6 +600,7 @@ Add_Hemo.Seurat <- function( hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, + ensembl_ids = FALSE, assay = NULL, overwrite = FALSE, list_species_names = FALSE, @@ -699,6 +702,11 @@ Add_Hemo.Seurat <- function( "i" = "Please provide a default species name or pattern/features.")) } + # Retrieve ensembl ids if TRUE + if (isTRUE(x = ensembl_ids)) { + hemo_features <- Retrieve_Ensembl_Hemo(species = species) + } + hemo_features <- hemo_features %||% grep(pattern = hemo_pattern, x = rownames(x = object[[assay]]), value = TRUE) # Check features are present in object diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index adead8da6f..b45b939bd8 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -26,6 +26,7 @@ Add_Hemo(object, ...) hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, + ensembl_ids = FALSE, assay = NULL, overwrite = FALSE, list_species_names = FALSE, @@ -57,6 +58,9 @@ present in meta.data slot.} contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). Default is FALSE.} +\item{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).} + \item{assay}{Assay to use (default is the current object default assay).} } \value{ From 2f561c50e6f0f5309042c5bc60cfd3883fe7e3bf Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 12:14:01 -0400 Subject: [PATCH 397/503] Update sysdata --- R/sysdata.rda | Bin 30673 -> 31025 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index 9677730073449644ff6413a9567994bf3d63800d..82a690c05213d957112076ed420d3334ec340740 100644 GIT binary patch delta 30712 zcmV)5K*_(+?*Xy$0e?bTXgM)KSte6i({;II0dG$K{{R2`|IcH8@IU|m^uPcA@Q?`y z0U#CxkpR#@1ONfxo_{DnP^tk!MF&F_C;-k1s!%8ZBq#!agarT!Dyo4XRZvI;A9y`| z-~;KnA5hVz9Rfg5djh1O1uNhHA)qsS-W-UjqK|YQhz$abkd1E)B(U9HhZnz z-5TxO4{QMT?y4}Cwno6vjewUt4(SL}%+qYBO=%$zmey9ccU4rLak_+to~6xO4HYe7 zXIMx=VSobw1mwv8l7U`(bp(a$KqMrQKqYOb7!3#tD2j;*0*QN^2SHL^t(6jq0*NH% z15^;C?Y1zA2!AD4cmviz01N9B7&sMB6cmI2lm-B4&^Gei^6k7{a%sp@)z)EYe? z001-q00006fYZ?sM3S1LL7|h>0MVdm4GjPQ000dbfCidrpaCiRqLn66dW{-yR1Gu+ zgGQPLfYG1~Krom?Kw@cx0iXaPNQBS{qfG#YDW)bvQxbVJgVLHk1j(j`Xn-;UKmamr zN?v|#dVj!bC?I7O6;_A{DBg-u0HTToAFJ#8zHg@i5Ca&5h$yIkcf;hq=YJBt`J8;? z^QJl&pYZ(tk%b>eGeZ3C{{QMBHJZKhbR)MNzqvN+{%n7Xc2@T3#~iQGtEJ@yR0ZuQ zq*)LMFpz=|^M9G0zo*o=N6T;Wu&@tmKtvA*k$=&{e@)B|TQorK(0*+=AOZur2nvGu zzsO`bMDCx;cUOn-xbrt3(ef57WeJ|6_YD|-0Y7Yzwx7a8?=}%DAN$Gs>Ee$+S=wsq zT9l_${o)_HX#@DW3QyS}Za;4t7?O)Lrd$ml$NzmUDM~Y%(i|fg6pumOGvg%l5YZi_ zSbyAE{2hc6AFYX~g}#UR)1{kZ`u|x+Z6289o3RW@hwvAG{`>HE>H4VJxzTjdW=x}S zobBVOom$Uj1FpT+JL85)MjO5BXY&6i{UV>u{Qt?R=&7wMcd}DUiHZ@H-skp|@X%(1 z*LrN#T0W?;La?W%fz^sU|Em_Joiu+mtAA9I5Kq@>oo*mU>sHD(H4C@iVvM$1G;lDr zj_{y(=|9n~!Dn-!vu~nP>VKWF_4k<=mm%bMACJ52Fk{!1cC0S6f;kmE5s~Kcg*|O{ zObOz^Vgi|lG@Vk!(w?bTUo+`lQae3KPRxdZhcDDBU^x1Rr;idhtY9%A!+c(BF@Ndp z`z=b+icwSK%vV)DMp77wX)28hMIeHUt%_XofuL8Q^ND2yifsB(0Qw`+%Mp@Ao+6tt zJZxZm9X|)Dob8?LeU3#B2jF4P_{ukSlZm0-0g|5aVy+G+YG?W5SOjQS`X(gP0)xka zKu}F>Ng2M@$J6o_d-b|a9gq7RZhx}}2Tuam%CIIS^tKzd6p_mVG5mwd9+;>K=ErK1 zDlC|1f((k8MD#{V(rE}`l`KrGlM)d|Ehtf!$YI4L7^SMBFc-nZ$4^JI@lqotsN;yc zd!&*?u|u5YIt)e!0_rL_LCJjCC@uS(Q3SCZl@EyGwWG`2?bO6q9!ctIdVgo`WQcs# zR(mox2eP^>&B^+n_(vY4z4+D3wk^fXvBEDamu@O7fV(r@L+0jn(i%P;?~>lJst&gZ z>Xmr~Iz_lv?0M^q7|Pa4c0MYyuY&e=Ug*hLcDd62kL&)g=z2jSc$(bn3e{O0Csc<= zHb=ww|F8Qo4>S~QSCx<)AAgr;7ah8vbibb*kIF-f4MaB?IxJ9A=r*=_KDMz#EuLn@$BEH;@#xwB$HQsF&oX)YE6B z$*^TqR-%l}n-7!24Gax1Jr-&8VB<|F^au)SfdZ_KAV(u6)W|(?(*%X2M+*@ij&1*V z5&ox!^&fz_WFtuh%J<2wCX@GDk}fVa4?EJ6@NeWWEgOyu`+p{N`Gp) zJ7mr!Cerm5Sfd1zzavLOQy%$af_cJqS4PPYdo`RapsF%hw1~7;7PJ-guL!-%&)M_* zR)P;FCdETLQ<==RU8&Dr(gYglxzi8R`4>o6Q&N}R4y*KWVL!}2ct@N8BfQ)4yyqWo z-s(LmAvEkg#ed}||DZLf{}y+oAIpc7_r53PGYi#qrIsT8Lh(nA9&Z&s376N`ca9ys zx+}}0&ikhw{NJr?!>g^;Dk0x{b|!8yf4qOmF>Xl8F*TPONz`a4EroaZrCV^3rB9VEr> ze*d~tqJOnh8r&(5yvO3a%%ct%;Cma$pRjT~N=r=%tuIQ(7}{?!j%3D+nA3Qyiji?4vC%)pQ|T;~3_Ym1QW| z3L@ty>&&@!!OINSLk+uQQCQ9Aj`%&$S34^|MXQb(p9PS8Vx5N5Y20^1Ri|7Y%P~322vx)kYyal!x+^;mqQDTe}}%AJU27A@O27o-qkDe;M?HJ zu(@$Oa*|z&KzV~U%IhnYRL=)qt|3anocdc`>dB!vF;e2N@jdCpviW6Xw#)4zs>ubF zL&qCfXTt~fv1^#)*{?Q5rbUx#@VVIZLw_>Sx1UVR{Q12lL71}^R>$$8r{A*&6eSkV zJ4N#{tDfi629$s8pNPkjEiSs)*KaPK3!4=}a$P9mF;RD#9z@i&Ta!#WSQ(eOiQ`*~ zRh;uPdpm#8ZE%kFo%>T}Z@Cz5?;N+=lDoH@!Mb(O-n8!{ou8&>dhH3O=#aPAM}MBJ z)n-QYX4Q>|apiN5+{~DGEK}B!mo0`8dKr@qpNy?u^}Lz4E^c2G4fx}`HnL_^hTq1%>qm)l*hSEdhd z!$WCp2(nyudT&h!Hg{B64g*`w^W0BcZ${R~xY58` z>WilAu(v4LYY$q+Ak0cr6q3%52P)oUu4WN;R~EkN$qqd7=3#wvPWhvq-fa~1BRI5o zB^XWTbai*g%e(8H*CMXBAAeciqo7b+w+XbXg=&m~BL$dwuLghN6ZUb^J3QUu=yhgz zaXn#D2C>{XzEBS7yk=HcAc+p+gUl_Apl_1YOOpz7OID>6eV_TW|9iXOK&O3W6rm^-f+ z?$f+BOv5hL^V@iObbp*G>$wP6TxdwF;oYLPZf`oF7Uf?QT`tP!BpaN&%e=x3$ZG7; z;V_li-syO{3%x!Lhtf9dU#3?yGjh>ams7dRyYS?7)5*)# zhSAq?luU;$CL(f<)tx(05G^Lt3N~d>df#+T9&?4$(c}(JZx>Efkc2ySuBt>j;Pg?B$)s*7Ou^0`U?KxhYa)toyRloV>#%4CKw}Xb$4QuZ+P-mDIBJ13na>so3V~uhf2s!aibJxhI|Kg<$zwAOM74gStWJ?ad z?>|ER=lcATJ9{5)`%2fp@BM~yIS$sP24WiX|4U;-F-C!zh1`P5J9IC<*l@MPM*)rC zf9I<r@U)5X(z4t<2@D zSe9)*k8@8OPge`ju6eOQ|IN7TLC1cT>rrxk8++|H;NvZ4W@_Eb61MU1Z=5?aopb^$ zmBEbFjAxpXmt!v5n&5ZZDq*p&!mhzPb10O5cQ)Se-c%nL^Zb{!&9-J*R$G`SP^sos z@YI+(#tfx_%gMSkW*k>e^G+R_QZFZOTx6|4)LdyD9aFoGnEUnKxc!A!qcPX2xYY0i zo9d?xP0k~Bqs1L)Ri+c7Jxo3aWOS*pPrn?hUaJKGsJH#Sxq z+b^m2S+(b7xQzrjr>8Mv^yy+o+F!6Sqzc#KzX8Qn{NfWv4j-T6m;!v9P(IR`kZC(O>4J~5z#2nmfB@*ikk5?xt8+!UC^ga`6{@&ZzA|rs(Zh? z(*4rC_fJx~y2rB2v+Bvpq29dhO&!~q8`&n`>TSR?3hG=v$o*9EUc+&de-aOW^;FAr zPq5Qn-uGp-rgw-~HCb;7)mC|s9+A1Z9Y!1q+si$NcN%xt@P5e~f-huG8Ln}^`m9hk zV+T?O6r3j6P9u3G-G-UqZQB^U(SjhC;hn2>0-QX(n^P+*IO4cLKdqZ$2?Yt87Zqu387dhFw&iPo4q z1rKMpMD;8(UV&QIS{hZ=GX1t3FHn_cLB+InCYO-QC^Y-BL+%PNiY%Czgy;$5+p{ zRZF+lgx5}y(@mkzsp9w9R>Mx{N zn%tF?u*57ZSyDLfh37MPc0(s&tP$|OR^*QZXGS{y4V9*9qm&_yD>xOr8D~)LF zn(psX7h+6SwcACL{1h2~e)1^&)p@Sv!ui?vvd$NCHs5C|vedn!R4YWb>LIdS#Jq1o zSFVQtvpn5Nd&{Y}#Jr^VO37x{s`i$`<(pHOyvrfkn54YU4MSuGFOWKC9r5!O*IS4~ zo*svezYQqh;Px!JaAFkp?^0v*EB^c8;=f*7pF8gxpFZ;RS7P{ocS`J+OQqRjj&Oak z02CkQ1rz}w2&j(j;_rtyH5}6wRw^h7GFcKKN{T2%T@sO1VuA&t3ZMx}3_ulPKv6^o z_@MK_1wkAJB8J27{kQhF+W(_LktVmBo0YcKU&TMPR4*AVDncLN{onC9KWR}UU7|n1 z1cW~`zP))7e{C3l&2Bp%F5HbV+1v41rsF9&Y@d+hz|t7VYQt@vF=Zqs6j{P9aKiVp zN((5lSwh6nQz=~{hOx|lvGQNw-_0cYa#w-xmB>`(nX^W2-bc}G_mR-NE2o+)Q8`$k zwa*sN%9yG}FozZBQe%64%Vy9=ce>u@=F(EO?iDchJR^gDIf=Tk%o%-`WJwWH%`HMZ z;9=+wUFJiD<#Gc8m?7c4y^Cvh_S;uxQGk&5fa6bZM}t)cuIbkI9}Z33zIWI>J1zG& zq~&sUT^Ek?ZeH51RH_W;y-20KCP5ux7t5Pn)&*dVr%7?k)Q)hVg>F^qAmHgPvC`Bt zwg6G9z3#YwO_pw7WLL4&KF?;g}?j3P{_nlvQfptgcc+Ivv+uSDtxQ zUU^so3N0~ND~*=;*k>eqcpP1rP4V8VZ@ZH5_b&8*IeXr>%Y3`DRaB~yRZDbUWu6!c zC<=8Z42($q>ZnM91c;=FAtECnjDjH`iy*5afgq%c01^lQ$f^KHBBLUSAb}u*BA`es z5Qr)Sih{Bts7L?|fGEhKAtEZsC?tvsAw@|UBC|y;5lF9Ty9$89SdfW`i6(*xP?8Zd zh~8;`f*N85R=#MW`dMXVEc7sp#R(Bwt+iTVtw7zLpI2O{G9x2A1(Pf)#xPsy+oc|+ zsfuATOD`F-Gh|rZnKL~sxEU4-sssd0wj^&1_UF5lwo(wN6B8=dS)ijWTBwa`_8F>* z!^#x$F+5Z zQVIYH2+@NP72wXLp{;#a%)+;Wv5$ov=azWctOD<(eYFbhOjm7cOM(?TsEV+mb)^J| z=_2!Yn^I`8p&&-uLv)z8HeO<<8bMSE0t!o9bqY$`6StQHvTfe=nxvqTg(Y@>(x6nO zkIF{MrIytKt1DaPZ*6Xt%Alsxpb=Et01%KA)8M3Scoy%Sh$tyRQtN3PIV-yHM3!r0 zTcIHU3b-byR0_;(R*y8*CQ`9d!;#fZd7HfOCxzy@z8ps}jZnOsG0|ClaGlJVt(8}e z^}ZOZhNh5F!QoUD(QYPXoz_)<>g6l8#Dc6xR*l{xMJmv%qFu(S#Z0j-l<{isdQCwk z!mD?CHxtTD3nSpGnsuNSs%k7LHnJ*OnWIw>+FBKgt-@DI3Z>o>B(?=?S`yh+HF&XN zVpvjm>g_hnct`?5D8wsEBVa<@Q0%uz?8Lm?o1vB-aukDue75ECECJzvG$@BH=IZUN z8Yq)p9Y+K5z%rG&d3(Hfg+NTDmb&XiS6a<(3QI-1N_A>UB~WOL*ovHmM)1XHqO)xE zvfG;nHKdq%-8{asA)z@0DyJzHN}FPt1*6Q=cO&Yeh&R%^GF0_v`cn^%mxrPq_F zgTrOIoeBv-C`zkCeg?=)397aWf(%=Uf?y68nMlwXNRkJDyY0Pg>C4|BoZX?xSkmFn zlJiEZ%LjHR3}(7z#w8Ok6s8C!jcuq?X;cSQjEu1Gy%t97rmt*UlgJw%e^r8xN(E3B zj?gR?r&C7lESd7)7Bs0)F4BlpHey64YEn3F1*10AacjCU#SO_XM;kSCPc5d>DVl1l zg&Vv;;B-?gYweUctG$ZvF}1YSJ~XL8XsM%ljjX*Gy6(GH-HhPHxbV?}nw~T)_}w_G zJ5BDSUShsf@$Dq=^UVgZf9_{@O*EEL)7ws8ZC-4~-l34gm~dtbQt$_yYePCJOvp53 z62&yS!7ldY?{mctN;w`-xa&7Dp^Gi{=tI0Bb=A17SiXx-W6C!MgF_Y4Agq~N(z+wP zyxtnk1#v50^HgwB?iH7HstfYCQ9#C( z47ej>Hr`TsF}S)e<)*E47@Jb)b=3PQ?68h1JLXA7|$Bzh`6k*ZM0zLVhVk&)JtVN8*_iIh4y< zb?f+_ww-P(-IUBlCX9I+lKd0*(^(8>sr#P7_NB)H6M|e*T5v8jned}u<5Fu+Wb8_l zS;zF74AiNV?=hOwxm#**OvdfPo66HANdDy78`8wmZ8h&pe+zk-(~&MNFfTDij-7G# zRNC*AouAeEqvafy)qd2_8B@YBkj8%xQ$nGyKdM-k1I;MCQ*;**jIg+IGeLn;b+3mC z4~-{NdT2Kr4JVgdNu2!&mnF$G@k$9Cyi2usrk5OhiXV)wS^gP4$*(Tw8Mls1Gb55j zaU}`UF_Se#f5gm1#M1Q6o=HgKLDbI#z{Dn`foX7QGA8m$X~dm}f{QCnif1>Y65ene zY`XmY{NM4ueCk>|Y=38#6?$&s>lUwr=*7cL5}g`uYc9pHJ<~E`hIJ={=gMOuo}14U zg~pS&!04Bp=t&(rOh{!=y(tIsPc+0$>$#-7==>%i*(kZrzT{ozj6;DRZadxzd0e z-GJ#J>Y;lw0MJ zR?Bn7w?*;6o?x+d)v?m)$aaB34Wx$(54Py5f7*$gyT+D{jyFl*!)~v-$~LHIeK9?^ ze4;2|;>51J5L(gNEMubgMo{OX#NBAsv)Rpw8-Pn!!SL0Uto34}S<>?Jgl@rFq{6Ev zr=7gBM>SAKPc`nKqKd{jnSt@q$E@piXk*Oi>$uva^T}#84si$01E^MX=pRJrl-$yM zf5*Bs6nGjuvXyh=x89z{#L7TPgWSi$X)#sZqWjN*7&;>j7R`%Bb!T6qoU8Nxd6D=; z2@}O4>-yY@<&utS%XHY-lNi5AnXD!SW_hNJ6bJ8$vH-f`qX>dj6m>uvidq5^2uKK$ z4N*WEDDP5*beRRIhef95M~ZldLg}P1f1+h8T`0`MFWI^cHd{;+&O25qB7$$}#HSP{;~9Gia47N$=L~LV z==E?%u-&LKmrCxu+wj@Vrf`BXe?6Heyb{Bb6M83gf|CdlZKiSU*u5XET}jZJzEe$*GxteXpq2*LdPf!=-&Uu>x8Y zDEYl!gz|FSO;_C?!QyKP#rN&{dER}yKRcupAa+l)5=>G3T&Uz(W$2fy?e{~E~5jg&j)v{>d;g2Q}ic>oxQg=L6R(udaCPR@~>%(HV zbf@(dRh2&ny%%+Y50f;62^R{l(vQ6MA#;h(QByv3My<7#4}A)=eGho@hdG}3xt{mI zUxA-dt{%Owil-LQn9dWgDV2-zWW=hi80C~)^;yDdtl4OI`A{?Df6B6kUUAgKK1R%{ z*qPhTQ*pZ=x93di8nMROEfBYQ;h5a&I@$ z8Ng22lOvEE#5ctuf2nVCi?!lco&{S79GDCz(U8`5Xf!?M?x~cP593xT=y?xz`)Z|{ zoD%~G7d|ZLNp4jkI;A&CQMwU{P7@aHHn)mYW+)je_Wckie{hKBIwygW53mf+If#=#n z?3PCf=bF}BJN2)g__#MGQ+}^;S4R6sFP~ugw0eUjTKL@|$oHiC)iNW5RK?r`m@r>j z$@etL>?`LTe^M8Yx>!5Bl%UzUmYxxWWvHFkef_IiVeOH9+u@ok4yjq5Ej79`rQ3`R zI$SvLPUC{_PD#MzTK79vPrvUUpYwj({QsDKX{?WpM2BopPxH%E;Zv0?IoWU?&h>Nd z{J+p{LMTf8Z_cC<`U&6K$)FN;GQPrqE7cLVG5d2of8<2C7u%An#J(EK6lx*!j%(Sd zqFPCH%=6R6<<6LKpbLqXW@%S3bo_6}-9D+()ran*E=5>|Ndax$Lj2`hj7LHV5NDUYGhL z)86;Hf7rhFSJo(rIkB1N$<}QPGnsPjbLMVxFSBp$Hx2s}SLaatnvU8m?B!Q|_QRNA zUQ9K>3!v3;_>}c#{9ZolV=UcaRFkwtBHsGl;+jnlG|*S-Qypi+&($}ToG^JXkl-W6 zV1>hHl~;akLr^S40#Tk0C{Vq{Cw_>9`{oIZ?k1ZM+&m zl|drC=}Eq#4oNK6xvgA#SB`16-S3#EajUxgI{YdquXlOm-+HT;>nH8FpygrQSB@cH z&C5mv8J*C*vE0RbTda6m*4dmB9riye0x(ts--Y|{em$y>1XtMA`X67PTOeDmk{@Ec ze<$RfJ1cGh*6F*)izqa?Ya&RZzk2NXVw|=zmbu-tzZ~yhR`y}OCRtT`48#B{N>G&nX@z1f7wjAv_?^sB(ZjWWfwv+bMvlqn}`DiqmdiJ zCB{Bz{nml!D&X4uAV}WBO(d!!yc%IWdtHhzDo)yGamfQ@r!Z-f2oUf zE6sOIWnl3`b(i!SvxI{98l-Wa_)GAL)e#{_npATmw{>C^45d2Qz z7HNGFoThf^!)Vq}@+fW ztc3(YF%x=mByq%SO9XSgTnCp<7>qPLqvxKVD*Mr6se2(#bW?!xCMbj?;`&afzP{Ji zZ(v~A$MM|vFxF^jueqx*WKl!jqB!kO6!yzT)4c6CI~%>TKzBc!W$b#GA`(0_Owwo<&p~A|YN>UG?dkrh8Bg{1 zq<5!cPeHuMU}-ldji+)sH66purc}srl0drje=J&WJUdfy0Wt?GX}S4v(s7|QC2vlX zCU#?`GZyaGj(POUB;#4bJ@n5mw0%Y#b0tP(^Y-({X_WP`JrPA0f2v@dQ&MnE{Y_<- zXgZzrqzO__Nj;V1B58K}rcA`|2&R=j zYD(Td%Kt|>TR87ddHZUI2ikeB{*9BF&U{ZNP}VGCHtaTBZf!M0JG;f%pgxY;b=p!Y zn{F+N!OOSZr4lIVf6G0+V(gT5aVqW?b!}q3-Gdf%>(0y=@lQJQDB0lWRApUjYakZV zD{XEbsJ5^fDIU?6R^y{wr%}edPtCim>cIPtB4zoPyEde2dQt7d)P&(Y$9FBJO2Jx< zw<<2A1I#$;QFzAm-E`XhC0@G-x^#!5uKksiogDNvZEusWe-d@PaucD;yTX~^ z68oY3&Mcq4e{?G4Y@loT_PLRZc9YwwdjlvmEXOp@<;a1x9!e2h36JM40Vb4kqE|OL z*>_krhf5aqF$#BA3y9Hs-!C=s5j5Kn$dL3_YxQE^dsNwVNgal|6pqrY&zaY>qCj*~ zLM3ZtTQs?k&yzQ|p+f2~fe;@0;ftEsGwmTXO$g9Tf5=#Mx7dPxW}GKD8PigDCZb5I zC79A0+uuwc>t7qmBcmn0h{h+je;gr=>f7Hy=k67S%sA%0n0fKYe*UC_k_uP3Pm|kB zUvv***6=UIAv$fME$jwpA(T#}#IsV3N-J z6=+qTe>W8+VhUB{?$*q$6-BhLq!fW`){?{L8cXr}=f3@K-c@*b*iaxy=Ov#XMm;0U zs+x4l>ES2BB)XEfWqkw2h~#vnXcGOkda4Wf(-qg#g4tQPL)Tt$*P@(tqLW6gtuMRZ zB;&gZrwl4CjZbB@qd7iAA2wLt=`9hHf2g{eMLY=aS7=KCz8ZF2nEl?wef(%~ zFp=P_-p>eRG$2Jx4c$9~hYoPZ9#iP-4Ip5gi_dwp-1T&xyAX;=1$n+orSAOJ@~}&V zE{L`ijO40-D=Mjr(iD?--TUV0EenM)EsDA-mYQAEim7sY?ckMfZ7NnIrrlD4s@uqx ze}$sO4vAHib<*OQ6>Yjf8>I?O<=S3y_DfZ?P*WL6Z*4Ep7EmNmk`YS#&wG@xrFwJc zVzDt8LsYc9Ndb_MDj34iM;E()}WS25H@TYbKH zzciB<3S1IO36=MRmi%g}&zk3+Jn%}ylACE*lPZ^l`MFyv2ohx^#a(!I7OEX?f~yK* zLORp3wuUAo3YLWoML~77OGW8% zm_WuXh2j}jo9MvGDN$r(Q$%X4u?_6360S7qaA->e3(ef6SGChu9Alg^gEFBcDlCd# zNTir+r7tfku+F-#n(xQoJDS?pjU|ODK~V_>R;$*jLabB?Fv!|Fno}?nfAC$BW5e5r zN#)_J-9BWr2eXz^+@4;NZ}ScpMDU00_fyVOV4R$Abi z=9-BInE8Z!yPP=*B08kWyuQf>QE(vqi`P;h_ZS`1*??_9v_2m@=Lb#T@ug0rAzQBQv56NeD`ya66E_?RugiezyFe`ueC76W#?0|Sv-bPP;MsQxwBUs+7 z?|G`%G>{}HqFL?Fwup#(q|h{g?^WTgqH6v32YxA+9*bn)oi?z!ABTwHjdV zk9Ro5h@C|Y4a~PzbTbCj%*gmH#IiV2+s=2LPPYgvWcum1VlyJgaZFY?2sexn^>R#kw#I zpErt%EyvT%qn*cCrCm~+^+KhYaFKJ6v#=u`qcby}ksQ~KR)5)Cw^X~<%qkoc915T) zs+E5MaA0Vbc401C7Sv|vy%sVeLOy?R_!3P4GX-{=17ZPm57B^W48<gX-nqUFOR?M%+aCa4m_tocvo+lI751`nQ;M~p95Vy&ER zw{;?tuQ^=!scVk-F88HZ4@amHC7*bSayt7}cp64j&8&s4a^i}k{N8>dN9%v{^M4Hf z`eB3pWOPI>M2JPi@B+h`+a;Eva6@o|#5Yrc+?(r@oZ}G5xKRe6y=Yg!(Gp!XiNMAT$oc$*(GvPmK9WU zRF)r?#!#n}z7+UQc;~CAu&NMmE>e}<9VS^uf`)R+3q&M35offbKtq4?wmv-$dT~Ez zvREtKuH|c{9!JKqj&u>URUq#&;mrxl$r=(a)4Z_>;(4ScExgN_vj0n8BfY_x-|*r91v zQ3av3iKn26xGhP&tjc4B##F&j&Q z;b=u0xC;-9jwNi>q;s#RPHSRY0L;})p8D#AS(@U2s1hlIJsdp6} z1Sf-4+3i;=PO_7xG$4Pm48hykxVkyd!{_dS`Ul=DHv82qv0PfKbcjn z0N4iAI_;t?=Lf%Zy6YLQ#9f_AuFaS`{6lh^-Yt5IOPeHI)&IQ5UHd=dJ5s zjQ2y`C@$NC^DfY_wm&WKUol+pXOq75yuo;Ca%s-pX!ma>O&(7zpm!8G(!B=@;xBVRChG-N!5lz z26MjAs`BFdGQ@u|(Hdbui6@$TA09R%&L*chzdNdakrLpC8{cR=r{)XR?S&@Tsh;*^ zHMOxv*F?(XNd&2$_txe+9Hh<|*@`f)QVKfS3&UolD4E%{6b55#MaY#gSuRLH+L=Udn@-pJ;OjyUcs|D1~yYhd}(STe)_$SYo8$@fiYef($ z)qdk=wmopp494=u*O3E_xb;- zyYxP%zR7>&H6;p&ru|iO_eLvqg7GxV#1RghIWOYOP#79h*m^qjVm!60{WM?Q5G8|DM~G-YknSI&pOD=9NWR)m5jQ9mACu3>36D=|Fnba4imCWR z^xt!=?Xy$yWr?;bZFKCm?!8i9R(?Igu#==v03zpV$mox`Dv9&n`}eXI8mp8+t2JZC zY$NNHb>=b$hzB$3Rsi;L(X=d5qX>jz`uBg5hc9~^5~o3aD05Xkxk%ilad91qAeRRN z_f*-;$l2u7s`sl}eA3^s&g&N?oz~}`T8X-0;_=0g;CajQ ze5t(*t%ooavF(BS|9+pz(DxU3jS1{boMXg}BCua~!e7K39U@OY?krvqSKfG>cTn!-RTKHQ@6a{W z4$||{tLBzscj^>2%VTb+3rIV6j78X;|BM>m<>Ck8N-hq}x95MDO#nt;+uHjS zd%I}yR8&{psb_~$AZtQ-FKChZF zFNpGKkkO@RgjO2NWXBhmoHO-0o2NHs+et{l@lTR^r!FR2Ek~tkadKQ&)o7vapKpc5 zhAquyRbMYjzrxO~T8i732fb74Kaj{Nn5{9y+I5i_W`czw&+iN3|jXuV@ z`%IM1fZ~MqBRaRs#jkf=fn{#)jdOapARP|_tmY~+3`J$9djq^vyKU+NRo+TG`#GGP zdaWd`TBqHmZ%BW;cnWF)s#_7g;AK3ums^i#DaZDcRlMUCU_70Xgk=R}5_mPLtEkG| z+$EfxV^Z8jXjg<|u*0OOIwtP347g1ho;7On`#T=r7gL701Zc_`Vzk{J&kCCI(xQ8< zoVC_kBT5BdD_NQ+8eFv8X)YG+7i3mnUu{av+e@YE-r#@cfKAs^)VMwdos`)07LSg$hYWN=XSyEqvf@Jz0GZcU-KQdUmCgUy4*L z)E9=TCz(f`F7;IJQ3yezkUr7m!m1z&M51{vTg!5^CLr+9`^l-kd*^+;^=&Q*GxucN zDzH-e^$mYvbBc}_kDmo)Wgm>Er&aibk9hTJ9{K6#d)?G*U2B?QXR&&DZi?w%i@tVf zxH%I_UZT+j`-4e)a=u^8e*CwH52}hhrS!V@74G+JWP}?PtON~Ywa*3!l~^kvO-z-Z zbh6KqO#4V_RCibNI^v#0;!Dej0u4+8!#VX-J;#3|2=l)>$8ww5P))S@uNp749WfwM zYn#ghdTD6(X;G^ceB|HAC%_}Uo*p}%ks{(q@_2Yw%hI+`H`olVbJqLQ7912Tqt=(( z$L^N-kc$|(-HQ#T-`C0mYQj>)po{rgu;jiY71asXN9c|t;PB@&H;gXeL=S#f74jv= zc~*bDjsAgJUj2q<` zaTgR=VQ40xL*)!3*JdFajoXlK7Flhqwnl$z+qFl&)PbkOU>fJx%#DFkBf+6sRW1h= zk{O;`CB#dCVZR2B^W7}k8rq+FPa8SI1K3TZh>TxAbsq~k|zn*sJ$4lrgS~j%sAhDndBH$8AUYEa|ZL3RN{X@ zWHTnigZjMvL-)Cr=RM?>WK8{6sH6Bck*8Q=4%`Sg1t-5)?Skv0w5ANGmmgX@lU#@+ zRC(vo30#MfeU#x(a&s)rI$jo64_7vCv(0asB~iR?D)!nuP9E=(Hk$HJJejhAi89SfhKp`>N~fZ$mC5KyfX%%`o?MNcU?PlJ9kfNGnaZf*%tCm#qW{2 z-xiMX##eIVoTmGj;(IOa#@7b7lG;#zQ=mZ9?>w=Jo;E$qkz8YL@bNS$T(@RrlZ_tr zX`!5|=rYH!5r)#_9bb8T7>BuB08Gm;#$#XfW= z&To{(lW)I%`^_$=CBVxJhuOR8G9zvGAW&m2y*XvojWjS!tvZEf#N=!|(^_$V6&OZs zd6ZW=iJt9B3M)(N}V=?Zkg9ibKT+pYP>UQjORn*@=fsiNgAr-DyACR0pr zf{oF=0M}NZw%$FN5D)Wys%?FlH9o|y^}V}0U~jzfBq+lC!3o|SnqCm_?QnPaDedg{ zAJ=$3az3$nJkCw@{37`t<%`XKI-_}^8QNUPc4`$}#Lf33QNiBNdERdzj(H-_VTtWf z=pv~-?C%I3;q zMJqBf-l+7&1AEz0l{?}*-DDn*F%Wx+cH-mjPjMvNih_zgJQJqEX%1mUh*x)5f-ox80>NSZ<%B0nd?HId+TxqJ?(KznX*7yjvY#f#meK;)r26xe&*gY5Q zQA;(Uj1vI0xRi4rz08$7vvQ!w=L?uB>emU1ZEuF|w}z~Uv~cZSj6`-e`c$pOr3{%< zT!sSO-qWtY=V`9yOwQi!#*Z1Nb9?jLleI!m3--l2w;g8Y-(c-SlMX{5e_?G%7Ej%N zpZ$N3A3lA(_kMKx(YudsF4&n+RM8IpTWCQW7cAUvgbDmeNt|3Sk3~N-e%$?!-mh)? za%9K5>%F@x+)^eI*7&4;&zSyi&ItMPreiQyDtjq13GxLI7wpyb)j0EZBR2Nq=VrKe z0gvAO9)2D=`a8ky&3Y*Je+l;>nwHivbSav8!VqdyY)RP~Ouvz9L9DfR0`&-qC@NX! zIHt0X)z>*#JC2^=dX%2U$zB9Sr-6xuwA-;_&xkss;J0oPjCV5t-*! zKc0LaxK{LOkE!>5SW<3czD&wOO{leDFi_^TlI3q>L#-*9bU}pdkcFN_kB{~ zox&}_POwi)!)Hq!f9}fX_ztzG{P?ys4U>Yyny&2JYh8|0j$cj7UJTmeX_c~TaP-e@ zb56KHL&>?|_iszweC($iZ3Im}pFJM?%bX}!VLx-Lvh||P-!W$Sqtsun`*eJ^p3OYI|2}nZzJv4S$g|&}^wA;Dev5mv0%?eG z?_#o5Yqsgw+l|dvGO^*@H+)?b6b$D(9h%D7$(hJ#^=EWY?;%Q_+KKITNQm5szUb4{ z6o*Z)hG%Kne~5^B@||@>E>zSgj~;V!udL0r%H~Ciu1_BEG<@Nc@^8f#9*AE1sIb)z z)I>NqJ-pFrDU{lru`qVCB}2+1MZk9k$68!eeBWy`h7T4%`JwC+?R)L+WA=0>*E|G0 zkv&i=08q^P5X5^>cPNj;w_VtuWMRRgD=zt0o|PgGe}ibD^K|4m+=5=#Z?D;Q9D_69 z5m_farLeRw?Wr+nybign6CY#nnzKSh=Juwig!TG|HQV#s-SO44cSv#swVj?t)eacz z!6l5X!YPPLvNYk5puJ(IQaZ`J$XUn|qfgADGZl7ARF$MARA&$(4M8cdbnvzn<3)A5Yspd)E4ByC&}#$+^4QC^WST+AE<+_F`di0U)m`f9QoyF!-v)slM_rzd6m$#N6KX{LFug zLg96z=_a*MsQ3m_HCc96ED>d0=g0#oo%U*l=Bv;-0}WHiuv0Tnu;u72GA*z}3sDIzW7x}2l)Pt?6ub)%M<is+gF1bz{}Q zW8A`o1B%-jL%H8@4M3l8-Nf#6q~PG4f18tB!P$oR>k-}N0QwQ&!pXAst}fVE84Wxo z&dSK;*?rQmwXo3V?C{2%Jyx~mO!wZU$Fzb3{PVbA_hmZv4mj8ur!Il@*3HHi+@^M+ z>uULO$dxf@ktqssNwriPjZ(4B3%s^Anm1Ub#!-%yq zqysYDS11!oX;v!xw5uJHr!6^qa9Sf&uB=Ur2D#?uLxrP7pXv9?*z<+q?QK<8Nf0y4Mx8%~_A`LlVoD^$jJIN4rXb+ICu;@GzAWlWp z_HW*#J>^7Y44)CDxwz(N!D&Z9oJR{}1C8XZHzJ}#)*9vqz0Mqs(6R4j)fruXt@g5c zqUc8sytRg3H!V4Vwv>y^t3|4oiTS2BtXl6@8{dEi^n3c zZE>Xv$lxPuu{%>R4NVIWNNnuHBg!Q@ii?Pl4GmSLfsxaQ!sLY&*%6$PMpVu0=Alwz zC1hqn9e|nzyvDC9MU7INfBZuF$?bS3pF%WUI{NwVNZm*{plR!m7EQLZOF zc{tfUc<5=iCFMmrx!U(6q)Lv35#7H#3bNx132YTq;_Zqfw7i5>RcaC4iR$8uV8m(G z_Gg@oUO+jwaQnN#u^d;pgmTU05=Ifoo9}DOJ_bQO6W$*j?iGclf3$cc%w1xzg>Nja z)qHW@!FXZYJ9^9C;JS=vF7!6N9|Q0Qt*lq?&euIHA4k!zZS2><&OrQj3`O=b#ovGd zr^pI;A}I4I=IduWomx>~(STm~B)&E%1)9#D>hhtSnx93P`97>I=mr z+A}6~8S1PjLk^I`e}ac?UptX-&an$m6lPu2JMX!n%as-Q)DDd=TNi}d(jSA*8Sn>2 zNV&A5-&R3)G`HFuN?5r$*nS>tutgcH?^IPg1d&&(jv~CNeBjNU@0DY`t>6`%5m_*? z@~X&Mi4kdx>88FL!HQT`4EcLK_nWG;DvyhdM**=jxaWt(e-qQ;v_!X&hNoyZ5fCiz z1k2$X1*XeJgjC|u8RS+Sf!C;$gM@}hF#Xw_9K$-GT&4AT z(ujaoLT6l#cPc!lox+AW^@6;z(kUN7@2pf9)c8<_f2rLHI|-T{=cxH5+`n!qMRi|> zyC<6#2v1*$_<|Ggw}O8R0=@ehf{ z`IKr7Tct24jxQpn63JSER(XG}U56^;mzJ|K&jOf>LscnsB}i2_P*70S2$E*OgR*1! z2l4+ehn%eMdS~B9wMyY-0z`#XbfuJH)lQ{4D{mrBYsXZn=9Q^jvG~;`Gi7}*>7Qmj zh><6U_2xccxy*4u*W(xZ@XjBta%(=;JQ4G`r%~vlT&A)HF>Bu?Kqd}17W9?4O zfsu#bZScFAy%ih z5`|Mx=USZM>ber>nkNiIMPQ7Qn)%6l;ncDI#qp8e_oigkeMsdYQHPb^YUz9(dS~8V z+(d9*)LX+dF8JGB@xwFDOFXV*XKzLqcQ^QQJ*_e=IAUPnJ2QWf8#N_bYk_2;FfSmc zAJ3)2_to{3b$fSy`*SB97nNw=C8^S}AtJI2){a-ct~Tv`zI7^kD#YM?7HxF|ZF~+% z=&lqAEJv~I@?a0kjLx2OR|4N@&SVNw(af!g%nJKN?+fXYjkj|zPKY1mnA1N7$DD@3}vgx+w$GBqi;_=@RKjj&yrSHZvp=FWkmoc%+!{ zisCx(RNyowlpb@@OlcN#EmZ9Ktk-_$)l%nQdH`b|053=fLsLw*zd_a8xqDC^k;Dp; zch|E{(D#7%cf)xy=WZK*ZhJ8s)M8_o&Q0;u$i57|bWnfqJHx0!Jh(R#$7%Hm5cOAX zf?YjY{6xlrFwFqsS+CE(DFgt1)3 z#+)XsHd>czmel9JQT-X-ou_ko;OZSmXmXbjX$fC0@SFEeZ+k-PmGd3xjIT;Ly5&IK zgEf1&_$hyZnhP-*kSMW{*5{&PB8GBK3>DLA_rj-x#T%vy%OZp^tb3AN z5{h0$#5Rs{47OsguwF~cBbN+_=b;r+Mdq2~nnCcW?^E+}SgdDmAVePvBO!~lC}s$% zCYUsS+pY!~5GrQ*>#A#umqPSx-Zw}WS0TBZt5tuMx-@1xPH>&dds9JIdyQeB4ioS{ zVqUjG;S>)g=nK_%EjZ67BdQ5MYJtwwTpaIiy90AQ_;=;|*xtjn>90$jwL((bcdlwY zg4#s%7_)SR3-(4%iZ{|Z#VAT=2|Emn6G}szW_b}q2q-7-BJTx#Aim3*|S@{=zKLRB@Sd!i|o~e`7|x(Bbm$)bA+I3TCFnG z3mD>Bdo&R+BUDC$f|Jb(DI+4KSr)4-gXQY5p`e}WP?<-dMSNYwAE>1CEcpC6Zo+cW zecaM%%{QFRV(P@GH02k;OB#{Ut88P7W21i!ade+-Xe(OpaxLaD@Vpf&6LfJZEu%8^ ztirdT()LN4nKE+IlJjZyZ<&He&aRoQI-(dM&aKF`-JZAS44x)bZ_F63PS;~MY9OmQ z-mT*-;b88(yVZ@%xHVReS+g0eD)6u@^E*3NJ$Tk1Cd{C%wORq8xtI!gcXHD4MlpZi zPaF1RT`Cf*SIc}S+rocSk->^zD8E-&)%jzU`Yr?LOYcuYnuXuJd|sni>8{ahnI73G(XJ2Rj95 zw?eQTv*q%4WYTKtaXoNC*^PM$?7_lfcM)d84#sY+#d{#aAU>AF{xae@Yozx`LIw~|` zLS90vK{|RbcJr=oW2)z?&UYGzH9LM=K;6qtImMFb6nw1nKB90NQ3ZKq%1DhH>0ttL zDttWkSMX-6KUpkV#BJA_Vir#G$sqR(HfSSS1q?hoSU{1f;NRm z$aehq;qvtOk8t{2>L=P3LPWS1#(2@G^z_Xh96yWvcTc}3-M+rOBQk%~gEszY-F35g zl(ywVoh*>XOp3DLy*U+H*L_VeI1x+m>(|u2+4vHEq@PlYaD0`Fo9(gNUs3H!(e%?g z8fPfcK#Duw>wkGztaPzf3Hf(RvE*}tB-eAE*O8Y9h|`9lXD~wUMhmLuLGKM+Fy6f0 z9L7z#Q%;((#R97HGA(~>(q-kA?(T;`olZo&6t9@PwVBr=c9&#-!Ce6U@`W!wb0NNUSiFrUj=SAM*b2hVAFqb+v}IOi|f^!$nzTApV8!x z6PpLVaz9=48#}_m7wgJij3dF>A`Sb>3zen8+wP6n>Ew&=8W3*#5eYIXrR`RjD94mI zHRWlH=K|r`&QwP-1&$G-z>R&I@i2Y%guc4uAHO9mScaD_(L0^2T`spW1|YVCgSWodc-kF=47nMR?TEe z$?2AsWvgSA&x2a`I`WpjZ3TKPpDGn*y0FrvL_vSe!FXgD};nJ@oY~73MBd2wA zXyUu2jBUKmox2zp*3fro&bDGFY7DWq2Tn#_oE$FWqhfVpEv?8oj^trcfsc_ChG3W7 zn$|( z8LsZlPddR}GZW{mZX9l*x*I_*28qo!`(A%Rymf1`)nv(d6A2J`tKPoV2pkd7L3HDp ze|lBxy_;5j%&YVS846WBwyz!nj;7FgvT-d_`X<0=x@mnf}7(V?ajn?eh7cB ziX=XAW+FttaB^eC?<8$MGgd^PV&El8agE4qUcvJ!GU3Xh*ztBH=1IQ^ex8#q_)mdG zkrq$LYl;TDFc2LYP1-yn@WRSkpM$SW@EM46CnYUC1c_VH=e#tXc}KCqS}hB>WFwKP zbB)8N8qVK#P3gtL`(AA8=L&5r0dJE8S|5LaxuH6ZwXa&8>vNs#S?RfP>|Ww|>g4FS z2%fo~4b^oM53nPTYnejJFGoAli9r>wV8Zo*&?6|RFmZO|`Xl-Yd2*Nr$H7rT#vjpB@+E8TC%7w>%E{pDK?ZkiL z?Z#I-Gc|KSzl&ilrld^d^O_vQa7Ru2A}+^3(5U*Bp*den);<;N<)5Uur2$W5O12 z_jaq5%13p?cGoTuD;%A%A{D9N%kuC|}!#2ob?yitRM6eJSo|+A0EtN3TdY##Sz#kl3WhqVByT7h}#F-Fwbg z2<)MzH?wviO@kgwiizam5PQx-ibpwf*bqV+0B;0v`1`UmjS8vc+*E&?u& z&5xnS0R4A^mgLO*X4m7dwcAF3*7Lm8t-2H=9peUPmLzAzAyIaF%=bslK9A2lXppBS2 zLxZ+Wr{{oJvn3@ZMWwLDGBH1*2mC+cY0~8TL)WO(T!8{KPk&KOfL5AmM5K$=`a4;R z6{@>dkY*Ipx`2PIl+htgH4>L=2tp8}%QWZjKEFRBj66lBKq5L*{yect_2TkV~eG1^)VEF>rselXlKdylZo(YrkVD++2=M zZrC|D)D|?3BsPRB7cdo7y#@p>U|1=5^XLrEE+yD0-h{1Ud;zrWcR%r$Yj9X$)LwGmqH$ z7H1qW&9>)oUFmSAfpX1^kn;cOR|JHTBp6R+8J2&bD8!}(hV^3Q!Lb4aA;6)uY+q?A z#mXuXg@Bk(OW^Lz`z+Y@n_d}1m&w+9ylbJ&hOAn9pB%(_9d27&w(ol|K0{vfzXwBS zPJRzPI$Qz}b*{82jHa4?KzknMI?xnMM*^OQ2f6%NtFg>(VvsEFyI{KxO~Z5K;K#+X zo85o9z3rXNjSM4An3Vb+VUE`Fya-mnCUfnuOK>gaY(=ojgHv zy*c%BZN9Dl7yDjb(>)Z)E7v=uy1LmX_8-`O;rd5FfJpKBT79d(ig%}w*_SeO2mH}T ziQ0MePV&8d?+P*XyiP204KC)-^@q1p@X~+V7u|zA^e(4cy~W82+~Qw4c{vR~`~(#} z$_S`L6h$;|*-$m2V&%_3S?6`3sn}p(#T4M-$SRIN6mp2hl+YDem^z#ssZ=hSdgyeH zHv3&YusaxrX2yeVj9x5Z480BvEJ8rP*qJ$LK;rOWSVvV;lewoxo4MCc^7b)#-)Mi1 z8s07jZUeQ55jlH>Rc*11LkC_@P}uOH+r^Iuo!`VG&hW7HvqT$b&VL)w=5ugl5TJt` zgG4lF=%mUf+#0}?Yuouw6vxtab^9BAhq%4ZtJ?jxWEf)w1``nsWTe6vu_&1+SY?Hg zmMKgUSs6t^8HkyTWMs)mlNBMDMpl1SWqa>iwWDoD-P*32&DFcTy^&g?6%!i#8BQUm zamQ>D8u}%+QGp_Y7!IRo6LKsiM(W#*Hr5Ho-Z&L0w8onZDUvj#Lc5l%Cx|Nh*Id@=Un~ zown_^J9bv=X1lK5mpt>#lN!`*Tax8TVu2%p6KE0?iK#$AEtcKg0OscQ>uq;S(B>Cl z^HdHCkJ{ty%q4u**fTi!m)`vp06bP~FV6nlm?M(i2l{ z+ihDjS%sR@cGgB~DZ2%*hix&=*35R=-PWxmDMe}tO+={u?(K#bgCw9REV+v&gO(D9MPONU(qjpa^ zv}NVzot@^_ow~G=WwOcJ((UBkuN`vdOSc=UcI_QBQyOWen;U6~p@6}#71I=m6BDSM zLvA)k*oqr)L>p)wAZ3b2aWOWTOieMULPSBR;T$9e$rLI<0veIBn53wqgi(zq#_8Pc z*9z_1n0312JF;86wYzPToMShC!7a9JZtiaFqix*Q?1CFp(r!MI=ZOnHhx{6(N}@GFZ<%tamBZ1~izKHiQ5xa#L-w z#G_=OVvb$HTZLh05E$zWr*#y_t=em$BD|(`yzK1mTi$mIt@7K9q|i`b3Db~m3NW&w z5GdF?QQ)o;P$UA9`(@<&&vE;RP1UCfR2TmC)GV!!4LPQg? zM%rjewvjD4jjTghVFU=Gt+a|TaDsq?9!qK{RyNv_HwM^~s$?F2q-xf&YQp#kARP|N zz3tostsc;#v9U;Zu}9*#D2N!m9+d8Nb#8L?`g=Ml;O}7_FD{Jw&1t#vD8M(n7!QNB zd>#hf21BK+7{Cn<(z*xwPkHwr>n)auO)MH}DWI`ng%E()?mJ)J)-?9M=fmz}&!e5u zM~kPs(}2LckG)3Rrjat)IMWr=`?JS3Ai(Py+Yu?HMYm%c|S?bBTwgl*y#?(LrggxWGvx%_4iiP z$)8;@B+{p5-FDJS9sTUq=}=>kU_gh^Z|O8*w z$zmTfsM7ufe0UpiJq})3-Z?TeHIvlAwuG%31~>yEu48+i3?8MUMLGQJ15TGE5d#;&(DKVST{m~!?QVX$egNro zJM#m=AR6DR7i)`8Tk3A@s0Ks`QM1(gb22Z<*l}l5g;i~LF*+DzKE7}=As80BPN7jl#K$Lpi-Eu+sg8p<^EP^(!?5glsQ5N| z9d4&k(5Ruz04nd*^&dId{f@crS z!=B`dr$F!$1CzNR;O;4Pmpx;!bhNts93GIjSwc>t9fU1l)HVU43O<{?jj4<@?tbE7 zgF{Y#r!Fs(#hm(FmzmAv?s&Lh04jMCeVG``fFJ>|V(cZMAsEXs(EirP_dj1IC>$I>5o;?(8$W$=o|eJsJZeD*?5^rvPE4lwxggY&@JR z9rzRtlI+kl@-{kbm^$eS990hDLnjA#{5$Y5dR=aB&h0uKBeB7bx3$I44uUZ-T%N~& zpm;aZ>buYnW6y!tkwY`vTeB|_Z#L#$zTCXqcP+f_q@o3pdB|Mov10B7As}Ipm1FPb zetEG5w!5A$*7EIdZ_%4>_FU;tIQ?%>TEY1H9biJxz8AHr7r?k%(!$|vA8#{;qc@r4 z@*Yh=uM-AjIJi1mzJGFzX)no+|L-Sx^ zFI3=$tLbo~&F*;bb9bN$npn^ro*uAz*siv=x*kSu;p=?x4PZ}+`OnUN1+XxWFi}z~ z28s%2%T|4pwG0B}2=xb_L(rCfUT632A4gZg?DY1!dlEmFQW%$Mv?dOlwzw33;}G6( zJBFSQ4?}ytr_i9sJ?)SbO%4ifIXJrqzia6^vuU@(*{t_TB9SRfGC+e8i7H7jkRpi8 z5Xc~*F=GhHNr@=LV1#2Rvog%el9m}HSy5G!8I_V*m{n9+MV3jHMTA8bR8@vV8Bvju zQI=B_W?*I#SXdMUMno7xeW)??47-v>?x8m93$Uk4dVLQR3+ZD`fb^qyBr`Cv>4l!+AfN;$s$n+H3eUJHl1JILdz-S zNBG@->hQt453_^6x!62^N_h_;1m+bKF5S)j@v)AlLLJ*(sdfz&QMl;<6?IsH{tZSl zQ%s=&5UwkRX!;E6i zCW7;j)JdZ~1v)B- z)ig;|_d=tI2{_n46l%~F6DkHF5wefIH9kUpJ$sBHy9wNXpMO3n5K4~Q5WxBnpD8>I z{~R%+IpXU&Au0Ik&|5#b_Qp?%)d|a-DY!VxKCbNAt;#Apg{9~q1KxI)>6+uN6MKvLt_MD1g?zOBKKC+=Yx!1mZ ztB|@D zJTJ6*$4)$2c52j)D?Ch&x{MN6sOY+JMJDJja)Xi9RkPef2wMqa&Qxb)?1e-8V;a!X zRLl_x=uR`h$TtR5Ty0ofo8MqF=9+<@?h|7 ziS0Rm4oh}k$5O9t2Wyf>)ZA;~*zD2khccN`ca{vx-Dh~|<%8kfs{*Dsj%KexXvo$R ze*&lY$dNKk)CwxHP3MSnQ3JsiZ^?#F>KVE2v?#^F!O7vYyK>~UeJ0F8eYn2^obQMK z3KH?jV279}hl>oNsJ_PE&-irnfI#$cs7#-KhE5v^r;g;%acpRTNm*rn$9CkJMPVN% zZAXC@dY*<(&sUCK0*&-NPXxPRr)GWW_Yfe~cdI;liYPf()J)oqTeJN|(>0wK&Z4NQ zE+cmKv1vnKi?~#-o1Kr!o$Ny>J0t8r4aax7_N|xb-?-@A?pMhUw(Ss;3j{hA9`i1L zrg`1(sMg+-ry&Tl-R&XFX#40L1uPuZzaBF%SX@{-N3jRF&~=2;ZyZl*dayo(f=8L6 zYC>s3%w?YZJq6B;a{5p5!a@-1?}ukrjit&j07NV*&Dbw$ZN+b67=c9)(wGmCB^9&$ zJqdcwGn%*G?jwlS?aAnyeJUJ^-b4?7II=2=sIyHP1L#^_;o5VOz9p|^6p;7E6D1Mq zEQs-z(`+^EOIgJK+>jumnoCxctuOopPb;_QU6&=!b>%_aC#l5+5d=g;6huTsL=l8U z_B_we`=#%(Z?Ew-_V0h~eS3X)(4_@lr_(2NOVNW9M31VpQ0*0Z@e{DkNga8A7EZqO z(ZH2_jZ4bhs>SuD!uWoa^IL=K=v%ge2Y-*b0;@Oe;CwnA#;lOmxeh-94k&hbX#0Mh{om;NsHYIUr;gyX6kZ-lq}9;s zVmNK1677tjMsqu0D)*)aU!QM(b_6f2<2;DI`mH7f6;u~Dl4nCi41DOpB;p97eRG@( z)?x>CG+@M`XJI#^(pWyksfvVoKb6VpHO`-l!YJ1M?453SnUY4L$b}4an`xqg zTaE<9UI^mAi;-D4B=ueSPgD;gteX%rVos+XCmf)Ne#tUk>kGXO1mWCfc=rzbYfp6u z9e1a@%e=qq002JEUqiB5RaGw7iWaSYxRs^hadYZglttKN?mgVxs)C$H+VS50=Y7L? zjLi~9fU8V|_XhR3_sLv;a2D)RFb{-T27DzG^+1(P5i6sks>ty2ay#$m9FM-9UH;TL zb7>QYFFs>KfUwF6DO^bhtBg)8ObR-$!#TZqMr3ier0cCaquN{hzm;8AJmL~l1Py7Z zsMcps?U;pL2453Gi`4iUOu&e0zc%CN-PDIi9A6x_Vb*5LGzRwUW0QehoBJ2aZje+Xx%POBBye=wQ+e5lixJrLR|6`e8?l3 z8;yo-!#U(tmXd6q+7sO*#g-|6sFcIWV4b#mi_Ys$vCa32XCiAJ=Nhs|(mJ?4b^;d` z>Js$6BV2NyMPY`2_ZO6)kj<-80-$$X$CiyQUK2z|G$l3-q0s9xn?T9fh8?&e+FDt! zdF}3o-$E5#X{*G^1{ph6l*wXD3cY$qTb8a)UZE>ZC8?dLb{^^VanraQNqYa6ZEtimK;q!DrZk ziw{y}ireZq;QQ$VG6hJesG?O4@!s=pR0#-HR~|$d_ad6{4T(!J={ep*CnJ|5&-YI* z#XZkxiTZzkPDhI;7l%2!LWca0H)W0I+E}kUTJw%Vs=m(C#s{XIHplWUy=BSmYMgm5 zLA_)qqRa$NqNusNNvOYJj#p_#EXPjTr)ZJdo@xv6WJF~&<|naUzE!EAP*vSk>BmxT zPG>Q_Dp)^Y`zkdj3zH1Tda07M2lk+MO?hOjtx5!cHmV?+PeZcA%dE!3o?5+GtxqGm zF7#9LdMPB(n|dWXymqRyGcz+aRaHq<(N?vPC`-9_Z8ewcdA+=&?arE*Y~F|3PglFo zN3PGgp6c6DL_|bE5fKp)5fKyF+kXSxFJ&}LGvkQ3xcWCC&7{OOq4e{M9Y|C2Fna%E zto&<#+ae-v+KD0}A|htyB5F*9UtPn;n|tbe@SI6KItZ2Jfk8{a}q0~XQ ztJJMv-$ygeiK-I^c)pDuU3@)m%?^R+ z0%pAE7zmbhIrd}_x}?$Af9Z z;ChMIsCL{hm5FP0npg?=C4LS^Ba~VTaV3m+nfHek6l^iQ@H`A4R>n|}vH|Qa-mBnP zmm6SxlZ%e$Q}pt>8-IEkAU6}o(VV$85?Yh!RHBkfE>9??l|?>e(rPM-qNu7Y`-!)4 zKYDu1t{uljL_LEaI=-yvrN?j=nDLu`^4=K|0I2S^ny^5`Lc+Z!fH4TZ#d1fTQ{H>L zcze0d8`Rl$rwmVl>&NQ+L?k36C%5k`S`rGPsJPQ|Sp8(%?s0^ zfcnN}!iyM-$Ix`)<7;f_Dq1)?P{^}Oo+Vj=Ru*!IP5x-eNJ0S!5P-6IR*xZnHi7Jg z(CtMr?)mp86*{qKh7dCLSwc4xJg-w4Ae#*eEcED3X1e0!enUo6C7;3jM&LvpuX^=E zAoAlLV>WX!LI-rse<4NzR8E<$Q!HYV0gnKitZtgM7&{!7+9ggH}h)7vJ(OK1~g*p z`D6~nI0s>iIP7(CA|E@SQO^kp2?+^z;2B)LCNPkg{O`64Wm>gu7clbWBC$4NT9A>9 zX;_q|I;$Nt3g0Yex4m1Lph}YwG60B(BqSsxBqy-T-gz+ag!0-3tvR88HBuYU#X(0C z74(0Wj7GCFH0C&=!<1cm)+xB$qV7Qi9$}#j#QDu1tGnXs{mL_TbnY>Pgy*#6QFic? zQk`>bBnUu+2y}_mg|9EnC%ZVE8U6@#(w@lS0a4x?lX6lIK%qF4KORZ;V7#Qd*Yg=s z;o*+Qam-x#N|dj<^@mtcSm%~3Nl08k^_ovN@(=I~ITrb)S7VroYJJupZgk)!qNu!B vWd+8W(+8K_Zt@b{jt{GsX2HYf1?T7RFB6sYiL^zIoGJDIp~kszrMa_22>P)CDCGLR65Z_q+$7sV`Y7iYq|U zMLB~-6$(zn3V%unTQj@?QWO9M06rf8lmG}I2_RrPb&v`G4FDp700CfXiV`GJhCzZ= z5-O5Nt(M3YN}(0DC=!GO06+mTG669FKuPHk$+UW!21saaKx7(Z4KP9}_>780Axd~t z)P7J#nFBQsP-Gea0Kz>$00E{z(?AbUYM+xpi6okko_{q{#Pp3esrsgesff{p27mwq z2w(&<4K&k3KxycRB1%OA2pRy$dH_MDKmnjM05sD>O*AxUGyoExswq;Ql6s6L)EXXw zXwyIgL7|YuFq!}w8hU^RAkm4C!4gCW1Zk=06GKG77@C@%hMFdtjW(u?Kp2La0B9N- zXk=|l9)F&Vn-oMciYSU+^r8V(K%@9R&!>l^5D^4KL;Qc4Q`6lKer7&D%kcQdA1{-c zp>B76$NLCPX0N_h!aK3u`*U{B^<(}m`CHqo9CE*ozaXNjJ;!lEj2K8k2mN2hcUS84 z4iWV3{t^}e?g*fP;PX1VczG^hUuIG7wtu4mReu0?KoLM+7x)Z>ilMcCkl5S*I!5$( zpQE7R#FSbpKWLmk5r1Tmwx7yG?luuCANkYx6Tu#SqlvG?wJA>o{Nz7+(g*W&6rZX< z-hOO|Vw72_Ghk`{fBNciN>QNLkmDG@qL8H)Oie^B^FN6@ zEPve})%uD$=<~@W--yJRe-U_(?!O0qkEI)zLN2N-%b0F6oxHWPt6A-!b=SJbd@#!> z!+*JK|Ht(I&MEz0*Zn%)iklL*dZjeDn4uYN?SENM9VU1^cqZL-qw0$kD++n(9ay8! z=wj5>s*mcGYLY?;`mHoA#0dRL*@noWcYh1aV=cDL91JaEyXYP|N&OYL9G4`~$nQmD z;-BtE9}UEaj}+@SpDn)<2&t-7+OWFP2;@}rMn{|m6!f*(a3_uf5ERZasPRh^QhFs` zKEvl-QaZf}PRyo}hcD1nz;W~*o*anYv4F&f4e)ui$*ZsHwJS;~MNf+{T~zrQh<{>B zQB-JBDFhTow0yHc9(-hSLgTskHP)%(~6eoH(_2@Y_R+N+0 zpYlr5vIzvI5zmuASdXO~BhsRhIe(ye59Katcc(zvogSEEYc}Q_@JeIIel0s3+%Us3 zSecn7BqEGjP@^x9!-`5Vmb!?*UiT9nJwC6-kr^#V9EIK6B$6eH9VaQ!VqkGDqN9u) zm(7xb-?haMOA*OX_>L=DJiV^pOhs|zo`$!kj@C$r$yH~!D{*@(qRiait$*)?a%)@P zkzBi?+?>lCBJ#O)<3*4cZi}dV+|If~N58r9Th=u}*5Ms;uPCQvTa9kXqPW3~&19!z z;;Sn7uUA#>jFp#joiFVE@9qA_q!K5AvCgoqRguDYq&pnhUk~U0@9)HUq@!}YtbpMB zHu7=Tt@lg%@<{tdGbA;T-hX80VuGJBxwFmnwTd4+D*GO`#!s=JnaC}2NdMy|huWnn z=#nZ(d8I=X3^93d;w8n_Oit-gYc!B3CNW8f#6>caIvBv9Rp?1R^AYwww7_yX9ZMd9 z&^(DL7)L`nXjk68^$G;eFw#{_8;bT-ZI_SQ6Bk*g1%6)}F-sK7@%Pn3bGU zz3QlyU$w`ECsE!j&40%dkCVs>T3T})BvecCvN@5G&ymTnWmHzOjSag`qr(i?8lZWs z)9AtC_BTQTn&3dID~J)w$+h&`IlHc(X=ELucbD+^i*`d5rz<>~7A{}RwaE@}CF9{C^DM_^!mV#9zo>DDlJ20;jz*dU|j0!>_MRd9?d4x^dyr`xeYRU2eHi z4(r>gGxCf5!~Q9b^o*kuVR5LPMv{W#@{;fu8V^h?Pij(-I)*-(+5S#Ejrr0jSdK>d zStE&*fJl)XFV%xaglLE1K6D!xY9e^+Hk0H=?#7tvvVY)OtPyiCQO+(Oqn7> z$qFeVPK-#7OGvhy`>(508l%YXcpOfGtj3<# z;(DA2pMR9*codeJQ(|6~j4|ar=MvQMY2x|GOm!Y?OiT<56lrOfiDv9%Rx6$;u?H~$ z=%b3o8ROt+fL4(V(|K*A2)I&gk2o4nM^Rjy>|0i+$!zVQm8#3u=#FM7S3$encBvB0 z5_E-DVcK)H$3n%5LHn7{Wf^I9yP*o_7{@%MtA8m*$Wa$LM_y*lx(--px)^TV8j8km zW=r7rL0s(2{Wh*hXM7ex^$K+xjmK%*4R)S5J(gmkcW`w*)I_(v8L!>Ho@?_HBuRkK zV#5(@X?9%@Cf;6h=2O?6prs9BvY7?Cr*`x{sC8!yr+le0idRBrOcOFzRx(LAnTU@f zL4TBU9{ht<23;&JLH+*fWboe3<;Bz~w}Vu#&4X}*D#GQ(GST4Cm6@FIG({#fq034+Gqsi!YXDOKiTSY@Z4$eSiCKaY9jS^fX^HGP&-3FoWLT`=4!YYN>bg zA0Ek@9&JS_x>~W>_Q7UN>daA5F1I42O*|4}cQMXO+6o-g5@&*F$>KypDE%G|u(f6HU<}Z?KB>ZmTjkqc*H;Lys$*e={;+;D51C zT1s5D8BN=M*Q)omVew?u(WXOY#^JKJa`g^V3jaFnJDxq$%!oW%V$`LxY1EqsPJ2NL z$>QKwT(hO`s^~SDjoMD=lbv$e$%&n1_Sb9G>4V$w(ArxJB0=Z3o#Ecq$+wSU-7p{FTPo%I z+Bi}5T$jCB+zfKEdD&UOs=UIv-m6zv0}R#}w|cXnNQYQ1vs0ng?w#=r9DjW5omOpI zC$CV;z3II)9NFDbWH=3PH_vfBZM_>?9^*#=YpO1rvclY>Wvo4G7=tk>Oj1iaJRGZe zj=7jc-CSDxt0Xw{%bA7s%{%6fcX_l^)QsZM+>~KAozd0b2$l8D>ydT1`p)$o0)pkZ zO{H8btmzbVUiWCv{S*knTP^yDqL! zF>~&&eVuiX^)Z}t#ZL{IgH`LkzV3apQAWu#4D7y}MRKmptC(i3?Q{mG zF?AukV=VYiR)hnMH`utI_`dp@{J`h&2Zh?ZppUo26z8Sxg<*jCX0?8zy0wYkBRwJvvSmb=-t3E;J-oaPHAt zH#eP7i*m1uE|+CgcI?C*5ET?O8sIxk4ut$vwY(9O$5UR_S- zF7<`F=xSSYvwO0hS~hl5bFMP0T)D{0*M`~IwUkT=iEcuSqqS#;GEGao%gVFKTdeGT z)rcmBD^09Up*?H>?)Rl5#8x$CR3!HyE>~Tqh8%NF3grU=Lw{>@b=W&Z_k%>T)?Bnw zQU>nsuKTPaAP=*acNbgGQMe1%`oupNQWPjnwx+|fQ8KV^Zll+VJIOY|dhoGiV(C*Y8$iK)^Se`d<6`JH zz>+rzbo!-Sa)0vkZ+0emqf8}SAl9s7W|p1mCYc1MlEw+MzHOizLT((S+%T+ zDZcK-Zm+JvpdA5>L~o7-l)!Du4Y_L^n>T9pJCa^r5C8T{7JEQ9_LMy z#143W?d+w$!Z}@Z|Mb`!bKE~2X<1nRO8(COfA~FLCm+w}*%#l+pB^nl$VBD&|GO9& zQe+r}_R*5gT?^;<Hv+YgRFB?9J;AyP_TBH(Fj_u|VbJKyNRK=AzX6HutH&2N`QSGgj_c zmA8+BeB-*x>;o1$(8hAcGtEgPEk@?J9rlWtY-{kVuuj~{B^}MTyf>8x#y$T(Is4Op z0$FzkVjy+XSDY;ZCe*0!+R1r0b7mV?PV-J3no=((Z(Lz*gHds$bahVdI%DtL_2;i@ z)^e>iJOJk!Xo}C@dN}A#czFB`%(Vo-(Nh<@zS=5@rt@!$JrdIm5(J3QDP(F=jowE|U*}EX2Rhq03skon3^q5P38=ET) z?U&U1tlIOk+(v>NQ`4BashC=x3E5d)eCw+=&K+)|u7C9xHOS^kVq|gEIaa0BA#FFp zmnh9_t+urd0`B)qyW=;)z|#Z0TCbtZ&3kVz8gDu^g11DqDFd1DHw`7WQQw zX$_Z?E>j&^<7{Rj(M6Mc{f}&a0o9r<*JrowA@0PhC|rHJ)10Yj&d>~{Z+MH>U7eJB zin>)ZgXr%?Ur=L`qrxMnc1#%>ZO%nZ9Q=-WIdmPaD-pbq;)M{(w3zNVd`k4kdaw!_ z>z!P-s9VPRg}0dZxYC)7pD!jnAUn)jl{)5Zv6h~YDjq2t&KnDw1#c%hmomDGzImKG zFRNVrCCeG?E8l8Qdad4GyLjOp5{(IMrdH^wuM=CDZ!e|Y3Uu$1tBa=cFNLamzsr+~ z5*z{Wlcy3LfB00(bWgC;UEcR)wWfE7ST$K}4RvRk0qGl?k+z;P#9c2a#<6x%-$*C?<&4V{$T%8j$axwX%0z~J5bC}IMIkS|suWLH8FA=AgdLHa8z~EvGLCH4kPVJY7J?w8~^pv|N1KbvXFRJD$ z$=No+8PcYSgvXZUgs$n^>lYc!?N}bV1CMB>f3V`av|Z-oR3_aY4(CjlsW*z&;}rNw zY}ZkI&BnJSWh^lZ3l>z4JK=fE-W`z1*lPr~FqKu-MQSa`i`C&bfNLy8-ks^@8yYK^ zE?a5G)_0?E{!U@)>Z;C|)^n5%0t74>rm8^-n3<}~&Me>VLOnCxp0ybDSlLRIp|;5_ zf8@aLYu4NsDc2j=Cnb!ByTcpR#-bQ4&|{rt-7+h&Ur}AM?v6BFsmE4zhwcACD;W6WQjCDI)<6YIylS~y1e}5?ye(Jo}a^ZaJ``Kp;xtnjNT?ZFC zMyOVZnVL#unY9y>It#s;8~;3WwI%N^rr#3sli@2Rn_8>dTML$LPGa*chh}1u^EfpP zkQlx|>6~}R%vW7*Ar5$WcI)ucjt&oE%a;ZrPj2-lKaXF|zg}1BOK)TPw)QVCMRdL` zf6}`bOQqLTaTDl(sv!Rmpa2OG6$E$i7lb-GDCn4?umC_wkjM}URa8O(=SV8Fpn+(B zfC5s35CvF~009C1>>e-#07nFXfno9ebo{ru|GzRqt!aiD9cxSXm-U8G>WZ#bRTTU` zZ}r@tdZI|XOn-t22!6A^J2ImGnHbM*e@h=Oysa_X8}V7D@=Cn+&%$!)H3l*o@ZD!r zSxE_n7I2HCFum*q7Exldg^8f1Qo2PAW0?PcMNm5l+ zN|xzazUEaRRTHf+WMW700-+)R5+afSgouoSG6;l%EQqXv1d0+M07$B-BB%i(3XF;* zf&_vLih&@kLMSK_3ZlpYp&|;B2qPe%go=wIDiR_Hg%u=Zip=R~kRc#xy9$WHWRQuA z2dONzBqC`MywwmjL=3Hce-K5=2na#Jgk~s6iq&nZ(+z3{?DYDba-hhJjPMpru&Wrs zZ>MgQdW};Q!eo|SGiGMUvAZ&6dRcHXEHc6!3`pJ??ay~9Y@{JjCMHs4DqsRbEn29J zYW7UkMRGGN*_hVl=~}R)=H~2{?#j$eo^c6FGsW%i6MLOI8zWuy;F^(iKOx$g$o`uRQX+s-hOe zq&t?Cl|X?YMl_j8VkmA7-6e6-3NLc0xybA&LR1a4N|O}ruB)WPkS&X(CBCV-h&nWu z3`pqdXjj?X*4HBCR+k(Qgn?-cRwZJxmESvcg65qCBnq_Lf4kQnxx3a%OsZnSv9y6- zT|{0kJ*%uKAV3I>?8wDNc9w><^B%w)N zw5Sy+WAP(pe^Se8fmM~Q^EbD8a`dwd-M0kH-Ox%Iw)%^^cJM9VI}lJ(g(cR~IC58Y z;)yKQ$hSg502OdeP^cA{+N~aGs!Xb^Ij2<>$+tWvI9%3V9ECGSAj_<&z@lEeOD1M( zWmV&SZ-y$+)1W*W4i7v7&J`6AmUmfKtCX(W5(=>$e_A(qjTEawu8DUVt0^+Xx>Log zz3DXsmkO=j?A%W&G%SyTu4&eQTB)e8q}s@-YG#d0LuqJMQnv|RC@PnDNRrqUv1qN8 zQ&)=?CMAU?REfJC0!l0_ZufV`)}8m3@(jmgky*XUP|FWF3PHiXTXOjp0Pva=LzeS( zcGe9Pe@U*6qk;Kg8A{x|z1};*pe9nwU3H=>t!B3cC8FJ>I<+K{s5C}wMNUGacx9J` zX4&gyw>A!INig%ed3|Ih;@hMqt0auM!#XV2a=f|HqmvgLAAid^C>20j zJ3z2nU3pR`sd)_yt`@A+mt@{oe>t){8*rAiA$O&x+&_KaP3U8`=!aAMqeXu(ZS8WwzRoK>Bs z_fju0SrX>NM9RvWC`#F#-G977B1B@`6>o4k%f{ZJki(d8W?G8?dB(IeqNL1&MnNo7 zORN&_ZeI61P~@YL* zbCl;HY_5yBX{%iZCe%!;)Z@o*Y3t&vIi}*7ZV)X7bS;46!?Lzw-5~TECAKAu!UgT- zP~cSvBuQ8?Ud-Ggx@Pg6wYFh1vug5`YXKG%n0E^xY#ZnQeo`JvUO)U$I;j1R&5<$= z=ATz9+xOF{KND$naew^(Ps7Uny-(#|?pA){eknxH)|W$1;+a!Hn9W*v`2HvCr;WvX z^BKsb(T^iqUxI$>Y$1^JKhNqfT3m4k3rxN2)qY5^DH73OMPNb7wzAX;1+jH$qqnz2r!y+xI#)ifLtiEucMHr;-X?vMCi zK9wyUc0a4j3cUC7b&FTM^kc_W5}g{ZYc9uXduCw0MJR?Bn7w?*-* z^1>NyTOBT(8$(coX(8u6+oG>(CT{N<+t}lDo_`EB>ievtYKDi?6We#nB8CnuO6$P| ztsSDqGWSMM=c2^jXw|dX&B)vWTD}j5EUjm&6&lW$mz*PZ3e_eRSv5TE<*%BkBd418 zP*Fu=9L&J@=;PLPyEHN8bamWqQokaQ@>Q2~cpl!T(K;nJG@miL9@kcC|n)2$V zMyM+v;$jq;3rFtwGC%-%_r+Ni9g$IlK`JOZ;0;AB0SN>o1W5*{pbY5t!%1wZCb}(+ zXKHRk-X61lZXFtCYMV7RR8-wm$&FOK6@MXEaoVv-6cc|=B{?6vSdXi~X-&_zx!I+yw~d7%DQUv@a{#Ot*%}S`(Sv_x z@Xkdx*L2suy1@b6xm^zAqq$xr%~InpEkVP z@Y&6#aDp;L2qtJ{_-|Q?+CTT@t$)np@eDydQRn$L?`3Z!!p;tJ&)EcQC_6rKp9!mn z%6{h;e%q8kB6N+-&*Bn3MNuZRFZjm3quTErs_^K(o7jT1C{gozy$RT=kEw;w!FKZ0)RhXJ%D`Lad?9ef~0S|c|Rc-eZ{kl*dYZUOzEB_R%aJ$kKwboZv8 z-K`Z;sI{{`9Xk@)P`1RXbS1AREv0c$Yadl4m~>)M5%hm&qT@Xf?iV=3%voYsQJ3~K z$&+JB@(?o-83G%xsN<@$;D1CCU`z_nXAO$o(&y<_R#bc*^j+2je2AtHfoawHS@)i# z`NuKVTt}U2UfI2GNyn{*HX%1qn{r>=eqY3Fho@WOsmZkGGz9C+W@7xgaaC4~b4o6H ztl>3QY}7ukbsK~UpSSP0(K+elt?^5y`tuKQ{l7j1%xlS8Y|A9IP=C90+|-Z2^x>T` zo8cgh4Tgk9$cp$}en_?N#P!2%^J(zxZXzk6L8I=ih4X}Jk{xxM;qJN>tug83!fHrB)2M%oMh3d`%O^aNmn+uw~iXfBJuvm zp$Oa|bDa^vB!lV(Bk)8QOeTb-h(H+8)e){h9+)3R9{Cw{f8xOeMcJ@IgEPNIEY;;xPMj$c0mt4F*UD%Zy8 z4oAHw-WMrwiiLKAatbrqc^=?Lsw;MCnC4A%$UD4-(X(+9=Lo_w+Kt)1{Ky_e&h>Nd{h#EwArvKk@6MzV`V+s!lRzY%SKv?udZISwKW=B7h?fHV za#eVj!&zdDL_TrNdo>hGNiMmbdU)D>PmWnNWDL&1#ec597h9VR8dVzz*Jb|O`QKn* z-;s}`uBZfzbhBK8ixerltO`zv_M6`}5d; zSM-I67?>ZW1$tla6Hj~I?_&J!udGoLb7M2dsIQd_W?W6ae9g`)>|Fh#)X%Ca{Occv zv$o8gy?=n-{FO4TN0%sRC4*2kb|U!`osTPYQI@W-s!7`MCim9w6w+vUrh>mxnCm_d ze~zYBaHGggjsiTAh%Y46N zpSI&iD-Pqll<(%{GQ5SlBZHeHaAmRKYBtQ^nD4>)P!WQ#9{jK0d-Uy8cp|?DJ{s5O zxnX6@)DPFopET<+Q5rgyJKY|46-wE>7+ zb$=9v{aCLF7SZhq)?}Od{Z62Ag7DD#sZeA9cjnK>;cU`He22|!kQQpvp{$KH*Hhb)4euC!8%-PxM?8a>RV<^fJSh{)M(umV^^gfzt z++Y-CoJ)8_O3CJr*_IDER*k>PJ;aeDsDB}P#7PFbT+SuSofm+0M7uvnkE}8$QazO!;GnqR)cr^G451 z*PJ602JZCZY~-b?BoWT>@E%=Ckbkhy@{gW+e5>t5ik|x1J=3U+7=+o(!iuYzI2u!P zeG{;~6d;yy{5L)9HW{>6+|`&<2p@tCk4x`UvS_ce$al zEcdu{(y>;^&^hn-)lQI&*xdKC)IKK|a`{tLpcd4CUAq0KZe z482m|n@+UOeW~`9O*1CGGU|Rdci-lGww#R!cpp9;p@yN~9_jd+AY6~p*q0Y(v%G>( z&r+muPr($$JPdEqn&T8Ekpj(<&OX!9|dGMuE4F1;Vm9ao+GX}o}$L!GqT{MjivP?}P= zr)0^USt(5AyY^(BjZ(`v)^X8&GtIFdQHLz)QJp=WzRZ@Hk4qEH6j6Lr1mv32ig58Z z7Fne6JE=$>DYUz_E=`4G)0RS!?YoxTBg3v;mo{ppn>RVrgr%sS+JEwqH9LjVCSvaR zrlmegO5R?o|2H{XK<_?~@g&e&B$JP1 zVJn4dHr%PyKz7v7u&QY0<;a*7Occ?>GxazBz~ z0!=l_Q2Dvk=zlVhC=QFLkVI`bE&-zM^6~wksL>=)$dL3_YxQE^dsNweBz79;q811f zJ)L&|5_E`&Fas7~S)r1->`mLyp>-HE+RpsPi*sFM`Kwbwr22wIcy?xbkv^r9nIrP~ z`1$(0{6+XpoC?DF{2wL9)34H}iNX4Faq2&%k%M}+_kYki`-?5XZfIx<3bW?oq^v=+yRGS~HX6LGxve?vl|NJHJ1D6!0UxU7;)n_-Wa8WA}Rz z_w=E}!cT-|_Bce5EFh{7-P5=@aNs)bXQPN=OMilLF8R%#=c}ak*n}jISDWOjUhmCs zD+IVw=!;=U&Pu2PvZ|Q9AxSrV-@a~=(700)*-N6SX{Fsrs+T9e-U(Lr(xqZbZPh3$ zt-Oh7S}aiLm03q!E-8^#+oTb?P^8{nrROhXwOd66F_f0}(*1#D0!0ZS6tBGZxl0OH zr++?nD-}S(8s(+pNDPF5P{tOAE}gx&(YIF87asdRVQ`U=^Xpi!tq++KlA~eakf(r` zTbI7luD3~jg)NDQ0tuDipIuU73Rk~y?)q(43dAcE7YbFj>jl4gyGd|Wq(ZrlqAJ_% z^Ue9Bn7C5ll2A;qv?RCVRaSi0Jn`p(R(~Xv+e*ZlRJ%Ge1li3ar|pxJ_`D=8>b9yGjsuKBGbyVj}{z=EZ`$w63pB?>`R zs^`O#+)B7o*p@bcDyW$ff}`*NqNqXI9Eo<9}FE zP^tu>R1Byj2xT0wdjr(*=S|ybo$yys))ppe9x=iW}i>6!P}kX zQUz8&w$fgeND}3$oFYgvV+6t_qpsyPfjCi)1@yQ##;ammLlY7OOG1Vspt{Drm}G43X-vRR!FEZH4{jYN zmbH7Q&Pza!jVZ0NN`kc>t}94;d~$cZsq%0|4c}&Dhgb`7&uge|inAm|Ab;@~Vh!B{ zmUr2sYVwtzeg-hci&(GXl(}oB9&AK!T(+l=4O^Lz-CTRi2fiXZ*dE-Vx;(M<{7a2$ zdB0W%MKptXObSLy{}eU^2{8fZ*A5|VXz^&6c)HW-#6k)J>bg+@x`2L9lEx5*QV;<= zm6BJ>xWkFIM_d>;m)Ib~GJk?U73|amdy)?A^5mQrYgVP-LT}Dfx5GI$@GZr4E-iX? z>v_2p*=t_)Sj)24oKZNUci&O7URT|&*Dnk)t8TeSIS1RZC4B`F@XTz=p|H=}CKC&I z=jaB#?8l+H!Am!q@xE_4x$oNcD-O1oN@qpc?D-##T58H-eu}xAij&1K7=PQ6%tC&4 zKs+89h=ud&BSm~(qgYF^-LJ>3AV^U}vyT2@xJI)Q1qdg34p6|5eC7`PaTR_Td+t?i z&t_Vc(+}D=S{-I{-U)I>_mz|B(?2)jU2RKxKAyMETb;=&9^$&~p!r=UDAngnsIg<7 z&$a5HOcZx<04~Z{yeN0ay?@EZZO@Zk-YbTuwX+)gubtUS-*Y0pgH!XcT{z`dNe=0gYLjrFdAD2oqznp^8q&fkBjT; z>SaZI7jy6iZXj(fDDIDUIU>T1WsDOs6E$Zbz;{VzhTd7)#kPa8*((jkx04j*V%dLO_YtX3Ptg#hn!Ty4Kwp^ z-vh5VO?r(|+REsvmVedE+(DE|w0*O;M4X=&gi<3{$YVKn0I}Ztzjw0-y@(CRc32{O zr67yAf+*3h9(t~5pkVpDbXl2SQ=3OSlUU*1Q;YSdPcqYHV-wDxvUQkC@EJu75hr0c%aL-{ZhO&V5`fQ~K7R(>up$wCsgN}wW`X)B z(;1E?#wP(0a)I_XF4c%TNJ$UA_nyeBdCwV2dio5_x-%w8J24Te-9RZ(p*LZ*&j6OW?CZ#xB9!i4;yrYy)9 zvCcGvLtE@qfpF37=daJ-V#eLZyO%nh3cZ}(Jo@_E9m!tOp3K81iJ00tDep+8vjg08 zjkya82-bc>hUL%7ua9oT<+NzOE%-Kzn#w%At8!+o=6}+K$#PITQ<2AJ?EE*H`06_g z(?5jABAt4-BAUrppAGfWPCoSO%qnmwsPLcGpHZI-n48;Ta!z?W1{&_2iKQ>^5pv;8 zH)WN{N?27<(Nb7`9ukE-&UFqqozEl0DQ)k@R`{vDH z+K{%N1uYO@-JtY&e&JWC%dy>kLUUUZ*al{*WcUlc%u#W@z0W0f-%i~+&YE1gPz9?xJ3AzV&IV&cU^tMSy33Z5p62G z_)CAjXMoQs3hO8@a_)snNUk-6dm+aPJdWoRk;74uN;UaG(jgHLW5j>8zNaIDX@>Te zO*Bxi8en&w6`bzW6Fb_=xP`4ReTTQLdzC!34gKwX%0VZd^!xMfO&4E_(sYa&vq{m2 z#rgGe95&HY+~G;o*PNz!WuG4J(?tRaEkrHW#w;^`UCoj-C;SVXUXWuccQo;hj4&h^ z&ih8I%UkwK5XVGmg#v#ho@wxWc-W6Pnw;kS=TFiiToB`X?FW?n!Ft`Wq}vrU-pq!z z@nh~V75Y%1Eia!w<|FX>?*@a&ux@K%uFSCfHfjS=8y3|8nKL0=2ym++V1{YkbK1oR zxg4B1u(IXli#t(&E@bmIPdUaaxh*QF{x9l$xv1UwXXv11A@F}kpDk@2n~_>5fmY91 znLFDrYEvu8e~#PCEGhw3n$>uG`S7P+%eyr~QC4epODG_+oU;ZZYXxGu?fJNTil>IO z=JCPm^heI60lHt0z9*Jfx1QH{w3?8i1>qnH_pf(;6QPaalO3qn67Z}~`CrNYWAD)V zj{66STox%Rne~6w$K7MOuOdFiGEdX42zEhkVm{k{VPXLoQdqgv<>Ny0B70nmhRQrW zGR}iK>dss5U`vw(>0S$AL`^%9+hPxe>?N_yn`A0kX0qu)cMr{qL+#j?zu8L3#rM-k z=`f+>ksacJ-e(O>T6o(K&J6YTYEr;_NfU%2NuD*}p8kJb{jvMtp2hY#2`BFZ_P#n_ zOkRw6hW|&M==7t#Uc=GXqY>q;U-MCanjlLCf<8gQzUw7=r|zBnyN{Xk7HFchgmj}` z#d7)YUUuOuE0ReErB8Vtld8Ov&ar&HyBzEZa&wdA8qXq}AW+YHFHoV~jG?cwEHxd- zeCh7Z5x#$ECyORb?bN0r*CHNyc5qOTqTzzq;pgB9UY^py>R%*PN5Uu5ea&kfA^K*q zHpNY@otE9#s!Qt6)3{a=bcz53TEaqa^=P(F%GbQxlx0IZ zF?Vv^i#Al9(`!}l-=D8i!kR(?U#)%Tj#qV!#0JlAIq5?{J4??-ubNqj->6XAEsc%* zeRtF?`CFZl!*Se&#N47a;c+JqvDq%|9@t4}hf4;#DH z`o6L5^m19zh;`k&!!;(Vl^e;bm$ z?w;G0sBTe`mj2i^z01T8#FShenRVxqkR=&^I6f#_whk>&6fjc@7ESBCk$``~P@OFz zh$e%=*fzWteRmCY4v5KknFaD+j+dBVoSs_YlWT@^tqP^e=U+|h$qvs+;a(d&JKu57 znWfiV^{p1-&0eiC}->FsVp^;6H|?Z@hSGHm4C z%j{tvv8316;qHEuv_1y&E6#u1ll9-seADUjMkVkbO){EwEf9*sVUU>O^7D?56U5&+ zyFThlMh}8~Q_(r{Gg)dqD@%)#;=dK5hq`@z_ZArMYbvVwdCmRyc(rOPZ(JVrOK0p? z3ivFQNHnF=G)#-&@(p`^k8etJ^&c+P%(F7CKJM;}-*T?fLQ~FK9*}>pwI0gs;Q-ph zxnv%&?)p^PF0U#Tb+|2FF%mOxrA4`Ywz4@W)9h=nw8>294k%AzGpl^OTK9F>7FO=) z*Eg$j0nqR|&SIl5#8z5&usg*&w%(zt)=E74vUBR>lDTT1c9p#%?cgb>3YNrgtCi-< z*!y#qyg$oL_rB#oYc+pz7)DTbK_`P{)m<#D-NIz#WQ}iem!aMflX51a1W-w_GOgM{ zT=`Jp%h}nidRjK1>vfR=27QMy;VEZLJ(-A543qOs)z*}gz{Xs zmgQ(nLE)qErl$Gto%Zw9w74YC#5c@wV5iR~G(PKbJbRA47A#NQIj%lSs3d#Gt5EmP zPdnc3qhjk^(+ht+i_^<=S4#9<^Rq?4$eL317KkswG?%w4<^0FyWL9trEK-OE0sTdSG!B~V;L3!s)nLa@=?J=d%-G9cK{PJ(S* zo*oz3ofgEK>;_i3>wW2q4hj}g>r3qM;&Ra+1}=AE!)dqo5i9?Rb5@VMn%26m-Z^3_~y!T5shPJ2Llg7?)_~nS(XRVzs zUNlJ!3lupn((|k2CWSzYsF_5m*==j-!kgB;(#+_v-2%xXK>OK~Bu*2rQF<|9Oz3;5 zm~p=QGsxLcWfapv&JE`(s#F6cNrPfh{T_aS`&`QNp7IQs5g%3SFn=b{b%tQea3I_i zp8bEvY!_V}r7&YESJsap*AgRI^UtCixD$%|4pWZgW?70}4+|@YtD863=C{ofsNOdf zdu<*k4|m9$O?fAtOxZxhobum1%_JkiUw!p(JE{bc^3ER)Zup&xaXhn9djSYWq%V?x zN6z+0=C2ZOECYVq%`9&)+N9}Pt(q)!yE z{F)>?eDiJ{#eRdbT}M7unibK^Y5cl^TYc%Z)g?}zxYr!-*_gX6^>Z;NdLnN0KY!NR4;*z?oYTs=(Ge%>dnkY1~6i4I$;I@^gMQV?zo#~rbTE{LZbjo*sl|y}|Z=XFi59XC-G2PiLOW}eL5bnVdX-A>ZZ zUFhdvT;v;9zAf3FXzv=y?b_zl&vPY5VrOk_aBR**%V@cviO8ouN~d@MgEoB0$GMU# zjBVZ?CWR}O?98%pqu#9}IaSbQk6q&wnQS%`;JvC}oKvdl!9X0^84;Y1UT9^lTXAaCNkm z@aw0%R-QS$9}Tf*MQ=Yfi}-*(?kneA(0L1-AiBXfdmSN8m?N|zz4q&Vao3a!x+cMY zBxtH>SXd>RuQqN)MIG>j!gxv=F?`20j*&U~zSEWXWYqi;yW@LycEI0x;z&`2`GOO= zc5zgrQm|>K^%uvN$*+6C^NZ^rk<8>@Ps3Bw_hn7t)_dNo3!VF?AZFZ!Df3TQ+WFY; zJI&%FoW%(yC@Z=pfm@%_c`N)EE z%a=_$G-h*VF-0pfvD~Qi#s>$or7CwsdA`U!9%4c6CD)HHa(hW8^i&j4>E4~2Nu)X^ z;pGpZRb3cZ=h8#>f42Q!qF%xW>ivJXVR!o6cwl|xv(yG{bn0E&>tN7^EO~=}AgK2C z8N9O75OodYaO=jStFgdJmA!|W-A1t~SyY;_oue0Ui;Xo~dM6#)THgT{&4ZG{FQ)~c z$!C2T-GkA7#T2tz7{M?LTZu<8``pP}H!2K{aJho6t#Fv8*7$DgcxuRtM-J8K#7AS! zZnsvHGG$G27z=lMPP+r0r@4s>oxRwdA+WFY!>IHt+=kxPJMeeYIV^lSaF_nn-!FPuDQy=+?t)kI@e9neg;M4 zbAtfb7161fg%P_nSpYKN_e*A{pD*7{CpE@mIoFea^Us6)g7>3J`j28?nU1e!bv=c>iu=CO;hn-Q@zsgx%r^ra?z;8y*7UK3k~rh99eb;1fBP0t6rdS2t_WfVy$B5C~j==a`S z;X=a+`<-2vtrzW~HO*ufw=8s*qoBi*V1;FW?U7R z$U&{gieUMuO|FWjA`FY#vQ|t{l0)Yh&OwSe^R-z{mut}Cp3eD;H_aZR{de1=<+S!` z<@x;i)xP=<&zB<4evhpZ9QWyOc3@304n6EmCtEi&Q)6vzYq*D#hj88T^iXJLIn~&I ztgVcQj8e~DcSR2IIC0x*J6&)R+*jQidepJgk{HbGO_Y+IoO9Sx`H@MbqWJ{siNlG|9ywPpAhce?VLOWTI)a4PP(3?ibWw?{( zdpCMf*NA-4I*ILf+uX_aG&$_Y0TZx)BdrR+8Vl5zUdlUkN9OI%nv>R@mVK5rLeRw@u@Lrybign6CY#nnzKQlH=@M+CvVg} zYq#gOyIAH6x?_k$yzFsZP~lyi5M*U;5mFO6}hzs%j6GhU>6-nNmu%xBvzMS9P1XwRY7N@W|cQ$ts@=jJUkEwn=mQ3)-7W7^A4VR+9= z6ub)%M<<_GWDc)yt*;p-Ja?aYLj8x>K|AJmMW&3FQ0+KBwu4G~rCASH9Bt$L{r!)h zu^*4xe}}jHCp2QKD|M%8<09}#&4^TGK5ETAWWA>MuHBK@W?f$_%r)Emu4vz!&Tk!_ zRXY+xAco!4_^P2oojDVKSsG3~%qT!Ot+A9lo%aCL3HJ@$PUlKa4hh-0HOw8DZ;r7Y z-e3=*9tkafV?nw&P#uyXcJ4mS2>4y~nD#8~$`bF2ffGzL5CqO$UX&KB{c%Lh9m z+68ZG5QO#dGlFM_5o%>f24%lFK$=rZu~*%tSnQoSVwaA~gmNrsn5r^R+MJnEo{biN zcfMAyJsG3p=HMrP-&E{;P0QnVlxk-W2uKh<83b22?tJbQ4|uxy6fYnXQxhiz8rWUr z1a2}q=0d}ho@jtfjc5!Fi!V4 zac+l`y@{$Z*Za@2k<1rCaO~y13q9?Zh}TQ9z}j1Cm(`ws-)v->r%cs9XU*LC93HWk zv)HdhSgI_GCcR0w87y3R{4YO(2j}|A3+KM03)R%UbcEFlypNkqkX~zv(=3OD%}BdS z2tzFizn^Z;ACm&GPaJVOHSG%L@UCeZ4LX!Stii~e9GNI0Nr>yH*q zwzEq}Jz4R~qWj6l$6i~m6Del0@x{;Xp>_jZ4KD5Z)axx_klv!|rCrFPJ5R*Rs;yyn zRCV#IkW$mLI}y$-ejsyh)c1FTQsceG7cAaUBw+@ByT|1p1rSdJb5D~Sh2fU=k3<+( zSnM)0Vn$>=Q%@|pR91|<*TK#}{B{8| z;n`AoRaL{oR=uLvyHlI9Cp(>bSXVJHxc1If<5m+TrbJG`h z0GZH#W5~O_7n1sn^;Q!D4v@owhizXwk#Nqj3r`i&w#BUDvo%oE{+dIB4EAJR6K_bL z2cAjr38MsDTWjB5BR3TH+8k~s;OA8Mc$hwH=X%!E*d&U*e3YxoiRT7vZ+xpA_}9LeCS?-r@3l@%qRtNrYm%RR)VE&8?YMqVG>;49x~Q@nPAe zk%35pR&0Xij9DeiySu#Y$C`$|g(f(D~$pwaFr(9wf)bA9dM z!i4s|0EQn|4{sJlYA<9m?zX3~9G7^XQ#MyAW|sw(VO=~#B^wOzV#WhPu=*pK%N^Xg zgDs?id`?cx4tFVeQs&cAIrWtMg``q{K7-$JP-9c!LK>%ZDC{O^cb-R5UCWI+D~sO^ zc271e5T3sS@B}B}ZvegN;^lT-u8jfW?ic8)TzDwXb%01f=y^I+PUhxUA}IA>f85_ zTH}<&`l(e+zP6QQ94!!yFqI6$G>ANDv^%`fcnT+}(CJYC9>0<8We2a~mdh;5rLpOGIYt*x%w=f*q z>&EjGSCfTKt!!>KEu^N2oa?sJnj%T8tf_}HB(^g5dm@!8KrZrgZ-{(OH_W3@a@|Y{ zvBl(6!dWX&O3yXRuz%%Ta`M(@S>RStmtAh=X-kUrH>O&*m!#lLp`C;Ki|_vmk382s z^VRq5eQx2sbOkE5K}-7adX#i zJ+#Y|y)oJ%ClFIh$R8Qd;%bLB;0r&H8k)UwW&Ji3p2Dun$>?ehNvlq>-0i9bT_pB{ zR$yk!(UH9pYSfbjv_wD@DMHR8QemBjlk6ggm+Tnhh*|8K(Ubz~o999yAQ(SYcPH^>I z33N>pfRbL()Gsgb>`wS~yr0zmNgeNcVhvZ+4pS7c&wZMg@N#g+eqP#3g7%fp7>K?$ z-+YxOImnZ>xU;vTMo6db`hLC&rQym%Z4OHyHfl<=*M9=ZLSSA&Oh1Q0oW5lky6*Wq zdTCuGW~FgL8M{b{4XtC|Mkh<>G(emon$o;2HM9}6=yFd*aH0#MJ`yUwY1mM1{x7Qg z>&3ch+RGcSiQTKd(L2KWWTSYc%|Y#%wz#&&Y^YP;#nhm@E_-9KQwQ;1idNeA&#EN@ zp7uXpx_>Ey(*!r|r_v&6uO>8mOiYZ(1dI1FO!tlnUJ+bpX9Y$BLMfxpdMZYdXENPJ z$F9iV-{cE-uXstLHKdn_m7&eaZ+?eYZsqMjdPfi{N#A{%c89zNGXisR?{ZVGGd+a2 ztf*YRaxarn0{Ald(L=oN4zP*kqiQ)e=d3_eu7A698|mxW@shL=hA0V9CgsR()w7+c zvS?LQ;je2Wv5z){0W>=s8EBJ0oUDxN5jZq6VZ3n|cxVn*V9QR`Eve6b$Mnwh?K_*# z2T^kIkLN5441tVm8kYy6fek)34oZ>MuRbNq@iOVCFq=nBz zE})CeG0BQzcv|mV`MB<$;OI>fJQyo-q*Uv6i(ovU$LGCot-g2;Hs<9BRP?FP{LkR#2ehas(*RW zJT(s?j$)#(u~r=NC|u_kGnf(20@0#4Z_!1qD1HACOA$??noTE5_tc6hB{AyRuWsBg zm&#$KVEbXC$hsKMeY{)tnvaQR!{5(-6PBCq=#x%~!02=rUMho5QG67!sT~@(MmX(r z&(zd?v7oJMy~wwi$HMSbs7=wtsDHMM%ht0B-h)foCT?WO%T7zpr`f({2_HJTX0+@h z1UJ>Wt6kaaes)g_DmUf~S0`(+o3#*CobOigmT<6lUR~-gJUh8*c%vBar;#+6IE86f4)%7}9zBvkM7HlvDSyUx@~G6S z&3S_9tF~aw)=RJ2**7_yMpbuMl2+o4zv+4A{2vT4hekoHjzA!O=zWgI0&<1%bW zn;E#bk*?a#-QA@G>>SH%0xoURh{S`wS2=5FD4rag&(T7da(Ug6dSe}?V4Pqd+}NE} zW3?D;+$o1#pGe-<=y}k^aE|P7Sg9U->OVO8n%O-#HlcRwcCi|Wi+>cxOxaL;hdG`U zh4&TlSoh_CUGC1~p~B~Lq$*B|S~0N`iPf;?r$z4Gc4Fam+;#bzDMOl_zXfA=Ei~sA zOQ2Emv&{O5!FNqRESB3NM*3thPAZQNJ$3t;uQ-n&bIAv8cwzSxA`(0RP!*qW@6W^< zho*ijJ~a%xAm;2&uYYCnqU?^hxO1uHDXY!FqBkwSTVqnqY7um*v;BqCQX3 zOWUt#DVjaeB*x=AVy8t5J@zSKsHGtV1rW1&m0xQU4DGTRORdxD@pFMeuID|k7FuL2 zIB7iQ1pA8x)pHT=4P8jg?B4Wl;1d<6k1kiXX}PD(xCtz@-McwqCcrqvEcWU%BBM#u#OIPPDVA#(7* zd}c6w80UFH)dzn93*Pr3frH(hJT!+mV0hw|hU7De(U()3S5o&*7qX)wr)@xb@Rgj^ z>l>Nn_}+j~7~};Ab+10W-nr>>yWEg)iwh?>t-B`8p?}-GH5~GvFamJe ztH~mJF7GYfQ#CIXkvo%-y5=6iQZH^IfjSos)4emNilkx_r>llLJ&y2O1}@WR7dg%8 zoNJ4bI1!+i3^s`!uE>)zBBnEmypc zF|FDC?nv=DuzTkt_r8YC@MRauksLCQhh_pd?0<;a!^C#`qjhxh1^1G|H+@M&ky8(D zfiPE+I5KXqu5*F#>}M%1Viq_?hE3Fbs`4nVa2tBY!LD}1Okx^byF~7Gv2?oKZt7J# zj@pV0uc-Wfb2pcDU1}piyX;N3JG4b?VU3Aw_j{A&abG(EU_#30F3(eS#iNygx?JBl zM}JQB=*xr3VMR{sJ6+Kix4(%D%%tY-$mNvlY$bZYzgN595Y)-5V=Hwj5axkdC$H0=Eo8}f6A2J`tKPoV2pkd7L3HDpf1N7j zJiHBZWIhuHk&6Pc)0!a+Ce%#Osek5+(QW2X(hW&NBWQemVS78Ve!VG6`1{oQw4P-i zW+@vpiemv zln9@2au<)@K-!-(UMOIzLAr60Hx$UdN6e*`rX3EiA5>0c8}OOp*)s2hqCxQ@J`?g9 z;(@Nr1P4Zwc8{W_6!M zPTzJ5#WA9j7+WcSfm+2HjkT{@o#{E=#jj1vHZN^E^>SB;Pur8DG2JLr#I|<3lq|`e z9PdoPaz{2}l)9yK_VL6Y84X${41(m)ryHr}1&1;kkW?a%Rv6{L;j<}td9dI}kqxeL za@g9>D2yYcw4_PtvWdLIw9$h{DLzg3`Y*Y&@)fu89e(_ONjRMh{9hZsd1{i?@4Z-w z_3T^mS6s@@p|{;`EIF?@YK$$-N)CBlwky&|J*AIzI6my5c9Tm~=YmkqHS>#zF7%7B zw?a=BGfun4)5n%!ct^-UtQtLq_DRs(#2hH&?? z4t;iq)en~Ey^m#aay#*N<-QI_zSZ`XIINsTCr+uDfx8h=WXBA)o|Mzp2H#VS{Wb8V zE4{lpl@0+iVtKBnB1;s9HzO<|ed8B51g_eSUFh$BxV`9soaP}@CJ>%l^w+x?s(sz6 z<#LAWOSJiklJa2fhzZ+{48Jb~UQLXQHzOqSnz4r|?#3`qR%@B4nR7P9W{`rO_9(eq z(VIDsbF?p%_+%P*v{}OCxy#{P7@~l6yhwbIUat8wqu+hp-K!J?91qKipouC*i`@7Z zfZg7Id$;itPjf#J zP!uXXdO^lAv2^r?z=}LAjw3O%Q^R|+yyb9?!x~ohF2WIDx|sCmlY(cy6U|xAH$7>J z`qJ--_*Qz>{l96o>V=^!E9US^fMB_*BXZ4u=4v>xY1mlPTUP!|?64+p%mm6$H%1H@JI&8P->c4=g$R5RlK3v7mWk3Soj%`0_9S}Z{J6LEGCIz)@tgl1hX)zb=-aM; z88|x6o594$$iSXXpL?6%9j32Kx$x%P+WDMt56<+tZ%q%vZhm_^oz!L<9xp{~aC(ic zQHEJZle;|Fz^Z7BInrRqsrixhJ6oS1>wCe-?YJMvkTYkS7u@*grQoQ4AZ>T1_iIir*Qn`nJjFPM8^=w~r@h?jZ2i!j8FH#{!jRtwK+cE z_3Jg4AV7@^<)mbADDj2|1DxWc7m$Gg;yvTRRuEL6yJ-t0G)PlTM5Wxq5QHdy^yr*? zr^BCFnNC9U(vD8w$-T+t&U9PBQq-SOVJl;Sz}$|(A>~yCg*Gb1FGyIB9#)T;QQ~8@ zu#=OTSau{bj)HW!lUuRu9*0}#eU4A1jh^a5$Mw>j0v_1v)rfH%-%;oe0UuKzNK2-9 zm;33E#lpr-+c`Tit?sSQ4Xmesd2%^AJD}v>SXk6JklYZkT){Y$k&F5tl6lOIgCTr7GX|s|M2&9r^861)(`d=8K<|Zx7U)K6vPKCEQ z7sZA4H}L9laWHncJHgq5gH8@;`Oi=2!@;<9&<-zy#lSkBQ<}MAF$m9pGtk)dH>V~o zpFzUS57CNwqv;0ZNU|z=xsa+HUPz}mq2tl=?+di{6a_W)OEZ=j=-Yd|F8LfO=`LBZk{+MvtAavF5)3D{ zjSEl|Vp9Ucda-ig*nt9n5a}pw8yDP4v2u!pVPGZ`&iFg@KHD}u#^TK_9X2LYtiBFk-=rU}<-1Iq9nVFdR z|Cjks`u)FeM<;u+*gd1%0GI~`=QrLFwomgEQT)gM59cmu;1MAMsFtw^SR62-e}DI% ziTX!CfJpH9+I@?|l6NPN+1EOD1O7;*$I^T~Y2_=|<$7qx*77+q&^0^TKhz%WZ^Kh; zUw#brX1d*v2NxuND|?B3Ddyxf|Ls5&_kseU6+{%zhT4I#6BjNt1)eU%HM>j<7^FQG zERq&Lg`m;c^@hE#MYVKVI`H3{^6R!oD}FaubPm=bp|zmho-ZaahF)g|79k*C?M$4t zAaZ(GRuR`!i8Jrtw#QpcF(CF!85TJt`gE(iORVGn4VAceqX79>$(;qq4*^L}KPW<24NXyW@c6SzO%KX zZARVNuA0q%)w{jDky@b&iH&{arx4S)<0)HTM7GK>Bv3;E)NKN8MTDr`TXCk^!8qH; z0;M*X(_w`&MwEzGa@B&{HITQN$=^-60e)k+p71l_iPP2EYmwxTBX=QnxVJ9gY%X3XV=TP=iH ziEA}NnY*?chVEso(V4q8keZur+iKaG%q-TMwz4ZXcMD+-+GCxqnC;Njr)w_mIkvRs z%;}olCcAqZ+sk)iBVF09?vIlPWGa7J#7*69=`C*Qwzb{Ut82FBaw_LnOMAO+t@F(z zwWezd+B3Y(&Tjb43um2LGV=3tduzLOX(Y{-PTrSqChd5N5QvV3#E9CCnkkJm(@l-E z#L&QC*b3>2Kx3$!LvA)k*oqr)AlpFc11wOsn43(dCYaTbkq~M)M**nRDnTCt8j-S? zq^P5WQH>_XL`X)+0#UUJ2%8|z?3V8>ZtauQWH)~^ZJS!g?W1kn*6fJYgrC>W!caF*d%S_B3P=F zF4I`Xbc?r5^6m63xpG)G#x&b3yUe?}5*RcFI%FNR#_6av1laOgyMh~nZG)!_m6>?j z6`>*t*&}T17^&p-xK{tS^Fy z0o3ig3A@Xr=M1xhQ!|bN-z!% z)&t<~Uk9Y!nULyh1~3CRaa}|GA5r%o(pxOyH85$Yre%u+D1-*bdEEZ)!KbEz+hd+>USo80NsE_C~!!psqMB`F>KSrZRZ!lytxfLq8qHo`t2d9+R|zv zH54ArKcBztKm2!=(?2%Sm!8vF=uViXeM$RsLqg|Iz^8-FR>(DCBY^)AknH{*)Y}nm zG!*LSY}nU+3HvnD zZA_W=(-KW8c5T;fB$u!2J!~7OO3|QXfHErQI63Y|Gn5C;NxpfdB@ock zFojq#D}$}=8#AqcyUoom>r|)U-IoIgt!U1jJ}d)PryxNC7s1WvmX6A9@VVUF{OS4u z)aLNe4+wy4e#~9YEj^E+ySktm5Ftk2L+8-Qzc*>goo*FXx!%O;VUv@Uko~im@D40` zJ@@qZrUFiaZC!5e#`v)9Y0dTV10oTDYqaYD6g*6Fc{m+^AsuXUG>=1Pt?fHb*OHHe zXQ|lhb&UXu9SWeY4S#3E{YUC8e8+EXYl^}idZm~cC}HxsfPJ4ou=kdZry+u8PkLw% z^6}}tBB|IN;y`kCq#PSYM67x19iyqG+2G*$0^NlPI>>gAwS!pL28by6?)J8(Fx9>L ziG~dgI^4N`K9`d?>T+I(N1MIm;eaA3=_d;^F_#okRN8erTbu_Fv*Bwne`YDvLA*qe z3z(HeAymcMOF}|1mSda!ov*Q;@4xbSadLRQcXTba=zZ{abUp_Mx)Lh7 zb^(KDye{rw_qxy?PX{vy*x+k*J+^KAZRO2Zcv|y+W94ts&Mq2^NK%xUIrby+ZWQWQ9<9pr{i4*~dja4~$2$4BDsI-Ntc!H&nd#mpSY#KCfV zUZLrKZ>iUJs25LKe@f%upNfG3Lu%k zP6iV7P6%thrwTn!d&`5P!4VYH#(?JZ`oZjCyBgf)^E7vlW9q;*0X~1E{U_)xfrNSj ziji0}P*XjXXWKiFz%D?KSbDmiq_gbke|q8a>-asse&<(eNAl}K674pG!PR!x0-R!h z91fGbY3X`=&F=aiGASK6HWWcKa8r5B#o9hy&z$Jdrr!-<`e6waiArIT1Q?V_Qb~k? z6h>f%KorI-VVI=ElwvSKF_Z`jfd~*}NJ2ycMNo_oWV0};sIrSJlPrq}iY&}3!y*i* z$jGS6DT*^NGYKfLCCWDcyHN25}rfb_Tx^)IV_aEyrvuTb!E9N!Ho zHn9pJ_H@{=I3By)xpKn?8-xjU@=FHmmV_|6OH~v$n~sNW^QH7SI1M+AFLN7zzDJv8 z<7cw$gWl1bF65EBtWDcO>?zdVpEJn<`k2#TJj08Np9iM*PL?#L4c&Ufb`GaN#nZ?~ zRoIxjT}(g?9yBLwhf^c4b!Zwpuy;8(V}t^hgBx?ZMabN#YgjBmqR@AhMK|6<3&yaq zKh00qd<+|~`+8m-?$P8^%z1!+CqM|HcJ7bw4UBcUq2IaOmtfIV8;+$=S6zrd;?`p> zP(lVp59|TC^)vwWbbg-F;mNZ5& z)*tIK47u5zVipLcCV^FptQyxPX3@N@kH(bWCKMFsRIoDz!cE zsNzCSRu9280cGR|NVUkn40Ycj{9i9&gg4%> zG=ajpzIb`0Q#O=7IUemPX5#&TIE5N@oKk02;;%G>2v8)g69f<75ju;5VY6k$)Yi5M z4c&>b;Z1m|ZMTMhLDMIsGbpem2tq;~plJRxnM^(QwSx!NR3~2*^3Skc=rbwyGOH~B zWC3j|evhm^L;JP%Aluu?yn*KD?b1B>DLv4_i#@%cIw)G%sbk)7H+#xXc90+#Hf{JFd#8uM5v=2rbaW;)vK?6em7dVOQB=J`$w#GWXD$B zdeOyaftA-$f=c*X8)u6Q?S$rNb2|#Qo5*1cVJun7jVzt8sDBW~vuP@53TMi8Zrk)2 zRO?>XULK=|+E=c1n0zqNuht*REetq7sX9Uwo}17t*nNgLrbPI#ced2^oQEa5Z)3!( z*Gbmok-0a2n>h75JbZBIQz}m4!I^t(?j1bPd^>gERL23#)#)u68p3blRR0MQCP|us zMOIAid&B609_D9!m}LGVM@{yH7`Qk&Jv)oHE=yO|ZNw+z#rPagZXeEQ@GR{^;1Lgf z6$uITo4+^T+3bKo^Kht4pMG9DNvDSN(sFEwflXz9mHM5#(rFche3`YKk* zIe4hwGtlo#wwku+;Gby%4QFz*$Ec!%m3;)ytk=Is(7I;Bv5g8UilX9g;M-=T?-}4n zW~-gAu{^9pC_7{AKSuMv-+NZu^>E&0yTC;215!OGgqTWz)(I&zSU zJ>If^9LArzfzVRH&0F$hGlhl4gQR+pdz}YZO(ycjeplr|eH<9{G)-ttNLh@t<-^Qe z>c=mv{xuav6xF#+dUWnCQFwwOVOD;jdee3`^)ZMjq8gI{@+6|RkAImjNyc+l`@N)b zHamKGrtdn3BDawP*%n1nRTgQdNPNpn+&fl(f>*?~?4pt$_`+nOJw=foQrvEa&B<#x zpYtRLD5j#-r7KJR@e|7K8W(NZ?R&ko>et~}`8VI7q9BNff{2KSh=MSPp3BVmUhI3( zM$6>JMf&Z_yVI2lP*v!B^7h2N7%^y(^j3-;Vy}-OI*jy@*_CAL?@c^OSIpMD?aZuy zUs`Q1hv`pZ+#gqAZt4gf-X72@vios8nNs4Z0a{5#QFUmmDNO1RAFN}VvZf>PK=1(n zNiYiTUt%9n8GV9@5H)U})7Jf;tKP*pi^%ZY7J`ez$u%1K9wsLZ)MC4%C=s4#js%|9 z125CNzXBK7@}4ALs;g0fMO6jP1e#EP(E}fboeowoVEx(Wfx>1X>*COKz}x0CyLT>& z?RC*mk2mtUK0{>keBPL&Ts!i1I$~%^8jB(nG1P9RiiCv0#qyNHZ@}mH3v)b&)ARPF zJ|~ZqeuKjlvHMBLI}WGFi9rWhU7w$y1E1bKn`>i#1CXnNMQ%8g6?mhI0xm^=Wa5+8 zci?&f6pDHsRBEQ3B0iTQwx$ikq1*>dS}36EMx-2Q5kKE_QOv)@7n8T#)ekP#G;iYZiN z9*!_|X?aJA`}3Vk*BOz;wI_zO?2jVf&-g2<=b%DLU@TGs4_?FdY`ITI^_$0-NfbS4~ap! z>Nm2X<^(d`PoD0G-IpgNPStU0?P)KOi zsew>C?qknAPF@o@j)+QsY!;?etdiOUlE5Ld0BjttM)EuMsc%pXU1_ht>cWbIgoK2I zlzUA^B37-2&rh!x@mT2n#vx(x%${>jF`arlla5a!R3-=o8weyB*cQYIn)1>IdZHkC z$t0Rc!m^S-d9%lUC<=-S3X6tf%6LI5X>w1e0uooCoo!EpIvGQM1L$$HldB@+h1r!k zL7iH4(iibO(3kCa*8vZB`00CepOE7T70%m&&!`M=^d@PozK1LyeIRE*sTCCzN}=34 z+-`~mMNsBvW7>*r#B5ZvCZna~GV?j}IsVz#tq|}{f+y&Q zbyKuR?oVQZ{237$O~Y1@pl$iBgLMyhQ4sUaWf($)zGo zr`(?O(xT}RQpY}uPY{YML(<;-Qb)BkR#Vgj&6)szz(ljK>D842>XT1XkrI3?*R7Z` zp1~YNm>AL|ln-jyB0PZ;ufZ)*V)_i}YEj$vCMOYfR3*0yu{P3H9#L{#@0?@uB;#8nkVQB+kIRR>*#o+h*FPK9P)W1S*`BXDW~ z{T|MLXD^53Ci~op`M5ai0|_i;2@4<|((UTL1BG~wf$?0)80riZ{gAO7hX6iG;lbvQ!mCBepkjS%3 zrX^W|Ru*!IP9C8oApnF06hRew+I?sif!zzC){11`^6gGac(G~*5HodILN_BsuTvm@ zfwa=1&sLP^Y_2XxilQddYKvZU z&rL;zn)?&729)NJP8R_)i=WXdE=ovfWpSWG#N6yP(a7#FFlrE&y{{ek1y4MIzP>CE z7-UghB^ApnG7Au<4n zh=_=Z@Gno}Ui%li3)g5BQ$Pz-0eBeDQOL&nKX!~whIVPpaYKhfcXv!*1Hu!3!4WQD zm>MDRGyL2BZqMyeqqoVt#u5{ar!tGTgqqab0uUhr9FXP(yCwP%_vsU>Ptb?2vHIHx zM&9oS!PFN6N5s Date: Wed, 29 May 2024 14:03:56 -0400 Subject: [PATCH 398/503] ensembl ids hemo liger and fix manual entries --- R/LIGER_Utilities.R | 8 ++++++++ R/Seurat_Iterative_Plotting.R | 4 ++-- R/Statistics.R | 1 - man/Add_Hemo.Rd | 7 ++++--- man/Iterate_FeaturePlot_scCustom.Rd | 2 +- man/Iterate_VlnPlot_scCustom.Rd | 2 +- man/Percent_Expressing.Rd | 1 - 7 files changed, 16 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 3db730e2d3..304fc49aa4 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1339,6 +1339,8 @@ Add_Cell_Complexity.liger <- function( #' @param hemo_pattern A regex pattern to match features against for hemoglobin genes (will set automatically if #' species is mouse or human; marmoset features list saved separately). #' @param hemo_features A list of hemoglobin gene names to be used instead of using regex pattern. +#' @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 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 `hemo_name` is #' present in meta.data slot. @@ -1369,6 +1371,7 @@ Add_Hemo.liger <- function( hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, + ensembl_ids = FALSE, overwrite = FALSE, list_species_names = FALSE, ... @@ -1471,6 +1474,11 @@ Add_Hemo.liger <- function( # get all features all_features <- Features(x = object, by_dataset = FALSE) + # Retrieve ensembl ids if TRUE + if (isTRUE(x = ensembl_ids)) { + hemo_features <- Retrieve_Ensembl_Hemo(species = species) + } + # get features from patterns hemo_features <- hemo_features %||% grep(pattern = hemo_pattern, x = all_features, value = TRUE) diff --git a/R/Seurat_Iterative_Plotting.R b/R/Seurat_Iterative_Plotting.R index 47170ff23d..2b259d5c6d 100644 --- a/R/Seurat_Iterative_Plotting.R +++ b/R/Seurat_Iterative_Plotting.R @@ -869,7 +869,7 @@ Iterate_Meta_Highlight_Plot <- function( #' #' @examples #' \dontrun{ -#' Iterate_FeaturePlot_scCustom(seurat_object = object, gene_list = DEG_list, +#' Iterate_FeaturePlot_scCustom(seurat_object = object, features = DEG_list, #' colors_use = viridis_plasma_dark_high, na_color = "lightgray", file_path = "plots/", #' file_name = "tsne", file_type = ".jpg", dpi = 600) #' } @@ -1210,7 +1210,7 @@ Iterate_FeaturePlot_scCustom <- function( #' #' @examples #' \dontrun{ -#' Iterate_VlnPlot_scCustom(seurat_object = object, gene_list = DEG_list, colors = color_list, +#' Iterate_VlnPlot_scCustom(seurat_object = object, features = DEG_list, colors = color_list, #' file_path = "plots/", file_name = "_vln", file_type = ".jpg", dpi = 600) #' } #' diff --git a/R/Statistics.R b/R/Statistics.R index f6cb9287d1..cbcb82aca9 100644 --- a/R/Statistics.R +++ b/R/Statistics.R @@ -122,7 +122,6 @@ Percent_Expressing <- function( group_by = NULL, split_by = NULL, entire_object = FALSE, - slot = deprecated(), layer = "data", assay = NULL ) { diff --git a/man/Add_Hemo.Rd b/man/Add_Hemo.Rd index b45b939bd8..44f9b65a38 100644 --- a/man/Add_Hemo.Rd +++ b/man/Add_Hemo.Rd @@ -15,6 +15,7 @@ Add_Hemo(object, ...) hemo_name = "percent_hemo", hemo_pattern = NULL, hemo_features = NULL, + ensembl_ids = FALSE, overwrite = FALSE, list_species_names = FALSE, ... @@ -50,6 +51,9 @@ species is mouse or human; marmoset features list saved separately).} \item{hemo_features}{A list of hemoglobin gene names to be used instead of using regex pattern.} +\item{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).} + \item{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 \code{hemo_name} is present in meta.data slot.} @@ -58,9 +62,6 @@ present in meta.data slot.} contain internal regex/feature lists (human, mouse, marmoset, zebrafish, rat, drosophila, and rhesus macaque). Default is FALSE.} -\item{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).} - \item{assay}{Assay to use (default is the current object default assay).} } \value{ diff --git a/man/Iterate_FeaturePlot_scCustom.Rd b/man/Iterate_FeaturePlot_scCustom.Rd index 95204b28d3..5ddb06d023 100644 --- a/man/Iterate_FeaturePlot_scCustom.Rd +++ b/man/Iterate_FeaturePlot_scCustom.Rd @@ -88,7 +88,7 @@ Create and Save plots for Gene list with Single Command } \examples{ \dontrun{ -Iterate_FeaturePlot_scCustom(seurat_object = object, gene_list = DEG_list, +Iterate_FeaturePlot_scCustom(seurat_object = object, features = DEG_list, colors_use = viridis_plasma_dark_high, na_color = "lightgray", file_path = "plots/", file_name = "tsne", file_type = ".jpg", dpi = 600) } diff --git a/man/Iterate_VlnPlot_scCustom.Rd b/man/Iterate_VlnPlot_scCustom.Rd index 0308ffc31c..32e4dfad76 100644 --- a/man/Iterate_VlnPlot_scCustom.Rd +++ b/man/Iterate_VlnPlot_scCustom.Rd @@ -68,7 +68,7 @@ Create and Save plots for Gene list with Single Command } \examples{ \dontrun{ -Iterate_VlnPlot_scCustom(seurat_object = object, gene_list = DEG_list, colors = color_list, +Iterate_VlnPlot_scCustom(seurat_object = object, features = DEG_list, colors = color_list, file_path = "plots/", file_name = "_vln", file_type = ".jpg", dpi = 600) } diff --git a/man/Percent_Expressing.Rd b/man/Percent_Expressing.Rd index 6d56e62a9c..e1272ad9b2 100644 --- a/man/Percent_Expressing.Rd +++ b/man/Percent_Expressing.Rd @@ -11,7 +11,6 @@ Percent_Expressing( group_by = NULL, split_by = NULL, entire_object = FALSE, - slot = deprecated(), layer = "data", assay = NULL ) From b24223337b5515cb0b03e31e3822a43d023442e9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 15:15:18 -0400 Subject: [PATCH 399/503] fix build errors --- R/Seurat_Iterative_Plotting.R | 1 - R/Seurat_Plotting.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/Seurat_Iterative_Plotting.R b/R/Seurat_Iterative_Plotting.R index 2b259d5c6d..0f20ee6b63 100644 --- a/R/Seurat_Iterative_Plotting.R +++ b/R/Seurat_Iterative_Plotting.R @@ -1218,7 +1218,6 @@ Iterate_FeaturePlot_scCustom <- function( Iterate_VlnPlot_scCustom <- function( seurat_object, features, - gene_list = deprecated(), colors_use = NULL, pt.size = NULL, group.by = NULL, diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 7ce728f48f..7d721fc6a1 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -78,7 +78,6 @@ FeaturePlot_scCustom <- function( aspect_ratio = NULL, figure_plot = FALSE, num_columns = NULL, - slot = deprecated(), layer = "data", alpha_exp = NULL, alpha_na_exp = NULL, From 23b3a339bdead56b7d47b93779e732b4b12605d9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 15:15:32 -0400 Subject: [PATCH 400/503] Update docs --- man/FeaturePlot_scCustom.Rd | 1 - man/Iterate_VlnPlot_scCustom.Rd | 1 - 2 files changed, 2 deletions(-) diff --git a/man/FeaturePlot_scCustom.Rd b/man/FeaturePlot_scCustom.Rd index 252a4efd6d..27f6e4d7f0 100644 --- a/man/FeaturePlot_scCustom.Rd +++ b/man/FeaturePlot_scCustom.Rd @@ -20,7 +20,6 @@ FeaturePlot_scCustom( aspect_ratio = NULL, figure_plot = FALSE, num_columns = NULL, - slot = deprecated(), layer = "data", alpha_exp = NULL, alpha_na_exp = NULL, diff --git a/man/Iterate_VlnPlot_scCustom.Rd b/man/Iterate_VlnPlot_scCustom.Rd index 32e4dfad76..0a719057e1 100644 --- a/man/Iterate_VlnPlot_scCustom.Rd +++ b/man/Iterate_VlnPlot_scCustom.Rd @@ -7,7 +7,6 @@ Iterate_VlnPlot_scCustom( seurat_object, features, - gene_list = deprecated(), colors_use = NULL, pt.size = NULL, group.by = NULL, From 9c861ec478c00fb8a0cf0a3f96766dafa575a0b6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 15:56:02 -0400 Subject: [PATCH 401/503] add ensembl ids msigdb liger --- R/LIGER_Internal_Utilities.R | 9 ++++++++- R/LIGER_Utilities.R | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index 911c90f92e..e1742bdbbd 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -2129,6 +2129,8 @@ LIGER2_DimPlot <- function( #' 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 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 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. @@ -2148,6 +2150,7 @@ Add_MSigDB_LIGER <- function( oxphos_name = "percent_oxphos", apop_name = "percent_apop", dna_repair_name = "percent_dna_repair", + ensembl_ids = FALSE, overwrite = FALSE ) { # Accepted species names @@ -2189,7 +2192,11 @@ Add_MSigDB_LIGER <- function( } # Retrieve gene lists - msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + if (isFALSE(x = ensembl_ids)) { + msigdb_gene_list <- Retrieve_MSigDB_Lists(species = species) + } else { + msigdb_gene_list <- Retrieve_MSigDB_Ensembl_Lists(species = species) + } # Check features are present in object all_features <- Features(x = liger_object, by_dataset = FALSE) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 304fc49aa4..335facff8b 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1015,7 +1015,7 @@ Add_Cell_QC_Metrics.liger <- function( # Add hemo if (isTRUE(x = add_hemo)) { cli_inform(message = c("*" = "Adding {.field Hemoglobin Percentages} to meta.data.")) - liger_object <- Add_Hemo(object = liger_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, overwrite = overwrite) + liger_object <- Add_Hemo(object = liger_object, species = species, hemo_name = hemo_name, hemo_pattern = hemo_pattern, hemo_features = hemo_features, overwrite = overwrite, ensembl_ids = ensembl_ids) } # return object From ac0fb92972a344ba649e0946656e66861400dadf Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 16:24:44 -0400 Subject: [PATCH 402/503] add IEG ensembl IDs and source code --- ...reate_Ensembl_IEG_Gene_Lists_scCustomize.R | 71 ++++++++++++++++++ data/ensembl_ieg_list.rda | Bin 0 -> 1407 bytes 2 files changed, 71 insertions(+) create mode 100644 data-raw/Create_Ensembl_IEG_Gene_Lists_scCustomize.R create mode 100644 data/ensembl_ieg_list.rda diff --git a/data-raw/Create_Ensembl_IEG_Gene_Lists_scCustomize.R b/data-raw/Create_Ensembl_IEG_Gene_Lists_scCustomize.R new file mode 100644 index 0000000000..e0787e84f7 --- /dev/null +++ b/data-raw/Create_Ensembl_IEG_Gene_Lists_scCustomize.R @@ -0,0 +1,71 @@ +# Scripts to create ensembl_id gene lists for IEGs + +# 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. See data-raw directory for scripts used to create gene list. + +library(dplyr) +library(AnnotationHub) + + +Create_Ensembl_IEG_List <- function( +) { + + refreshHub(hubClass="AnnotationHub") + + species_list <- c("Mus musculus", "Homo sapiens") + ieg_symbol_list <- scCustomize:::ieg_gene_list + + ah <- AnnotationHub() + + ieg_list <- lapply(1:length(x = species_list), function(x){ + + cli::cli_inform("Retrieving ensembl ID for {species_list[x]}") + # Access the Ensembl database for organism + ahDb <- query(ah, + pattern = c(species_list[x], "EnsDb"), + ignore.case = TRUE) + + # Check versions of databases available + ahDb %>% + mcols() + + + # Acquire the latest annotation files + id <- ahDb %>% + mcols() %>% + rownames() %>% + tail(n = 1) + + # Download the appropriate Ensembldb database + edb <- ah[[id]] + + + # Extract gene-level information from database + annotations <- genes(edb, + return.type = "data.frame") + + + # Select annotations of interest + annotations <- annotations %>% + dplyr::select(gene_id, gene_name, gene_biotype, seq_name, description, entrezid) + + ieg_ids <- annotations %>% + dplyr::filter(gene_name %in% ieg_symbol_list[[x]], gene_biotype != "LRG_gene") %>% + dplyr::pull(gene_id) + + + cli::cli_alert("Complete") + return(ieg_ids) + + }) + + names(ieg_list) <- paste0(gsub(pattern = " ", replacement = "_", x = species_list), "_IEG_ensembl") + + return(ieg_list) +} + +ensembl_ieg_list <- Create_Ensembl_IEG_List() + +save(ensembl_ieg_list, file = "data/ensembl_ieg_list.rda") + diff --git a/data/ensembl_ieg_list.rda b/data/ensembl_ieg_list.rda new file mode 100644 index 0000000000000000000000000000000000000000..cbf97d26f6e725e28827a9bfc82066722c7116c7 GIT binary patch literal 1407 zcmV-_1%Ub=iwFP!0000019e%=ZeB$Uy@X^zH&n3UC6LBHV|(_L!lEoFmAZ=xicqAa zMGAQe-hoF&oZE(cU-*tArAh6%b3OL)@tH3_fA`j&y?wTA+vnT)IsU!CuiM3&U%vmg zw(a~3|M_e?-@d@l=U4CVu5N$5xxBvm{qpAe?$2#I`x^Fr&2xPJ^|0=%7eBpz_2%`< z@$qZUil82esf&7C&ACT+ANPdC=sdHi$J8r%)RBWfqY=tIvTE`OWUXvHi$`E9I!{(K z5lj>9-qU4gS~VFRVop6M!fI+-wRq*EmhfkM)#6d>sKsM5L_Ist1_~bbl8PY|aLmE$MQ*Ej2 zcB|E7)Y2MU1HRm2;avnsc9R1YTFnS z@1HKVHTii)lr(JVvYPt%Xpjg`)2Hg*WE5dL_sERVbz^k>GpoUM7znP3O|5xPd7B-t zCf7cdpU3AK4I}w#*dNar_oP?T_2zi0@nnN|jmp;3be5Ml+>2T_Os;9o1caxVKf8xN zGo$TO8;w5DT%3`>{oXM}MN=P4;AYO@J<;T#r0HNswwul>ZFC5BYZw;KbbVUZ^xUY~ z;J~W}$H4?d_F<(O}<+|@if{cU3lIm)FAhybh$P_ zu9?mz&D_Q_4a3^bm(;UHH2t%4FV6wgQ-=f3hWRX(HOx1>shsZw)A03d)RW0*^yr?p zW;R0Lb59DiP;>tgZ+Hg-sKFartGSnq*~~1Us+)5v9lK0zlmql*vs*4}5D(t#@TODd z_UV@R_rr=WvEqR;bIPNLJ2q!La>bF^wNg&a0n(eNW^As+jMa~Kj)Pfat~@o1n>}*V z6LT1iBp*BfU><2XPmhDXl0o*CNGE$^kXMno?I7olR$GLTy%8We<=C&h6SR=-#==aXyY8a`<`Rq9b$dijEu})0(WdtZ|A#+$?L5O(KviviBOa8=wvdzDLF4 zX4c#(bDX|X^XMaxV{-1YDv>@60s9nmJtwkTIiJORYS7UUYm) zP%HuRtifOp^bD5RIZ1$!KFUT0tSs(SB^kt&Qr0`J!q^9*iq_IW)npS7*7Mk!QE%9C zW`@3E1Kn$|;k5=MQ_O#1(!!E;1M~)CpWV#LAcs#!o^X}3>FSgA{8Xpi;LfU}(^#r> zFdz$BEg9I%Xa@Hr5;JZAOtay}$zY#G^O4x?Bv*7e7e?TmEVy} zh#ET^Nvwsk>8jANY&Kx-kWRw|hl!jK!2(RG9-%*tC_J<_#uS6kV%5PtYq6ngM)@Qb zYu8m&6782oCZMDk6##);Jx;=d`=>ty5L$J(q#sXLh=S7qVV*&hX*v@NSS`(JC9l+4 zgf#&vA%}+;c2Wk_RMtEDF;8o$HiQgatTq}T?tSDgHNsikFcW%IL+g;Z_fI$e|98lX z_wR16?zT_Y$+HLJH?QvRE^qJee!IWHFF(F`dHL|y%K!X7e7OB^dH3#*YuKOox9y+( N`(NsH+m;C(001~E&wKy? literal 0 HcmV?d00001 From c30d5cd5c3ecaa63d3ad5536a3ee25978669732a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 16:24:56 -0400 Subject: [PATCH 403/503] Update package data --- R/Data.R | 19 +++++++++++++++++++ R/sysdata.rda | Bin 31025 -> 31900 bytes 2 files changed, 19 insertions(+) diff --git a/R/Data.R b/R/Data.R index 37c443ca4f..306fe50300 100644 --- a/R/Data.R +++ b/R/Data.R @@ -150,3 +150,22 @@ #' homologs according to HGNC. See data-raw directory for scripts used to create gene list. #' "ieg_gene_list" + + +#' Immediate Early Gene (IEG) gene lists +#' +#' Ensembl IDs for immediate early genes +#' +#' @format A list of seven vectors +#' \describe{ +#' \item{Mus_musculus_IEGs}{Ensembl IDs for IEGs from source publication (see below)} +#' \item{Homo_sapiens_IEGs}{Ensembl IDs 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. See data-raw directory for scripts used to create gene list. +#' +"ensembl_ieg_list" diff --git a/R/sysdata.rda b/R/sysdata.rda index 82a690c05213d957112076ed420d3334ec340740..eac9861fcb93460f13ad7c54d2ea436c615f707c 100644 GIT binary patch delta 31834 zcmV()K;OTy@&TOr0e?bTXgM)KSte6iMwi=$wkaEQ6$J!P5E}q4gh>@i z00&wMU<3dF!b&Jm0HKg-fkg00000003#|kP1pqRRC#;+DlT9>CO&L!_Xlk3%c_hfu`V=xf zA>lw8dVhcbXlbS;0oZjLw*b^oK+Y;Etq>4Vy%eGWMHC7@gYf<@x%aRl0A&!7QBX(h zJ-#jOfAlmVndi!1Dy5;tAItLj$~64m=SK!{|KR>&G&KzfP4O9BE5C8Bv-QjL-#7PF zDNY$H%o*7N1cbGY9IGM$1`-ev{y+1C^M6mo27e-Y_#dr>fLg@Bga+lD$%_VP5i{FE zBV`NnRTKaq74ZcCSJeKaF~m;^`p*jS{O(;%$MpPViy6XGS^I?%{qeuVOlyzjBzBt# z77+dg`WJeE`p!nL0_9ThU%*HFmk~dspv4}lCgb<9qY|dwD=rg9{6FWVYa?Hh_Baiov$KG>}O>i zje`C73{sxUs80tCVE*bz51Rjtj|Z#O3F-cf<-vccJos%UNPx#9aq`*mBAIEOmo#s< zih5<{oS<(UG3j&iVJO9faS@EejVFS&XqH=YM9|-UPN*HhZpM`DMG#@m0hDro*Yg~Kg%0L zB}+riVp?KSckn3+N*d)dmE4|s^?#3BY*iF$U+z{b2&k&D4}{$jq(Y?eK~_{tEKJAr zkST)2NLfRUOiZk{fX@_D9)t6=?sRdEu8#MmIu0^u;A;w>0*f0BaZgobqBnEO2hpR} z7^)MM$>$Na_DxMISUTvP6qt-B0{Uw>Me79)RF{3vDT=i{RzgF|8lN9?_kUF(o_McA zR2F{6DF?}!sM(R+Am)6W=W~XrLNdpxutOU?w#nRH=9U>ivV5^qY)09h`e8%d`{p`b z-LRWrX;&BBhFYg)L5`Al3m=a?l8cP4wsczwGfvJ8)zyLWn>n_<^Z)1e|7ZUoqNI14 z-up`#oSrWQ9*=fNNB$q%{eReq8VYu_3kZ)7!)F(qwLIFQCdXIY9RBR5$!_n3%V3lGe4D8j=Kw%)>11ds5KA-ha##i!kBSW?6|J zJVfSL#Q^+6$CQ+mn9NEN!v|H3I4C}KE)dEvMDrp&UOCHZa&pp{WlUl?xbh@ALm4JO zDOpEE`!ef#gHr7&bJws_*aqeXU8vSeWAeEuJrJ638eR8fCW z%HjSRQh$&7%RkgQ8X0lBX@I5c3H85;89}*5cT~YI_}4&IxyQdyB@RA=r_7<>5AG0n}x zlarHGik@^;z}&Jtq+-%V1-090K|w)7=qM&kfiZ?AP4bZ;>f%nPKDbpj8|y zIq8#@rGMyV8cSmPe#WasjK(&+V;^acy}Hb!hmJTNrt(MRIi2N2#)Yk5Rt_9(H<-t{ zV@_Ds@tm1dbx4sD3MRP?eyvKnD@)=fp&3dwg>)#sAv;iso*`n8WugVw5hU@79H4JB z9*?HUz4)D{OeWU$QcmV`a(sum#Z36Sx#wdNEq~89%w}_k=*;bJjjb;l{ZT3igUS5= zX8p>l{I_J?*T=OoME(Q!KXdgtFY@0UJ9f&l!Orr>f-rnp@5<J+Y3iE^Q7Q84mA#Q-E%B z`0#x!Y~JeH8F0INT+JKX6bG?3*u+Q}TwM+`YQxqt3B^=r+Ms+nyLvkmXZqB)wKy?rw}8S{D0 zlQC{AuE+4ExM10Z4xMfP?X-EFK`o=twX?51dyLoi*T-d4;lIcegii^C^ z@+PIK+?rw1z|6hOPa566xHrw-?Ct-)+Tk7VJNBl`-*PbB-Z^i#C3kN*gLLbmy&q}b zM>{`=&h^?8P0=B5u#Y`ks?3e(&8r&_ADUjP6HdZw>n` z>Prl)Yx|pii4~1EJ3Tg8_PC3u`-}VB&7=3HS0(5m_ugqz!de?tJEntbYW8mqCm2%+ zNhShDCx0eGY&0@hwK{R+OT5$$NkeBvMbMO@R;R5+ZoJx57-TV>Yip6Z40aMS*3Bu= zRTXOOyR;R$k1h9!?{(Ix8)8j)&F^Ce_}8wl+xKuD5gdtDE#`-~U|n9C-2qW9tyH~Q zccEF^op`Q|@G!GX>f3!u_6t-)sVL<=MqphtGJmFF8wzu!lgiA?$)RQ5Bpb}$+I=Rq zXR}XKS;J8bD;#=4=DU?|q?|gtUt>`)qKjzXZ*IIdu8oz#y zU4L#<>pRqT6GHi36KPjjuEVrN9jpg8jn)YNz9;ag=^dVPc)A@~o*YkEktPGBaI?w* z-8YQN%H$Ct+suEo*Oj=pz~$*^XJ3w?b43|)KZK{=-A(Z=YD(%G&Tbre33t3DZ*Nh(RJHvN#41c>@ z&u!u9(r~M;t z!CatVNNsM8y9a2V@MxA=%a)2tK;7Nd-*tr1fKGg}ado`~8-TrUxy5Z}$95aCc0HGO zGRI`7luqW>@9@;+7m#>FKy+6(1G{sV7}arY^fkugQWPjnwx+|fQ8KV^ZhxcKiaW_R z!FuqqWMb)4EgL|=eDk|gdE;W}H^7oN2z2_TTypaBZ+0emqf8}SAl9s7W|p1mCYc1MlEw+MzHOizLT((S+%T+DZcK-Zm+JvpdA5>L~o7-l)!Du4Y_L^n>T9pJCa^r z5C5X<8b4p5D2m5Almzka7R@ECZw6XX$@hQx3l;pPhee{;J|5 z+t~Ye+E%^)d+28)knL(vW+AUX^R_fI6lfWkUC1n>w?g~>tRuGX$$MAfH<#6<*D+hKB%U-*>6^Y^HLDo5_Ga~mUC|Em z8_EW5!@EZBLezgK?WU?aIF#PIt>={T*c}aQTGHn?TA*@RhFV#bZf7lG#ItGidzyIK zdbnPNbIpne|8C>02OauXtwqWBZSS<-gN(JEnX7j!O54Z5zHscyb1vkoh#d8ZD|DHoHst}<4jYA!U6j;YDZoRhe3^{F@mTvt7`o=!P*4Ck* zUEb+;e1B&6SQ=n=t5x(lnXhf-<4(FzSnUiNHY1Xg#Y=A`0CNdKqTbA-ts%1VHDZp8 ztE!^how>PpoBo#(Cqu%hYvSOO?!>DoTz$LKoT+He&YlS=SkpzL#_<)4ocsE}O`{6>6UE_S#>%SH9`$ zSASPn_F0yFSvgcY*PW@OyK@73B-{R{ZULBAQsM4L>Zg+S8;R=ExNZBO)Eh$%v0VB( z<@|T9iY4+e- zXP=c&BAyy|ubF9TF|sH?*x{ zJ0|sUGH6>(;d!TXM*?^Wt86ZFvv%6w_N6E4mvvI;6f%3q*F>sJ?%sg%>i56Z2Y)BM zy1l3FGIu79JH+9ci(dB~dPD30PQB+h4Hv7fgY}LnQRr3@Y6wjSy7XvI8reEW4&yM1U)>#iF3WV)fQ-Jth1OVFZV>>yxeMp+mlih5?xo8 z?zWq(rI7?IELl=G)$oq^L5#T!orbe{bI}P^S!7ot-csE@6LgRx!D*2;A zv9;BGu+cxPia&K;Yq@Z~c75!#h1|?luT@!UUeT%*qFZ$k*)HN{9ysdxLp_wM+w*g0 z@HBZic5l9ZzICB)+W!pE@iUXReEQCvX28lrZa7)l7E(fDi#Us{F?-kxLkzqx7+|7C zqFo~>!B~Hn>c8NBzsE`RV4PDcJt?lLFd)?Qr`v-?*zUK6t zu1?FM@!oCA+f~YyL7exg6t|?vBdj9%b8EW5tP!;7E;)LU&J+->%DqG!9VON}T84JO z3N?4V*9o%DZLPX>xiF=ZH>);}V@~AW$u3k_-$0((6M{>CzFT8qj<;;_cd}hgXLh+$ zuAMNRnbswLEzQgn>ndiWW2BO^C>4|j-S+gU*}1CpXqY693X$Gc^qgCp;=<(CwDrwB z?=?v(rBzD-2^N{xh~BKcGI6n|Bz$-rU6@Vq?yDzmWjNNA7?pQdiZLW;00*8AJn&zE z8`jlP6+4p*j7a@}qDTsafUIk67TXr6+S)4AYN*zKqSiL5qODddTBxRkd})4YStmx+xX)UC^iuOC%y>QcVaYLP$i` zBYCn2Y={}!`l5@R)~!o>Mk8ej5nQghTw|Pp-928nmx_Z#Xx@Od)+)@x?^j+*J!dJD z#L`-S^lqDUi#w*9dYbSWENY-YMB8FUuw&OfsY^v63V|^)lWTA&*Dh2?IeS*+MR<*^ z(`P$grOOnaJ9kOw^Uj^a19|6fGo5p(F|>>*7$Q_CqJly}C}efEx@(b;xQ0Z@6wG*6L?&>0`V@l!nRv;l%VZ;M+LUIhbs*<;AjapNSgmx+7MO;u@QQ$E6F8xGSb=+g zOu4Kjf~XKA2+K*7mQh1+cIhjQkWp)M0;w-?*ieeB6qy@TsWCg|qTXj_%KtgW~sBS;fN6^U4^rFXtvU|Y+eq=8mjmwDUH^?Agk z%BRM%R$E9GE!0KfZRuTLsz87d8hRLih_429Ee#Ems`?!(pms6vqrCFZ8#RDk^pCco zQ-WfBDC?rQo7mZ#tq{(AKK#eqp=`m?d7mO+#i3Lz32q`S>)F~@$ zPTnpFVrky9jM7j^L{e96Dg{a_A88sYmMy9UR#tVqYZ{AGp;Q#wbOI`yU;+|<(`7{V zDH~l2cg(~T6ribbw2hmLT+dWW#Ej^RR3sn)R>ai`fmw#tWbRs|%2p~^Hyu>ZajVBd zbi8MJ*wk|v%G-uK*^Y|K>x9 z4$H@5ky*XUP|FWF3PHiXTaaHOz#bDqh;rU;uG+z(i8ayGZz7&BDCH}Ej`H_-?+Sns zDOOtRtr1;oHMl7)7VeUrT9Qdr8Y4C$ry)_iF+dXWy=E2QrCTi)G9lIhL6Oclx za*<@Iwke)Rw^5-wZ&r-y)QHt)yLnJ9s_3b;Y*o#$wwcWkV-8xowV}Z%B?(>VZ^BkE zC3w8+2*VKdfyfLtUNED7L4_M(;4b@bTY7T$$R{^wa=BbE;@~rSy5`Cq#b`U&@MkW} zDL%D%LV$tEX4Jc8vAw}tD+<+}P*-xizSk%@qf_Y?f~<6;DQ#oNVMlp~JqSUK1 zbyCvw+EVdW3OOhhM4Lxw77I(SEJ=5=@4{$haJ6U1CD|&Saw?5~B5bLNyf`+F2C%u* zhUDT!>7#DqoC5_lJZM?*x^Y%^o7&ZOn#FvnLIM#*^ii!+_MpP2TG`hhq_Uc~uJW%ALk>Up9@$O?o7F+Gmhj>Km zt8rSfeG}ErIya&NLlx2>teIQVx+A^3-WtsYmlCz_HAe+59BVG?R2SuNz>SrQ4a<{q zg2!4`Yqp}a^C^`&-a?m@PF*U3udZpjlIScVxbIBYd8qb(E{nNot6c^r)Vpf)Q;x7Z zdrxI?Rh-jl*t{8jQ9H7poc@hxO= zo`>)HjmchcBScl@RxSnRlRg@C{+iac>bjL{S;zRzhH99~c9_j;v7NPWS&iF{*MfF`^?zsc%f?wQuLjkiGOp=LV~qXY zhK5GG{)*LTK+>DRZi`|umY0txG#Ep{5KX*_%`C_4Pg3)Sj{-l-;Y z?=RKfw7lckQw(L3&+U`kwdLINHu38YWc4ywl`E!WCTh#d3`OM&0?xcuL(K<)o+}B6 zT9iwFi^EBgZzjf^OQ`N)r*W~2=Jeuw&I8St;LqFF4~7al>uPyh4zC@v4k*CxO~GY>TmI(2VBbjnc`mj`+^MU+Mmj>;@0h z{h#kC{*>S-Sk>8o&ZqgW0U|c=x)NrGcIFpK*Ge#*qOt(EW$5O*>S8LWT5zkHo-vny z3gAvNy>;DsrtXH}mVYgS^WgAp9KA4`{zEKn~abj0q2rX#s7BSI# zqbPIHVs5l*+3e=TjldQ3)N|tlzq=ht7Iv(l5f)AA?J;slJ9Ho7H zcKg?nzP^{w1+CZEUix$y_%+&J8fkou8S3=Sxojf+ zn+->i;!US9ic^mgxIO$$%OL&F%^CWCAJb3tFU&LdS|;x+Cg`eKp#E)KV=rMY65TTU z(er!!FD;1lHEIl1!k06D-9DN(q|J~LVcI#y?a+?Z~;Bme=pV`i*IGZc<%1 zSJQeBC6b{>&1Ui^iMw$%Uugab;WdJ7efxep?)~piuW&`Cy$_Oqp<-SkQx7ijtn0r= z-tP@G^O;v^YKH;*&(~eXb+bL}oW=sIyp7>jm7wRT+y0vt#a3LoOqd;)B%Ve8w=$gm ziR!0gW$S53bNAu70RBKFQUYNfk834Q^44wSbMp-%3Gn+6pYi`EpI4h7Ry(}&>3O&M zN5MoNfp>!7O;FZa{RDJxpX?G~3~hQ3h}bUGE>y1aFJ?(3 zc?1GUkl+{(*U@oUAo(I`2oepISLs_G#(OgO)1IQHeCmz2xN}l> z5sy*`IhabO5=^hS{C_z85BdM7sQLU=-Q+t%P2CQZa_7u{y>;43%KbCS*ON?XC09*u zUp-2=K$-jg`;8Nxp1ZR6rPF=r*<62r&w}f&x0O1AEfQcUq^GvRZfTFe^x=AEH^M<& zO@>59$cp$}eUWG16VA;yy;I&_ExSZhLW4)?ZH4pVowl}R4{sGdUrZD$L(aAT*|0;*iw0%+=TB+}|q80z$;{b7Rh4lKYc|QTq7?Si0*)^3>ln@2<+Y}~WVBc5 zky!fFX7tv)MVp9N5pBR>KKlLA{hGP>KJRtD&%d94ardG2R}$#`i4Qw@H+A-PLzqkp z%Eq?qid)9*t;_u<#MI`*``;&k zuJDHad;+s(3XovgK`1lFD}sj)_rE@N!_NuuqfhEtc1H=`=Qy}?>pwl!vAH;#?7oRt zM*By9FTX+1R*z6*p=;*p4oAHw-)dnzBBn0jB*B9E)=#;nPhnp;>X5v3(!t&2prF~g zo>Q$ONZe68@gw7vZInWxbA1W$*HyBMiUOetyhX&rct_L#sJ^!Ef z|0mdfKbQ9!{C_Oeep#H4jYNlxP*3reslum!Dp+gPggu?==iU3i%Wgs_O8yV4sRVy0 zCx4}rKuppsd^BLnx$o(s!lvJ@@*+4%J|k;qfrmI)@!Yrty(Q4tFC2Nr;W>) zFJhEHP)l{5ay3x=>bEvj8j78mHP*j*eDAa7dA}zYNsh#VMB%8-Oc9Zh@cXwyFR^5Q zk=bKETstr*T-DF9Qblhf$kyCPu}+%(pMTi9yZ7g!SJnMMu*O0s@CH^zPxDNQ&F1GW ze#)<`Q4(`wFoZsw&D}t@MUwsfH@DM1Q$Evh+4Rj{okQ@{cF|{VWF@~GHy0D-xEh$- zpv+u;lUclzQhDnQm2_l(@0+|+iJ?`dg1?fO{Le?f$x~kX4+HJPL4rJH z2wdc0imSgg(P{;VfJj7Bm#U}RrU%q#Ik7irYMXpAC`XW@zky2*23^x|MlN!rei++$ zG=nHmNQLi8P4y6RW^6yPyGB*vO!!GRHz{@+yYu>AKZn8K^XWImeebUOiIet!+)#3` z?kmR-ujb{W0wxUZqPWiOk-?cq$f?Szi_fP3}uC%$W{Xx`yi{eA43>nN0%a!kTXGDqoqw?S8tE+ZubMmOV z5tE;a=Q+55FkYuS5V%CtW9ARi&^+Z_8()a`A|R4tNRLpKL9V}d(tVkK)z#@g!FI0N ztS38dL&YG%uCf-Woho_btaI!P-Xpu8Z1Xg7_s=4l~~p{35o=RcFo@N8LY2 z;Da1Inzz?k`9AC4w>}krZ@(ZwlB^n4Pp{Mv&zCt41VMGoTTwI1!u|wxjF6Sj=eY9G zzu|UU-8kE!jxIbAMtxMFkR<*QjtYT3#81n?Vl|7%QvrkKO6wuY$rAEJ66Rv)9h6YH3!sTDD;Wx8aYPKOMbPekwgMi;kR}-3F5Mad-u10?GIzaluT|lSt`C2 zoqNkm*MB0pyIxt#S=)`IAxLz6Cv)eosrHwJkOTXk)0j~ z&xdGX(m&(fM~R*#>KXeL<@s&zBB^v3tvsvXn8dscSTp6k$a7w6imV=PJNXn5=Cu>l zugzMdb7{Nfpth+xx}RygdjCYsr}B2GZ(T}_2J<0=(r#LRHl2yc>*dUAta7GwGg6C1Jxp3aHDiLbDGX%Cj=^ z_43DYl=QWErWkJpg>hP!1;4=7TW*8E?WsiYTMPRY>set!A z<>y6MXFVl<8!X63(*5_)P-1^{mX!G?oPVEOd^59(X$;g`TVoi=yDDiBRCh9D;4q|BNZzfbFHuh~Cmkq)Xz9y6y<+T?c5y21 z7J{jAvogzvCfXPVqjJmfS8s$2UHR674 z-Dg$@+<6l(%vZZMw_2Sj^==lbLU5jAyOz@>V68^ml^0S0<{Wh>ykmN9x@~`MtJh%{ zPLT9<-?Flkqn?JXt@3r^PPdLibUAl;Q#)@iVAUd5$0gXcQ0zkcCS98=0+{rPj02`44}}n9MEU>@*r(Tl7v@(0)BrBCFM`>1P+1DzSPy>Y}2!ShFBGHw+ zKKz*0o<$LL7&O|)K4GzQTLyikCW)aM37PR>*56_Y_9Gr+ACH=sa@0*TO{g6)*IG6c2Vc*)wK_h`JMYTmW>pa#FUP4OKja%9A!=*7}srw zC^+4ngf9sUqf58V_~Dw_RAHr(kR=9xEor2z`L>qCzcKsX`q#Hr)2)R91dZ-l@=g$W zM{`v&>6OBpbj@nkw70$Od?aa{k8VbZCbit&F%;8&X^QLV!DCLQbnV&aUE`_duTG@M zaM6Q_7%K5x&za`;xVqY~;jX7(!3Lr+b6)AwI7~ILYi7>X&i%Q@g-e`U z4-$;)TjnG0+KxA-$`<+Q(O_7#)68|waOUfx*?Z|avp1*Z=DH=ZITv&7?Dl-RPdgBR zNg%IlaVqA!ono*hvX=x~3Pv|7pbE;WV(|(|yXL*!Qdt(tWivvq3a@g5T&-bEEw^p( zKy%KNFC+rl(w2hh;w6z}u|tJ_Dzc6`TT>BMo1_uCP^8{2((dm>wOU05F^ZP7()|Iv zItpW=k`SvL=evqnDPCOp*sM%T0-Sb2kOLtgR5FF5)31MiRBzk1Z>cxTi|@;crK+Y6 ztkf(;!1q- zQc$KmG_%RN=XInCyVk0I6u^R|tYT1B4+%n$RbFd<4bPcMxGLC|8$cCQOhllNE89>? z6<99tZAYeJ6`N@;xu&-!Rvx{cv^kv|S}9YFV5Ff`AuC0aqi7NZLem$Zygui%XCDok za>TZ^yx%xXof?WlA|1c5M(+{F@@=|}JM|P{#PfXc5^;fvZd3+;kx2|dblZD5M37|8 z322b7mYqQ(O=k-EX;tm2(3X(I%J9WYLbE8SF1D#@TdK){EQ+ATWhJ-k-VCCZ7Dh!h zgJ^~2LRDuRKy;#$L7^-N7qxPgUY88otd+rNRB5U}nN$@@z^Xxyj;UE?Rt!E$uV;(n z=XZ?hXQcs%i6dfv1dEflgtTu4K&dfmrf$`RR0$EnIWsO9>XXAgOw+$39H2-#G^TX= z?&`&b9QE(vqi`HsHp5q60`D~mP2o!{+q|Ng@g&1BDyvTn^Ac%Dn^n^f6A8x}j^defq#P8axiv&t99KsR2 zMg0JyyEPPIJY-5X>ya66E_?RugdA-y6wV8i)8u_}(^t1pQ^KxikwGjdn#@;?U@%~A zo~@4WSJ^XFIwN_$_D*x}nvTpPWb}{@l=XZug6-_1cek!J-Pa5 zh=;mO14s_`Q-OjYE^`NdDVo0tmA>G0t@VbX$4swi-Dp*r$L|F?BYVo%@3F&O-)4BK zaaNs;RnA+T$toV=y6vF(UJDG-tbFdG#g1pQ^1W0E(MP)w0_>%W!i4$v+nZv0sQ;#uQ63dzJ$C|EVvgj5MJ(N-8b~QlveR=5{&qo46EXi6(OYwXKoA=x5 z1G)`KSfD74Zf1=S^Q129gBH-&Gcrdz`G@9z0owL{K_6dVO+@^%F5kcrxskORVD681 zIK_ya2=izWRWnt1R{=0ZshN@RTZv?JrMH~#I-L!|3fP$JQ*H>xBEz_&!m?N(y$lfZ zcUFa+u)8Na=SM2ZA)DDs1QJysklwNMo*yC&BTPb(d}<-%ab(Gvm+jwZ%32oNU5=@L zZDn*-OKRqBE-@QPVm{gHqE2ti!YW|o?ZUd6Xp#}$bA8Rs9`4Dr4Lm%P z5N$^`1i2l3s=N&&DrVL~*Ew;NzEkLaLdUi8dadJj7=NISkqeO`5pq00c&RoVKCV0b zMr%jz@AOn)Hr6t+9nBlNvI>9;oh#;zJph6S6#f$5G~cBVBGf3r3n)>Kh1Wy>hbc}-`1A651l zu;avTcD2QG$Ix)=`uZ&k2XLDv8mhk}?^P>G>pIy_58>Z9)y{s^cTq+}I zobTxQxu+^hT=uqg*q2bE=rJes?&jhXHxH1St}b1KVtKXPuWyF3h1&C_dQ7 z>^Pk*f0-jfMcQ|kAv{ksgsoLJt>v?##8DM_D$7MZPfWRUokNZ1bI9=uTYexVVS{>w z=H4f3J9UBpCa)M*4{qDp+a^|Os=#vuJzFgx>vkwwRa8OB+6MJfb>O8ajI<{`*P~7g z7VauA9>DJNjdEE_CrXhsteqPWnn~y>Kj$`Ue*xNJHkSl9)ndekuSb{e6?~k#8`sn) zHL)##W@@HSfVgy2?bEewX{+VRfijZwFxJ$}7^!WSXIW<_}OdC%>hv?nDfE?b1|F3_;sA8qVkFs^iGXFbO8fpjuW z-dyF@73GPFPdoBNai=5Hna)-vl7*bFdLF#z*s0r4 z*Wp*>QVBcmU%wB(D>N15EQrV~yu66Q<}QBPHco77n4III9G7)qI!A?|d|SUkL4ZLe zM9glaGBCUPzMW)fh52pddO@5O9nCyabzzW!o%`lY=Ct+cEJGa;rW6R0cQ0exf5T!P z?HXIMz2{HTB3uyTd+i5VgMa+5e?QkpRD zQVJhxn0_2LAw?+MD@s+2(B?bBI+& zxQMEs>;Gcqx}D#aevAU*2f;p9f5RI@Yqmxa1ci4x#ARmjMPRW}K3e&s6LCgC23g4& zE~CzNCWkKDVgM?NR;zVOC?S>|LuL#_)(XXFd%tTwHB-Y{b9mtOdL!pjfZZ?0-zSz= zx1QH{w4Wp>L3l_4y}r%e?~?RE>lhc!b*#MyA%AiGKiw|;A5+upodIT$qkeb=o2-T7b}%3AldPq(0q>m%q6yCl}v_kKrIenkdGR2L@;4 z&voCPz57wUkGsnRcxHWz_#Anx9_d2)eO5Wy4JR4O^2xmNDNF+ce?9A40;Km=F{`rB zQ9a3A=snj&Z<74Kc?!8i9R({^$<{#BAB7g$S-+5$oMv|zXJ@41Okg&q5ltH9x+&)Z! z9CEMD9ypLE%K~24f4C@{+~Axz3L;UNk`ap?d)Y#Hd(O{7bHHDU9OX^iq-@Db;oQ$+ zNFdxC58YE|b0cT7Qmdz{TYS@XUdKDeO%{O8N|@QW5;tR^(LJe&rwV@`%(tDL$l>@c zN4HtpkpUG?_4VJqEertrO|NU&yStNL@XPHX!}V#z5cBn;e@P{(^W{(teI>_hcyY3a zMO>h>8ANDu-NitG2}qx`hob!EaO9%m-~rdP_4eMZHP3xM*ayeBup{R6zh_guwG(v1 ztFA0^d*h(4NG}#ym*kD*(Rljk_!=PdiQ;Y3Rw@ zr#RwctS+~Nf9lP*lyILQ3fpK|NhSCXxcQcO--!3Ahg`cd@8D6ECK{+Vx9^q)?(i2n zTyYbp5x0UO`4$}(wY!K%+|xmSbb>XkY?APy0cBiPS%c$mmN%Nx?B?vmm2=|}$IZ;A zG%{cl@iG#fA-&dm69VlJLYrKmseJl2*~t_ zJp1u^9X2g^vcN-V%ORVc!et9FJq52Yj&sHQ>sf(U`<-}QO= zhxR{y{e1g<{^eT6Nn->L`=o-;?t;VQK0kb8ZWr|J7q2#mh&>!Fe-uYn!z|Vh(d}M(*X{Y7ZjvaBWjZ-oFv^Ur&;8KY;>;kkO^7jG8*kWdqCx1BQPC zz}-a;&9<@CDVNQ+zMEfVrd zd$ShCy*5q<7}OZlX)UpMHf%Z=Ro7s(c?P6sUrLK|`)y=$QK#6~Uulw=&>T>nf5c~2 z`FOSN>#!`X-O;XZR^$Vr;B}nEMq!AowC`Ydig#_jKx(_mN1tailaE!TmCIE7w5{nE zZvjm}RZC(wy+K}Vy^ps!Ys3A5Z@u>_16iw;VHrVL1fC6Qs_HVgcL`@F7}U2BS{30K z>@ezNO$da8acbfOTk@q!YhJp=f2H|2Y=Sc-o1vB~Nxv6og-w~+cSNqeiQ?;{5gbq| z)FDfrBZp4GkoA}Jz0GZcU+;97M)tQ*V;xqe``hIrKy}@ zJ`X78Wow;s4B4?k^*&6ICKzhtvUXgzn{u)yAnB9#^D|rbdF#iPscdBj}`SQPo# zZzSMnQ9M0IUKSP;_FT^1<l9_f2(Xyv#T7f-tCN#gJQLSfvlFf=754W_MPghYD>>LS!c;6 zZ`)!@qkFIVD>B;TPNclZfFRVsEHl4VL)>yOk2&%>$8k5ag%L3VG-EU^_>Y8D0ZBcX zUC?E>@S@X#snezNcb*Gn19t(Ho%z0Sf5l+fp=BOvecgV_ z*6|r;Co^^|Hk*H+P#abfmL&vV-elcRUUII?Zl@g|qBxI(!<@|CFuQ>PIy}Y05Iy-^ zSICg#ysKX4C&Ydz1dAY9^CRT=+g&?K8m+V=(&?h&V|2k$(is+aL53l+6}FN2K*#3GawTivx$ilgyYO!7_d_~9?ZrKx6e#= z3@QwwnrJt*!@bT{a^f&76HHiV;IF{H7rV+{*XO8URF~|3mJ$7pq-oX|!?ywr!Ab6Z zGi(=K9i=d1D;oWs=YN(bq>6TY^Y#k6inC1lUK?L(-GMXZdMtUP>eweQT-Fz!35CU8 zwvML{YjHN3?49h!iUuU{eZ${#q>K-u#{K2M-e@T@v}{0coTqxNHD)_zne6!jVAB!t zpWyl4vN@`7iA6t_GW#-Ql{lj?79Fh{GV9vo7gMTm{UR_ zk@=OpKFp8d+p@m*yIhB)onHK^W}yu44|Zp_)!sPD?p$+}-*X&KWxcr5TpHzKmXs9e zKpLIrmN8St$GMU#jBVZ?CWR}O?98%pqu#AFGnHKiSbz2cFxp&$tM4y^5cj*;5r)3S z@x>p;_uwsM&uZvv$6DWs-#ZJlt5B(<#XfW~w`XV1JI#iu>EG`;6G=8I(RhCCoechhD=Aje23uWLG?yG*zEIOt5>*NsA1QJ6Ss<P5*5Xmj ze)iNv<>MAz)#+BqK~9@ti;!+qVA+Q5en)>wKZQCY{8dIlLrfL63wRhqi`XjUCrvS#m> zZ>Fj&RrAA}%3_pOsi$yt%DX1r zp%5AEChNB8cCMQZT7Q*eI#jVV3kzyMvVU9qZ|(l(JnznPH@`hGOy))0U9mEtsiGa9 zm$g-fNKunVBWxf~>pmpTRo4yj*th0x{ipUndkA}T=s7ZD-Sytxs6OJ6FqXH)Bldj9 z^JnJ-{P}Y+mMfJ#l$iwi0*H(DYW{myd2{DE5yyPE=XkCTz<)9Nzjx2g#n7f{>j*)qQKBU5jV4@to1F%-)!YlzA|#-xXPn}kvqgPebCrX*>FyV) zN$gye;HMsUHFu(k=9xkTwLmd(QXLyGAA{@Kob`^}Ef_nqRPd7iFU z%m`J)LXVxhst0!@N=Djt7PTC|PT}Ww2YFL6jQP8rA@Z&q^W@Tb#`ArQM1dVwy7&#^ z=6A8F_&-@fWbZy|?mWBs?D?Y)Hex2}>|_&L`EteTCV#Ul9bU}p(F`=+#e2Sq()Ufy zGiLmwBau!NWX%J-#x}l=slCgR)1--_2Ar$u}0~qn*1Q)yHTKwp3QTlWg4^FdT}%7D%p$blIbCpvA_=EV*&AV zh-W0t99hs9p*xj^u5XvUa`VhQn66UX!_`w+c^f}&_eOJuJJokDo}X%2nKVuF@VDJC zCYXmF_A4geWXyRhq2s&^D)r&qH#f)7g2@M$&VSEl_W3(AISI4ZoY6zM3RL#gPiv}t zh}?+2=+o5{hfT1CXKC3aob1<+>-9`cGi3Rj@4ockx*O+zPq@nZ?}yCH`e33m+D*#Z;``NW(dyZq0>IdfcFWZUaj5st!W!U9d&q|R5LGx(H z`MPo(Zb2^t&Q~oXS7pAEE>uK53CoI-r{*O^Og0^JSSCKl;WcK2i_Ps#PYLVw4r{mX zZ*#|1&D|l$5*p6WAzeqDG1r1i7niz4(0_#Ly2lQlDlyIFPK=1>IeW%gEb5iWeSE_W@-P_9DyIqr;NZsdMxRn5~jSsBGXdHKO;!(>&0C&ww zTXRb=PC<;G0;DL83c0TsyMr|$tTW>vl(eKg+O9Z$V?jha1XWi=)EW=Tm3)DBt&_Az z5P$6TA7|+GYucMdc5-3h$OM~}swp{zblcP~XshUG`!O)u0zqCXxFJ)Fi1Ag6Q+?!L zesyzmu{k3vS6i>bq^pV;eVM7r1V_L!k*dqGv0#_3RNv6mYr)@(7^%H;gJl{_vc{FO z7VE|SL+qCQgw~f`6KuK2x{QT4q~#hAl)SwU3pSpCNe9TNJzt z5Jxw+pOyztm)l&5bS_)x_ZrWv`pB;84%s?{ie7pkur>k_C!6hlpUZOZ*u z$CWeVc*1RK?!$Ou)i$!Xk}S%6(gN3yte3Rf-pp?kYk|jWGLJ0GHQoHrT`DurcYogE zv&yAmkcc5Abo`2`iHD~p)=rY^8-ySnR@llN&ijCB1p9{WCv&AI2L$Zgn&uA7H^*3x z?=T0-A>hKv!<)fo=4>zwhMp4VWn^;fzUf$6*l2V1cwZsCj`$9BGk%|49j&~piL>ISgWq>D#v8$%YRN@+!lz{ zE2|S@1|W{i<8a|<(P#R-^0qwTczat_WJGh5dc|vZtK+-EYh1`vBp7+&3q9(+V!g4& zeC%~{XkJJroUqOcHM1S$h&xX}u0zYSpzuh6ITk8=E1C?)HbfQ+zRU^7j;-NkOx*)e z<{VW(2OG&+Zbd|gtToIJdw-lc8=+&~%c?TE|B>`oPc&T!;n$Y1%jV^$FgDVPCj{b= zKBV~fGNK>~6#!SS%-s1r3)V9G!(>f*CdE-iSvBlJN^zlc=ka;_;C}D9LOy%!8TL&j z)gINrbwe*F=F%h;nx*Mzg@rl{UBpQcGT=M;_Uq#D$gCS&X+pDJ(0{IHyH*qwzEq?7pp#U=)UrCvU>9!aG6UrmT}tG z?ny|M9SS2iv7UAv?tey>666(B;_Zehdh^4B8+~+sJevDGShY|mg-p&%-%f?(1Dkgb zr+0%?&mHX{9J6^upD>O@-+NV}mINM7d!m6kvi4%{nL42!v%Au^cqUua;!7}LVb#e2UZB#uWz7f_quDL3ESXjLHDI%dmI)d>@HjK%g zMtZ9W(8HuK;Gx@B&g5J(tV=1D)P`MMTny(P8oQMh`sxQpm#y^XlZEhx1fKx$p8$(8 zMopz2>c}qmt$*{|9ZGV6le-VY%~?X2Pk!IANcMmLJ=^yQel?!^Tg$%j&p!3{wNHMc z(Az6>*H%K*NQ+EoO*MZkMa`oq#r0+Ln^ol&gwgSF!8``UiQIF;;)&@*MY1J4j5Rw! zxQLG|?*vJFBS5v7GQ*Sd$3Fc7LiIDj*|+E`pak!`CIc2z6vA z$=Y#~f*6uxHG-WPvPx>wN$xs%Co6U~WKHiyC^qfntc!vPVncarBb=NFKF@llC8es| zz}$1snw5Mn+3n+s>dRd0n7Eo0zj-?zl0B7`-#>mj5TMV`xbB4fopy!-289Vm>`Mm= zIPvE~idVhHpU24!*FlKW92NtY^?U{6b3{{k7 zmklycGKExTeTN{Apm}R=5~8Th_!^kxjRk#|L&0I-1QF|0{1^1XetB@ex#7v*yCGk* zl1Z%vdsh1waogtZ$2p$%O;q*Nc!hfv6-}j+ev0)7vB)LT6?FFY|bRfDw9~ zXMbHpKw3Qx)Xol_ATL!yqk~N$XU~+&9NHew!7e*i)zC5vTDTbJUCr05E15S8h!mX_ zF)@-$_WkSq+x^X>{W^gD_wJr7O~2X^4%E6%r#Yvwu<6(+p6N=rs%|SZI@fH1OsAky z?$Lbnfv{9pQ)hTequb)$8Eha@!n!*V?ti97WOtRypJk30xQBC{r#K$adTTGDXx?n4 zhn7t?Svr-hQ+YE6(Cq6pgBej!ww!|@I|#o8Jy2q8)FL-tX^kc}Xl$mI?&kr6li8Ho zw3tPm>z%+z3Eqly6o`mb4(s==S-u&C%^GC#rcxOmSmQ~!MeK)xj-tJ2+VVvFOYgm zZ<$7*<+@V>h~n}pVJwxXC1;xD*mABpd22H)@GB_GuD5F)D~j_qmRh%q%5Wx-&O!b{ z{BPRP-sgVu@jiU7#_k)}KvJu2JAYU#8Etji>U}h!y_=Ovo(kA{)=M9*sVST*>3>xF zG1!R`cn|VsK47`baX{DWi~dYAhwEIL8TPj&eMXs9W9kz22-8sG<-netp3d&qr{4`Y zb4Q=BesHMdbJc4-`I5`1kA{7t!mE%J)yIfxJPKXVy}1JRKOi?(oJ_U!n|~7rCM&ID z=usybrE=>U&V|r1lYHvT3b(TQwRhEl!-9erx6G^HS4ts+P!Bhc6>V~H`*XbM$T`xY zfsu(H)#Mo}v@IW>n&8Nvt3f%Ix+kk^b8ESH=kMG3uzaH%JBB_e=GD)s$c;N(E7Mx; zlLKd8bfTigIFu@yhdR{f4}VqAmqdt$Vj?R9WR%y=OWzKqkM=K&gWmV1WYhYQ%0h%; z<#*b;Uk6^9_m{U392d0~@XX7;HrIS`%=41ZE14PF(S_a3{%%LLrbVX=OdX-gWCqPi zR+`{hC`=2;JYoI#xL*3dFh)-jT;jKT7*h&jo~4swQ8|KOhh^nVF@HSb*lkbF=#f}L zH>Nx)6zG^Rr?C_j-SCYd#6Yng$Fs?S=k4P&r@Ym~PWGEwky8_~vGF^#ciJa-Urdy3 zyP0}}+cRx!RZ)3j;i}J!U@|yoHyb-rEXS<;3u)TKeT_z>822ak>!Of7GD2S5E|D&j zc;|ffkZfj8gp2nEGJpHdG-4;hE>YKlrvaffp!1%JV@SG;%y&CJt0SM!*%q%>@RLQ> zkS|CFLsLw*zk$`;xqDF^7u&B;D`ek!c^D5go@N4JJ8JhFD)TelQ!_m#COLfM-yKYo zd>MS`q270gLJ&_b4aD)23^v(CTU4gi>-=n`X-p4i^*ZPT!^8BbP0EPJRRGZB+BYd8;xY=Ponz%_P)*u(AsUztgZJ~ z+o4y!l7C%$!=<5b-rkb?+Q=HcS6=C0&yyAt?X$%$?Jf@q2mH-o4>cQ0~YbT{B#DL@-00Ta^~Ov)26Klf=r6`GXb8ovy}i z)InBry<5gv!ol5ncdHwm^G7P-i#B65g+t7$M=6~$aT+1p%r_2h^VExXf-ah<%XIk29r!E~a{qXoLgtMzN-Wp2Jc z2D65+H$`r?_c1Npyag$(&2yEe4rr8~ZRR?Jr>X^R)#~L3C5LoZGPc+mdvy>+)^P~n zr6}7L6x-VwAsb25lYF(umsrz9*H+6t+%)^_gg zC?{a%TVN4$Zw1RSAupEZ!gvch)AaDUk< z(wSA)!Z)@23pz22;T`0$VvCPEqC2t4rLuZ(Z9?tV?P4_%7AcIGvY`4L=6F&U+*iuS zzgPv{?Cv@oE~j&(9uB5@w$PW5s?biJi`vtjb8{V6Jzi$G5^|?k6F}X|QYiMZE`dk7 z$8q%&g63N;v=Y)IM*3JloVlxh9)EiC_<8eQ@(*Np#t$%Gk#W~I1}}TOrVkS8n!U`kKJywc7p_-zmEIO#~ zZ$-~zLSVaH5vggFa@%xC$#--cf;PoR$d(_T{CvGWBiuh1I*Im$kdZD0_!U-Isseowo7m)OEHEl4wO=AGADH%8BcKJ_?f z(|!5dsm;6z^x>C$-qXKsFn?WF20`x)T`=Cft>KJh+m$rws~k`%&D}EjQf1|q?(T;e zOR310f|k?wX#;Cj5}ly#5!8Z=RD}^_UgD@Ss8?ssox=l_ag9YM!zZ0o?kmnt3}_|@ zqhtZ5yL!de>OSjaSKA}Q@!YL%w2VY*{6T&9(K4W5_h(NHA+8k*+<#bluJWvDwldyt zIP&`V=+0$odD4ooD^3K3X1uYDxsP97U;>E4kUCjsTEDLAJMpY@JoCVDlLEx$S0d7~ zMeJmb=b@yZYM>lLikKE^d*v?R1mU==#zX5@d1~sBrm`6icQtY2YZh|TN>=r9Qh=0w z9PSP|!_x3%c=Yx-W`8>RyTL&NH*k~!o^yI$DCBZp(=wWUCHoK)&$*S8HFME;TEz9& zXLPSxdz5%Ku5sVNtchQh**mN8(p;_m>oVSGlg>)KKBecj&VLC9{4fe&ILM>=S#J0A9gbAO|5GYtnegC}z@&2wWM zvwh98?)`Q5u*SU!kVbpY8bpX|;aiQ-zljx>gz3pHb<5mE_3F*!d5vz*^<0tSb71$* zNAte}ba#b@QZZ@M>Qr<3LPjR+#|u@J8XHnW@HMT6t7YqMWr zTkQ6;(HDCOnty7?2+)bTrSk8|vLl=a79p~0ov|)loQk`&PUmYEOS>g^a#gR6+KLRX z#D0EXyWZ|yUtFm|BJZ+|r1xx&UoW-7`#6zxn83^CBhJWjCN{g-yE_fOMvhi^RYy0@ z5!1beB@>JlQKq-@J0I4xM{2IxZF`@=ZaQdM4|4Yrdw;y~(}unaaef~E2?i;^%&amN zIo8OqqfGR<&0fc|;TK&8zXf`KZk!k3mpClfRvJ{Oh%cFf^3@YE*C_i2vczkO7WKTN zb}msJJFBBd72PajZRT|C*ucKFgS$p`vk^N`WsR^pax(Pb;ddPy6RQ!n?_LgLxfoPn zW8_64n13brX0?VbOR96u#yTgxk8hPEw{cXvohs)p$u_gJJfqb0uOoY7tnVCr>w34g zps#OXrm}c9ZdJW`FIf>ao+YUM#t=hM@LT>)3gMOv|E3 zos3B>My4_8!IFfbFhgC_H9YGDbj(klvAA)%hUjesxEd!k+wFM<@zt)&Rg)#)Oe8_( zuX_7bAaF-T1=EgY{(<9iY!$@!WZ5Pvnwu_jN983f3t2i8TH+yQqSXu)4G52GhY;C~`| z=6E+%)J#6Wjyw={f|k-)kuZ$&ntvR`a&c~jT zLG3JisloZOh1yLmQ=SP!IM>`<`px_C7h|r6b$6HSH7WSocphCCTO-}syM+tz@tBF; z#!noQe;uhCI%Yx5TBJ&KOmiejd^HxRT1Cx7#4JFL(O zUGekLv@RN`fPF~j(iOcYS2b~13=7|zm*7;={EiNXoW%}vy{o3tx7AQ2p{#L-SSqc!F&&d{;STp2;$ zp7I4pQCM#_dJnawFdc6aA0!v6zM0YP`|m#Lu|R0_AFAT0B1(~>_kTDq3zpjEFVUZA zbZ=s0>8pbk4i(*F?Kw^OkK~t$L$LIS6mN#q@zkuJ}fQH&554xUA)=8>UpLsTxoNu z_BzM87W;%QlH#kDiho8{RWoYIWnN9pD^R7pQAw>iu}T_iD&NyPED4+WJrKzERi9nI zx_a$<(qxR@q%51emSZqoun!=`^t*`#^6b<#XOm=CVAcZG+%_!bOC@%!phA5Qo2itm zsU{WSbh}p4ssusppm2y`t+0+YHQj|mStV(yHljK~z)@xTdpe$I{ z7g(aQ7N z;OuXnH9%1~Z-;BUt>d}t-^J|7%m*jA?r0-s4*=_UNx=JH7A(n0Nl|HRF^r5)_(1=c z{LPyj-*9_&n@f-&Mv3t5DX>E26c!6w#?!9mFkrae<$uCVVl)?RA!MeB3Tdd6tCI{c z!wxx8jC)UqK1NnJjn6`Q?EHJ4ym`@0+u2;G>MbX9u$#@P_*8srq_nEmX)FphsE{mB zpsesQY<3yFb5@-cau15@yk@Ofw2KO@a9xUPl4SL*$Te7%BrLo#X{zA3;@fT zWyl%`qJM(_T{0Osv72_zZtSazvxCcfDdJp?Zm$SAx7rpq4n#NvEEg~;t9lF&xq`t< zmmL8~%P9oLb1vcQa-?y!w;PU>(o>YusxshOY+CrDK_xXo7bmHdE=!9f9YaY#lK6Nk zl_Ty`FOv)IZ{y9$$iuzE#2wgh(}zTTC$IOh;(y#bs0Sy->~I|4W1_j_F$m8?)Y$l& z)0-C0#B#Gk@#LO}`oXypEQ+4a(iKCK(LwEcp3bkk;1_A~lmw9dj@a^gJ&#e%%;pds z?~-9%j95rOhcZ&^h2#4Zn*wxc44kMnkJ9?fGo~`tw-<<-mF}>HXuNRI?5YH#rP7eT%w^ESP6;gcPr^WFHbv*mMO8HuSws< z*%c{@BQvDt9++=X>ycX6{Fy4vn3f_`Q_ua1evJcOgt=G}G~e-uN-xfTCnL zDdyque*UWObsL!^3p}paF2l9BaeZzW`hS}#$>F!)+2YvIglV%9pF`AU*@MCAbEiW? zLG=Hl{>SlsKTlUji@DrAJ_O|{jwRn!q*_S|v$uR+PJh~%j?weL866ms-Q!PVd#k2hZ?tj|+ z+Z$y2@Xuz8M%Q!6$;}Gl=3iQST*jZ}1Qk8#3W7jERW#+gpl(FT&$58C*zQAXyupSk z4~oT-LdXz%3C5M6E45*LSYFDw-$L}z`I%qzRcm0>nFS@S2MscMF@!VpIALNE1^$%H z&teBht%YJcYMkCJI&8bGc{vxclYiLzgmJm(;MKtJVgyd#c&e?pv4~;ao7^@$Xn1sE z*7iKQ1bZI450#ohw!MewdAgllY=RUJW0+|TH0Md2P8e$hqjwLm>!v=FyUUdvyUz_c zc~p`_%!&+5h-Q?@2xXFqWeXa`V`@^ENvvuu1}aH5Ws5YVNt%$TjjFAy;eUGXIm50; zUU|y$b9XN8^SseqqsH>*Uu!AEH10UPu(N0D{WQ<^(YY~>+xS}e>YAJVi)5VejVnR&~ zmLNn9vqCpiGL+Voym)kY1q_hppBs>&{HH)#3)_eArvu@wQft5C5i-& z1WlkwQYNJV1ez15NPqxiryCk%h*%*&r2%b13ON&rIw%=H0um-J?F_b=8bL|NPW0~^ z(s!XdIb2!$0M84BX-K~0hZktQV_#|lL5=XWVCbAZzrq=^xfQjJ1E z1tkcSLkS~MQ@3z!F|ma*fs`aSP`WC{-MWA_gj`91O4Zz{V@lg%VL}mCOHT97rRR8^ z)#&o^c=BF$cS=U;I&@PSX{MVRZ80?10|vlXOj00BPNHfdjDL;M8)6unZU}>I1EdTs zsU5`QQYKRqOlks-L=m+dBY@c=g-9SnQZ`c*l`1$z7}9KHM1*XBB^yvk6itvAqogL_ znA&O(6kwo+(<&iJB9tab=}H+iUlW1iBLP0sn`+S*120bGh;+kdEIwz<=F1& zCmqhN;oQPqbbspZ?cLW7ySF=}W0f0Wgrr7o=(WuWkdi4#(^O)Jxr*kB3q=uV3PWv; zBSs`iiio6%0yd3}8YqO3ND@eqV|#`w_Gx6r1wh475CE;oO}57pjgo-9<4KyH47)0uUt9Dko5tDnU7N0HSu9gDEr=0)J^a2GFAmDj@=mgS8$7aF->6 zY-3Hb%e-Rld57Z zU`#TpXUR^I#9p}$A{?FU2gTsNFImGwG1%4^zzrS-g}IOO9|Q3p?JcITn^-i|Q$odp z6hZ@I!1F)c-Zc52d*k?+^V6H99;auArvn1+Uw;RJU>mRq#STdn_C5B_=1rP;Z@lb$ zYtNX|(jmgkf3CR&O4Q_3Fx3tY%769o+A;mc!SvD9XyminYHaJT63wN4?Fi1t z2AifDaS7mlz;Zf%j*Dc5fSe9hVNXvhh6H|BG2mQpD7BdbUKFf61frM?&9eFrTlbEs z8h?J>?!fPKX@_a$A!h~nmI?wScael4DnKQgELwsPggpLsZgwapQwWRm=q;)Cs&jITroa<=sp!4ePYX@cm znLLN4*RyK00{Uk7>C-&mnwrKCs|H1Kc7MI&W_LGxT@voqN`7YSxEOnujVagXU>i0$ zsE8RpE{|?{yQ#a%=b3@{(f9(XP_R-4=0FxNX)BbImX*OlT;>8~2vNV{eL9(!?RT9S z+~TUZJXoCAX6EN)KPjA80~%$Az8tusA{z+SrCPg6gp(SRl?$dYGa(ojyH3$jLx0p| zo6*765!%N?SoJo0p7Xr#dMNm|dApsi(Vc(MNm$J?uwZpG+lP-bWD34u=FAal|uz~FzheGpHZh<(UcYEQRx7!#4v%T8 z#C)%_0k{eDA8GcVyjun%)D%>T!J>kh@>QRfd60-eU}c~=}-*+zs|GvyPCAi3qPT z%G&hjVXri-J!z{$56@F$VX+^nLFK#Kn-5X6TQbaM{w-aHF#m*=G~4U6to#z zw(S=qa;2?cu>y-h;#Cyii40yfixd2G{p;Yvb{|h$%YVV%JqmkAv;jJWMGLoee}HUd zwb2g_4+Oggim2RnD2fK#5P!k6%3Pp?49Xwf1B2{n0zJ=jgmxZm+Zv=pf=z^ycDJ(= zaB%vH4>PEFw>#c1i{iz7L5wk`hQbGtk9ch~a&+-^a8P822%8=429KHPZazn|q0FX= zDEU9SAAg`1^Z3M(1JiUrYN_}9F=O>pKS}V?TQo9edD`?)+=a+O6j-2y8X;nkpiO`j zEzq-9wTx1qP<}HWy^lXn=>1GL=0D3xOiD>R@34soFT9=abx?Ibj!$$bfeFBJxGO&} z`~-?tEG7S%tG&~vtXH^)^IBlR8nL)}jA|rlFn=GY{TOuXFlNr{EVkK78Q%-7wi3Rh z6$9YT!0A3VXN$DY?fde|nsC1vgdnfPU71=?VlqmZN?L>YOk_1a>Z;yg<5foYZ3cPhcM@r?g*sIcs%Vm_@P$Vr5_GV8Gps<#WkHBZ*+^iO zaDSM-p1r0R?!!gv@pR&(3bU1{B6^^1(YF{q@so;Mim=GTIeY7%eLc&$lQ+2Tg!1rt zLEi5^gUu2~LPADw;WzQ@*m8WHBKgJe_MwP7{}>hmuU~nc280{zujhx&NoCNFjyOL; zw`#$y1IW{(QNd7kZ7cIpi5f*ag@q&dM1Q)A!&$Fg<@H$BiaUBOX8Nqe%Vpc~kD#MK zWnq{Zfrc4|JJ8koj?$QW?P~@fX;7Wri|3zNJW{G3T}e$!3}_nSxM%u@$cJvOh<4|A zyTl-EhRp;IgA{F!8g2J<`O`~S=Tzg^-fi|OIox4BKO+p!JUQ*MHsE#T-FLc}7Jtf; z+%Iv6teu5XA~>|BbkmC=jmB!7V?P8jUvp$Hjj#+C5NT=0i%!j2lgkeCBk!jQo(3N$ z(ImwWi)S@EPbpT{i3~#6mMrH+wodp|Kgcny8cLLcMHyR7*7cEdXiHMAJj@>v-5Wt4 zh8+66WBh|s;o?fQ*BI1#Zb5Fd?SC<1Sl7kD-0h3jiH}!oz~jKL*FnkZX4SaY!>ReD z;fJiMbseRnoZXi8kE1MM9?e)v+;1M|S)jObb)^vCR}T4;C?@ApFwEsd4)E(?2Xbm5 zG{o1;rBi#@aU~TMHHzX21O|J(OJoi7lJYT~vHr4^fO@n?kT8z-4q=#YQ-5#f`}%oA zB6+-IP*L5JhQfv4xo9}M8bMKEZJwuQ+JM4`%chZAPux{)O}!&WsOZ&h%Ab--Jsf^q-QP8yanRPk`XTGyryy&YT89ER3nD-h#6(i!s zqupdN<1+=N<)h|$k%QkC+EA!~@{Oy}!3tb4>S&u#n-H@ZXU~s8bDmlKBbjBv@lfb5yKY zKJhOb_vdYwtKR$tVc0K&d*l>E5fKnk5fKp(Mj|J*^xu>B3*lwnzrgG4Ut6+m^y5nu zmHHn%osuvo1}8|DqklR`@DVx zstn#^3P?5eQTBVV?f#F0im{E%@ahYJhU4V58v73u5yy2nn}2kt5>!xgi6^I599=)KLWmJTTtvqM;tw z@wvW3bn<=ot|-?p4BgJT8j?n$#z5gRsJY3*m}VL(OK9Z9zJ`Bc`OL?czqJlrPCG@` zZjv5;+A@ZdB7e+;I2cuq)BWuD4F7QlJ7ck6-f)%>oY}_gKBupzz+k-aV!dr~m=>`gxsG(#*>J ziGt>{(-S&<*O$V!t%TbQork-v?8sw@3!p#W*#E>kynl0@B4=>TRLAHKOu6<+T`(=! zq+lO3Sq6O4iTi*`q~Vb4nKV5M7bP=nIkK7eIcMA4gFYIBV$aVBLWq+SVTLS`F!Xte z<*Nx#gL`K;w>eNt8?`SDYqDI6zk~8K>+8-UY+*sIYAZFF*Z-qJMSaFz^Fs~bdm2w5 zDZ2e!kAI(+avb_(`o#3YLPA19Wl2!=Le|%pknlN-CT3pCBJpR2hH#e5W?lj2I4%r@ z>6|g<1ae+g=eMmprR#vpv7TJmyhu(Ep>ZQVyoEm^DejKrVViL0z>_(uD021Cz0+8- z$zd5PqvFvHR{M+xWyjU-`^GbpHIRGFSte;8WPf2rs72-4g~{cSTu)^CwTyCddu0TM zty-8B1H$HAx@>dtnnZO%Q()kn-Nti(8N1NOn+SP}OEvI4-VovFLbq;v{pUPUP>_(2 zkdlv-*kmPa+*!+{m(AuM-b{kii8@vgMLNi+x%f+@1qQ5@0o=(T z^M9I}&`LHH68vVr4aOl1(SZUptD(PVrwwl|N%t^9O8AM~)cKjz$`~ITm7Lv~mn1IC z>CO!2uXQ1RQRsxfd)Zusmw33-2jV`aHW``k*@dX;L5mNeL88Zf4me?gpfez?GGxN8 zJ)`~R+^8mzVPv_HaqdiO#5)rf;N+8-)0m@ULA-2ZLm``Wco!W@a_c(BdDhW}!WPzQTrXI29e=FG zOAten4$2#zOA8pKBWnpQCz;i1%dE!X@Gfr$I_2VaN&akp-5UN?p&xfw;ew>i2fX-K{k-zmgrK)8%o@d`asls6rAF5)u*w5fKp)5fKqS zvxjul#cVT@BTiWfNlU8q7-}RJAb<77B+9fMzW*)ke1Bs2H@HMZ?zs{~L=3|)%r-))65^5V49>)cj=~A$7ypqUu#73aO}C zkKDm|Eu*1gWNE^~?r&ENn?Aok4jFKyQ*oQwEZQj0?I7FY_?4_T)2Zsn+kXj%kiArL z(~F|Eg;1y0_?NQK!)OyLUkYkG0!gGEmv>@QJH^flYw-HKI@=NafzHVWkR8%H>aI+OZr4(^#&&ZyQz4@S$1@?^bs` zJw1k`yArj>d7pTCp$h8kyMN+%!aNJvOcG@Pw1@HHP*)>vfnd*)I| zcK1>X@a)cI^7@T@ATmE6CoQ02OBupK$Op<@y;sawmm6UEXGbnAYu7vwUHRC_5!_Dy zH$AdyCe^Q*TMSK8dhwFd$&Zmjp@w0YW*LT~u%X?B9`)%#WP1*YBY)H}_1E;yn7r%* z0goBKE&#})44>g~s|pN6Z7kAg0}z|kvT6r{_nrK4cjGZ&NVW;hibs*sUf%JBVVGtc zyX_u5hGCdy8yeiL>o=EaOYS^7&4@PO*1ox&91Ed@g@c^zE*?lrFHxF2Ui)$mXR?Z^ z1jnZ(Os?}SceL|*ntz_(?oDDOsVOzFxjK$X7XjNFm=J2W1Aoh{J$p8HBbQ z7;7^u)mBKyy-C??FMq@at8Vs)*-vJkBGDa9CGILx0R*!%&31?RfFPRP@Lk zYv*8kp_xT^5X+prVT@wM4kLeKRyPosA9!U(PVbUH??bFR%$d`Bx1kXE-FuG6NJvOX zOTRE@auOuNFw*l~%r&*@)wFEH3)quL*@>$}%wwl&sqEXhwuo-NeTQMCElDJV0uh9S zNhE?IA|fIuzkj`70`_wEY3%)dRnj6Q>wvBqhT`GO4UK15U_$c#LLaF`aL=mM_x|wo Z3;k>Y{Db`}{|bNnUC9*TLO~plooFtEtiJ#N delta 30962 zcmV(_K-9mS`2n%=0e?bTXgM)KSte6i({;II0dG$K{{R2`|IcH8@IU|m^uPcA@Q?`y z0U#CxkpR#@1ONfxo_{DnP^tk!MF&F_C;-k1s!%8ZBq#!agarT!Dyo4XRZvI;A9y`| z-~;KnA5hVz9Rfg5djh1O1uNhHA)qsS-W-UjqK|YQhz$abkd1E)B(U9HhZnz z-5TxO4{QMT?y4}Cwno6vjewUt4(SL}%+qYBO=%$zmey9ccU4rLak_+to~6xO4HYe7 zXIMx=VSobw1mwv8l7U`(bp(a$KqMrQKqYOb7!3#tD2j;*0*QN^2SHL^t(6jq0*NH% z15^;C?Y1zA2!AD4cmviz01N9B7&sMB6cmI2lm-B4&^Gei^6k7{a%sp@)z)EYe? z001-q00006fYZ?sM3S1LL7|h>0MVdm4GjPQ000dbfCidrpaCiRqLn66dW{-yR1Gu+ zgGQPLfYG1~Krom?Kw@cx0iXaPNQBS{qfG#YDW)bvQxbVJgVLHk1j(j`Xn-;UKmamr zN?v|#dVj!bC?I7O6;_A{DBg-u0HTToAFJ#8zHg@i5Ca&5h$yIkcf;hq=YJBt`J8;? z^QJl&pYZ(tk%b>eGeZ3C{{QMBHJZKhbR)MNzqvN+{%n7Xc2@T3#~iQGtEJ@yR0ZuQ zq*)LMFpz=|^M9G0zo*o=N6T;Wu&@tmKtvA*k$=&{e@)B|TQorK(0*+=AOZur2nvGu zzsO`bMDCx;cUOn-xbrt3(ef57WeJ|6_YD|-0Y7Yzwx7a8?=}%DAN$Gs>Ee$+S=wsq zT9l_${o)_HX#@DW3QyS}Za;4t7?O)Lrd$ml$NzmUDM~Y%(i|fg6pumOGvg%l5YZi_ zSbyAE{2hc6AFYX~g}#UR)1{kZ`u|x+Z6289o3RW@hwvAG{`>HE>H4VJxzTjdW=x}S zobBVOom$Uj1FpT+JL85)MjO5BXY&6i{UV>u{Qt?R=&7wMcd}DUiHZ@H-skp|@X%(1 z*LrN#T0W?;La?W%fz^sU|Em_Joiu+mtAA9I5Kq@>oo*mU>sHD(H4C@iVvM$1G;lDr zj_{y(=|9n~!Dn-!vu~nP>VKWF_4k<=mm%bMACJ52Fk{!1cC0S6f;kmE5s~Kcg*|O{ zObOz^Vgi|lG@Vk!(w?bTUo+`lQae3KPRxdZhcDDBU^x1Rr;idhtY9%A!+c(BF@Ndp z`z=b+icwSK%vV)DMp77wX)28hMIeHUt%_XofuL8Q^ND2yifsB(0Qw`+%Mp@Ao+6tt zJZxZm9X|)Dob8?LeU3#B2jF4P_{ukSlZm0-0g|5aVy+G+YG?W5SOjQS`X(gP0)xka zKu}F>Ng2M@$J6o_d-b|a9gq7RZhx}}2Tuam%CIIS^tKzd6p_mVG5mwd9+;>K=ErK1 zDlC|1f((k8MD#{V(rE}`l`KrGlM)d|Ehtf!$YI4L7^SMBFc-nZ$4^JI@lqotsN;yc zd!&*?u|u5YIt)e!0_rL_LCJjCC@uS(Q3SCZl@EyGwWG`2?bO6q9!ctIdVgo`WQcs# zR(mox2eP^>&B^+n_(vY4z4+D3wk^fXvBEDamu@O7fV(r@L+0jn(i%P;?~>lJst&gZ z>Xmr~Iz_lv?0M^q7|Pa4c0MYyuY&e=Ug*hLcDd62kL&)g=z2jSc$(bn3e{O0Csc<= zHb=ww|F8Qo4>S~QSCx<)AAgr;7ah8vbibb*kIF-f4MaB?IxJ9A=r*=_KDMz#EuLn@$BEH;@#xwB$HQsF&oX)YE6B z$*^TqR-%l}n-7!24Gax1Jr-&8VB<|F^au)SfdZ_KAV(u6)W|(?(*%X2M+*@ij&1*V z5&ox!^&fz_WFtuh%J<2wCX@GDk}fVa4?EJ6@NeWWEgOyu`+p{N`Gp) zJ7mr!Cerm5Sfd1zzavLOQy%$af_cJqS4PPYdo`RapsF%hw1~7;7PJ-guL!-%&)M_* zR)P;FCdETLQ<==RU8&Dr(gYglxzi8R`4>o6Q&N}R4y*KWVL!}2ct@N8BfQ)4yyqWo z-s(LmAvEkg#ed}||DZLf{}y+oAIpc7_r53PGYi#qrIsT8Lh(nA9&Z&s376N`ca9ys zx+}}0&ikhw{NJr?!>g^;Dk0x{b|!8yf4qOmF>Xl8F*TPONz`a4EroaZrCV^3rB9VEr> ze*d~tqJOnh8r&(5yvO3a%%ct%;Cma$pRjT~N=r=%tuIQ(7}{?!j%3D+nA3Qyiji?4vC%)pQ|T;~3_Ym1QW| z3L@ty>&&@!!OINSLk+uQQCQ9Aj`%&$S34^|MXQb(p9PS8Vx5N5Y20^1Ri|7Y%P~322vx)kYyal!x+^;mqQDTe}}%AJU27A@O27o-qkDe;M?HJ zu(@$Oa*|z&KzV~U%IhnYRL=)qt|3anocdc`>dB!vF;e2N@jdCpviW6Xw#)4zs>ubF zL&qCfXTt~fv1^#)*{?Q5rbUx#@VVIZLw_>Sx1UVR{Q12lL71}^R>$$8r{A*&6eSkV zJ4N#{tDfi629$s8pNPkjEiSs)*KaPK3!4=}a$P9mF;RD#9z@i&Ta!#WSQ(eOiQ`*~ zRh;uPdpm#8ZE%kFo%>T}Z@Cz5?;N+=lDoH@!Mb(O-n8!{ou8&>dhH3O=#aPAM-QH@ z)n-QYX4Q>|apiN5+>?q5BY*R|tC{Wh4|O5w;Gx2MA-951{+Fk|(ulo%j)_B(_SSY# zH7&ZOGe|^3)oP*JmUWlgU9VTB4{yUmX>ADUjP6HdZw>nuWX!m*>VLXb!*?j;E7!lhH2@gv9uQF^$NSGJjpEwQ(x17RnnM zEr^db)&W{Hw-eaz25qDP> zzUs*iJo4sYeREFvqn+Mu6!jxGw09*KP3LrVcgV}T>z&skuD2gq-lL#UT(=3dtA%Qe zf+Gc(d9Mb4;S=_8(mOoe;^=i|cyT>pQUAYrESAQUh4&&pyvg+jn7e4Ce z+1FVQQyIrRRPfoTH3yq7ub)2ID5arQo0d7t@nhYW26kUfqPbUQRm?M1_PPU8n7WYN zv6g%%D?$Oro9tXqa+STbd$8*&qTOC9fNZxjBNlrkHhTuP3(q(;9g|mzx}3K*J*E)r z-m`C}%exzu41Y(7q(SESZA|iRUm;w987sKpyN>s^44ih*TfLOHzLb?A()#t<87`pe z+f^$vLn-#)RojXlw>L`67P6Q-uNdyryf#e3F4ptgczSf4D(krjSX^jGtl{0Fwr+1a zp%&#|6kRUL=Oi1PyUV=74ajQj(%~?b+1}}Rx(mHN4u6NzHtS!eS2Qzn(N~vKxy!v_ zZn_&YiuLB}6x70uu}SKjs?^iT%hiU_*Kw3ghb<-|a*oxVJ5dlVCesQwWl(zGbz%vj ziqmTos83q}JH6>h@fD3(l?gq_OO@AYp@$sPg1JDzklNiHb`H@!;L$9#mn{^OfxEk_ zzUv5x1Apx0oyFGl6mA0bzULLSn;qD0$=LQ?+{-%bT2VWjTfeHOD7=HhA_JnixE7`jx;M$j-{Jnq!qc-XoP@Fb1G z9X_d79K5{S-HD!P(+O7yHLDoerKfs{r#yFKCe7NtPUM%DgaOBLb|A8lw)*vAX0ooBmsw=O-3>|a zTFfEhzl&%w6!#aa4l8e~j`~Zh<%4j{g8bT}-d#l2`0KM2*>8CARVf^%Y6~RFk(;rO zTz`j3$WC#i6m>a_whKt)Czlsa?{>5?m#;f0%S99#cp=KWzwP1L+*jgK3%z}w&8=4% zpaV8w>Uq}NqOxButr^8+?WI-@_43I>o&q&Q&I55FR&=|2E}dLg)Ok~tIBeFniCb?a zKJswdfvnY@6e?!z;ho%S_3608x)Eefj(@>4t5`8e_qI)TxmNHoORg}y8K;||@QUf3 zcr{*Ndv~W*Z%!pzgL&f0u(SW-r47IALMIjR$7p0r4!-X{LjLFa{E|C+A8z|f*T3)m zhH^O$)};nw8uR~4V?!}UftiKeg33E|FTdDuwZumOjo^Rht2S$xF`BKHH@PpmHh(IG zElrEfgDwa)E)L>eTEM)BPWrT(<|}pNlg5eNGk448wPP0E%-*o;x*^^}c|gtBcWB+{ zT7@07)kjAXo7Z)`@}64*p{J~*SQe|^kco2M>okU)Ce`u355jlTN@NcEZ`l5C}gEQf$d+b^|LnPB zhhcB4eG-y1MFZ&8Y1=U?t(&q66O0#RI5##{8{03b_gS^)Ww?z5IH#vE zb5k(2JQK3Ay7|_JiX3H7xf;LPDc2{M$_ zcUh9gn@=X3ocyWqa_A_1GM9UmY14lpm3el@ac9J>nD15rL-RS<p{>wBDU-MpgaxtryFQ=LO$1 zDoty*juFu)(3aX|Zi<@mHMy4Z`d!ecPWdXhx^E)*RjPZxyVCvAz4uR2y1IYIvdpvU z$;zSLyzNaL+n5{KCg199z%vT!Ts_GBRPtWKaXngh4Zn06gJ@yaE1yS4^;FArPq5Qn z-uGp-rgw-~HCb;7)mC|s9+A1Z9Y!1q+si$NcN%xt@P5e~f-huG8Ln}^`m9hkV+T?O z6r3j6P9u3G-G-UqZQB^U(Sm;||O4cLKdqZ$2?Yt87Zqu387dhFw&iPo4q1rKMp zMD;8(UV&GX1t3FHn_cLB+InCYO-QC^Y-BL+%PNiY%Czgy;$5+p{RZF+l zgxc$PcYcgT)}N63VyS_8;kPu4`Z=aoinKCC>jJ0`V{Ei8@33F zLAnjTMMC`+N5ejoRTWu(xiss$t#I`@?O8I{uJvHh22z*IBiieRcXKO^XziNr?@||H zOjfnqMT_Av<9Lj9J6z*k)z1McRr5xLV{5AWVWNKWDE-xWuI0k{+4r)}7jrh>XDYJP zy`xksM7HW7vR%ZyZ$VeChX1oX-AQ}Pskg+ur1(n7X4b0qmcr$Kn^Ty)%OTmAq`b}z zLu3XokUD1_@$(heTZluR9*2&<4JhE?_AI$@Vifl8Qe*Th{`=wLzg}CPJMSBxKJxTe zV)%DT?3YWW*8C`4TnkyT=X z1)>U|2}%q=6=FbtQA7v$p!2~6K^z7mhQsguxAwQ%|D!>XCbyfLmA2Mj#Xq!EFBvT= zLLcD$-|;y=X;CCyqCdd|gg-OBy?GITZ5YjNJ0C9GjWOBV@mZ$hDLHJPkmJD87|3eF zZJjY?BqkJD!Y**a_p(Y0D6v^W#L!bIT_T3D%zv@+U*O+=%_RDASAp-9$W-N-vqo;- zN6~Hfky58pI(o(kW6)^TZBZE1K zy0FX{eV1fO5mL=9LObAL=nq}yLxtsX0|J;K;k~_!Yj*bAS7uRwkoSP&Pj5$qRR*r< z*7qL{P2IkKci22TE%!I1<#Kji7mo98UfQlysto77NTt0dK^0($q7y08y*G?zl~sb8T(Yt;vNfnY~%Gdm48p_DOQ0zNvdD@U^tN zHp34jv(Ds~PnnxXD_*=Odpg9Wxvh~wi+M1P-OxyX7`6$-w>HJ=$C9w&m?Vx0NZYNH zRchX>u2Mrf9oJr0o_SSXc~}ApEiqXujh6V>XC!)f99@`A@!qR%yOQzuF7!Ej-nYwq zyR%hPs*+VpbY5ki7z!u~btVjqNd4-lNP+~2q=+FRBOr`|As~w&t0I9Qq>2C%2mr{c z07xQ#qaukQfgpn-phznah$;k%g0dp0NB|6gD9EBAA}YuzB#H_lMM)VVvqdctNUv$T z3V^~`kco(iCV~l2k`XhA-f4mwVg^>eXrlUAWo0b%FpR|s5n8RaT4Aj~-JYLUT&OZ5 zBRmC@EGot@Tj|@S9;T^^VKPfE8M8BFSlyX_Gd(Q085Rnv1O!dCBySA%=ev})QV^&U z6DrnOprb8XsEum&8LEopW?8c_t;^E2VM)!+*)83hqXC|F=VM!IX)w%@f`Eidg%nUo zNF@x8cF#t5n2Urli9+q%D5AlVqae(R46v{(nR6`WMrIaKHKmsB(2Av-S1PP9ow!TtV9Z~iVCs5V^G2Eb|u3?Pm)t}w}UgBaZemIo0Q9R?Cj@?=}kJ` zc$OR$W)`1&r<~JN+gcedr13EG8M2e?iP-m$S-1l`a;!|rYQk-H4(D>ZLa6rJEbVV8 zQmRQYY)V5rtV;@@K#(I%CQ@2O4Z+)gq^>$aMebEMIUR)vN`bbiQevI8)pVGW1+jF5 zx79Z>2S$>?i5(p+3i~^n+T>iS(&K^P_ zS8Zxbf)zTbim;(|r38rSBJ+2fQfRTEAV%6lbeOj`USg*jK~xC>3QJsd3QF4(x0eL6 zZQk{oq@a?8C3e!FRHcu~M#`m@)dH(4Tjp@12M! zDM3=}X&gB#y75GoYh+uYApi=0xF)Dn3e0U*k2KXLQn6CQk=0Fko4oKRh32`w97i#Y zP`sNl(OG?Poy?i7l~;}Rz8I^9rjSv=;ZzmTZYE`&)>Z1|E4IXftVdRj-XldS(5s?d z#;V0ku`ZPHYVUeYK_$YgcY8Mz%1sL+;H#Q-pcblXEGag!Dq5MNQxMvJS`~_|!dFTP zrQQ-Gwgqfj64_NXc(Gz)SWqJ*t&29=yMY~FMYDpzf zXpGp3oP|d4#c86mZ1u8#+nWb9q?mc#Jif9ap*aL9rzsXnn_`*ddvzKUruAsfok)#V zYqymG>aL2LSB$%**ORD&!)3ai3JF0dN~=SD2FMAjwhMv`TZw{T4i}k7&>2XQ2Y|cn zy>02s-yodbp~+a%;m(rtMytyQb|(yGx@E>C6E75|2qukfs8eZwR0mazjIi*%7Dnu* zuWVbIH9nDOD#uDfwz1w=QkIl@#zHJ8xhl-vRJ6S|l)P1fj!Fek7LL#?7N=82?JSw{ z;1)EgP%hGlR5oHnCu&kSZv~?^)p2XOF~tqZFGm|SbWbg&(kYs1tA!i9K;U#!ENktQ zIIF#i?=iKs)jl+TsX=I|qj`<2y%@UgyH?$d;KjJ`(Sn+uG%WbtIIBBN?xbE~zEtt; zB=Gai2C(jDcTF^wQq$W`Uu|A&#@?Zj!rB6ZcctysQ`Ph-kA27^Nt(jcsVnOoAjBfY%d8qEc9D_-+d za8m9SmvyQO^0-kz+Org!v=%zjvt6|nraGWc`>-U zF6E}JbQqgb?W@gBJPzK|*~M0KO{Ze*8Ww8DQRP;=9fz??X0MPi1$G(@!7CGB>4_xS zyP1^`ZdO}=#{_M>(>rTy!e?ga$5*jnBEsFnxLE^W-#^{uIZ{KB|J;GuNBIAH8e<*F zKJGWS=}yG_O@-CR{U2xM^1o+e_}BU?KSF*fM9 zmeqdL&>2(0F_6Z84^u*+uRp3-mIKWwy;F1-5sa|7aWg@IQgyF~3J;AZQ+jAO8x1Fy zTS=UM{Rx*P$u#jw2^_pjwRonN9D9l%jILS!89m9bF6SAyj!ZKnl0KMhk}bMO^RnXqY~b59BjJ${runYzI^Ih zJ8XYvmKAz#;_DW#gXqP>O%k0NZfh>Zu|3m&GGc~xCxhq8V?bW6iVe3j%Q@a<1S`8 zu1>U=c#50yrG~9V=V_qcWEpkpAFA<&hXWn+_?sR=GW-WpeXdwj*v`uZeetfNEXpsQEfB>46~LTldh5FNP2Do4>C54>cW&K|%bn7JRw;9*;8jd{m4V6r@hsPW&5@i|7qkNhB0H~XMXBq0Xzo_abH=wt@xh*8 zv3Aw5(&@-{fkF+WhYAn2=&Ra^o4dxAjgB`-;KOdOy2>`FXnip~w|t@~VB*BCybxN^ z+AL$D_eN0XqQu>3)w9{ni5q}RSHbYrm8|t*qgm4O^Mr1}TBO3OCa0aevqv?5P)AQS z?x3QI#yOdR@zKYu>vm{k%;@X5+NATzYBdgV2hIbiR&?keMCg><(tO9dG!%FmJhGK@ zC1%NrT+S!f7#8-J<)?ffza?4HnIdMs;UjqMWPq{&|u3LacBKpKi#0ul&F2$Bs^KpH6TQiXJx z1*wNcrshYAc!xsiq%fjoD_tne!!Oyo4K`a$6V5wUDI$Vz>BOfa_iGXLcpP=GcN8kc z?oEpHEoim<%WxfY=C>T2#h?=DMD6zmGmR;^_bzs6Yi;9UNJ?68z1+ZmD+TtA2K?y3 zzqatsMK;%U1HF$K1f95_GD4ppd!q+3(E`m-iZF#OE>G0r`S7cvJD&7G$E+0o>E|wl zS4{gJG9_iT(9o)v&{<(!O0OoDsZynj8r6zubSRYg5fBfR|+r{JzfeT`M{yX=sH;l|@2RH}rf;M7Kzay0# zhzjGuTzeFU6<9w}9A`6`_-&rDB$oI(=oT}Bv%31KL zYUe1|l;!O=g*sC~%TsUqwkE`B^_-tL#mVCgIuQooccX{X18-Kb!Q3v2%;J6c1HfQMm??ujf zC0xfigL8EZQxQ1+kJYkh;Ng!Z5sFhgB2sreRaSfuK_)|yS?j}Mw{)lV6;+i#2fY_{ zf)A54gb5c4uhNga_91hL&rwr8bw;hVl@EOivwaVE@`pKpp7^<*_rYI*pHZ$Jy|0R= z7SWi_6R#$!fLG9Xn6ThGvvy$hF)>h#6CvMs@R#^&Qo!_AGhaB z>Kd`e+AR>bsdL@s=1pSzk4_oVbF>IuO@@R<$cp$}en_?N#P!2%^J(zxZXzk6L8J86 z!u#<~i-wSY`0l66^umQ`N*oOA@ZQn0ITA>wr7~cc@l5Jgf?!)ML4|e-%rJ9@*0|*yBEa*vY zRUta1H%d{u5s6L{7Vb8;id1GO87ubv5GQbm=Q<~Wk`J&9&*Xv%q#;0Y83I7hi{{5S zJjAy``|1cL+r`)CYrG-)x#P{4DnWxq1fqD-(L+!4eERomm7~%%^z4>L3Fn&DTs!rz zp7^+bHz!kmuW?sK`$sRIVEVLrgC$z{-66>Lr2Ew}BZO4N+ys~~Us}ocG|B8M=N(cP zj=ESoyp*8Xxt5+0gk`9m*M0q~T4C*xecR!hD-Nkyo-H-HGo{;%4LV#n@J{1`?@md; zb3EikxEI@!tHiz<%M@xM^NwrTsG?d)bWPCpD(2ML@BtjQ| z_`;(D(Q{Wm#Yq*sxz^lAu}+%(pLgtC-TS%hudDijVT?8h<3V1R`Xtld_q*7>_gB^^ zi8-;E=gHP>3p1H=?Q`aCaxb%Q?Kchk6IbU@{F;v1EbQf1efGncVO~r%zzd+&arl(= zX8c}0>SHY3VN{c}MIzq%-Qt=}4>Zt!SL#z8XT#6cH+*ghvU(L%#1R0%w(7mzT z#d}+5GM2gBv%ehgUsm>Ez9v~!bdR>vH9rYYz$(-p(0Yp{dMlGc z%~&(!1MGB9Ww&5@b2Gu7ElxwJ-6lq9iseq|RzGIR5;bDM|*1*4H0!X?H&X#LiK=PKaZ z{Nvn+f=P)YJwjOqyIjsha^8&`i2M>)ZB`SVwxQyaD!Ry8qI9X}jsx`&j_Oh zoe~{G+q7R-&Tr|w8?z%K3Gc%msE1_)B1*nX3Mexk{LAr+assJ~bSuqwOl4s4Lv@$* z8nc9g_!^{fp7=}fiq#PzN19Y~Be!*84=0mX)bsEAm%nZJRlaW?I5k`Gfp^y;#PT>}5eG;6ecIm@t z)==^*_XT3TRI^nOF(V$%b-ulsMNhDU@bd#B>cP7|1uvpBa*dvsT&#rzK`|40aU^lX zY)b@lyj%yDP8f_dJfr8HpDO#&W2t)~PIOa%@+K&RB;xu`r@p>_*Vb=fVA;p<-1jin zXlSpwt1x6yL*Ak|?N1c;%SO|@?KnFdy|X}fKb&RkdeQE8y`iny^;outStiVLEqnc1 zwOp%xa566FVfM69Ody&}j3d+3s8(tA_;+`Ba9$Pj$a_5wX`y&!-!2KXQs&?_@bDTsfzsh zZZaH`(Kw|*<8kBKOot@YOHy5$q@ZQfZ_hzxF>0xGhVAM8sToi8_oR2HVoyQ5$Y5zV zCXJ_ZIW--_%%)Vxagso~^nWZ`Z#+9waRD+1D`~m;anf;rp)@6LPLn2fW2G||?$?fa z^vfjUS;IZ_&n~omMjUe`Mr8B$^T%nF^|3t>MHi}IoKsS8P5n(}mS{Si^rQ}{u)Db~ zO=V=$jxv$$w~ovszqVa2Y_&@+UQ?$DOG!PI!khX>k!d9VJBlbOzZPbW~;EMqq8He7CPHAFkR#o3@fj@otFQYxEnEsDX*x80=@ zDCx^Ry<+T?c5y217j_9F2$;cVhdfg zp+w%5k(f3C%Lhc$nl4&v7G@mLCDzK`or5e=Yao-ewyl<&N#5qn*tF(qLgkEr_+`Ly zovyKeIkOrV&OTHug2H54DHa^^QdOdTKdl?o>X=oLbf%QL+AF|U?4A<)q5aM*pT2Y| zM(&29{S;nn%Fb#Av8@0&`ii!b+_1peP)~|I2qGYcqXDqt0kDy8r$DY9_wEl z$s?mBzKF&rwtpNUjq2OqK)Snr#wxu@5Kla*fhXBL_d8wzX3v0O2|~72Dd)!(W}RS?&ifT;Ri8H%C1MIy zZ{AgSc-T-NNarP=A4WYR%&MAn%IV=J!X&zq zw`F|;#)#x}q-YZTwR)-x_|p~F(}LN5S-3;jUUAo=oOPm;My;(cyWb?_eGf-Di)^P1 zDlUyrWwoO@K13fjSl;O^5tFF8nngSa?^kF`0lpe`U6}pe#C`l|aWIkKtlrNEWHcZ} zOby*TgNF`q#~xGY>ph zsf*GSlXu#9saOE>Nv-%YCFScPJO;YzmMV7Ko#X)X%1h*vSxMO%HodA~H17YbYwN(q(s zgqHkjs?VC|o;>hM#FCq7Sd%K3g!#E!DhLu~B*k5Lb{47~Zi1@{VnRB9+Y(9%Tl3w* zLn~k;wj>+Wii2hfpsb{!OnB1q^1J4=fmeFfLYNR#x0xs_4@99zDz#kra(jta3R@D! z&;?Z!B2Y*b^{6EZtS<24k8H?Rt)#qjZE{U4d-q;6Ijx;rDN~JMNkXU+g-|l0f~Yc% zSUrL2b>&UlDV^|FP}UZIEvpzsV$pcb4&T@#cZlQpHr+;_qRc3r&pZT=5s%3L4#gxF zEi~a0L6aCJ5iK28DYOZ`jBr=mO0SJp#I}YeBnp;=3`Ie8wM#|mahO2HEQR73R-5R+ z$|+G~WK%?Htg#L3tP-v?>2PRE1PjgFrB}7nR~%!UGJ`UqBq}U_ie5;hm}{jkFDkIk zy04n=$KN}e+SiRGg(^W&2?bWG)~Q0QR0%N1+B=$4Fca`yl4HZ$he_q(tld6jvwfN?=8xmpz&#oLrZD{doGY=P9eOQP=KwVd-BD>T_)>c~Jn&z5`2blSUe7l@E z2_ibA$-KVF22pSz{EOF8Aomy@)7gM+LF2ktd;*^DhR%$C)eZq=RrswfdUor1xe@Y9 zw)9;R&%mWi@F`OKEAf2yclP!mh;+zc>op6!l59o0Vs zZ#?VQdH45!C76W#?0|Sv-bPP;MsQxwBUs+7?|G`%G>{}HqFL?Fwup#(q|h{g?^WTg zqH6v32YxA+9*bn)oi?z!ABTwHjdVk9Ro5h@C|Y4a~PzbTbCj%*gmH#IiV2 z+s=2LPPYgvWcum1VlyJgaZFY?2sexn^>R#kw#IpErt%EyvT%qn*cCrCm~+^+KhYaFKJ6 zv#=u`qcby}ksQ~KR)5)Cw^X~<%qkoc915T)s+E5MaA0Vbc401C7Sv|vy%sVeLOyVl zdNd$^Kx8ia-g?Da&UlPN>gX-nqUFOR?M%+aCa4m_tocvo+lI751`nQ;M~p95Vy&ER zw{;?tuQ^=!scVk-F88HZ4@amHC7*bSayt7}cp64j&8&s4a^i}k{N8>dN9*(Re+>Tm zVT1i-bVM#hh(*Nk0>hcydcP$e?|CM|-X8CNq4j+e9Tz=hnlR1$#CTO9iyaZ9A{w8S zOUH!?t36xxxN&8rPab4S3cUF|dG>a;Eva6@o|#5Yrc+?(r@oZ}G5xKRe6y=Yg!(Gp!XiNMAT$oc$*(GvPmK9WU zRF)r?#!#n}z7+UQc;~CAu&NMmE>e}<9VS^uf`)R+3q&M35offbKtuDkK0OY4aX)9W zSS#JGwAn!8a%?ZnY$r=(a)4Z_>;(4ScExgN_vj0n8BfY_x-|*r91v zQ3av3iKn26xGhP&tjfcX$|{w}i!rRyPhf1zrIV#dnbuB?h)pE)6rb{&HGu7ZF&j&Q z;b=u0xC;-9jwNi>q;s#RPHSRY0L;})p8D#AS(@U2s1hlIJsdp6} z1Sf-4+3i;=PO<|o@F;V;S!mY5heUbPk=>7S&nI-?*6=Wj7X+~k!Q0umx;f9o z=k9^}2i|CBpEI2HV!eqe7*-X3qv0PfKbcjn0N4iAI_;t?=Lf%Zy6YLQ#9f_AuFaS`{6lh^-Yt5IOPeHI)&IQ5UHd=dJ5sjQ2y`C@$NC^DfY_wm&WKUol+pXOq75 zyuo;Ca%s-pX!ma>O&(7zpm!8G(!B=@;xBVRChG-N!5lz26MjAs`BFdGQ=^_8eu?*Cz^a89yTM+ zCZ{>SJF0$>65xj$-)KC4r{)XR?S&@Tsh;*^HMOxv*F?(XNd&2$_txe+9Hh<|*@`f) zQVKfS3&UolD4E%{6b55#MaY#gSuRLH+L=Udn@-pJ;OjyUcs|D1~yYkP`fLuWMC(oA~L~FKdMGz|FU58%xwqDexSCamJ-CKEug+MCPTCWeD z{3+M6?#)n?Rhr#W$_Ol{EWwDH!C0=ler_Kkso||Tyl{HG5%Z})ZkOZliRG2;=e6D~ zCZs4qct`@h>)qdk=wmopp494=u*O3E_xb;-yYxP%zRBb@B?^e9{Z(`KMk{sX&)Cj0 z^s9nZkX1TM?YZ`U79a0cqiKUsy?oNr&hc;ukmla9+Y>h*m^qj zVm!60{WM?Q5G8|DM~G-YknSI&pOD=9NWR36D=|Fnba4imCWR^xt!=?Xy$yWr?;bZFKCm?!8i9R(?Ig zu#==v03zpV$mox`Dv9&n`}eXI8mp8+t2JZCY$NNHb>=b$hzB$3Rsi;L(X=d5qX>jz z`uCEDFMAvkr$K%wb5%XLNZh4yaUF>umj?s)RN2gb$l2u7s`sl}eA3^s&g&N?oz~}`T8X-0;_=0g;CajQe5t(*t%ooavF(BS|9+pz(DxU3jS1{b zoMXg}BCua~!BMp1h`vRCheKQC#3Ss}L4RokZ+XH?#Rv;Z<(6Ub zu2|ke7K39U@OY?krvqSKfG>cTn!-RTKHQ@6a{W4$||{tLBzscj^>2%VTb1j|)rCvN9xCmSEc8+0x9h-Huv2_Vu08$!_)&(@!wtT8fClBs+&%B|= zj*NlTcCQPjX|mxPo9>+3rIV6 zj78X;|BM>m<>Ck8N-hq}x96Bm07hTi+WQoHyJ+!LRTXp%(bKs&+|9b$7D_pP4+>&{ zpsb_~$AZtQR}V$jD=b^cqda(d6yD;>XILSf_>-FKChZFFNpGKkkO@RgjO2NWXBhmoHO-0o2NHs z+et{l@lTR^r!FR2Ek~tkadKQ&)o7vapKpc5hAquyRbMYjzrxO~T8i732fb74Kaj{N znV0&G#zpBqcoMqD?~cxfsTOy*5q<7}OZl zX)UpMHf%Z>5{9y+I5i_W`czw&+iN3|jXuV@`%IM1fZ~MqBRaRs#jkf=fn{#)jdOap zARP|_tmY~+3`J$9djq^vyKU+NRo+TG`#GGPdaWd`TBqHmZ%Dg%3TgtXTM@nBWjwW) zTaRZc$M%y|yyF&NJe`q$gk=R}5_mPLtEkG|+$EfxV^Z8jXjg<|u*0OOIwtP347g1h zo;7On`#T=r7gL701Zc_`Vzk{J&kCCI(xQ8)po{rg zu;jiY71asXN9c|t;PB@&H;gXeL=S#f74jv=c~-sTc_&CDQ38*b9?vrjOFj>qtJmpQ z#DchzNVpJxE*$B5eGFKsyWkzS+|4*ejsAgJUj2q<`aTgR=VQ40xL*)!3*JdFajoXlK7Flhq zwnl5)wMV|xfv3b^8t2%|je$}l!J%4JE(aBo8J=5zCB#dCVZR2B^W7}k8rq+FPa8SI z1K3TZh>TxAbsq~k|zn* zsJ$4lrgS~j%sAhDndBH$8AUYEa|ZL3RN_HoGbY1>`n>%^_qmnlJ>-^TO#N4=qxd$F zr&wcu4%`Sg1t-5)?Skv0w5ANGmmgX@lU#@+RC(vo30#MfeU#x(a&s)rI$jo64_7vC zv(0asB~iR?D)!nuP9E=(Hk$HJJejhAi89SfhKp`>N~fZ$mC5K zyfX%%`o?MNcU?PlJ9kfNGnaZf*%tCm#qW{2-xiMX##eIVoTmGj;(IOa#@7b7lG;#H zpg`2`Jh6(NHa*OdTw`wV@iZx1w`OINjUM%Bf1#YJ=rYH!5r)#_9bb8T7>BuB08Gm;#$#XfW=&To{(lW)I%`^_$=CBVxJhuOR8G9zvG zAW&m2y*XvojWjS!tvZEf#N=!|(^_#A7)EV*lvg^5p6yEI4ss76bI}FX3A@UQjORn*@=fsiNgAr-DyACR0prf{oF=0M}NZw%$FN5D)Wys%?FlH9o|y z^}V}0U~jzfBq+lC!3o|SnqCm_?QnPaDedg{AJ=$3az3$nJkCw@{37`t<%`Waqj{kj z+FZzXY873?&G#cw!QRh#-ftj|c_PnYe~Il-=pv~-?C%I3;qMJqBf-l+7&1AEz0l{?}*-DDn*F%Wx+ zcH-mjPjMvNih_zgJQJqEX%1<$c|+(`S4I{&^pMfRUG8-mUh*x)5f-ox80>NSZ<%B0nd?HId+ zTxqJ?(KznX*7yjvY#f#meK;)r26xe&*gY5QQA;(Uj1vI0xRi4rz08%fa-hiP3z#bE z*9nSkZ-(x-hOCIRaP3}qf4^lgM!#)-K>ra&hDp@Y7eRQ#X7egX6D~u?L#kmn8|%G4*pwc zK^qq=+-`&k{76ZhTrZDBKQn&Z{g2+SZTfO#$GhvjyDQvMCKA^8q<+ts{%_6*`SPY? zFjp#jDKZK21rZnQ)%DdlfAe-DHumG^X1I0%kKX+rejYmdJHhVFdMNh^_aK^<)-iM` zntH+zYE*1V*&0m0k!wM$wRZyb2#F{vS?4&WvX9l*IaoW6p5c0wp2f*t1V!ZYfs>YH z2o~It2Rpf?!6xGH_hPCA`Kz3PDc2F1=T<+Sd>^=0^l6W&_kLJXe{N#FOv*w{sI_6_ zU)5d(dNyG!RMh1&ve~#_C~;kV-)!eT?(-wH?>ogn^F3cIKu!vuoZG4y?jbU*r(tV6 zzfRfba|e4;mGE zb2RDfWD{HUa>eQ?vQ=xg>Db$i%~vw9;oLWTT@(}y=Q|ym z%Gt@8$Y}Lve{@jqAxfUwiS2brh}?+2=+o5{hfT1CXKC4ph=W&K?e1gtbSKw51U->GP%8jXf6V(3#CuS8D38OpUD%&wVZov+ zF8NoUl_C#=Xrc3T)U*GvEP|k@-M$R&CbN!-u3*< ze~Uulb))GfwNR+|22wRyc2+DAWnJgU11X*MYK7*j&^ZGQQ^@1{-2Nl`@`RP45}Lm? zde3QS&ym$iWgDZhueN{}$iyr$%b0D|Nzg zbCY--ZzNfi`KvxYWWA>MuHBK@W?f$_%r&|C_JoMPIh@`rJgQb1e+YsSS5L^Qn3#HX zW7WW8+`@zdirX1Ox!-UNK%a2k#O`#Y;NYE`lU%{shWP6d-R1!L5#Ykfvi7bn*jO12 zJSEP`$mQ96(y+C#(C6&%#+*G?wdPFs-lfO1f&~2YxM25XI`$4Y*cqoTf%VqS#unVB zcA@KP`EtmWF=&w~e+qF)wNx98QnAhpytX!)H&~_Q(k&btiWFwXMuba~t0d}?wCUlN zM4_{=;Nx#*Q0m%MY(ep$whTaHzPc+fC_LeB8ceWrvMs1p?{o`Lx7omn!85~% zwKAjwGTm1w6G~}TD*Lpn9h0XmIeTzgBUG-eO^gP)=H^3%f1^d8>G#Um^M&E|# za&KL1Lbb4y4R1PABp7<}3toA9%J+kp-ygT+(%&KtIboa>Yi2vi5Ort|kgl-kJQ5&I zMb!3h-lRR{L}d)05v94f=4iobM?suN3uFV0Cxg^7`@=*{dM3qDL|HZL zLP~L=bLa5+{UAR_)=-b0`vzm!>_@7gI-z%y^Jx+a%~JHVLc*OfcM&8&%Yg6a+pmkq zBCu_7r3%R4BWtlcQ!oup3lK#5pe^sS{k<*C6 zp;BTcWM)AffSLuo#;+?yjZ&QaLi)+=cqpGjG+jFS`R_>GNI0Nr>yH*qwzEq?7pp!w zbYFQm**$pZX|^ThMLN0K_avlBj)f83zdH)D;|mFF6;$HwiX*hVgjH2)5#5RE;)`I! zY1Z~Z3W>P&9IGU)7ee{u7eZB#ui@Q$&>hRnUJEM9yHNT>|z z3&kYbGbVKz>Z~V24v@owhizXwk#Nqj3r`egUDP}8xuMII75LN+jW1glgxb;{gU=c8 z2S!M_w4>ivL3cE_+8jz)xjEQ=9&E5h8LaPARXYTcSF4U9ys3QP&7JR+W4x{46`c`T ze=xD~s>oW25owI+roJ1&ida?*`FlP0o2s-bkBf{)0kJc<=ZD1;)8Vv4w~>aYXg3iM zEbj!%;Ti>|%SMD$;?Wu8RvqJyFP*Mb7^8OJxk^QxDkIDpY$>_k9=R>hL#rbWx{RC< z#FH7U6zI*8Q&y5sans2;Td}huZ+aX} zkZ*&e$;0a5?c&I-MeK%M*3|YRlJ7F#R5({HvrB@?u&$mW5{-s*F=DV96^GF~e;n)` z=G&6eh=5i?XIzeVDm!;_uC-_@m@_$lk;SVaJ7!%UgB4{NrNHn3?z(L5{p->z z@S*I!)Uay`d0A-sv=!EYDAOh)e>qYs#oKWmZCqD&oIBszkgwUvB-Vnxt9^^O?elkI zZ{A5!#N)&tu~Agot)*EC-Ze3mP?}QAGf0ERp`qXCi@Z@ij%PZE0Gd5c^i~d?9w)L* zC&6ThCVcr!u+5>$>*L32ZBBuZO=)N;%BxqNu&P9uR31=tN+4q*=U-JZf5!Y%5B$ml z{}<(+EKR?}A|0u8olbL4V`0;;(xHY=`Ze>w}!G&WO9cXNQj$?VE)T1+C&_0HfStI5>y)v6@hIUn!Z zvwSlPnl#DfPcs8GF5vPbEkN-cD`t4~fS4lxhxJr7$RtFCwNAf5}>cR(Y;nhbrTj zma{U?0+@?KRVj2ONL4pbP*Bwfl4ik!vSaxN@&7M}oUHG9XWvJ)O5tS!M1@s!rIcdT zPNh04Zz4`>$5g52m8o2@_|+vdWqmK{pJqLXktc`s=00G#%yB^1;}`ny&L6FEYd+TG zuc*^1%zZ*$!5V5De|)$T)05fV+VuP3rw(ZI_7Bn(9FBUeXSWEa5$T@M67mE(k0g9Y zLYGuIw;*1}-VN2~6D@rtA)J`5wU41hoMx4*dzYOHpkpTa)tD7;W%X+Bm4U;6A$Yc- zUjn*O4AcY7S1%sTzi+(h$T`xZL6GKS?M}^sk%!-H@VlDie}j#w+nUM2j|Xz`&)wVk zutgZz+&>cL)z7KO+1lY=n%81z4V`-Hlvt+{g;P-HTAbnPx)SJ`Ck#YIV2qNQ`N@0X z)Up1>@sZy5rexK9NaZ0>hn3%I>3kh}XWm}iL~vfzTf;Lh_}g9a!!yoHJg#JCZ$=k) zH~4Zrtuie*e_~+ZJ2Q|QH6>bWfn=dDFCeBL&!xim)%BEhdv|{Ob0-}am1y53snW3_ zBC-tDj#s{}Htl`Bbt-x)#Nd1uZFK}~d=5$It`rF@N3rbkU=PcT&Yp8u0^e!QWC~Kz z%&myb3j0Lw3+a-Lw{tI0duDB}EwP&_6!-07!Ji_pe~9amMm-+{B<#xHl8WY4r&Z^;d3!T|HX-M8<+J%>d$AwwOxd(azJdXjN0g zUe-@%7HtUu(CqBx!6tz@Svk}t;LwePv0TN*oF=R`T9;~;)aSoZ{Tbe!r*nDW>K#XD za+eTk312SooA*v{dqV4#^Bw7ouSz+(Ho!_$h&!3o#jxD6x^&=b~aFhH_2} z71L_>#kO-T-;-ElH}0{;8>R}&B7`xldy-rdie5#;HjZ)(wqmcaUQ5d(mkfyKp%qd^ z=9%M~LGY;WQ}c0HtY>Z@L>~(yA&ayqW(cY#m^6Odt_B$pDrWiXs%wjvLiB9jH%J#( ze<8V>t5ub{G-f+aaGlC~Q$bgIjbWe;6YxJ`UbjNw6b~in3)OcmIL{{|stG@8fzH%i z9Pe(s19Lt2cjf!o-ov%&uS=b^LQ>jyu4+7j+C=mivvh?E_C`*MH_|!9C`xAuI}D2x zN<*Axc@aYh=o0SocssW+NtM)^HyX*#f1gG2{(JK{CqrqsINnamJ#grI6#tuoaM7~)!cG!ZZ(R7Qe=lg$b#BO;|)7OO0S zcprtYm zq8K60t;n_Ap10==o+eap%owgt*JC$oAgejvt>Y}=VD7xT)s4)!HCB#Uvl*-^@USfN zJ3CiBc-9{#%%H8cS^=TCm}!NOv9 z5oW^<#%`_TYqqnucWFU82Qu3Li<@+!F(B`z-dt@6m&1=U^-!b}Jnpf2XBEOdP<4Pu z@N!=wuzOR6&CEGf*TOfofBKemAzUN7JQq&~pE{4uKBl%$P7SDCy4|csq9VmHlQvWz zA=U?+w&&a_aQ(a zS@Rz~`q{{M_w=*fC}r6PH)3^rFO3&ub-lx#PbpbC7UPbQMj~TlSV12+_1aPD8LBE` z!>W$<^j!8dCJVLE8kU(?Ew@CRo3;{yHibvXcKr9@^7QzRaQa;8C)yT5M7S5mc+si! z^vxa|Ka2c#ProPKf4;uFBQn&3HvVbdb+dSsw&g>eERe=bin8FnITc#heN8Yp5lisv z*VMk*_!54kpHho(e3guw?XlZmQSD06^wT;TXDHD?iaXxxe|cD}bg@7x4Yb6;T9tvaxE(+&A{#Y96lug z+8U{WW~ZJ~<^WC`io9e#wRe`TsTyk`koO)=>P<B@^8 z8uxU2LT4pcyk=X?9EL0HS(PP(Yl_(vOqw z?)M@NLv&mSdl3>j+J#4B-q4P8ZN_1s?n4@>czBBT>(!gc^BUcs(d3U4n+LvfKV9@2JHo*i>&jk?Bf;4s4g1Oq zm8HSk?v2>#6Vsdt7DbVgIf1G@|M1B1$r!>DivnB zf3VV}L_y8Lcy3}3HHb0c(yt?I-HYlYr*(8_;=84cZM@E%yBHVN(06Fgwqhr046(Kc zPDWmw94_OdVs&CIt;ji!? zYdb^AJx^NlH?}&?@yE`$t9xn+_VyZUe`ERBha?gb9&9hnEbnMKx;mx$BI(_B| zhbFB@jsD|UIR=WGW;wj9#RbxbD~DGbVU5hbp$t(6+f%P`Zk}bgn51Y& zZ(OWdb72imCl*4x5@p!{>D#-$v8e0QnM^bpuI|lGI>B8t6X&dM9B!ey8$m7xe~HaD z`(8o3b!)QKWXX6F2@rX!-oDic91+n$bmN(SdR6Pan^t|ytMmjJ3ROL}uO1pzpkYnA zdG3qRZRSwY4M{^IXncKPdpogyc9f<3d&pglCz(f?i>8vBhd`-wO;efMo}9XZUZWhE zBM0<^$1(o+zF0-*Z^;jWo8ukrf6c^peh9CMBtCLxB1FG%a%08sByB%4Rz#p;;3Z0N zjmT_X!SgCI;mV=d@pdKVNxunxo|7*4Pk}~}7Ej1)iUzwd5FHv#+B_og!pd5ogRf2S z8HjTyB`rM!iCfa=yfmG8N3p?LEep70Bay0ejl-uJ&fj)T>BYkPUTo{?6=Q|@+u=E^Ts;*o-r>7>^Tbh%46|4=lpjA2(+1e-%@~ev-T4)$Sk% z=5tlcf>bxJtx~*iE8USL@Mj!%9^ep=w<`|V$9DNSR- z7I5R3m3Ji6pkszxe@{wj>jQ79+%@bD#LbQ3P}sO+wq^5GIhIhU9Ne6=WM6oLcO;1I z#PaV)eaQEsMst}0n==9Oq#ktxS%3Lf5e|me!5!6;2&7OnpX-o%O z#D~cR>hF^}J>Pxj-Bu_K9)t4Ys3J;{qW3s20lU2SZ}WHVv5CbYx${%^C)rjhZD!%uY5JDROZv=4o`?52Q3aRAWRGYA`o53yt zg661=%Qmw%%S~z6SkqfdyKh=1-hE#U#ocB}xl0|^-)R|O0AkTv# zR5RHFIdjzoKZItMw&A-u2$}6t1S!eL+OG4WhQ^8Rey01D6bMu67yyw$D2=r%P*8D$uE= zH$H&se|v$*?6@DokTf&Vi|u+wKDPp#UuyLx;|3-{^Q)Gpy+PNcHD)-w_>JCnJ$l@q z&hHfvHanAZv8NYf&~R}*1vrKqhdr*Bx!UP(mKmTZn|4E!uYUTg zm^(v*woRw!fLOC7B_&0ru*NbmKcWZxKjLZ9f8_f^*QnH7fdVv7e^E_I)1 zJ6Vers=HQ@W)#x8fUK0!Ax$+Bmum<@5Tna9=kGqhKO>AhMdhI!o!^sllgpIow|b?i zKElFQ#{+q_9fCv3stXEiRf=Aau^>FHA2Oq#-Tge(^@6;-_k1TJ7$DR}ef49_kl*m5}d7JMAaJLiGmdh^WBiPq^j z?|SvUzA1=e2N%KTa1Mvf(5_gFLNn0wHa$)0$%|*yZ?i-4VxEZk19Bu;6+HP6svKS_ z4=0)D=K4E=?LB1yBtM2Rlka?Om8^8e{q1cZ_#7*AyxmY^uarUi!eV&%cH0t6wzp|osY zX)49aDiMW%m`_XK?#%lv*!G)V8AF%J)_c5bq0NS@T6>=y#CaWVTU)m8doVsjUh}^P zLuXEY4?Q|u0uXhsv?+|Hntnige;(#K&=gEZ0-lElx%^qHvCM8_kSy=JV7m@Y!*k@| z$HlUn-MYQ)oz0C5BTbl;`W|B@%pI>YCP|YfCjZs^r|9{7u*#PuX;_+s)&PV8^m&~; zL36!1^>b~$t^XJMUS88Z6v->sJEXe0*(dfN*nZ*qM?io`@%mbQtG|kOf2WYymojt* z{Lx2=+IjR&^1XfU3NiJ(PAqc`F6PhmhqqJk(%To^gFN&ur(3x|Nh&n*Ot}V~w(Yh%c2?|WyRP1sJoC(x8q{rD zlI2Nafg^zvXc82OsX#$3mfhU|=H~Y6ZFfu1<`-b|R3M{~IZl9L01-sXyF)FeM?s0E z&GUJlP4I3tT3frVTGM}>t}xEKyzd#wj`PnmJh~;R0b8}Rd#jcfsk^B+cGN`P+~)5) zXKveztl6Bf%SEt@F)e1ZH+I8N-ORO`GdE_^6H{&5ZCf*0g__fL)<$b7y9Ka^Z86T) z%y!z{)~zEcNdgTqgdG(TOl%Oy@(-5sK%w-T1i6T+DXv9t3Zs{#<>9)0Zbn4pex!j7m)zLX4Q73l6 z1Y-(i0!<;hmrks1*`sz(I<#fw=bfGA*PXhwl4Y{V+tTgi-LD;T=S#O6s&?%iG*cRB zrkfjSiJ^eOuoZvP6o?ZOsGLJ?Hb&Tr8*oG$XdNJBibruVHknLKF{naBL8##z2FVmE zK>`|)vY4c(ql8h7CdTR9?bizJ+n9B_<2$ljytTV+&MwmA-L;)A?(4B@yK?MnJ9jl3 zcU)HGj?On#l-vYv?Ut)Csf@yirgrVSo2zi$*(RHCFp(r!MI=ZOnHhx{6(N}@GFZ<% ztamBZ1~izKHiQ5xa#L-w#G_=OVvb$HTZLh05E$zWr*#y_t=em$BD|(`yzK1mTi$mI zt@7K9q|kp*3Db~m3NW&w5GdF?QQ)o;P$UA9`(@<&&vE;RP z1UCfR2TmC)GV!!4LPQg?M%rjewvjD4jjTghVFU=Gt+a|TaDsq?9!qK{RyNv_HwM_K zQ4ADuIFv9=Tc)gLOS)F26s}0ZTd0eY7&8o!xTJq-*0E~B_y`~!4$Hmm+ykv1(4w)i zNO!SE;b^#cny&|4(WwN=8W}W*lIo}HJ$Z6vc+h#x5X$>yMlSv7rp!swE&vEu2{yU3j zqtURX<*@9WpOb^r*8c8<uXZH3&{L^4LGkLv2;J`Ju$KrWENzEfq=h%Pg4#z`GIUQsy;d%A1_Qr=yD^y?8T?);N_*^(D2@994yIVA2X=Z{seq@ z8*x1jURmBbGBY)k)WNodtr`Y610t?td!FQTIY4~mo3wGuC?;lcget*_Tis7!*`0q) z-cE$OsZyVVc3cb|rK3eT{Okixmn9Jc7s1f-%Qsy&ciio6e!6}D>2y2u1HvF0->VmE zi%(nXZtbWBLl1TKWfPWonAT9-5_?7${-%Jb-*X$H4d&j;9%dW>11=56#1#%x9|L&__;jqRou&Ld7pE14ljmr$^`%loX>&1?SzW1ePCeO?hCtEJjHsa=+yX}8@t?zHaobDP-NK&@}Qk zI&7Fa=?WZG4&p;62YCED@G*K_Zg0-*Ivpdi!H&1J#n29dF)&=7$Dn_BH`406&<|tJ zf!C2kGuvCUFA;Ax=3c(syxVszyzQi-1(A8kT7TLeRb!wW$}txLeY~;cOpoGlru#ndI^wO+l{{24pz6 zI$FSdU9OCk!}@Y^ez$)IHr?Z)Wr~uzJ|8wzj$+MsDHjeDDomPl@@@&VB{3Fpn@%QY!|E3TMk!eUr5e z0^|tw2cJXGmVRDm_wFA@SHbM`_PTo#KbKM%mua*n4x6^P6ytvo-f%mHo(~U0d%ma8 zpvOJ!kQ7Z03T`<#y9d8(={d7$x5L@2_emm=DNHgzgA$1@7*UxOStWm%Q!-{2C5C1eMpg=BWf@>eBw->+BO;K1?hVD1L=L^%CY~Otz1##D z1EVJq=F%z%JRAo4SI>5cMnr^Hpm(_rhr>t!smICIJ#H=ErLC@Gy^L}jScMS!xLB|_ z9=qJRa>EB3gb8)&mJPQp2w`-VswizXoX*Y12h`x;G~RzSy{vBZyqh;0J$Gat=8X)y zl1A>KHtY+qr%QT$4-^aOV@-hc4lXW@?+e{HF{LnW>eL%>bh(BueI#_QdVScCozMl$6DAY@Sfz#CsS zfFsoPI3uL($+4P5Hl)%?Cnok{YYo3?LE7dWy4{ZF!SG_fA%+ZTp|F9{$FMaT99+m@j41BW`d2CR@nB!~F zLvj}(2vK5!5NL&pLXBnmy{utEeWCiMA5X4F_5aoXV1xc>|6fM2qNDmf3?=9E z3;RrQM*mu-79gz#OG2abj=YINV!*re({Hq>rxnaU^;lngDaON$V$LRl^Yov;hMh(E zv$cP9*<@n;?tQjc_}xj0W1g*hMbNK28%)06!z^f{2V*b?rPzyeC4|gINYNO_P=5)G zWz5X$5U@olGm5NTVAi=SHVRrQ#Kd6DVFKo6EJ~O%%R$shqdf&WDu~rINmTbjqlpPP z*gq6%&=nIZ1|bo$kG?fNLVZ1Zj3K)T+@F7cJ}D4Nj@uBx`VgNfJPrRGF{3%+>pCGR z`0CJGKe_hCPl?qD*R|gVW3c$0u_R<9BxcRCX6}6^_ou*K@%a2EqucrKOUiw{=5!4R z8|$m-hoVI?=tJd=?$DNPOZA{Qg&H*+5@%-8uSA3hP$aDr0T0k3b{7V-Ub~B_t!#f1 z8+s3z}rcXd+QB)N{MHNLgA)EG`iec`xtQbDBp*p$OzJ28IN~nGHB}~vU zpe?0O&-Mq*e}1lrHsG!H&1Pi!!v&v#Fy6fJDjvG6yWeg!8hOb?gL!bheV z?5-AG*B0}+sCi^)EWylTDkWJ=2n>H%Q7S0KkjBPpTD5iW#dWKYx)wYyw0g%*JX&^Y z)Q&4WOpdyY5?83`x^YD&=q_@Dk=9kS+(QUk31ZGvXJqV!L;PbJ(9%@Q5eem8HrdRB zE`&`KIakz7+KpSY{YBF?ofyudsH!d_cJ{GpLtu-z zRIZzykIJ3wLnu2V>^}|1ce?him+0TP=-uvD$qu&d5R(f8Iu;)DE~bBZ-S4Q@-jk;x z2(#VoA*6aDvGGHO&SB}T3+GWbCSL#uVoaF_r?#+oD0@s2X-`I#Gz+l zH>1*6KE$btgn2)e$>}xDpNqmM*8c3BZg`oJMxw}t40M}mqM;!$aeK;Pv*$T}BHWIX z-|_Y(J|~ZOoXyce$L2#QX)-2c5MWU%8&BlVd7teb&9Q&6U%cWf;E`L71jSwm;=qfM zSvVy1UHMN`4ROaV*ktZK+}x^yoJZR6-u~x(!+4C%5=VfmOoaCa z^||-STyTFD>{2ifgjoiBB@^{Pl}!;VqobG2T~|Ef5>o^XX{e~yXHV^zg;Wh-$w!0q+a=5i|c@LA{G~z;B@)Uf?BbpnHhHb++rb)G_ljpCYaZtsvPjZ8xIT6Q7Z&Og^u8lpa-T(E zhWCFLl%SB!t5X7?cU;GojV@jjL`O6wHVvWB>oS`_$=HS+xFOnFS+9BR?uOq&6Nw#0 z=>swaNT{fyRSxmq^KMiL2v%1fL>TuXn(+;ZOEKv=-a{uNmm|;jPcFqh&uEGIe@=f# zizgR{IlDrJ{Es(fjpy1}uRB`vjzX%w&eO&Rrkys&@-4k($?a;Kc`re|WG14_1Wux; zxx7iJzhRD7X+1Xky;-eKBf2j1Q}cQ$B+#3B zB|E%!sTnwV_fhuTk9yU$0i&$*uJ+fqbC zL_rY|5fKp)6WQB;1KclVG)yz&h`6}=HzCcW#5SSy^NSrwQ}Zx-|6{EDYukS!B5vA= zA|fIpX67PlOod-v!^fL@>U;2L)=*53?CBixzmDeMAfyyzGRmUKDx zWDvTf(b(ifp8GXwW(Mn zKE&o$Wb<>RP(*F*Kquwy&Smra1-b7P55Dw`KtWc

`|#>@MD`;8>R%V11K|j^|VK z^12&;dKn-$6UWh`f?zWn+K*U1Ay(WM$2)@N~N1apNd%Spixy~EZ*>ik3`BqS%d?<`sp3ZkgE({fqN-dm*;?mGCJ5H{bfKFrMv)1iR+#%98c7>mcy zbm8M`Z0IUlI66?svrC>OS%Ov;a)?d-Xvj!H0SFL)vUygIAvS-3?1j+nMKSLA_a_xP zv1o=6GWJ;es^+O=?;~rx+b1^~( zbj^PuMgde+5jGnXTJt7qYAh_((KN!y=0AA&*47VTKr3p~5%wYR0k?0rv(pV(a;24#YSIVT(BI zb#WpeJD*X{2?+@a33uQbT)rkSkeK}MwhLuiwQUzL^5r72Heyl;M-vtFf0m3!vokd2 zIHALoU3%6jxZI-dK?ELQp$x?N%^$0~;_Lm&Gj??DF@%KYwB%8C@RL%Vb8I9CK!gZ% ziPVL!FU%*qIGq{(2z1h($l(D|-W!v0QV&3(IFvsgN%mm8q`KGh8ByWkj>mD#T=`0r zue$YzSXfWzmMlp~TtM}jPdD-p@C-Q?`K4E5n2BnA)*o(k;3cA{yjW!g#+lOxm)vgh l65WmutCwcS^}l$sr}|>2=1 Date: Wed, 29 May 2024 16:25:04 -0400 Subject: [PATCH 404/503] Update docs --- man/ensembl_ieg_list.Rd | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 man/ensembl_ieg_list.Rd diff --git a/man/ensembl_ieg_list.Rd b/man/ensembl_ieg_list.Rd new file mode 100644 index 0000000000..bc7961d571 --- /dev/null +++ b/man/ensembl_ieg_list.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Data.R +\docType{data} +\name{ensembl_ieg_list} +\alias{ensembl_ieg_list} +\title{Immediate Early Gene (IEG) gene lists} +\format{ +A list of seven vectors +\describe{ +\item{Mus_musculus_IEGs}{Ensembl IDs for IEGs from source publication (see below)} +\item{Homo_sapiens_IEGs}{Ensembl IDs for homologous genes from mouse gene list} + +} +} +\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. See data-raw directory for scripts used to create gene list. +} +\usage{ +ensembl_ieg_list +} +\description{ +Ensembl IDs for immediate early genes +} +\concept{data} +\keyword{datasets} From 8536fdad88f416147ecc5d0acbb888d958778ada Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 16:40:04 -0400 Subject: [PATCH 405/503] update ieg ensembl --- R/Internal_Utilities.R | 73 +++++++++++++++++++++++++++++++++++++++++- R/Object_Utilities.R | 2 +- 2 files changed, 73 insertions(+), 2 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index ba4414ba2e..c4f750adb4 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -770,6 +770,70 @@ Retrieve_IEG_Lists <- function( } +#' Retrieve IEG Gene Lists (Ensembl) +#' +#' Retrieves species specific IEG gene lists with ensembl IDs +#' +#' @param species species to retrieve IDs. +#' +#' @return list of 2 sets of ensembl IDs +#' +#' @import cli +#' +#' @keywords internal +#' +#' @noRd +#' + +Retrieve_IEG_Ensembl_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), + Chicken_Options = c("Chicken", "chicken", "Gallus", "gallus", "Gg", "gg") + ) + + # 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 + chicken_options <- accepted_names$Chicken_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_ensembl") + + # pull lists + qc_gene_list <- list( + ieg = ieg_gene_list[[ieg]] + ) + + return(qc_gene_list) +} + + #' Retrieve dual species gene lists mitochondrial #' #' Returns vector of all mitochondrial genes across all species in dataset. @@ -1071,6 +1135,8 @@ Add_MSigDB_Seurat <- function( #' @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 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 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. @@ -1089,6 +1155,7 @@ Add_IEG_Seurat <- function( seurat_object, species, ieg_name = "percent_ieg", + ensembl_ids = FALSE, assay = NULL, overwrite = FALSE ) { @@ -1127,7 +1194,11 @@ Add_IEG_Seurat <- function( assay <- assay %||% DefaultAssay(object = seurat_object) # Retrieve gene lists - ieg_gene_list <- Retrieve_IEG_Lists(species = species) + if (isFALSE(x = ensembl_ids)) { + ieg_gene_list <- Retrieve_IEG_Lists(species = species) + } else { + ieg_gene_list <- Retrieve_IEG_Ensembl_Lists(species = species) + } ieg_found <- Feature_PreCheck(object = seurat_object, features = ieg_gene_list[["ieg"]]) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 618c108e48..4888bd5259 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -250,7 +250,7 @@ Add_Cell_QC_Metrics.Seurat <- function( "i" = "No column will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field IEG Percentages} to meta.data.")) - object <- Add_IEG_Seurat(seurat_object = object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite) + object <- Add_IEG_Seurat(seurat_object = object, species = species, ieg_name = ieg_name, assay = assay, overwrite = overwrite, ensembl_ids = ensembl_ids) } } From 3d58736574ee2030f33d114d598515064c03927b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 29 May 2024 16:40:37 -0400 Subject: [PATCH 406/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 340d305f38..ad6c0a76d6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9064 +Version: 2.1.2.9065 Date: 2024-05-29 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")), From 700edb55a12d39f5d07d122ed169f66efd3878a5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:06:50 -0400 Subject: [PATCH 407/503] Update liger ensembl IDs --- R/LIGER_Internal_Utilities.R | 9 ++++++++- R/LIGER_Utilities.R | 4 ++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Internal_Utilities.R b/R/LIGER_Internal_Utilities.R index e1742bdbbd..56b309d782 100644 --- a/R/LIGER_Internal_Utilities.R +++ b/R/LIGER_Internal_Utilities.R @@ -2248,6 +2248,8 @@ Add_MSigDB_LIGER <- function( #' @param liger_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 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 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. #' @@ -2264,6 +2266,7 @@ Add_IEG_LIGER <- function( liger_object, species, ieg_name = "percent_ieg", + ensembl_ids = FALSE, overwrite = FALSE ) { # Accepted species names @@ -2300,7 +2303,11 @@ Add_IEG_LIGER <- function( } # Retrieve gene lists - ieg_gene_list <- Retrieve_IEG_Lists(species = species) + if (isFALSE(x = ensembl_ids)) { + ieg_gene_list <- Retrieve_IEG_Lists(species = species) + } else { + ieg_gene_list <- Retrieve_IEG_Ensembl_Lists(species = species) + } all_features <- Features(x = liger_object, by_dataset = FALSE) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 335facff8b..f3046026d8 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -997,7 +997,7 @@ Add_Cell_QC_Metrics.liger <- function( "i" = "No columns will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field MSigDB Oxidative Phosphorylation, Apoptosis, and DNA Repair Percentages} to meta.data.")) - liger_object <- Add_MSigDB_LIGER(liger_object = liger_object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, overwrite = overwrite) + liger_object <- Add_MSigDB_LIGER(liger_object = liger_object, species = species, oxphos_name = oxphos_name, apop_name = apop_name, dna_repair_name = dna_repair_name, overwrite = overwrite, ensembl_ids = ensembl_ids) } } @@ -1008,7 +1008,7 @@ Add_Cell_QC_Metrics.liger <- function( "i" = "No column will be added to object meta.data")) } else { cli_inform(message = c("*" = "Adding {.field IEG Percentages} to meta.data.")) - liger_object <- Add_IEG_LIGER(liger_object = liger_object, species = species, ieg_name = ieg_name, overwrite = overwrite) + liger_object <- Add_IEG_LIGER(liger_object = liger_object, species = species, ieg_name = ieg_name, overwrite = overwrite, ensembl_ids = ensembl_ids) } } From 3f2f52523c16310d0db997d7742645abc7893642 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:12:18 -0400 Subject: [PATCH 408/503] Update changelog --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index df1f19de0b..f7458ffae6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -43,6 +43,8 @@ - `Add_Mito_Ribo` now supports datasets aligned to multi-species reference genomes ([#184](https://github.com/samuel-marsh/scCustomize/issues/184)). - Added parameter `add_prop_plot` to `DimPlot_scCustom` to return plot showing number or percent of cells per identity along with the DimPlot. - Added optional parameter `colors_use_assay2` to `FeaturePlot_DualAssay` which allows for specification of different palettes for the two plots ([#182](https://github.com/samuel-marsh/scCustomize/issues/182)). +- Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. +- Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). From 36fd8c731cc9fa45f89c40d159d33bf1fa94c933 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:12:31 -0400 Subject: [PATCH 409/503] Update ribo and mito lists --- data/ensembl_mito_id.rda | Bin 1082 -> 1082 bytes data/ensembl_ribo_id.rda | Bin 11588 -> 11589 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/data/ensembl_mito_id.rda b/data/ensembl_mito_id.rda index f38e5dce561caf0fc05d14f67288699944578aaa..5891d2baa7e18143283403651f8998321119c781 100644 GIT binary patch delta 960 zcmV;x13&z_2)YP=ABzY80000000VWI+ix316o;3RsG>X+!3zb6r_wj1nKL`L$D+{i zP`6S_q`p~8u!1FDDm&rNN6aR!+3}n&k(2cN=G?wHv%9XZER(_tB zKfCkmKi>S3y6)^r`NtRCS@%`>{d}?6FV=sq=IiC%cE0=>tLvV8SIke#>znfW`LOKU z-`;(gU4OVV50RHWe-{EW2*@BHgMbVISAYxxGKk0^;v7UdImyqROU%h*O zSmA7}s-GyPk4aUe;IpdIyHq_eOrnXc`kLkm)dT7@k2886SDxoQGI-a|UV;d{_c2#UmwsmY83Q<~9Ln7q1uGEH4O{vi| zj?pxZf6*unwRPpT`lRrxV@Z(g+gM52+6G}Xiep>q@hD6jTZB=WiN-M`WeSy5iYY4h zsM+lL_;%MNOGw!428x62zn&C843cEA1f_i{DN*NfG#+1?KOyTwjh`{Qi5Dc_~+ iRS7+4OMbWJs7^el%k{pDJW1Z~tzT7jx8s|u_wMEUmtEJLcNgbp-T7tt zvAewen_g9FQ0T5-KXXItHox&SpT`2ua^(o`SPzAt~>j(m|v9F=jHXo!R?D* z-oBgNzPmP0k(fPy6#_B{$RHqtfD8h6fD8gMh{zz~K8SL1l3x{%XIZQ<$4xgi+umzt zV`5azNm{eXn%U-5zO*DIjc!&;TC3)c$8|mN){}^Cc3w62dV|LcM?Ix!&7=46z@C`Z zBvG02$vd=WN#fh#$4+v)mc^W%z6?Ph2ZoQ@l#-Q2ds=yarSCC`ZcaME+!7p7DY=U| zWPL5O&KouaB?-z+^6K@?;qaw$tv9+NvAPIPl(L;bG4+jgTE|p3qW_iPQuYvIZGt+% zQP(E*SSLfah;@2nfkAc-6O(Mjka`tIo3!H^gN05O41LuIw7y}H-(;5-&qgPJy&D-A( z9?r(9`-x)um{dgyKC3FdOVtCzB%9c3u4$c6J)lnOIHT8b<$2CS9f^82XG<8=2{A&Q z?4WB2CPN*Eb+U)vdU2pgO3;A~2^bg$>oeZIV71GCF`{{L1f?X?vz3)g5L2FMY2}q0c>F@+5i?P-UUAUbn&N=*HBu{v}8$CLcy!Q-K76*P2Wdm>N?&ZtF?<*2}iJj^}O?*yf79^@^>@wt>w+Axdj%NQB(>mD=>FX*HTA zFq$TRFdAi`wy)fFpA=qoE(wx-n=2_x+aQca32a+E9)(F@i!dsCq6rL1*@cRiVv5Q= zYBsw)zTI`nk`f&$ffd1QJt`QJFeY#|LrVQehbksv9i-#2>-z0`HIK(^+yTxLxemu5 zgM@1uvFm`@0#C|&Cu0YwBxK-G3CKF3;&HzedF~qbPU0PpM7{R3dHwpg(ZfD_lVbx? zf0vtKz1Sa)_ltw^>)GRezJA=_J+8(d#?M&}AG&;W_;tJ9&iBKIWwC1xUtJBG<#xVX z?8^U&{@u;+@KADZw!428_scuI%=cHj?SA{=@8xQkuNSLfv%Meo4~w1V`|WJFEB{K{ itCD)qT)w#;R^veT&)+JKuKRa<{RhYl2A`>j8UO&RqUEmu diff --git a/data/ensembl_ribo_id.rda b/data/ensembl_ribo_id.rda index faaf09c301986c47c7f73a7ad12f933ba0e82927..a82ad8e4ffd670a4cce5107342d67fb9dddb5a41 100644 GIT binary patch delta 9959 zcmVH2qd)v0s8)h~bkPwmhC z>CfK1d-uohKKm^G`P2B%cR&60fBUQs_KlwND_)p@`U&OEe_s5_8<$wN%Uw!`TU;U!7u+#$qF_VP^lz-zx zQF1Qq1r@E>L!83)p(Io7g0g~(2~8+Yo7Wa_bHPL0T-bm?bILB6LvYwVl_z+67xWVr zzwlE8z6ptu-hCl|x(od}IIqx^M{HHl!dk+^G}aLQ>%OMYAh#{S-@-Bz+QyCziSP6x z;@iEM(Ck9LS6WS2s8aVA{B1N96@ST43a=pa6M@$jtX$BXch=)A7`A}uEK^7sFUm(8 zEM8clpIG5DpO<8RtEPnOQ6gFT;IT7JVzQb}M)f$020R^TKA5HN1;D1zXZ`+Gu zBKW})zS|fOwsRj-#Pot&E1R|}Dj8!7Z|exLEwU!0t{hg|7P2vMK}Z=BcH<5d5x(`{ zJK_|&DeuZqSq2GF;mIn>>mF1hU>)*QWle+yrtF_4_*;HSSVmjn&M;$r)G`bwyhXMI zUYET^^d%%P^PS8k5MGZhV}Ja?Dg>`;wFw=z4W(1;wS|?_*HU()bwLZhCS!csv?7Ar zlY+#4RJ^42Dd=ZaW6AX5`B7dE>2)_1@l2~t>7ynsN|7%X0!#W`q^~n*LBw1$-$kw3 zg!QqS;L7=qh&&|kRo<_npwmp~mSG`FtDuN1gBCDQeoJW`2JVRboqs+QHAs@F&t*^J6H=8tx&4W$cHh=lf@1SzpPTO=0b?*(6wA8)e@w`$V zZ->?lercl>p$uf$^QEy&>zg3huPnodsDC5kF1WxJT%D+)^?^(YSy*fb z<)sy3rY!|M0k+b1YNp>Kdqj@h8fi*xF=q?im(DVH0r4s!1ojX|Oz4xSNh=8nh^ibD z_gskIh4qu(8u9Nj9N|3>eUeq9>WtgzM))1-7P8)DI7wMZfQG7Eut)yn+yuelBuPT1 z5v2w1sa6E<(CtYaZASaP5s|wSHDn$Ttve2$wY-69k(v_QQcSLU5V^Ke5l_4|WO&SG!kk5s;iUN0qt@aCljjLJe;&!=H~zf| z2LsxKgF)J;ZUy5&OMpz;#42V=wowc7fl54^w8_C~fwK?`OXZ%07kx4`3wUfk(2zWm zi*GQgU;|oPS0c%65|$0c(2(>-zM0@BsFueGlX|-xw^KS1cW8s8CdMhC7Ivhg-#GFj zA4do}bRjfHjO~r+(!3$Be>#%SZ;zQHkB-)8m{J5PyTWvLP!Sb}YC)`^^-74`<|3gR zUo5ms-*{-PGjSU}E(_N^`(W-vmToGngvf&td0gp1cQJ}2m8rHg$;6XyLPVp9RWlO? zX$R$HuVkuNGw?u#Avw?*EyC}Ea|cNg<9Klsk&@HEg;3qbq+eSBe?-oT8&W|-4Z#I& zC&B2&iCj~eflpdNMjiZ{6hANM5%GdPJg>+egRym5w^hRLKzgzSyrE;NcOxt%Ptw1W z#S#R~00+%?CI5+se+)#C!E?s|?K1O*@YkfA#mPIO<|6(b0-DsVpd9ikc^T**bo4s6 zO=8q$96W(4eonh=m1rjezc>jJVDFpU69Fnz&VqIbu&EOfOvp`}Q zKnp$Kid=Kx5ocB_t_0CORze!JJNP&PR2_|`S!nZFl2803f4C3g_dpzM3-RO#(cdO< zQqD3v8h$;kl7-$Jof!c@r1^?Ij?fA!%1b^5pJYhJ+@xA~>*#e3?t=oRQKTt8Np#se zZ)X>rq)a5K-H_oGr%#6Tr|oz}k6#=EX<=?g)_;fqBG)}9>Y7I*fX5NzC%qz@Y542P zR&;AbfT2Ucf98XtDjAZV$czv~e^o;PlQ988HbXCHtQ*<7qlpy@#3*fG1Oj$3?MyOh zgSbh1?5mQmHxqAB$tk1~xnUG5HB$_qROW08^+6GO+?5;-p+Ax2cIy-hGZ766q{4MO zGwQ(-kd=5FWPF6yi!3ZAM>%hxf|jh+B(y)ebKE5$e+u19Y(@wYxrROs&Ww_|gUH!7 zVQf}bkYEf=3Gut2s5>g{?tG98valBkuz^)1>Vj)xy1{6KRha;Y{wnl6229ZT-v*$) zt;|fJm7o~S_&mlK*+1Bw!pO01@)d+i$yz}nYIyOhz%G}OH5&F9JL?)*(ZQ$53px$` zY;|A~e@mx7ncbAdeOS;(Q)Y%Uc*E@O`Ii04ISP28G6K+7wUtdR)OuB zhk%(d&5@)k5_e_POzoB=U`6+GYYX$)LLEeEVECpUW4sz2WD(Y;dktaTtN-_{O(q*QYtV|@^NH7M+BPD*$Mkl`;W;Lbpf$(l5bldKRdR0f0wxTmS3snHH zf3s{dQUkwHsdO?8L(UKKt>+}DLsZ&Mzyyyt7$o8e>Gokv6rcvn#3KkPg~UKtYDI3J zB|xm(3kN27Tc%BL`8*-aCa@c@`CtDi5C}C9xqY3KUhRhRvhP8eFy1hs)JtUt=48hd*$oz23-ee< zKSWkl(E`c%NVSFi_7o?{8bA!Nb{C-n)Yj`DM@cAQ?Efz8UdA+uWJ)M^8cxzCf5qqf zCLU|6PCR+z_zmRVq&K4N}se%ezv4D@Nv962EdMrx#goaGCuMwi9?i$c{5>h z3z9;Y4QB9o#Y4+X0n|(jC)}aXZSIt4l6`$quUhCIflfAmRoA$Y-+WI7ul+wy^_XnUef;*Kc+&B)k`Lj%@p zV|Mb0xO2!fd*9Qq(NSWU9h8o4#H!#BWFQ#UWq8^!$iLB+^2wP3Mi2}unl>Lc2^k2P z)P!t(kmEHh7_wc1xJhznh9lap4Xn`+0T>gAvq7|XG-XUJj<{fNJkzM3l;-{EJiWXl$kK-*Tk~SJb5Y& z?u$f5a0tvz>`u;%(FeOe&`!$*qBz2u>-77;E>nl#^gKLb&e2YZe~yUEsX7(omzlnV z))5<$6Eicy{N;S)ic!P#dJ&~f8Bf%w`uSdNyLw}r{Um5U8F9)oYH+_JoF0Y2F$R}61< zMjtnu+|H8y5Y7t>G0!eZ0_<2SkVC&t>jP*$^i|G;F-|2OR2n??z`ho(fbIIyNRa#| zl@c8DF+{f7JjLXr`eLEf94!jmt6{ zGLCGKfU$p6pn{#SGEA8;85PH1`NGnh*3j3Rc^p{p>bRX=NX}PISxomJm+WJ@K{M0} z<|Gx=LfgVDgpOGV1C5U$9*hQsZOyeJ5TIzh-HiiO%(|ob{2}z8s5Y<*aiY5dHSqX8~y*iXnZuxFwQVH z`@+!J*l1|+NIPwySI#k&Ay$IieifpI;A{xkGP!{T+9cIk7B?*7Op?N2 zIg1R(e>O{5kb{(F=$L9)s}lIlO(wXpjA0Q_8w2UGI?-k3sv@Heiyu37wZMn2xT!va$I~!{X}L4jN4zv-Yx@6uXXa{IX-tLN-dq<^hk~c8QsB4vG11A5gW&%vrR2}peDAJt=K`v zL?0+lfexBS|98iJ92OQjDt_2KFSmo;fOwKZZt;*L*d?H@f!%4Gm4&=r0&$R%%hKeg zE-!{L#>|j`1%}+l>M9?cb&Vp!gpZ?8e~nF6ED+k;aShS=cv3}9CI@rZ)*(6}60#ZR z4~D{uW%X^K&AlhNK0+Fi3K~3?+gfqy&BPMKKuv5hxv+(5-rr4(qhscgRm?dH^A|0~ z!J&fA9S98ZB(MsLX*&8idg1<6bD%Qp)Wg9t<&3C!V#0J?9h0#OI=a&#g39nBf1Ryz zT}E!?v?Ue{&hAc&q|U$x`FzhS_L}d*#x1%x%dgJh<+Oa;KpW zFB@BMo)U`a*d#XCnt(pp&zqf$6+H`^yZ&vAVzp_QvN$H2Z;i_YvA`%pVc63PizGsU z!t@U3_`HkK1jj&p!2ndIvtyZeAr4{OOR^VCXU~j4Za_qG$Fb>eUJ!(Je@DjogN}z5 zo5v;-6=PnRc7@rr+<~B?ahSd-eM`7a*n>4?VPQ`?)B_3pb5I)hNGLdV?IP{ctd~%bz>F+briJ43@uf4&r>f~|978P2-y z=wZ#oQO-g@#^D{)l&erJuy`qRAt zCn&k>MZlnxTB1scUfVBhO5n{3DAo$dtS*mapzQq&1n+u)P^REAQGcpWYZe! zv8`fS;lh^s*$x-s%{dEmU|@Km$nflufJ_MldUnRfPUH^$i>f3k{S()kvn*GO-`^SXfBR)_?YD;!mQl zcMnX%@8s0YGzrprjUykS&hUj}Tw+`JzUbYtN@=6f6m}OTBo)kCH|HzCS3|lin4q3L z9PrQvTId@W7=P==Vw$8AIGs8%m7#Oz;8mE42Xgz(ILLhygXXc_+{9b?vSB?7U1aMU zyIKZf;$^}G?c!S4kSrLk3YcIUgN@P7I5f1pI;Ee6qS-i~&4@_m!27w4HKnXOqU~%< ztT%Q{1sd~pwX6~qEHepEae-*Z?9Pq1J!GK;!kbcF%6~L0WXNVDct0SzK0>B34lb+^ zao$eDT<59stFT9R<9k)ANICD=Bq(nR=L{Zf*T3;Llg9N8b>MwRp=Xm-mlvY*V>X(w zWT_j^oOMfR5WAO^#g7JpH5-zmlI`oPc)1~i-cIoIa7X39XgN*c;ZxHPp<2wz@cjGbJ zm&hKQxTCV6Hk0X)SWi;0AV6foI0iwR$kA??4UfCZ2VG(@yTHLO_3Br@{Na4K3|s1ljDC@njy z17O9~!|WVQKO4szFmHx)pwer|y(H0Xm<`S0vEdaRndFY^#u|id3(gK>^sQURcDRi@ zzn4i78{->9Lxtc->LfgghrG**5DX%rNNQFo<0QNiyyQDCC7`)G_G(&-Q(l7kaEByr zd4IS$Xu%=8usYvPk~ajgx16&l@^WNCpN_n0V=6<&8yJ1CC_JNyI0@zCMyVfG<;Uz6?IZB{ll)15?feGx>5` zj@4CccVS%8oc?caoP^o5h3*x9X|jxuF@K#srbdOei1a*eQ(dugE8~}#g5j7{!LE;t zbE71o8_{eSm20FHh6T_A*-RN2fJ!Ta%hS=Mjd{r4;e_eRz1&0h!GK?{BrijbaKjLa zUxvA3Xf#c3d04rRNE5Zotjcw&Ow2~NCYL&shp7=VgjV_NuXXfz3j@kEbE_GHFzEauy1&m*)Ou&Yj6 zczImo=Kjs_nwU1wg^;bjsBbwtqf^`BKHA(Jvh#h69WC8Z{LnpN)O(^0ynQ!W7!b*x zsIazzg@3*<#IX%4a<*ZtZgK9`GJmX*T!!V+VJwp*Sw4v_!#tn`t~gDA_bQn6u?@qT z!Fz}rV%=mhZo_20cucuOn*)ApIcYPCdtJwNNCl0#$q^WjNr{ig?DxSIPWfwsiBkiM zI32?y?$~N~8#PGG$0UnGvnP^@#|#rx&Q{0UGFJ!~I)-kDgB|V5n1m$vu77A3hm>M! zz`N~(M931zPL1%%5JuR6x1t%831B!$rR=vL60*})MZeGDDTCBz8UyDzEaTBb? z6=z9k^tiDs=EisNm`*;ggM$Ue%#?dO7v3y39lf{HvFK{fLLTh^ETVnImRYN!ezF|B ziGi_{$}lQ+LfqUrc=J`b@qd^Y-sJp~g}3r0U6Rh07)!s7Qy@eZpEPX5mUr?p0g|>p zz2mKX6|djRro`Op3)Pm{`6f<0hO7_8@-OrZy9kAiiCS-EKXPF=mT~e;D6*{kV2iTF zi6)_lakB=DV)cQ2i5!nObNo3wh%dB8Q5VFD)@W$uXk}naxXSnJWq+R&v@fwpc{aS{ zJIR4zg5@!l`))P7Z7qycF8{(phBi>{WSdjM6US=~@YU|_#g2WRzhBCO6Z*!V*Lyp`QmStA%`JeYla;IiE`4W_a1Q^CB z8o(Ie$sQ_b)sd(2C4ZjA-dny8hWq49?u2MV^>7fKgOSH#aYxG*8>sux=2so`$#{%c z&;(YIK~~Wk&1MbEdckhU0#QW!j_G1;V&|LS5J;|u+&-IbW8Yg;D#NTnv@g^sHvJ@+ z?6k1lE`xQPxQ0iZAshI$lY>4llqCU^O@Fz22Qv<&G;?&NzB)wZkcDv~?B;gnoh!64 z0W6!=pd*k1thNXBjJCZBI$Qo(hBnv?bzvI`%Z;$Vc%k+Hg)Gklio9|QsYpX7x)30pr#|p}of4}~i&95FD&$YFwPT`UY&ygiZuJ$=kSYOuoW7YMt z9-gqia$la`QD>T4Wr${fbFu1-6bQU70u$rljAvWc1;&SgBi`|K`Bk558|r-eRRi;U zrwM+LNoNe}l@)LwIn%!!zxesje))^n#TUnskj}TWJx2O<`R;ur6Y&?1f2=Fecpq_F zW;inEyzTfHDa(1b(5M=}llk+!wlc2dgvUF}2Y)B8H{kDNk+p#6QAcqbu@}=9-|4G1 zK83ukPON%g*CRb<>wd%HV{PSfUOZ0Dyzo1v&&?;74O@5xt*P@F<;o;}oartVAsPnU zby?~Yt8DRp){)Wq215p)e_XnG1@7#+5IWhLR!~XnYYMovOLKef)WwBoNRUF$eU6s+B96L3535qiU28qXG7yNjJFY79CZRh&Z5 zBjZ8$E3^G^K79#3TKjbw;gg3Hfg#y#j;S%@`MjSX)5;iP4?J=9pCHUw=vY#}k@ogyRY{}#O z>NN6@+h)uYv*S$_7_v>^oAou2=HlS4i$R_e!wbW@`4Su{7F`rxD-N5NuPeS&gyxV} z(+Ey}+z;{8gs%I~0iTnGBrAVM5%%L0jts5GJN3GG>A8Z&dZJ~4xftn_`HtCu94t!H_36l)9yCmHPY9<={?6g({8fs7} z^O*wQ_7?aS61=nc#qqQO4Sw(Qm zSXmQiT6~M|jO#YfH_#E(m_089kDo)FT<^vCwCiqylZQ?wBvYol2!4GODL-+v3%K=K z1+Ow&Vr`-M2?~yPwpyFw6k)$A{${N+WrZYJg0_oqhC%GL2#BsCv<+W(JN4v=cYEvP zRZ42Mx`&WiN9%vqH&ikO-z)OKH*k{hEk8V*iTuns3f_++UXFmKHKO$VLgkG zSw-oI*^EL^{q6z=VFgVggO|d@kmrJen-w9^%j!Z;9H|N^eyud2<3h^^1s@64Z+N0u zb=V++w!JD#qK-NQcZqXQ5^#&1c9U9-Dc!QpAuN`$@4kP#^Awt(;NeSX4r2@9m^L@_>Io_#VXsUKx!~CSvCb(EVdb2;_mi<}(;7|JRAAj+$|L#Bi=KDV^q1_*4 z{)9b#l{XUI9_3|@uj}~uXxP<~{o{)*GYKElm#f9d$47swUsz=_+>#A3myw^up+vV2{T|Lh~Ej1)UdA_*U<5y`~KlYd%y60OE?#Ep1 z>Y@Dl=u#_QA6=E4ua7Q*{`AN%j`0edI{kSZ*VS;J9<}ydy&WCHKRp_=KA{>+zr6+F zc+PcQ7yp0y;+1QAJ!;wP?-^*o^$xIXsi^SOwa|B2CgZTxdx^J;bY z`si|P97p@uc1WTpiPo~;5X@X}(0A4OT-Ul9>3n~J#J;>jufMu(jDBTlyf~ld7?0W$P3m| zPlDO=$zaUOa}mMO9%%A%+E4E5SFY#r=!vVD$oM3MtDV&AuZF$(l|NZpN~`;!y)e=F zQMP~m>X3e)fBx%Nt^4Xv_8ciUOZOVdJFxhjn$CEBXWes>t`YC`rr93vB&^li3cu6W zJv-reXWp|^j_>S#^Bo-T>@~$Zy$>;BOF^gHy$a`keDQ2y>5B8o9&$WeHr!oeKgAfL z*&|fIt$1ZT2;3P0caFP+o_J8iek^!S$B}A|jl&)zt88@&eF?l?t1(2gix1D1 zxm>){;4Yij7CRNQS*8&w%Ie}w=RG&=HsUO}A zHdqvR(1tjl1e}0qzsH_W=xj0DGq!NdHn*aznO5~3Yo@r%E@G#v3y5Y=hIxPD zsP}BylTPpP<8!v9D0ryZ?6^kqG2%;5Nv3u1NMBbS&+~kmIG?iW60)R8h-fjx7r*$~f6ZTnSkKy)#Ut$=T+3voiW8`Qiejmw-Q!(OqztFL^RcW-PY}*73k_9si zQm%^ctb4xMv9_`{ev&%W>@>^_xSrc;$5s@coBamS6%EhGu_0H zmXM8s*J`8>7pMKOu1`8GO>qj-60j*Q)`VmVxMiK!XFrLNKl=EKpML-TyRU!zs3QEy z$A|y+^WXpY#dp8|@vGl|8~^dcH(!4E;_L5!{QA2uzy0)szyI*vhcADAeE-ki#B=(= zfB4(?-+uee?|%EkH~;d*|9t<|SHI{qKGkuYUjG zhyV5UZ@&48XZepm|KY=rAO88b-+cT2i|@Yv_Wk!Ce)Imv-+lc9{r2B~{{E}@J9hVN lO#PmI^6!2TYmYDe<_{D9y8YtayZ@Vi{vWL}r!Qa;0RY$Qo-zOc delta 9955 zcmV<9CLGztTEtp^ABzY80000000VuUOV4IUamQZ_D1aM;m2@XV2 z3=#y1MI>wNjLbx~2iXwup|Z^9i&FJ^<~^6^_m8dd<@9s$sdhnG!Nr6o6sOH=3%I%9A#N^gz@Ry0m&_qJ?4HUKyuAzh35#F&DFWYw z#7OVHkU!mpejS`w=*lCuDrjLX;b9tU2>*3oQ)rOemf&w;nF(!U$A-jrdJ*yM-b`qA zq2DX5CM;B``wRXynu>~lWGIDK5c-M0YYSE`XwEz9@fHkQKy;QVq>LBkBMufXtkBS} zStqxcOn6Gtc2#lbB0PW@Ef+ft6-DSsrZleYMNrll-NkGnPZ>I;sVsx(CPqA%qVo3^ z;WeB~>hY$mwh-n*)S3OU_d8)D|!U9wFPZRttza%W9t#D_Uu|8@Uh7;Z*TLQ1k-Xi)E z5}5f;<`M|6$CfdF{$Le?SGC%N4%>#(DfZgJ%IRwMJM<8GVhuCSdtj$FsnW9z-rNOdsDdiEtD&NLZ6^Vf=NOae!Vu$oxu=-;FyFb z)%POQ97h29f<8`^7BHb-2d^vysx|-zYYP?u=u@{fB-dJqNLmN(6LeV?L2%Db7;BA? zEvXezb9ef6sGC4(&%{HM6arNsk39l5;CiIjTy}X_EvLulwATx$99fu;_4sRBu@pjx z;dGXNK?}%{*P%k3cX^6{oY!3@p=L;oPM{h`k;Da0N{5wP89J z94W1^5I9^JH{wPPQ3h?kG?r<769oH_Wq1>Rbwu0+7ubTU6E(CxkSQSxi|wGiv_j0Z zrJyIkR@zR@^m}BF$dOwkO{p#BY@z$oSq3j4UL}OU9^!}zeG)ZkB_RP(m1E+b3-PAUK>PNys#!wBS8g zmEaw^J&B{uXx}#?a(AMJ%mboz$H9}FZ>(Cdt{Jv1$uv9JyjQNt%5X=GdO8ZPP{L3x zZ=hPFro^@slj|NtuB}wW6K@R}9g{sePU%G4p$(Fn7^i?**eM@|ZdD=xB|GDMg^NBTRP%6;W}h7Q_l#uY|~LE)u%&#X`IE zjfd7c6Sv{xvT)tA59U5(>88R;h&&jP$B`a%6{AQ}nQBXuOg#A}L^PUMH8Ww5c2HjS zN~Vf60}oUfk^`;LBK$r$caRh@j%PO!DLD;X2-R&&`n45*K;*2rAr&;#5M1DP5{zD) z$TgK2_@otN)WN?=@$-Tn5ijV&^NQ>-7+a@xTP6Gsq$f+j8#<*Km@q@oBI+XwA3EOGS8WekH>GSIiaos7LeH8in&lK!16mLO;b zIB32r`Avq8TIc~+ zS#30LYvQ$eBvj6!F>?F2jXB`h$p8I{bdp-Nrq(1O{#^rj$Y^BJ}6)sMVjK1M3=quc6Px@ z%0!ad4H;f>`eaCd+KyNB_{A}h7UpJT{f7u3a@}*Hu6b$%a64lBq*r7!4S!wPif)Yv zFmwoi*nCh_B}38^nGu5MuWBe@GA2OCX6OZtbt7AMG_hiV7^Mx2K)^1hok=Eb5I1R$ zeO2=HX5uX>IfYarH;iJXW{TmH%A9SXJ}5$uyOP5p^e2+sZkQ0q*S3XDvS=fsN*uW|hb-^_;-C#7rs!RYxe--*3119MFZv)WYR%WKq zN>Geud>&(r>>un-VdPjh`3gd%WUZhOH9Y%OV3*6t8V!4lopp_@=-|`j1)YX|wmL9> ziKSKcT5J?v=8XjUvrB}2y=dL_)N$!7yoQN*nm9|08alf3GxUftFVqJ^tpeLM4*@e_ znj=Y7B<{+nnc6K$z>4nW))wZog*u4T!2ZErNn3AecOpq4Oj;!>ZiWHYRxnQ~1t5E! zF&|Qx<0+KSHTEK~u1z|OMC zNDcf(rP9eX3^_l@x1N)r4pC`40TVppV33F>q}zuvQGgmO6OSOI6cPhnsTH|>mH@GC zFC3WUZJ9Qa(rgh&_RL>;Tz3}FActU8ZdY_nmCe>a=P6Zmlw@=QL)2(?_T33J(_4=E z_dq@vmN>dT2FkSEK)TuLnjEnz z%b8JIUr4SY7ulR3ArNXJa{D?dz1j`sW#5A`VZ32Nsh7$Q%*l=^vKuV47Ur>zeu%89 zq6L!ik!lP3?I})@HGmjk?JhzEsIAvQj*?Kq*#BMFy^LuR$&^s;G@PV=O^VO=O+40C zop|!b@%e5j1d1~s#KcV7l|E^k{A@{Q;Ny6H41gUKbIV6279@o( z8_eMGiieh&0;ri5PPjv%+uSM9B>VcJUbWCa$XQM9oy1Xgr$jFiI!e6pp%qN0@hV)v zq*`PeKCUE`BGi2xC184gUg?wQLhyns$#gbAw&ep;(e^}}#2r%tnvt;=hX$ekbk2s<&!f7j35|RG;Ka?5;71nsR`No zAjfN1Fl4(1ag*fE3`ewG8(5ulp~u--5x!| z4Xx2wAlhl!js*!2B#Ffopn}?S+dI@xzzdqmL9DGW3T_2|K+ZNXGb7|Ys)?cca1;xv zxT0(bzJ@N~+0jiKN-r{M%Jh2f+`;iQGE&{pogcP8L2!)CY`tLN-y9^>CxGxeJ z!67g=u{$|4Mj!0@KszlLh~fxquG8-WyG$K|)AR6%IY&ExB|0K9r|MLUUuOCeT1RY1 zPRz^*^Oy6HD@F~|>qV3{ks}9xgp;?9IZ(-z$QmuUlCdUfGocW1-s900{i>f3?ZhNx zE{C#CYRd@o5)X}?{~4JAYFN%1#~?c`L6@QKOX$>>ztu=~YWBf zHugYaRc{a!`ZY`AOmwby<*bj)_T^YKD`%bKfatf+J_|_mSiBT4LF1!ghH-|u*%yY! z9yjl51y|B4#zsSnN7`uvy>gDJ46zdA_Nx#z1ZP9QmdOn)&?c$QvbbRpXOa{K%UNW9 zIJQ~Jf*hnYL&sFZT9v?WZZg4*Wekge+89We)rl@MR}~p`!Rqgd+`bO*07dGH0ITy5`u351;UF}9N$>#ekys!;Tqx92EAQ1Vn$kxNs#iDR-Ze)eC z-!KB4!F)_SrVw71#~??ZShE)^LE0&Q9ob_YWc}BMIewYIi(MI*arDaB;tjjd4Km!H zd#m6vV2C<%-!YX~l=3-B?ukiSN%OGzX$A~0(19}rCRg|k>}X;gk*zLtePll+RJRtL zPUyUB!E|)(m5t3`8WvZ_cF<_*n6;PHq}X+Yeer$5`}q%;*kYihZ|?j@URBoo#B-12wU&Y{d>TCi*~e z3Utss`oBB&dAS|z2E>yTa*Kx~!7c%H4eUd<}+B!rhL_#*>{J~II zv8=ugw7K^r*GEVrQbB{qa$74dy_r~o7^sOYCKt9)&HKBFadgZ)vWhupVg91UI5iwd)>9#v<~99@e(Sx@)rUX=wr zhVAGg>(qiT@2ugLhp2yNJ{z_d=>);&*g9&|7!wEp5=nK=2pkiscw!Y^tQ(!t*r5E` zDS(pOk+V4$amLxBK8T%v`O;hlDjurZV@1!x=B|GmqgZVkrYw%h=3C=3K`b!JP#E^~!Xk-KpfJ6| zIX>^AG{G?tUoZfb>FikMU5G;%_mb=d)7dj4kQ)$@+;MFBn->IsVcn5&{-EQb#pbce zM8%j_rd?q+Eq5TOXk2G)5C(~`X0L5*IUbt=g2zSh6*WScNnvUJ`f`f6Zfq{i+LYoOC8DklpDicSx10rpPn+LFR z7HER*x8dlf?U)bI8r~3KLEV^zKph2bF~bXsmK(?|EE$@A)UYqbs9@{dScbE%J9=0% zag?(Vka2j&H03H(3oKsBTscl62emx#WN@VgM%=R)5*Y{g!%NG7&>p+fWEL6jk~Jlf z7H-%hFf*gM0TDVgI(Le*hGm%zm4&QQ!q`6=2%*W5qa=g3sN@uKk(pzbWM=AO?+HpS zdloP#rIx5*QsVXtn-X}l0*bW)a;x-$=`_ymMcg@+VRM>h}P zljay<0bG+v8S{U1Ir;hV#3tgQD4`{=s+gPFurJP52?>qu02W_nwkO_t(-%d9;+v>I zh5iIAYv6Nbv=2kEORVSJ%wPQQ3>JyU?4ReVq z=YMA=BeBPV$=I{dMVFSHc8N#^W~+q4f$q1(t)z$0eXxJKZ#KK6qLe{xBZ8i=G&t-U zuotyiggV0)j&X@?;rpU@$10_bMpM{bn2=O3Z{3`)1YZs5vS5OG_He*M z8)%_#Tws5!8;fa@PT+Lv#8igPor70lDjvw~H{&4pO$?gHc5@SN<;#ZkEOe2rZ|rIr zh>4d87qp9OVMDTDxGG?RZ45R>JLAyM^6Hd+8j5D)d^RH@nFH_VHrAA~?ufRtF|pp* zF%@Xc*VVF0RItn>K*a^39kV+(-u94%76@-jc`1L>u#h2}k>LG+==unm#yGgJLd1DH z4Rf8R%CEv6-Hq>6sUqdPW0Rn~DV#HSuwDPg+e{kQH`Iam9fh7vR$X3*&X3t>!jhrd z(IBgQl}p{6^x08I4&{vLlK4rW>p(```AQVSRxz!rlygj^>a@#LadCY+oXK zY~qf}hT2S~Lt;Hi!GZvh3F8<9Z6ZgzVU~NW8Z|ubDj#%-#gIc>{z-=9b6p*glw%+5 zFf!P+$C14)sCY9AFe=wbEes2w2eO$mFaVWS2A8L!NgMN!y~7F9m3z5|?t=lpUP)et9N~r`6u%5} z$Ixh+-14w;ACV?%msyqTRGFBK(gD9Mh@P7)8!XV4BQu>HgU*>2hD|*>b{Bsei%6=n zuORz3V^9tm-sG!_(ua<{J}>|kzs9ui)zD}X4&#X)k?hHg;aJSK&z?tUH(*ztw(#<} z#?Aek;WaUBpbH^eeNo?Xc1EYR#eKB7J7nkk7&}_Jq4=SD!l?H|8+iL}vM?Z$JyBt8 z1q=UtVTfZJR^)8MSl!~>tz~~$Be@LArNdYzNwRzrU50r;3tVxU0Pj^W>th>+HG}sM zHN?8fV%&zweDRoai8crP)^gHj7WcZ2?T`u@bCV-59+MIukJ;~oEu8Y#1QVwQ7I8X; zN8GX1?lx+Wn2$*ohh|SC6^|JvsGO~iw`HynFmw#v5C=QjmoW)R?p=S;E)FTh)PQ%} z2Z@j+kewRglOc?-18+q$C=^;xV0kUIzyYjF~C-b}qbGY&v>xr(@C8oP|8v0a!%)iY>ENMg3$sdJ_X< zDV1SV?1Z?vbMWS?aN~b5F}%t7Ckt=oOS&YTEismU9j8EuEIw)2h%N8rWdbB^eR{`R z`6^z&mraSe)fcKQv-3@ycnnz|isfJE8Fmp08xytO%6{a+ZY<;En^0s~_rVrrixW*k z5#weJ7{%%X`w}@Gapw4Qb`W1^jiN4y6|K?G%F)WemT;Bt*~@=ECum<{k@9SK$#;?i z!vxD?D)-%Lc-vYSsa*brg$!+=+{relgeQ*I20phGB(yhleKfSW1KypOzaPlQ62MI8YQ8a)t zzLPyv(5fR(<#T^LjlH*g9}M@&ncNA{hU(!UItL?<#o~^ZEjCd1q0O&4=#%jnub>I6 zB7>}=HJZ&DnDv6)kOiWM_8rs3+QiN`!6A@b4Y_?b-NwGRs8ohogJ@rKSc&6?DQ(&MRni{dES0xjFP;Z(=3oEEoqKS~j77WRqthrhn7Z597~| z-wppLhJX4mKY7O$$~Yp0*O9!FwBm?QdvUqm-ibrt+2&|swptDrew%F`(URLpJ1$SW zjf7C`Vz%9R)u}r2NEU(=e#eiC-)`R-hv|9SsU4oO+dKVmlit2l4`1Bv6j~K0S5Bq7 z58tT*)>d6Wrytqgw-uBle}DZpn;$(m?rUpPox&j%?juW%9PM-Nus*Eu+p6nfJ=|e^ zwP80kf zlg=2{D=XmMai%|=e(~W?e)aR0#TUnskj|I0J&p9^^4;r5CgLw1S${{M@jBwR%y4AR zdD-!4q%7yzLZfQ@PUg?^+R8YR6K?M;AN-xX-hjW8Mb-kMr#gzuh&`LW_)cH7@hRkO zbz;@~xE|>?TlWhVpVn3m=f&;h%nQF$`rLeS*|3FI(3(1*QI1UF+nMfC5u#zh9harv zvC01U zF_2Wq1?$Hh#<%@6?}A&NE~~!7`e<)*!?%9)RJ+Y)a|u3rlk8`j)A%+NbhhO2esmhS z$!#;{iP`a{3JlpM@Xh)fNON&;$HgFbiQ$D|-Fyj-6pJnjuN8;Q%hwg(DME9|t7!x$ zKiv;;*MyGy&jIg~i6kq3ry}gzDV#F2Ztv9N=B4`z8taLc1?FO;Pv$#jr&QECbczXx zc4Ho5lJCS$_hd}WS_TD!!TcZ~Is`=R)I{;Vw&SLnhj+S=S^Mz)-`6H&mSr~eerGrQ z&*>Mx`o%BbWAX3{?Hwb*5 zoxn%&j_rQI)zfU{C?B|w3={91E^)f=)Wthv?JnL~S8eSKgL1*U^K3`{&V6l1b@hGZ z>WezfHhnN2WQGB+EyGI!L)@mo1HV$sX$3xv-|0bP{GFDmP&g7tI>m@rW9-dxXntqd z7W-*#OF*YJ=kMfyMU6aLYT$f6#ixK{rF#taYZWkR(gccJa+Hh`km8(N%=D;p=Lro_XTc-a7Lt zB{f^!L&&UuQ|s0TDw%@sOc#=Ao>~Lm;Z}u)QcrEM@3LM|NpgR+(;;AeZliaH^(;bW z6{RO;GYUcVy9*eE6*PqmUJ4UKo(l?YR)j<^s|!7Gq$;HNwbF!67h2vZ_>^G%z!Sx) z!v+zw?NwP4b<`oaOPqs}fLrXeo78Gd>6Ud4VX=&Vef8a)PoW749=?R;FvbwFBxGZg zI-fY7^PReP?Y1|;t6WMzTT0fqBJd#Z9TYT|m)?olj`nnSZaD;h>!*vB@2hsD-G(*A zD@gN4jAV|xkU!V>*_k6vr48;OEQvb1fLq>4Cai+p1TAFOZh?uX=B&3<=xYgEGt7D+ z8`lt%t0xkFo=PX~nw_$8?9{^J&O??sg+8j#cgm?F&x4jGxLC^sHJ)t@F%q82U@I&FfB)l+ZwJKVBA>o@+Se}DIjzxdfde)i=zOK8_enLlB- zU*(NNmq&S-PJ@U`!Al{wC`WELoa#%tNyV1 zTxz{<=(uO_{krPWCGX|Y(RTS|Lr2f^_e%|lQ0_18b^BGC*0()ohwk|Z!hM^o9X*s^ z9vy1M%cG-`^X1V&(C;7l!7*NdQ>WjL*8O3UOaMbk4J6ZA01aczI&8```d8@xi5bJbie&7^zR!oJ)`e^5#1lw)sJGh_ZylA zJ3kP!-G6lo*u0->RJ*}zJv@4L6yI@mtosQ)!}YdDpZ7(?{CAAbYvb?hnn$a{mq&+d z<8-vQZHFYflV~mbfner(K;Kp8eO>Elr1Kts68rE9z5MF9G5Uq2jfX?qM@j3;qjrZ^ zwkLe})e(PtzoB`s<`Y>xyg2XY7?0W=P3m}{p?%yE@bYNg9|g+!9RcbC7G}-!onZF7 zGZ^!7Uqo=U8=5?y_MQ9sk?VPSbjQ_9WW1BY(N5~+SHm8D<#(2r(&~C>&rEc_lWo6$ zK1siiKKjjz)_wFRyN{HMrF)Fz9a#KMO=mp6v#vQw$B6fO(QHreB&^li3cu6WH9O(- z&b(%+oW8UB#dmOeXRj&V>3xV1TM9bm>Qy-J#~05QmaaIT>>ato*pCIz={Pcfsu%H{Q{%AP$SPZ%LSF)}*J=#W?Bc_-WiA)* zG`P#=wZ%@wY?f(6in6*m(|OHJyNo!`HbU71U85X-=Xb8Yr1QvCMjj)<=q_=V(@4F>!OkOHj0D7|_)fpp zTbyUR`jSo~r)J{Uk*qisBYyP@oz}L>B_@3O&fJ^dsq3l@oMzkC9O=_++XM`f1v3m% zu8QxhYrffOZDno#PH0gA*43_+GN+Mw&2>1#V5w7>voQ?n_AOSh>k@E(vms6)xMmR$ z4KXe7&C3#a-TLGayVb*7&eX(C^8yxuAyweDxuTNHUK8ijcM+#Bt{Dxdk-WG_tooW) za(+i+$S4X!e2DL?B5=pX6l=@AT#AP%D#=uJ!Cl%ll5pk}tBUg(*NmX^`E0>M?3Rao z;pA#8PqU7zW+G{q@QOTebMSQC;d;Ffh>-}xX$zV+@G-~IB{7q7p5ry_js z-NV2B=#O82{KX%?{`8NZ$A5hF=99M{zy9*;*I#_{`THOI^V=_f-hTY`tKYwg=k$ZW z|LLpGKY#Ow-+lGwPaps1t4}}u9nbSuAHMqX&D)Q^di_=Y^Kty|e)Z}Pe~4GVeEZdZ zz5eXYr##C)eE8MduiyUucW*v__3;<4KY#V*+s|Ho{fF0I(Qp6uqgS8C-?6*TW9nD* hlfU_StUbQ;**E_Zy8Pnl>3{Rj{{d~`4SQe_0RV-_esBN) From d9a6e1193792fd0c319bcf1f08aecb82aa447bc4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:17:58 -0400 Subject: [PATCH 410/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ad6c0a76d6..c1649527e4 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" RRID:SCR_024675. -Version: 2.1.2.9065 -Date: 2024-05-29 +Version: 2.1.2.9066 +Date: 2024-05-30 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"), From 4c53c7d82f4c754c5bd00024e33d926c1e15ffc0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:19:32 -0400 Subject: [PATCH 411/503] update ensembl version and date --- R/Data.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/Data.R b/R/Data.R index 306fe50300..a381403a35 100644 --- a/R/Data.R +++ b/R/Data.R @@ -1,6 +1,6 @@ #' Ensembl Mito IDs #' -#' A list of ensembl ids for mitochondrial genes (Ensembl version 105) +#' A list of ensembl ids for mitochondrial genes (Ensembl version 112; 4/29/2024) #' #' @format A list of six vectors #' \describe{ @@ -21,7 +21,7 @@ #' Ensembl Ribo IDs #' -#' A list of ensembl ids for ribosomal genes (Ensembl version 105) +#' A list of ensembl ids for ribosomal genes (Ensembl version 112; 4/29/2024) #' #' @format A list of eight vectors #' \describe{ @@ -42,7 +42,7 @@ #' Ensembl Hemo IDs #' -#' A list of ensembl ids for hemoglobin genes (Ensembl version 112) +#' A list of ensembl ids for hemoglobin genes (Ensembl version 112; 4/29/2024) #' #' @format A list of six vectors #' \describe{ @@ -101,6 +101,7 @@ #' #' Ensembl IDs for qc percentages from MSigDB database. The gene sets are from 3 MSigDB lists: #' "HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". +#' (Ensembl version 112; 4/29/2024) #' #' @format A list of 21 vectors #' \describe{ @@ -154,7 +155,7 @@ #' Immediate Early Gene (IEG) gene lists #' -#' Ensembl IDs for immediate early genes +#' Ensembl IDs for immediate early genes (Ensembl version 112; 4/29/2024) #' #' @format A list of seven vectors #' \describe{ From 8885fc0f1ad63a210363476b1b258aaaa8604fe8 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 09:19:52 -0400 Subject: [PATCH 412/503] Update docs --- man/ensembl_hemo_id.Rd | 2 +- man/ensembl_ieg_list.Rd | 2 +- man/ensembl_mito_id.Rd | 2 +- man/ensembl_ribo_id.Rd | 2 +- man/msigdb_qc_ensembl_list.Rd | 1 + 5 files changed, 5 insertions(+), 4 deletions(-) diff --git a/man/ensembl_hemo_id.Rd b/man/ensembl_hemo_id.Rd index 7b1070bd44..a3ad6fbe30 100644 --- a/man/ensembl_hemo_id.Rd +++ b/man/ensembl_hemo_id.Rd @@ -23,7 +23,7 @@ See data-raw directory for scripts used to create gene list. ensembl_hemo_id } \description{ -A list of ensembl ids for hemoglobin genes (Ensembl version 112) +A list of ensembl ids for hemoglobin genes (Ensembl version 112; 4/29/2024) } \concept{data} \keyword{datasets} diff --git a/man/ensembl_ieg_list.Rd b/man/ensembl_ieg_list.Rd index bc7961d571..c37529b638 100644 --- a/man/ensembl_ieg_list.Rd +++ b/man/ensembl_ieg_list.Rd @@ -21,7 +21,7 @@ homologs according to HGNC. See data-raw directory for scripts used to create g ensembl_ieg_list } \description{ -Ensembl IDs for immediate early genes +Ensembl IDs for immediate early genes (Ensembl version 112; 4/29/2024) } \concept{data} \keyword{datasets} diff --git a/man/ensembl_mito_id.Rd b/man/ensembl_mito_id.Rd index 63453e440a..f076b11e67 100644 --- a/man/ensembl_mito_id.Rd +++ b/man/ensembl_mito_id.Rd @@ -23,7 +23,7 @@ See data-raw directory for scripts used to create gene list. ensembl_mito_id } \description{ -A list of ensembl ids for mitochondrial genes (Ensembl version 105) +A list of ensembl ids for mitochondrial genes (Ensembl version 112; 4/29/2024) } \concept{data} \keyword{datasets} diff --git a/man/ensembl_ribo_id.Rd b/man/ensembl_ribo_id.Rd index ac0dae4158..109c09f739 100644 --- a/man/ensembl_ribo_id.Rd +++ b/man/ensembl_ribo_id.Rd @@ -24,7 +24,7 @@ See data-raw directory for scripts used to create gene list. ensembl_ribo_id } \description{ -A list of ensembl ids for ribosomal genes (Ensembl version 105) +A list of ensembl ids for ribosomal genes (Ensembl version 112; 4/29/2024) } \concept{data} \keyword{datasets} diff --git a/man/msigdb_qc_ensembl_list.Rd b/man/msigdb_qc_ensembl_list.Rd index cc786570d3..dfeae55e61 100644 --- a/man/msigdb_qc_ensembl_list.Rd +++ b/man/msigdb_qc_ensembl_list.Rd @@ -39,6 +39,7 @@ msigdb_qc_ensembl_list \description{ Ensembl IDs for qc percentages from MSigDB database. The gene sets are from 3 MSigDB lists: "HALLMARK_OXIDATIVE_PHOSPHORYLATION", "HALLMARK_APOPTOSIS", and "HALLMARK_DNA_REPAIR". +(Ensembl version 112; 4/29/2024) } \concept{data} \keyword{datasets} From ffc1bb35784df551b5dd73e90de9957ec90afa54 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:28:10 -0400 Subject: [PATCH 413/503] rliger variable all 2.0.0 compatible --- R/LIGER_Utilities.R | 61 +++++++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 19 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index f3046026d8..d9d03866f7 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1647,6 +1647,7 @@ Add_Top_Gene_Pct.liger <- function( #' @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). +#' Only applicable for rliger < 2.0.0. #' @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. @@ -1678,35 +1679,57 @@ Variable_Features_ALL_LIGER <- function( alpha.thresh = 0.99, tol = 0.0001, do.plot = FALSE, - pt.size = 0.3, - chunk=1000 + pt.size = 1.5, + chunk = 1000 ) { - # liger version check - if (packageVersion(pkg = 'rliger') > "1.0.1") { - cli_abort(message = c("Functionality is currently restricted to rliger v1.0.1 or lower.")) - } - # check liger Is_LIGER(liger_object = liger_object) - raw_data <- liger_object@raw.data + # version check and split + if (packageVersion(pkg = 'rliger') >= "2.0.0") { + raw_data <- rliger::rawData(x = liger_object) - cli_inform(message = "Creating temporary object with combined 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) + temp_liger <- rliger::createLiger(rawData = list("dataset" = Merge_Sparse_Data_All(matrix_list = raw_data)), removeMissing = FALSE) - rm(raw_data) - gc() + rm(raw_data) + gc() - cli_inform(message = "Normalizing and identifying variable features.") + 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 + temp_liger <- rliger::normalize(object = temp_liger) + temp_liger <- rliger::selectGenes(object = temp_liger, thresh = var.thresh, alpha = alpha, chunk = chunk) + if (isTRUE(x = do.plot)) { + plotVarFeatures(object = temp_liger, dotSize = pt.size) + } + + var_genes <- rliger::varFeatures(x = temp_liger) - rm(temp_liger) - gc() + rm(temp_liger) + gc() + + rliger::varFeatures(x = liger_object) <- var_genes + } else { + raw_data <- liger_object@raw.data - liger_object@var.genes <- var_genes + 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) } From 211104d371d7bb7e5d86e32f468dde3d20c6fb76 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:28:18 -0400 Subject: [PATCH 414/503] Update docs --- man/Variable_Features_ALL_LIGER.Rd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/man/Variable_Features_ALL_LIGER.Rd b/man/Variable_Features_ALL_LIGER.Rd index d9ceffd94b..779a9eb9ea 100644 --- a/man/Variable_Features_ALL_LIGER.Rd +++ b/man/Variable_Features_ALL_LIGER.Rd @@ -11,7 +11,7 @@ Variable_Features_ALL_LIGER( alpha.thresh = 0.99, tol = 1e-04, do.plot = FALSE, - pt.size = 0.3, + pt.size = 1.5, chunk = 1000 ) } @@ -28,7 +28,8 @@ Genes with expression variance greater than threshold (relative to mean) are sel \item{alpha.thresh}{Alpha threshold. Controls upper bound for expected mean gene expression (lower threshold -> higher upper bound). (default 0.99)} -\item{tol}{Tolerance to use for optimization if num.genes values passed in (default 0.0001).} +\item{tol}{Tolerance to use for optimization if num.genes values passed in (default 0.0001). +Only applicable for rliger < 2.0.0.} \item{do.plot}{Display log plot of gene variance vs. gene expression. Selected genes are plotted in green. (Default FALSE)} From c6c3b6492383bd09d80d04f212906e2996eae8c6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:29:00 -0400 Subject: [PATCH 415/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index f7458ffae6..ef7146a5cc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,7 @@ - `Add_Mito_Ribo` - `Add_Cell_Complexity` - `DimPlot_LIGER` + - `Variable_Features_ALL_LIGER` - *New functions compatible with old and new style liger objects:* - Added new function `Add_Hemo` to add hemoglobin gene percentage for QC. Also added as parameter to `Add_Cell_QC_Metrics`. `Add_Hemo` supports all default species: (human, mouse, marmoset, zebrafish, rat, drosophila, rhesus macaque, and chicken) and works with both Seurat and liger objects. - *New scCustomize generics to function across both Seurat and Liger objects* From 73df56b08028b62e15e447383d275d9442615aa5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:29:12 -0400 Subject: [PATCH 416/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c1649527e4..8b4cc12f99 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9066 +Version: 2.1.2.9067 Date: 2024-05-30 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")), From c61840ff0a1fc337775dbc18b9e36644e45b6372 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:32:42 -0400 Subject: [PATCH 417/503] fix error --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index d9d03866f7..0a5f1750e6 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1699,7 +1699,7 @@ Variable_Features_ALL_LIGER <- function( cli_inform(message = "Normalizing and identifying variable features.") temp_liger <- rliger::normalize(object = temp_liger) - temp_liger <- rliger::selectGenes(object = temp_liger, thresh = var.thresh, alpha = alpha, chunk = chunk) + temp_liger <- rliger::selectGenes(object = temp_liger, thresh = var.thresh, alpha = alpha.thresh, chunk = chunk) if (isTRUE(x = do.plot)) { plotVarFeatures(object = temp_liger, dotSize = pt.size) } From 5d4bf8a0c878eb5858cda384aa02671eee6eb976 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 30 May 2024 13:36:04 -0400 Subject: [PATCH 418/503] plotting --- R/LIGER_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 0a5f1750e6..910c2321d7 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1701,7 +1701,7 @@ Variable_Features_ALL_LIGER <- function( temp_liger <- rliger::normalize(object = temp_liger) temp_liger <- rliger::selectGenes(object = temp_liger, thresh = var.thresh, alpha = alpha.thresh, chunk = chunk) if (isTRUE(x = do.plot)) { - plotVarFeatures(object = temp_liger, dotSize = pt.size) + print(plotVarFeatures(object = temp_liger, dotSize = pt.size)) } var_genes <- rliger::varFeatures(x = temp_liger) From 192b26a08adee9c0c37a94aade851c06d97d03ab Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 4 Jun 2024 13:19:08 -0400 Subject: [PATCH 419/503] add messages --- R/LIGER_Utilities.R | 3 +++ R/Object_Utilities.R | 3 +++ 2 files changed, 6 insertions(+) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 910c2321d7..449a1b9b36 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1229,6 +1229,7 @@ Add_Mito_Ribo.liger <- function( # Add mito and ribo percent if (length_mito_features > 0) { + cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species_use}} using gene symbol pattern: {.val {mito_pattern}}.") good_mito <- mito_features[mito_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { @@ -1241,6 +1242,7 @@ Add_Mito_Ribo.liger <- function( } if (length_ribo_features > 0){ + cli_inform(message = "Adding Percent Ribosomal genes for {.field {species_use}} using gene symbol pattern: {.val {ribo_pattern}}.") good_ribo <- ribo_features[ribo_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { @@ -1254,6 +1256,7 @@ Add_Mito_Ribo.liger <- function( # Create combined mito ribo column if both present if (length_mito_features > 0 && length_ribo_features > 0) { + cli_inform(message = "Adding Percent Mito+Ribo by adding Mito & Ribo percentages.") if (packageVersion(pkg = 'rliger') > "1.0.1") { object@cellMeta[[mito_ribo_name]] <- object@cellMeta[[mito_name]] + object@cellMeta[[ribo_name]] } else { diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 4888bd5259..563e9c17b1 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -523,17 +523,20 @@ Add_Mito_Ribo.Seurat <- function( } # Add mito and ribo columns + cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species_use}} using gene symbol pattern: {.val {mito_pattern}}.") if (length_mito_features > 0) { good_mito <- mito_features[mito_features %in% rownames(x = object)] object[[mito_name]] <- PercentageFeatureSet(object = object, features = good_mito, assay = assay) } if (length_ribo_features > 0) { + cli_inform(message = "Adding Percent Ribosomal genes for {.field {species_use}} using gene symbol pattern: {.val {ribo_pattern}}.") good_ribo <- ribo_features[ribo_features %in% rownames(x = object)] object[[ribo_name]] <- PercentageFeatureSet(object = object, features = good_ribo, assay = assay) } # Create combined mito ribo column if both present if (length_mito_features > 0 && length_ribo_features > 0) { + cli_inform(message = "Adding Percent Mito+Ribo by adding Mito & Ribo percentages.") object_meta <- Fetch_Meta(object = object) %>% rownames_to_column("barcodes") From 5a25fc4892d8d45abc1006f0288082e31c5e9eff Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 4 Jun 2024 14:34:50 -0400 Subject: [PATCH 420/503] fix species --- R/LIGER_Utilities.R | 4 ++-- R/Object_Utilities.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 449a1b9b36..3f7473b637 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -1229,7 +1229,7 @@ Add_Mito_Ribo.liger <- function( # Add mito and ribo percent if (length_mito_features > 0) { - cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species_use}} using gene symbol pattern: {.val {mito_pattern}}.") + cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species}} using gene symbol pattern: {.val {mito_pattern}}.") good_mito <- mito_features[mito_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { @@ -1242,7 +1242,7 @@ Add_Mito_Ribo.liger <- function( } if (length_ribo_features > 0){ - cli_inform(message = "Adding Percent Ribosomal genes for {.field {species_use}} using gene symbol pattern: {.val {ribo_pattern}}.") + cli_inform(message = "Adding Percent Ribosomal genes for {.field {species}} using gene symbol pattern: {.val {ribo_pattern}}.") good_ribo <- ribo_features[ribo_features %in% all_features] if (packageVersion(pkg = 'rliger') > "1.0.1") { diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index 563e9c17b1..b747407f7c 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -523,13 +523,13 @@ Add_Mito_Ribo.Seurat <- function( } # Add mito and ribo columns - cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species_use}} using gene symbol pattern: {.val {mito_pattern}}.") + cli_inform(message = "Adding Percent Mitochondrial genes for {.field {species}} using gene symbol pattern: {.val {mito_pattern}}.") if (length_mito_features > 0) { good_mito <- mito_features[mito_features %in% rownames(x = object)] object[[mito_name]] <- PercentageFeatureSet(object = object, features = good_mito, assay = assay) } if (length_ribo_features > 0) { - cli_inform(message = "Adding Percent Ribosomal genes for {.field {species_use}} using gene symbol pattern: {.val {ribo_pattern}}.") + cli_inform(message = "Adding Percent Ribosomal genes for {.field {species}} using gene symbol pattern: {.val {ribo_pattern}}.") good_ribo <- ribo_features[ribo_features %in% rownames(x = object)] object[[ribo_name]] <- PercentageFeatureSet(object = object, features = good_ribo, assay = assay) } From 445422e209bf66fa00ae287c4ade152cbea94134 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:16:36 -0400 Subject: [PATCH 421/503] Update --- R/Plotting_Utilities.R | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 7a505cb957..ce594c3eef 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -1596,6 +1596,43 @@ upper_diag_cor_mat <- function( } +#' Get hclust rectangles +#' +#' get data.frames to plot hclust rectangles +#' +#' @param cor_mat correlation matrix created with `cor`. +#' @param num_rect number of rectangles to plot +#' @param num_factors number of factors in plot +#' +#' @return list of dataframes to use for drawing rectangles +#' +#' @noRd +#' + +create_factor_hclust_rect <- function( + cor_mat, + num_rect, + num_factors +) { + n <- nrow(cor_mat) + method <- "complete" + tree <- hclust(as.dist(1 - cor_mat), method = method) + hc_rect <- cutree(tree, k = num_rect) + clustab <- table(hc_rect)[unique(hc_rect[tree$order])] + cu <- c(0, cumsum(clustab)) + + rect_df <- data.frame(cbind(cu[-length(cu)], cu[-1])) + rownames(rect_df) <- 1:num_rect + rect_df <- rect_df + 0.5 + rect_df2 <- length(num_factors) - rect_df + 1 + + rect_list <- list("x_axis" = rect_df, + "y_axis" = rect_df2) + + return(rect_list) +} + + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #################### GGPLOT2/THEMES #################### #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From 0b51e6e6a401a784d27484e702122dfa39aaf599 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:17:03 -0400 Subject: [PATCH 422/503] Update --- man/Factor_Cor_Plot.Rd | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index d3c10c3dc8..abe6f71492 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -12,7 +12,10 @@ Factor_Cor_Plot( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE + x_lab_rotate = TRUE, + cluster = TRUE, + cluster_rect = FALSE, + cluster_rect_col = "white" ) } \arguments{ From 23f1c3f6257a45e68a0b2ce32af7d81bda317c48 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:19:52 -0400 Subject: [PATCH 423/503] update plots --- R/LIGER_Plotting.R | 27 ++++++++++++++++++++++++--- man/Factor_Cor_Plot.Rd | 1 + 2 files changed, 25 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 49a7f19263..87f550aad3 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -375,7 +375,11 @@ Factor_Cor_Plot <- function( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE + x_lab_rotate = TRUE, + cluster = TRUE, + cluster_rect = FALSE, + cluster_rect_num = NULL, + cluster_rect_col = "white" ) { # check plot type if (!plot_type %in% c("full", "lower", "upper")) { @@ -397,6 +401,13 @@ Factor_Cor_Plot <- function( plot_df <- cor_mat } + if (isTRUE(x = cluster)) { + dist_mat <- stats::as.dist((1 - cor_mat) / 2) + hclust_res <- stats::hclust(dd, method = "complete") + + plot_df <- plot_df[hclust_res$order, hclust_res$order] + } + # Reshape for plotting plot_df <- data.frame(plot_df) %>% rownames_to_column("rowname") %>% @@ -405,6 +416,10 @@ Factor_Cor_Plot <- function( plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) + if (isTRUE(x = cluster)) { + plot_df$Var <- factor(plot_df$Var, levels = unique(plot_df$Var)) + } + if (isTRUE(x = label)) { plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) @@ -415,8 +430,8 @@ Factor_Cor_Plot <- function( # plot plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + - geom_tile() + - scale_y_discrete(limits = factor_names) + + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + + scale_x_discrete(expand = c(0, 0)) + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + xlab("") + ylab("") @@ -434,6 +449,12 @@ Factor_Cor_Plot <- function( plot <- plot + RotatedAxis() } + if (isTRUE(x = cluster_rect)) { + rect_list <- create_factor_hclust_rect(cor_mat = cor_mat, num_rect = cluster_rect_num, num_factors = length(x = factor_names)) + + plot <- plot + annotate(geom = "rect", xmin = rect_list[[1]][,1], xmax = rect_list[[1]][,2], ymin = rect_list[[2]][,1], ymax = rect_list[[2]][,2], fill = NA, color = cluster_rect_col) + } + # return plot return(plot) } diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index abe6f71492..dfffca6d15 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -15,6 +15,7 @@ Factor_Cor_Plot( x_lab_rotate = TRUE, cluster = TRUE, cluster_rect = FALSE, + cluster_rect_num = NULL, cluster_rect_col = "white" ) } From 87ae16586cb49e746141ff7956dd49749bbcf5fb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:23:33 -0400 Subject: [PATCH 424/503] revert to figure out --- R/LIGER_Plotting.R | 27 +++------------------------ man/Factor_Cor_Plot.Rd | 6 +----- 2 files changed, 4 insertions(+), 29 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 87f550aad3..49a7f19263 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -375,11 +375,7 @@ Factor_Cor_Plot <- function( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE, - cluster = TRUE, - cluster_rect = FALSE, - cluster_rect_num = NULL, - cluster_rect_col = "white" + x_lab_rotate = TRUE ) { # check plot type if (!plot_type %in% c("full", "lower", "upper")) { @@ -401,13 +397,6 @@ Factor_Cor_Plot <- function( plot_df <- cor_mat } - if (isTRUE(x = cluster)) { - dist_mat <- stats::as.dist((1 - cor_mat) / 2) - hclust_res <- stats::hclust(dd, method = "complete") - - plot_df <- plot_df[hclust_res$order, hclust_res$order] - } - # Reshape for plotting plot_df <- data.frame(plot_df) %>% rownames_to_column("rowname") %>% @@ -416,10 +405,6 @@ Factor_Cor_Plot <- function( plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) - if (isTRUE(x = cluster)) { - plot_df$Var <- factor(plot_df$Var, levels = unique(plot_df$Var)) - } - if (isTRUE(x = label)) { plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) @@ -430,8 +415,8 @@ Factor_Cor_Plot <- function( # plot plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + - scale_y_discrete(limits = factor_names, expand = c(0, 0)) + - scale_x_discrete(expand = c(0, 0)) + + geom_tile() + + scale_y_discrete(limits = factor_names) + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + xlab("") + ylab("") @@ -449,12 +434,6 @@ Factor_Cor_Plot <- function( plot <- plot + RotatedAxis() } - if (isTRUE(x = cluster_rect)) { - rect_list <- create_factor_hclust_rect(cor_mat = cor_mat, num_rect = cluster_rect_num, num_factors = length(x = factor_names)) - - plot <- plot + annotate(geom = "rect", xmin = rect_list[[1]][,1], xmax = rect_list[[1]][,2], ymin = rect_list[[2]][,1], ymax = rect_list[[2]][,2], fill = NA, color = cluster_rect_col) - } - # return plot return(plot) } diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index dfffca6d15..d3c10c3dc8 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -12,11 +12,7 @@ Factor_Cor_Plot( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE, - cluster = TRUE, - cluster_rect = FALSE, - cluster_rect_num = NULL, - cluster_rect_col = "white" + x_lab_rotate = TRUE ) } \arguments{ From a2bd588ffd88ac2b1512b2bbd9d5079d8511e18e Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:27:56 -0400 Subject: [PATCH 425/503] first update --- R/LIGER_Plotting.R | 10 +++++++++- man/Factor_Cor_Plot.Rd | 3 ++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 49a7f19263..49dbc54645 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -375,7 +375,8 @@ Factor_Cor_Plot <- function( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE + x_lab_rotate = TRUE, + cluster = TRUE ) { # check plot type if (!plot_type %in% c("full", "lower", "upper")) { @@ -397,6 +398,13 @@ Factor_Cor_Plot <- function( plot_df <- cor_mat } + if (isTRUE(x = cluster)) { + dist_mat <- stats::as.dist((1 - plot_df) / 2) + hclust_res <- stats::hclust(dd, method = "complete") + + plot_df <- plot_df[hclust_res$order, hclust_res$order] + } + # Reshape for plotting plot_df <- data.frame(plot_df) %>% rownames_to_column("rowname") %>% diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index d3c10c3dc8..2dc3aa17d7 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -12,7 +12,8 @@ Factor_Cor_Plot( label_size = 5, plot_title = NULL, plot_type = "full", - x_lab_rotate = TRUE + x_lab_rotate = TRUE, + cluster = TRUE ) } \arguments{ From a66eea0aff885c3cb7805102bdb6477434546636 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 12:33:14 -0400 Subject: [PATCH 426/503] fix --- R/LIGER_Plotting.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 49dbc54645..25894f2455 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -413,6 +413,11 @@ Factor_Cor_Plot <- function( plot_df$rowname <- factor(plot_df$rowname, levels = rev(unique(plot_df$rowname))) + if (isTRUE(x = cluster)) { + plot_df$Var <- factor(plot_df$Var, levels = unique(plot_df$Var)) + } + + if (isTRUE(x = label)) { plot_df$label <- ifelse(plot_df$corr >= label_threshold, round(plot_df$corr, 2), NA) plot_df$label <- ifelse(plot_df$label == 1, NA, round(plot_df$label, 2)) From 63826e0a41747ba08eb3cf769705ab755b3b6a1c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 13:17:44 -0400 Subject: [PATCH 427/503] expand zero --- R/LIGER_Plotting.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 25894f2455..0d2ccfae45 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -429,6 +429,8 @@ Factor_Cor_Plot <- function( plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + geom_tile() + + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + + scale_x_discrete(expand = c(0, 0)) + scale_y_discrete(limits = factor_names) + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + xlab("") + From ab6226c4a7a894e09d043796c14ecd0b5f44e69b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 13:30:36 -0400 Subject: [PATCH 428/503] add plot --- R/LIGER_Plotting.R | 11 ++++++++++- man/Factor_Cor_Plot.Rd | 5 ++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 0d2ccfae45..5cc8f8b87c 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -376,7 +376,10 @@ Factor_Cor_Plot <- function( plot_title = NULL, plot_type = "full", x_lab_rotate = TRUE, - cluster = TRUE + cluster = TRUE, + cluster_rect = FALSE, + cluster_rect_num = NULL, + cluster_rect_col = "white" ) { # check plot type if (!plot_type %in% c("full", "lower", "upper")) { @@ -449,6 +452,12 @@ Factor_Cor_Plot <- function( plot <- plot + RotatedAxis() } + if (isTRUE(x = cluster_rect)) { + rect_list <- create_factor_hclust_rect(cor_mat = cor_mat, num_rect = cluster_rect_num, num_factors = length(x = factor_names)) + + plot <- plot + annotate(geom = "rect", xmin = rect_list[[1]][,1], xmax = rect_list[[1]][,2], ymin = rect_list[[2]][,1], ymax = rect_list[[2]][,2], fill = NA, color = cluster_rect_col) + } + # return plot return(plot) } diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index 2dc3aa17d7..dfffca6d15 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -13,7 +13,10 @@ Factor_Cor_Plot( plot_title = NULL, plot_type = "full", x_lab_rotate = TRUE, - cluster = TRUE + cluster = TRUE, + cluster_rect = FALSE, + cluster_rect_num = NULL, + cluster_rect_col = "white" ) } \arguments{ From 51930be319346ab752e7b5f408a93529b807e298 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 13:36:13 -0400 Subject: [PATCH 429/503] fix rectangles --- R/Plotting_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index ce594c3eef..a1de1df515 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -1624,7 +1624,7 @@ create_factor_hclust_rect <- function( rect_df <- data.frame(cbind(cu[-length(cu)], cu[-1])) rownames(rect_df) <- 1:num_rect rect_df <- rect_df + 0.5 - rect_df2 <- length(num_factors) - rect_df + 1 + rect_df2 <- num_factors - rect_df + 1 rect_list <- list("x_axis" = rect_df, "y_axis" = rect_df2) From 615ff4557b11ba2a5abaef1eb21674c2a4dad111 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:35:31 -0400 Subject: [PATCH 430/503] factor cor plot --- R/LIGER_Plotting.R | 31 ++++++++++++++++++++++--------- man/Factor_Cor_Plot.Rd | 1 + 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 5cc8f8b87c..693378ddc1 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -375,6 +375,7 @@ Factor_Cor_Plot <- function( label_size = 5, plot_title = NULL, plot_type = "full", + positive_only = FALSE, x_lab_rotate = TRUE, cluster = TRUE, cluster_rect = FALSE, @@ -429,15 +430,27 @@ Factor_Cor_Plot <- function( factor_names <- levels(plot_df$rowname) # plot - plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + - theme_cowplot() + - geom_tile() + - scale_y_discrete(limits = factor_names, expand = c(0, 0)) + - scale_x_discrete(expand = c(0, 0)) + - scale_y_discrete(limits = factor_names) + - scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + - xlab("") + - ylab("") + if (isFALSE(x = positive_only)) { + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + + theme_cowplot() + + geom_tile() + + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + + scale_x_discrete(expand = c(0, 0)) + + scale_y_discrete(limits = factor_names) + + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + + xlab("") + + ylab("") + } else { + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + + theme_cowplot() + + geom_tile() + + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + + scale_x_discrete(expand = c(0, 0)) + + scale_y_discrete(limits = factor_names) + + scale_fill_gradientn(colours = colors_use, limits = c(-1,1), na.value = colors_use[1]) + + xlab("") + + ylab("") + } # modify plot if (isTRUE(x = label)) { diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index dfffca6d15..c448feff4c 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -12,6 +12,7 @@ Factor_Cor_Plot( label_size = 5, plot_title = NULL, plot_type = "full", + positive_only = FALSE, x_lab_rotate = TRUE, cluster = TRUE, cluster_rect = FALSE, From 320bc0820cd56e07dcab323e544d4e246af43aaa Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:42:03 -0400 Subject: [PATCH 431/503] fix plotting --- R/LIGER_Plotting.R | 6 ++++-- man/Factor_Cor_Plot.Rd | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 693378ddc1..542d7db080 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -369,7 +369,7 @@ plotFactors_scCustom <- function( Factor_Cor_Plot <- function( liger_object, - colors_use = viridis_light_high, + colors_use = NULL, label = FALSE, label_threshold = 0.5, label_size = 5, @@ -430,7 +430,8 @@ Factor_Cor_Plot <- function( factor_names <- levels(plot_df$rowname) # plot - if (isFALSE(x = positive_only)) { + if (isTRUE(x = positive_only)) { + colors_use <- colors_use %||% viridis_light_high plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + geom_tile() + @@ -441,6 +442,7 @@ Factor_Cor_Plot <- function( xlab("") + ylab("") } else { + colors_use <- colors_use %||% paletteer::paletteer_d("RColorBrewer::RdBu") plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + geom_tile() + diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index c448feff4c..4d7a0b3a1e 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -6,7 +6,7 @@ \usage{ Factor_Cor_Plot( liger_object, - colors_use = viridis_light_high, + colors_use = NULL, label = FALSE, label_threshold = 0.5, label_size = 5, From 5fe2341807eb90f289488091d3327214b1e21187 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:46:11 -0400 Subject: [PATCH 432/503] fix double axis --- R/LIGER_Plotting.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 542d7db080..c71a1c6d30 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -380,7 +380,7 @@ Factor_Cor_Plot <- function( cluster = TRUE, cluster_rect = FALSE, cluster_rect_num = NULL, - cluster_rect_col = "white" + cluster_rect_col = NULL ) { # check plot type if (!plot_type %in% c("full", "lower", "upper")) { @@ -432,23 +432,25 @@ Factor_Cor_Plot <- function( # plot if (isTRUE(x = positive_only)) { colors_use <- colors_use %||% viridis_light_high + cluster_rect_col <- cluster_rect_col %||% "white" + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + geom_tile() + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + scale_x_discrete(expand = c(0, 0)) + - scale_y_discrete(limits = factor_names) + scale_fill_gradientn(colours = colors_use, limits = c(0,1), na.value = colors_use[1]) + xlab("") + ylab("") } else { colors_use <- colors_use %||% paletteer::paletteer_d("RColorBrewer::RdBu") + cluster_rect_col <- cluster_rect_col %||% "black" + plot <- ggplot(data = plot_df, mapping = aes(x = .data[["Var"]], y = .data[["rowname"]], fill = .data[["corr"]])) + theme_cowplot() + geom_tile() + scale_y_discrete(limits = factor_names, expand = c(0, 0)) + scale_x_discrete(expand = c(0, 0)) + - scale_y_discrete(limits = factor_names) + scale_fill_gradientn(colours = colors_use, limits = c(-1,1), na.value = colors_use[1]) + xlab("") + ylab("") From 4e6a946fea3c90312aff1e8d5a8958511e08c076 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:52:10 -0400 Subject: [PATCH 433/503] add manual entry --- R/LIGER_Plotting.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index c71a1c6d30..8b7130385b 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -336,7 +336,9 @@ plotFactors_scCustom <- function( #' Any negative correlations are set to NA and NA values set to bottom color of color gradient. #' #' @param liger_object liger object. -#' @param colors_use Color palette to use for correlation values. Default is `viridis`. +#' @param colors_use Color palette to use for correlation values. +#' Default is `RColorBrewer::RdBu` if `positive_only = FALSE`. +#' If `positive_only = TRUE` the default is `viridis`. #' Users can also supply vector of 3 colors (low, mid, high). #' @param label logical, whether to add correlation values to plot result. #' @param label_threshold threshold for adding correlation values if `label = TRUE`. Default @@ -345,7 +347,15 @@ plotFactors_scCustom <- function( #' @param plot_title Plot title. #' @param plot_type Controls plotting full matrix, or just the upper or lower triangles. #' Accepted values are: "full" (default), "upper", or "lower". -#' @param x_lab_rotate logical, whether to rotate the axes labels on the x-axis. Default is TRUE +#' @param positive_only logical, whether to limit the plotted values to only positive +#' correlations (negative values set to 0); default is FALSE. +#' @param x_lab_rotate logical, whether to rotate the axes labels on the x-axis. Default is TRUE. +#' @param cluster logical, whether to cluster the plot using `hclust` (default TRUE). If FALSE +#' factors are listed in numerical order. +#' @param cluster_rect logical, whether to add rectangles around the clustered areas on plot, +#' default is FALSE. +#' @param cluster_rect_num number of rectangles to add to the plot, default NULL. +#' @param cluster_rect_col color to use for rectangles, default MULL (will set color automatically). #' #' @return A ggplot object #' From 65400f3cd13945918f332f5d0814ece9523f0f7b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:52:18 -0400 Subject: [PATCH 434/503] update docs --- man/Factor_Cor_Plot.Rd | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/man/Factor_Cor_Plot.Rd b/man/Factor_Cor_Plot.Rd index 4d7a0b3a1e..ceca08f195 100644 --- a/man/Factor_Cor_Plot.Rd +++ b/man/Factor_Cor_Plot.Rd @@ -17,13 +17,15 @@ Factor_Cor_Plot( cluster = TRUE, cluster_rect = FALSE, cluster_rect_num = NULL, - cluster_rect_col = "white" + cluster_rect_col = NULL ) } \arguments{ \item{liger_object}{liger object.} -\item{colors_use}{Color palette to use for correlation values. Default is \code{viridis}. +\item{colors_use}{Color palette to use for correlation values. +Default is \code{RColorBrewer::RdBu} if \code{positive_only = FALSE}. +If \code{positive_only = TRUE} the default is \code{viridis}. Users can also supply vector of 3 colors (low, mid, high).} \item{label}{logical, whether to add correlation values to plot result.} @@ -38,7 +40,20 @@ is 0.5.} \item{plot_type}{Controls plotting full matrix, or just the upper or lower triangles. Accepted values are: "full" (default), "upper", or "lower".} -\item{x_lab_rotate}{logical, whether to rotate the axes labels on the x-axis. Default is TRUE} +\item{positive_only}{logical, whether to limit the plotted values to only positive +correlations (negative values set to 0); default is FALSE.} + +\item{x_lab_rotate}{logical, whether to rotate the axes labels on the x-axis. Default is TRUE.} + +\item{cluster}{logical, whether to cluster the plot using \code{hclust} (default TRUE). If FALSE +factors are listed in numerical order.} + +\item{cluster_rect}{logical, whether to add rectangles around the clustered areas on plot, +default is FALSE.} + +\item{cluster_rect_num}{number of rectangles to add to the plot, default NULL.} + +\item{cluster_rect_col}{color to use for rectangles, default MULL (will set color automatically).} } \value{ A ggplot object From f3fd4c2a68e1d2e8d0c52a47e984eb7466cf4202 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 12 Jun 2024 16:52:49 -0400 Subject: [PATCH 435/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8b4cc12f99..e0afe54e1b 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" RRID:SCR_024675. -Version: 2.1.2.9067 -Date: 2024-05-30 +Version: 2.1.2.9068 +Date: 2024-06-12 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"), From b702a1e92a6d5d2dcc3bfd6d03dced6a27f22c4c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 13 Jun 2024 15:14:54 -0400 Subject: [PATCH 436/503] fix --- R/LIGER_Plotting.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/LIGER_Plotting.R b/R/LIGER_Plotting.R index 8b7130385b..e7965bdd6c 100644 --- a/R/LIGER_Plotting.R +++ b/R/LIGER_Plotting.R @@ -414,7 +414,7 @@ Factor_Cor_Plot <- function( if (isTRUE(x = cluster)) { dist_mat <- stats::as.dist((1 - plot_df) / 2) - hclust_res <- stats::hclust(dd, method = "complete") + hclust_res <- stats::hclust(dist_mat, method = "complete") plot_df <- plot_df[hclust_res$order, hclust_res$order] } From 110821d183cc9577163c3d7747349bc41fe81018 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 6 Aug 2024 08:31:32 -0400 Subject: [PATCH 437/503] fix name collision possibility with meta data --- R/LIGER_Utilities.R | 6 +++--- R/Object_Utilities.R | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/LIGER_Utilities.R b/R/LIGER_Utilities.R index 3f7473b637..29529728b9 100644 --- a/R/LIGER_Utilities.R +++ b/R/LIGER_Utilities.R @@ -597,13 +597,13 @@ Rename_Clusters.liger <- function( ident_df <- data.frame(rliger::defaultCluster(x = object)) colnames(x = ident_df) <- "current_idents" ident_df <- ident_df %>% - rownames_to_column("barcodes") + rownames_to_column("temp_barcodes") new_idents_df <- data.frame("current_idents" = names(x = new_idents), "new_idents" = new_idents) new_idents_meta <- suppressMessages(right_join(x = ident_df, y = new_idents_df)) %>% - column_to_rownames("barcodes") + column_to_rownames("temp_barcodes") suppressMessages(rliger::defaultCluster(x = object) <- new_idents_meta$new_idents) cli_inform(message = c("v" = "{.code defaultCluster} updated and stored as: {.val defaultCluster} in object cellMeta slot.")) @@ -1261,7 +1261,7 @@ Add_Mito_Ribo.liger <- function( object@cellMeta[[mito_ribo_name]] <- object@cellMeta[[mito_name]] + object@cellMeta[[ribo_name]] } else { object_meta <- Fetch_Meta(object = object) %>% - rownames_to_column("barcodes") + rownames_to_column("temp_barcodes") object_meta <- object_meta %>% mutate({{mito_ribo_name}} := .data[[mito_name]] + .data[[ribo_name]]) diff --git a/R/Object_Utilities.R b/R/Object_Utilities.R index b747407f7c..c829409e72 100644 --- a/R/Object_Utilities.R +++ b/R/Object_Utilities.R @@ -538,14 +538,14 @@ Add_Mito_Ribo.Seurat <- function( if (length_mito_features > 0 && length_ribo_features > 0) { cli_inform(message = "Adding Percent Mito+Ribo by adding Mito & Ribo percentages.") object_meta <- Fetch_Meta(object = object) %>% - rownames_to_column("barcodes") + rownames_to_column("temp_barcodes") object_meta <- object_meta %>% mutate({{mito_ribo_name}} := .data[[mito_name]] + .data[[ribo_name]]) object_meta <- object_meta %>% - select(all_of(c("barcodes", mito_ribo_name))) %>% - column_to_rownames("barcodes") + select(all_of(c("temp_barcodes", mito_ribo_name))) %>% + column_to_rownames("temp_barcodes") object <- AddMetaData(object = object, metadata = object_meta) } @@ -1190,7 +1190,7 @@ Add_Sample_Meta <- function( # Pull meta data meta_seurat <- seurat_object@meta.data %>% - rownames_to_column("barcodes") + rownames_to_column("temp_barcodes") # remove if (isTRUE(x = overwrite)) { @@ -1206,10 +1206,10 @@ Add_Sample_Meta <- function( # Remove existing Seurat meta if (length(x = dup_columns) > 0 && isTRUE(x = overwrite)) { meta_merged <- meta_merged %>% - column_to_rownames("barcodes") + column_to_rownames("temp_barcodes") } else { meta_merged <- Meta_Remove_Seurat(meta_data = meta_merged, seurat_object = seurat_object) %>% - column_to_rownames("barcodes") + column_to_rownames("temp_barcodes") } # check NA From 57fae6d1b7d08b9e5532faa4ecc8d3bc2dc083b6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 6 Aug 2024 08:33:14 -0400 Subject: [PATCH 438/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index ef7146a5cc..a5c3613cce 100644 --- a/NEWS.md +++ b/NEWS.md @@ -74,6 +74,7 @@ - Fixed bug in `MAD_Stats` that didn't respect `mad_num` parameter ([#183](https://github.com/samuel-marsh/scCustomize/issues/183)). - Fixed bugs in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0 and returned error if setting `group_by_var` to "ident". - Replaced lingering instances of deprecated tidyr code .data[["var"]] with update `all_of`/`any_of` syntax. +- Fixed issue that could occur with some meta data modifying functions due to column name collisions in internals of function ([#193](https://github.com/samuel-marsh/scCustomize/issues/193)). - Spelling and style fixes. Thanks @kew24. From ba5d76ee9a90c2bf4536d1de6809522bd8bd0445 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 6 Aug 2024 08:33:34 -0400 Subject: [PATCH 439/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e0afe54e1b..760bfb4273 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" RRID:SCR_024675. -Version: 2.1.2.9068 -Date: 2024-06-12 +Version: 2.1.2.9069 +Date: 2024-08-06 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"), From ceb6d3b3c72e2f5bf73040d84c47514de054d2f5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:41:40 -0400 Subject: [PATCH 440/503] reveal reduction explicitly --- R/Seurat_Plotting.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 7d721fc6a1..8b0b0f7055 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1146,6 +1146,7 @@ Clustered_DotPlot <- function( #' @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 reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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 ... Extra parameters passed to \code{\link[Seurat]{DimPlot}}. @@ -1178,6 +1179,7 @@ Cluster_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) { @@ -1187,6 +1189,9 @@ Cluster_Highlight_Plot <- function( # Add raster check for scCustomize raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) + # Set reduction + reduction <- reduction %||% DefaultDimReduc(object = seurat_object) + # Perform Idents check and report errors when when length(cluster_name) > 1 if (length(x = cluster_name) > 1) { idents_list <- levels(x = Idents(object = seurat_object)) @@ -1277,6 +1282,7 @@ Cluster_Highlight_Plot <- function( #' @param split.by Variable in `@meta.data` to split the plot by. #' @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 reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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 ... Extra parameters passed to\code{\link[Seurat]{DimPlot}}. @@ -1314,6 +1320,7 @@ Meta_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) { @@ -1363,6 +1370,9 @@ Meta_Highlight_Plot <- function( # Add raster check for scCustomize raster <- raster %||% (length(x = Cells(x = seurat_object)) > 2e5) + # Set reduction + reduction <- reduction %||% DefaultDimReduc(object = seurat_object) + # Change default ident and pull cells to highlight in plot Idents(object = seurat_object) <- good_meta_data_column From a57352ae9742689c4495c9d3eb4e3c35d9623167 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:41:49 -0400 Subject: [PATCH 441/503] update roxygen version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 760bfb4273..43bcee49df 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -68,4 +68,4 @@ License: GPL (>= 3) Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 From 177798a746fe28aea3445b752c4024985a45d103 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:42:04 -0400 Subject: [PATCH 442/503] Update docs --- man/Cluster_Highlight_Plot.Rd | 3 +++ man/Meta_Highlight_Plot.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index 678d3d13c2..6a8a9627dc 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -17,6 +17,7 @@ Cluster_Highlight_Plot( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) @@ -52,6 +53,8 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} +\item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} + \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes.} diff --git a/man/Meta_Highlight_Plot.Rd b/man/Meta_Highlight_Plot.Rd index 58b564755c..38aa072fcf 100644 --- a/man/Meta_Highlight_Plot.Rd +++ b/man/Meta_Highlight_Plot.Rd @@ -18,6 +18,7 @@ Meta_Highlight_Plot( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) @@ -54,6 +55,8 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} +\item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} + \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes.} From ce5f7c6b772b47c83ec339b39f5e8cd6c5d10b7f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:43:46 -0400 Subject: [PATCH 443/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index a5c3613cce..b01a73ee18 100644 --- a/NEWS.md +++ b/NEWS.md @@ -46,6 +46,7 @@ - Added optional parameter `colors_use_assay2` to `FeaturePlot_DualAssay` which allows for specification of different palettes for the two plots ([#182](https://github.com/samuel-marsh/scCustomize/issues/182)). - Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). +- Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). From d162284a5e5563c168dd551a51a6b3880506ea7f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:43:56 -0400 Subject: [PATCH 444/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 43bcee49df..c744c707c3 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" RRID:SCR_024675. -Version: 2.1.2.9069 -Date: 2024-08-06 +Version: 2.1.2.9070 +Date: 2024-08-20 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"), From 988e593b4be329f3d47f5960d66b09154bf648c1 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 20 Aug 2024 08:46:56 -0400 Subject: [PATCH 445/503] add to plotting --- R/Seurat_Plotting.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 8b0b0f7055..5c47d24439 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1238,6 +1238,7 @@ Cluster_Highlight_Plot <- function( split.by = split.by, split_seurat = split_seurat, label = label, + reduction = reduction, ...) # Edit plot legend @@ -1409,6 +1410,7 @@ Meta_Highlight_Plot <- function( split.by = split.by, split_seurat = split_seurat, label = label, + reduction = reduction, ...) # Update legend and return plot From b8aef434daddfeb20490c225361b5d505404121c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:45:13 -0400 Subject: [PATCH 446/503] add show row/column names param to clustered dotplot --- R/Plotting_Utilities.R | 40 ++++++++++++++++++++++++++++------------ R/Seurat_Plotting.R | 8 ++++++++ 2 files changed, 36 insertions(+), 12 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index a1de1df515..9ec9857308 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -598,6 +598,8 @@ Clustered_DotPlot_Single_Group <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + show_row_names = TRUE, + show_column_names = TRUE, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -905,7 +907,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names - show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -922,7 +926,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names - show_column_names) } } else { if (isTRUE(x = flip)) { @@ -941,7 +947,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names - show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -958,7 +966,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names - show_column_names) } } @@ -979,10 +989,6 @@ Clustered_DotPlot_Single_Group <- function( } - - - - #' Clustered DotPlot #' #' Clustered DotPlots using ComplexHeatmap @@ -1096,6 +1102,8 @@ Clustered_DotPlot_Multi_Group <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + show_row_names = TRUE, + show_column_names = TRUE, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1386,7 +1394,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names - show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1402,7 +1412,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names - show_column_names) } } else { if (isTRUE(x = flip)) { @@ -1420,7 +1432,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names - show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1436,7 +1450,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names - show_column_names) } } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 5c47d24439..9a3329ce8d 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -966,6 +966,8 @@ DotPlot_scCustom <- function( #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. #' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. +#' @param show_row_names logical, whether to show row names on plot (default is TRUE). +#' @param show_column_names logical, whether to show column names on plot (default is TRUE). #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. @@ -1038,6 +1040,8 @@ Clustered_DotPlot <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + show_row_names = TRUE, + show_column_names = TRUE, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1082,6 +1086,8 @@ Clustered_DotPlot <- function( show_parent_dend_line = show_parent_dend_line, ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, + show_row_names = show_row_names, + show_column_names - show_column_names, seed = seed) } else { Clustered_DotPlot_Multi_Group(seurat_object = seurat_object, @@ -1114,6 +1120,8 @@ Clustered_DotPlot <- function( group.by = group.by, idents = idents, show_parent_dend_line = show_parent_dend_line, + show_row_names = show_row_names, + show_column_names - show_column_names, seed = seed) } } From 8f8295f30d026a4f0af3ea4754f00f271a3caaaf Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:45:22 -0400 Subject: [PATCH 447/503] update docs --- man/Clustered_DotPlot.Rd | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index e13fd25089..11ab8361fc 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -29,6 +29,8 @@ Clustered_DotPlot( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + show_row_names = TRUE, + show_column_names = TRUE, raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -110,6 +112,10 @@ smaller than row_km, but this might mean the original row_km is not a good choic \item{legend_title_size}{Size of the legend title text labels. Provided to \code{title_gp} in Heatmap legend call.} +\item{show_row_names}{logical, whether to show row names on plot (default is TRUE).} + +\item{show_column_names}{logical, whether to show column names on plot (default is TRUE).} + \item{raster}{Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE.} \item{plot_km_elbow}{Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. From a6152fb6c22932d1db91c36913a731be83bcf2f7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:46:45 -0400 Subject: [PATCH 448/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index b01a73ee18..7221a2b4ba 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,6 +47,7 @@ - Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). +- Added `show_row_names` and `show_column_names` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). From 33cc3a4f3a68c59d866c43208198f140240e09f5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:46:53 -0400 Subject: [PATCH 449/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c744c707c3..29e4b36caa 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" RRID:SCR_024675. -Version: 2.1.2.9070 -Date: 2024-08-20 +Version: 2.1.2.9071 +Date: 2024-08-22 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"), From 2f3ef664975cfef9400a4b3059381883408d2248 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:55:59 -0400 Subject: [PATCH 450/503] revert test --- R/Plotting_Utilities.R | 32 ++++++++------------------------ 1 file changed, 8 insertions(+), 24 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 9ec9857308..9dd687d3f8 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -907,9 +907,7 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -926,9 +924,7 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_ident) } } else { if (isTRUE(x = flip)) { @@ -947,9 +943,7 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -966,9 +960,7 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_ident) } } @@ -1394,9 +1386,7 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1412,9 +1402,7 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_ident) } } else { if (isTRUE(x = flip)) { @@ -1432,9 +1420,7 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_feature) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1450,9 +1436,7 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident, - show_row_names = show_row_names, - show_column_names - show_column_names) + cluster_columns = cluster_ident) } } From 95c4ff3a2ac9a1a8dc0a63883a500312a484c844 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 08:59:10 -0400 Subject: [PATCH 451/503] fix error --- R/Plotting_Utilities.R | 32 ++++++++++++++++++++++++-------- R/Seurat_Plotting.R | 4 ++-- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 9dd687d3f8..aca7ca0b34 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -907,7 +907,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names = show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -924,7 +926,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names = show_column_names) } } else { if (isTRUE(x = flip)) { @@ -943,7 +947,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names = show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -960,7 +966,9 @@ Clustered_DotPlot_Single_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names = show_column_names) } } @@ -1386,7 +1394,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names = show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1402,7 +1412,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names = show_column_names) } } else { if (isTRUE(x = flip)) { @@ -1420,7 +1432,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_ident, - cluster_columns = cluster_feature) + cluster_columns = cluster_feature, + show_row_names = show_row_names, + show_column_names = show_column_names) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1436,7 +1450,9 @@ Clustered_DotPlot_Multi_Group <- function( show_parent_dend_line = show_parent_dend_line, column_names_rot = x_lab_rotate, cluster_rows = cluster_feature, - cluster_columns = cluster_ident) + cluster_columns = cluster_ident, + show_row_names = show_row_names, + show_column_names = show_column_names) } } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 9a3329ce8d..c52a9c4e16 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1087,7 +1087,7 @@ Clustered_DotPlot <- function( ggplot_default_colors = ggplot_default_colors, color_seed = color_seed, show_row_names = show_row_names, - show_column_names - show_column_names, + show_column_names = show_column_names, seed = seed) } else { Clustered_DotPlot_Multi_Group(seurat_object = seurat_object, @@ -1121,7 +1121,7 @@ Clustered_DotPlot <- function( idents = idents, show_parent_dend_line = show_parent_dend_line, show_row_names = show_row_names, - show_column_names - show_column_names, + show_column_names = show_column_names, seed = seed) } } From baf2aea797f387f2ba4e1311c46b1e9484a3df36 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:04:18 -0400 Subject: [PATCH 452/503] add row and column name side param to clustered Dotplot --- R/Plotting_Utilities.R | 36 ++++++++++++++++++++++++++++-------- R/Seurat_Plotting.R | 6 ++++++ 2 files changed, 34 insertions(+), 8 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index aca7ca0b34..2888342395 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -600,6 +600,8 @@ Clustered_DotPlot_Single_Group <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, + column_names_side = c("bottom", "top"), + row_names_side = c("right", "left"), raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -909,7 +911,9 @@ Clustered_DotPlot_Single_Group <- function( cluster_rows = cluster_ident, cluster_columns = cluster_feature, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -928,7 +932,9 @@ Clustered_DotPlot_Single_Group <- function( cluster_rows = cluster_feature, cluster_columns = cluster_ident, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } } else { if (isTRUE(x = flip)) { @@ -949,7 +955,9 @@ Clustered_DotPlot_Single_Group <- function( cluster_rows = cluster_ident, cluster_columns = cluster_feature, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -968,7 +976,9 @@ Clustered_DotPlot_Single_Group <- function( cluster_rows = cluster_feature, cluster_columns = cluster_ident, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } } @@ -1104,6 +1114,8 @@ Clustered_DotPlot_Multi_Group <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, + column_names_side = c("bottom", "top"), + row_names_side = c("right", "left"), raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1396,7 +1408,9 @@ Clustered_DotPlot_Multi_Group <- function( cluster_rows = cluster_ident, cluster_columns = cluster_feature, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1414,7 +1428,9 @@ Clustered_DotPlot_Multi_Group <- function( cluster_rows = cluster_feature, cluster_columns = cluster_ident, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } } else { if (isTRUE(x = flip)) { @@ -1434,7 +1450,9 @@ Clustered_DotPlot_Multi_Group <- function( cluster_rows = cluster_ident, cluster_columns = cluster_feature, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), @@ -1452,7 +1470,9 @@ Clustered_DotPlot_Multi_Group <- function( cluster_rows = cluster_feature, cluster_columns = cluster_ident, show_row_names = show_row_names, - show_column_names = show_column_names) + show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side) } } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index c52a9c4e16..8e33f07ce7 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1042,6 +1042,8 @@ Clustered_DotPlot <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, + column_names_side = c("bottom", "top"), + row_names_side = c("right", "left"), raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1088,6 +1090,8 @@ Clustered_DotPlot <- function( color_seed = color_seed, show_row_names = show_row_names, show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side, seed = seed) } else { Clustered_DotPlot_Multi_Group(seurat_object = seurat_object, @@ -1122,6 +1126,8 @@ Clustered_DotPlot <- function( show_parent_dend_line = show_parent_dend_line, show_row_names = show_row_names, show_column_names = show_column_names, + column_names_side = column_names_side, + row_names_side = row_names_side, seed = seed) } } From ceec35abdead5e5aba5134226ac9a650f9c1001a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:12:43 -0400 Subject: [PATCH 453/503] add informative warnings --- R/Seurat_Plotting.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 8e33f07ce7..5ecbc71f18 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -968,6 +968,8 @@ DotPlot_scCustom <- function( #' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. #' @param show_row_names logical, whether to show row names on plot (default is TRUE). #' @param show_column_names logical, whether to show column names on plot (default is TRUE). +#' @param row_names_side Should the row names be on the "left" or "right" of plot. Default is "right". +#' @param column_names_side Should the row names be on the "bottom" or "top" of plot. Default is "bottom". #' @param raster Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE. #' @param plot_km_elbow Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. #' Estimating elbow of this plot is one way to determine "optimal" value for `k`. @@ -1055,6 +1057,15 @@ Clustered_DotPlot <- function( color_seed = 123, seed = 123 ) { + # Check allowed parameter options + if (!column_names_side %in% c("bottom", "top")) { + cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") + } + + if (!row_names_side %in% c("left", "right")) { + cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") + } + # check split if (is.null(x = split.by)) { Clustered_DotPlot_Single_Group(seurat_object = seurat_object, From 3922c306284d274e6a926793da1e3cc4e0339da2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:12:51 -0400 Subject: [PATCH 454/503] Update docs --- man/Clustered_DotPlot.Rd | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index 11ab8361fc..8eda6e1744 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -31,6 +31,8 @@ Clustered_DotPlot( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, + column_names_side = c("bottom", "top"), + row_names_side = c("right", "left"), raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -116,6 +118,10 @@ smaller than row_km, but this might mean the original row_km is not a good choic \item{show_column_names}{logical, whether to show column names on plot (default is TRUE).} +\item{column_names_side}{Should the row names be on the "bottom" or "top" of plot. Default is "bottom".} + +\item{row_names_side}{Should the row names be on the "left" or "right" of plot. Default is "right".} + \item{raster}{Logical, whether to render in raster format (faster plotting, smaller files). Default is FALSE.} \item{plot_km_elbow}{Logical, whether or not to return the Sum Squared Error Elbow Plot for k-means clustering. From 06f913f7175d0b0a788e9fa566f7a6ea8ed758ff Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:12:59 -0400 Subject: [PATCH 455/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 7221a2b4ba..0c3bede399 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,7 +47,7 @@ - Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). -- Added `show_row_names` and `show_column_names` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). +- Added `show_row_names` `show_column_names`, `column_names_side`, and `row_names_side` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). From fdf540103179774f30b85edca194e5aa52eb6a98 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:13:06 -0400 Subject: [PATCH 456/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 29e4b36caa..7168963373 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9071 +Version: 2.1.2.9072 Date: 2024-08-22 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")), From 9cb81a6cc07175d8235bb4c7f32ba019fac582ec Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 22 Aug 2024 09:17:17 -0400 Subject: [PATCH 457/503] fix after mtg --- R/Seurat_Plotting.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 5ecbc71f18..a7402ba515 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1057,14 +1057,14 @@ Clustered_DotPlot <- function( color_seed = 123, seed = 123 ) { - # Check allowed parameter options - if (!column_names_side %in% c("bottom", "top")) { - cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") - } - - if (!row_names_side %in% c("left", "right")) { - cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") - } + # # Check allowed parameter options + # if (!column_names_side %in% c("bottom", "top")) { + # cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") + # } + # + # if (!row_names_side %in% c("left", "right")) { + # cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") + # } # check split if (is.null(x = split.by)) { From 64fc500ff5f3056b9be258e54c324fd6871feaa0 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:31:41 -0400 Subject: [PATCH 458/503] fixes --- R/Plotting_Utilities.R | 2 +- R/Seurat_Plotting.R | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 2888342395..ba04e0f710 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -784,7 +784,7 @@ Clustered_DotPlot_Single_Group <- function( show_legend = FALSE ) } else { - column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = Identity, + column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = anno_block(labels = Identity), col = identity_colors_list, na_col = "grey", name = "Identity", diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index a7402ba515..ab3a610c16 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1044,8 +1044,8 @@ Clustered_DotPlot <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, - column_names_side = c("bottom", "top"), - row_names_side = c("right", "left"), + column_names_side = "bottom", + row_names_side = "right", raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -1057,14 +1057,14 @@ Clustered_DotPlot <- function( color_seed = 123, seed = 123 ) { - # # Check allowed parameter options - # if (!column_names_side %in% c("bottom", "top")) { - # cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") - # } - # - # if (!row_names_side %in% c("left", "right")) { - # cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") - # } + # Check allowed parameter options + if (!column_names_side %in% c("bottom", "top")) { + cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") + } + + if (!row_names_side %in% c("left", "right")) { + cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") + } # check split if (is.null(x = split.by)) { From 78bfbf0e0491fe60dcfe56f7d7f3e023f20e8564 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:36:49 -0400 Subject: [PATCH 459/503] fix anno block --- R/Plotting_Utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index ba04e0f710..112881b4cc 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -784,7 +784,7 @@ Clustered_DotPlot_Single_Group <- function( show_legend = FALSE ) } else { - column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = anno_block(labels = Identity), + column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = ComplexHeatmap::anno_block(labels = Identity), col = identity_colors_list, na_col = "grey", name = "Identity", From f69258c9b4987d8c40e8d9151ccc8d0a6d5c68f5 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:47:31 -0400 Subject: [PATCH 460/503] update --- R/Plotting_Utilities.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 112881b4cc..af1687a8ce 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -600,8 +600,8 @@ Clustered_DotPlot_Single_Group <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, - column_names_side = c("bottom", "top"), - row_names_side = c("right", "left"), + column_names_side = "bottom", + row_names_side = "right", raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, @@ -784,7 +784,7 @@ Clustered_DotPlot_Single_Group <- function( show_legend = FALSE ) } else { - column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = ComplexHeatmap::anno_block(labels = Identity), + column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = Identity, col = identity_colors_list, na_col = "grey", name = "Identity", @@ -1114,8 +1114,8 @@ Clustered_DotPlot_Multi_Group <- function( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, - column_names_side = c("bottom", "top"), - row_names_side = c("right", "left"), + column_names_side = "bottom", + row_names_side = "right", raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, From b2372c1f11ddde915d920884fe1398287350982d Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:53:00 -0400 Subject: [PATCH 461/503] update parameter --- R/Seurat_Plotting.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index ab3a610c16..3666c8ae31 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1000,6 +1000,7 @@ DotPlot_scCustom <- function( #' @importFrom rlang is_installed #' @importFrom Seurat DotPlot #' @importFrom stats quantile +#' @importFrom stringr str_to_lower #' @importFrom tidyr pivot_wider #' #' @export @@ -1058,11 +1059,11 @@ Clustered_DotPlot <- function( seed = 123 ) { # Check allowed parameter options - if (!column_names_side %in% c("bottom", "top")) { + if (!str_to_lower(column_names_side) %in% c("bottom", "top")) { cli_abort(message = "{.code column_names_side} must be one of {.field 'bottom'} or {.field 'top'}.") } - if (!row_names_side %in% c("left", "right")) { + if (!str_to_lower(row_names_side) %in% c("right", "left")) { cli_abort(message = "{.code row_names_side} must be one of {.field 'right'} or {.field 'left'}.") } From 1f82a5ac753d1b4086209a239d8140f6a6eb3a8c Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:53:21 -0400 Subject: [PATCH 462/503] update docs --- man/Clustered_DotPlot.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index 8eda6e1744..af2e32153a 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -31,8 +31,8 @@ Clustered_DotPlot( legend_title_size = 10, show_row_names = TRUE, show_column_names = TRUE, - column_names_side = c("bottom", "top"), - row_names_side = c("right", "left"), + column_names_side = "bottom", + row_names_side = "right", raster = FALSE, plot_km_elbow = TRUE, elbow_kmax = NULL, From aa685549088ef8cd3de64a7e3c898e7642740572 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 10:53:40 -0400 Subject: [PATCH 463/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7168963373..82f1603fee 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" RRID:SCR_024675. -Version: 2.1.2.9072 -Date: 2024-08-22 +Version: 2.1.2.9073 +Date: 2024-08-23 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"), From 2cc47ba0a84862d3182aaa9e1b11a5d63e1d91e9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 11:02:42 -0400 Subject: [PATCH 464/503] update split vector --- R/Utilities.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/Utilities.R b/R/Utilities.R index 8b0a378962..56a63482c8 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -1611,7 +1611,10 @@ Rename_Clusters.Seurat <- function( #' Splits vector into chunks of x sizes #' #' @param x vector to split -#' @param chunk_size size of chunks for vector to be split into, default is 100. +#' @param chunk_size size of chunks for vector to be split into, default is NULL. Only valid if +#' `num_chunk` is NULL. +#' @param num_chunk number of chunks to split the vector into, default is NULL. Only valid if +#' `chunk_size` is NULL. #' @param verbose logical, print details of vector and split, default is FALSE. #' #' @return list with vector of X length @@ -1633,9 +1636,18 @@ Rename_Clusters.Seurat <- function( Split_Vector <- function( x, - chunk_size = 100, + chunk_size = NULL, + num_chunk = NULL, verbose = FALSE ) { + if (!is.null(x = chunk_size) && !is.null(x = num_chunk)) { + cli_abort(message = "Cannot specify both {.code chunk_size} and {.code num_chunk}, use one or the other.") + } + + # set chunk size + chunk_size <- chunk_size %||% (length(x = x) / num_chunk) + + # Split vector vector_list <- split(x, ceiling(x = seq_along(x)/chunk_size)) # Report info @@ -1646,7 +1658,6 @@ Split_Vector <- function( # return list return(vector_list) - } From 5273c84fde6b0d5753635df07041f43ffaabac82 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 11:02:52 -0400 Subject: [PATCH 465/503] Update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 0c3bede399..39ea00783b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -48,6 +48,7 @@ - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). - Added `show_row_names` `show_column_names`, `column_names_side`, and `row_names_side` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). +- Updated `Split_Vector` to allow user to specify number of chunks or size of chunks for splitting vector. From 3bca33e48731cec779135b2087c851150521afa2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 11:03:23 -0400 Subject: [PATCH 466/503] Update docs --- man/Split_Vector.Rd | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/man/Split_Vector.Rd b/man/Split_Vector.Rd index 293a1c9188..28512293d7 100644 --- a/man/Split_Vector.Rd +++ b/man/Split_Vector.Rd @@ -4,12 +4,16 @@ \alias{Split_Vector} \title{Split vector into list} \usage{ -Split_Vector(x, chunk_size = 100, verbose = FALSE) +Split_Vector(x, chunk_size = NULL, num_chunk = NULL, verbose = FALSE) } \arguments{ \item{x}{vector to split} -\item{chunk_size}{size of chunks for vector to be split into, default is 100.} +\item{chunk_size}{size of chunks for vector to be split into, default is NULL. Only valid if +\code{num_chunk} is NULL.} + +\item{num_chunk}{number of chunks to split the vector into, default is NULL. Only valid if +\code{chunk_size} is NULL.} \item{verbose}{logical, print details of vector and split, default is FALSE.} } From a15b6854b39edd4e15806641396e2b1091752930 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 23 Aug 2024 11:03:38 -0400 Subject: [PATCH 467/503] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 82f1603fee..a4439fd517 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ 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" RRID:SCR_024675. -Version: 2.1.2.9073 +Version: 2.1.2.9074 Date: 2024-08-23 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")), From a3d5b53b7cab9a468b98f0aa39e85dfe05b9f51a Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 3 Sep 2024 11:39:46 -0400 Subject: [PATCH 468/503] allow splitting cluster highlight plot --- R/Seurat_Plotting.R | 139 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 110 insertions(+), 29 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3666c8ae31..10fd198677 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1172,6 +1172,7 @@ Clustered_DotPlot <- function( #' @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 num_columns number of columns in final layout plot. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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. @@ -1182,6 +1183,8 @@ Clustered_DotPlot <- function( #' @import cli #' @import ggplot2 #' @import patchwork +#' @importFrom dplyr filter +#' @importFrom magrittr "%>%" #' #' @export #' @@ -1205,6 +1208,7 @@ Cluster_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, + num_columns = NULL, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -1230,12 +1234,38 @@ Cluster_Highlight_Plot <- function( } } + # check split + if (!is.null(x = split.by)) { + if (length(x = cluster_name) > 1) { + cli::cli_abort(message = "Only one cluster/ident can be plotted when using {.code split.by}.") + } else { + split.by <- Meta_Present(object = seurat_object, meta_col_names = split.by, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE)[[1]] + } + } + # pull cells to highlight in plot - cells_to_highlight <- CellsByIdentities(seurat_object, idents = cluster_name) + if (!is.null(x = split.by)) { + cells_to_highlight <- CellsByIdentities(seurat_object, idents = cluster_name) + } else { + split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) + + cells_to_highlight_list <- lapply(1:length(x = split_by_list), function(x){ + cells <- FetchData(object = seurat_object, vars = c("ident", split_by_list[x])) %>% + filter(.data[[ident]] == cluster_name & .data[[split.by]] == split_by_list[x]) %>% + rownames() + }) + + # Add ident names to the list + names(cells_to_highlight_list) <- split_by_list + } # set point size if (is.null(x = pt.size)) { - pt.size <- AutoPointSize_scCustom(data = sum(lengths(x = cells_to_highlight)), raster = raster) + if (is.null(x = split.by)) { + pt.size <- AutoPointSize_scCustom(data = sum(lengths(x = cells_to_highlight)), raster = raster) + } else { + pt.size <- AutoPointSize_scCustom(data = max(lengths(x = cells_to_highlight_list)), raster = raster) + } } # Set colors @@ -1252,38 +1282,89 @@ Cluster_Highlight_Plot <- function( } # plot - plot <- DimPlot_scCustom(seurat_object = seurat_object, - cells.highlight = cells_to_highlight, - cols.highlight = highlight_color, - colors_use = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - raster = raster, - raster.dpi = raster.dpi, - split.by = split.by, - split_seurat = split_seurat, - label = label, - reduction = reduction, - ...) + if (is.null(x = split.by)) { + plot <- DimPlot_scCustom(seurat_object = seurat_object, + cells.highlight = cells_to_highlight, + cols.highlight = highlight_color, + colors_use = background_color, + sizes.highlight = pt.size, + pt.size = pt.size, + order = TRUE, + raster = raster, + raster.dpi = raster.dpi, + split.by = split.by, + split_seurat = split_seurat, + label = label, + reduction = reduction, + ...) + + # Edit plot legend + plot <- suppressMessages(plot & scale_color_manual(breaks = names(x = cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) - # Edit plot legend - 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)) { + 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) + } - # 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.") + # Figure plot + if (isTRUE(x = figure_plot)) { + plot <- Figure_Plot(plot = plot) } - plot <- plot & theme(aspect.ratio = aspect_ratio) - } - # Figure plot - if (isTRUE(x = figure_plot)) { - plot <- Figure_Plot(plot = plot) - } + return(plot) + } else { + reduction <- reduction %||% DefaultDimReduc(object = 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]), + max(reduc_coordinates[, 1])) + y_axis <- c(min(reduc_coordinates[, 2]), + max(reduc_coordinates[, 2])) + + + plots <- lapply(1:length(x = split_by_list), function(x) { + plot <- DimPlot_scCustom(seurat_object = seurat_object, + cells.highlight = cells_to_highlight_list[[x]], + cols.highlight = highlight_color, + colors_use = background_color, + sizes.highlight = pt.size, + pt.size = pt.size, + order = TRUE, + raster = raster, + raster.dpi = raster.dpi, + label = label, + reduction = reduction, + ...) + + ggtitle(paste(split_by_list[[x]])) + + theme(plot.title = element_text(hjust = 0.5), + legend.position = "right") + + xlim(x_axis) + + ylim(y_axis) + + plot <- suppressMessages(plot & scale_color_manual(breaks = names(x = cells_to_highlight), values = c(highlight_color, background_color), na.value = background_color)) - return(plot) + # Aspect ratio changes + if (!is.null(x = aspect_ratio)) { + if (!is.numeric(x = aspect_ratio)) { + cli_abort(message = "{.code aspect_ratio} must be a {.field numeric} value.") + } + plot <- plot & theme(aspect.ratio = aspect_ratio) + } + + # Figure plot + if (isTRUE(x = figure_plot)) { + plot <- Figure_Plot(plot = plot) + } + + }) + + # Wrap Plots into single output + plots <- wrap_plots(plots, ncol = num_columns) + plot_layout(guides = 'collect') + } } From 4e36688d9407e03bc59a227ddae8c1a99cc80f85 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Tue, 3 Sep 2024 11:40:21 -0400 Subject: [PATCH 469/503] update docs --- man/Cluster_Highlight_Plot.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index 6a8a9627dc..523361c573 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -17,6 +17,7 @@ Cluster_Highlight_Plot( label = FALSE, split.by = NULL, split_seurat = FALSE, + num_columns = NULL, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -53,6 +54,8 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} +\item{num_columns}{number of columns in final layout plot.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using From 0ad131ba3cb7f5ed0ba22c8610b90ffe2a3b5c85 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:17:45 -0400 Subject: [PATCH 470/503] allow split in cluster highlight --- R/Seurat_Plotting.R | 95 +++++++++++++++++++-------------------------- 1 file changed, 41 insertions(+), 54 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 10fd198677..4eb728210c 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1172,7 +1172,6 @@ Clustered_DotPlot <- function( #' @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 num_columns number of columns in final layout plot. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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. @@ -1208,7 +1207,6 @@ Cluster_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, - num_columns = NULL, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -1237,26 +1235,26 @@ Cluster_Highlight_Plot <- function( # check split if (!is.null(x = split.by)) { if (length(x = cluster_name) > 1) { - cli::cli_abort(message = "Only one cluster/ident can be plotted when using {.code split.by}.") + cli_abort(message = "Only one cluster/ident can be plotted when using {.code split.by}.") } else { split.by <- Meta_Present(object = seurat_object, meta_col_names = split.by, omit_warn = FALSE, print_msg = FALSE, return_none = TRUE)[[1]] } } # pull cells to highlight in plot - if (!is.null(x = split.by)) { + if (is.null(x = split.by)) { cells_to_highlight <- CellsByIdentities(seurat_object, idents = cluster_name) } else { split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) cells_to_highlight_list <- lapply(1:length(x = split_by_list), function(x){ - cells <- FetchData(object = seurat_object, vars = c("ident", split_by_list[x])) %>% - filter(.data[[ident]] == cluster_name & .data[[split.by]] == split_by_list[x]) %>% + cells <- FetchData(object = seurat_object, vars = c("ident", split.by)) %>% + filter(.data[["ident"]] == cluster_name &.data[[split.by]] == split_by_list[x]) %>% rownames() }) # Add ident names to the list - names(cells_to_highlight_list) <- split_by_list + names(cells_to_highlight_list) <- rep(x = cluster_name, length(x = cells_to_highlight_list)) } # set point size @@ -1276,9 +1274,26 @@ Cluster_Highlight_Plot <- function( "i" = "Using the same color ({.val {highlight_color[1]}}) for all clusters.")) } + # Adjust colors in split situation + if (!is.null(x = split.by)) { + if (length(x = highlight_color) == 1) { + cli_inform(message = c("NOTE: Only one color provided to but {.field {length(x = split_by_list)}} idents present in {.field {split_by}}.", + "i" = "Using the same color ({.val {highlight_color[1]}}) for all idents")) + } + if (length(x = highlight_color) > 1) { + if (length(x = highlight_color) != length(x = split_by_list)) { + cli_abort(message = "The number of colors provided to {.code highlight_color} ({.field {length(x = highlight_color)}}) does not equal number of idents ({.field {length(x = split_by_list)}}) present in {.field {split_by}}") + } + } + } + # If NULL set using scCustomize_Palette if (is.null(x = highlight_color)) { - highlight_color <- scCustomize_Palette(num_groups = length(x = cells_to_highlight), ggplot_default_colors = ggplot_default_colors) + if (is.null(x = split.by)) { + highlight_color <- scCustomize_Palette(num_groups = length(x = cells_to_highlight), ggplot_default_colors = ggplot_default_colors) + } else { + highlight_color <- scCustomize_Palette(num_groups = 1, ggplot_default_colors = ggplot_default_colors) + } } # plot @@ -1292,8 +1307,6 @@ Cluster_Highlight_Plot <- function( order = TRUE, raster = raster, raster.dpi = raster.dpi, - split.by = split.by, - split_seurat = split_seurat, label = label, reduction = reduction, ...) @@ -1314,56 +1327,30 @@ Cluster_Highlight_Plot <- function( plot <- Figure_Plot(plot = plot) } + # return plots return(plot) } else { - reduction <- reduction %||% DefaultDimReduc(object = 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]), - max(reduc_coordinates[, 1])) - y_axis <- c(min(reduc_coordinates[, 2]), - max(reduc_coordinates[, 2])) - - - plots <- lapply(1:length(x = split_by_list), function(x) { - plot <- DimPlot_scCustom(seurat_object = seurat_object, - cells.highlight = cells_to_highlight_list[[x]], - cols.highlight = highlight_color, - colors_use = background_color, - sizes.highlight = pt.size, - pt.size = pt.size, - order = TRUE, - raster = raster, - raster.dpi = raster.dpi, - label = label, - reduction = reduction, - ...) + - ggtitle(paste(split_by_list[[x]])) + - theme(plot.title = element_text(hjust = 0.5), - legend.position = "right") + - xlim(x_axis) + - ylim(y_axis) - - 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)) { - 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) - } - - # Figure plot - if (isTRUE(x = figure_plot)) { - plot <- Figure_Plot(plot = plot) - } - + plots <- lapply(1:length(x = cells_to_highlight_list), function(x) { + plot <- Cell_Highlight_Plot(seurat_object = seurat_object, + cells_highlight = cells_to_highlight_list[x], + highlight_color = highlight_color, + background_color = background_color, + pt.size = pt.size, + aspect_ratio = aspect_ratio, + figure_plot = figure_plot, + raster = raster, + raster.dpi = raster.dpi, + label = label) + # Add title from split conditions + plot <- plot + ggtitle(split_by_list[x]) + plot }) # Wrap Plots into single output plots <- wrap_plots(plots, ncol = num_columns) + plot_layout(guides = 'collect') + + # return plots + return(plots) } } From 8cf95a473c9fa58a69e54c97ea6591ad5f5f17af Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:23:54 -0400 Subject: [PATCH 471/503] allow split in cliuster plot (adjust title size parameter) --- R/Seurat_Plotting.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 4eb728210c..a00c8bf3cd 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1207,6 +1207,7 @@ Cluster_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, + split_title_size = 15, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -1342,7 +1343,9 @@ Cluster_Highlight_Plot <- function( raster.dpi = raster.dpi, label = label) # Add title from split conditions - plot <- plot + ggtitle(split_by_list[x]) + plot <- plot + + ggtitle(split_by_list[x]) + + theme(plot.title = element_text(hjust = 0.5, size = split_title_size)) plot }) From a8e060961e303c2501ac13fe49ef8454561a6e03 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:24:24 -0400 Subject: [PATCH 472/503] update docs --- man/Cluster_Highlight_Plot.Rd | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index 523361c573..88436c8775 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -17,7 +17,7 @@ Cluster_Highlight_Plot( label = FALSE, split.by = NULL, split_seurat = FALSE, - num_columns = NULL, + split_title_size = 15, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -54,8 +54,6 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} -\item{num_columns}{number of columns in final layout plot.} - \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using From 409605287e4a011609334bbcdb0420ca705e8fab Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:26:29 -0400 Subject: [PATCH 473/503] update parameters and docs --- R/Seurat_Plotting.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index a00c8bf3cd..5800d8c261 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1172,6 +1172,7 @@ Clustered_DotPlot <- function( #' @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 split_title_size size for plot title labels when using `split.by`. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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. @@ -1551,6 +1552,7 @@ Meta_Highlight_Plot <- function( #' @param split.by Variable in `@meta.data` to split the plot by. #' @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 reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @param ggplot_default_colors logical. If `highlight_color = NULL`, Whether or not to return plot #' using default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes. #' @param ... Extra parameters passed to\code{\link[Seurat]{DimPlot}}. @@ -1592,12 +1594,16 @@ Cell_Highlight_Plot <- function( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) { # Check Seurat Is_Seurat(seurat_object = seurat_object) + # Set reduction + reduction <- reduction %||% DefaultDimReduc(object = seurat_object) + if (!inherits(x = cells_highlight, what = "list")) { cli_abort(message = "{.code cells_highlight} must be of class: {.val list()}.") } From d57ffafd1f5149d16f6d41db2cfba60fdaa540a2 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:26:55 -0400 Subject: [PATCH 474/503] Update docs --- man/Cell_Highlight_Plot.Rd | 3 +++ man/Cluster_Highlight_Plot.Rd | 2 ++ 2 files changed, 5 insertions(+) diff --git a/man/Cell_Highlight_Plot.Rd b/man/Cell_Highlight_Plot.Rd index 2aa81c5315..37017ca39b 100644 --- a/man/Cell_Highlight_Plot.Rd +++ b/man/Cell_Highlight_Plot.Rd @@ -17,6 +17,7 @@ Cell_Highlight_Plot( label = FALSE, split.by = NULL, split_seurat = FALSE, + reduction = NULL, ggplot_default_colors = FALSE, ... ) @@ -51,6 +52,8 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} +\item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} + \item{ggplot_default_colors}{logical. If \code{highlight_color = NULL}, Whether or not to return plot using default ggplot2 "hue" palette instead of default "polychrome" or "varibow" palettes.} diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index 88436c8775..956a0de38d 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -54,6 +54,8 @@ Default is c(512, 512).} \item{split_seurat}{logical. Whether or not to display split plots like Seurat (shared y axis) or as individual plots in layout. Default is FALSE.} +\item{split_title_size}{size for plot title labels when using \code{split.by}.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using From 4353bf7849ea35046af5ff184d55dc977124e7db Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:31:52 -0400 Subject: [PATCH 475/503] update for ordering of plots --- R/Seurat_Plotting.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 5800d8c261..f283c73565 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1247,7 +1247,11 @@ Cluster_Highlight_Plot <- function( if (is.null(x = split.by)) { cells_to_highlight <- CellsByIdentities(seurat_object, idents = cluster_name) } else { - split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) + if (!inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { + split_by_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) + } else { + split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) + } cells_to_highlight_list <- lapply(1:length(x = split_by_list), function(x){ cells <- FetchData(object = seurat_object, vars = c("ident", split.by)) %>% From f10420c23eebc29210e8925fc42c2ad59746bad4 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:33:10 -0400 Subject: [PATCH 476/503] Update docs --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 39ea00783b..4eb4a5851f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -78,6 +78,7 @@ - Fixed bugs in `MAD_Stats` that could cause issues if `mad_num` was less than or equal to 0 and returned error if setting `group_by_var` to "ident". - Replaced lingering instances of deprecated tidyr code .data[["var"]] with update `all_of`/`any_of` syntax. - Fixed issue that could occur with some meta data modifying functions due to column name collisions in internals of function ([#193](https://github.com/samuel-marsh/scCustomize/issues/193)). +- Fixed issue that caused error when using `Cluster_Highlight_Plot` with `split.by` parameter ([#201](https://github.com/samuel-marsh/scCustomize/issues/201)). - Spelling and style fixes. Thanks @kew24. From f29bf06858d12521dee7f9c1c2861da31f87fdca Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:33:19 -0400 Subject: [PATCH 477/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a4439fd517..78bd481d1c 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" RRID:SCR_024675. -Version: 2.1.2.9074 -Date: 2024-08-23 +Version: 2.1.2.9075 +Date: 2024-09-04 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"), From 47ba63076bbdcae7fabe94242626e2239cc8fe61 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:36:43 -0400 Subject: [PATCH 478/503] fix if --- R/Seurat_Plotting.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index f283c73565..3f37d17f21 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1247,7 +1247,7 @@ Cluster_Highlight_Plot <- function( if (is.null(x = split.by)) { cells_to_highlight <- CellsByIdentities(seurat_object, idents = cluster_name) } else { - if (!inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { + if (inherits(x = seurat_object@meta.data[, split.by], what = "factor")) { split_by_list <- as.character(x = levels(x = seurat_object@meta.data[, split.by])) } else { split_by_list <- as.character(x = unique(x = seurat_object@meta.data[, split.by])) From 1fdc4b50f29331cc708120de502b3b9fc6ffcf34 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:41:45 -0400 Subject: [PATCH 479/503] add num_columns --- R/Seurat_Plotting.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3f37d17f21..a55f565d1c 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1173,6 +1173,7 @@ Clustered_DotPlot <- function( #' @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 split_title_size size for plot title labels when using `split.by`. +#' @param num_columns Number of columns in plot layout. Only valid if `split.by != NULL`. #' @param reduction Dimensionality Reduction to use (if NULL then defaults to Object default). #' @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. @@ -1209,6 +1210,7 @@ Cluster_Highlight_Plot <- function( split.by = NULL, split_seurat = FALSE, split_title_size = 15, + num_columns = NULL, reduction = NULL, ggplot_default_colors = FALSE, ... From 3ec27275553429e5216133716058dc1d3561602f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Wed, 4 Sep 2024 10:41:51 -0400 Subject: [PATCH 480/503] Update docs --- man/Cluster_Highlight_Plot.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/Cluster_Highlight_Plot.Rd b/man/Cluster_Highlight_Plot.Rd index 956a0de38d..98d7e1bc66 100644 --- a/man/Cluster_Highlight_Plot.Rd +++ b/man/Cluster_Highlight_Plot.Rd @@ -18,6 +18,7 @@ Cluster_Highlight_Plot( split.by = NULL, split_seurat = FALSE, split_title_size = 15, + num_columns = NULL, reduction = NULL, ggplot_default_colors = FALSE, ... @@ -56,6 +57,8 @@ individual plots in layout. Default is FALSE.} \item{split_title_size}{size for plot title labels when using \code{split.by}.} +\item{num_columns}{Number of columns in plot layout. Only valid if \code{split.by != NULL}.} + \item{reduction}{Dimensionality Reduction to use (if NULL then defaults to Object default).} \item{ggplot_default_colors}{logical. If \code{colors_use = NULL}, Whether or not to return plot using From 0d5050edff38926a6e2865f5286ffa6007179d52 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 11:53:48 -0400 Subject: [PATCH 481/503] add legend positioning --- R/Plotting_Utilities.R | 10 ++++++---- R/Seurat_Plotting.R | 3 +++ 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index af1687a8ce..8c44a2fec2 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -598,6 +598,7 @@ Clustered_DotPlot_Single_Group <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + legend_position = "right", show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -992,9 +993,9 @@ Clustered_DotPlot_Single_Group <- function( } if (!is.null(x = plot_padding)) { - return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, padding = padding)) + return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, padding = padding, merge_legend = TRUE, heatmap_legend_side = legend_position)) } else { - return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list)) + return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, merge_legend = TRUE, heatmap_legend_side = legend_position)) } } @@ -1112,6 +1113,7 @@ Clustered_DotPlot_Multi_Group <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + legend_position = "right", show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -1486,9 +1488,9 @@ Clustered_DotPlot_Multi_Group <- function( } if (!is.null(x = plot_padding)) { - return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, merge_legend = TRUE, padding = padding)) + return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, merge_legend = TRUE, padding = padding, heatmap_legend_side = legend_position)) } else { - return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, merge_legend = TRUE)) + return(ComplexHeatmap::draw(cluster_dot_plot, annotation_legend_list = lgd_list, merge_legend = TRUE, heatmap_legend_side = legend_position)) } } diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index a55f565d1c..05a1e0afd3 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1043,6 +1043,7 @@ Clustered_DotPlot <- function( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + legend_position = "right", show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -1091,6 +1092,7 @@ Clustered_DotPlot <- function( column_label_size = column_label_size, legend_label_size = legend_label_size, legend_title_size = legend_title_size, + legend_position = legend_position, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, @@ -1129,6 +1131,7 @@ Clustered_DotPlot <- function( column_label_size = column_label_size, legend_label_size = legend_label_size, legend_title_size = legend_title_size, + legend_position = legend_position, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, From 741310e32adcc2af80cef44ed031757498ec608f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:00:18 -0400 Subject: [PATCH 482/503] Update legend orientation --- R/Plotting_Utilities.R | 10 ++++++---- R/Seurat_Plotting.R | 3 +++ 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 8c44a2fec2..3bd0e3a6d1 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -599,6 +599,7 @@ Clustered_DotPlot_Single_Group <- function( legend_label_size = 10, legend_title_size = 10, legend_position = "right", + legend_orientation = NULL, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -896,7 +897,7 @@ Clustered_DotPlot_Single_Group <- function( 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")), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), direction = legend_orientation), col=col_fun, rect_gp = gpar(type = "none"), layer_fun = layer_fun, @@ -917,7 +918,7 @@ Clustered_DotPlot_Single_Group <- function( row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, - heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), direction = legend_orientation), col=col_fun, rect_gp = gpar(type = "none"), layer_fun = layer_fun, @@ -940,7 +941,7 @@ Clustered_DotPlot_Single_Group <- function( } else { 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")), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), direction = legend_orientation), col=col_fun, rect_gp = gpar(type = "none"), cell_fun = cell_fun_flip, @@ -961,7 +962,7 @@ Clustered_DotPlot_Single_Group <- function( row_names_side = row_names_side) } else { cluster_dot_plot <- ComplexHeatmap::Heatmap(exp_mat, - heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), + heatmap_legend_param=list(title="Expression", labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), direction = legend_orientation), col=col_fun, rect_gp = gpar(type = "none"), cell_fun = cell_fun, @@ -1114,6 +1115,7 @@ Clustered_DotPlot_Multi_Group <- function( legend_label_size = 10, legend_title_size = 10, legend_position = "right", + legend_orientation = NULL, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 05a1e0afd3..3806995176 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1044,6 +1044,7 @@ Clustered_DotPlot <- function( legend_label_size = 10, legend_title_size = 10, legend_position = "right", + legend_orientation = NULL, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -1093,6 +1094,7 @@ Clustered_DotPlot <- function( legend_label_size = legend_label_size, legend_title_size = legend_title_size, legend_position = legend_position, + legend_orientation = legend_orientation, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, @@ -1132,6 +1134,7 @@ Clustered_DotPlot <- function( legend_label_size = legend_label_size, legend_title_size = legend_title_size, legend_position = legend_position, + legend_orientation = legend_orientation, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, From 908ae8f3a0102053f799386a1bda2ac01affb960 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:09:59 -0400 Subject: [PATCH 483/503] control rows for horizontal legend --- R/Plotting_Utilities.R | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 3bd0e3a6d1..0d181df818 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -864,8 +864,12 @@ Clustered_DotPlot_Single_Group <- function( } # Create legend for point size + if (legend_orientation == "horizontal") { + num_row <- 1 + } + lgd_list = list( - ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]]), labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold")), + ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]]), labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row), ComplexHeatmap::Legend(labels = c(10,25,50,75,100), title = "Percent Expressing", graphics = list( function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.1) * unit(2, "mm"), @@ -879,7 +883,7 @@ Clustered_DotPlot_Single_Group <- function( function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), gp = gpar(fill = "black"))), labels_gp = gpar(fontsize = legend_label_size), - title_gp = gpar(fontsize = legend_title_size, fontface = "bold") + title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row ) ) @@ -1365,6 +1369,10 @@ Clustered_DotPlot_Multi_Group <- function( } # Create legend for point size + if (legend_orientation == "horizontal") { + num_row <- 1 + } + lgd_list = list( ComplexHeatmap::Legend(labels = c(10,25,50,75,100), title = "Percent Expressing", graphics = list( @@ -1379,7 +1387,7 @@ Clustered_DotPlot_Multi_Group <- function( function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), gp = gpar(fill = "black"))), labels_gp = gpar(fontsize = legend_label_size), - title_gp = gpar(fontsize = legend_title_size, fontface = "bold") + title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row ) ) From 1025ec83c4e9924dc9a5b0446b9ec9ab178b5024 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:16:51 -0400 Subject: [PATCH 484/503] add hide ident legend --- R/Plotting_Utilities.R | 58 +++++++++++++++++++++++++++++------------- R/Seurat_Plotting.R | 3 +++ 2 files changed, 44 insertions(+), 17 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 0d181df818..c2ed11b21d 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -600,6 +600,7 @@ Clustered_DotPlot_Single_Group <- function( legend_title_size = 10, legend_position = "right", legend_orientation = NULL, + show_ident_legend = TRUE, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -868,24 +869,46 @@ Clustered_DotPlot_Single_Group <- function( num_row <- 1 } - lgd_list = list( - ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]]), labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row), - ComplexHeatmap::Legend(labels = c(10,25,50,75,100), title = "Percent Expressing", - graphics = list( - function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.1) * unit(2, "mm"), - gp = gpar(fill = "black")), - function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.25) * unit(2, "mm"), - gp = gpar(fill = "black")), - function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.50) * unit(2, "mm"), - gp = gpar(fill = "black")), - function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.75) * unit(2, "mm"), - gp = gpar(fill = "black")), - function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), - gp = gpar(fill = "black"))), - labels_gp = gpar(fontsize = legend_label_size), - title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row + if (isFALSE(x = show_ident_legend)) { + lgd_list = list( + ComplexHeatmap::Legend(labels = c(10,25,50,75,100), title = "Percent Expressing", + graphics = list( + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.1) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.25) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.50) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.75) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), + gp = gpar(fill = "black"))), + labels_gp = gpar(fontsize = legend_label_size), + title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row + ) ) - ) + } else { + lgd_list = list( + ComplexHeatmap::Legend(at = Identity, title = "Identity", legend_gp = gpar(fill = identity_colors_list[[1]]), labels_gp = gpar(fontsize = legend_label_size), title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row), + ComplexHeatmap::Legend(labels = c(10,25,50,75,100), title = "Percent Expressing", + graphics = list( + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.1) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.25) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.50) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = sqrt(0.75) * unit(2, "mm"), + gp = gpar(fill = "black")), + function(x, y, w, h) grid.circle(x = x, y = y, r = 1 * unit(2, "mm"), + gp = gpar(fill = "black"))), + labels_gp = gpar(fontsize = legend_label_size), + title_gp = gpar(fontsize = legend_title_size, fontface = "bold"), nrow = num_row + ) + ) + } + + # Set x label roration if (is.numeric(x = x_lab_rotate)) { @@ -1120,6 +1143,7 @@ Clustered_DotPlot_Multi_Group <- function( legend_title_size = 10, legend_position = "right", legend_orientation = NULL, + show_ident_legend = TRUE, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 3806995176..8b80bdff6a 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -1045,6 +1045,7 @@ Clustered_DotPlot <- function( legend_title_size = 10, legend_position = "right", legend_orientation = NULL, + show_ident_legend = TRUE, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -1095,6 +1096,7 @@ Clustered_DotPlot <- function( legend_title_size = legend_title_size, legend_position = legend_position, legend_orientation = legend_orientation, + show_ident_legend = show_ident_legend, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, @@ -1135,6 +1137,7 @@ Clustered_DotPlot <- function( legend_title_size = legend_title_size, legend_position = legend_position, legend_orientation = legend_orientation, + show_ident_legend = show_ident_legend, raster = raster, plot_km_elbow = plot_km_elbow, elbow_kmax = elbow_kmax, From e30acb030257049a4c9233d55c66d250238b9d87 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:25:35 -0400 Subject: [PATCH 485/503] fix legend rows error when unspecified --- R/Plotting_Utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index c2ed11b21d..9f5bfdd3db 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -865,7 +865,7 @@ Clustered_DotPlot_Single_Group <- function( } # Create legend for point size - if (legend_orientation == "horizontal") { + if (!is.null(x = legend_orientation) && legend_orientation == "horizontal") { num_row <- 1 } @@ -1393,7 +1393,7 @@ Clustered_DotPlot_Multi_Group <- function( } # Create legend for point size - if (legend_orientation == "horizontal") { + if (!is.null(x = legend_orientation) && legend_orientation == "horizontal") { num_row <- 1 } From 8b67d776e7b90c2af6b3a6268898e4a635a9b526 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:31:12 -0400 Subject: [PATCH 486/503] add else condition --- R/Plotting_Utilities.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 9f5bfdd3db..75f8a41b20 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -867,6 +867,8 @@ Clustered_DotPlot_Single_Group <- function( # Create legend for point size if (!is.null(x = legend_orientation) && legend_orientation == "horizontal") { num_row <- 1 + } else { + num_row <- NULL } if (isFALSE(x = show_ident_legend)) { @@ -1395,6 +1397,8 @@ Clustered_DotPlot_Multi_Group <- function( # Create legend for point size if (!is.null(x = legend_orientation) && legend_orientation == "horizontal") { num_row <- 1 + } else { + num_row <- NULL } lgd_list = list( From d1c8798b447c5f97496e509b5f1052f9e9589bd9 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 12:41:48 -0400 Subject: [PATCH 487/503] remove color bar param --- R/Plotting_Utilities.R | 31 ++++++++++++++++++------------- R/Seurat_Plotting.R | 6 ++++++ 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 75f8a41b20..8942e764f7 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -779,22 +779,27 @@ Clustered_DotPlot_Single_Group <- function( } # Create identity annotation - if (isTRUE(x = flip)) { - column_ha <- ComplexHeatmap::rowAnnotation(Identity = Identity, - col = identity_colors_list, - na_col = "grey", - name = "Identity", - show_legend = FALSE - ) + if (isTRUE(x = show_ident_colors)) { + if (isTRUE(x = flip)) { + column_ha <- ComplexHeatmap::rowAnnotation(Identity = Identity, + col = identity_colors_list, + na_col = "grey", + name = "Identity", + show_legend = FALSE + ) + } else { + column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = Identity, + col = identity_colors_list, + na_col = "grey", + name = "Identity", + show_legend = FALSE + ) + } } else { - column_ha <- ComplexHeatmap::HeatmapAnnotation(Identity = Identity, - col = identity_colors_list, - na_col = "grey", - name = "Identity", - show_legend = FALSE - ) + column_ha <- NULL } + # Set middle of color scale if not specified if (is.null(x = exp_color_middle)) { exp_color_middle <- Middle_Number(min = exp_color_min, max = exp_color_max) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 8b80bdff6a..894da4b50f 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -940,6 +940,7 @@ DotPlot_scCustom <- function( #' @param colors_use_idents specify color palette to used for identity labels. 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`. +#' @param show_ident_colors description #' @param x_lab_rotate How to rotate column labels. By default set to `TRUE` which rotates labels 45 degrees. #' If set `FALSE` rotation is set to 0 degrees. Users can also supply custom angle for text rotation. #' @param plot_padding if plot needs extra white space padding so no plot or labels are cutoff. @@ -966,6 +967,9 @@ DotPlot_scCustom <- function( #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. #' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. +#' @param legend_position +#' @param legend_orientation +#' @param show_ident_legend #' @param show_row_names logical, whether to show row names on plot (default is TRUE). #' @param show_column_names logical, whether to show column names on plot (default is TRUE). #' @param row_names_side Should the row names be on the "left" or "right" of plot. Default is "right". @@ -1029,6 +1033,7 @@ Clustered_DotPlot <- function( exp_value_type = "scaled", print_exp_quantiles = FALSE, colors_use_idents = NULL, + show_ident_colors = TRUE, x_lab_rotate = TRUE, plot_padding = NULL, flip = FALSE, @@ -1080,6 +1085,7 @@ Clustered_DotPlot <- function( exp_color_max = exp_color_max, print_exp_quantiles = print_exp_quantiles, colors_use_idents = colors_use_idents, + show_ident_colors = show_ident_colors, x_lab_rotate = x_lab_rotate, plot_padding = plot_padding, flip = flip, From a285b8c75e0b8407b27cca7b7c864a8141219edb Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:00:13 -0400 Subject: [PATCH 488/503] fix error --- R/Plotting_Utilities.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 8942e764f7..13ce2e27eb 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -584,6 +584,7 @@ Clustered_DotPlot_Single_Group <- function( exp_color_max = 2, print_exp_quantiles = FALSE, colors_use_idents = NULL, + show_ident_colors = TRUE, x_lab_rotate = TRUE, plot_padding = NULL, flip = FALSE, From 4c2480e1ae0500de8b668034ac9970c0347b620b Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:03:18 -0400 Subject: [PATCH 489/503] update legend check --- R/Plotting_Utilities.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/Plotting_Utilities.R b/R/Plotting_Utilities.R index 13ce2e27eb..9045db9d1e 100644 --- a/R/Plotting_Utilities.R +++ b/R/Plotting_Utilities.R @@ -633,6 +633,11 @@ Clustered_DotPlot_Single_Group <- function( # Check Seurat Is_Seurat(seurat_object = seurat_object) + # set legend + if (isFALSE(x = show_ident_colors)) { + show_ident_legend <- FALSE + } + # set assay (if null set to active assay) assay <- assay %||% DefaultAssay(object = seurat_object) From 6b80f405d860d382a5769bf05b0b13e4424d36d7 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:12:27 -0400 Subject: [PATCH 490/503] update manual docs --- R/Seurat_Plotting.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/Seurat_Plotting.R b/R/Seurat_Plotting.R index 894da4b50f..360e71c180 100644 --- a/R/Seurat_Plotting.R +++ b/R/Seurat_Plotting.R @@ -940,7 +940,8 @@ DotPlot_scCustom <- function( #' @param colors_use_idents specify color palette to used for identity labels. 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`. -#' @param show_ident_colors description +#' @param show_ident_colors logical, whether to show colors for idents on the column/rows of the plot +#' (default is TRUE). #' @param x_lab_rotate How to rotate column labels. By default set to `TRUE` which rotates labels 45 degrees. #' If set `FALSE` rotation is set to 0 degrees. Users can also supply custom angle for text rotation. #' @param plot_padding if plot needs extra white space padding so no plot or labels are cutoff. @@ -967,9 +968,9 @@ DotPlot_scCustom <- function( #' @param column_label_size Size of the feature labels. Provided to `column_names_gp` in Heatmap call. #' @param legend_label_size Size of the legend text labels. Provided to `labels_gp` in Heatmap legend call. #' @param legend_title_size Size of the legend title text labels. Provided to `title_gp` in Heatmap legend call. -#' @param legend_position -#' @param legend_orientation -#' @param show_ident_legend +#' @param legend_position Location of the plot legend (default is "right"). +#' @param legend_orientation Orientation of the legend (default is NULL). +#' @param show_ident_legend logical, whether to show the color legend for idents in plot (default is TRUE). #' @param show_row_names logical, whether to show row names on plot (default is TRUE). #' @param show_column_names logical, whether to show column names on plot (default is TRUE). #' @param row_names_side Should the row names be on the "left" or "right" of plot. Default is "right". From 99f4e6798e93fb976e9094a021e1ebc494a07c75 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:12:35 -0400 Subject: [PATCH 491/503] Update docs --- man/Clustered_DotPlot.Rd | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/man/Clustered_DotPlot.Rd b/man/Clustered_DotPlot.Rd index af2e32153a..0ea9a08421 100644 --- a/man/Clustered_DotPlot.Rd +++ b/man/Clustered_DotPlot.Rd @@ -15,6 +15,7 @@ Clustered_DotPlot( exp_value_type = "scaled", print_exp_quantiles = FALSE, colors_use_idents = NULL, + show_ident_colors = TRUE, x_lab_rotate = TRUE, plot_padding = NULL, flip = FALSE, @@ -29,6 +30,9 @@ Clustered_DotPlot( column_label_size = 8, legend_label_size = 10, legend_title_size = 10, + legend_position = "right", + legend_orientation = NULL, + show_ident_legend = TRUE, show_row_names = TRUE, show_column_names = TRUE, column_names_side = "bottom", @@ -74,6 +78,9 @@ if there are values below or above those cutoffs, respectively.} 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 \code{DiscretePalette_scCustomize}.} +\item{show_ident_colors}{logical, whether to show colors for idents on the column/rows of the plot +(default is TRUE).} + \item{x_lab_rotate}{How to rotate column labels. By default set to \code{TRUE} which rotates labels 45 degrees. If set \code{FALSE} rotation is set to 0 degrees. Users can also supply custom angle for text rotation.} @@ -114,6 +121,12 @@ smaller than row_km, but this might mean the original row_km is not a good choic \item{legend_title_size}{Size of the legend title text labels. Provided to \code{title_gp} in Heatmap legend call.} +\item{legend_position}{Location of the plot legend (default is "right").} + +\item{legend_orientation}{Orientation of the legend (default is NULL).} + +\item{show_ident_legend}{logical, whether to show the color legend for idents in plot (default is TRUE).} + \item{show_row_names}{logical, whether to show row names on plot (default is TRUE).} \item{show_column_names}{logical, whether to show column names on plot (default is TRUE).} From a8f86be3fd28ce229a1f4898ed0e027113603d85 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:14:11 -0400 Subject: [PATCH 492/503] update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 4eb4a5851f..9f86de565c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,7 +47,7 @@ - Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). -- Added `show_row_names` `show_column_names`, `column_names_side`, and `row_names_side` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). +- Added `show_row_names` `show_column_names`, `column_names_side`, `row_names_side`, `legend_position`, `legend_orientation`, `show_ident_legend`, and `show_ident_colors` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). - Updated `Split_Vector` to allow user to specify number of chunks or size of chunks for splitting vector. From 3d124e9045d6f74900b56aae25c36c00e993ddda Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:14:32 -0400 Subject: [PATCH 493/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 78bd481d1c..a6f6358712 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" RRID:SCR_024675. -Version: 2.1.2.9075 -Date: 2024-09-04 +Version: 2.1.2.9076 +Date: 2024-09-12 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"), From 60f4c4bdb5739c42611c5e7fe572c531b33919cc Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Thu, 12 Sep 2024 14:18:20 -0400 Subject: [PATCH 494/503] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9f86de565c..d2ab029a57 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,7 +47,7 @@ - Added new folder and scripts (see "data-raw/" on GitHub) detailing the creation of gene lists used in `Add_Cell_QC_Metrics`. - Added ensembl ID support for percent hemoglobin, msigdb, and IEG gene sets ([#186](https://github.com/samuel-marsh/scCustomize/issues/186)). - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). -- Added `show_row_names` `show_column_names`, `column_names_side`, `row_names_side`, `legend_position`, `legend_orientation`, `show_ident_legend`, and `show_ident_colors` parameters to `Clustered_DotPlot` ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). +- Added `show_row_names` `show_column_names`, `column_names_side`, `row_names_side`, `legend_position`, `legend_orientation`, `show_ident_legend`, and `show_ident_colors` parameters to `Clustered_DotPlot`. Thanks for idea and code @johnminglu ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). - Updated `Split_Vector` to allow user to specify number of chunks or size of chunks for splitting vector. From 28c71c0ff8eed9b9303827824d6410120443bb44 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:08:43 -0400 Subject: [PATCH 495/503] styling --- R/Utilities.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Utilities.R b/R/Utilities.R index 56a63482c8..94287a8cf1 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -2028,5 +2028,6 @@ Updated_HGNC_Symbols <- function( # Return results return(merged_df) - } + + From 8e7cded99dc05d4edf6885f4a4cd91a438b26745 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:11:16 -0400 Subject: [PATCH 496/503] mouse symbol support functions --- R/Internal_Utilities.R | 102 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index c4f750adb4..e4585b49ed 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -2064,6 +2064,56 @@ download_hgnc_data <- function( } +#' Download HGNC Dataset +#' +#' Internal function to download and cache the latest version of HGNC dataset for use with renaming genes. +#' +#' @param update logical, whether to manually override update parameters and download new data. +#' +#' @import cli +#' +#' @return path to data cache +#' +#' @references \url{https://bioconductor.org/packages/release/bioc/vignettes/BiocFileCache/inst/doc/BiocFileCache.html} +#' +#' @noRd +#' + + +download_mgi_data <- function( + update = NULL +) { + # Get cache + bfc <- .get_bioc_cache() + + # URL from https://www.genenames.org/download/statistics-and-files/ + hgnc_ftp_url <- "https://www.informatics.jax.org/downloads/reports/MGI_EntrezGene.rpt" + + # bfc <- BiocFileCache::BiocFileCache(hgnc_ftp_url) + + rid <- BiocFileCache::bfcquery(bfc, hgnc_ftp_url, "fpath")$rid + if (!length(rid)) { # not in cache, add but do not download + rid <- names(BiocFileCache::bfcadd(bfc, hgnc_ftp_url, download = FALSE)) + } + + if (isTRUE(x = update)) { + update <- update + } else { + update <- BiocFileCache::bfcneedsupdate(bfc, rid) # TRUE if newly added or stale + } + + # download & process + if (!isFALSE(x = update)) { + cli_inform(message = "Downloading MGI data from: {.field {hgnc_ftp_url}}") + BiocFileCache::bfcdownload(bfc, rid, ask = FALSE, FUN = process_hgnc_data) + } + + rpath <- BiocFileCache::bfcrpath(bfc, rids=rid) # path to processed result + + return(rpath) +} + + #' Process HGNC Dataset #' #' Internal function process/filter and save HGNC dataset during cache process @@ -2108,3 +2158,55 @@ process_hgnc_data <- function( saveRDS(hgnc_long_data, file = to) TRUE } + + +#' Process MGI Dataset +#' +#' Internal function process/filter and save MGI dataset during cache process +#' +#' @param from input (cache location). +#' @param to output (cached data). +#' +#' @importFrom dplyr mutate select filter any_of contains +#' @importFrom magrittr "%>%" +#' @importFrom tidyr separate_wider_delim pivot_longer +#' +#' @return path to data cache +#' +#' @references \url{https://bioconductor.org/packages/release/bioc/vignettes/BiocFileCache/inst/doc/BiocFileCache.html} +#' +#' @noRd +#' + +process_mgi_data <- function( + from, + to +) { + # read in data + mgi_full_data <- data.table::fread(file = from, data.table = FALSE) + + # Rename columns + colnames(mgi_full_data) <- c("MGI Marker Accession ID", "Marker Symbol", "Status", "Marker Name", "cM Position", "Chromosome", "Type", "Secondary", "Entrez Gene ID", "Synonyms", "Feature Types", "Genome Coordinate Start", "Genome Coordinate End", "Strand", "BioTypes") + + # set accepted gene types + accepted_biotypes <- c("protein coding gene", "lncRNA gene" , "lincRNA gene", "antisense lncRNA gene") + + # filter data: Approved Genes > select relevant categories + mgi_filtered_data <- mgi_full_data %>% + filter(.data[["Status"]] == "O" & .data[["Type"]] == "Gene" & .data[["Chromosome"]] != "UN" & .data[["Feature Types"]] %in% accepted_biotypes) %>% + select(any_of(c("MGI Marker Accession ID", "Marker Symbol", "Status", "Synonyms", "Entrez Gene ID", "Type", "Feature Types"))) + + + mgi_long_data <- mgi_filtered_data %>% + select(any_of(c("Marker Symbol", "Synonyms"))) %>% + separate_wider_delim(cols = "Synonyms", delim = "|", names_sep = "_", names = NULL, too_few = "align_start") %>% + pivot_longer(cols = contains("Synonyms"), + names_to = "column", + values_to = "Synonyms", + values_drop_na = TRUE) %>% + mutate("Synonyms" = ifelse(.data[["Synonyms"]] %in% "", .data[["Marker Symbol"]], .data[["Synonyms"]])) + + # save processed data + saveRDS(mgi_long_data, file = to) + TRUE +} From 3ba05df5f95a0ec43e89720b05349baedc50eb24 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:11:24 -0400 Subject: [PATCH 497/503] Update mouse symbols --- R/Utilities.R | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) diff --git a/R/Utilities.R b/R/Utilities.R index 94287a8cf1..ec0e6a7ae2 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -2031,3 +2031,133 @@ Updated_HGNC_Symbols <- function( } +#' Update MGI Gene Symbols +#' +#' Update mouse gene symbols using data from MGI This function will store cached data in package directory using (BiocFileCache). Use of this function requires internet connection on first use (or if setting `update_symbol_data = TRUE`). Subsequent use does not require connection and will pull from cached data. +#' +#' @param input_data Data source containing gene names. Accepted formats are: +#' \itemize{ +#' \item \code{charcter vector} +#' \item \code{Seurat Objects} +#' \item \code{data.frame}: genes as rownames +#' \item \code{dgCMatrix/dgTMatrix}: genes as rownames +#' \item \code{tibble}: genes in first column +#' } +#' @param update_symbol_data logical, whether to update cached MGI data, default is NULL. +#' If `NULL` BiocFileCache will check and prompt for update if cache is stale. +#' If `FALSE` the BiocFileCache stale check will be skipped and current cache will be used. +#' If `TRUE` the BiocFileCache stale check will be skipped and MGI data will be downloaded. +#' @param verbose logical, whether to print results detailing numbers of symbols, found, updated, +#' and not found; default is TRUE. +#' +#' @return data.frame containing columns: input_features, Approved_Symbol (already approved; output unchanged), Not_Found_Symbol (symbol not in MGI; output unchanged), Updated_Symbol (new symbol from MGI; output updated). +#' +#' @import cli +#' @importFrom dplyr mutate filter select across left_join join_by +#' @importFrom magrittr "%>%" +#' @importFrom stats complete.cases +#' @importFrom stringr str_to_upper str_replace_na str_c str_replace +#' @importFrom tidyr drop_na everything +#' +#' @export +#' +#' @concept misc_util +#' +#' @examples +#' \dontrun{ +#' new_names <- Updated_MGI_Symbols(input_data = Seurat_Object) +#' } +#' + +Updated_MGI_Symbols <- function( + input_data, + update_symbol_data = NULL, + verbose = TRUE +) { + # Check BiocFileCache installed + BiocFileCache_check <- is_installed(pkg = "BiocFileCache") + if (isFALSE(x = BiocFileCache_check)) { + cli_abort(message = c( + "Please install the {.val BiocFileCache} package to use {.code Updated_HGNC_Symbols}", + "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}BiocFileCache{symbol$dquote_right})`}", + "----------------------------------------" + )) + } + + # Check input data type + accepted_types <- c("data.frame", "dgCMatrix", "dgTMatrix") + + if (inherits(x = input_data, what = "Seurat")) { + input_symbols <- Features(input_data) + } + if ((class(x = input_data) %in% accepted_types)) { + input_symbols <- rownames(x = input_data) + } + if (inherits(x = input_data, what = "tibble")) { + input_symbols <- input_data[, 1] + } + if (inherits(x = input_data, what = "character")) { + input_symbols <- input_data + } + + # Check for duplicates + num_duplicated <- length(x = unique(x = input_symbols[duplicated(x = input_symbols)])) + + if (num_duplicated > 0) { + cli_abort(message = c("Input data contains duplicate gene symbols.", + "i" = "Check input data and/or make unique.")) + } + + # Download and process HGNC dataset if not already cached + mgi_data_path <- download_mgi_data(update = update_symbol_data) + + mgi_long_data <- readRDS(mgi_data_path) + + input_features_df <- data.frame("input_features" = input_symbols) + + symbols_not_approved <- input_symbols[!input_symbols %in% mgi_long_data$symbol] + symbols_approved <- input_symbols[input_symbols %in% mgi_long_data$symbol] + + input_features_df_approved <- input_features_df %>% + mutate("Approved_Symbol" = ifelse(.data[["input_features"]] %in% symbols_approved, .data[["input_features"]], NA)) %>% + drop_na() + + + input_features_updated_df <- mgi_long_data %>% + filter(.data[["prev_symbol"]] %in% symbols_not_approved) %>% + mutate("Updated_Symbol" = symbol) %>% + select(any_of(c("prev_symbol", "Updated_Symbol"))) %>% + rename("input_features" = any_of("prev_symbol")) %>% + drop_na() + + symbols_not_found <- data.frame("input_features" = symbols_not_approved[!symbols_not_approved %in% input_features_updated_df$input_features]) %>% + mutate("Not_Found_Symbol" = .data[["input_features"]]) + + merged_df <- left_join(input_features_df, y = input_features_df_approved, by = join_by("input_features")) %>% + left_join(symbols_not_found, by = join_by("input_features")) %>% + left_join(input_features_updated_df, by = join_by("input_features")) %>% + mutate(across(everything(), ~str_replace_na(string = .x, replacement = ""))) %>% + mutate(Output_Features = str_c(.data[["Approved_Symbol"]], .data[["Not_Found_Symbol"]], .data[["Updated_Symbol"]])) %>% + mutate(across(everything(), ~str_replace(string = .x, pattern = "^$", replacement = NA_character_))) %>% + filter(!(.data[["input_features"]] == "QARS" & .data[["Updated_Symbol"]] == "EPRS1")) + + # Report the results + if (isTRUE(x = verbose)) { + num_features <- length(input_symbols) + + num_updated <- sum(complete.cases(merged_df$Updated_Symbol)) + num_not_found <- sum(complete.cases(merged_df$Not_Found_Symbol)) + num_approved <- sum(complete.cases(merged_df$Approved_Symbol)) + + cli_inform(message = c("Input features contained {.field {format(x = num_features, big.mark = ',')}} gene symbols", + "{col_green({symbol$tick})} {.field {format(x = num_approved, big.mark = ',')}} were already approved symbols.", + "{col_blue({symbol$arrow_right})} {.field {format(x = num_updated, big.mark = ',')}} were updated to approved symbol.", + "{col_red({symbol$cross})} {.field {format(x = num_not_found, big.mark = ',')}} were not found in MGI dataset and remain unchanged.")) + } + + # Return results + return(merged_df) +} From b849f720ffd84a13f86481db51551de0aa6d754f Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:12:43 -0400 Subject: [PATCH 498/503] Update namespace --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index aff94b0c58..df282618d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -169,6 +169,7 @@ export(Subset_LIGER) export(Top_Genes_Factor) export(UnRotate_X) export(Updated_HGNC_Symbols) +export(Updated_MGI_Symbols) export(VariableFeaturePlot_scCustom) export(Variable_Features_ALL_LIGER) export(VlnPlot_scCustom) From a5baf12749c3d4a20f908b40d80f6385f1691ab6 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:12:51 -0400 Subject: [PATCH 499/503] Update docs --- man/Updated_MGI_Symbols.Rd | 39 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 man/Updated_MGI_Symbols.Rd diff --git a/man/Updated_MGI_Symbols.Rd b/man/Updated_MGI_Symbols.Rd new file mode 100644 index 0000000000..4f970b3f74 --- /dev/null +++ b/man/Updated_MGI_Symbols.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{Updated_MGI_Symbols} +\alias{Updated_MGI_Symbols} +\title{Update MGI Gene Symbols} +\usage{ +Updated_MGI_Symbols(input_data, update_symbol_data = NULL, verbose = TRUE) +} +\arguments{ +\item{input_data}{Data source containing gene names. Accepted formats are: +\itemize{ +\item \code{charcter vector} +\item \code{Seurat Objects} +\item \code{data.frame}: genes as rownames +\item \code{dgCMatrix/dgTMatrix}: genes as rownames +\item \code{tibble}: genes in first column +}} + +\item{update_symbol_data}{logical, whether to update cached MGI data, default is NULL. +If \code{NULL} BiocFileCache will check and prompt for update if cache is stale. +If \code{FALSE} the BiocFileCache stale check will be skipped and current cache will be used. +If \code{TRUE} the BiocFileCache stale check will be skipped and MGI data will be downloaded.} + +\item{verbose}{logical, whether to print results detailing numbers of symbols, found, updated, +and not found; default is TRUE.} +} +\value{ +data.frame containing columns: input_features, Approved_Symbol (already approved; output unchanged), Not_Found_Symbol (symbol not in MGI; output unchanged), Updated_Symbol (new symbol from MGI; output updated). +} +\description{ +Update mouse gene symbols using data from MGI This function will store cached data in package directory using (BiocFileCache). Use of this function requires internet connection on first use (or if setting \code{update_symbol_data = TRUE}). Subsequent use does not require connection and will pull from cached data. +} +\examples{ +\dontrun{ +new_names <- Updated_MGI_Symbols(input_data = Seurat_Object) +} + +} +\concept{misc_util} From e6b561e5dcdf2a811b305cc0f931e1a869199c17 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 11:33:18 -0400 Subject: [PATCH 500/503] wrong code fix --- R/Internal_Utilities.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index e4585b49ed..ad6fac1fd8 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -2087,13 +2087,13 @@ download_mgi_data <- function( bfc <- .get_bioc_cache() # URL from https://www.genenames.org/download/statistics-and-files/ - hgnc_ftp_url <- "https://www.informatics.jax.org/downloads/reports/MGI_EntrezGene.rpt" + mgi_ftp_url <- "https://www.informatics.jax.org/downloads/reports/MGI_EntrezGene.rpt" - # bfc <- BiocFileCache::BiocFileCache(hgnc_ftp_url) + # bfc <- BiocFileCache::BiocFileCache(mgi_ftp_url) - rid <- BiocFileCache::bfcquery(bfc, hgnc_ftp_url, "fpath")$rid + rid <- BiocFileCache::bfcquery(bfc, mgi_ftp_url, "fpath")$rid if (!length(rid)) { # not in cache, add but do not download - rid <- names(BiocFileCache::bfcadd(bfc, hgnc_ftp_url, download = FALSE)) + rid <- names(BiocFileCache::bfcadd(bfc, mgi_ftp_url, download = FALSE)) } if (isTRUE(x = update)) { @@ -2104,8 +2104,8 @@ download_mgi_data <- function( # download & process if (!isFALSE(x = update)) { - cli_inform(message = "Downloading MGI data from: {.field {hgnc_ftp_url}}") - BiocFileCache::bfcdownload(bfc, rid, ask = FALSE, FUN = process_hgnc_data) + cli_inform(message = "Downloading MGI data from: {.field {mgi_ftp_url}}") + BiocFileCache::bfcdownload(bfc, rid, ask = FALSE, FUN = process_mgi_data) } rpath <- BiocFileCache::bfcrpath(bfc, rids=rid) # path to processed result From 06b337a6c19c93f093d419370b1caab16542aa32 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 12:21:36 -0400 Subject: [PATCH 501/503] add back column names --- R/Internal_Utilities.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/Internal_Utilities.R b/R/Internal_Utilities.R index ad6fac1fd8..b182c15dcb 100644 --- a/R/Internal_Utilities.R +++ b/R/Internal_Utilities.R @@ -2206,6 +2206,7 @@ process_mgi_data <- function( values_drop_na = TRUE) %>% mutate("Synonyms" = ifelse(.data[["Synonyms"]] %in% "", .data[["Marker Symbol"]], .data[["Synonyms"]])) + colnames(mgi_long_data) <- c("symbol", "column", "prev_symbol") # save processed data saveRDS(mgi_long_data, file = to) TRUE From 4f17938e3ef160604ed79757287574fea93d9f04 Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 12:25:10 -0400 Subject: [PATCH 502/503] update changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index d2ab029a57..cf93dc0ef5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -49,6 +49,7 @@ - Explicitly reveal the `reduction` parameter in `Cluster_Highlight_Plot` and `Meta_Highlight_Plot` ([#198](https://github.com/samuel-marsh/scCustomize/issues/198)). - Added `show_row_names` `show_column_names`, `column_names_side`, `row_names_side`, `legend_position`, `legend_orientation`, `show_ident_legend`, and `show_ident_colors` parameters to `Clustered_DotPlot`. Thanks for idea and code @johnminglu ([#199](https://github.com/samuel-marsh/scCustomize/issues/199)). - Updated `Split_Vector` to allow user to specify number of chunks or size of chunks for splitting vector. +- Added `Updated_MGI_Symbols` to check for update gene names/symbols in mouse data ([#202](https://github.com/samuel-marsh/scCustomize/issues/202)). From d64310f7a5f68309c9685f1dbf44aad2e71a81ff Mon Sep 17 00:00:00 2001 From: samuel-marsh Date: Fri, 13 Sep 2024 12:25:18 -0400 Subject: [PATCH 503/503] bump version and date --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a6f6358712..503efae287 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" RRID:SCR_024675. -Version: 2.1.2.9076 -Date: 2024-09-12 +Version: 2.1.2.9077 +Date: 2024-09-13 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"),