diff --git a/.Rbuildignore b/.Rbuildignore index ec9271d1..c47772ae 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,4 +10,6 @@ pipeline_stores ^data/theme_multipanel\.rda$ ^inst/rmd/.*\\.html$ ^[^/]*\.r$ -^tests$ \ No newline at end of file +^tests$ +_targets +target_framework \ No newline at end of file diff --git a/.gitignore b/.gitignore index ca0eaf47..cf3d9cf6 100644 --- a/.gitignore +++ b/.gitignore @@ -15,6 +15,11 @@ input_reference.rds reference_azimuth.rds temp_computing_resources.rds tissue.rds +data_container_type.rds +sample_names.rds +temp_fx.rds +temp_gene_nomenclature.rds +RNA_feature_thresh.rds # Exclude pipeline and scripts directories and files pipeline_store pipeline_store.R @@ -28,3 +33,4 @@ fibrosis_data !README.md _target* dev +meta diff --git a/DESCRIPTION b/DESCRIPTION index 399ec1d4..e22097c1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: HPCell Title: Massively-parallel R native pipeline for single-cell analysis -Version: 0.2.1 +Version: 0.3.14 Authors@R: c(person("Stefano", "Mangiola", email = "mangiolastefano@gmail.com", role = c("aut", "cre")), person("Jiayi", "Si", email = "si.j@wehi.edu.au", @@ -11,7 +11,12 @@ License: GPL-3 Roxygen: list(markdown = TRUE) Depends: R (>= 4.2.0) -Remotes: sqjin/CellChat +Remotes: + sqjin/CellChat, + satijalab/seurat@seurat5, + satijalab/seurat-data@seurat5, + satijalab/azimuth@master, + mojaveazure/seurat-disk@master Biarch: true Imports: targets, @@ -29,7 +34,7 @@ Imports: tidyr, glue, stringr, - tidyseurat, + tidyseurat (>= 0.8.0), purrr, readr, patchwork, @@ -40,7 +45,6 @@ Imports: SingleR, celldex, scuttle, - CellChat, gridGraphics, scDblFinder, magrittr, @@ -57,22 +61,25 @@ Imports: future.apply, ids, RColorBrewer, - digest, - cowplot, - igraph, reshape2, - callr, future, methods, pbapply, - reshape2, scales, data.table, ggplot2, ggupset, here, qs, - ensembldb + ensembldb, + Azimuth, + DelayedArray, + HDF5Array, + SeuratObject, + SingleCellExperiment, + biomaRt, + lme4, + tidyselect Suggests: testthat(>= 3.0.0), scRNAseq, diff --git a/Empty_droplet_report.qmd b/Empty_droplet_report.qmd new file mode 100644 index 00000000..6803f5a5 --- /dev/null +++ b/Empty_droplet_report.qmd @@ -0,0 +1,346 @@ +--- +title: "Empty_droplet_report" +format: html +editor: visual +params: + empty_tbl: "NA" + data_object: "NA" + alive_tbl: "NA" + sample_name: "NA" +--- + +## Empty Droplet Report + +```{r, include = FALSE} +# empty_tbl <- params$empty_tbl +# data_object <- params$data_object +# alive_tbl<- params$alive_tbl +# sample_name<- params$sample_name + +library(HPCell) +library(readr) +library(dplyr) +library(tidyr) +library(ggplot2) +library(purrr) +library(Seurat) +library(tidyseurat) +library(glue) +library(scater) +library(DropletUtils) +library(EnsDb.Hsapiens.v86) +library(here) +library(stringr) +library(rlang) +library(scuttle) +library(scDblFinder) +library(ggupset) +library(tidySummarizedExperiment) +library(broom) +library(tarchetypes) +library(SeuratObject) +library(SingleCellExperiment) +library(SingleR) +library(celldex) +library(tidySingleCellExperiment) +library(tibble) +library(magrittr) +library(qs) +library(S4Vectors) +library(gridExtra) + +# sample_column <- "orig.ident" + +# Calculate_UMAP +calc_UMAP <- function(input_seurat) { + assay_name <- input_seurat@assays |> names() |> extract2(1) + + # Check if variable features are already present, if not calculate them + if (length(VariableFeatures(input_seurat)) == 0) { + input_seurat <- FindVariableFeatures(input_seurat) + } + + # Extract variable features using VariableFeatures() for Seurat v5 + var_genes <- VariableFeatures(input_seurat) + + # Ensure that there are variable features before proceeding + if (length(var_genes) > 0) { + # Scale data and run PCA on variable genes + x <- ScaleData(input_seurat) |> + RunPCA(features = var_genes) |> + FindNeighbors(dims = 1:30) |> + FindClusters(resolution = 0.5) |> + RunUMAP(dims = 1:30, spread = 0.5, min.dist = 0.01, n.neighbors = 10L) |> + as_tibble() + } else { + stop("No variable features available for UMAP calculation.") + } + + return(x) +} + +calc_UMAP_dbl_report <- map(data_object, calc_UMAP) + +extract_metadata <- function(seurat_obj, sample_name) { + seurat_obj@meta.data %>% + rownames_to_column(var = ".cell") %>% + mutate(sample = sample_name) +} + +meta_data_list <- map2(data_object, sample_name, ~ extract_metadata(.x, .y)) + +# Function to merge meta data with another processed tibble data +merge_meta <- function(meta_data, data_to_merge) { + left_join(meta_data, data_to_merge, by = ".cell") +} +``` + +Barcode rank plot + +```{r, echo=FALSE, message=FALSE, warning=FALSE, fig.width=12, fig.height=7} +# names(empty_droplets_tbl_list) <- unique_samples_list +# Process empty droplets data +empty_df <- function(input_metadata, empty_droplets_tbl, sample_name) { + # input <- input_metadata |> + # # input_seurat@meta.data |> + # tibble::rownames_to_column(var = '.cell') + #browser() + joined_data <- empty_droplets_tbl |> + left_join(input_metadata |> dplyr::select(.cell), by = '.cell') + + # Create a data frame with plotting information + plot_data <- data.frame( + x = joined_data$rank, + y = joined_data$Total, + rank = joined_data$rank, + inflection = joined_data$inflection, + knee = joined_data$knee, + fitted = joined_data$fitted, + empty = joined_data$empty_droplet, + FDR = joined_data$FDR, + Total = joined_data$Total, + PValue = joined_data$PValue, + sample_name = sample_name + ) + return(plot_data) +} + +process_empty_droplet_list <- purrr::pmap( + list(meta_data_list, empty_tbl, sample_name), + ~ empty_df(..1, ..2, ..3) +) + +# Combined tibble with an identifier for each tissue/sample +combined_df <- bind_rows(process_empty_droplet_list) + +# Generate plot +plot <- ggplot(combined_df, aes(x = x, y = y)) + + geom_point(color = 'lightblue', alpha = 0.5) + + scale_x_log10() + + scale_y_log10() + + geom_line(aes(x = rank, y = fitted), color='darkblue') + + geom_hline(aes(yintercept = knee), color='red') + + geom_hline(aes(yintercept = inflection), color='forestgreen') + + scale_linetype_manual(values = c("knee" = "dashed", "inflection" = "dashed"), + guide = guide_legend(override.aes = list(color = c("forestgreen", "red"))) + ) + + facet_wrap(~sample_name, scales = "free") + + theme_minimal() + + labs(x = "Barcodes", y = "Total UMI count", color = "Legend") + + theme(legend.position = "bottom") + +print(plot) +``` + +Percentage of reads assigned to mitochondrial transcrips against library size + +- Scatter plot comparing mitochondrial content percentage to total count of RNA sequencing reads across different samples (in this case tissues) + +- The X-axis is on a logarithmic scale and represents the total count of RNA sequencing reads per cell, while the Y-axis shows the percentage of those reads that are mitochondrial. Each point on the plot represents a single cell. + +```{r, echo=FALSE, message=FALSE, warning=FALSE, fig.width=12, fig.height=7} + +merged_alive <- map2(meta_data_list, alive_tbl, merge_meta) +combined_merged_alive <- bind_rows(merged_alive) + +# Function to process and prepare data for mitochondrial plotting +plot_mito_data <- function(input_seurat, tissue_name, alive_identification) { + # Calculate per-cell mitochondrial QC metrics + mitochondrion <- alive_identification %>% + group_by(sample) %>% + mutate( + discard = as.logical(isOutlier(subsets_Mito_percent, type = "higher")), + threshold = as.numeric(attr(isOutlier(subsets_Mito_percent, type = "higher"), "threshold")["higher"]), + tissue_name = tissue_name + ) %>% + ungroup() + + # Prepare data frame for plotting + plot_mito <- mitochondrion %>% + dplyr::select( + tissue_name, + subsets_Mito_percent, + subsets_Mito_sum, + discard, + threshold, + high_mitochondrion = discard # Rename discard to high_mitochondrion for clarity + ) + + return(plot_mito) +} + +# Apply the function to a list of samples and combine all data +all_data <- lapply(seq_along(data_object), function(i) { + plot_mito_data(meta_data_list[[i]], sample_name[[i]], merged_alive[[i]]) +}) + +# Combine all data into a single tibble +combined_plot_mito_data <- bind_rows(all_data) + +# Function to plot mitochondrial content per tissue +plot_each_sample <- function(combined_plot_mito_data) { + num_tissues <- length(unique(combined_plot_mito_data$tissue_name)) + + ggplot(combined_plot_mito_data, aes(x = subsets_Mito_sum, y = subsets_Mito_percent)) + + facet_wrap(~ tissue_name) + + geom_point(aes(color = high_mitochondrion), alpha = 0.5) + + #scale_x_log10() + + geom_hline(aes(yintercept = threshold), color = "red", linetype = "dashed") + + labs( + x = "Total count", + y = "Mitochondrial %", + title = paste("Percentage library size vs. library size with", num_tissues, "tissue types"), + color = "High mitochondrial percentage" + ) + + theme_minimal() +} + +# Plot all tissues +plot_each_sample(combined_plot_mito_data) + +``` + +Proportion of empty droplets + +- Number and proportion of cells (non-empty droplets), everything above knee is retained. + +```{r, warning=FALSE, message=FALSE, echo=FALSE} +empty_count <- function(df) { + # Count the TRUE and FALSE values in the empty_droplet column + tibble <- df %>% + group_by(sample_name) %>% + summarise( + Empty_count = sum(empty == TRUE), + Cell_count = sum(empty == FALSE) + ) + return(tibble) +} + +# Apply the function to the combined_df +empty_count_results <- empty_count(combined_df) +empty_count_results +``` + +Number of non-empty droplets + +```{r, warning=FALSE, message=FALSE, echo=FALSE} +# Number of non-empty droplets ------------------------------------------------- +empty_table <- function(df) { + # Count the TRUE and FALSE values in the empty_droplet column + tibble <- df %>% + group_by(sample_name) %>% + summarise( + "Number: True cells (FDR<0.001)" = sum(FDR < 0.001, na.rm = TRUE), # Count of FDR values less than 0.001 + "Proportion: True cells (FDR<0.001)" = mean(FDR < 0.001, na.rm = TRUE) # Proportion of FDR values less than 0.001 + ) + return(tibble) +} +empty_count_results <- empty_table(combined_df) +empty_count_results +``` + +Count of cells vs empty droplets + +```{r, warning=FALSE, message=FALSE, echo=FALSE} +count <- function(df) { + # is.cell <- df$FDR <= 0.001 + tibble<- df %>% + group_by(sample_name) %>% + summarise( + Cells = sum(FDR, na.rm = TRUE), # Count of TRUE values, NA values removed + Empty_droplets = sum(!FDR, na.rm = TRUE) # Count of FALSE values, NA values removed + ) + return(tibble) +} +count_results <- count(combined_df) +count_results +``` + +Histogram of p-values + +- Shows the distribution of p-values for droplets in the lower 10 percentile of total within each tissue +- A low p-value signifies significance therefore we would reject those droplets as empty + +```{r, echo=FALSE, message=FALSE, warning=FALSE, fig.width=12, fig.height=7} +hist_p_val <- function(df) { + if(df |> dplyr::filter(empty) |> nrow() != 0){ + df_filtered <- df %>% + group_by(sample_name) %>% + dplyr::filter(empty) %>% + mutate(Total_quantile = quantile(Total[Total > 0], 0.1)) %>% + dplyr::filter(Total <= Total_quantile & Total > 0) %>% + ungroup() + +plot_hist <- ggplot(df_filtered, aes(x = PValue)) + + geom_histogram(binwidth = 0.2, fill = "cornflowerblue", color = "grey") + + facet_wrap(~ sample_name) + + labs(x = "P-value", y = "Frequency") + + ggtitle("Droplets with 0 < libsize <= 10th Percentile of Total per Tissue") + + theme_minimal() +}} + +plot_hist <- hist_p_val(combined_df) +plot_hist +``` + +Mitochondrial gene expression and ribosomal protein expression across samples + +- UMAP plots constructed from barcodes that were detected with EmptyDrops +- Each point represents a barcode and is colored based on its Mitochondrial/ Ribosomal percentage + +```{r, warning=FALSE, message=FALSE, echo=FALSE, fig.width=20, fig.height=10} +merge_umap_with_metadata <- function(umap_data, metadata, sample) { + umap_data |> + dplyr::select(.cell, umap_1, umap_2) |> + left_join(metadata, by = ".cell") |> + mutate(sample = sample) # Merge with metadata +} + +# Merge UMAP data with combined_merged_alive and add sample names +umap_merged_data <- map2(calc_UMAP_dbl_report, sample_name, ~ merge_umap_with_metadata(.x, combined_merged_alive, .y)) + +combined_umap_merged <- bind_rows(umap_merged_data) + +# Plot for mitochondrial gene expression +plot_mito <- ggplot(combined_umap_merged, aes(x = umap_1, y = umap_2, color = subsets_Mito_percent)) + + geom_point(alpha = 0.6) + # Add transparency for better visualization + scale_color_gradient(low = "blue", high = "red") + + labs(title = "Mitochondrial Gene Expression", x = "UMAP1", y = "UMAP2") + + theme_minimal() + + facet_wrap(~ sample) + +# Plot for ribosomal gene expression +plot_ribo <- ggplot(combined_umap_merged, aes(x = umap_1, y = umap_2, color = subsets_Ribo_percent)) + + geom_point(alpha = 0.6) + # Add transparency for better visualization + scale_color_gradient(low = "blue", high = "red") + + labs(title = "Ribosomal Protein Expression", x = "UMAP1", y = "UMAP2") + + theme_minimal() + + facet_wrap(~ sample) + +# combined_plot <- grid.arrange(plot_mito, plot_ribo, ncol = 2) + +combined_plot <- plot_mito + plot_ribo + +# Show the combined plot +combined_plot +``` diff --git a/NAMESPACE b/NAMESPACE index 2009c44a..90145a52 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,27 +2,41 @@ S3method(annotate_cell_type,HPCell) S3method(calculate_pseudobulk,HPCell) +S3method(celltype_consensus_constructor,HPCell) +S3method(cluster_metacell,HPCell) S3method(evaluate_hpc,HPCell) S3method(get_single_cell,HPCell) +S3method(ligand_receptor_cellchat,HPCell) S3method(normalise_abundance_seurat_SCT,HPCell) S3method(print,HPCell) S3method(remove_dead_scuttle,HPCell) S3method(remove_doublets_scDblFinder,HPCell) S3method(remove_empty_DropletUtils,HPCell) S3method(remove_empty_DropletUtils,Seurat) +S3method(remove_empty_threshold,HPCell) +S3method(remove_empty_threshold,Seurat) S3method(score_cell_cycle_seurat,HPCell) -S3method(tranform_assay,HPCell) +S3method(transform_assay,HPCell) export(alive_identification) export(annotate_cell_type) -export(annotation_consensus) export(annotation_label_transfer) +export(calc_UMAP) export(calculate_pseudobulk) +export(cell_communication) export(cell_cycle_scoring) +export(cell_type_ensembl_harmonised) +export(celltype_consensus_constructor) +export(clean_cellxgene_cell_types) +export(cluster_metacell) +export(computeCommunProbPathway) +export(compute_mode_delayedarray) export(convert_gene_names) export(create_pseudobulk) export(delete_lines_with_word) export(doublet_identification) export(empty_droplet_id) +export(empty_droplet_threshold) +export(ensemble_annotation) export(evaluate_hpc) export(factory_de_fix_effect) export(factory_de_random_effect) @@ -40,6 +54,7 @@ export(hpc_single) export(initialise_hpc) export(internal_de_function) export(is_target) +export(ligand_receptor_cellchat) export(map2_test_differential_abundance_hpc) export(map_add_dispersion_to_se) export(map_de) @@ -49,30 +64,37 @@ export(map_split_se_by_number_of_genes) export(map_test_differential_abundance) export(non_batch_variation_removal) export(normalise_abundance_seurat_SCT) +export(postprocess_SCimplify) +export(preprocess_SCimplify) export(preprocessing_output) export(pseudobulk_merge) export(read_data_container) +export(reference_annotation_to_consensus) export(reference_label_coarse_id) export(reference_label_fine_id) export(remove_dead_scuttle) export(remove_doublets_scDblFinder) export(remove_empty_DropletUtils) -export(run_targets_pipeline) +export(remove_empty_threshold) +export(save_experiment_data) export(score_cell_cycle_seurat) export(se_add_dispersion) -export(seurat_to_ligand_receptor_count) +export(split_sample_cell_type_calculate_metacell_membership) export(split_summarized_experiment) +export(target_append) export(test_differential_abundance_hpc) -export(tranform_assay) +export(transform_assay) export(transform_utility) export(vector_to_code) exportMethods(test_differential_abundance) +import(DelayedArray) +import(Seurat) import(SeuratObject) +import(SingleCellExperiment) import(broom) import(crew) import(crew.cluster) import(dplyr) -import(future.apply) import(ggplot2) import(ggupset) import(here) @@ -84,23 +106,26 @@ import(tidySingleCellExperiment) import(tidySummarizedExperiment) import(tidyseurat) importFrom(AnnotationDbi,mapIds) +importFrom(Azimuth,RunAzimuth) importFrom(CellChat,aggregateNet) -importFrom(CellChat,computeExpr_LR) -importFrom(CellChat,computeExpr_agonist) -importFrom(CellChat,computeExpr_coreceptor) -importFrom(CellChat,computeRegionDistance) +importFrom(CellChat,computeCommunProb) importFrom(CellChat,createCellChat) importFrom(CellChat,filterCommunication) importFrom(CellChat,identifyOverExpressedGenes) importFrom(CellChat,identifyOverExpressedInteractions) -importFrom(CellChat,projectData) +<<<<<<< HEAD +importFrom(CellChat,normalizeData) +======= +importFrom(CellChat,smoothData) importFrom(CellChat,scPalette) importFrom(CellChat,searchPair) +>>>>>>> b129b6212876a8e990ca906908ba9ff2aa72d40d importFrom(CellChat,setIdent) +importFrom(CellChat,smoothData) importFrom(CellChat,subsetCommunication) importFrom(CellChat,subsetDB) importFrom(CellChat,subsetData) -importFrom(CellChat,triMean) +importFrom(DelayedArray,blockApply) importFrom(DropletUtils,barcodeRanks) importFrom(DropletUtils,emptyDrops) importFrom(EnsDb.Hsapiens.v86,EnsDb.Hsapiens.v86) @@ -108,10 +133,11 @@ importFrom(HDF5Array,loadHDF5SummarizedExperiment) importFrom(HDF5Array,saveHDF5SummarizedExperiment) importFrom(Matrix,Matrix) importFrom(Matrix,colSums) -importFrom(RColorBrewer,brewer.pal) +importFrom(Matrix,t) importFrom(S4Vectors,cbind) importFrom(S4Vectors,metadata) importFrom(S4Vectors,split) +importFrom(Seurat,Assays) importFrom(Seurat,CellCycleScoring) importFrom(Seurat,CreateAssayObject) importFrom(Seurat,CreateSeuratObject) @@ -131,36 +157,39 @@ importFrom(Seurat,ScaleData) importFrom(Seurat,VariableFeatures) importFrom(Seurat,as.Seurat) importFrom(Seurat,as.SingleCellExperiment) +importFrom(SeuratObject,RenameAssays) importFrom(SingleCellExperiment,"altExp<-") +importFrom(SingleCellExperiment,"reducedDim<-") importFrom(SingleCellExperiment,SingleCellExperiment) importFrom(SingleCellExperiment,altExp) importFrom(SingleR,SingleR) importFrom(SummarizedExperiment,"assay<-") +importFrom(SummarizedExperiment,"assayNames<-") +importFrom(SummarizedExperiment,"assays<-") importFrom(SummarizedExperiment,"colData<-") importFrom(SummarizedExperiment,"rowData<-") importFrom(SummarizedExperiment,SummarizedExperiment) importFrom(SummarizedExperiment,assay) +importFrom(SummarizedExperiment,assayNames) importFrom(SummarizedExperiment,assays) importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) +importFrom(SuperCell,build_knn_graph) +importFrom(biomaRt,getBM) +importFrom(biomaRt,useMart) importFrom(callr,r) importFrom(celldex,BlueprintEncodeData) importFrom(celldex,MonacoImmuneData) -importFrom(circlize,colorRamp2) -importFrom(cowplot,as_grob) importFrom(crew,crew_controller_local) importFrom(data.table,":=") importFrom(digest,digest) -importFrom(dplyr,"%>%") -importFrom(dplyr,across) -importFrom(dplyr,add_count) importFrom(dplyr,as_tibble) -importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) importFrom(dplyr,count) importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,group_by) +importFrom(dplyr,group_split) importFrom(dplyr,if_else) importFrom(dplyr,join_by) importFrom(dplyr,left_join) @@ -172,18 +201,20 @@ importFrom(dplyr,rename) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,tibble) +importFrom(dplyr,tribble) importFrom(dplyr,with_groups) importFrom(edgeR,estimateDisp) -importFrom(future,nbrOfWorkers) importFrom(future,tweak) importFrom(glue,glue) -importFrom(grid,grid.grab) -importFrom(gridGraphics,grid.echo) importFrom(here,here) importFrom(ids,random_id) -importFrom(igraph,graph_from_adjacency_matrix) -importFrom(igraph,in_circle) -importFrom(igraph,layout_) +importFrom(igraph,E) +importFrom(igraph,V) +importFrom(igraph,cluster_louvain) +importFrom(igraph,cluster_walktrap) +importFrom(igraph,contract) +importFrom(igraph,simplify) +importFrom(irlba,irlba) importFrom(lme4,findbars) importFrom(magrittr,"%$%") importFrom(magrittr,"%>%") @@ -191,39 +222,35 @@ importFrom(magrittr,divide_by) importFrom(magrittr,extract2) importFrom(magrittr,not) importFrom(magrittr,set_names) +importFrom(methods,as) importFrom(methods,show) -importFrom(methods,slot) -importFrom(patchwork,wrap_elements) -importFrom(pbapply,pbsapply) +importFrom(proxy,dist) importFrom(purrr,compact) importFrom(purrr,imap) importFrom(purrr,map) importFrom(purrr,map2) -importFrom(purrr,map2_dbl) importFrom(purrr,map_chr) importFrom(purrr,map_int) -importFrom(purrr,rep_along) importFrom(purrr,safely) importFrom(purrr,set_names) -importFrom(purrr,when) -importFrom(readr,read_csv) importFrom(readr,write_lines) -importFrom(reshape2,melt) importFrom(rlang,enquo) importFrom(rlang,is_symbolic) importFrom(rlang,parse_expr) importFrom(rlang,quo_is_symbolic) -importFrom(rlang,quo_name) +importFrom(rlang,rep_along) +importFrom(rlang,set_names) importFrom(rlang,sym) -importFrom(scales,rescale) -importFrom(scales,viridis_pal) importFrom(scater,isOutlier) importFrom(scuttle,logNormCounts) importFrom(scuttle,perCellQCMetrics) importFrom(stats,as.formula) +importFrom(stats,density) importFrom(stats,model.matrix) +importFrom(stats,prcomp) importFrom(stats,terms) importFrom(stats,update) +importFrom(stats,var) importFrom(stringr,str_c) importFrom(stringr,str_detect) importFrom(stringr,str_remove) @@ -237,13 +264,15 @@ importFrom(targets,tar_config_get) importFrom(targets,tar_option_set) importFrom(targets,tar_script) importFrom(tibble,as_tibble) +importFrom(tibble,deframe) importFrom(tibble,enframe) importFrom(tibble,rowid_to_column) +importFrom(tibble,rownames_to_column) importFrom(tibble,tibble) importFrom(tidybulk,as_SummarizedExperiment) importFrom(tidybulk,pivot_transcript) importFrom(tidybulk,test_differential_abundance) -importFrom(tidyr,gather) +importFrom(tidyr,expand_grid) importFrom(tidyr,nest) importFrom(tidyr,pivot_longer) importFrom(tidyr,replace_na) @@ -251,4 +280,5 @@ importFrom(tidyr,unite) importFrom(tidyr,unnest) importFrom(tidyselect,all_of) importFrom(tidyseurat,aggregate_cells) +importFrom(utils,capture.output) importMethodsFrom(ensembldb,genes) diff --git a/Pipeline_benchmarking_script.R b/Pipeline_benchmarking_script.R index 5e719527..9e301cd0 100644 --- a/Pipeline_benchmarking_script.R +++ b/Pipeline_benchmarking_script.R @@ -2,16 +2,22 @@ install.packages("lobstr") library(lobstr) # Defining resources -Cores <- c(3, 5 ,10, 20, 50, 100, 200) -Sample_size <- c(10, 20, 50, 100) +Cores <- c(3) +Sample_size <- c(1,2, 5, 10, 20, 50, 100, 137) +#Sample_size <- c(2, 5, 10, 20, 50) +#Sample_size <- c(2, 5, 10, 20, 50, 100, 138) + -Cores<- c(3, 5 ,10, 20, 50, 100, 200) -Sample_size<- c(1, 2, 3, 5) setwd("/vast/scratch/users/si.j/susan_fibrosis") +#setwd("/stornext/General/scratch/GP_Transfer/susan_fibrosis") #initial_file_count <- 2 files <- list.files() -store <- "/stornext/General/scratch/GP_Transfer/si.j/store_pipeline_benchmark_fibrosis_all_data_3" +length(files) +store <- "/stornext/General/scratch/GP_Transfer/si.j/benchmark_store" + +#store_contents <- list.files(store) +#need_invalidate <- length(store_contents) > 0 # for (i in initial_file_count:length(files)) { # # tar_invalidate(names = everything(), store = store) @@ -22,7 +28,6 @@ store <- "/stornext/General/scratch/GP_Transfer/si.j/store_pipeline_benchmark_fi # } else { # mem_before <- 0 # } - for(core in Cores) { for(sample_size in Sample_size) { if(length(files) < sample_size) { @@ -45,32 +50,34 @@ for(core in Cores) { slurm_memory_gigabytes_per_cpu = 20, slurm_cpus_per_task = 1, workers = total_workers, - verbose = FALSE + verbose = FALSE, + seconds_idle = 30 ) - # Time and run your pipeline function - time_taken <- system.time({ - preprocessed_seurat <- run_targets_pipeline( - input_data = file_subset, - tissue = "pbmc", - computing_resources = computing_resources, - sample_column = "sampleName", - store = store, - input_reference = NULL, - cell_type_annotation_column = "cellAnno" - ) - }) - - # Memory usage after pipeline execution - #mem_after <- obj_size(get("preprocessed_seurat", envir = globalenv())) - #mem_used_this_run <- mem_after - mem_before - - # Output the time and memory used for this run - cat("Running with", core, "cores for", sample_size, "samples, using", total_workers, "workers\n") - cat("Sample size:", length(file_subset), "\n", - "Time taken: User time =", time_taken["user.self"], - "System time =", time_taken["sys.self"], - "Elapsed time =", time_taken["elapsed"], "seconds\n") - #"Memory used:", format(mem_used_this_run, units = "Mb"), "\n\n") + # Time and run your pipeline function + #setwd("~/HPCell") + time_taken <- system.time({ + preprocessed_seurat <- run_targets_pipeline( + input_data = file_subset, + tissue = "pbmc", + computing_resources = computing_resources, + sample_column = "sampleName", + store = store, + input_reference = NULL, + cell_type_annotation_column = "cellAnno" + ) + }) + + # Memory usage after pipeline execution + #mem_after <- obj_size(get("preprocessed_seurat", envir = globalenv())) + #mem_used_this_run <- mem_after - mem_before + + # Output the time and memory used for this run + cat("Running with", core, "cores for", sample_size, "samples, using", total_workers, "workers\n") + cat("Sample size:", length(file_subset), "\n", + "Time taken: User time =", time_taken["user.self"], + "System time =", time_taken["sys.self"], + "Elapsed time =", time_taken["elapsed"], "seconds\n") + #"Memory used:", format(mem_used_this_run, units = "Mb"), "\n\n") } } @@ -97,4 +104,108 @@ ggplot(data_melted, aes(x = SampleSize, y = value, colour = variable)) + theme_minimal() + labs(x = "Sample Size", y = "Time (seconds)", title = "Performance Metrics by Sample Size", color = "Metric") + scale_colour_manual(values = c("UserTime" = "cornflowerblue", "SystemTime" = "slategrey", "ElapsedTime" = "coral")) + + + +### Rewriting alternative script +# Defining resources +Cores <- c(16) +Sample_size <- c(1, 2, 5, 10, 20, 50) + +setwd("/stornext/General/scratch/GP_Transfer/susan_fibrosis/") +files <- list.files() +store <- "/stornext/General/scratch/GP_Transfer/si.j/store_pipeline_benchmark_fibrosis_all_data_3" + +# Initialize results dataframe +results <- data.frame(SampleNumber = integer(), DataSize = numeric(), RunningTimeMin = numeric(), Cores = integer()) + +for(core in Cores) { + for(sample_size in Sample_size) { + if(length(files) < sample_size) { + break # Break if the sample_size exceeds the available files + } + + #tar_invalidate(names = everything(), store = store) + + # Select the subset of files to process in this iteration + file_subset <- files[1:sample_size] + total_workers <- min(core, length(file_subset)) + + # Initialize computing resources for all files + computing_resources = crew_controller_slurm( + name = "my_controller", + slurm_memory_gigabytes_per_cpu = 20, + slurm_cpus_per_task = 1, + workers = total_workers, + verbose = FALSE + ) + + # Time and run your pipeline function + time_taken <- system.time({ + preprocessed_seurat <- run_targets_pipeline( + input_data = file_subset, + tissue = "pbmc", + computing_resources = computing_resources, + sample_column = "sampleName", + store = store, + input_reference = NULL, + cell_type_annotation_column = "cellAnno" + ) + }) + + + # Output the results + results <- rbind(results, data.frame( + SampleNumber = sample_size, + DataSize = data_size, + RunningTimeMin = time_taken["elapsed"] / 60, # Convert seconds to minutes + Cores = core + )) + + cat("Running with", core, "cores for", sample_size, "samples, using", total_workers, "workers\n") + cat("Sample size:", length(file_subset), "\n", + "Time taken: User time =", time_taken["user.self"], + "System time =", time_taken["sys.self"], + "Elapsed time =", time_taken["elapsed"], "seconds\n") + } +} + +# Save the results to a CSV file +write.csv(results, "benchmark_results.csv", row.names = FALSE) + +### PLOTTING + +library(ggplot2) +library(reshape2) + +# Melting data for ggplot +data_melted <- melt(results, id.vars = "SampleNumber") + +# Plotting +ggplot(data_melted, aes(x = SampleNumber, y = value, colour = variable)) + + geom_line() + + geom_point() + + theme_minimal() + + labs(x = "Sample Number", y = "Value", title = "Performance Metrics by Sample Number", color = "Metric") + + scale_colour_manual(values = c("DataSize" = "cornflowerblue", "RunningTimeMin" = "slategrey", "Cores" = "coral", "TotalMemoryGB" = "purple")) + + + + + + + + + + + + + + + + + + + + diff --git a/R/CellChat.R b/R/CellChat.R index e230ba60..e66d3da7 100644 --- a/R/CellChat.R +++ b/R/CellChat.R @@ -952,7 +952,7 @@ grab_grob <- function(){ #' @importFrom CellChat subsetData #' @importFrom CellChat identifyOverExpressedGenes #' @importFrom CellChat identifyOverExpressedInteractions -#' @importFrom CellChat projectData +#' @importFrom CellChat smoothData #' @importFrom CellChat filterCommunication #' @importFrom CellChat aggregateNet #' @importFrom rlang quo_name @@ -1009,7 +1009,7 @@ seurat_to_ligand_receptor_count = function(counts, .cell_group, assay, sample_fo subsetData() |> identifyOverExpressedGenes() |> identifyOverExpressedInteractions() |> - projectData(CellChat::PPI.human) + smoothData(CellChat::PPI.human) if(nrow(x@LR$LRsig)==0) return(NA) diff --git a/R/HPCell.R b/R/HPCell.R new file mode 100644 index 00000000..eca676cb --- /dev/null +++ b/R/HPCell.R @@ -0,0 +1,7 @@ +.myDataEnv <- new.env(parent = emptyenv()) # not exported + +.data_internal <- function(dataset) { + if (!exists(dataset, envir = .myDataEnv)) { + utils::data(list = c(dataset), envir = .myDataEnv) + } +} \ No newline at end of file diff --git a/R/cell_type_curated_constructor.R b/R/cell_type_curated_constructor.R new file mode 100644 index 00000000..16a1afaa --- /dev/null +++ b/R/cell_type_curated_constructor.R @@ -0,0 +1,309 @@ +# Define the generic function +#' @export +celltype_consensus_constructor <- function(input_hpc, + target_input = "data_object", + target_output = "cell_type_concensus_tbl", + target_annotation = "annotation_tbl", + annotation_unified_names = c("azimuth", "blueprint", "monaco", "cellxgene"), + celltype_unification_list = NULL, + nonimmune_cellxgene = NULL, + ...) { + UseMethod("celltype_consensus_constructor") +} + +#' @importFrom purrr map +#' +#' @export +celltype_consensus_constructor.HPCell <- function(input_hpc, + target_input = "data_object", + target_output = "cell_type_concensus_tbl", + target_annotation = "annotation_tbl", + annotation_unified_names = c("azimuth", "blueprint", "monaco", "cellxgene"), + ...) { + + input_hpc |> + + hpc_iterate( + target_output = target_output, + user_function = cell_type_ensembl_harmonised |> quote(), + input_read_RNA_assay = target_input |> is_target(), + annotation_label_transfer_tbl = target_annotation |> is_target(), + available_maps = annotation_unified_names, + ... + ) +} + +#' Harmonize Cell Types Across Datasets +#' +#' This function integrates and harmonizes cell type annotations across multiple +#' datasets by applying predefined unification maps and cell type labels. +#' It uses a combination of transferred annotations and predefined maps to +#' produce a consensus on cell type identities. +#' +#' @param input_read_RNA_assay SingleCellExperiment or Seurat object containing RNA assay data. +#' @param annotation_label_transfer_tbl A tibble with annotation label transfer data. +#' @param celltype_unification_maps A list containing mapping data frames for different sources +#' (e.g., Azimuth, Blueprint, Monaco, and cellxgene). Default is `NULL`. +#' If `NULL`, it retrieves default maps stored in HPCell. +#' @param nonimmune A character vector specifying non-immune cell types. +#' Default is `NULL`. If `NULL`, it retrieves default non-immune types from HPCell. +#' @param available_maps A character vector of cell type annotation sources to include in the ensemble annotation process. +#' Supported values include `"azimuth"`, `"blueprint"`, `"monaco"`, and `"cellxgene"`. +#' By default, it uses all of the annotations. +#' @return A tibble of the input SummarizedExperiment metadata enriched with unified cell type annotations +#' and additional classification details. +#' +#' @importFrom dplyr left_join select rename mutate count as_tibble if_else case_when +#' @importFrom tibble rownames_to_column as_tibble +#' @importFrom purrr map +#' @importFrom tidyr unnest +#' @export +cell_type_ensembl_harmonised <- function(input_read_RNA_assay, + annotation_label_transfer_tbl = NULL, + celltype_unification_maps = NULL, + nonimmune = NULL, + available_maps = c("azimuth", "blueprint", "monaco", "cellxgene") + ) { + + # Handle missing input + if (input_read_RNA_assay |> is.null()) return(NULL) + + # Handle empty annotation_tbl + if (nrow(annotation_label_transfer_tbl) == 0 ) return(NULL) + + # Use pre-generated celltype_unification_maps (list) and + # nonimmune_cellxgene (character vector) from Dharmesh + if (is.null(celltype_unification_maps)) + celltype_unification_maps <- HPCell::celltype_unification_maps + if (is.null(nonimmune)) + nonimmune <- HPCell::nonimmune_cellxgene + + # get cell_metadata + try({ + if (inherits(annotation_label_transfer_tbl, "tbl_df")){ + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(annotation_label_transfer_tbl, by = ".cell") + } + }, silent = TRUE) + + # Get metadata + if (inherits(input_read_RNA_assay, "Seurat")) { + input_read_RNA_assay <- input_read_RNA_assay[[]] |> as.data.frame() |> + rownames_to_column(var = ".cell") |> + dplyr::rename( + blueprint_first_labels_fine = blueprint_first.labels.fine, + blueprint_first_labels_coarse = blueprint_first.labels.coarse, + monaco_first_labels_fine = monaco_first.labels.fine, + monaco_first_labels_coarse = monaco_first.labels.coarse + ) + } else if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + # Rename and unnest annotation_tbl + input_read_RNA_assay <- input_read_RNA_assay |> SummarizedExperiment::colData() |> as.data.frame() |> + rownames_to_column(var = ".cell") |> + dplyr::rename( + blueprint_first_labels_fine = blueprint_first.labels.fine, + blueprint_first_labels_coarse = blueprint_first.labels.coarse, + monaco_first_labels_fine = monaco_first.labels.fine, + monaco_first_labels_coarse = monaco_first.labels.coarse + ) + } + + # Sometimes, sce does not have azimuth annotation + input_read_RNA_assay <- input_read_RNA_assay |> + mutate(azimuth_predicted_celltype_l2 = ifelse(!("azimuth_predicted.celltype.l2" %in% names(input_read_RNA_assay)), + NA, + azimuth_predicted.celltype.l2)) |> + unnest(blueprint_scores_fine) |> + select(.cell, any_of(c("observation_joinid", "observation_originalid", + "donor_id", "dataset_id", "sample_id", "cell_type")), + blueprint_first_labels_fine, monaco_first_labels_fine, + blueprint_first_labels_coarse, monaco_first_labels_coarse, + any_of("azimuth_predicted_celltype_l2"), monaco_scores_fine, contains("macro"), contains("CD4") ) |> + unnest(monaco_scores_fine) |> + select(.cell, any_of(c("observation_joinid", "observation_originalid", + "donor_id", "dataset_id", "sample_id", "cell_type")), + blueprint_first_labels_fine, monaco_first_labels_fine, + blueprint_first_labels_coarse, monaco_first_labels_coarse, + any_of("azimuth_predicted_celltype_l2"), contains("macro") , contains("CD4"), contains("helper"), contains("Th")) + + + # If cellxgene is available, calculate ensemble annotations accordingly + has_cellxgene <- "cellxgene" %in% available_maps + + # Set method weights depending on availability of cellxgene + if (has_cellxgene) { + method_weights <- c(1, 1, 1, 2) + } else { + method_weights <- c(1, 1, 1, 0) # 0 weight for missing cellxgene + } + + # Unify cell types + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(celltype_unification_maps$azimuth, copy = TRUE) |> + left_join(celltype_unification_maps$blueprint, copy = TRUE) |> + left_join(celltype_unification_maps$monaco, copy = TRUE) |> + mutate(ensemble_joinid = paste(azimuth, blueprint, monaco, sep = "_")) + + # Conditionally join cellxgene only if it exists + if ("cellxgene" %in% available_maps) input_read_RNA_assay <- input_read_RNA_assay |> + left_join(celltype_unification_maps$cellxgene, copy = TRUE) |> + mutate(ensemble_joinid = paste(ensemble_joinid, cell_type_unified, sep = "_")) + + # Produce the ensemble map + df_map <- input_read_RNA_assay |> + dplyr::count(across(all_of(c("azimuth", "blueprint", "monaco", "cell_type_unified", "ensemble_joinid"))), name = "NCells") |> + as_tibble() |> + mutate(cellxgene = if (has_cellxgene) { + if_else(cell_type_unified %in% nonimmune_cellxgene, "non immune", + cell_type_unified) + } else {NA_character_}, + data_driven_ensemble = ensemble_annotation(cbind(azimuth, blueprint, monaco), + override_celltype = c("non immune", "nkt", "mast")), + cell_type_unified_ensemble = ensemble_annotation(cbind(azimuth, blueprint, monaco, cellxgene), + method_weights = method_weights, + override_celltype = c("non immune", "nkt", "mast")), + cell_type_unified_ensemble = if (has_cellxgene) { + case_when( + cell_type_unified_ensemble == "non immune" & cellxgene == "non immune" ~ cell_type_unified, + cell_type_unified_ensemble == "non immune" & cellxgene != "non immune" ~ "other", + TRUE ~ cell_type_unified_ensemble + ) + } else { + case_when( + cell_type_unified_ensemble == "non immune" ~ "other", + TRUE ~ cell_type_unified_ensemble + ) + }, + is_immune = !cell_type_unified_ensemble %in% nonimmune + ) |> + select( + ensemble_joinid, + data_driven_ensemble, + cell_type_unified_ensemble, + is_immune + ) + + # Use map to perform cell type ensemble + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(df_map, by = "ensemble_joinid", copy = TRUE) + + return(input_read_RNA_assay) +} + + +#' Ensemble Annotation for Cell Type Identification +#' +#' This function creates an ensemble annotation for cell types by utilizing a voting mechanism +#' across different methods. It leverages a hierarchy of cell types, method-specific weights, +#' and an option to override certain cell types to derive a consensus classification. +#' +#' @param celltype_matrix A matrix or data frame where columns represent different annotation +#' methods for cell types. Each element in the matrix represents a cell type determined by +#' each method. +#' @param method_weights Optional numeric vector or matrix specifying weights for each method. +#' If not provided, equal weights are used. If provided as a vector, it should match the +#' number of methods (columns of celltype_matrix). +#' @param override_celltype A character vector of cell types that should override the voting +#' process if they appear. This can be used to set certain cell types as non-negotiable +#' when they are detected by any method. +#' @param celltype_tree An igraph object representing the hierarchy of cell types. If NULL, +#' a default graph named "immune_graph" from the global environment is used. +#' +#' @return A vector representing the consensus cell type for each row in the input `celltype_matrix`. +#' +#' @export +ensemble_annotation <- function(celltype_matrix, method_weights = NULL, + override_celltype = c(), celltype_tree = NULL) { + if (is.null(celltype_tree)) { + celltype_tree <- get("immune_graph") + } + + stopifnot(is(celltype_tree, "igraph")) + stopifnot(igraph::is_directed(celltype_tree)) + stopifnot(is.matrix(celltype_matrix) | is.data.frame(celltype_matrix)) + + node_names = igraph::V(celltype_tree)$name + + # check override_celltype nodes are present + missing_nodes = setdiff(override_celltype, node_names) + if (!is.null(missing_nodes) & length(missing_nodes) > 0) { + missing_nodes = paste(missing_nodes, collapse = ", ") + stop(sprintf("the following nodes in 'override_celltype' not found in 'celltype_tree': %s", utils::capture.output(utils::str(missing_nodes)))) + } + + # check celltype_matrix + if (ncol(celltype_matrix) == 1) { + # no ensemble required + return(celltype_matrix) + } else { + celltype_matrix = as.matrix(celltype_matrix) + invalid_types = setdiff(celltype_matrix, c(node_names, NA)) + if (length(invalid_types) > 0) { + warning(sprintf("the following cell types in 'celltype_matrix' are not in the graph and will be set to NA:\n"), utils::capture.output(utils::str(invalid_types))) + } + celltype_matrix[celltype_matrix %in% invalid_types] = NA + } + + # check method_weights + if (is.null(method_weights)) { + method_weights = matrix(1, ncol = ncol(celltype_matrix), nrow = nrow(celltype_matrix)) + } else if (is.vector(method_weights)) { + if (ncol(celltype_matrix) != length(method_weights)) { + stop("the number of columns in 'celltype_matrix' should match the length of 'method_weights'") + } + method_weights = matrix(rep(method_weights, each = nrow(celltype_matrix)), nrow = nrow(celltype_matrix)) + } else if (is.matrix(method_weights) | is.data.frame(method_weights)) { + if (ncol(celltype_matrix) != ncol(method_weights)) { + stop("the number of columns in 'celltype_matrix' and 'method_weights' should be equal") + } + method_weights = as.matrix(method_weights) + } + method_weights = method_weights / rowSums(method_weights) + + # create vote matrix + vote_matrix = Matrix::sparseMatrix(i = integer(0), j = integer(0), dims = c(nrow(celltype_matrix), length(node_names)), dimnames = list(rownames(celltype_matrix), node_names)) + for (i in seq_len(ncol(celltype_matrix))) { + locmat = cbind(seq_len(nrow(celltype_matrix)), as.numeric(factor(celltype_matrix[, i], levels = node_names))) + missing = is.na(locmat[, 2]) + vote_matrix[locmat[!missing, ]] = vote_matrix[locmat[!missing, ]] + method_weights[!missing, i] + } + + # propagate vote to children + d = apply(!is.infinite(igraph::distances(celltype_tree, mode = "out")), 2, as.numeric) + d = as(d, "sparseMatrix") + vote_matrix_children = Matrix::tcrossprod(vote_matrix, Matrix::t(d)) + + # propagate vote to parent + d = igraph::distances(celltype_tree, mode = "in") + d = 1 / (2^d) - 0.1 # vote halved at each subsequent ancestor + diag(d)[igraph::degree(celltype_tree, mode = "in") > 0 & igraph::degree(celltype_tree, mode = "out") == 0] = 0 + diag(d) = diag(d) * 0.9 # prevent leaf nodes from being selected when trying to identify upstream ancestor (works for any number in the interval (0.5, 1)) + vote_matrix_parent = Matrix::tcrossprod(vote_matrix, Matrix::t(d)) + + # assess votes and identify common ancestors for ties + vote_matrix_children = apply(vote_matrix_children, 1, \(x) x[x > 0], simplify = FALSE) + vote_matrix_parent = apply(vote_matrix_parent, 1, \(x) x[x > 0], simplify = FALSE) + ensemble = mapply(\(children, parents) { + # override condition + override_node = intersect(override_celltype, names(children)) + if (length(override_node) > 0) { + return(override_node[1]) + } + + # maximum votes + children = names(children)[children == max(children)] + if (length(children) == 1) { + return(children) + } else { + # lowest ancestor with the maximum votes + parents = names(parents)[parents == max(parents)] + if (length(parents) == 1) { + return(parents) + } else { + return(NA) + } + } + }, vote_matrix_children, vote_matrix_parent) + + return(ensemble) +} diff --git a/R/data.R b/R/data.R index 770d5e13..3588a41e 100644 --- a/R/data.R +++ b/R/data.R @@ -27,4 +27,36 @@ #' #' @noRd #' -"dummy_hpc" \ No newline at end of file +"dummy_hpc" + +#' +#' This dataset contains Ensembl gene IDs, external gene names, and chromosome names +#' retrieved using the biomaRt package. +#' +#' @format A data frame map of ensembl_gene_id, external_gene_name and chromosome_name +#' +#' @usage +#' data(ensembl_genes_biomart) +#' +#' @source biomaRt::getBM() +#' +#' @keywords datasets +#' @docType data +"ensembl_genes_biomart" + +#' CellChatDB.human database +#' +#' A curated human ligand–receptor interaction database provided by the CellChat package. +#' +#' This object is typically used as input to the CellChat pipeline. It contains signaling pathway data +#' for cell-cell communication analysis. +#' +#' @format A list with multiple elements, each representing different parts of the signaling network. + +#' @usage +#' data(CellChatDB.human) +#' +#' @source CellChat::CellChatDB.human +#' @noRd +#' +"CellChatDB.human" diff --git a/R/differential_expression.R b/R/differential_expression.R index b9249428..6e9e1bf5 100644 --- a/R/differential_expression.R +++ b/R/differential_expression.R @@ -15,7 +15,7 @@ #' @importFrom dplyr distinct #' @importFrom dplyr filter #' @importFrom dplyr pull -#' @importFrom dplyr enframe +#' @importFrom tibble enframe #' @importFrom purrr map #' @importFrom purrr map_int #' @importFrom stringr str_subset @@ -200,9 +200,10 @@ map_de = function(se, my_formula, assay, method, max_rows_for_matrix_multiplicat } +#' @importFrom tidybulk test_differential_abundance #' @export #' @noRd -internal_de_function = function(x, fi, a, f, m){ +internal_de_function = function(x, fi, a, formul, m){ # Skip if not enough samples if(x |> ncol() < 3) warning("HPCell says: your dataset has less than 3 samples, the differential expression analysis was skipped") @@ -210,7 +211,7 @@ internal_de_function = function(x, fi, a, f, m){ x |> keep_abundant(factor_of_interest = fi, .abundance = !!sym(a)) |> - test_differential_abundance(f, .abundance = !!sym(a), method = m) |> + test_differential_abundance(formul, .abundance = !!sym(a), method = m) |> pivot_transcript() |> # This because fi can be NULL. @@ -282,10 +283,10 @@ factory_de_fix_effect = function(se_list_input, output_se, formula, method, tier #' @importFrom rlang sym #' @importFrom dplyr left_join -#' @importFrom dplyr nest +#' @importFrom tidyr nest #' @importFrom dplyr group_by #' @importFrom dplyr mutate -#' @importFrom dplyr unnest +#' @importFrom tidyr unnest #' @importFrom purrr map #' @importFrom S4Vectors split #' @importFrom purrr compact diff --git a/R/execute_pipeline.R b/R/execute_pipeline.R deleted file mode 100644 index 0551df64..00000000 --- a/R/execute_pipeline.R +++ /dev/null @@ -1,408 +0,0 @@ -#' Run Targets Pipeline for HPCell -#' -#' @description -#' This function sets up and executes a `targets` pipeline for HPCell. It saves input data and configurations, -#' writes a pipeline script, and runs the pipeline using the 'targets' package. -#' -#' @param input_data Input data for the pipeline. -#' @param store Directory path for storing the pipeline files. -#' @param input_reference Optional reference data. -#' @param tissue Tissue type for the analysis. -#' @param computing_resources Configuration for computing resources. -#' @param debug_step Optional step for debugging. -#' @param filter_empty_droplets Flag to indicate if input filtering is needed. -#' @param RNA_assay_name Name of the RNA assay. -#' @param sample_column Column name for sample identification. -#' @param cell_type_annotation_column Column name for cell type annotation in input data -#' @param data_container_type A character vector of length one specifies the input data type. -#' @param profiler Optional step for profilling. Default is FALSE -#' data type can be one of the following: anndata for annotated data mainly used in python. -#' sce_rds and seurat_rds for `SingleCellExperiment` and `Seurat` RDS format representively -#' seurat_rds for `Seurat` RDS format. -#' sce_hdf5 for `SingleCellExperiment` HDF5 format -#' seurat_hdf5 for `Seurat` HDF5 format -#' -#' @return The output of the `targets` pipeline, typically a pre-processed data set. -#' -#' @importFrom glue glue -#' @importFrom targets tar_script -#' @import crew.cluster -#' @import tarchetypes -#' @import targets -#' @import broom -#' @import ggplot2 -#' @import ggupset -#' @import here -#' @import qs -#' @import crew -#' @importFrom future tweak -#' @import crew -#' @import crew.cluster -#' @export -run_targets_pipeline <- function( - input_data, - store = "./", - input_reference = NULL, - tissue, - computing_resources = crew_controller_local(workers = 1), - debug_step = NULL, - filter_empty_droplets = NULL, - RNA_assay_name = "RNA", - sample_column = "sample", - cell_type_annotation_column = "Cell_type_in_each_tissue", - data_container_type -){ - - # Fix GCHECKS - data_object <- NULL - reference_file <- NULL - tissue_file <- NULL - filtered_file <- NULL - sample_column_file <- NULL - cell_type_annotation_column_file <- NULL - reference_label_coarse <- NULL - reference_label_fine <- NULL - input_read <- NULL - unique_tissues <- NULL - reference_read <- NULL - empty_droplets_tbl <- NULL - cell_cycle_score_tbl <- NULL - annotation_label_transfer_tbl <- NULL - alive_identification_tbl <- NULL - doublet_identification_tbl <- NULL - non_batch_variation_removal_S <- NULL - preprocessing_output_S <- NULL - create_pseudobulk_sample <- NULL - sampleName <- NULL - cellAnno <- NULL - pseudobulk_merge_all_samples <- NULL - calc_UMAP_dbl_report <- NULL - variable_gene_list <- NULL - tar_render <- NULL - empty_droplets_report <- NULL - doublet_identification_report <- NULL - Technical_variation_report <- NULL - pseudobulk_processing_report <- NULL - - sample_column = enquo(sample_column) - # cell_type_annotation_column = enquo(cell_type_annotation_column) - - # Save inputs for passing to targets pipeline - # input_data |> CHANGE_ASSAY |> saveRDS("input_file.rds") - input_data |> saveRDS("input_file.rds") - input_reference |> saveRDS("input_reference.rds") - tissue |> saveRDS("tissue.rds") - computing_resources |> saveRDS("temp_computing_resources.rds") - filter_empty_droplets |> saveRDS("filter_empty_droplets.rds") - sample_column |> saveRDS("sample_column.rds") - cell_type_annotation_column |> saveRDS("cell_type_annotation_column.rds") - data_container_type |> saveRDS("data_container_type.rds") - debug_step |> saveRDS("debug_step_param.rds") - # Write pipeline to a file - tar_script({ - # library(targets) - # library(tarchetypes) - # library(crew) - # library(crew.cluster) - - computing_resources = readRDS("temp_computing_resources.rds") - debug_step = readRDS("debug_step_param.rds") - #-----------------------# - # Packages - #-----------------------# - tar_option_set( - packages = c( - "HPCell", - "readr", - "dplyr", - "tidyr", - "ggplot2", - "purrr", - "Seurat", - "tidyseurat", - "glue", - "scater", - "DropletUtils", - "EnsDb.Hsapiens.v86", - "here", - "stringr", - "readr", - "rlang", - "scuttle", - "scDblFinder", - "ggupset", - "tidySummarizedExperiment", - "broom", - "tarchetypes", - "SeuratObject", - "SingleCellExperiment", - "SingleR", - "celldex", - "tidySingleCellExperiment", - "tibble", - "magrittr", - "qs", - "S4Vectors", - "tarprof", - "zellkonverter" - ), - memory = "transient", - garbage_collection = TRUE, - #trust_object_timestamps = TRUE, - storage = "worker", - retrieval = "worker", - #error = "continue", - format = "qs", - debug = debug_step, # Set the target you want to debug. - # cue = tar_cue(mode = "never") # Force skip non-debugging outdated targets. - controller = computing_resources - ) - - #-----------------------# - # Future SLURM - #-----------------------# - - # library(future) - # library("future.batchtools") - # slurm <- - # `batchtools_slurm` |> - # future::tweak( template = glue("/stornext/Bioinf/data/bioinf-data/Papenfuss_lab_projects/people/mangiola.s/third_party_sofware/slurm_batchtools.tmpl"), - # resources=list( - # ncpus = 20, - # memory = 6000, - # walltime = 172800 - # ) - # ) - # plan(slurm) - - # small_slurm = - # tar_resources( - # future = tar_resources_future( - # plan = tweak( - # batchtools_slurm, - # template = "dev/slurm_batchtools.tmpl", - # resources = list( - # ncpus = 2, - # memory = 40000, - # walltime = 172800 - # ) - # ) - # ) - # ) - # - # big_slurm = - # tar_resources( - # future = tar_resources_future( - # plan = tweak( - # batchtools_slurm, - # template = "dev/slurm_batchtools.tmpl", - # resources = list( - # ncpus = 19, - # memory = 6000, - # walltime = 172800 - # ) - # ) - # ) - # ) - - target_list = list( - tar_target(file, "input_file.rds", format = "rds"), - tar_target(data_object, readRDS("input_file.rds")), - #tar_target(reference_file, "input_reference.rds", format = "rds"), - tar_target(reference_file, readRDS("input_reference.rds")), - tar_target(tissue_file, readRDS("tissue.rds")), - tar_target(filtered_file, readRDS("filter_empty_droplets.rds")), - tar_target(sample_column_file, readRDS("sample_column.rds")), - tar_target(cell_type_annotation_column_file, readRDS("cell_type_annotation_column.rds")), - tar_target(data_container_type_file, readRDS("data_container_type.rds"))) - - #-----------------------# - # Pipeline - #-----------------------# - target_list|> c(list( - - # Define input files - # tarchetypes::tar_files(name= input_track, - # data_object, - # deployment = "main"), - # tarchetypes::tar_files(name= reference_track, - # read_reference_file, - # deployment = "main"), - tar_target(filter_empty_droplets, filtered_file, deployment = "main"), - tar_target(tissue, tissue_file, deployment = "main", ), - tar_target(sample_column, sample_column_file, deployment = "main"), - tar_target(cell_type_annotation_column, cell_type_annotation_column_file, deployment = "main"), - tar_target(reference_label_coarse, reference_label_coarse_id(tissue), deployment = "main"), - tar_target(reference_label_fine, reference_label_fine_id(tissue), deployment = "main"), - # Reading input files - tar_target(file_path, data_object, pattern = map(data_object), format = "file", deployment = "main"), - tar_target(unique_tissues, - get_unique_tissues(read_data_container(file_path, container_type = data_container_type_file), sample_column |> quo_name()), - pattern = map(file_path), - iteration = "list"), - # tar_target( - # tissue_subsets, - # input_read, split.by = "Tissue"), - # pattern = map(input_read), - # iteration = "list" - # ), - tar_target(reference_read, reference_file, deployment = "main"), - - # Identifying empty droplets - tar_target(empty_droplets_tbl, - empty_droplet_id(read_data_container(file_path, container_type = data_container_type_file), filter_empty_droplets), - pattern = map(file_path), - iteration = "list"), - - # Cell cycle scoring - tar_target(cell_cycle_score_tbl, cell_cycle_scoring(read_data_container(file_path, container_type = data_container_type_file ), - empty_droplets_tbl), - pattern = map(file_path, - empty_droplets_tbl), - iteration = "list"), - - # Annotation label transfer - tar_target(annotation_label_transfer_tbl, - annotation_label_transfer(read_data_container(file_path, container_type = data_container_type_file), - empty_droplets_tbl, - reference_read), - pattern = map(file_path, - empty_droplets_tbl), - iteration = "list"), - - # Alive identification - tar_target(alive_identification_tbl, alive_identification(read_data_container(file_path, container_type = data_container_type_file), - empty_droplets_tbl, - annotation_label_transfer_tbl), - pattern = map(file_path, - empty_droplets_tbl, - annotation_label_transfer_tbl), - iteration = "list"), - - # Doublet identification - tar_target(doublet_identification_tbl, doublet_identification(read_data_container(file_path, container_type = data_container_type_file), - empty_droplets_tbl, - alive_identification_tbl, - annotation_label_transfer_tbl, - reference_label_fine), - pattern = map(file_path, - empty_droplets_tbl, - alive_identification_tbl, - annotation_label_transfer_tbl), - iteration = "list"), - - # Non-batch variation removal - tar_target(non_batch_variation_removal_S, non_batch_variation_removal(read_data_container(file_path, container_type = data_container_type_file), - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl), - pattern = map(file_path, - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl), - iteration = "list"), - - # Pre-processing output - tar_target(preprocessing_output_S, preprocessing_output(tissue, - non_batch_variation_removal_S, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl), - pattern = map(non_batch_variation_removal_S, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl), - iteration = "list") - - # pseudobulk preprocessing for each sample - # tar_target(create_pseudobulk_sample, create_pseudobulk(preprocessing_output_S, - # assays = "SCT", - # cell_type_annotation_column, - # x = c(sampleName, cellAnno)), - # pattern = map(preprocessing_output_S), - # iteration = "list"), - # - # tar_target(pseudobulk_merge_all_samples, pseudobulk_merge(create_pseudobulk_sample, - # assays = "RNA", - # x = c(sampleName)), - # iteration = "list"), - # - # tar_target(calc_UMAP_dbl_report, calc_UMAP(input_read), - # pattern = map(input_read), - # iteration = "list"), - # tar_target(variable_gene_list, find_variable_genes(input_read, - # empty_droplets_tbl), - # pattern = map(input_read, empty_droplets_tbl), - # iteration = "list") - - # tar_render( - # name = empty_droplets_report, # The name of the target - # path = paste0(system.file(package = "HPCell"), "/rmd/Empty_droplet_report.Rmd"), - # params = list(x1 = tar_read(input_read, store = store), - # x2 = tar_read(empty_droplets_tbl, store = store), - # x3 = tar_read(annotation_label_transfer_tbl, store = store), - # x4 = tar_read(unique_tissues, store = store), - # x5 = sample_column |> quo_name()) - # ), - # tar_render( - # name = doublet_identification_report, - # path = paste0(system.file(package = "HPCell"), "/rmd/Doublet_identification_report.Rmd"), - # params = list(x1 = input_read, - # x2 = calc_UMAP_dbl_report, - # x3 = doublet_identification_tbl, - # x4 = annotation_label_transfer_tbl, - # x5 = sample_column |> quo_name(), - # x6 = cell_type_annotation_column |> quo_name()) - # ), - # tar_render( - # name = Technical_variation_report, - # path = paste0(system.file(package = "HPCell"), "/rmd/Technical_variation_report.Rmd"), - # params = list(x1= input_read, - # x2= empty_droplets_tbl, - # x3 = variable_gene_list, - # x4 = calc_UMAP_dbl_report, - # x5 = sample_column |> quo_name()) - # ), - # tar_render( - # name = pseudobulk_processing_report, - # path = paste0(system.file(package = "HPCell"), "/rmd/pseudobulk_analysis_report.Rmd"), - # params = list(x1 = pseudobulk_merge_all_samples, - # x2 = sample_column |> quo_name(), - # x3 = cell_type_annotation_column |> quo_name()) - ) - ) - }, script = glue("{store}.R"), ask = FALSE) - - #Running targets - # input_files<- c("CB150T04X__batch14.rds","CB291T01X__batch8.rds") - # run_targets <- function(input_files){ - # tar_make( - # script = glue("{store}.R"), - # store = store - # ) - # } - # run_targets(input_files) - - tar_make( - script = glue("{store}.R"), - store = store, - callr_function = NULL - ) - # tar_make_future( - # script = glue("{store}.R"), - # store = store, - # workers = 200, - # garbage_collection = TRUE - # ) - - message(glue("HPCell says: you can read your output executing tar_read(preprocessing_output_S, store = \"{store}\") ")) - #tar_meta_download(store = store) - metadata<- tar_meta(store = store) - return(metadata) - #tar_read(preprocessing_output_S, store = store) - -} - -## my_results = run_targets_pipeline(..) \ No newline at end of file diff --git a/R/factories.R b/R/factories.R index 48c8804c..0fdc972f 100644 --- a/R/factories.R +++ b/R/factories.R @@ -38,7 +38,6 @@ parse_function_call <- function(command) { } - #' @export hpc_internal = function( tiers = NULL, @@ -49,26 +48,32 @@ hpc_internal = function( other_arguments_to_map = c(), packages = targets::tar_option_get("packages") , deployment = targets::tar_option_get("deployment"), + format = targets::tar_option_get("format"), ... ){ args <- list(...) # Capture the ... arguments as a list - # Construct the full call expression with the pipeline substituted into the function - fx_call <- as.call(c(user_function, args)) + + # If format is file just pass the argument + if(format != "file") + + # Construct the full call expression with the pipeline substituted into the function + user_function <- as.call(c(user_function, args)) if(tiers |> is.null() || tiers |> length() < 2){ tar_target_raw( name = target_output |> as.character(), - command = fx_call, + command = user_function, # This is in case I am not tiering (e.g. DE analyses) but I need to map pattern = build_pattern(other_arguments_to_map = other_arguments_to_map), iteration = "list", packages = packages, - deployment = deployment + deployment = deployment, + format = format ) @@ -78,7 +83,7 @@ hpc_internal = function( else { - if(fx_call |> deparse() |> str_detect("%>%") |> any()) + if(user_function |> deparse() |> str_detect("%>%") |> any()) stop("HPCell says: no \"%>%\" allowed in the command, please use \"|>\" ") # Filter out arguments to be tiered from the input command @@ -93,7 +98,7 @@ hpc_internal = function( # This is needed because using glue as.character() , - command = fx_call |> add_tier_inputs(arguments_already_tiered, .y), + command = user_function |> add_tier_inputs(arguments_already_tiered, .y), pattern = build_pattern( other_arguments_to_map = glue("{other_arguments_to_map}_{.y}"), @@ -103,7 +108,8 @@ hpc_internal = function( iteration = "list", packages = packages, deployment = deployment, - resources = tar_resources(crew = tar_resources_crew(.y)) + resources = tar_resources(crew = tar_resources_crew(.y)) , + format = format ) }) @@ -129,11 +135,11 @@ hpc_internal_report = function( if(tiers |> is.null() || tiers |> length() < 2){ - tar_render_raw( + tar_quarto_raw( name = target_output |> as.character(), path = rmd_path, output_file = output_file, - render_arguments = render_arguments, + execute_params = render_arguments, # This is in case I am not tiering (e.g. DE analyses) but I need to map # pattern = build_pattern(other_arguments_to_map = other_arguments_to_map), @@ -155,7 +161,7 @@ hpc_internal_report = function( map2(tiers, names(tiers), ~ { - tar_render_raw( + tar_quarto_raw( name = glue("{target_output}_{.y}") |> @@ -194,7 +200,13 @@ hpc_internal_report = function( #' @importFrom purrr set_names #' @export hpc_iterate = - function(input_hpc, target_output = NULL, user_function = NULL, ...) { + function( + input_hpc, + target_output = NULL, + user_function = NULL, + user_function_source_path = NULL, + ... + ) { # Check for argument consistency check_for_name_value_conflicts(...) @@ -205,6 +217,9 @@ hpc_iterate = # Delete line with target in case the user execute the command, without calling initialise_hpc target_output |> delete_lines_with_word(target_script) + # Append source if any + write_source(user_function_source_path, target_script) + # please, because sometime we set up list target that do not depend on any other ones # if tiers is set to NULL, then the target will not acquire the _ suffix # I HAVE TO MAKE THIS MORE ELEGANT, AND NOT RELY ON tiers ARGUMENT @@ -269,7 +284,13 @@ hpc_iterate = #' @importFrom purrr set_names #' @export hpc_single = - function(input_hpc, target_output = NULL, user_function = NULL, iterate = "none", ...) { + function( + input_hpc, + target_output = NULL, + user_function = NULL, + user_function_source_path = NULL, + iterate = "none", + ...) { # Target script target_script = glue("{input_hpc$initialisation$store}.R") @@ -277,6 +298,10 @@ hpc_single = # Delete line with target in case the user execute the command, without calling initialise_hpc target_output |> delete_lines_with_word(target_script) + # Append source if any + write_source(user_function_source_path, target_script) + + tar_append( fx = hpc_internal |> quote(), target_output = target_output, @@ -314,7 +339,13 @@ hpc_single = #' @importFrom purrr set_names #' @export hpc_merge = - function(input_hpc, target_output = NULL, user_function = NULL, ...) { + function( + input_hpc, + target_output = NULL, + user_function = NULL, + user_function_source_path = NULL, + ... + ) { # Check for argument consistency check_for_name_value_conflicts(...) @@ -325,17 +356,8 @@ hpc_merge = # Delete line with target in case the user execute the command, without calling initialise_hpc target_output |> delete_lines_with_word(target_script) - # name_target_intermediate = glue("{target_output}_merge_within_tier") - - # tar_append( - # fx = hpc_internal |> quote(), - # tiers = input_hpc$initialisation$tier |> get_positions() , - # target_output = name_target_intermediate, - # script = target_script, - # user_function = user_function, - # arguments_already_tiered = list(...) |> arguments_to_action(input_hpc, "tiered") , # This "tiered" value is decided for each new target below. Ususally every other list targets. - # ... - # ) + # Append source if any + write_source(user_function_source_path, target_script) # If no tiers @@ -405,8 +427,7 @@ hpc_merge = #' #' #' @export -hpc_report = - function(input_hpc, target_output = NULL, rmd_path = NULL, ...) { +hpc_report = function(input_hpc, target_output = NULL, rmd_path = NULL, ...) { # # Check for argument consistency # check_for_name_value_conflicts(...) diff --git a/R/functions.R b/R/functions.R index 1999dd4f..3cb72b01 100644 --- a/R/functions.R +++ b/R/functions.R @@ -1,6 +1,281 @@ ## quiets concerns of R CMD check re: the .'s that appear in pipelines if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) +#' Identify Empty Droplets in Single-Cell RNA-seq Data +#' +#' @description +#' `empty_droplet_id` distinguishes between empty and non-empty droplets using the DropletUtils package. +#' It excludes mitochondrial and ribosomal genes, calculates barcode ranks, and optionally filters input data +#' based on these criteria. The function returns a tibble containing log probabilities, FDR, and a classification +#' indicating whether cells are empty droplets. +#' +#' @param input_read_RNA_assay SingleCellExperiment or Seurat object containing RNA assay data. +#' @param filter_empty_droplets Logical value indicating whether to filter the input data. +#' +#' @return A tibble with columns: logProb, FDR, empty_droplet (classification of droplets). +#' +#' @importFrom AnnotationDbi mapIds +#' @importFrom stringr str_subset +#' @importFrom dplyr left_join mutate +#' @importFrom tidyr replace_na +#' @importFrom DropletUtils emptyDrops barcodeRanks +#' @importFrom S4Vectors metadata +#' @importFrom EnsDb.Hsapiens.v86 EnsDb.Hsapiens.v86 +#' @importFrom biomaRt useMart getBM +#' +#' @export +empty_droplet_id <- function(input_read_RNA_assay, + total_RNA_count_check = -Inf, + assay = NULL, + feature_nomenclature){ + + if(input_read_RNA_assay |> is.null()) return(NULL) + if(ncol(input_read_RNA_assay) == 0) return(NULL) + + #Fix GChecks + FDR = NULL + .cell = NULL + + # Get assay + if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) + + # Get counts + if (inherits(input_read_RNA_assay, "Seurat")) { + counts <- GetAssayData(input_read_RNA_assay, assay, slot = "counts") + } else if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + counts <- assay(input_read_RNA_assay, assay) + } + + + significance_threshold = 0.001 + + # Genes to exclude + if (feature_nomenclature == "symbol") { + location <- mapIds( + EnsDb.Hsapiens.v86, + keys=rownames(input_read_RNA_assay), + column="SEQNAME", + keytype="SYMBOL" + ) + mitochondrial_genes = which(location=="MT") |> names() + ribosome_genes = rownames(input_read_RNA_assay) |> str_subset("^RPS|^RPL") + + } else if (feature_nomenclature == "ensembl") { + # all_genes are saved in data/all_genes.rda to avoid recursively accessing biomaRt backend for potential timeout error + data(ensembl_genes_biomart) + all_mitochondrial_genes <- ensembl_genes_biomart[grep("MT", ensembl_genes_biomart$chromosome_name), ] + all_ribosome_genes <- ensembl_genes_biomart[grep("^(RPL|RPS)", ensembl_genes_biomart$external_gene_name), ] + mitochondrial_genes <- all_mitochondrial_genes |> + filter(ensembl_gene_id %in% rownames(input_read_RNA_assay)) |> pull(ensembl_gene_id) + ribosome_genes <- all_ribosome_genes |> + filter(ensembl_gene_id %in% rownames(input_read_RNA_assay)) |> pull(ensembl_gene_id) + } + + + # if ("originalexp" %in% names(input_file@assays)) { + # barcode_ranks <- barcodeRanks(input_file@assays$originalexp@counts[!rownames(input_file@assays$originalexp@counts) %in% c(mitochondrial_genes, ribosome_genes),, drop=FALSE]) + # } else if ("RNA" %in% names(input_file@assays)) { + # barcode_ranks <- barcodeRanks(input_file@assays$RNA@counts[!rownames(input_file@assays$RNA@counts) %in% c(mitochondrial_genes, ribosome_genes),, drop=FALSE]) + # } + + + filtered_counts <- counts[!(rownames(counts) %in% c(mitochondrial_genes, ribosome_genes)),, drop=FALSE ] + + n_expressed_genes_non_zero = (filtered_counts > 0) |> colSums() + + filter_empty_droplets = n_expressed_genes_non_zero |> min() < 200 + + if(!filter_empty_droplets) + return( input_read_RNA_assay |> + as_tibble() |> + select(.cell) |> + mutate( empty_droplet = FALSE)) + + quantile_expressed_genes = n_expressed_genes_non_zero |> quantile(0.05) + + # Check if empty droplets have been identified + # nFeature_name <- paste0("nFeature_", assay) + + #if (any(input_read_RNA_assay[[nFeature_name]] < total_RNA_count_check)) { + # filter_empty_droplets <- "TRUE" + # } + # else { + # filter_empty_droplets <- "FALSE" + # } + + # Attempt to run emptyDrops() and handle potential errors + tryCatch({ + # WE CANNOT USE AMBIENT PARAMETER BECAUSE WITH PERCULIAR DATASETS WITH + # cells with more zeros have also more total RNA counts dysfunction stalls + # for example for this sample + #.cell dataset_id sample_id + #AAACCCAAGCTAATCC___eec804b9-2ae5-44f0-a1b5-d721e21257de eec804b9-2ae5-44f0-a1b5-d721e21257de 485c0dac47c6bd0b91fd3ae9d7de7385 + + emptyDrops(filtered_counts) |> + as_tibble(rownames = ".cell") |> + mutate(empty_droplet = FDR >= significance_threshold) |> + replace_na(list(empty_droplet = TRUE)) |> + mutate(filter_empty_method = "emptyDrops") + + }, error = function(e) { + # Check if the error message matches the specific error + if (grepl("no counts available to estimate the ambient profile", e$message)) { + # You can also print a message if you like + message("Error encountered: ", e$message) + message("Setting do_filter to FALSE.") + + # Return NULL or an empty object as appropriate + input_read_RNA_assay |> + as_tibble() |> + select(.cell) |> + mutate( empty_droplet = n_expressed_genes_non_zero < 200) |> + mutate(filter_empty_method = "expressed_genes_more_than_200") + } else { + # For other errors, re-throw the error + stop(e) + } + }) + + + # barcode ranks + # Calculate bar-codes ranks + # barcode_ranks <- barcodeRanks(filtered_counts) + # + # barcode_table <- barcode_table |> + # left_join( + # barcode_ranks |> + # as_tibble(rownames = ".cell") |> + # mutate( + # knee = metadata(barcode_ranks)$knee, + # inflection = metadata(barcode_ranks)$inflection + # ) + # ) + + + # barcode_table |> saveRDS(output_path_result) + + # # Plot bar-codes ranks + # plot_barcode_ranks = + # barcode_table %>% + # ggplot2::ggplot(aes(rank, total)) + # geom_point(aes(color = empty_droplet, size = empty_droplet )) + # geom_line(aes(rank, fitted), color="purple") + # geom_hline(aes(yintercept = knee), color="dodgerblue") + # geom_hline(aes(yintercept = inflection), color="forestgreen") + # scale_x_log10() + # scale_y_log10() + # scale_color_manual(values = c("black", "#e11f28")) + # scale_size_discrete(range = c(0, 2)) + # theme_bw() + + # plot_barcode_ranks |> saveRDS(output_path_plot_rds) + + # ggsave( + # output_path_plot_pdf, + # plot = plot_barcode_ranks, + # useDingbats=FALSE, + # units = c("mm"), + # width = 183/2 , + # height = 183/2, + # limitsize = FALSE + # ) + +} + +#' Identify Empty Droplets in Single-Cell RNA-seq Data +#' +#' @description +#' `empty_droplet_threshold` identifies empty droplets by applying a gene expression threshold per sample. +#' It excludes mitochondrial and ribosomal genes, and classifies droplets as empty if +#' the number of expressed genes falls below the specified threshold. +#' +#' The function returns a tibble containing the number of expressed genes, +#' total RNA count for each cell, and a logical annotation indicating whether the droplet was classified as empty. +#' +#' @param input_read_RNA_assay SingleCellExperiment or Seurat object containing RNA assay data. +#' @param filter_empty_droplets Logical value indicating whether to filter the input data. +#' @param RNA_feature_threshold An optional integer for the number of feature expressed in a sample. +#' +#' @return A tibble with columns: Cell, nFeature_expressed_in_sample, nCount_RNA, empty_droplet (classification of droplets). +#' +#' @importFrom AnnotationDbi mapIds +#' @importFrom stringr str_subset +#' @importFrom dplyr left_join mutate +#' @importFrom tidyr replace_na +#' @importFrom DropletUtils emptyDrops barcodeRanks +#' @importFrom S4Vectors metadata +#' @importFrom EnsDb.Hsapiens.v86 EnsDb.Hsapiens.v86 +#' @importFrom biomaRt useMart getBM +#' +#' @export +empty_droplet_threshold<- function(input_read_RNA_assay, + total_RNA_count_check = -Inf, + assay = NULL, + feature_nomenclature, + RNA_feature_threshold){ + if(input_read_RNA_assay |> is.null()) return(NULL) + if(ncol(input_read_RNA_assay) == 0) return(NULL) + + #Fix GChecks + FDR = NULL + .cell = NULL + + # Get assay + if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) + + significance_threshold = 0.001 + + # # Rule of thumb threshold + # expressed_genes_threshold = 0.025 + # if (is.null(RNA_feature_threshold)) RNA_feature_threshold = min(floor(dim(input_read_RNA_assay)[1]*expressed_genes_threshold), 500) + # + # Genes to exclude + if (feature_nomenclature == "symbol") { + location <- mapIds( + EnsDb.Hsapiens.v86, + keys=rownames(input_read_RNA_assay), + column="SEQNAME", + keytype="SYMBOL" + ) + mitochondrial_genes = which(location=="MT") |> names() + ribosome_genes = rownames(input_read_RNA_assay) |> str_subset("^RPS|^RPL") + + } else if (feature_nomenclature == "ensembl") { + # all_genes are saved in data/all_genes.rda to avoid recursively accessing biomaRt backend for potential timeout error + data(ensembl_genes_biomart) + all_mitochondrial_genes <- ensembl_genes_biomart[grep("MT", ensembl_genes_biomart$chromosome_name), ] + all_ribosome_genes <- ensembl_genes_biomart[grep("^(RPL|RPS)", ensembl_genes_biomart$external_gene_name), ] + + mitochondrial_genes <- all_mitochondrial_genes |> + filter(ensembl_gene_id %in% rownames(input_read_RNA_assay)) |> pull(ensembl_gene_id) + ribosome_genes <- all_ribosome_genes |> + filter(ensembl_gene_id %in% rownames(input_read_RNA_assay)) |> pull(ensembl_gene_id) + } + + # Get counts + if (inherits(input_read_RNA_assay, "Seurat")) { + counts <- GetAssayData(input_read_RNA_assay, assay, slot = "counts") + } else if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + counts <- assay(input_read_RNA_assay, assay) + } + filtered_counts <- counts[!(rownames(counts) %in% c(mitochondrial_genes, ribosome_genes)),, drop=FALSE ] + + # Generate library size for each cell + library_size <- colSums(filtered_counts) |> enframe(name = ".cell", value = "nCount_RNA") + + # filter based on number of expressed genes + result <- colSums(filtered_counts > 0 ) |> enframe(name = ".cell", value = "nFeature_expressed_in_sample") |> + left_join(library_size, by = ".cell") |> + mutate(empty_droplet = nFeature_expressed_in_sample < RNA_feature_threshold) + + # # Discard samples with nFeature_RNA density mode < threshold, avoid potential downstream error + # density_est = result |> pull(nFeature_RNA) |> density() + # density_value = density_est$x[which.max(density_est$y)] + # if (density_value < RNA_feature_threshold) return(NULL) + + result +} + #' Cell Type Annotation Transfer #' #' @description @@ -18,6 +293,7 @@ if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) #' #' @importFrom celldex BlueprintEncodeData #' @importFrom celldex MonacoImmuneData +#' #' @importFrom Seurat CreateAssayObject #' @importFrom Seurat SCTransform #' @importFrom Seurat CreateSeuratObject @@ -25,6 +301,10 @@ if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) #' @importFrom Seurat FindTransferAnchors #' @importFrom Seurat MapQuery #' @importFrom Seurat as.SingleCellExperiment +#' @importFrom Seurat Assays +#' @importFrom SeuratObject RenameAssays +#' @import Seurat +#' #' @importFrom scuttle logNormCounts #' @importFrom SingleR SingleR #' @importFrom tibble as_tibble @@ -37,12 +317,17 @@ if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) #' @importFrom magrittr extract2 #' @importFrom SummarizedExperiment assay #' @importFrom SummarizedExperiment assay<- +#' @importFrom Azimuth RunAzimuth +#' @importFrom stringr str_detect +#' @importFrom tidyr nest +#' @importFrom S4Vectors cbind #' #' @export annotation_label_transfer <- function(input_read_RNA_assay, - empty_droplets_tbl, + empty_droplets_tbl = NULL, reference_azimuth = NULL, - assay = NULL + assay = NULL, + feature_nomenclature ){ # Fix github checks empty_droplet = NULL @@ -50,38 +335,49 @@ annotation_label_transfer <- function(input_read_RNA_assay, delta.next = NULL .cell = NULL + if(input_read_RNA_assay |> is.null()) return(NULL) + if(ncol(input_read_RNA_assay) == 0) return(NULL) # Get assay if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) + # TEMPORARY FOR SOME REASON THE MIN COUNTS IS NOT 0 FOR SOME SAMPLES + input_read_RNA_assay = check_if_assay_minimum_count_is_zero_and_correct_TEMPORARY(input_read_RNA_assay, assay) + + + if (!is.null(empty_droplets_tbl)) { + input_read_RNA_assay = + input_read_RNA_assay |> + left_join(empty_droplets_tbl, by=".cell") |> + dplyr::filter(!empty_droplet) + } + # SingleR if (inherits(input_read_RNA_assay, "Seurat")) { - sce = + input_read_RNA_assay = input_read_RNA_assay |> - # Filter empty - left_join(empty_droplets_tbl, by = ".cell") |> - dplyr::filter(!empty_droplet) |> as.SingleCellExperiment() |> logNormCounts() } else if (inherits(input_read_RNA_assay, "SingleCellExperiment")){ - sce = - input_read_RNA_assay |> - # Filter empty - left_join(empty_droplets_tbl, by = ".cell") |> - dplyr::filter(!empty_droplet) |> - logNormCounts() + input_read_RNA_assay = + input_read_RNA_assay|> + logNormCounts(assay.type = assay) } - - if(ncol(sce)==1){ - sce = S4Vectors::cbind(sce, sce) - colnames(sce)[2]= "dummy___" + # This because an error is num cell = 1 + if(ncol(input_read_RNA_assay)==1){ + input_read_RNA_assay = S4Vectors::cbind(input_read_RNA_assay, input_read_RNA_assay) + colnames(input_read_RNA_assay)[2]= "dummy___" } - blueprint <- celldex::BlueprintEncodeData() + + blueprint <- celldex::BlueprintEncodeData( + ensembl = feature_nomenclature == "ensembl" + #legacy = TRUE + ) data_annotated = - sce |> + input_read_RNA_assay |> SingleR( ref = blueprint, assay.type.test= 1, @@ -94,7 +390,7 @@ annotation_label_transfer <- function(input_read_RNA_assay, left_join( - sce |> + input_read_RNA_assay |> SingleR( ref = blueprint, assay.type.test= 1, @@ -109,14 +405,16 @@ annotation_label_transfer <- function(input_read_RNA_assay, rm(blueprint) gc() - - MonacoImmuneData = celldex::MonacoImmuneData() + MonacoImmuneData <- celldex::MonacoImmuneData( + ensembl = feature_nomenclature == "ensembl" + #legacy = TRUE + ) data_annotated = data_annotated |> left_join( - sce |> + input_read_RNA_assay |> SingleR( ref = MonacoImmuneData, assay.type.test= 1, @@ -130,7 +428,7 @@ annotation_label_transfer <- function(input_read_RNA_assay, ) |> left_join( - sce |> + input_read_RNA_assay |> SingleR( ref = MonacoImmuneData, assay.type.test= 1, @@ -146,22 +444,8 @@ annotation_label_transfer <- function(input_read_RNA_assay, rm(MonacoImmuneData) gc() - - rm(sce) - gc() - # Convert SCE to SE to calculate SCT - if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { - assay(input_read_RNA_assay, assay) <- assay(input_read_RNA_assay, assay) |> as("dgCMatrix") - input_read_RNA_assay <- input_read_RNA_assay |> as.Seurat(data = NULL) - - # Rename assay - assay_name_old = input_read_RNA_assay |> Assays() |> _[[1]] - input_read_RNA_assay = input_read_RNA_assay |> - RenameAssays( - assay.name = assay_name_old, - new.assay.name = assay) - } + # If not immune cells if(nrow(data_annotated) == 0){ @@ -181,109 +465,65 @@ annotation_label_transfer <- function(input_read_RNA_assay, } else if (!is.null(reference_azimuth)) { - #print("Start Seurat") - - # Load reference PBMC - # reference_azimuth <- LoadH5Seurat("data//pbmc_multimodal.h5seurat") - # reference_azimuth |> saveRDS("analysis/annotation_label_transfer/reference_azimuth.rds") - - #reference_azimuth = readRDS(reference_azimuth_path) - - - # Reading input - input_read_RNA_assay = - input_read_RNA_assay |> - # Filter empty - left_join(empty_droplets_tbl, by = ".cell") |> - filter(!empty_droplet) - - - # Subset - RNA_assay = input_read_RNA_assay[rownames(input_read_RNA_assay[[assay]]) %in% rownames(reference_azimuth[["SCT"]]),][[assay]] - - #RNA_assay <- input_read_RNA_assay@assays$RNA[["counts"]][rownames(input_read_RNA_assay@assays$RNA[["counts"]])%in% rownames(reference_azimuth[["SCT"]]),] - #ADT_assay = input_read_RNA_assay[["ADT"]][rownames(input_read_RNA_assay[["ADT"]]) %in% rownames(reference_azimuth[["ADT"]]),] - input_read_RNA_assay <- CreateSeuratObject( counts = RNA_assay) - - if("ADT" %in% names(input_read_RNA_assay@assays) ) { - ADT_assay = input_read_RNA_assay[["ADT"]][rownames(input_read_RNA_assay[["ADT"]]) %in% rownames(reference_azimuth[["ADT"]]),] - if("ADT" %in% names(input_read_RNA_assay@assays) ) - input_read_RNA_assay[["ADT"]] = ADT_assay |> CreateAssayObject() - } + library(Seurat) # !!! If this is not here gives error, but this has to go for Bioconductor - # Normalise RNA - input_read_RNA_assay = - input_read_RNA_assay |> + # Convert SCE to SE to calculate SCT + if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { - # Normalise RNA - not informed by smartly selected variable genes - SCTransform(assay=assay) |> - ScaleData(assay = "SCT") |> - RunPCA(assay = "SCT") - - if("ADT" %in% names(input_read_RNA_assay@assays) ){ - Seurat::VariableFeatures(input_read_RNA_assay, assay="ADT") <- rownames(input_read_RNA_assay[["ADT"]]) - input_read_RNA_assay = - input_read_RNA_assay |> - NormalizeData(normalization.method = 'CLR', margin = 2, assay="ADT") |> - ScaleData(assay="ADT") |> - RunPCA(assay = "ADT", reduction.name = 'apca') - } - - - # input_file = - # input_file |> - # FindMultiModalNeighbors( - # reduction.list = list("pca", "apca"), - # dims.list = list(1:30, 1:18), - # modality.weight.name = "RNA.weight" - # ) |> - # RunUMAP( - # nn.name = "weighted.nn", - # reduction.name = "wnn.umap", - # reduction.key = "wnnUMAP_" - # ) - - # Define common anchors - anchors <- Seurat::FindTransferAnchors( - reference = reference_azimuth, - query = input_read_RNA_assay, - normalization.method = "SCT", - reference.reduction = "spca", - dims = 1:50 - ) - - # Mapping - - azimuth_annotation = - tryCatch( - expr = { - Seurat::MapQuery( - anchorset = anchors, - query = input_read_RNA_assay, - reference = reference_azimuth , - refdata = list( - celltype.l1 = "celltype.l1", - celltype.l2 = "celltype.l2", - predicted_ADT = "ADT" - ), - reference.reduction = "spca", - reduction.model = "wnn.umap", - query.dims = 1:2 - ) - }, - error = function(e){ - print(e) - input_read_RNA_assay |> as_tibble() |> select(.cell) - } - ) |> - as_tibble() |> - select(.cell, any_of(c("predicted.celltype.l1", "predicted.celltype.l2")), contains("refUMAP")) + assay = input_read_RNA_assay@assays |> names() |> extract2(1) + + assay(input_read_RNA_assay, assay) <- + assay(input_read_RNA_assay, assay) |> + as("dgCMatrix") + + input_read_RNA_assay <- input_read_RNA_assay |> as.Seurat(data = NULL, counts = assay) + + # Rename assay + assay_name_old = input_read_RNA_assay |> Assays() |> _[[1]] + input_read_RNA_assay = input_read_RNA_assay |> + RenameAssays( + assay.name = assay_name_old, + new.assay.name = assay) + } + + options(future.globals.maxSize = 16 * 1024^3) + + azimuth_annotation = + tryCatch({ + + if(ncol(input_read_RNA_assay)<200) k.weight = 25 + else k.weight = 50 + + input_read_RNA_assay |> RenameAssays(assay.name = assay, new.assay.name = "RNA") |> + Azimuth::RunAzimuth(reference = reference_azimuth, assay = "RNA", umap.name = "refUMAP") |> + as_tibble() |> + dplyr::select(.cell, any_of( + c( + "predicted.celltype.l1", + "predicted.celltype.l2", + "predicted.celltype.l3", + "predicted.celltype.l1.score", + "predicted.celltype.l2.score", + "predicted.celltype.l3.score" + ) + )) |> + nest(azimuth_scores_celltype = c(ends_with("score"))) |> + dplyr::rename(azimuth_predicted.celltype.l1 = predicted.celltype.l1, + azimuth_predicted.celltype.l2 = predicted.celltype.l2, + azimuth_predicted.celltype.l3 = predicted.celltype.l3) + }, + error = function(e) { + if(!str_detect(e$message, "Please set k.weight to be smaller than the number of anchors|Number of anchor cells is less than k.weight|number of items to replace is not a multiple of replacement length")) + stop("HPCell says: Seurat Azimuth failed, probably for the small number of cells, which is .", ncol(input_read_RNA_assay), " Please investigate -> ", e$message) + print(e) + input_read_RNA_assay |> as_tibble() |> dplyr::select(.cell) + }) # Save - modified_data <- data_annotated |> - left_join(azimuth_annotation, by = dplyr::join_by(.cell) ) + data_annotated |> + left_join(azimuth_annotation, by = dplyr::join_by(.cell) ) - return(modified_data) + } } @@ -295,7 +535,8 @@ annotation_label_transfer <- function(input_read_RNA_assay, #' @param assay The assay to be used for analysis, specified as a character string. #' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing RNA assay data. #' @param empty_droplets_tbl A tibble identifying empty droplets. -#' @param annotation_label_transfer_tbl A tibble with annotation label transfer data. +#' @param cell_type_ensembl_harmonised_tbl A tibble with annotated cell type label data. +#' @param cell_type_column A character vector indicating the cell type column used for grouping during quality control and dead cell removal. #' @param assay assay used, default = "RNA" #' #' @return A tibble identifying alive cells. @@ -322,31 +563,41 @@ annotation_label_transfer <- function(input_read_RNA_assay, #' #' @export alive_identification <- function(input_read_RNA_assay, - empty_droplets_tbl, - annotation_label_transfer_tbl = NULL, - annotation_column = NULL, - assay = NULL) { + empty_droplets_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + cell_type_column = NULL, + assay = NULL, + feature_nomenclature) { # Fix GCHECK notes empty_droplet = NULL detected = NULL .cell = NULL high_mitochondrion = NULL - blueprint_first.labels.fine = NULL + + if (input_read_RNA_assay |> is.null()) return(NULL) if( - !is.null(annotation_column) && - !annotation_column %in% colnames(as_tibble(input_read_RNA_assay[1,1])) + is.null(cell_type_column) && + !cell_type_column %in% colnames(as_tibble(input_read_RNA_assay[1,1])) ) stop("HPCell says: Your `group_by` columns are not present in your data. Please run annotate_cell_type_hpc() to get the cell type annotation that you can use as grouping for the cell-type-specific quality control and removal of dead cells.") # Get assay if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) - input_read_RNA_assay = - input_read_RNA_assay |> - left_join(empty_droplets_tbl, by=".cell") |> - dplyr::filter(!empty_droplet) + if (!is.null(empty_droplets_tbl)) { + input_read_RNA_assay = + input_read_RNA_assay |> + left_join(empty_droplets_tbl, by=".cell") |> + dplyr::filter(!empty_droplet) + } + + # In rare cases, all cells in a sample are empty droplets + if (ncol(input_read_RNA_assay) == 0) return(NULL) + + # In rare cases, a cell in a sample is non empty droplet + if (ncol(input_read_RNA_assay) == 1) input_read_RNA_assay = input_read_RNA_assay |> duplicate_single_column_assay() # Calculate nFeature_RNA and nCount_RNA if not exist in the data nFeature_name <- paste0("nFeature_", assay) @@ -373,16 +624,23 @@ alive_identification <- function(input_read_RNA_assay, } } - + input_read_RNA_assay <- input_read_RNA_assay %>% + AddMetaData( + metadata = PercentageFeatureSet(input_read_RNA_assay, pattern = "^MT-", assay = assay), + col.name = "percent.mt" + ) # Returns a named vector of IDs - # Matches the gene id’s row by row and inserts NA when it can’t find gene names - location <- mapIds( - EnsDb.Hsapiens.v86, - keys=rownames(input_read_RNA_assay), - column="SEQNAME", - keytype="SYMBOL" - ) + # Matches the gene id's row by row and inserts NA when it can't find gene names + if (feature_nomenclature == "symbol") { + location <- mapIds( + EnsDb.Hsapiens.v86, + keys=rownames(input_read_RNA_assay), + column="SEQNAME", + keytype="SYMBOL" + ) + } + which_mito = rownames(input_read_RNA_assay) |> str_which("^MT") @@ -396,13 +654,13 @@ alive_identification <- function(input_read_RNA_assay, # as_tibble(rownames = ".cell") |> # select(-sum, -detected) |> # - # # Join cell types if annotation_label_transfer_tbl provided + # # Join cell types if cell_type_ensembl_harmonised_tbl provided # {\(x) - # if (inherits(annotation_label_transfer_tbl, "tbl_df")) { - # left_join(x, annotation_label_transfer_tbl, by = ".cell") |> + # if (inherits(cell_type_ensembl_harmonised_tbl, "tbl_df")) { + # left_join(x, cell_type_ensembl_harmonised_tbl, by = ".cell") |> # # # Label cells - # nest(data = -all_of(annotation_column)) |> + # nest(data = -all_of(cell_type_column)) |> # mutate(data = map( # data, # ~ .x |> @@ -439,52 +697,56 @@ alive_identification <- function(input_read_RNA_assay, as_tibble(rownames = ".cell") %>% dplyr::select(-sum, -detected) + # I HAVE TO DROP UNIQUE, AS SOON AS THE BUG IN SEURAT IS RESOLVED. UNIQUE IS BUG PRONE HERE. + percentage_output = PercentageFeatureSet(input_read_RNA_assay, pattern = "^RPS|^RPL", assay = assay) + percentage_output = percentage_output[!duplicated(names(percentage_output))] # Compute ribosome statistics ribosome = input_read_RNA_assay |> select(.cell) |> #mutate(subsets_Ribo_percent = PercentageFeatureSet(input_read_RNA_assay, pattern = "^RPS|^RPL", assay = assay)[,1]) |> - - # I HAVE TO DROP UNIQUE, AS SOON AS THE BUG IN SEURAT IS RESOLVED. UNIQUE IS BUG PRONE HERE. - mutate(subsets_Ribo_percent = PercentageFeatureSet(input_read_RNA_assay, pattern = "^RPS|^RPL", assay = assay)) + mutate(subsets_Ribo_percent = percentage_output) - # Add cell type labels and determine high mitochondrion content, if annotation_label_transfer_tbl is provided - if(annotation_column |> is.null() |> not()) { + # Add cell type labels and determine high mitochondrion content, if cell_type_ensembl_harmonised_tbl is provided + if(cell_type_column |> is.null() |> not()) { - if ( - inherits(annotation_label_transfer_tbl, "tbl_df") && - annotation_column %in% colnames(annotation_label_transfer_tbl) - ) { - - mitochondrion <- qc_metrics %>% - left_join(annotation_label_transfer_tbl, by = ".cell") - - ribosome = - ribosome |> - left_join(annotation_label_transfer_tbl, by = ".cell") - } - - - else if (annotation_column %in% colnames(as_tibble(input_read_RNA_assay[1,1]))) { + if ( + inherits(cell_type_ensembl_harmonised_tbl, "tbl_df") && + cell_type_column %in% colnames(cell_type_ensembl_harmonised_tbl) + ) { + + mitochondrion <- qc_metrics %>% + left_join(cell_type_ensembl_harmonised_tbl, by = ".cell") + + ribosome = + ribosome |> + # Only retrieve metadata so nesting in the next step won't break + left_join(cell_type_ensembl_harmonised_tbl, by = ".cell") |> as_tibble() + } + + + else if (cell_type_column %in% colnames(as_tibble(input_read_RNA_assay[1,1]))) { mitochondrion <- qc_metrics %>% - left_join(input_read_RNA_assay |> select(.cell, all_of(annotation_column)), by = ".cell") + left_join(input_read_RNA_assay |> as_tibble() |> select(.cell, all_of(cell_type_column)), by = ".cell") ribosome = ribosome |> - left_join(input_read_RNA_assay |> select(.cell, all_of(annotation_column)), by = ".cell") + # Only retrieve metadata so nesting in the next step won't break + left_join(input_read_RNA_assay |> as_tibble() |> select(.cell, all_of(cell_type_column)), by = ".cell") |> as_tibble() + } - - + + mitochondrion = mitochondrion %>% - nest(data = -all_of(annotation_column)) + nest(data = -all_of(cell_type_column)) ribosome = ribosome |> - nest(data = -all_of(annotation_column)) + nest(data = -all_of(cell_type_column)) } else { # Determing high mitochondrion content @@ -500,7 +762,7 @@ alive_identification <- function(input_read_RNA_assay, mutate(high_mitochondrion = isOutlier(subsets_Mito_percent, type="higher"), high_mitochondrion = as.logical(high_mitochondrion)))) %>% unnest(cols = data) - + ribosome = ribosome |> mutate(data = map( @@ -515,9 +777,11 @@ alive_identification <- function(input_read_RNA_assay, # Merge mitochondrion |> - left_join(ribosome, by=".cell") |> - mutate(alive = !high_mitochondrion) # & !high_ribosome ) |> - + left_join(ribosome) |> + mutate(alive = !high_mitochondrion) |> # & !high_ribosome ) |> + # Select informative columns + select(.cell, {{cell_type_column}}, contains("subsets"), contains("observation"), + contains("high"), alive) } @@ -530,61 +794,72 @@ alive_identification <- function(input_read_RNA_assay, #' @param assay The assay to be used for analysis, specified as a character string. #' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing RNA assay data. #' @param empty_droplets_tbl A tibble identifying empty droplets. -#' @param alive_identification_tbl A tibble identifying alive cells. -#' @param annotation_label_transfer_tbl A tibble with annotation label transfer data. -#' @param reference_label_fine Optional reference label for fine-tuning. #' @param assay Name of the assay to use. #' #' @return A tibble containing cells with their scDblFinder scores. #' -#' @importFrom dplyr left_join filter +#' @importFrom dplyr left_join filter select #' @importFrom Matrix Matrix -#' @importFrom SummarizedExperiment colData +#' @importFrom SummarizedExperiment colData assayNames assayNames<- #' @importFrom Seurat as.SingleCellExperiment #' @import scDblFinder #' @export doublet_identification <- function(input_read_RNA_assay, - empty_droplets_tbl, - alive_identification_tbl, - #annotation_label_transfer_tbl, - #reference_label_fine, + empty_droplets_tbl = NULL, + # annotation_label_transfer_tbl, + # reference_label_fine, assay = NULL){ # Fix GChecks .cell = NULL empty_droplet = NULL - high_mitochondrion = NULL - high_ribosome = NULL + + if (is.null(input_read_RNA_assay)) return(NULL) # Get assay if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) - + if (inherits(input_read_RNA_assay, "Seurat")) { input_read_RNA_assay <- input_read_RNA_assay |> - # Filtering empty Seurat::as.SingleCellExperiment() } - - filter_empty_droplets <- input_read_RNA_assay |> - # Filtering empty - left_join(empty_droplets_tbl |> select(.cell, empty_droplet), by = ".cell") |> - filter(!empty_droplet) |> - - # Filter dead - left_join(alive_identification_tbl |> select(.cell, alive), by = ".cell") |> - filter(alive) + # Filtering empty + if (!is.null(empty_droplets_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(empty_droplets_tbl |> select(.cell, empty_droplet), by = ".cell") |> + filter(!empty_droplet) + } - # Annotate - filter_empty_droplets <- filter_empty_droplets |> - #left_join(annotation_label_transfer_tbl, by = ".cell")|> - #scDblFinder(clusters = ifelse(reference_label_fine=="none", TRUE, reference_label_fine)) |> - scDblFinder(clusters = NULL) + # scDblFinder() can identify doublets from non-empty droplet cells, so no need to filter alive - as_tibble(colData(filter_empty_droplets), rownames = ".cell")|> select(.cell, contains("scDblFinder")) + # In rare cases, all cells in a sample are empty droplets or dead + if (ncol(input_read_RNA_assay) == 0) return(NULL) + # scDblFinder can only handle counts assay, thus rename + assayNames(input_read_RNA_assay)[assayNames(input_read_RNA_assay) == assay] <- "counts" + + # Annotate + # Mark doublets to Unknown when scDblFinder fails and keep them in the downstream analysis. + result <- tryCatch({ + # Run scDblFinder + input_read_RNA_assay <- input_read_RNA_assay |> + # By default, artificial doublets will be considered unidentifiable when score threshold below 0.2 + scDblFinder(clusters = NULL) + }, error = function(e) { + # Error handling + message("Error in scDblFinder: ", e$message) + input_read_RNA_assay <- input_read_RNA_assay |> mutate(scDblFinder.class = "Unknown") + } + ) + + result |> + colData() |> + as_tibble(rownames = ".cell") |> + select(.cell, scDblFinder.class) + } @@ -608,14 +883,14 @@ doublet_identification <- function(input_read_RNA_assay, #' @importFrom tibble as_tibble #' @importFrom Seurat CellCycleScoring #' @importFrom Seurat as.Seurat -#' @importFrom Seurat RenameAssays +#' @importFrom SeuratObject RenameAssays #' @importFrom Seurat NormalizeData #' @importFrom EnsDb.Hsapiens.v86 EnsDb.Hsapiens.v86 #' @importFrom SingleCellExperiment SingleCellExperiment #' @export cell_cycle_scoring <- function(input_read_RNA_assay, - empty_droplets_tbl, - gene_nomenclature, + empty_droplets_tbl = NULL, + feature_nomenclature, assay = NULL){ #Fix GCHECK empty_droplet = NULL @@ -639,171 +914,730 @@ cell_cycle_scoring <- function(input_read_RNA_assay, new.assay.name = assay) } - if (gene_nomenclature == "ensembl") { - s.features_tidy = Seurat::cc.genes$s.genes |> convert_gene_names(current_nomenclature = "symbol") |> - filter(stringr::str_detect(gene_id, "ENSG*")) |> dplyr::pull(gene_id) - g2m.features_tidy = Seurat::cc.genes$g2m.genes |> convert_gene_names(current_nomenclature = "symbol") |> + if (feature_nomenclature == "ensembl") { + s.features_tidy = Seurat::cc.genes$s.genes |> + convert_gene_names(current_nomenclature = "symbol") |> filter(stringr::str_detect(gene_id, "ENSG*")) |> dplyr::pull(gene_id) - } else if (gene_nomenclature == "symbol") { + g2m.features_tidy = Seurat::cc.genes$g2m.genes |> + convert_gene_names(current_nomenclature = "symbol") |> + filter(stringr::str_detect(gene_id, "ENSG*")) |> dplyr::pull(gene_id) + } else if (feature_nomenclature == "symbol") { s.features_tidy = Seurat::cc.genes$s.genes g2m.features_tidy = Seurat::cc.genes$g2m.genes } + # avoid small number of cells + if (!is.null(empty_droplets_tbl)) { + filtered_counts <- input_read_RNA_assay |> + left_join(empty_droplets_tbl, by = ".cell") |> + dplyr::filter(!empty_droplet) + } - counts <- - input_read_RNA_assay |> - left_join(empty_droplets_tbl, by = ".cell") |> - dplyr::filter(!empty_droplet) |> - + counts <- filtered_counts |> # Normalise needed NormalizeData() |> - # Assign cell cycle scores of each cell + # Assign cell cycle scores of each cell # Based on its expression of G2/M and S phase markers #Stores S and G2/M scores in object meta data along with predicted classification of each cell in either G2M, S or G1 phase - CellCycleScoring( - s.features = s.features_tidy, - g2m.features = g2m.features_tidy, - set.ident = FALSE - ) |> + CellCycleScoring(s.features = s.features_tidy, + g2m.features = g2m.features_tidy, + set.ident = FALSE) |> as_tibble() |> - select(.cell, S.Score, G2M.Score, Phase) + select(.cell, S.Score, G2M.Score, Phase) + +} + + +#' Non-Batch Variation Removal +#' +#' @description +#' Regresses out variations due to mitochondrial content, ribosomal content, and +#' cell cycle effects. +#' +#' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing RNA assay data. +#' @param empty_droplets_tbl A tibble identifying empty droplets. +#' @param alive_identification_tbl A tibble from alive cell identification. +#' @param cell_cycle_score_tbl A tibble from cell cycle scoring. +#' @param assay assay used, default = "RNA" +#' +#' @return Normalized and adjusted data. +#' +#' @importFrom dplyr left_join filter +#' @importFrom Seurat NormalizeData VariableFeatures SCTransform +#' @export +non_batch_variation_removal <- function(input_read_RNA_assay, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, + assay = NULL, + factors_to_regress = NULL, + external_path){ + #Fix GChecks + empty_droplet = NULL + .cell <- NULL + + # Your code for non_batch_variation_removal function here + class_input = input_read_RNA_assay |> class() + + # Get assay + if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) + + if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + assay(input_read_RNA_assay, assay) <- assay(input_read_RNA_assay, assay) |> as("dgCMatrix") + + input_read_RNA_assay <- input_read_RNA_assay |> as.Seurat(data = NULL, + counts = assay) + # Rename assay + assay_name_old = input_read_RNA_assay |> Assays() |> _[[1]] + input_read_RNA_assay = input_read_RNA_assay |> + RenameAssays( + assay.name = assay_name_old, + new.assay.name = assay) + } + + # avoid small number of cells + if (!is.null(empty_droplets_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(empty_droplets_tbl, by = ".cell") |> + dplyr::filter(!empty_droplet) + } + + if (!is.null(alive_identification_tbl)) { + input_read_RNA_assay = + input_read_RNA_assay |> + left_join( + alive_identification_tbl |> + select(.cell, any_of(factors_to_regress)), + by=".cell" + ) + } + + if(!is.null(cell_cycle_score_tbl)) + input_read_RNA_assay = input_read_RNA_assay |> + + left_join( + cell_cycle_score_tbl |> + select(.cell, any_of(factors_to_regress)), + by=".cell" + ) + + # filter(!high_mitochondrion | !high_ribosome) + + # variable_features = readRDS(input_path_merged_variable_genes) + # + # # Set variable features + # VariableFeatures(input_read_RNA_assay) = variable_features + + # Normalise RNA + input_read_RNA_assay <- + input_read_RNA_assay |> + Seurat::SCTransform( + assay=assay, + return.only.var.genes=FALSE, + residual.features = NULL, + vars.to.regress = factors_to_regress, + vst.flavor = "v2", + scale_factor=2186, + conserve.memory=T, + min_cells=0 + ) |> + GetAssayData(assay="SCT") + + if (class_input == "SingleCellExperiment") { + + if(input_read_RNA_assay[,1,drop=FALSE] |> is.nan() |> any()) + warning("HPCell says: some features might be all 0s, NaN are added by Seurat in the SCT assay, and kept in the assay because SingleCellExperiment requires same feature set for all assays.") + + write_HDF5_array_safe(input_read_RNA_assay, "SCT", external_path) + + } else if (class_input == "Seurat") { + + # Remove NaN features from SCT assay + input_read_RNA_assay <- input_read_RNA_assay[!apply(input_read_RNA_assay, 1, function(row) all(is.nan(row))), ] + + input_read_RNA_assay + + } + + + # # Normalise antibodies + # if ( "ADT" %in% names(normalized_rna@assays)) { + # normalized_data <- normalized_rna %>% + # NormalizeData(normalization.method = 'CLR', margin = 2, assay="ADT") %>% + # select(-subsets_Ribo_percent, -subsets_Mito_percent, -G2M.Score) + # + # my_assays = my_assays |> c("CLR") + # + # } else { + # normalized_data <- normalized_rna %>% + # # Drop alive columns + # select(-subsets_Ribo_percent, -subsets_Mito_percent, -G2M.Score) + # } +} + +#' Preprocess metacells with the SuperCell approach +#' +#' This function preprocesses a single-cell gene expression matrix for downstream simplification using PCA +#' and k-nearest neighbor (kNN) graph construction. It includes options for scaling, feature selection, +#' approximate sampling, and PCA computation methods. +#' +#' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing RNA assay data. +#' @param assay assay used, default = "RNA" +#' @param genes.use a vector of genes used to compute PCA +#' @param genes.exclude a vector of genes to be excluded when computing PCA +#' @param n.var.genes if \code{"genes.use"} is not provided, \code{"n.var.genes"} genes with the largest variation are used +#' @param k.knn parameter to compute single-cell kNN network +#' @param do.scale whether to scale gene expression matrix when computing PCA +#' @param n.pc number of principal components to use for construction of single-cell kNN network +#' @param fast.pca use \link[irlba]{irlba} as a faster version of prcomp (one used in Seurat package) +#' @param do.approx compute approximate kNN in case of a large dataset (>50'000) +#' @param approx.N number of cells to subsample for an approximate approach. By default, 5000 cells are used +#' for approximation to capture biological meaningful result. +#' @param seed seed to use to subsample cells for an approximate approach +#' @param ... other parameters of \link{build_knn_graph} function +#' @return A list of variables to be passed to the `SuperCell::SCimplify` gamma involved function. +#' @importFrom Matrix t +#' @importFrom stats var prcomp +#' @importFrom irlba irlba +#' @importFrom SuperCell build_knn_graph +#' @export +preprocess_SCimplify <- function(input_read_RNA_assay, + assay = NULL, + genes.use = NULL, + genes.exclude = NULL, + n.var.genes = min(1000, nrow(input_read_RNA_assay)), + k.knn = 5, + do.scale = TRUE, + n.pc = 10, + fast.pca = TRUE, + do.approx = FALSE, + approx.N = 5000, + seed = 12345, + ...){ + #Fix GChecks + empty_droplet = NULL + .cell <- NULL + + # Your code for non_batch_variation_removal function here + class_input = input_read_RNA_assay |> class() + + # For small number of cells + if (ncol(input_read_RNA_assay) < 10) { + k.knn = ncol(input_read_RNA_assay) - 1 + n.pc = ncol(input_read_RNA_assay) - 1 + } + + # Get assay + if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> magrittr::extract2(1) + + # Convert to SE if the input is SCE + if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + assay(input_read_RNA_assay, assay) <- assay(input_read_RNA_assay, assay) |> as("dgCMatrix") + + input_read_RNA_assay <- input_read_RNA_assay |> as.Seurat(data = NULL, + counts = assay) + + # Rename assay + assay_name_old = DefaultAssay(input_read_RNA_assay) + input_read_RNA_assay_transform = input_read_RNA_assay |> + RenameAssays( + assay.name = assay_name_old, + new.assay.name = assay) + } + + # Get normalise and scale gene expression matrix with rows to be genes and cols to be cells + normalized_rna <- + input_read_RNA_assay |> + NormalizeData(normalization.method = "LogNormalize") |> + FindVariableFeatures(nfeatures = 2000) |> + ScaleData() |> + RunPCA(npcs = min(50, ncol(input_read_RNA_assay) - 1), verbose = F) |> + RunUMAP(reduction = "pca", dims = c(1:min(30, ncol(input_read_RNA_assay) - 1)), + n.neighbors = min(30, ncol(input_read_RNA_assay) - 1), verbose = F) |> + Seurat::GetAssayData(slot = "data") + + N.c <- ncol(normalized_rna) + + # if(gamma > 100 & N.c < 100000){ + # warning(paste0("Graining level (gamma = ", gamma, ") seems to be very large! Please, consider using smaller gamma, the suggested range is 10-50.")) + # } + + if(is.null(rownames(normalized_rna))){ + if(!(is.null(genes.use) | is.null(genes.exclude))){ + stop("rownames(normalized_rna) is Null \nGene expression matrix normalized_rna is expected to have genes as rownames") + } else { + warning("colnames(normalized_rna) is Null, \nGene expression matrix normalized_rna is expected to have genes as rownames! \ngenes will be created automatically in a form 'gene_i' ") + rownames(normalized_rna) <- paste("gene", 1:nrow(normalized_rna), sep = "_") + } + } + + if(is.null(colnames(normalized_rna))){ + warning("colnames(normalized_rna) is Null, \nGene expression matrix normalized_rna is expected to have cellIDs as colnames! \nCellIDs will be created automatically in a form 'cell_i' ") + colnames(normalized_rna) <- paste("cell", 1:N.c, sep = "_") + } + + cell.ids <- colnames(normalized_rna) + + keep.genes <- setdiff(rownames(normalized_rna), genes.exclude) + normalized_rna <- normalized_rna[keep.genes,] + + + if(is.null(genes.use)){ + n.var.genes <- min(n.var.genes, nrow(normalized_rna)) + if(N.c > 50000){ + set.seed(seed) + idx <- sample(N.c, 50000) + gene.var <- apply(normalized_rna[,idx], 1, stats::var) + } else { + gene.var <- apply(normalized_rna, 1, stats::var) + } + + genes.use <- names(sort(gene.var, decreasing = TRUE))[1:n.var.genes] + } + + if(length(intersect(genes.use, genes.exclude)) > 0){ + stop("Sets of genes.use and genes.exclude have non-empty intersection") + } + + genes.use <- genes.use[genes.use %in% rownames(normalized_rna)] + normalized_rna <- normalized_rna[genes.use,] + + if(do.approx & approx.N >= N.c){ + do.approx <- FALSE + warning("approx.N is larger or equal to the number of single cells, thus, an exact simplification will be performed") + } + + # if(do.approx & (approx.N < round(N.c/gamma))){ + # approx.N <- round(N.c/gamma) + # warning(paste("approx.N is set to N.SC", approx.N)) + # } + # + # if(do.approx & ((N.c/gamma) > (approx.N/3))){ + # warning("approx.N is not much larger than desired number of super-cells, so an approximate simplification may take londer than an exact one!") + # } + + if(do.approx){ + set.seed(seed) + approx.N <- min(approx.N, N.c) + presample <- sample(1:N.c, size = approx.N, replace = FALSE) + presampled.cell.ids <- cell.ids[sort(presample)] + rest.cell.ids <- setdiff(cell.ids, presampled.cell.ids) + } else { + presampled.cell.ids <- cell.ids + rest.cell.ids <- c() + } + + normalized_rna.for.pca <- Matrix::t(normalized_rna[genes.use, presampled.cell.ids]) + if(do.scale){ normalized_rna.for.pca <- scale(normalized_rna.for.pca) } + normalized_rna.for.pca[is.na(normalized_rna.for.pca)] <- 0 + + if(is.null(n.pc[1]) | min(n.pc) < 1){stop("Please, provide a range or a number of components to use: n.pc")} + if(length(n.pc)==1) n.pc <- 1:n.pc + + if(fast.pca & (N.c < 1000)){ + warning("Normal pca is computed because number of cell is low for irlba::irlba()") + fast.pca <- FALSE + } + + if(!fast.pca){ + PCA.presampled <- tryCatch({ + stats::prcomp(normalized_rna.for.pca, rank. = max(n.pc), scale. = FALSE, center = FALSE) + }, error = function(e) { + # Print error message + cat("Error in PCA computation: ", e$message, "\nExcluding zero variance and retrying...\n") + + # Update normalized_rna.for.pca to exclude columns with zero variance + normalized_rna.for.pca <- normalized_rna.for.pca[, apply(normalized_rna.for.pca, 2, var) != 0] + + # Rerun PCA on the updated dataset + stats::prcomp(normalized_rna.for.pca, rank. = max(n.pc), scale. = FALSE, center = FALSE) + }) + + } else { + set.seed(seed) + PCA.presampled <- irlba::irlba(normalized_rna.for.pca, nv = max(n.pc, 25)) + PCA.presampled$x <- PCA.presampled$u %*% diag(PCA.presampled$d) + PCA.presampled$rotation <- PCA.presampled$v + } + + + sc.nw <- SuperCell::build_knn_graph( + X = PCA.presampled$x[,n.pc], + k = k.knn, from = "coordinates", + #use.nn2 = use.nn2, + dist_method = "euclidean", + #directed = directed, + #DoSNN = DoSNN, + #pruning = pruning, + #which.snn = which.snn, + #kmin = kmin, + ... + ) + + list(sc.nw = sc.nw, PCA.presampled = PCA.presampled, + normalized_rna.for.pca = normalized_rna.for.pca, + presampled.cell.ids = presampled.cell.ids, + rest.cell.ids = rest.cell.ids, genes.use = genes.use, cell.ids = cell.ids, + do.approx = do.approx, n.pc = n.pc, k.knn = k.knn) + +} + +#' Detection of metacells with the SuperCell approach +#' +#' This function detects metacells (former super-cells) from single-cell gene expression matrix +#' +#' +#' @param preprocessed A list returned by `preprocess_SCimplify` containing preprocessed single-cell data, +#' PCA results, and kNN graph. +#' @param cell.annotation a vector of cell type annotation, if provided, metacells that contain single cells of different cell type annotation will be split in multiple pure metacell (may result in slightly larger numbe of metacells than expected with a given gamma) +#' @param cell.split.condition a vector of cell conditions that must not be mixed in one metacell. If provided, metacells will be split in condition-pure metacell (may result in significantly(!) larger number of metacells than expected) +#' @param gamma graining level of data (proportion of number of single cells in the initial dataset to the number of metacells in the final dataset) +#' @param block.size number of cells to map to the nearest metacell at the time (for approx coarse-graining) +#' @param igraph.clustering clustering method to identify metacells (available methods "walktrap" (default) and "louvain" (not recommended, gamma is ignored)). +#' @param return.singlecell.NW whether return single-cell network (which consists of approx.N if \code{"do.approx"} or all cells otherwise) +#' @param return.hierarchical.structure whether return hierarchical structure of metacell +#' @param ... other parameters of \link{build_knn_graph} function +#' +#' @return A tibble with column 'cell' and 'membership' indicating which metacell cluster each cell belongs to. +#' @importFrom igraph cluster_walktrap cluster_louvain contract simplify E V +#' @importFrom Matrix t +#' @importFrom proxy dist +#' @export +postprocess_SCimplify <- function(preprocessed, + cell.annotation = NULL, + cell.split.condition = NULL, + gamma, + block.size = 10000, + igraph.clustering = c("walktrap", "louvain"), + return.singlecell.NW = TRUE, + return.hierarchical.structure = TRUE, + ...) { + + sc.nw = preprocessed$sc.nw + PCA.presampled = preprocessed$PCA.presampled + normalized_rna.for.pca = preprocessed$normalized_rna.for.pca + presampled.cell.ids = preprocessed$presampled.cell.ids + rest.cell.ids = preprocessed$rest.cell.ids + genes.use = preprocessed$genes.use + cell.ids = preprocessed$cell.ids + do.approx = preprocessed$do.approx + n.pc = preprocessed$n.pc + k.knn = preprocessed$k.knn + #normalized_rna = preprocessed$normalized_rna + + N.c <- length(preprocessed$cell.ids) + + k <- round(N.c / gamma) + + if (igraph.clustering[1] == "walktrap") { + g.s <- igraph::cluster_walktrap(sc.nw$graph.knn) + g.s$membership <- igraph::cut_at(g.s, k) + + } else if (igraph.clustering[1] == "louvain") { + warning(paste( + "igraph.clustering =", + igraph.clustering, + ", gamma is ignored" + )) + g.s <- igraph::cluster_louvain(sc.nw$graph.knn) + + } else { + stop( + paste( + "Unknown clustering method (", + igraph.clustering, + "), please use louvain or walkrtap" + ) + ) + } + + membership.presampled <- g.s$membership + names(membership.presampled) <- presampled.cell.ids + + ## Split super-cells containing cells from different annotations or conditions + if (!is.null(cell.annotation) | !is.null(cell.split.condition)) { + if (is.null(cell.annotation)) + cell.annotation <- rep("a", N.c) + if (is.null(cell.split.condition)) + cell.split.condition <- rep("s", N.c) + names(cell.annotation) <- names(cell.split.condition) <- cell.ids + + split.cells <- interaction(cell.annotation[presampled.cell.ids], cell.split.condition[presampled.cell.ids], drop = TRUE) + + membership.presampled.intr <- interaction(membership.presampled, split.cells, drop = TRUE) + membership.presampled <- as.numeric(membership.presampled.intr) + names(membership.presampled) <- presampled.cell.ids + } + + + + SC.NW <- igraph::contract(sc.nw$graph.knn, membership.presampled) + if (!do.approx) { + SC.NW <- igraph::simplify(SC.NW, + remove.loops = T, + edge.attr.comb = "sum") + } + + + if (do.approx) { + PCA.averaged.SC <- as.matrix(Matrix::t(supercell_GE(t( + PCA.presampled$x[, n.pc] + ), groups = membership.presampled))) + normalized_rna.for.roration <- Matrix::t(normalized_rna[genes.use, rest.cell.ids]) + + + + if (do.scale) { + normalized_rna.for.roration <- scale(normalized_rna.for.roration) + } + normalized_rna.for.roration[is.na(normalized_rna.for.roration)] <- 0 + + + membership.omitted <- c() + if (is.null(block.size) | is.na(block.size)) + block.size <- 10000 + + N.blocks <- length(rest.cell.ids) %/% block.size + if (length(rest.cell.ids) %% block.size > 0) + N.blocks <- N.blocks+1 + + + if (N.blocks > 0) { + for (i in 1:N.blocks) { + # compute knn by blocks + idx.begin <- (i - 1) * block.size+1 + idx.end <- min(i * block.size, length(rest.cell.ids)) + + cur.rest.cell.ids <- rest.cell.ids[idx.begin:idx.end] + + PCA.ommited <- normalized_rna.for.roration[cur.rest.cell.ids, ] %*% PCA.presampled$rotation[, n.pc] ### + + D.omitted.subsampled <- proxy::dist(PCA.ommited, PCA.averaged.SC) ### + + membership.omitted.cur <- apply(D.omitted.subsampled, 1, which.min) ### + names(membership.omitted.cur) <- cur.rest.cell.ids ### + + membership.omitted <- c(membership.omitted, membership.omitted.cur) + } + } + + membership.all_ <- c(membership.presampled, membership.omitted) + membership.all <- membership.all_ + + + names_membership.all <- names(membership.all_) + ## again split super-cells containing cells from different annotation or split conditions + if (!is.null(cell.annotation) | !is.null(cell.split.condition)) { + split.cells <- interaction(cell.annotation[names_membership.all], cell.split.condition[names_membership.all], drop = TRUE) + + + membership.all.intr <- interaction(membership.all_, split.cells, drop = TRUE) + + membership.all <- as.numeric(membership.all.intr) + + } + + + SC.NW <- igraph::simplify(SC.NW, + remove.loops = T, + edge.attr.comb = "sum") + names(membership.all) <- names_membership.all + membership.all <- membership.all[cell.ids] + + } else { + membership.all <- membership.presampled[cell.ids] + } + membership <- membership.all + + supercell_size <- as.vector(table(membership)) + + igraph::E(SC.NW)$width <- sqrt(igraph::E(SC.NW)$weight / 10) + + if (igraph::vcount(SC.NW) == length(supercell_size)) { + igraph::V(SC.NW)$size <- supercell_size + igraph::V(SC.NW)$sizesqrt <- sqrt(igraph::V(SC.NW)$size) + } else { + igraph::V(SC.NW)$size <- as.vector(table(membership.all_)) + igraph::V(SC.NW)$sizesqrt <- sqrt(igraph::V(SC.NW)$size) + warning("Supercell graph was not splitted") + } + + res <- list( + graph.supercells = SC.NW, + gamma = gamma, + N.SC = length(unique(membership)), + membership = membership, + supercell_size = supercell_size, + genes.use = genes.use, + simplification.algo = igraph.clustering[1], + do.approx = do.approx, + n.pc = n.pc, + k.knn = k.knn, + sc.cell.annotation. = cell.annotation, + sc.cell.split.condition. = cell.split.condition + ) + + if (return.singlecell.NW) { + res$graph.singlecell <- sc.nw$graph.knn + } + if (!is.null(cell.annotation) | !is.null(cell.split.condition)) { + res$SC.cell.annotation. <- supercell_assign(cell.annotation, res$membership) + res$SC.cell.split.condition. <- supercell_assign(cell.split.condition, res$membership) + } - counts + if (igraph.clustering[1] == "walktrap" & + return.hierarchical.structure) + res$h_membership <- g.s + metacell_classification <- tibble(cell = res$membership |> names(), + membership = res$membership) + + metacell_classification } +#' Calculate Appropriate Gamma Values for Metacell Analysis +#' +#' This function determines viable gamma (γ) values to be used in metacell analysis. Gamma is a graining level +#' parameter that controls the degree of cell aggregation when creating metacells. It represents the ratio +#' between the original number of cells and the desired number of metacells. +#' +#' For example: +#' - γ = 2: combines cells to create metacells, aiming for half as many metacells as original cells +#' - γ = 4: aims for one-fourth as many metacells +#' - γ = 8: aims for one-eighth as many metacells +#' And so on, using powers of 2. +#' +#' The function starts with γ = 2 and doubles it repeatedly (2, 4, 8, 16...) until the ratio of +#' cells/gamma would result in metacells that are smaller than the minimum allowed size. Higher gamma +#' values mean more aggressive aggregation (fewer, larger metacells), while lower gamma values preserve +#' more granularity (more, smaller metacells). +#' +#' @param cell_count Integer, the total number of cells. +#' @param min_cells_per_metacell Integer, the minimum number of cells allowed per metacell. Defaults to 30. +#' @return An Integer vector of viable gamma values. If no viable gamma values are found, returns 0. +calculate_gamma <- function(cell_count, min_cells_per_metacell = 1) { + gamma = 2 + gamma_values <- integer() + while (cell_count / gamma >= min_cells_per_metacell) { + gamma_values <- c(gamma_values, gamma) + gamma <- gamma * 2 + } + if (length(gamma_values) == 0) { + return(0) # Return 0 if no viable gamma values + } + return(gamma_values) +} -#' Non-Batch Variation Removal +#' Calculate Metacell Membership Scores Across Different Gamma Parameters #' -#' @description -#' Regresses out variations due to mitochondrial content, ribosomal content, and -#' cell cycle effects. +#' This function processes single-cell data to identify metacell membership across various gamma settings. +#' It preprocesses the single-cell data, calculates gamma values based on the number of columns (typically genes), +#' and postprocesses each gamma setting to assign cells to metacells. It then aggregates these results and +#' handles missing values by taking the maximum value in each group, ignoring NAs. #' -#' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing RNA assay data. -#' @param empty_droplets_tbl A tibble identifying empty droplets. -#' @param alive_identification_tbl A tibble from alive cell identification. -#' @param cell_cycle_score_tbl A tibble from cell cycle scoring. -#' @param assay assay used, default = "RNA" +#' @param sample_sce a SingleCellExperiment object containing pre-loaded single-cell RNA-seq data. +#' @param min_cells_per_metacell An integer of minimum cells in each metacell. +#' @return A tibble with metacells membership scores across computed gamma settings. +#' @importFrom purrr map +#' @importFrom dplyr rename group_by summarise group_split +#' @examples +#' # Assume 'sce' is a SingleCellExperiment object with a cell type +#' calculate_metacell(sce) +calculate_metacell_for_a_sample_per_cell_type <- function(sample_sce, + min_cells_per_metacell = 1) { + # Preprocess the single-cell data + preprocessed_sce = sample_sce |> preprocess_SCimplify() + + # Calculate the number of metacells can be produced + gammas <- calculate_gamma(sample_sce |> colnames() |> length(), + min_cells_per_metacell) + + # Postprocess data for each gamma, rename columns, and aggregate results + gammas |> map(~ postprocess_SCimplify(preprocessed_sce, gamma = .x) |> + dplyr::rename(!!paste0("gamma", .x) := membership)) |> + bind_rows() |> + + # Group by cell and summarise by taking the max value across all variables, removing NAs + group_by(cell) |> + summarise(across(everything(), max, na.rm = TRUE)) +} + +#' Calculate Metacell Membership for Each Cell Type #' -#' @return Normalized and adjusted data. +#' This function processes a SingleCellExperiment object by grouping cells according +#' to their type, calculates metacell membership for each group, and combines the +#' results into a single tibble. #' -#' @importFrom dplyr left_join filter -#' @importFrom Seurat NormalizeData VariableFeatures SCTransform +#' @param sample_sce A SingleCellExperiment object containing single-cell data. +#' @param cell_type_tbl A tibble of cell type. +#' @param empty_droplets_tbl A tibble identifying empty droplets. +#' @param alive_identification_tbl A tibble from alive cell identification. +#' @param doublet_identification_tbl A tibble from doublet identification. +#' @param x A character vector of cell type aggregation column. +#' @param min_cells_per_metacell An integer of minimum cells in each metacell. +#' @return A tibble with metacell membership data for each cell type. #' @export -non_batch_variation_removal <- function(input_read_RNA_assay, - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl, - assay = NULL, - factors_to_regress = NULL, - external_path){ - #Fix GChecks - empty_droplet = NULL - .cell <- NULL - subsets_Ribo_percent <- NULL - subsets_Mito_percent <- NULL - G2M.Score = NULL - - # Your code for non_batch_variation_removal function here - class_input = input_read_RNA_assay |> class() - - # Get assay - if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) - - if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { - assay(input_read_RNA_assay, assay) <- assay(input_read_RNA_assay, assay) |> as("dgCMatrix") - input_read_RNA_assay <- input_read_RNA_assay |> as.Seurat(data = NULL) - - # Rename assay - assay_name_old = input_read_RNA_assay |> Assays() |> _[[1]] - input_read_RNA_assay = input_read_RNA_assay |> - RenameAssays( - assay.name = assay_name_old, - new.assay.name = assay) - } - - input_read_RNA_assay = - input_read_RNA_assay |> - left_join(empty_droplets_tbl, by = ".cell") |> - filter(!empty_droplet) |> - - left_join( - alive_identification_tbl |> - select(.cell, any_of(factors_to_regress)), - by=".cell" - ) +split_sample_cell_type_calculate_metacell_membership <- function(sample_sce, + cell_type_tbl, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + doublet_identification_tbl = NULL, + x="cell_type", + min_cells_per_metacell = NULL) { - if(!is.null(cell_cycle_score_tbl)) - input_read_RNA_assay = input_read_RNA_assay |> - - left_join( - cell_cycle_score_tbl |> - select(.cell, any_of(factors_to_regress)), - by=".cell" - ) + if (sample_sce |> is.null()) return(NULL) - # filter(!high_mitochondrion | !high_ribosome) + if (cell_type_tbl |> is.null()) return(NULL) - # variable_features = readRDS(input_path_merged_variable_genes) - # - # # Set variable features - # VariableFeatures(counts) = variable_features + # avoid small number of cells + if (!is.null(empty_droplets_tbl)) { + sample_sce <- sample_sce |> + left_join(empty_droplets_tbl, by = ".cell") |> + dplyr::filter(!empty_droplet) + } - # Normalise RNA - normalized_rna <- - Seurat::SCTransform( - input_read_RNA_assay, - assay=assay, - return.only.var.genes=FALSE, - residual.features = NULL, - vars.to.regress = factors_to_regress, - vst.flavor = "v2", - scale_factor=2186, - conserve.memory=T, - min_cells=0, - ) |> - GetAssayData(assay="SCT") + # remove dead cells + if (!is.null(alive_identification_tbl)) { + sample_sce = + sample_sce |> + left_join( + alive_identification_tbl , + by=".cell" + ) |> dplyr::filter(alive) + } - - if (class_input == "SingleCellExperiment") { - dir.create(external_path, showWarnings = FALSE, recursive = TRUE) - - - # Write the slice to the output HDF5 file - normalized_rna |> - HDF5Array::writeHDF5Array( - filepath = glue("{external_path}/{digest(normalized_rna)}"), - name = "SCT", - as.sparse = TRUE - ) - - } else if (class_input == "Seurat") { - - normalized_rna - + # remove doublets + if (!is.null(doublet_identification_tbl)) { + sample_sce = + sample_sce |> + left_join( + doublet_identification_tbl , + by=".cell" + ) |> dplyr::filter(scDblFinder.class != "doublet") } - - # # Normalise antibodies - # if ( "ADT" %in% names(normalized_rna@assays)) { - # normalized_data <- normalized_rna %>% - # NormalizeData(normalization.method = 'CLR', margin = 2, assay="ADT") %>% - # select(-subsets_Ribo_percent, -subsets_Mito_percent, -G2M.Score) - # - # my_assays = my_assays |> c("CLR") - # - # } else { - # normalized_data <- normalized_rna %>% - # # Drop alive columns - # select(-subsets_Ribo_percent, -subsets_Mito_percent, -G2M.Score) - # } + # In rare cases, all cells in a sample are from empty droplets or dead or doublets + if (ncol(sample_sce) == 0) return(NULL) + # # In rare cases, only one cell in a sample is left + # if (ncol(sample_sce) == 1) sample_sce = sample_sce |> duplicate_single_column_assay() + metacell_gamma_membership_tibble <- sample_sce |> left_join(cell_type_tbl) |> + dplyr::group_split(!!sym(x)) |> + # We need to include all good quality single cells in metacell. + # For those cells that cant be halved further, mark metacell_2 to 1 + purrr::map( ~ if (ncol(.x) <= 2) { + .x |> + SummarizedExperiment::colData() |> as.data.frame() |> tibble::rownames_to_column("cell") |> + select(cell) |> mutate(gamma2 = 1) |> as_tibble() + } else if (ncol(.x) >2) {calculate_metacell_for_a_sample_per_cell_type(.x)}) |> - + # calculate_metacell_for_a_sample_per_cell_type(.x, min_cells_per_metacell)} else return(NULL)) |> + bind_rows() + metacell_gamma_membership_tibble } #' Preprocessing Output @@ -822,11 +1656,12 @@ non_batch_variation_removal <- function(input_read_RNA_assay, #' #' @return Processed and filter_empty_droplets dataset. #' -#' @importFrom dplyr left_join #' @importFrom dplyr filter #' @importFrom dplyr select +#' @importFrom dplyr left_join #' @import SeuratObject -#' @importFrom dplyr left_join +#' @importFrom SummarizedExperiment assay +#' @importFrom SummarizedExperiment assay<- #' @import tidySingleCellExperiment #' @import tidyseurat #' @importFrom magrittr not @@ -834,12 +1669,13 @@ non_batch_variation_removal <- function(input_read_RNA_assay, #' @importFrom SingleCellExperiment altExp<- #' @export preprocessing_output <- function(input_read_RNA_assay, - empty_droplets_tbl, - non_batch_variation_removal_S, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl){ + empty_droplets_tbl = NULL, + non_batch_variation_removal_S = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + annotation_label_transfer_tbl = NULL, + doublet_identification_tbl = NULL){ #Fix GCHECKS .cell <- NULL alive <- NULL @@ -850,58 +1686,78 @@ preprocessing_output <- function(input_read_RNA_assay, scDblFinder.class <- NULL predicted.celltype.l2 <- NULL - if(empty_droplets_tbl |> is.null() |> not()) + if (empty_droplets_tbl |> is.null() |> not()) { input_read_RNA_assay = input_read_RNA_assay |> left_join(empty_droplets_tbl, by = ".cell") |> - filter(!empty_droplet) + filter(!empty_droplet) + } # Add normalisation if(!is.null(non_batch_variation_removal_S)){ - if(input_read_RNA_assay |> is("Seurat")) - input_read_RNA_assay[["SCT"]] = non_batch_variation_removal_S - else if(input_read_RNA_assay |> is("SingleCellExperiment")){ + if(input_read_RNA_assay |> is("Seurat")) { + non_batch_variation_removal_S_assay <- CreateAssay5Object(data = non_batch_variation_removal_S) + input_read_RNA_assay[["SCT"]] <- non_batch_variation_removal_S_assay + + } else if(input_read_RNA_assay |> is("SingleCellExperiment")){ message("HPCell says: in order to attach SCT assay to the SingleCellExperiment, SCT was added to external experiments slot") - - #input_read_RNA_assay = input_read_RNA_assay[rownames(non_batch_variation_removal_S), ] - + #input_read_RNA_assay = input_read_RNA_assay[rownames(non_batch_variation_removal_S), # altExp(input_read_RNA_assay) = SingleCellExperiment(assay = list(SCT = non_batch_variation_removal_S)) - assay(input_read_RNA_assay, "SCT") <- non_batch_variation_removal_S } } - - input_read_RNA_assay <- input_read_RNA_assay |> - - # Filter dead cells - left_join( - alive_identification_tbl |> - select(.cell, any_of(c("alive", "subsets_Mito_percent", "subsets_Ribo_percent", "high_mitochondrion", "high_ribosome"))), - by = ".cell" - ) |> - filter(alive) |> - - # Filter doublets + # Filtering dead + if(alive_identification_tbl |> is.null() |> not()) + input_read_RNA_assay = input_read_RNA_assay |> + left_join(alive_identification_tbl |> select(.cell, alive), by = ".cell") |> + filter(alive) + + + + # Filter doublets + if(doublet_identification_tbl |> is.null() |> not()) + input_read_RNA_assay <- input_read_RNA_assay |> left_join(doublet_identification_tbl |> select(.cell, scDblFinder.class), by = ".cell") |> - filter(scDblFinder.class=="singlet") + filter(scDblFinder.class!="doublet") - # Add cell cycle + # attach cell cycle if(cell_cycle_score_tbl |> is.null() |> not()) - input_read_RNA_assay <- input_read_RNA_assay |> - left_join( - cell_cycle_score_tbl, + input_read_RNA_assay = + input_read_RNA_assay |> + left_join( + cell_cycle_score_tbl , by=".cell" - ) + ) # Attach annotation - if (inherits(annotation_label_transfer_tbl, "tbl_df")){ - input_read_RNA_assay <- input_read_RNA_assay |> - left_join(annotation_label_transfer_tbl, by = ".cell") - } + try({ + if (inherits(annotation_label_transfer_tbl, "tbl_df") && nrow(annotation_label_transfer_tbl) > 0){ + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(annotation_label_transfer_tbl, by = ".cell") |> + left_join(cell_type_ensembl_harmonised_tbl) + + # Replace NA annotation column with "other", as annotations are single-cell level, not related to pseudobulk + annotation_columns <- c("blueprint_first.labels.fine", "blueprint_first.labels.coarse", + "monaco_first.labels.fine", "monaco_first.labels.coarse", + "blueprint_first_labels_fine", "monaco_first_labels_fine", + "azimuth_predicted_celltype_l2", "azimuth", "blueprint", "monaco") + + cell_type_concensus_columns <- c("cell_type_unified_ensemble", "data_driven_ensemble") + + input_read_RNA_assay <- input_read_RNA_assay |> mutate(across(all_of(annotation_columns), + ~tidyr::replace_na(., "Other"))) |> + + mutate(across(all_of(cell_type_concensus_columns), as.character)) |> + + # Replace NA with Unknown because non-immune cells are regarded as "Other" in cell_type_unified_ensemble + mutate(across(all_of(cell_type_concensus_columns), + ~tidyr::replace_na(., "Unknown"))) + } + }, silent = TRUE) + - input_read_RNA_assay # # Filter Red blood cells and platelets # if (tolower(tissue) == "pbmc" & "predicted.celltype.l2" %in% c(rownames(annotation_label_transfer_tbl), colnames(annotation_label_transfer_tbl))) { @@ -924,6 +1780,7 @@ preprocessing_output <- function(input_read_RNA_assay, #' @param x A grouping variable used to aggregate cells into pseudobulk samples. #' This variable should be present in the `preprocessing_output_S` object and #' typically represents a factor such as sample ID or condition. +#' @param container_type A character vector specifying the output file type. Ideally it should match to the input file type. #' @param ... Additional arguments passed to internal functions used within #' `create_pseudobulk`. This includes parameters for customization of #' aggregation, data transformation, or any other process involved in the @@ -946,22 +1803,24 @@ preprocessing_output <- function(input_read_RNA_assay, #' @importFrom S4Vectors cbind #' @importFrom purrr map #' @importFrom scater isOutlier -#' @importFrom SummarizedExperiment rowData +#' @importFrom SummarizedExperiment rowData colData rowData<- colData<- #' @importFrom digest digest #' @importFrom HDF5Array saveHDF5SummarizedExperiment +#' @importFrom SingleCellExperiment SingleCellExperiment #' #' @export - # Create pseudobulk for each sample create_pseudobulk <- function(input_read_RNA_assay, sample_names_vec, - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl , + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, + annotation_label_transfer_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + doublet_identification_tbl = NULL, x = c() , - external_path, assays = NULL) { + external_path, assays = NULL, + container_type) { #Fix GChecks .sample = NULL .feature = NULL @@ -970,17 +1829,22 @@ create_pseudobulk <- function(input_read_RNA_assay, dir.create(external_path, showWarnings = FALSE, recursive = TRUE) + if (input_read_RNA_assay |> is.null()) return(NULL) + preprocessing_output_S = preprocessing_output( - input_read_RNA_assay, - empty_droplets_tbl, - non_batch_variation_removal_S = NULL, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl - ) - + input_read_RNA_assay, + empty_droplets_tbl, + non_batch_variation_removal_S = NULL, + alive_identification_tbl, + cell_cycle_score_tbl = NULL, + cell_type_ensembl_harmonised_tbl, + annotation_label_transfer_tbl, + doublet_identification_tbl + ) + + # In rare cases, empty droplets observed across cells in a sample + if (ncol(preprocessing_output_S) == 0) return(NULL) if(assays |> is.null()){ if(preprocessing_output_S |> is("Seurat")) @@ -989,7 +1853,7 @@ create_pseudobulk <- function(input_read_RNA_assay, assays = preprocessing_output_S@assays |> names() } - + # Aggregate cells pseudobulk = preprocessing_output_S |> @@ -998,38 +1862,53 @@ create_pseudobulk <- function(input_read_RNA_assay, mutate(sample_hpc = sample_names_vec) |> # Aggregate - aggregate_cells(c(sample_hpc, any_of(x)), slot = "data", assays = assays) + #aggregate_cells(c(sample_hpc, any_of(x)), slot = "data", assays = assays) + tidySingleCellExperiment::aggregate_cells(c(sample_hpc, !!sym(x)), slot = "data", assays = assays) # If I start from Seurat if(pseudobulk |> is("data.frame")) pseudobulk = pseudobulk |> - as_SummarizedExperiment(.sample, .feature, any_of(assays)) + tidybulk::as_SummarizedExperiment(.sample, .feature, any_of(assays)) rowData(pseudobulk)$feature_name = rownames(pseudobulk) + colData(pseudobulk)$pseudobulk_sample = colnames(pseudobulk) - pseudobulk |> + pseudobulk = pseudobulk |> pivot_longer(cols = assays, names_to = "data_source", values_to = "count") |> filter(!count |> is.na()) |> # Some manipulation to get unique feature because RNA and ADT # both can have same name genes - rename(symbol = .feature) |> + dplyr::rename(symbol = .feature) |> mutate(data_source = stringr::str_remove(data_source, "abundance_")) |> - unite(".feature", c(symbol, data_source), remove = FALSE) |> + tidyr::unite(".feature", c(symbol, data_source), remove = FALSE) |> - # Covert - as_SummarizedExperiment( + tidybulk::as_SummarizedExperiment( .sample = .sample, .transcript = .feature, .abundance = count ) - file_name = glue("{external_path}/{digest(pseudobulk)}") + # Covert pseudobulk to SCE representation as zellkonverter::writeH5AD + # does not support saving a SummarizedExperiment + if (container_type == "anndata") { + pseudobulk = SingleCellExperiment( + assays = assays(pseudobulk), + rowData = rowData(pseudobulk), + colData = colData(pseudobulk) + ) + } + + file_name = glue::glue("{external_path}/{digest(pseudobulk)}") + # Maybe do not need to save Anndata externally for cellNexus because pseudobulk can be read by tar_read_raw pseudobulk |> - # Conver to H5 - saveHDF5SummarizedExperiment(dir = file_name, replace=TRUE, as.sparse=TRUE) + # Convert to Anndata + save_experiment_data( + dir = file_name, + container_type = container_type + ) } @@ -1052,8 +1931,6 @@ create_pseudobulk <- function(input_read_RNA_assay, #' @importFrom SummarizedExperiment rowData #' @importFrom SummarizedExperiment rowData<- #' -#' -#' #' @export #' pseudobulk_merge <- function(pseudobulk_list, external_path, ...) { @@ -1063,8 +1940,9 @@ pseudobulk_merge <- function(pseudobulk_list, external_path, ...) { # Fix GCHECKS . = NULL - + # Select only common columns + # investiagte common_columns, as data_source is not a common column in the pilot data common_columns = pseudobulk_list |> purrr::map(~ .x |> as_tibble() |> colnames()) |> @@ -1086,13 +1964,12 @@ pseudobulk_merge <- function(pseudobulk_list, external_path, ...) { # Add missing genes purrr::map(~{ - missing_genes = all_genes |> setdiff(rownames(.x)) if(missing_genes |> length() == 0) return(.x) else .x |> add_missingh_genes_to_se(all_genes, missing_genes) - + }) |> purrr::map(~ .x |> dplyr::select(any_of(common_columns))) %>% @@ -1101,10 +1978,10 @@ pseudobulk_merge <- function(pseudobulk_list, external_path, ...) { file_name = glue("{external_path}/{digest(se)}") - + se = se |> - + saveHDF5SummarizedExperiment(dir = file_name, replace=TRUE, as.sparse=TRUE) # Return the pseudobulk data for this single sample @@ -1181,6 +2058,179 @@ map_add_dispersion_to_se = function(se_df, .col, abundance = NULL){ } +#' Perform Human Cell-Cell Communication Analysis +#' @description This function performs cells communication analysis. +#' It processes single-cell RNA sequencing data to identify and analyze intercellular communication networks. +#' @param input_read_RNA_assay A SingleCellExperiment or Seurat object containing gene expression data +#' @param empty_droplets_tbl Optional tibble identifying empty droplets to be filtered out +#' @param alive_identification_tbl Optional tibble identifying dead cells to be filtered out +#' @param doublet_identification_tbl Optional A tibble from doublet identification. +#' @param cell_type_tbl Optional A tibble containing cell, cell type, and sample_id information +#' @param assay Character string specifying which assay to use +#' @param cell_type_column Character string specifying the column name containing cell type annotations +#' @param feature_nomenclature Character vector specifying gene in Symbol or Ensemble format +#' @param reference_db The ligand-receptor interaction database curated in CellChat tool. Choose between human or mouse. +#' @param ... Additional arguments passed to \code{CellChat::subsetDB} +#' @return A CellChat tibble containing the inferred communication at the level of +#' ligands/receptors +#' @importFrom CellChat createCellChat subsetDB subsetData identifyOverExpressedGenes +#' identifyOverExpressedInteractions computeCommunProb filterCommunication subsetCommunication +#' normalizeData smoothData aggregateNet setIdent +#' @importFrom tibble as_tibble +#' @importFrom dplyr filter mutate +#' @export +cell_communication <- function(input_read_RNA_assay, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + doublet_identification_tbl = NULL, + cell_type_tbl = NULL, + assay = NULL, + cell_type_column = NULL, + feature_nomenclature, + reference_db = "human", + ...){ + + # Input should not be NULL + if (is.null(input_read_RNA_assay)) return(NULL) + + # Get assay + if(is.null(assay)) my_assay = input_read_RNA_assay@assays |> names() |> magrittr::extract2(1) + + # Identify cell type column + if( + is.null(cell_type_column) && + !cell_type_column %in% colnames(as_tibble(input_read_RNA_assay[1,1])) + ) stop("HPCell says: Your `cell_type_column` columns are not present in your data. Please run celltype_consensus_constructor() to get the cell type annotation that you can use as grouping.") + + # Avoid small number of cells + if (!is.null(empty_droplets_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(empty_droplets_tbl, by = ".cell") |> + dplyr::filter(!empty_droplet) + } + + # Avoid dead cells + if (!is.null(alive_identification_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(alive_identification_tbl |> select(.cell, alive), by = ".cell") |> + dplyr::filter(alive) + } + + # Avoid doublet + if (!is.null(doublet_identification_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(doublet_identification_tbl |> select(.cell, scDblFinder.class), by = ".cell") |> + filter(scDblFinder.class!="doublet") + } + + # Append cell type + if (!is.null(cell_type_tbl) && + cell_type_column %in% colnames(cell_type_tbl)) { + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(cell_type_tbl) |> + select(everything(), !!cell_type_column) |> + filter(!is.na(.data[[cell_type_column]])) + } else if (!is.null(cell_type_tbl) && !cell_type_column %in% colnames(cell_type_tbl)) + stop ("HPCell says: Your `cell_type_column` does not present in `cell_type_tbl` data") + + # Note: CellChat only takes gene symbols as input, thus conversion step is required for ensemble IDs + if (feature_nomenclature == "ensembl") { + + gene_map = rownames(input_read_RNA_assay) |> convert_gene_names(current_nomenclature = feature_nomenclature) |> + filter(!is.na(gene_name)) + + input_read_RNA_assay = input_read_RNA_assay[gene_map$gene_id, ] + rownames(input_read_RNA_assay) = gene_map$gene_name + } + + if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + counts = input_read_RNA_assay |> assay(my_assay) + meta = input_read_RNA_assay |> colData() |> as.data.frame() + } else if (inherits(input_read_RNA_assay, "Seurat")){ + counts = GetAssayData(input_read_RNA_assay, assay = my_assay) + meta = input_read_RNA_assay[[]] + } + + if (meta |> nrow() == 0) return(NULL) + + # CellChat identifyOverExpressedGenes() would only support at least 2 groups + if (meta |> distinct(.data[[cell_type_column]]) |> pull() |> length() <= 1) return(NULL) + + # Choose cellchat reference + DB <- switch(reference_db, human = CellChat::CellChatDB.human, mouse = CellChat::CellChatDB.mouse) + projectionDB <- switch(reference_db, human = CellChat::PPI.human, mouse = CellChat::PPI.mouse) + + CellChatDB <- DB + + CellChatDB.use <- subsetDB(CellChatDB, search =c("Secreted Signaling","ECM-Receptor","Cell-Cell Contact"), key = c("annotation")) + + # CellChat Only Takes log-Normalized data + cellchat = counts |> + as("dgCMatrix") |> + normalizeData(do.log = TRUE) |> + createCellChat(group.by = cell_type_column, meta = meta, assay = my_assay) + + cellchat@DB <- CellChatDB.use + + # Preprocessing + cellchat = cellchat |> + subsetData() |> + identifyOverExpressedGenes() |> + identifyOverExpressedInteractions() |> + smoothData(adj = projectionDB) + + # Return NULL when none of LR pairs are found + if (nrow(cellchat@LR$LRsig) == 0) return(NULL) + + cellchat = cellchat |> + + # Use projected data + computeCommunProb(raw.use = FALSE) |> + + # Filter the number of cells in each group are less than 10 + filterCommunication(min.cells = 10) |> + computeCommunProbPathway() |> + aggregateNet() + + gc() + + # Extract the inferred cellular communication network as a data frame + # By default, slot.name = "net" extracts the inferred communication at the level of ligands/receptors + # Set slot.name = "netP" to access the the inferred communications at the level of signaling pathways + # If all arguments are NULL, it returns a data frame consisting of all the inferred cell-cell communications + lr_tbl <- tryCatch( + subsetCommunication(cellchat, slot.name = "net", thresh = NULL) |> + dplyr::rename(lr_prob = prob, + lr_pval = pval), + error = function(e) { + message("Error in subsetCommunication(): ", e$message) + return(NULL) + } + ) + + pathway_tbl <- tryCatch( + subsetCommunication(cellchat, slot.name = "netP", thresh = NULL) |> + dplyr::rename(pathway_prob = prob, + pathway_pval = pval), + error = function(e) { + message("Error in subsetCommunication(): ", e$message) + return(NULL) + } + ) + + if (nrow(lr_tbl) == 0 || is.null(lr_tbl)) return(NULL) + + cell_interaction_count = cellchat@net$count |> as_tibble(rownames = "source") |> + pivot_longer(-source, names_to = "target", values_to = "interaction_count") + + cell_interaction_weight = cellchat@net$weight |> as_tibble(rownames = "source") |> + pivot_longer(-source, names_to = "target", values_to = "interaction_weight") + + result = lr_tbl |> left_join(pathway_tbl, by = c("source", "target", "pathway_name")) |> + mutate(sample_id = unique(cellchat@meta$sample_id)) |> + left_join(cell_interaction_count) |> left_join(cell_interaction_weight) |> + as_tibble() +} #' Test Differential Abundance in SummarizedExperiment Object #' @@ -1198,6 +2248,8 @@ map_add_dispersion_to_se = function(se_df, .col, abundance = NULL){ #' @return Data frame with test results. #' #' @importFrom rlang enquo +#' @importFrom tidybulk test_differential_abundance +#' #' @import dplyr #' @export map_test_differential_abundance = function( @@ -1217,7 +2269,7 @@ map_test_differential_abundance = function( if(ncol(.x) > 2000) method = "glmmseq_glmmTMB" else method = "glmmSeq_lme4" - + # Test test_differential_abundance( .x, @@ -1229,7 +2281,7 @@ map_test_differential_abundance = function( .dispersion = dispersion, ... ) - }, + }, ... )) @@ -1405,129 +2457,14 @@ find_variable_genes <- function(input_seurat, empty_droplet){ return(my_variable_genes) } -#' Harmonize cell type annotations based on consensus -#' -#' This function harmonizes cell type annotations by matching them with a reference annotation -#' and applying specific rules for non-immune cell types. -#' -#' @param single_cell_data A data frame containing single-cell data with cell type annotations. -#' @param .sample_column The column name specifying sample information. -#' @param .cell_type The column name for the cell type annotations. -#' @param .azimuth The column name for Azimuth annotations. -#' @param .blueprint The column name for Blueprint annotations. -#' @param .monaco The column name for Monaco annotations. -#' -#' @return A data frame with harmonized cell type annotations. -#' -#' -#' @importFrom dplyr across -#' @importFrom readr read_csv -#' @importFrom dplyr bind_rows -#' @importFrom dplyr join_by -#' @importFrom data.table := -#' -#' + #' @export -annotation_consensus = function(single_cell_data, .sample_column, .cell_type, .azimuth, .blueprint, .monaco){ - # Fix GITCHECK notes - .sample = NULL - cell_type = NULL - cell_annotation_azimuth_l2 = NULL - cell_annotation_blueprint_singler = NULL - cell_annotation_monaco_singler = NULL - .cell = NULL - cell_type_harmonised = NULL - confidence_class = NULL - - - # Fix GCHECK notes - .cell = NULL - cell_type_harmonised = NULL - confidence_class = NULL - cell_annotation_azimuth_l2 = NULL - cell_annotation_blueprint_singler = NULL - cell_annotation_monaco_singler = NULL - cell_type = NULL - .sample = NULL - .sample_column = enquo(.sample_column) - .azimuth = enquo(.azimuth) - .blueprint = enquo(.blueprint) - .monaco = enquo(.monaco) - .cell_type = enquo(.cell_type) - - # reference_annotation = - # CuratedAtlasQueryR::get_metadata() |> - # filter(cell_type_harmonised!="immune_unclassified" | is.na(cell_type_harmonised)) |> - # select(cell_type, - # cell_type_harmonised, - # cell_annotation_azimuth_l2, - # cell_annotation_blueprint_singler, - # cell_annotation_monaco_singler, - # confidence_class - # ) |> - # as_tibble() |> - # mutate(cell_type_clean = cell_type |> clean_cell_types()) |> - # HPCell::clean_cell_types_deeper() |> - # select(-cell_type) |> - # - # count(cell_type_harmonised, cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler, confidence_class, cell_type_clean) |> - # with_groups(c(cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler, cell_type_clean), ~ .x |> arrange(desc(n)) |> slice(1) ) - # - # reference_annotation |> saveRDS("reference_annotation_16_jan_2024.rds") - - reference_annotation = readRDS("reference_annotation_16_jan_2024.rds") - - annotation= - single_cell_data |> - rename( - .sample := !!.sample_column, - cell_type := !!.cell_type, - cell_annotation_azimuth_l2 := !!.azimuth, - cell_annotation_blueprint_singler := !!.blueprint, - cell_annotation_monaco_singler := !!.monaco - ) |> - select(.cell, .sample, cell_type, cell_annotation_azimuth_l2,cell_annotation_blueprint_singler, cell_annotation_monaco_singler) |> - mutate(across(c(cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler), tolower )) |> - mutate(across(c(cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler), clean_cell_types )) |> - - is_strong_evidence(cell_annotation_azimuth_l2, cell_annotation_blueprint_singler) |> - - # Clean cell types - mutate(cell_type_clean = cell_type |> clean_cell_types()) |> - left_join(read_csv("~/PostDoc/CuratedAtlasQueryR/dev/metadata_cell_type.csv"), by = "cell_type") |> - clean_cell_types_deeper() |> - - # Reference annotation link - left_join(reference_annotation ) +is_target = function(x) { - annotation_connie_non_immune = - annotation |> - filter(cell_type_harmonised |> is.na()) |> - - harmonise_names_non_immune() |> - - # Fix some gaps in the original code - mutate(cell_type_harmonised = case_when( - cell_type |> tolower() |> str_detect("endothelial") ~ "endothelial_cell", - cell_type |> tolower() |> str_detect("enodothelial") ~ "endothelial_cell", - cell_type |> tolower() |> str_detect("epithelial") ~ "epithelial_cell", - cell_type |> tolower() |> str_detect("fibroblast") ~ "fibroblast", - TRUE ~ cell_type - )) |> - - mutate(confidence_class = 1) + if(x |> is.null()) return(NULL) - single_cell_data |> - left_join( - annotation |> - filter(!cell_type_harmonised |> is.na()) |> - bind_rows(annotation_connie_non_immune) |> - select(.cell, .sample, cell_type_harmonised, confidence_class), - by = join_by(.cell, !!.sample_column == .sample) - ) + if(x |> is("character") |> not()) + stop("HPCell says: the input to `is_target` must be a character") -} - - -#' @export -is_target = function(x) as.name(x) + as.name(x) +} diff --git a/R/functions_consensus.R b/R/functions_consensus.R new file mode 100644 index 00000000..7928e4b5 --- /dev/null +++ b/R/functions_consensus.R @@ -0,0 +1,134 @@ +ensemble_annotation <- function(celltype_matrix, method_weights = NULL, override_celltype = c(), celltype_tree = NULL) { + if (is.null(celltype_tree)) { + celltype_tree <- get("immune_graph") + } + + stopifnot(is(celltype_tree, "igraph")) + stopifnot(igraph::is_directed(celltype_tree)) + stopifnot(is.matrix(celltype_matrix) | is.data.frame(celltype_matrix)) + + node_names = igraph::V(celltype_tree)$name + + # check override_celltype nodes are present + missing_nodes = setdiff(override_celltype, node_names) + if (!is.null(missing_nodes) & length(missing_nodes) > 0) { + missing_nodes = paste(missing_nodes, collapse = ", ") + stop(sprintf("the following nodes in 'override_celltype' not found in 'celltype_tree': %s", utils::capture.output(utils::str(missing_nodes)))) + } + + # check celltype_matrix + if (ncol(celltype_matrix) == 1) { + # no ensemble required + return(celltype_matrix) + } else { + celltype_matrix = as.matrix(celltype_matrix) + invalid_types = setdiff(celltype_matrix, c(node_names, NA)) + if (length(invalid_types) > 0) { + warning(sprintf("the following cell types in 'celltype_matrix' are not in the graph and will be set to NA:\n"), utils::capture.output(utils::str(invalid_types))) + } + celltype_matrix[celltype_matrix %in% invalid_types] = NA + } + + # check method_weights + if (is.null(method_weights)) { + method_weights = matrix(1, ncol = ncol(celltype_matrix), nrow = nrow(celltype_matrix)) + } else if (is.vector(method_weights)) { + if (ncol(celltype_matrix) != length(method_weights)) { + stop("the number of columns in 'celltype_matrix' should match the length of 'method_weights'") + } + method_weights = matrix(rep(method_weights, each = nrow(celltype_matrix)), nrow = nrow(celltype_matrix)) + } else if (is.matrix(method_weights) | is.data.frame(method_weights)) { + if (ncol(celltype_matrix) != ncol(method_weights)) { + stop("the number of columns in 'celltype_matrix' and 'method_weights' should be equal") + } + method_weights = as.matrix(method_weights) + } + method_weights = method_weights / rowSums(method_weights) + + # create vote matrix + vote_matrix = Matrix::sparseMatrix(i = integer(0), j = integer(0), dims = c(nrow(celltype_matrix), length(node_names)), dimnames = list(rownames(celltype_matrix), node_names)) + for (i in seq_len(ncol(celltype_matrix))) { + locmat = cbind(seq_len(nrow(celltype_matrix)), as.numeric(factor(celltype_matrix[, i], levels = node_names))) + missing = is.na(locmat[, 2]) + vote_matrix[locmat[!missing, ]] = vote_matrix[locmat[!missing, ]] + method_weights[!missing, i] + } + + # propagate vote to children + d = apply(!is.infinite(igraph::distances(celltype_tree, mode = "out")), 2, as.numeric) + d = as(d, "sparseMatrix") + vote_matrix_children = Matrix::tcrossprod(vote_matrix, Matrix::t(d)) + + # propagate vote to parent + d = igraph::distances(celltype_tree, mode = "in") + d = 1 / (2^d) - 0.1 # vote halved at each subsequent ancestor + diag(d)[igraph::degree(celltype_tree, mode = "in") > 0 & igraph::degree(celltype_tree, mode = "out") == 0] = 0 + diag(d) = diag(d) * 0.9 # prevent leaf nodes from being selected when trying to identify upstream ancestor (works for any number in the interval (0.5, 1)) + vote_matrix_parent = Matrix::tcrossprod(vote_matrix, Matrix::t(d)) + + # assess votes and identify common ancestors for ties + vote_matrix_children = apply(vote_matrix_children, 1, \(x) x[x > 0], simplify = FALSE) + vote_matrix_parent = apply(vote_matrix_parent, 1, \(x) x[x > 0], simplify = FALSE) + ensemble = mapply(\(children, parents) { + # override condition + override_node = intersect(override_celltype, names(children)) + if (length(override_node) > 0) { + return(override_node[1]) + } + + # maximum votes + children = names(children)[children == max(children)] + if (length(children) == 1) { + return(children) + } else { + # lowest ancestor with the maximum votes + parents = names(parents)[parents == max(parents)] + if (length(parents) == 1) { + return(parents) + } else { + return(NA) + } + } + }, vote_matrix_children, vote_matrix_parent) + + return(ensemble) +} + +add_celltype_level <- function(.data, id_col, level = 0, celltype_tree = NULL) { + if (is.null(celltype_tree)) { + .data_internal(immune_graph) + } + stopifnot(is(celltype_tree, "igraph")) + stopifnot(igraph::is_directed(celltype_tree)) + + ig_diameter = igraph::diameter(celltype_tree) + if (level > ig_diameter) { + stop(sprintf("The specified level (%d) exceeds the depth of the celltype tree (%d)", level, ig_diameter)) + } + + # check column exists + id_col_str = rlang::as_string(rlang::ensym(id_col)) + if (!id_col_str %in% colnames(.data)) { + stop(sprintf("Column '%s' not found in .data", rlang::as_string(rlang::ensym(id_col)))) + } + + # generate map + ct_map = igraph::ego(celltype_tree, mode = "in", order = ig_diameter) |> + sapply(\(x) { + x = rev(x$name) + x[min(length(x), level + 1)] + }) |> + setNames(igraph::V(celltype_tree)$name) + + # retain types of the matching level only + d = igraph::distances(celltype_tree, mode = "in") + d[is.infinite(d)] = NA + ct_level = apply(d, 1, max, na.rm = TRUE) + is_child = igraph::degree(celltype_tree, mode = "out") == 0 + ct_map[ct_level[ct_map] != level & !is_child] = NA_character_ + map_df = data.frame(ctypes, ct_map[ctypes]) + colnames(map_df) = c(id_col_str, sprintf("%s_L%d", id_col_str, level)) + + # join and return + .data |> + dplyr::left_join(map_df, copy = TRUE) +} diff --git a/R/modules_grammar_hpc.R b/R/modules_grammar_hpc.R index 66dc86ee..80fbe73e 100644 --- a/R/modules_grammar_hpc.R +++ b/R/modules_grammar_hpc.R @@ -46,7 +46,13 @@ initialise_hpc <- function(input_hpc, debug_step = NULL, RNA_assay_name = "RNA", gene_nomenclature = "symbol", - data_container_type) { + data_container_type, + verbosity = targets::tar_config_get("reporter_make"), + error = NULL, + update = "thorough", + garbage_collection = 0, + workspace_on_error = FALSE + ) { # Capture all arguments including defaults args_list <- as.list(environment()) @@ -55,9 +61,7 @@ initialise_hpc <- function(input_hpc, if(input_hpc |> names() |> is.null()) input_hpc = input_hpc |> set_names(seq_len(length(input_hpc))) - input_hpc |> names() |> saveRDS("sample_names.rds") - #cell_count |> saveRDS("cell_count.rds") - + # Optionally, you can evaluate the arguments if they are expressions args_list <- lapply(args_list, eval, envir = parent.frame()) @@ -65,15 +69,16 @@ initialise_hpc <- function(input_hpc, dir.create(store, showWarnings = FALSE, recursive = TRUE) data_file_names = glue("{store}/{names(input_hpc)}.rds") + # Save parameters to files? input_hpc |> as.list() |> saveRDS("input_file.rds") + input_hpc |> names() |> saveRDS("sample_names.rds") + gene_nomenclature |> saveRDS("temp_gene_nomenclature.rds") data_container_type |> saveRDS("data_container_type.rds") - computing_resources |> saveRDS("temp_computing_resources.rds") + # Get the index of jobs of different priority tiers = tier |> get_positions() - tiers |> - saveRDS("temp_tiers.rds") # Write pipeline to a file { @@ -88,50 +93,72 @@ initialise_hpc <- function(input_hpc, tar_option_set( memory = "transient", - garbage_collection = TRUE, + garbage_collection = g, storage = "worker", retrieval = "worker", - #error = "continue", - format = "qs", + error = e, + # format = "qs", debug = d, # Set the target you want to debug. - # cue = tar_cue(mode = "never") # Force skip non-debugging outdated targets. + cue = tar_cue(mode = u), # Force skip non-debugging outdated targets. controller = crew_controller_group ( readRDS("temp_computing_resources.rds") ), - packages = c("HPCell") + packages = c("HPCell"), + trust_object_timestamps = TRUE, + workspace_on_error = w ) - - target_list = list( - tar_target(gene_nomenclature, readRDS("temp_gene_nomenclature.rds"), iteration = "list", deployment = "main"), - tar_target(data_container_type, readRDS("data_container_type.rds"), deployment = "main") - - ) - + + target_list = list( ) } |> - substitute(env = list(d = debug_step)) |> + substitute(env = list(d = debug_step, e = error, u = update, g = garbage_collection, w = workspace_on_error)) |> tar_script_append2(script = glue("{store}.R"), append = FALSE) input_hpc = list(initialisation = args_list ) |> - c(list(sample_names = list(iterate = "map")) ) |> - + add_class("HPCell") input_hpc |> + # Nomenclature + hpc_single("temp_gene_nomenclature_file", "temp_gene_nomenclature.rds", format = "file") |> + + hpc_single( + target_output = "gene_nomenclature", + user_function = readRDS |> quote(), + file = "temp_gene_nomenclature_file" |> is_target(), + deployment = "main" + ) |> + + # Container class + hpc_single("data_container_type_file", "data_container_type.rds", format = "file") |> + + hpc_single( + target_output = "data_container_type", + user_function = readRDS |> quote(), + file = "data_container_type_file" |> is_target(), + deployment = "main" + ) |> + + # Sample names + hpc_single("sample_names_file", "sample_names.rds", format = "file") |> + hpc_single( target_output = "sample_names", user_function = readRDS |> quote(), - file = "sample_names.rds", + file = "sample_names_file" |> is_target(), deployment = "main", iterate = "map" ) |> + # Files + hpc_single("read_file_list_file", "input_file.rds", format = "file") |> + hpc_single( target_output = "read_file_list", user_function = readRDS |> quote(), - file = "input_file.rds", + file = "read_file_list_file" |> is_target(), deployment = "main", iterate = "map" ) |> @@ -148,7 +175,6 @@ initialise_hpc <- function(input_hpc, - # Define the generic function #' @export remove_empty_DropletUtils <- function(input_hpc, total_RNA_count_check = NULL, target_input = "data_object", target_output = "empty_tbl", ...) { @@ -177,13 +203,59 @@ remove_empty_DropletUtils.HPCell = function(input_hpc, total_RNA_count_check = N target_output = target_output, user_function = empty_droplet_id |> quote() , input_read_RNA_assay = target_input |> is_target(), - total_RNA_count_check = total_RNA_count_check + total_RNA_count_check = total_RNA_count_check, + feature_nomenclature = "gene_nomenclature" |> is_target() ) } -target_chunk_undefined_remove_empty_DropletUtils = function(input_hpc){ +#' @export +remove_empty_threshold <- function(input_hpc, RNA_feature_threshold = input_hpc$initialisation$input_hpc |> map(~200), target_input = "data_object", target_output = "empty_tbl", ...) { + UseMethod("remove_empty_threshold") +} + +#' @export +remove_empty_threshold.Seurat = function(input_hpc, RNA_feature_threshold = NULL, target_input = "data_object", target_output = "empty_tbl", ...) { + # Capture all arguments including defaults + args_list <- as.list(environment()) + + # Optionally, you can evaluate the arguments if they are expressions + args_list <- lapply(args_list, eval, envir = parent.frame()) + + list(initialisation = list(input_hpc = input_hpc)) |> + add_class("HPCell") |> + remove_empty_threshold() + +} + +#' @export +remove_empty_threshold.HPCell = function(input_hpc, RNA_feature_threshold = input_hpc$initialisation$input_hpc |> map(~200), + target_input = "data_object", target_output = "empty_tbl",...) { + + RNA_feature_threshold |> saveRDS("RNA_feature_thresh.rds") + input_hpc |> + + # Track the file + hpc_single("RNA_feature_thresh_file", "RNA_feature_thresh.rds", format = "file") |> + hpc_iterate( + target_output = "RNA_feature_thresh", + user_function = readRDS |> quote() , + file = "RNA_feature_thresh_file" |> is_target() + ) |> + + hpc_iterate( + target_output = target_output, + user_function = empty_droplet_threshold |> quote() , + input_read_RNA_assay = target_input |> is_target(), + RNA_feature_threshold = "RNA_feature_thresh" |> is_target(), + feature_nomenclature = "gene_nomenclature" |> is_target() + ) + + +} + +target_chunk_undefined_remove_empty_threshold = function(input_hpc){ input_hpc |> hpc_iterate( target_output = "empty_tbl", @@ -191,10 +263,8 @@ target_chunk_undefined_remove_empty_DropletUtils = function(input_hpc){ x = "data_object" |> is_target(), packages = c("dplyr", "tidySingleCellExperiment", "tidyseurat") ) - } - # Define the generic function #' @export remove_dead_scuttle <- function(input_hpc, @@ -223,27 +293,14 @@ remove_dead_scuttle.HPCell = function( user_function = alive_identification |> quote() , input_read_RNA_assay = target_input |> safe_as_name(), empty_droplets_tbl = target_empty_droplets |> safe_as_name() , - annotation_label_transfer_tbl = target_annotation |> safe_as_name() , - annotation_column = group_by - ) - -} - -#' @importFrom dplyr mutate -target_chunk_undefined_remove_dead_scuttle = function(input_hpc){ - - input_hpc |> - hpc_iterate( - target_output = "alive_tbl", - user_function = (function(x) x |> as_tibble() |> select(.cell) |> mutate(alive = TRUE)) |> quote() , - x = "data_object" |> is_target(), - packages = c("dplyr", "tidySingleCellExperiment", "tidyseurat") + cell_type_ensembl_harmonised_tbl = target_annotation |> safe_as_name() , + cell_type_column = group_by, + feature_nomenclature = "gene_nomenclature" |> is_target() ) } - # Define the generic function #' @export score_cell_cycle_seurat <- function(input_hpc, target_input = "data_object", target_output = "cell_cycle_tbl",...) { @@ -259,98 +316,66 @@ score_cell_cycle_seurat.HPCell = function(input_hpc, target_input = "data_object user_function = cell_cycle_scoring |> quote() , input_read_RNA_assay = target_input |> is_target(), empty_droplets_tbl = "empty_tbl" |> is_target() , - gene_nomenclature = input_hpc$initialisation$gene_nomenclature - ) - -} - -target_chunk_undefined_score_cell_cycle_seurat = function(input_hpc, target_input = "data_object"){ - - input_hpc |> - hpc_iterate( - target_output = "cell_cycle_tbl", - user_function = function(x) NULL , - x = "read_file_list" |> is_target() + feature_nomenclature = "gene_nomenclature" |> is_target() ) } - # Define the generic function #' @export -remove_doublets_scDblFinder <- function(input_hpc, target_input = "data_object", target_output = "doublet_tbl") { +remove_doublets_scDblFinder <- function( + input_hpc, target_input = "data_object", target_output = "doublet_tbl", + target_empry_droplets = "empty_tbl" + # , target_annotation = "annotation_tbl", reference_label_group_by = "monaco_first.labels.fine" + ) { UseMethod("remove_doublets_scDblFinder") } #' @export -remove_doublets_scDblFinder.HPCell = function(input_hpc, target_input = "data_object", target_output = "doublet_tbl") { - - input_hpc |> - hpc_iterate( - target_output = target_output, - user_function = doublet_identification |> quote() , - input_read_RNA_assay = target_input |> is_target(), - empty_droplets_tbl = "empty_tbl" |> is_target() , - alive_identification_tbl = "alive_tbl" |> is_target() - ) - -} +remove_doublets_scDblFinder.HPCell = function( + input_hpc, target_input = "data_object", target_output = "doublet_tbl", + target_empry_droplets = "empty_tbl" + # , target_annotation = "annotation_tbl", + # reference_label_group_by = "monaco_first.labels.fine" + ) { -target_chunk_undefined_remove_doublets_scDblFinder = function(input_hpc){ - - input_hpc |> + input_hpc |> hpc_iterate( - target_output = "doublet_tbl", - user_function = (function(x) x |> as_tibble() |> select(.cell) |> mutate(scDblFinder.class="singlet")) |> quote() , - x = "data_object" |> is_target(), - packages = c("dplyr", "tidySingleCellExperiment", "tidyseurat") + target_output = target_output, + user_function = doublet_identification |> quote() , + input_read_RNA_assay = target_input |> is_target(), + empty_droplets_tbl = target_empry_droplets |> is_target() , + # annotation_label_transfer_tbl = target_annotation |> is_target(), + # reference_label_fine = reference_label_group_by ) - + } # Define the generic function #' @export -annotate_cell_type <- function(input_hpc, azimuth_reference = NULL, target_input = "data_object", target_output = "annotation_tbl",...) { +annotate_cell_type <- function(input_hpc, azimuth_reference = NULL, target_input = "data_object", + target_output = "annotation_tbl", target_empty_droplets = "empty_tbl", ...) { UseMethod("annotate_cell_type") } #' @export -annotate_cell_type.HPCell = function(input_hpc, azimuth_reference = NULL, target_input = "data_object", target_output = "annotation_tbl", ...) { - - - azimuth_reference |> saveRDS("input_reference.rds") +annotate_cell_type.HPCell = function(input_hpc, azimuth_reference = NULL, target_input = "data_object", + target_output = "annotation_tbl", target_empty_droplets = "empty_tbl", ...) { + input_hpc |> - - hpc_single( - target_output = "reference_read", - user_function = readRDS |> quote(), - file = "input_reference.rds" - ) |> hpc_iterate( target_output = target_output, user_function = annotation_label_transfer |> quote() , input_read_RNA_assay = target_input |> is_target(), - empty_droplets_tbl = "empty_tbl" |> is_target() , - reference_azimuth = reference_read |> quote() - ) - -} - -target_chunk_undefined_annotate_cell_type = function(input_hpc){ - - input_hpc |> - hpc_iterate( - target_output = "annotation_tbl", - user_function = function(x) NULL , - x = read_file_list |> quote() + empty_droplets_tbl = target_empty_droplets |> safe_as_name() , + reference_azimuth = azimuth_reference, + feature_nomenclature = "gene_nomenclature" |> is_target() ) - } - # Define the generic function #' @export normalise_abundance_seurat_SCT <- function(input_hpc, target_input = "data_object", target_output = "sct_matrix", ...) { @@ -373,33 +398,59 @@ normalise_abundance_seurat_SCT.HPCell = function(input_hpc, factors_to_regress = ... ) - } -target_chunk_undefined_normalise_abundance_seurat_SCT = function(input_hpc){ +# Define the generic function +#' @export +cluster_metacell <- function(input_hpc, target_input = "data_object", + target_celltype_ensembl = "cell_type_concensus_tbl", + target_output = "metacell_tbl", target_empry_droplets = "empty_tbl", + target_alive = "alive_tbl", target_doublet = "doublet_tbl", + group_by = NULL, + cell_per_metacell = 30, + ...) { + UseMethod("cluster_metacell") +} + +#' @export +cluster_metacell.HPCell = function(input_hpc, target_input = "data_object", + target_celltype_ensembl = "cell_type_concensus_tbl", + target_output = "metacell_tbl", target_empry_droplets = "empty_tbl", + target_alive = "alive_tbl", target_doublet = "doublet_tbl", + group_by = NULL, + cell_per_metacell = 30, + ...) { input_hpc |> hpc_iterate( - target_output = "sct_matrix", - user_function = function(x) NULL , - x = read_file_list |> quote() + target_output = target_output, + user_function = split_sample_cell_type_calculate_metacell_membership |> quote() , + sample_sce = target_input |> is_target(), + cell_type_tbl = target_celltype_ensembl |> is_target(), + empty_droplets_tbl = target_empry_droplets |> is_target(), + alive_identification_tbl = target_alive |> is_target(), + doublet_identification_tbl = target_doublet |> is_target(), + x = group_by, + min_cells_per_metacell = cell_per_metacell, + ... ) - - } # Define the generic function #' @export -calculate_pseudobulk <- function(input_hpc, group_by = NULL, target_input = "data_object", target_output = "pseudobulk_se") { +calculate_pseudobulk <- function(input_hpc, group_by = NULL, target_input = "data_object", + target_celltype_ensembl = "cell_type_concensus_tbl", + target_output = "pseudobulk_se") { UseMethod("calculate_pseudobulk") } #' @export -calculate_pseudobulk.HPCell = function(input_hpc, group_by = NULL, target_input = "data_object", target_output = "pseudobulk_se") { +calculate_pseudobulk.HPCell = function(input_hpc, group_by = NULL, target_input = "data_object", + target_celltype_ensembl = "cell_type_concensus_tbl", + target_output = "pseudobulk_se") { pseudobulk_sample = glue("{target_output}_iterated") |> - # This is important otherwise targets fails with glue as.character() @@ -415,16 +466,18 @@ calculate_pseudobulk.HPCell = function(input_hpc, group_by = NULL, target_input alive_identification_tbl = "alive_tbl" |> is_target(), cell_cycle_score_tbl = "cell_cycle_tbl" |> is_target(), annotation_label_transfer_tbl = "annotation_tbl" |> is_target(), + cell_type_ensembl_harmonised_tbl = target_celltype_ensembl |> is_target(), doublet_identification_tbl = "doublet_tbl" |> is_target(), x = group_by, - external_path = glue("{input_hpc$initialisation$store}/external") - ) |> + external_path = glue("{input_hpc$initialisation$store}/external") |> as.character(), + container_type = "data_container_type" |> is_target() + ) |> # merge hpc_merge( - target_output = target_output, - user_function = pseudobulk_merge |> quote(), - external_path = glue("{input_hpc$initialisation$store}/external"), + target_output = target_output, + user_function = pseudobulk_merge |> quote(), + external_path = glue("{input_hpc$initialisation$store}/external") |> as.character(), pseudobulk_list = pseudobulk_sample |> is_target(), packages = c("tidySummarizedExperiment", "HPCell") ) @@ -432,6 +485,40 @@ calculate_pseudobulk.HPCell = function(input_hpc, group_by = NULL, target_input } +# Define the generic function +#' @export +ligand_receptor_cellchat <- function( + input_hpc, target_input = "data_object", target_output = "ligand_receptor_tbl", + target_empty_droplets = "empty_tbl", target_alive_tbl = "alive_tbl", + target_doublet_tbl = "doublet_tbl", target_cell_type = "cell_type_concensus_tbl", + species_db = "human", group_by = "cell_type", ...) { + UseMethod("ligand_receptor_cellchat") +} + +#' @export +ligand_receptor_cellchat.HPCell = function( + input_hpc, target_input = "data_object", target_output = "ligand_receptor_tbl", + target_empty_droplets = "empty_tbl", target_alive_tbl = "alive_tbl", + target_doublet_tbl = "doublet_tbl", target_cell_type = "cell_type_concensus_tbl", + species_db = "human", group_by = "cell_type", ...) { + + input_hpc |> + hpc_iterate( + target_output = target_output, + user_function = cell_communication |> quote() , + input_read_RNA_assay = target_input |> is_target(), + empty_droplets_tbl = target_empty_droplets |> is_target() , + alive_identification_tbl = target_alive_tbl |> is_target(), + doublet_identification_tbl = target_doublet_tbl |> is_target(), + cell_type_tbl = target_cell_type |> is_target(), + cell_type_column = group_by, + feature_nomenclature = "gene_nomenclature" |> is_target(), + reference_db = species_db, + ... + ) + +} + # Define the generic function #' @export get_single_cell <- function(input_hpc, target_input = "data_object", target_output = "single_cell",...) { @@ -449,7 +536,7 @@ get_single_cell.HPCell = function(input_hpc, target_input = "data_object", targe user_function = preprocessing_output |> quote() , input_read_RNA_assay = target_input |> is_target(), empty_droplets_tbl = "empty_tbl" |> is_target() , - non_batch_variation_removal_S = sct_matrix |> quote(), + non_batch_variation_removal_S = "sct_matrix" |> is_target(), alive_identification_tbl = "alive_tbl" |> is_target(), cell_cycle_score_tbl = "cell_cycle_tbl" |> is_target(), annotation_label_transfer_tbl = "annotation_tbl" |> is_target(), @@ -464,9 +551,8 @@ get_single_cell.HPCell = function(input_hpc, target_input = "data_object", targe #' #' This function tests differential abundance for HPCell objects. #' -#' @name test_differential_abundance,HPCell-method +#' @name test_differential_abundance-HPCell-method #' @rdname test_differential_abundance -#' @inherit tidybulk::test_differential_abundance #' #' @importFrom tidybulk test_differential_abundance #' @exportMethod test_differential_abundance @@ -488,65 +574,120 @@ get_single_cell.HPCell = function(input_hpc, target_input = "data_object", targe #' @param .contrasts Contrasts parameter. #' @return The result of the differential abundance test. #' -setMethod( - "test_differential_abundance", - signature(.data = "HPCell"), - function(.data, .formula, .sample = NULL, .transcript = NULL, - .abundance = NULL, contrasts = NULL, method = "edgeR_quasi_likelihood", - test_above_log2_fold_change = NULL, scaling_method = "TMM", - omit_contrast_in_colnames = FALSE, prefix = "", action = "add", factor_of_interest = NULL, - target_input = "pseudobulk_se", target_output = "de", group_by_column = NULL, - ..., significance_threshold = NULL, fill_missing_values = NULL, - .contrasts = NULL) { - - if(.formula |> deparse() |> str_detect("\\|")) - factory_de_random_effect( - se_list_input = target_input, - output_se = target_output, - formula=.formula, - #method="edger_robust_likelihood_ratio", - tiers = tiers, - factor_of_interest = factor_of_interest, - .abundance = .abundance - ) - - else - - .data |> - - hpc_single( - target_output = "chunk_tbl", - user_function = function(x){ x |> rownames() |> feature_chunks()} |> quote(), - x = "pseudobulk_se" |> is_target() - ) |> - - hpc_single( - target_output = "pseudobulk_group_list", - user_function = group_split |> quote(), - .tbl = target_input |> is_target(), - gr = as.name(gr) |> substitute(env = list(gr = group_by_column)), - packages = c("tidySummarizedExperiment", "S4Vectors", "targets"), - - # I need this because targets does not know the output - # is a list I need to iterate on outside the tiers - iterate = "map" - ) |> - - - hpc_iterate( - target_output = target_output, - user_function = internal_de_function |> quote() , - x = "pseudobulk_group_list" |> is_target(), - fi = factor_of_interest, - a = .abundance, - f = .formula, - m = method, - packages="tidybulk" - ) - - - -}) +# setMethod( +# "test_differential_abundance", +# signature(.data = "HPCell"), +# function(.data, .formula, .sample = NULL, .transcript = NULL, +# .abundance = NULL, contrasts = NULL, method = "edgeR_quasi_likelihood", +# test_above_log2_fold_change = NULL, scaling_method = "TMM", +# omit_contrast_in_colnames = FALSE, prefix = "", action = "add", factor_of_interest = NULL, +# target_input = "pseudobulk_se", target_output = "de", group_by_column = NULL, +# ..., significance_threshold = NULL, fill_missing_values = NULL, +# .contrasts = NULL) { +# +# if(.formula |> deparse() |> str_detect("\\|")) +# factory_de_random_effect( +# se_list_input = target_input, +# output_se = target_output, +# formula=.formula, +# #method="edger_robust_likelihood_ratio", +# tiers = tiers, +# factor_of_interest = factor_of_interest, +# .abundance = .abundance +# ) +# +# else +# +# .data |> +# +# hpc_single( +# target_output = "chunk_tbl", +# user_function = function(x){ x |> rownames() |> feature_chunks()} |> quote(), +# x = "pseudobulk_se" |> is_target() +# ) |> +# +# hpc_single( +# target_output = "pseudobulk_group_list", +# user_function = group_split |> quote(), +# .tbl = target_input |> is_target(), +# gr = as.name(gr) |> substitute(env = list(gr = group_by_column)), +# packages = c("tidySummarizedExperiment", "S4Vectors", "targets"), +# +# # I need this because targets does not know the output +# # is a list I need to iterate on outside the tiers +# iterate = "map" +# ) |> +# +# +# hpc_iterate( +# target_output = target_output, +# user_function = internal_de_function |> quote() , +# x = "pseudobulk_group_list" |> is_target(), +# fi = factor_of_interest, +# a = .abundance, +# formul = .formula, +# m = method, +# packages="tidybulk" +# ) +# +# +# +# }) + + + + # + # factory_collapse( + # "colapsed_preprocessing_output", + # bind_rows(preprocessing_output_S) , + # "preprocessing_output_S", + # tiers + # ), + # + # tar_render( + # name = preprocessing_report, + # path = paste0(system.file(package = "HPCell"), "/rmd/preprocessing_report.Rmd"), + # params = list( + # x1 = collapsed_preprocessing_output, + # x2 = group_by|> quo_name() + # ) + # ) + + +#' generate_report = function(tiers){ +#' +#' list( +#' factory_split( +#' "final_report", +#' command = {read_file |> +#' read_data_container(container_type = data_container_type) |> + # tar_render( + # name = empty_droplets_report, + # path = paste0(system.file(package = "HPCell"), "/rmd/Empty_droplet_report.Rmd"), + # params = list(x1 = empty_droplets_tbl, + # # x2 = empty_droplets_tbl, + # # x3 = annotation_label_transfer_tbl + # # x4 = tar_read(unique_tissues, store = store), + # # x5 = sample_column |> quo_name() + # )) |> +#' quote() +#' }, +#' tiers, +#' arguments_to_tier = "read_file", +#' other_arguments_to_tier = c("empty_droplets_tbl" +#' # "annotation_label_transfer_tbl", +#' # "doublet_identification_tbl"), +#' ), +#' other_arguments_to_map = c("empty_droplets_tbl" +#' # "annotation_label_transfer_tbl", +#' # "doublet_identification_tbl") +#' ) +#' ) +#' +#' ) +#' +#' } + # Define the generic function @@ -560,59 +701,13 @@ evaluate_hpc <- function(input_hpc) { #' @export evaluate_hpc.HPCell = function(input_hpc) { - #-----------------------# - # Empty droplets - #-----------------------# - - if(! "empty_tbl" %in% names(input_hpc)) - target_chunk_undefined_remove_empty_DropletUtils(input_hpc) - - #-----------------------# - # Annotate cell type - #-----------------------# - - if( - !("annotation_tbl" %in% names(input_hpc) | - ( "alive_tbl" %in% names(input_hpc) & !is.null(input_hpc$remove_dead_scuttle$group_by)) - )) - target_chunk_undefined_annotate_cell_type(input_hpc) - - #-----------------------# - # Remove dead - #-----------------------# - - if(! "alive_tbl" %in% names(input_hpc)) - target_chunk_undefined_remove_dead_scuttle(input_hpc) - - - #-----------------------# - # score cell cycle - #-----------------------# - if(! "cell_cycle_tbl" %in% names(input_hpc)) - target_chunk_undefined_score_cell_cycle_seurat(input_hpc) - - #-----------------------# - # Doublets - #-----------------------# - - if(! "doublet_tbl" %in% names(input_hpc)) - target_chunk_undefined_remove_doublets_scDblFinder(input_hpc) - - #-----------------------# - # SCT - #-----------------------# - - if(! "sct_matrix" %in% names(input_hpc)) - target_chunk_undefined_normalise_abundance_seurat_SCT(input_hpc) - - #-----------------------# # Close pipeline #-----------------------# # Call final list tar_script_append({ - target_list + target_list }, script = glue("{input_hpc$initialisation$store}.R")) if(input_hpc$initialisation$debug_step |> is.null()) @@ -622,25 +717,24 @@ evaluate_hpc.HPCell = function(input_hpc) { tar_make( callr_function = my_callr_function, - reporter = "verbose_positives", script = glue("{input_hpc$initialisation$store}.R"), - store = input_hpc$initialisation$store + store = input_hpc$initialisation$store, + reporter = input_hpc$initialisation$verbosity ) - # Example usage: - c( - "input_file.rds", - "temp_computing_resources.rds", - "temp_debug_step.rds", - "sample_names.rds", - "total_RNA_count_check.rds", - "temp_group_by.rds", - "factors_to_regress.rds", - "pseudobulk_group_by.rds", - "temp_tiers.rds", - "temp_gene_nomenclature.rds" - ) |> - remove_files_safely() + # # Example usage: + # c( + # "input_file.rds", + # "temp_computing_resources.rds", + # "temp_debug_step.rds", + # "sample_names.rds", + # "total_RNA_count_check.rds", + # "temp_group_by.rds", + # "factors_to_regress.rds", + # "pseudobulk_group_by.rds", + # "temp_gene_nomenclature.rds" + # ) |> + # remove_files_safely() # If get_single_cell is called then return the object if(input_hpc$last_call |> is.null() |> not()) @@ -667,4 +761,4 @@ print.HPCell <- function(x, ...){ x |> evaluate_hpc() |> print() -} +} \ No newline at end of file diff --git a/R/targets_functions.R b/R/targets_functions.R index 1dc4fe7d..87c498d6 100644 --- a/R/targets_functions.R +++ b/R/targets_functions.R @@ -147,7 +147,7 @@ map2_test_differential_abundance_hpc = function( # Dispersion tar_target( pseudobulk_df_tissue_dispersion, - # pseudobulk_df_tissue |> map_add_dispersion_to_se(data, formula, abundance), + pseudobulk_df_tissue |> map_add_dispersion_to_se(data, formula, abundance), pattern = map(pseudobulk_df_tissue), iteration = "group" ), diff --git a/R/tranform_assay.R b/R/tranform_assay.R index 43982d0d..288508fc 100644 --- a/R/tranform_assay.R +++ b/R/tranform_assay.R @@ -1,41 +1,45 @@ # Define the generic function #' @export -tranform_assay <- function(input_hpc, fx = input_hpc$initialisation$input_hpc |> map(~identity), target_input = "data_object", target_output = "sce_transformed", ...) { - UseMethod("tranform_assay") +transform_assay <- function(input_hpc, fx = input_hpc$initialisation$input_hpc |> map(~identity), target_input = "data_object", target_output = "sce_transformed", ...) { + UseMethod("transform_assay") } #' @importFrom purrr map #' #' @export -tranform_assay.HPCell = function( +transform_assay.HPCell = function( input_hpc, # This might be carrying the environment - fx = input_hpc$initialisation$input_hpc |> map(~identity), + fx = input_hpc$initialisation$input_hpc |> map(~"identity"), target_input = "data_object", target_output = "sce_transformed", ... - ) { +) { fx |> saveRDS("temp_fx.rds") input_hpc |> + # Track the file + hpc_single("transform_file", "temp_fx.rds", format = "file") |> hpc_iterate( target_output = "transform", user_function = readRDS |> quote() , - file = "temp_fx.rds" + file = "transform_file" |> is_target() # , # iteration = "list", # deployment = "main" ) |> - + hpc_iterate( target_output = target_output, user_function = transform_utility |> quote() , - input_read_RNA_assay = as.name(target_input), - transform_fx = transform |> quote() , - external_path = glue("{input_hpc$initialisation$store}/external") + input_read_RNA_assay = "data_object" |> is_target(), + transform_fx = "transform" |> is_target() , + external_path = glue("{input_hpc$initialisation$store}/external") |> as.character(), + container_type = "data_container_type" |> is_target() + ) } @@ -46,31 +50,162 @@ tranform_assay.HPCell = function( #' SummarizedExperiment object and saves the transformed object in HDF5 format. #' #' @param input_read_RNA_assay A SummarizedExperiment object to be transformed. -#' @param transform A function to apply to the assay of the SummarizedExperiment object. +#' @param transform_fx A function to apply to the assay of the SummarizedExperiment object. #' @param external_path A character string specifying the directory path to save the transformed object. -#' +#' @param container_type A character vector specifying the output file type. Ideally it should match to the input file type. #' @return The function does not return an object. It saves the transformed SummarizedExperiment object to the specified path. #' -#' @importFrom SummarizedExperiment assay assay<- +#' @importFrom SummarizedExperiment assay +#' @importFrom SummarizedExperiment assay<- +#' @importFrom SummarizedExperiment assays assays<- +#' @importFrom SummarizedExperiment rowData +#' @importFrom SummarizedExperiment rowData<- +#' @importFrom SingleCellExperiment reducedDim<- +#' @importFrom dplyr select #' @importFrom glue glue -#' @importFrom tools digest -#' @importFrom HDF5Array saveHDF5SummarizedExperiment +#' @importFrom digest digest +#' @importFrom stats density #' #' @export -transform_utility = function(input_read_RNA_assay, transform_fx, external_path) { - #input_read_RNA_assay = input_read_RNA_assay |> read_data_container(container_type = data_container_type) +transform_utility = function(input_read_RNA_assay, transform_fx, external_path, container_type) { + + numer_of_cells_to_sample = 5e3 + + if(ncol(input_read_RNA_assay) == 0) return(NULL) + + # Rename assay names to for consistency + if (length(names(assays(input_read_RNA_assay))) == 1 && + names(assays(input_read_RNA_assay)) != "X") names(assays(input_read_RNA_assay)) <- "X" + + # strip metadata that we don't need + input_read_RNA_assay = + input_read_RNA_assay |> + select(.cell, observation_joinid, observation_originalid, donor_id, dataset_id, sample_id, cell_type) + + # Remove reduced dimensions + reducedDim(input_read_RNA_assay) = NULL + + # Remove row data to avoid downstream binding errors + rowData(input_read_RNA_assay) <- NULL + + # Clear memory + gc() dir.create(external_path, showWarnings = FALSE, recursive = TRUE) - file_name = glue("{external_path}/{digest(input_read_RNA_assay)}") - assay(input_read_RNA_assay) = assay(input_read_RNA_assay) |> transform_fx() + # Convert transform_method to a function if it is a character string + transform_function <- match.fun(transform_fx) + + # Get the name of the first assay in the data object + assay_name <- names(assays(input_read_RNA_assay))[1] + + # Extract the counts matrix from the assay + counts <- assay(input_read_RNA_assay, assay_name) + + # Scale counts to a maximum of 20 to avoid downstream failures. + # This Check needs ~13Gb to run for 5000+ cell datasets + # Check if the transformation method is not 'identity' and counts exceed 20 + if (!identical(transform_function, identity) ) { + if(max(counts) > 20){ + scale_factor <- 20 / max(counts) + counts <- counts * scale_factor + }} + + # Clear memory + gc() + + # Apply the transformation method to counts + counts <- transform_function(counts) + + # This is to avoid memory explosion + set.seed(42) + counts_light_for_checks = counts[,sample(seq_len(ncol(counts)), size = min(numer_of_cells_to_sample, ncol(counts))),drop=FALSE] + + # Compute the density estimate of the counts. This needs ~13Gb to run for 5000+ cell datasets + density_est <- counts_light_for_checks |> as.matrix() |> density() + # Clear memory + gc() + + # Find the mode (peak) value of the counts + mode_value <- density_est$x[which.max(density_est$y)] + + # If the mode value is negative, shift counts to make the mode zero + if (mode_value < 0) { + counts <- counts + abs(mode_value) + counts_light_for_checks = counts_light_for_checks + abs(mode_value) + } + + # Round counts to avoid potential subtraction errors due to floating-point precision + counts <- round(counts, 5) + counts_light_for_checks = round(counts_light_for_checks, 5) + + # Find the most frequent count value (mode) in the counts + majority_gene_counts <- compute_mode_delayedarray(counts_light_for_checks)$mode + + # Subtract the mode value from counts if it is not zero + if (majority_gene_counts != 0) { + counts <- counts - majority_gene_counts + counts_light_for_checks <- counts_light_for_checks - majority_gene_counts + } + + # Replace negative counts with zero to avoid downstream failures + if (min(counts_light_for_checks) < 0) { + counts[counts < 0] <- 0 + } + + # Clear memory + gc() + + # Assign the modified counts back to the data object + assay(input_read_RNA_assay, assay_name) <- counts + + # Remove cells with zero total counts + # !!! MAYBE WE SHOULD LKEEP THESE CELLS AND LEAVE THEM TO THE FILTERING STEP + input_read_RNA_assay <- input_read_RNA_assay[, colSums(counts) > 0] + + if (ncol(input_read_RNA_assay) == 0) return(NULL) + + # Rebuild the SCE to stay light, and to set the assay with the right name + input_read_RNA_assay = SingleCellExperiment( + assays = list(X = input_read_RNA_assay |> assay() ), + colData = colData(input_read_RNA_assay) + ) + + # Return the modified data object input_read_RNA_assay |> - saveHDF5SummarizedExperiment( - dir = file_name, - replace=TRUE, - as.sparse=TRUE + + save_experiment_data( + dir = glue("{external_path}/{digest(input_read_RNA_assay)}"), + container_type = container_type ) - file_name + # extension <- switch(container_type, + # + # "sce_rds" = ".rds", + # "seurat_rds" = ".rds", + # + # "seurat_h5" = ".h5Seurat", + # + # "anndata" = ".h5ad", + # + # "sce_hdf5" = "") + + # file_name = paste0(file_name, extension) + # + # # Return data as target instead of file_name pointer + # + # input_read_RNA_assay + # + # + # extension <- switch(container_type, + # "sce_rds" = ".rds", + # "seurat_rds" = ".rds", + # "seurat_h5" = ".h5Seurat", + # "anndata" = ".h5ad", + # "sce_hdf5" = "") + # file_name = paste0(file_name, extension) + + # Return data as target instead of file_name pointer + } diff --git a/R/utilities.R b/R/utilities.R index 9a4f6bc7..5a92e5cd 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -43,12 +43,106 @@ read_data_container <- function(file, } switch(container_type, - "anndata" = zellkonverter::readH5AD(file, reader = "R", use_hdf5 = TRUE, obs = FALSE, raw = FALSE, layers = FALSE), + "anndata" = zellkonverter::readH5AD(file, reader = "R", use_hdf5 = TRUE, + obs = FALSE, raw = FALSE, layers = FALSE), "sce_rds" = readRDS(file), "seurat_rds" = readRDS(file), "sce_hdf5" = loadHDF5SummarizedExperiment(file), "seurat_h5" = SeuratDisk::LoadH5Seurat(file) - ) + ) +} + +#' Save various types of single-cell data +#' @param data A data object to save. +#' @param dir A character vector of length one specifies the file path, or directory path. +#' @param container_type A character vector of length one specifies the input data type. +#' @return An object stored in the defined path. +#' @importFrom HDF5Array loadHDF5SummarizedExperiment saveHDF5SummarizedExperiment +#' @importFrom SummarizedExperiment assay +#' @export +save_experiment_data <- function(data, + dir, + container_type = "anndata"){ + + if (container_type == "seurat_h5") { + if (!requireNamespace("SeuratDisk", quietly = TRUE)) { + stop("HPCell says: You need to install the SeuratDisk package.") + } + } + + if (container_type == "anndata") { + if (!requireNamespace("zellkonverter", quietly = TRUE)) { + stop("HPCell says: You need to install the zellkonverter package.") + } + } + + switch(container_type, + "anndata" = { + if (ncol(assay(data)) == 1) data = data |> duplicate_single_column_assay() + zellkonverter::writeH5AD(data, paste0(dir, ".h5ad"), compression = "gzip") + read_data_container(paste0(dir, ".h5ad"), "anndata") + }, + "sce_rds" = data, + "seurat_rds" = data, + "sce_hdf5" = saveHDF5SummarizedExperiment(data, + dir, + replace = TRUE, + as.sparse = TRUE), + + "seurat_h5" = SeuratDisk::SaveH5Seurat(data, + paste0(dir, ".h5Seurat"), + overwrite = TRUE) + ) +} + +#' Duplicate Single-Column Assay in a SingleCellExperiment or Seurat Object +#' +#' This function handles a `SingleCellExperiment` or `Seurat` object where a specified assay +#' contains only one column. It duplicates the single-column assay to avoid potential +#' errors during saving or downstream analysis that require at least two columns. +#' The duplicated column is marked with a prefix `DUMMY___` to distinguish it. +#' Corresponding entries in the column metadata (`colData`) are also duplicated. +#' +#' @param data A `SingleCellExperiment` or `Seurat` object. +#' @importFrom SummarizedExperiment assay assays colData +#' @importFrom SingleCellExperiment SingleCellExperiment +#' @importFrom Seurat GetAssayData CreateSeuratObject +#' @importFrom rlang set_names +#' @return A modified `SingleCellExperiment` or `Seurat` object with the single-column assay +#' duplicated if applicable. +duplicate_single_column_assay <- function(data) { + + assay_name = data@assays|> names() |> magrittr::extract2(1) + + if (inherits(data, "SingleCellExperiment") && ncol(data) == 1){ + + # Duplicate the assay to prevent saving errors due to single-column matrices + my_assay = cbind(assay(data), assay(data)) + # Rename the second column to distinguish it + colnames(my_assay)[2] = paste0("DUMMY", "___", colnames(my_assay)[2]) + + cd = colData(data) + cd = cd |> rbind(cd) + rownames(cd)[2] = paste0("DUMMY", "___", rownames(cd)[2]) + + data = SingleCellExperiment(assay = list(my_assay) |> set_names(assay_name), colData = cd) + data + } + + if (inherits(data, "Seurat") && ncol(data) == 1) { + + my_assay <- GetAssayData(data, layer = "counts", assay = assay_name) + my_assay <- cbind(my_assay, my_assay) + colnames(my_assay)[2] <- paste0("DUMMY___", colnames(my_assay)[2]) + + cd <- data[[]] + cd <- rbind(cd, cd) + rownames(cd)[2] <- paste0("DUMMY___", rownames(cd)[2]) + + data <- CreateSeuratObject(counts = my_assay, meta.data = cd, assay = assay_name) + data + } + data } #' Gene name conversion using ensembl database @@ -78,149 +172,27 @@ convert_gene_names <- function(id, edb_df } -#' Identify Empty Droplets in Single-Cell RNA-seq Data -#' -#' @description -#' `empty_droplet_id` distinguishes between empty and non-empty droplets using the DropletUtils package. -#' It excludes mitochondrial and ribosomal genes, calculates barcode ranks, and optionally filters input data -#' based on these criteria. The function returns a tibble containing log probabilities, FDR, and a classification -#' indicating whether cells are empty droplets. -#' -#' @param input_read_RNA_assay SingleCellExperiment or Seurat object containing RNA assay data. -#' @param filter_empty_droplets Logical value indicating whether to filter the input data. -#' -#' @return A tibble with columns: logProb, FDR, empty_droplet (classification of droplets). -#' -#' @importFrom AnnotationDbi mapIds -#' @importFrom stringr str_subset -#' @importFrom dplyr left_join mutate -#' @importFrom tidyr replace_na -#' @importFrom DropletUtils emptyDrops barcodeRanks -#' @importFrom S4Vectors metadata -#' @importFrom EnsDb.Hsapiens.v86 EnsDb.Hsapiens.v86 -#' -#' @export -empty_droplet_id <- function(input_read_RNA_assay, - total_RNA_count_check = -Inf, - assay = NULL){ - #Fix GChecks - FDR = NULL - .cell = NULL - - # Get assay - if(is.null(assay)) assay = input_read_RNA_assay@assays |> names() |> extract2(1) - - # Check if empty droplets have been identified - nFeature_name <- paste0("nFeature_", assay) - - #if (any(input_read_RNA_assay[[nFeature_name]] < total_RNA_count_check)) { - filter_empty_droplets <- "TRUE" - # } - # else { - # filter_empty_droplets <- "FALSE" - # } - - significance_threshold = 0.001 - # Genes to exclude - location <- mapIds( - EnsDb.Hsapiens.v86, - keys=rownames(input_read_RNA_assay), - column="SEQNAME", - keytype="SYMBOL" - ) - mitochondrial_genes = which(location=="MT") |> names() - ribosome_genes = rownames(input_read_RNA_assay) |> str_subset("^RPS|^RPL") - - # if ("originalexp" %in% names(input_file@assays)) { - # barcode_ranks <- barcodeRanks(input_file@assays$originalexp@counts[!rownames(input_file@assays$originalexp@counts) %in% c(mitochondrial_genes, ribosome_genes),, drop=FALSE]) - # } else if ("RNA" %in% names(input_file@assays)) { - # barcode_ranks <- barcodeRanks(input_file@assays$RNA@counts[!rownames(input_file@assays$RNA@counts) %in% c(mitochondrial_genes, ribosome_genes),, drop=FALSE]) - # } - - # Get counts - if (inherits(input_read_RNA_assay, "Seurat")) { - counts <- GetAssayData(input_read_RNA_assay, assay, slot = "counts") - } else if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { - counts <- assay(input_read_RNA_assay, assay) - } - filtered_counts <- counts[!(rownames(counts) %in% c(mitochondrial_genes, ribosome_genes)),, drop=FALSE ] - # Calculate bar-codes ranks - barcode_ranks <- barcodeRanks(filtered_counts) - - # Set the minimum total RNA per cell for ambient RNA - if(min(barcode_ranks$total) < 100) { lower = 100 } else { - lower = quantile(barcode_ranks$total, 0.05) - - # write_lines( - # glue("{input_path} has supposely empty droplets with a lot of RNAm maybe a lot of ambient RNA? Please investigate"), - # file = glue("{dirname(output_path_result)}/warnings_emptyDrops.txt"), - # append = T - # ) - } - - # Remove genes from input - if ( - # If filter_empty_droplets - filter_empty_droplets == "TRUE") { - barcode_table <- filtered_counts |> - emptyDrops( test.ambient = TRUE, lower=lower) |> - as_tibble(rownames = ".cell") |> - mutate(empty_droplet = FDR >= significance_threshold) |> - replace_na(list(empty_droplet = TRUE)) - } - else { - barcode_table <- - input_read_RNA_assay |> - as_tibble() |> - select(.cell) |> - mutate( empty_droplet = FALSE) - } - - # barcode ranks - barcode_table <- barcode_table |> - left_join( - barcode_ranks |> - as_tibble(rownames = ".cell") |> - mutate( - knee = metadata(barcode_ranks)$knee, - inflection = metadata(barcode_ranks)$inflection - ) - ) - - - # barcode_table |> saveRDS(output_path_result) - - # # Plot bar-codes ranks - # plot_barcode_ranks = - # barcode_table %>% - # ggplot2::ggplot(aes(rank, total)) + - # geom_point(aes(color = empty_droplet, size = empty_droplet )) + - # geom_line(aes(rank, fitted), color="purple") + - # geom_hline(aes(yintercept = knee), color="dodgerblue") + - # geom_hline(aes(yintercept = inflection), color="forestgreen") + - # scale_x_log10() + - # scale_y_log10() + - # scale_color_manual(values = c("black", "#e11f28")) + - # scale_size_discrete(range = c(0, 2)) + - # theme_bw() - - # plot_barcode_ranks |> saveRDS(output_path_plot_rds) - - # ggsave( - # output_path_plot_pdf, - # plot = plot_barcode_ranks, - # useDingbats=FALSE, - # units = c("mm"), - # width = 183/2 , - # height = 183/2, - # limitsize = FALSE - # ) - - barcode_table - # return(list(barcode_table, plot_barcode_ranks)) +#' Transform counts to continous data +#' @param counts A SummarizedExperiment object +#' @importFrom tidyr pivot_longer +#' @importFrom SummarizedExperiment assay +#' @importFrom tibble as_tibble rownames_to_column +#' @importFrom magrittr extract2 +get_count_per_gene_df <- function(counts) { + #assay_name = data@assays |> names() |> extract2(1) + #counts <- assay(data, assay_name) |> as.data.frame() |> rownames_to_column(var = "features") + counts_tidy <- counts |> as.data.frame() |> tibble::rownames_to_column(var = "features") |> + as_tibble() |> pivot_longer(!features, names_to = "cells", + values_to = "counts") + counts_tidy } + + + + + #' Reference Label Fine Identification #' #' @description @@ -614,21 +586,19 @@ tar_append = function(fx, tiers = NULL, script = targets::tar_config_get("script # Construct the call with substitute # if (length(additional_args) > 0) { - call_expr = - as.call(arguments_to_pass) |> - deparse() - + call_expr = + as.call(arguments_to_pass) |> + deparse() + # } else { # call_expr <- substitute(fx(x), env = list(fx = fx, x = tiers)) |> # deparse() # } # Add prefix - "target_list = c(target_list, list(" |> + "target_list |> target_append(" |> c(call_expr ) |> - - # Add suffix - c("))") |> + c(")") |> paste(collapse = " ") |> @@ -718,13 +688,13 @@ append_chunk_fix = function(chunk, script = targets::tar_config_get("script")){ #' @importFrom targets tar_config_get #' @noRd append_chunk_tiers = function(chunk, tiers, script = targets::tar_config_get("script")){ - + # This does not work with purrr:::imap # As chunk does not like passed to a function tiers = tiers |> get_positions() .y = 1 for(.x in tiers |> names() ){ - + "target_list = c(target_list, list(" |> c( @@ -742,7 +712,7 @@ append_chunk_tiers = function(chunk, tiers, script = targets::tar_config_get("sc "targets::tar_option_get(\"resources\")", glue("tar_resources(crew = tar_resources_crew(\"{.x}\"))" ) ) - ) + ) ) |> # Add suffix @@ -755,7 +725,7 @@ append_chunk_tiers = function(chunk, tiers, script = targets::tar_config_get("sc .y = .y + 1 } - + } @@ -795,20 +765,34 @@ addition = function(a, b){ #' @noRd #' #' @importFrom Seurat RunUMAP -calc_UMAP <- function(input_seurat){ - assay_name = input_seurat@assays |> names() |> extract2(1) - find_var_genes <- FindVariableFeatures(input_seurat) - var_genes<- find_var_genes@assays[[assay_name]]@var.features - - x<- ScaleData(input_seurat) |> - # Calculate UMAP of clusters - RunPCA(features = var_genes) |> - FindNeighbors(dims = 1:30) |> - FindClusters(resolution = 0.5) |> - RunUMAP(dims = 1:30, spread = 0.5,min.dist = 0.01, n.neighbors = 10L) |> - as_tibble() +#' @export +calc_UMAP <- function(input_seurat) { + assay_name <- input_seurat@assays |> names() |> extract2(1) + + # Check if variable features are already present, if not calculate them + if (length(VariableFeatures(input_seurat)) == 0) { + input_seurat <- FindVariableFeatures(input_seurat) + } + + # Extract variable features using VariableFeatures() for Seurat v5 + var_genes <- VariableFeatures(input_seurat) + + # Ensure that there are variable features before proceeding + if (length(var_genes) > 0) { + # Scale data and run PCA on variable genes + x <- ScaleData(input_seurat) |> + RunPCA(features = var_genes) |> + FindNeighbors(dims = 1:30) |> + FindClusters(resolution = 0.5) |> + RunUMAP(dims = 1:30, spread = 0.5, min.dist = 0.01, n.neighbors = 10L) |> + as_tibble() + } else { + stop("No variable features available for UMAP calculation.") + } + return(x) } + #' Subsetting input dataset into a list of SingleCellExperiment or Seurat objects by pre-specified sample column tissue #' #' @importFrom dplyr quo_name pull @@ -886,177 +870,207 @@ is_strong_evidence = function(single_cell_data, cell_annotation_azimuth_l2, cell )) } -#' Clean and Standardize Cell Types (Deeper) +#' reference_annotation_to_consensus #' -#' This function takes a vector of cell types and applies a series of transformations -#' to clean and standardize them for better consistency. +#' This function takes cell type annotations from multiple datasets (Azimuth, Monaco, Blueprint) and harmonizes them into a consensus annotation. The function utilizes predefined mappings between cell type labels in these datasets to generate standardized cell types across references. #' -#' @importFrom dplyr %>% #' @importFrom dplyr mutate -#' -#' @importFrom stringr str_remove_all -#' @importFrom stringr str_remove -#' @importFrom stringr str_replace +#' @importFrom dplyr case_when +#' @importFrom dplyr left_join +#' @importFrom dplyr tribble +#' @importFrom tidyr expand_grid #' @importFrom stringr str_detect -#' @importFrom stringr str_replace_all -#' @importFrom stringr str_trim +#' @importFrom tibble deframe +#' +#' @param azimuth_input A vector of cell type annotations from the Azimuth dataset. +#' @param monaco_input A vector of cell type annotations from the Monaco dataset. +#' @param blueprint_input A vector of cell type annotations from the Blueprint dataset. +#' +#' @return A vector of consensus cell type annotations, merging inputs from the three datasets. #' -#' @param x A vector of cell types. +#' @examples +#' # Example usage: +#' tibble::tibble( +#' azimuth_predicted.celltype.l2 = c("CD8 TEM", "NK", "CD4 Naive"), +#' monaco_first.labels.fine = c("Effector memory CD8 T cells", "Natural killer cells", "Naive CD4 T cells"), +#' blueprint_first.labels.fine = c("CD8+ Tem", "NK cells", "Naive B-cells") +#' ) |> +#' dplyr::mutate(consensus = reference_annotation_to_consensus( +#' azimuth_predicted.celltype.l2, monaco_first.labels.fine, blueprint_first.labels.fine)) +#' +#' @note This function is designed to harmonize specific cell types, especially T cells, B cells, monocytic cells, and innate lymphoid cells (ILCs), across reference datasets. #' -#' @return A cleaned and standardized vector of cell types. +#' @seealso \code{\link[dplyr]{mutate}}, \code{\link[stringr]{str_detect}}, \code{\link[tidyr]{expand_grid}} #' -# @examples -# cell_types <- c("CD4 T Cell, AlphaBeta", "NK cell, gammadelta", "Central Memory") -# cleaned_cell_types <- clean_cell_types_deeper(cell_types) -clean_cell_types_deeper = function(x){ +#' @export +reference_annotation_to_consensus = function(azimuth_input, monaco_input, blueprint_input){ + + # azimuth_pbmc = enquo(azimuth_pbmc) + # monaco_fine = enquo(monaco_fine) + # blueprint_fine = enquo(blueprint_fine) monaco = tribble( - ~Query, ~Reference, ~Database, - "Naive CD8 T cells", "cd8 naive", "monaco_first.labels.fine", - "Central memory CD8 T cells", "cd8 tcm", "monaco_first.labels.fine", - "Effector memory CD8 T cells", "cd8 tem", "monaco_first.labels.fine", - "Terminal effector CD8 T cells", "terminal effector cd4 t", "monaco_first.labels.fine", # Adjusting for the closest match - "MAIT cells", "mait", "monaco_first.labels.fine", - "Vd2 gd T cells", "tgd", "monaco_first.labels.fine", - "Non-Vd2 gd T cells", "tgd", "monaco_first.labels.fine", # No direct match, leaving as NA - "Follicular helper T cells", "cd4 fh", "monaco_first.labels.fine", - "T regulatory cells", "treg", "monaco_first.labels.fine", - "Th1 cells", "cd4 th1", "monaco_first.labels.fine", - "Th1/Th17 cells", "cd4 th1/th17", "monaco_first.labels.fine", - "Th17 cells", "cd4 th17", "monaco_first.labels.fine", - "Th2 cells", "cd4 th2", "monaco_first.labels.fine", - "Naive CD4 T cells", "cd4 naive", "monaco_first.labels.fine", - "Progenitor cells", "progenitor_cell", "monaco_first.labels.fine", - "Naive B cells", "b naive", "monaco_first.labels.fine", - "Naive B", "b naive", "monaco_first.labels.fine", - "Non-switched memory B cells", "b memory", "monaco_first.labels.fine", # No direct match, leaving as NA - "Nonswitched memory B", "b memory", "monaco_first.labels.fine", # No direct match, leaving as NA - "Exhausted B cells", "plasma_cell", "monaco_first.labels.fine", # No direct match, leaving as NA - "Switched memory B cells", "b memory", "monaco_first.labels.fine", - "Switched memory B", "b memory", "monaco_first.labels.fine", - "Plasmablasts", "plasma_cell", "monaco_first.labels.fine", - "Classical monocytes", "cd14 mono", "monaco_first.labels.fine", - "Intermediate monocytes", "cd14 mono", "monaco_first.labels.fine", # Mapping to a closely related term - "Non classical monocytes", "cd16 mono", "monaco_first.labels.fine", - "Natural killer cells", "nk", "monaco_first.labels.fine", - "Natural killer", "nk", "monaco_first.labels.fine", - "Plasmacytoid dendritic cells", "pdc", "monaco_first.labels.fine", - "Myeloid dendritic cells", "cdc", "monaco_first.labels.fine", - "Myeloid dendritic", "cdc", "monaco_first.labels.fine", - "Low-density neutrophils", "granulocyte", "monaco_first.labels.fine", - "Lowdensity neutrophils", "granulocyte", "monaco_first.labels.fine", - "Low-density basophils", "granulocyte", "monaco_first.labels.fine", # No direct match, leaving as NA - "Lowdensity basophils", "granulocyte", "monaco_first.labels.fine", # No direct match, leaving as NA - "Terminal effector CD4 T cells", "terminal effector cd4 t", "monaco_first.labels.fine", - "progenitor", "progenitor_cell", "monaco_first.labels.fine" - ) + ~Query, ~Reference, + "Naive CD8 T cells", "cd8 naive", + "Central memory CD8 T cells", "cd8 tcm", + "Effector memory CD8 T cells", "cd8 tem", + "Terminal effector CD8 T cells", "cd8 tem", # Adjusting for the closest match + "MAIT cells", "mait", + "Vd2 gd T cells", "tgd", + "Non-Vd2 gd T cells", "tgd", # No direct match, leaving as NA + "Follicular helper T cells", "cd4 fh", + "T regulatory cells", "treg", + "Th1 cells", "cd4 th1", + "Th1/Th17 cells", "cd4 th1/th17", + "Th17 cells", "cd4 th17", + "Th2 cells", "cd4 th2", + "Naive CD4 T cells", "cd4 naive", + "Progenitor cells", "progenitor", + "Naive B cells", "b naive", + "Naive B", "b naive", + "Non-switched memory B cells", "b memory", # No direct match, leaving as NA + "Nonswitched memory B", "b memory", # No direct match, leaving as NA + "Exhausted B cells", "plasma", # Removed " cell" + "Switched memory B cells", "b memory", + "Switched memory B", "b memory", + "Plasmablasts", "plasma", # Removed " cell" + "Classical monocytes", "cd14 mono", + "Intermediate monocytes", "cd14 mono", # Mapping to a closely related term + "Non classical monocytes", "cd16 mono", + "Natural killer cells", "nk", + "Natural killer", "nk", + "Plasmacytoid dendritic cells", "pdc", + "Myeloid dendritic cells", "cdc", + "Myeloid dendritic", "cdc", + "Low-density neutrophils", "granulocyte", + "Lowdensity neutrophils", "granulocyte", + "Low-density basophils", "granulocyte", # No direct match, leaving as NA + "Lowdensity basophils", "granulocyte", # No direct match, leaving as NA + "Terminal effector CD4 T cells", "cd4 tem", + "progenitor", "progenitor" # Removed " cell" + ) - azimuth = + azimuth = tribble( - ~Query, ~Reference, ~Database, - "NK", "nk", "Azimuth", - "CD8 TEM", "cd8 tem", "Azimuth", - "CD4 CTL", "cd4 helper", "Azimuth", # CD4 cytotoxic T lymphocytes often relate to Th1 cells - "dnT", "dnt", "Azimuth", - "CD8 Naive", "cd8 naive", "Azimuth", - "CD4 Naive", "cd4 naive", "Azimuth", - "CD4 TCM", "cd4 helper", "Azimuth", # Central memory cells often relate to Th1 or Th17 - "gdT", "tgd", "Azimuth", - "CD8 TCM", "cd8 tcm", "Azimuth", - "MAIT", "mait", "Azimuth", - "CD4 TEM", "terminal effector cd4 t", "Azimuth", # Effector memory cells can relate to terminal effector cells - "ILC", "ilc", "Azimuth", - "CD14 Mono", "cd14 mono", "Azimuth", - "cDC1", "cdc", "Azimuth", # Conventional dendritic cell 1 is commonly referred to as CDC - "pDC", "pdc", "Azimuth", - "cDC2", "cdc", "Azimuth", # No specific reference for cDC2, but using CDC as a general category - "B naive", "b naive", "Azimuth", - "B intermediate", "b naive", "Azimuth", # No direct match, leaving as NA - "B memory", "b memory", "Azimuth", - "Platelet", "platelet", "Azimuth", - "Eryth", "erythrocyte", "Azimuth", - "CD16 Mono", "cd16 mono", "Azimuth", - "HSPC", "hematopoietic_precursor_cell", "Azimuth", - "Treg", "treg", "Azimuth", - "NK_CD56bright", "nk", "Azimuth", # CD56bright NK cells are a subset of NK cells - "Plasmablast", "plasma_cell", "Azimuth", - "NK Proliferating", "NK", "Azimuth", # NK cells can be proliferative, linked to general proliferation - "ASDC", "cdc", "Azimuth", # No direct match, leaving as NA - "CD8 Proliferating", "proliferating_t_cell", "Azimuth", - "CD4 Proliferating", "proliferating_t_cell", "Azimuth", - "doublet", "non_immune", "Azimuth" - ) + ~Query, ~Reference, + "NK", "nk", + "CD8 TEM", "cd8 tem", + "CD4 CTL", "cd4 helper", # CD4 cytotoxic T lymphocytes often relate to Th1 cells + "dnT", "dnt", + "CD8 Naive", "cd8 naive", + "CD4 Naive", "cd4 naive", + "CD4 TCM", "cd4 tcm", # Central memory cells often relate to Th1 or Th17 + "gdT", "tgd", + "CD8 TCM", "cd8 tcm", + "MAIT", "mait", + "CD4 TEM", "cd4 tem", # Effector memory cells can relate to terminal effector cells + "ILC", "ilc", + "CD14 Mono", "cd14 mono", + "cDC1", "cdc", # Conventional dendritic cell 1 is commonly referred to as CDC + "pDC", "pdc", + "cDC2", "cdc", # No specific reference for cDC2, but using CDC as a general category + "B naive", "b naive", + "B intermediate", "b memory", # No direct match, leaving as NA + "B memory", "b memory", + "Platelet", "platelet", + "Eryth", "erythrocyte", + "CD16 Mono", "cd16 mono", + "HSPC", "progenitor", + "Treg", "treg", + "NK_CD56bright", "nk", # CD56bright NK cells are a subset of NK cells + "Plasmablast", "plasma", + "NK Proliferating", "nk", # NK cells can be proliferative + "ASDC", "cdc", # No direct match, leaving as NA + "CD8 Proliferating", "cd8 tem", + "CD4 Proliferating", "cd4 tem", + "doublet", "non immune", + NA, NA + ) - blueprint = tribble( - ~Query, ~Reference, ~Database, - "Neutrophils", "granulocyte", "blueprint_first.labels.fine", - "Monocytes", "monocyte", "blueprint_first.labels.fine", - "MEP", "hematopoietic_cell", "blueprint_first.labels.fine", # MEP typically refers to megakaryocyte-erythroid progenitor - "CD4+ T-cells", "cd4 th1", "blueprint_first.labels.fine", - "Tregs", "treg", "blueprint_first.labels.fine", - "CD4+ Tcm", "cd4 th1/th17", "blueprint_first.labels.fine", - "CD4+ Tem", "terminal effector cd4 t", "blueprint_first.labels.fine", - "CD8+ Tcm", "cd8 tcm", "blueprint_first.labels.fine", - "CD8+ Tem", "cd8 tem", "blueprint_first.labels.fine", - "NK cells", "nk", "blueprint_first.labels.fine", - "naive B-cells", "b naive", "blueprint_first.labels.fine", - "Memory B-cells", "b memory", "blueprint_first.labels.fine", - "Class-switched memory B-cells", "b memory", "blueprint_first.labels.fine", # No direct match, leaving as NA - "HSC", "hematopoietic_cell", "blueprint_first.labels.fine", - "MPP", "hematopoietic_cell", "blueprint_first.labels.fine", # MPP typically refers to multipotent progenitor - "CLP", "hematopoietic_cell", "blueprint_first.labels.fine", # CLP typically refers to common lymphoid progenitor - "GMP", "hematopoietic_cell", "blueprint_first.labels.fine", # GMP typically refers to granulocyte-macrophage progenitor - "Macrophages", "macrophage", "blueprint_first.labels.fine", - "CD8+ T-cells", "cd8", "blueprint_first.labels.fine", - "CD8 T", "cd8", "blueprint_first.labels.fine", - "Erythrocytes", "erythrocyte", "blueprint_first.labels.fine", - "Megakaryocytes", "megakaryocytes", "blueprint_first.labels.fine", - "CMP", "hematopoietic_cell", "blueprint_first.labels.fine", # CMP typically refers to common myeloid progenitor - "Macrophages M1", "macrophage", "blueprint_first.labels.fine", # Specific polarization states (M1, M2) not explicitly listed - "Macrophages M2", "macrophage", "blueprint_first.labels.fine", - "Endothelial cells", "endothelial_cell", "blueprint_first.labels.fine", - "DC", "cdc", "blueprint_first.labels.fine", # Assuming DC refers to dendritic cells - "Eosinophils", "granulocyte", "blueprint_first.labels.fine", # No direct match, leaving as NA - "Plasma cells", "plasma_cell", "blueprint_first.labels.fine", - "Chondrocytes", "chondrocyte", "blueprint_first.labels.fine", - "Fibroblasts", "fibroblast", "blueprint_first.labels.fine", - "Smooth muscle", "smooth_muscle_cell", "blueprint_first.labels.fine", - "Epithelial cells", "epithelial_cell", "blueprint_first.labels.fine", - "Melanocytes", "melanocyte", "blueprint_first.labels.fine", - "Skeletal muscle", "muscle_cell", "blueprint_first.labels.fine", - "Keratinocytes", "keratinocyte", "blueprint_first.labels.fine", - "mv Endothelial cells", "endothelial_cell", "blueprint_first.labels.fine", - "Myocytes", "myocyte", "blueprint_first.labels.fine", - "Adipocytes", "fat_cell", "blueprint_first.labels.fine", - "Neurons", "neuron", "blueprint_first.labels.fine", - "Pericytes", "pericyte_cell", "blueprint_first.labels.fine", - "Preadipocytes", "adipocyte", "blueprint_first.labels.fine", # No direct match, leaving as NA - "Astrocytes", "astrocyte", "blueprint_first.labels.fine", - "Mesangial cells", "mesangial_cell", "blueprint_first.labels.fine" - ) - - conversion_table = - bind_rows(monaco, blueprint, azimuth) + blueprint = tribble( + ~Query, ~Reference, + "Neutrophils", "granulocyte", + "Monocytes", "monocyte", + "MEP", "progenitor", # MEP typically refers to megakaryocyte-erythroid progenitor + "CD4+ T-cells", "cd4 t", + "Tregs", "treg", + "CD4+ Tcm", "cd4 tcm", + "CD4+ Tem", "cd4 tem", + "CD8+ Tcm", "cd8 tcm", + "CD8+ Tem", "cd8 tem", + "NK cells", "nk", + "naive B-cells", "b naive", + "Memory B-cells", "b memory", + "Class-switched memory B-cells", "b memory", # No direct match, leaving as NA + "HSC", "progenitor", # HSC typically refers to hematopoietic stem cell + "MPP", "progenitor", # MPP typically refers to multipotent progenitor + "CLP", "progenitor", # CLP typically refers to common lymphoid progenitor + "GMP", "progenitor", # GMP typically refers to granulocyte-macrophage progenitor + "Macrophages", "macrophage", + "CD8+ T-cells", "cd8", + "CD8 T", "cd8", + "Erythrocytes", "erythrocyte", + "Megakaryocytes", "megakaryocytes", + "CMP", "progenitor", # CMP typically refers to common myeloid progenitor + "Macrophages M1", "macrophage m1", # Specific polarization states (M1, M2) not explicitly listed + "Macrophages M2", "macrophage m2", + "Endothelial cells", "endothelial", # Removed " cell" + "DC", "cdc", # Assuming DC refers to dendritic cells + "Eosinophils", "granulocyte", # No direct match, leaving as NA + "Plasma cells", "plasma", # Removed " cell" + "Chondrocytes", "chondrocyte", + "Fibroblasts", "fibroblast", + "Smooth muscle", "smooth muscle", # Removed " cell" from "smooth muscle cell" + "Epithelial cells", "epithelial", # Removed " cell" + "Melanocytes", "melanocyte", + "Skeletal muscle", "muscle", # "muscle cell" becomes "muscle" + "Keratinocytes", "keratinocyte", + "mv Endothelial cells", "endothelial", # Removed " cell" + "Myocytes", "myocyte", + "Adipocytes", "fat", # "fat cell" becomes "fat" after removing " cell" + "Neurons", "neuron", + "Pericytes", "pericyte", # "pericyte cell" becomes "pericyte" + "Preadipocytes", "adipocyte", # No direct match, leaving as NA + "Astrocytes", "astrocyte", + "Mesangial cells", "mesangial" # Removed " cell" + ) - all_combinations = - expand_grid( - blueprint_first.labels.fine = blueprint |> pull(Reference) |> unique(), - monaco_first.labels.fine = monaco |> pull(Reference) |> unique(), - Azimuth = azimuth |> pull(Reference) |> unique() + non_immune_cells <- c( + "megakaryocytes", + "endothelial", + "chondrocyte", + "fibroblast", + "smooth muscle", + "epithelial", + "melanocyte", + "muscle", + "keratinocyte", + "endothelial", # Appears again in the original vector + "myocyte", + "fat", + "neuron", + "pericyte", + "adipocyte", + "astrocyte", + "mesangial" ) t_cells <- c( "cd8 naive", "cd8 tcm", "cd8 tem", - "terminal effector cd4 t", + "cd4 tem", + "cd4 tcm", + "cd4 effector", "treg", "cd4 th1/th17", "cd4 th1", "cd4 th17", + "cd4 th2", + "cd4 t", "t_nk", - "proliferating_t_cell", + "cd8 effector", "dnt", "cd4 naive", "cd4 th2", @@ -1068,7 +1082,7 @@ clean_cell_types_deeper = function(x){ b_cells <- c( "b naive", "b memory", - "plasma_cell" + "plasma" ) myeloid_cells <- c( @@ -1076,12 +1090,12 @@ clean_cell_types_deeper = function(x){ "monocyte", "cd16 mono", "macrophage", + "macrophage m1", + "macrophage m2", "macrophages", - "pdc", # Plasmacytoid dendritic cells + #"pdc", # Plasmacytoid dendritic cells "cdc", # Conventional dendritic cells - "promyelocyte", - "myelocyte", - "kupffer_cell" + "kupffer" ) ilcs <- c( @@ -1089,126 +1103,278 @@ clean_cell_types_deeper = function(x){ "nk" ) - all_combinations |> - mutate(consensus = - case_when( - # Full consensus - blueprint_first.labels.fine == monaco_first.labels.fine & - blueprint_first.labels.fine == Azimuth ~ blueprint_first.labels.fine, - - # Partial consensus - blueprint_first.labels.fine == monaco_first.labels.fine ~ blueprint_first.labels.fine, - blueprint_first.labels.fine == Azimuth ~ blueprint_first.labels.fine, - monaco_first.labels.fine == Azimuth ~ monaco_first.labels.fine, - - # T cells - blueprint_first.labels.fine |> str_detect("cd8") & monaco_first.labels.fine |> str_detect("cd8") & Azimuth |> str_detect("cd8") ~ "t cd8", - blueprint_first.labels.fine |> str_detect("cd4|th|fh|treg") & monaco_first.labels.fine |> str_detect("cd4|th|fh|treg") & Azimuth |> str_detect("cd4|th|fh|treg") ~ "t cd4", - blueprint_first.labels.fine %in% t_cells & monaco_first.labels.fine %in% t_cells & Azimuth %in% t_cells ~ "t", - - # B cells - blueprint_first.labels.fine %in% b_cells & monaco_first.labels.fine %in% b_cells & Azimuth %in% b_cells ~ "b", - - # monocytic - blueprint_first.labels.fine %in% myeloid_cells & monaco_first.labels.fine %in% myeloid_cells & Azimuth %in% myeloid_cells ~ "monocytic", - - # ILCs - blueprint_first.labels.fine %in% ilcs & monaco_first.labels.fine %in% ilcs & Azimuth %in% ilcs ~ "ilc", - - - TRUE ~ NA_character_ - )) |> filter(consensus |> is.na()) - - - - x |> - select(.cell, blueprint_first.labels.fine, monaco_first.labels.fine) |> - pivot_longer(-.cell, names_to = "Database", values_to = "Query") |> - mutate(Query = Query |> tolower()) |> - left_join(conversion_table |> mutate(Query = Query |> tolower()), copy = TRUE) |> - select(-Query) |> - pivot_wider(names_from = Database, values_from = Reference) - - - + all_combinations = + expand_grid( + blueprint_fine = blueprint |> pull(Reference) |> unique(), + monaco_fine = monaco |> pull(Reference) |> unique(), + azimuth_pbmc = azimuth |> pull(Reference) |> unique() + ) |> + + # Find consensus manually + mutate(consensus = + case_when( + + # Non immune + blueprint_fine %in% non_immune_cells ~ "non immune", + + # Full consensus + blueprint_fine == monaco_fine & + blueprint_fine == azimuth_pbmc ~ blueprint_fine , + + # This goes before partial exact consensus because is a special case + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & blueprint_fine %in% c("cd4 tcm") & azimuth_pbmc %in% c("cd4 tcm") ~ glue("{monaco_fine} cm") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & blueprint_fine %in% c("cd4 tem") & azimuth_pbmc %in% c("cd4 tem") ~ glue("{monaco_fine} em") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + blueprint_fine |> str_detect("macrophage") & monaco_fine |> str_detect(" mono") & azimuth_pbmc |> str_detect(" mono") ~ blueprint_fine, + + # Partial consensus + blueprint_fine == monaco_fine ~ blueprint_fine , + blueprint_fine == azimuth_pbmc ~ blueprint_fine , + monaco_fine == azimuth_pbmc ~ monaco_fine , + + ################## + # More difficoult combination if nothing above matched + ################## + + # T cells + str_detect( blueprint_fine , "cd8") & str_detect( monaco_fine , "cd8") & str_detect( azimuth_pbmc , "cd8") ~ "t cd8", + + + str_detect( blueprint_fine , "cd4|treg") & str_detect( monaco_fine , "cd4|treg") & str_detect( azimuth_pbmc , "cd4|treg") ~ "t cd4", + blueprint_fine %in% t_cells & monaco_fine %in% t_cells & azimuth_pbmc %in% t_cells ~ "t", + + # B cells + blueprint_fine %in% b_cells & monaco_fine %in% b_cells & azimuth_pbmc %in% b_cells ~ "b", + + # Monocytic cells + blueprint_fine %in% myeloid_cells & monaco_fine %in% myeloid_cells & azimuth_pbmc %in% myeloid_cells ~ "monocytic", + + # ILCs + blueprint_fine %in% ilcs & monaco_fine %in% ilcs & azimuth_pbmc %in% ilcs ~ "ilc", + + # cytotoxic + ( blueprint_fine %in% ilcs | str_detect( blueprint_fine , "cd8") ) & + ( monaco_fine %in% ilcs | str_detect( monaco_fine , "cd8") ) & + ( azimuth_pbmc %in% ilcs | str_detect( azimuth_pbmc , "cd8") ) ~ "cytotoxic", + + ################## + # Partial consensus broad cell types + ################## + + # T cells + str_detect( blueprint_fine , "cd8") & str_detect( monaco_fine , "cd8") ~ "t cd8", + str_detect( blueprint_fine , "cd8") & str_detect( azimuth_pbmc , "cd8") ~ "t cd8", + str_detect( monaco_fine , "cd8") & str_detect( azimuth_pbmc , "cd8") ~ "t cd8", + + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & blueprint_fine %in% c("cd4 tcm") ~ glue("{monaco_fine} cm") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & azimuth_pbmc %in% c("cd4 tcm") ~ glue("{monaco_fine} cm") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + + + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & blueprint_fine %in% c("cd4 tem") ~ glue("{monaco_fine} em") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + monaco_fine %in% c("cd4 fh","cd4 th1","cd4 th1/th17", "cd4 th17", "cd4 th2") & azimuth_pbmc %in% c("cd4 tem") ~ glue("{monaco_fine} em") , # Because most Th cells are central and effector memory CD4 T cells (CM and EM), PMID: 30726743 + + + str_detect( blueprint_fine , "cd4|treg") & str_detect( monaco_fine , "cd4|treg") ~ "t cd4", + str_detect( blueprint_fine , "cd4|treg") & str_detect( azimuth_pbmc , "cd4|treg") ~ "t cd4", + str_detect( monaco_fine , "cd4|treg") & str_detect( azimuth_pbmc , "cd4|treg") ~ "t cd4", + + blueprint_fine %in% t_cells & monaco_fine %in% t_cells ~ "t", + blueprint_fine %in% t_cells & azimuth_pbmc %in% t_cells ~ "t", + monaco_fine %in% t_cells & azimuth_pbmc %in% t_cells ~ "t", + + # B cells + blueprint_fine %in% b_cells & monaco_fine %in% b_cells ~ "b", + blueprint_fine %in% b_cells & azimuth_pbmc %in% b_cells ~ "b", + monaco_fine %in% b_cells & azimuth_pbmc %in% b_cells ~ "b", + + # Monocytic cells + blueprint_fine |> str_detect("monocyte") & monaco_fine |> str_detect(" mono") ~ monaco_fine, # This is because blueprint does not have CDC16 or CD14 + blueprint_fine |> str_detect("monocyte") & azimuth_pbmc |> str_detect(" mono") ~ azimuth_pbmc, # This is because blueprint does not have CDC16 or CD14 + + blueprint_fine |> str_detect("macrophage") & monaco_fine |> str_detect(" mono") ~ blueprint_fine, # This is because only blueprint has mac M1 M2 + blueprint_fine |> str_detect("macrophage") & azimuth_pbmc |> str_detect(" mono") ~ blueprint_fine, # This is because only blueprint has mac M1 M2 + + blueprint_fine %in% myeloid_cells & monaco_fine %in% myeloid_cells ~ "monocytic", + blueprint_fine %in% myeloid_cells & azimuth_pbmc %in% myeloid_cells ~ "monocytic", + monaco_fine %in% myeloid_cells & azimuth_pbmc %in% myeloid_cells ~ "monocytic", + + # ILCs + blueprint_fine %in% ilcs & monaco_fine %in% ilcs ~ "ilc", + blueprint_fine %in% ilcs & azimuth_pbmc %in% ilcs ~ "ilc", + monaco_fine %in% ilcs & azimuth_pbmc %in% ilcs ~ "ilc", + + # cytotoxic + ( blueprint_fine %in% ilcs | str_detect( blueprint_fine , "cd8") ) & + ( monaco_fine %in% ilcs | str_detect( monaco_fine , "cd8") ) ~ "cytotoxic", + + ( blueprint_fine %in% ilcs | str_detect( blueprint_fine , "cd8") ) & + ( azimuth_pbmc %in% ilcs | str_detect( azimuth_pbmc , "cd8") ) ~ "cytotoxic", + + ( monaco_fine %in% ilcs | str_detect( monaco_fine , "cd8") ) & + ( azimuth_pbmc %in% ilcs | str_detect( azimuth_pbmc , "cd8") ) ~ "cytotoxic", + + + TRUE ~ NA_character_ + )) |> + + # simplify Thelper cm to tcm + mutate(consensus = if_else(consensus |> str_detect("cd4 .* cm"), "cd4 tcm", consensus )) + + # |> + # rowid_to_column("combination_id") |> + # pivot_longer(-combination_id, names_to = "Database", values_to = "Reference") |> + # left_join(conversion_table, relationship = "many-to-many") |> + # select(-Reference) |> + # pivot_wider(names_from = Database, values_from = Query, values_fn = function(x) paste(unique(x), collapse = ",")) + + # parse names, chenge to lower case for all + tibble( + blueprint_fine = blueprint |> mutate(across(everything(), tolower)) |> deframe() |> _[!!tolower(blueprint_input)], + monaco_fine = monaco |> mutate(across(everything(), tolower)) |> deframe() |> _[!!tolower(monaco_input)], + azimuth_pbmc = azimuth |> mutate(across(everything(), tolower)) |> deframe() |> _[!!tolower(azimuth_input)], + ) |> + left_join( + all_combinations, + by = join_by( + blueprint_fine == blueprint_fine, + monaco_fine == monaco_fine, + azimuth_pbmc == azimuth_pbmc + ) + ) |> + pull(consensus) - #Fix GChecks - cell_type_clean = NULL - x |> - # Annotate - mutate(cell_type_clean = cell_type_clean |> tolower()) |> - mutate(cell_type_clean = cell_type_clean |> str_remove_all(",")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("alphabeta")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove_all("positive")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("cd4 t", "cd4")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("regulatory t", "treg")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("thymusderived")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("human")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("igg ")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("igm ")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("iga ")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("group [0-9]")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("common")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("cd45ro")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("type i")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("germinal center")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("iggnegative")) |> - mutate(cell_type_clean = cell_type_clean |> str_remove("terminally differentiated")) |> - - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect("macrophage"), "macrophage", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean == "mononuclear phagocyte", "macrophage", cell_type_clean) ) |> - - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect(" treg"), "treg", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect(" dendritic"), "dendritic", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect(" thelper"), "thelper", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect("thelper "), "thelper", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect("gammadelta"), "tgd", cell_type_clean) ) |> - mutate(cell_type_clean = if_else(cell_type_clean |> str_detect("natural killer"), "nk", cell_type_clean) ) |> - - - mutate(cell_type_clean = cell_type_clean |> str_replace_all(" ", " ")) |> - - - mutate(cell_type_clean = cell_type_clean |> str_replace("myeloid leukocyte", "myeloid")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("effector memory", "tem")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("effector", "tem")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace_all("cd8 t", "cd8")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("central memory", "tcm")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("gammadelta t", "gdt")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("nonclassical monocyte", "cd16 monocyte")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("classical monocyte", "cd14 monocyte")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("follicular b", "b")) |> - mutate(cell_type_clean = cell_type_clean |> str_replace("unswitched memory", "memory")) |> - - mutate(cell_type_clean = cell_type_clean |> str_trim()) } -#' Clean and Standardize Cell Types +#' Clean and Standardize Cell Type Names #' -#' This function takes a vector of cell types and applies a series of transformations -#' to clean and standardize them for better consistency. +#' Cleans and standardizes a vector of cell type names by applying a series of string transformations to improve consistency. +#' This function is particularly useful for preprocessing cell type labels in biological datasets where consistent naming conventions are important. #' -#' @importFrom stringr str_remove_all -#' @importFrom stringr str_trim +#' @param x A character vector of cell type names to be cleaned and standardized. #' -#' @param .x A vector of cell types. +#' @return A character vector of cleaned and standardized cell type names. #' -#' @return A cleaned and standardized vector of cell types. +#' @importFrom stringr str_remove_all +#' @importFrom stringr str_remove +#' @importFrom stringr str_replace +#' @importFrom stringr str_replace_all +#' @importFrom stringr str_trim #' #' @examples -#' cell_types <- c("CD4+ T-cells", "NK cells", "Blast-cells") -# cleaned_cell_types <- clean_cell_types(cell_types) - -clean_cell_types = function(.x){ - .x |> +#' cell_types <- c("CD4+ T-cells", "NK cells", "Blast-cells", "Terminally differentiated macrophage") +#' cleaned_cell_types <- clean_cellxgene_cell_types(cell_types) +#' print(cleaned_cell_types) +#' +#' # Output: +#' # [1] "cd4 t" "nk" "" "macrophage" +#' +#' @export +clean_cellxgene_cell_types = function(x){ + + x |> + # Annotate + tolower() |> + str_remove_all(",") |> + str_remove("alphabeta") |> + str_remove_all("positive") |> + str_replace("cd4 t", "cd4") |> + str_replace("regulatory t", "treg") |> + str_remove("thymusderived") |> + str_remove("human") |> + str_remove("igg ") |> + str_remove("igm ") |> + str_remove("iga ") |> + str_remove("group [0-9]") |> + str_remove("common") |> + str_remove("cd45ro") |> + str_remove("type i") |> + str_remove("germinal center") |> + str_remove("iggnegative") |> + str_remove("terminally differentiated") |> + + str_replace(".*macrophage.*", "macrophage") |> + str_replace("^mononuclear phagocyte$", "macrophage") |> + str_replace(".* treg.*", "treg") |> + str_replace(".* dendritic.*", "dendritic") |> + str_replace(".* thelper.*", "thelper") |> + str_replace(".*thelper .*", "thelper") |> + str_replace(".*gammadelta.*", "tgd") |> + str_replace(".*natural killer.*", "nk") |> + + str_replace_all(" ", " ") |> + + str_replace("myeloid leukocyte", "myeloid") |> + str_replace("effector memory", "tem") |> + str_replace("effector", "tem") |> + str_replace_all("cd8 t", "cd8") |> + str_replace("central memory", "tcm") |> + str_replace("gammadelta t", "gdt") |> + str_replace("nonclassical monocyte", "cd16 monocyte") |> + str_replace("classical monocyte", "cd14 monocyte") |> + str_replace("follicular b", "b") |> + str_replace("unswitched memory", "memory") |> + + str_trim() |> + str_remove_all("\\+") |> str_remove_all("cells") |> str_remove_all("cell") |> str_remove_all("blast") |> str_remove_all("-") |> - str_trim() + str_trim() |> + + str_remove("^_+|_+$") |> # Removes leading and trailing underscores + + # clean NON IMMUNE + str_replace("(?i)\\bepithelial\\b", "epithelial_cell") |> + str_replace("(?i)\\bfibroblast\\b", "fibroblast") |> + str_replace("(?i)\\bendothelial\\b", "endothelial_cell") |> + str_replace("(?i)^(Mueller cell|Muller cell)$", "Muller_cell") |> + str_replace("(?i)\\bneuron\\b", "neuron") |> + str_replace("(?i)amplifying cell", "amplifying_cell") |> + str_replace("(?i)stem cell", "stem_cell") |> + str_replace("(?i)progenitor cell", "progenitor_cell") |> + str_replace("(?i)acinar cell", "acinar_cell") |> + str_replace("(?i)goblet cell", "goblet_cell") |> + str_replace("(?i)thymocyte", "thymocyte") |> + str_replace("(?i)urothelial", "urothelial_cell") |> + str_replace("(?i)\\bfat\\b", "fat_cell") |> + str_replace("(?i)pneumocyte", "pneumocyte") |> + str_replace("(?i)mesothelial", "mesothelial_cell") |> + str_replace("(?i)enteroendocrine", "enteroendocrine_cell") |> + str_replace("(?i)enterocyte", "enterocyte") |> + str_replace("(?i)\\bbasal\\b", "basal_cell") |> + str_replace("(?i)stromal", "stromal_cell") |> + str_replace("(?i)retina", "retinal_cell") |> + str_replace("(?i)ciliated", "ciliated_cell") |> + str_replace("(?i)pericyte", "pericyte_cell") |> + str_replace("(?i)trophoblast", "trophoblast") |> + str_replace("(?i)brush", "brush_cell") |> + str_replace("(?i)serous", "serous_cell") |> + str_replace("(?i)hepatocyte", "hepatocyte") |> + str_replace("(?i)melanocyte", "melanocyte") |> + str_replace("(?i)myocyte", "myocyte") |> + str_replace("(?i)promyelocyte", "promyelocyte") |> + str_replace("(?i)cholangiocyte", "cholangiocyte") |> + str_replace("(?i)myoblast", "myoblast") |> + str_replace("(?i)satellite", "satellite_cell") |> + str_replace("(?i)muscle", "muscle_cell") |> + str_replace("(?i)progenitor", "progenitor_cell") |> + str_replace("(?i)erythrocyte", "erythrocyte") |> + str_replace("(?i)myoepithelial", "myoepithelial_cell") |> + str_replace("(?i)myofibroblast", "myofibroblast_cell") |> + str_replace("(?i)pancreatic", "pancreatic_cell") |> + str_replace("(?i)renal", "renal_cell") |> + str_replace("(?i)epidermal", "epidermal_cell") |> + str_replace("(?i)cortical", "cortical_cell") |> + str_replace("(?i)interstitial", "interstitial_cell") |> + str_replace("(?i)neuroendocrine", "neuroendocrine_cell") |> + str_replace("(?i)granular", "granular_cell") |> + str_replace("(?i)kidney", "kidney_cell") |> + str_replace("(?i)paneth", "paneth_cell") |> + str_replace("(?i)bipolar", "bipolar_cell") |> + str_replace_all(" ", "_") } @@ -1363,7 +1529,7 @@ harmonise_names_non_immune = function(metadata){ metadata$cell_type_harmonised <- ifelse(grepl("myoblast", metadata$cell_type_harmonised, ignore.case=TRUE), "myoblast", ## Discussed with Stefano on Teams on 16/12/2022. metadata$cell_type_harmonised) - + metadata$cell_type_harmonised <- ifelse(grepl("satellite", metadata$cell_type_harmonised, ignore.case=TRUE), "satellite_cell", ## Discussed with Stefano on Teams on 16/12/2022. metadata$cell_type_harmonised) @@ -1436,7 +1602,7 @@ harmonise_names_non_immune = function(metadata){ metadata$cell_type_harmonised <- gsub(" " , "_", metadata$cell_type_harmonised) - + table(metadata$cell_type_harmonised[grepl("glial", metadata$cell_type_harmonised, ignore.case=TRUE)]) ## glial cell, microglial cell, radial glial cell ## https://www.simplypsychology.org/glial-cells.html#:~:text=Glial%20cells%20are%20a%20general,that%20keep%20the%20brain%20functioning. @@ -1452,648 +1618,648 @@ harmonise_names_non_immune = function(metadata){ metadata } -get_manually_curated_immune_cell_types = function(){ - - # library(zellkonverter) - # library(Seurat) - # library(SingleCellExperiment) # load early to avoid masking dplyr::count() - # library(tidySingleCellExperiment) - # library(dplyr) - # library(cellxgenedp) - # library(tidyverse) - #library(tidySingleCellExperiment) - # library(stringr) - # library(scMerge) - # library(glue) - # library(tidyseurat) - # library(celldex) - # library(SingleR) - # library(glmGamPoi) - # library(stringr) - # library(purrr) - - - #Fix GCHECKS - metadata_file = NULL - .cell = NULL - cell_type = NULL - file_id = NULL - .sample = NULL - azhimut_confirmed = NULL - blueprint_confirmed <- NULL - arrange <- NULL # This one is actually a function from dplyr, so you should use it with dplyr::arrange or import it - cell_type_clean <- NULL - blueprint_singler <- NULL - predicted.celltype.l2 <- NULL - strong_evidence <- NULL - cell_type_harmonised <- NULL - confidence_class <- NULL - lineage_1 <- NULL - monaco_singler <- NULL - cell_annotation_monaco_singler <- NULL - cell_annotation_azimuth_l2 <- NULL - cell_annotation_blueprint_singler <- NULL - confidence_class_manually_curated <- NULL - cell_type_harmonised_manually_curated <- NULL - file_curated_annotation_merged <- NULL - .sample <- NULL - cell_type_harmonised_non_immune <- NULL - - # library(zellkonverter) - # library(Seurat) - # library(SingleCellExperiment) # load early to avoid masking dplyr::count() - # library(tidySingleCellExperiment) - # library(dplyr) - # library(cellxgenedp) - # library(tidyverse) - # #library(tidySingleCellExperiment) - # library(stringr) - # library(scMerge) - # library(glue) - # library(DelayedArray) - # library(HDF5Array) - # library(tidyseurat) - # library(celldex) - # library(SingleR) - # library(glmGamPoi) - # library(stringr) - # library(purrr) - - # # source("utility.R") - # - # metadata_file = "/vast/projects/cellxgene_curated//metadata_0.2.rds" - # file_curated_annotation_merged = "~/PostDoc/CuratedAtlasQueryR/dev/cell_type_curated_annotation_0.2.3.rds" - # file_metadata_annotated = "/vast/projects/cellxgene_curated/metadata_annotated_0.2.3.rds" - # annotation_directory = "/vast/projects/cellxgene_curated//annotated_data_0.2/" - # - # # metadata_file = "/vast/projects/cellxgene_curated//metadata.rds" - # # file_curated_annotation_merged = "~/PostDoc/CuratedAtlasQueryR/dev/cell_type_curated_annotation.rds" - # # file_metadata_annotated = "/vast/projects/cellxgene_curated//metadata_annotated.rds" - # # annotation_directory = "/vast/projects/cellxgene_curated//annotated_data_0.1/" - # - # - # annotation_harmonised = - # dir(annotation_directory, full.names = TRUE) |> - # enframe(value="file") |> - # tidyr::extract( file,".sample", "/([a-z0-9]+)\\.rds", remove = F) |> - # mutate(data = map(file, ~ .x |> readRDS() |> select(-contains("score")) )) |> - # unnest(data) |> - # - # # Format - # mutate(across(c(predicted.celltype.l1, predicted.celltype.l2, blueprint_singler, monaco_singler, ), tolower )) |> - # mutate(across(c(predicted.celltype.l1, predicted.celltype.l2, blueprint_singler, monaco_singler, ), clean_cell_types )) |> - # - # # Format - # is_strong_evidence(predicted.celltype.l2, blueprint_singler) |> - # - # - # - # - # job::job({ - # annotation_harmonised |> saveRDS("~/PostDoc/CuratedAtlasQueryR/dev/annotated_data_0.2_temp_table.rds") - # }) - # - - annotation_harmonised = readRDS("~/PostDoc/CuratedAtlasQueryR/dev/annotated_data_0.2_temp_table.rds") - - # library(CuratedAtlasQueryR) - metadata_df = readRDS(metadata_file) - - # Integrate with metadata - - annotation = - metadata_df |> - select(.cell, cell_type, file_id, .sample) |> - as_tibble() |> - left_join(read_csv("~/PostDoc/CuratedAtlasQueryR/dev/metadata_cell_type.csv"), by = "cell_type") |> - left_join(annotation_harmonised, by = c(".cell", ".sample")) |> - - # Clen cell types - mutate(cell_type_clean = cell_type |> clean_cell_types()) - - # annotation |> - # filter(lineage_1=="immune") |> - # count(cell_type, predicted.celltype.l2, blueprint_singler, strong_evidence) |> - # arrange(!strong_evidence, desc(n)) |> - # write_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm.csv") - - - annotation_crated_confirmed = - read_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm_manually_curated.csv") |> - - # TEMPORARY - rename(cell_type_clean = cell_type) |> - - filter(!is.na(azhimut_confirmed) | !is.na(blueprint_confirmed)) |> - filter(azhimut_confirmed + blueprint_confirmed > 0) |> - - # Format - mutate(cell_type_harmonised = case_when( - azhimut_confirmed ~ predicted.celltype.l2, - blueprint_confirmed ~ blueprint_singler - )) |> - - mutate(confidence_class = 1) - - - - # To avoid immune cell annotation if very contrasting evidence - blueprint_definitely_non_immune = c( "astrocytes" , "chondrocytes" , "endothelial" , "epithelial" , "fibros" , "keratinocytes" , "melanocytes" , "mesangial" , "mv endothelial", "myocytes" , "neurons" , "pericytes" , "preadipocytes" , "skeletal muscle" , "smooth muscle" ) - - - - annotation_crated_UNconfirmed = - - # Read - read_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm_manually_curated.csv") |> - - # TEMPORARY - rename(cell_type_clean = cell_type) |> - - filter(is.na(azhimut_confirmed) | (azhimut_confirmed + blueprint_confirmed) == 0) |> - - clean_cell_types_deeper() |> - - mutate(cell_type_harmonised = "") |> - - # Classify strong evidence - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("cd8 cytokine secreting tem t") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("cd8 cytotoxic t") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("cd8alphaalpha intraepithelial t") & predicted.celltype.l2 == "cd8 tem" & blueprint_singler == "cd8 tem", T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("mature t") & strong_evidence & predicted.celltype.l2 |> str_detect("tem|tcm"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("myeloid") & strong_evidence & predicted.celltype.l2 == "cd16 mono", T, azhimut_confirmed) ) |> - - # Classify weak evidence - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("b", "B") & predicted.celltype.l2 == "b memory" & blueprint_singler == "classswitched memory b", T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("b", "B") & predicted.celltype.l2 %in% c("b memory", "b intermediate", "b naive", "plasma") & !blueprint_singler %in% c("classswitched memory b", "memory b", "naive b"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("b", "B") & !predicted.celltype.l2 %in% c("b memory", "b intermediate", "b naive") & blueprint_singler %in% c("classswitched memory b", "memory b", "naive b", "plasma"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "activated cd4" & predicted.celltype.l2 %in% c("cd4 tcm", "cd4 tem", "tregs"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "activated cd4" & blueprint_singler %in% c("cd4 tcm", "cd4 tem", "tregs"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "activated cd8" & predicted.celltype.l2 %in% c("cd8 tcm", "cd8 tem"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "activated cd8" & blueprint_singler %in% c("cd8 tcm", "cd8 tem"), T, blueprint_confirmed) ) |> - - # Monocyte macrophage - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 cd16 monocyte" & predicted.celltype.l2 %in% c("cd14 mono", "cd16 mono"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 cd16negative classical monocyte" & predicted.celltype.l2 %in% c("cd14 mono"), T, azhimut_confirmed) ) |> - mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14 cd16negative classical monocyte" & blueprint_singler %in% c("monocytes"), "cd14 mono", cell_type_harmonised) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 monocyte" & predicted.celltype.l2 %in% c("cd14 mono"), T, azhimut_confirmed) ) |> - mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14 monocyte" & blueprint_singler %in% c("monocytes"), "cd14 mono", cell_type_harmonised) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14low cd16 monocyte" & predicted.celltype.l2 %in% c("cd16 mono"), T, azhimut_confirmed) ) |> - mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14low cd16 monocyte" & blueprint_singler %in% c("monocytes"), "cd16 mono", cell_type_harmonised) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd16 monocyte" & predicted.celltype.l2 %in% c("cd16 mono"), T, azhimut_confirmed) ) |> - mutate(cell_type_harmonised = if_else(cell_type_clean == "cd16 monocyte" & blueprint_singler %in% c("monocytes"), "cd16 mono", cell_type_harmonised) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "monocyte" & blueprint_singler |> str_detect("monocyte|macrophage") & !predicted.celltype.l2 |> str_detect(" mono"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "monocyte" & predicted.celltype.l2 |> str_detect(" mono"), T, azhimut_confirmed) ) |> - - - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd4" & predicted.celltype.l2 |> str_detect("cd4|treg") & !blueprint_singler |> str_detect("cd4"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "cd4" & !predicted.celltype.l2 |> str_detect("cd4") & blueprint_singler |> str_detect("cd4|treg"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> - - - mutate(azhimut_confirmed = if_else(cell_type_clean == "memory t" & predicted.celltype.l2 |> str_detect("tem|tcm") & !blueprint_singler |> str_detect("tem|tcm"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "memory t" & !predicted.celltype.l2 |> str_detect("tem|tcm") & blueprint_singler |> str_detect("tem|tcm"), T, blueprint_confirmed) ) |> - - - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8alphaalpha intraepithelial t" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8alphaalpha intraepithelial t" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8hymocyte" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8hymocyte" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> - - # B cells - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("memory b") & predicted.celltype.l2 =="b memory", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("memory b") & blueprint_singler |> str_detect("memory b"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "immature b" & predicted.celltype.l2 =="b naive", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "immature b" & blueprint_singler |> str_detect("naive b"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "mature b" & predicted.celltype.l2 %in% c("b memory", "b intermediate"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "mature b" & blueprint_singler |> str_detect("memory b"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "naive b" & predicted.celltype.l2 %in% c("b naive"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "naive b" & blueprint_singler |> str_detect("naive b"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "transitional stage b" & predicted.celltype.l2 %in% c("b intermediate"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "transitional stage b" & blueprint_singler |> str_detect("naive b") & !predicted.celltype.l2 %in% c("b intermediate"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "memory b" & predicted.celltype.l2 %in% c("b intermediate"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & predicted.celltype.l2 %in% c("b naive") & !blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & blueprint_singler |> str_detect("naive b") & predicted.celltype.l2 %in% c("hspc"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & predicted.celltype.l2 %in% c("hspc"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> - - # Plasma cells - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "plasma") & predicted.celltype.l2 == "plasma" , T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "plasma") & predicted.celltype.l2 == "plasma" , T, blueprint_confirmed) ) |> - - mutate(azhimut_confirmed = case_when( - cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & predicted.celltype.l2 == "cd4 ctl" & blueprint_singler != "cd4 tcm" ~ T, - cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & predicted.celltype.l2 == "cd4 tem" & blueprint_singler != "cd4 tcm" ~ T, - TRUE ~ azhimut_confirmed - ) ) |> - mutate(blueprint_confirmed = case_when( - cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & blueprint_singler == "cd4 tem" & predicted.celltype.l2 != "cd4 tcm" ~ T, - cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & blueprint_singler == "cd4 t" & predicted.celltype.l2 != "cd4 tcm" ~ T, - TRUE ~ blueprint_confirmed - ) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean == "cd4hymocyte" & predicted.celltype.l2 |> str_detect("cd4|treg") & !blueprint_singler |> str_detect("cd4"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "cd4hymocyte" & !predicted.celltype.l2 |> str_detect("cd4") & blueprint_singler |> str_detect("cd4|treg"), T, blueprint_confirmed) ) |> - - mutate(azhimut_confirmed = case_when( - cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 == "cd8 tem" & blueprint_singler != "cd8 tcm" ~ T, - cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 == "cd8 tcm" & blueprint_singler != "cd8 tem" ~ T, - TRUE ~ azhimut_confirmed - ) ) |> - mutate(blueprint_confirmed = case_when( - cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 != "cd8 tem" & blueprint_singler == "cd8 tcm" ~ T, - cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 != "cd8 tcm" & blueprint_singler == "cd8 tem" ~ T, - TRUE ~ blueprint_confirmed - ) ) |> - - mutate(azhimut_confirmed = case_when( - cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 == "cd4 tem" & blueprint_singler != "cd8 tcm" ~ T, - cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 == "cd4 tcm" & blueprint_singler != "cd8 tem" ~ T, - TRUE ~ azhimut_confirmed - ) ) |> - mutate(blueprint_confirmed = case_when( - cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 != "cd4 tem" & blueprint_singler == "cd4 tcm" ~ T, - cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 != "cd4 tcm" & blueprint_singler == "cd4 tem" ~ T, - TRUE ~ blueprint_confirmed - ) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "t") & blueprint_singler =="cd8 t" & predicted.celltype.l2 |> str_detect("cd8"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "t") & blueprint_singler =="cd4 t" & predicted.celltype.l2 |> str_detect("cd4|treg"), T, azhimut_confirmed) ) |> - - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "treg") & blueprint_singler %in% c("tregs"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "treg") & predicted.celltype.l2 == "treg", T, azhimut_confirmed) ) |> - - - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tcm cd4") & blueprint_singler %in% c("cd4 tcm"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tcm cd4") & predicted.celltype.l2 == "cd4 tcm", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tcm cd8") & blueprint_singler %in% c("cd8 tcm"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tcm cd8") & predicted.celltype.l2 == "cd8 tcm", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tem cd4") & blueprint_singler %in% c("cd4 tem"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tem cd4") & predicted.celltype.l2 == "cd4 tem", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tem cd8") & blueprint_singler %in% c("cd8 tem"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tem cd8") & predicted.celltype.l2 == "cd8 tem", T, azhimut_confirmed) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tgd") & predicted.celltype.l2 == "gdt", T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "activated cd4") & predicted.celltype.l2 == "cd4 proliferating", T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "activated cd8") & predicted.celltype.l2 == "cd8 proliferating", T, azhimut_confirmed) ) |> - - - - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("naive cd4", "naive t") & predicted.celltype.l2 %in% c("cd4 naive"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("naive cd8", "naive t") & predicted.celltype.l2 %in% c("cd8 naive"), T, azhimut_confirmed) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("cd4 naive") & !blueprint_singler |> str_detect("clp|hcs|mpp|cd8"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("cd8 naive") & !blueprint_singler |> str_detect("clp|hcs|mpp|cd4"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("hspc"), T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "prot") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> - - mutate(azhimut_confirmed = if_else(cell_type_clean == "dendritic" & predicted.celltype.l2 %in% c("asdc", "cdc2", "cdc1", "pdc"), T, azhimut_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "double negative t regulatory" & predicted.celltype.l2 == "dnt", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "early t lineage precursor", "immature innate lymphoid") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "early t lineage precursor", "immature innate lymphoid") & predicted.celltype.l2 == "hspc" & blueprint_singler != "clp", T, azhimut_confirmed) ) |> - - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("ilc1", "ilc2", "innate lymphoid") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("ilc1", "ilc2", "innate lymphoid") & predicted.celltype.l2 %in% c( "nk", "ilc", "nk proliferating"), T, azhimut_confirmed) ) |> - - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "immature t") & blueprint_singler %in% c("naive t"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "immature t") & predicted.celltype.l2 == "t naive", T, azhimut_confirmed) ) |> - - mutate(cell_type_harmonised = if_else(cell_type_clean == "fraction a prepro b", "naive b", cell_type_harmonised)) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == "granulocyte" & blueprint_singler %in% c("eosinophils", "neutrophils"), T, blueprint_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("immature neutrophil", "neutrophil") & blueprint_singler %in% c( "neutrophils"), T, blueprint_confirmed) ) |> - - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("megakaryocyte") & blueprint_singler |> str_detect("megakaryocyte"), T, blueprint_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("macrophage") & blueprint_singler |> str_detect("macrophage"), T, blueprint_confirmed) ) |> - - mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "nk") & blueprint_singler %in% c("nk"), T, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "nk") & predicted.celltype.l2 %in% c("nk", "nk proliferating", "nk_cd56bright", "ilc"), T, azhimut_confirmed) ) |> - - - # If identical force - mutate(azhimut_confirmed = if_else(cell_type_clean == predicted.celltype.l2 , T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean == blueprint_singler , T, blueprint_confirmed) ) |> - - # Perogenitor - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("progenitor|hematopoietic|precursor") & predicted.celltype.l2 == "hspc", T, azhimut_confirmed) ) |> - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("progenitor|hematopoietic|precursor") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> - - # Generic original annotation and stem for new annotations - mutate(azhimut_confirmed = if_else( - cell_type_clean %in% c("T cell", "myeloid cell", "leukocyte", "myeloid leukocyte", "B cell") & - predicted.celltype.l2 == "hspc" & - blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, azhimut_confirmed) ) |> - - # Omit mature for stem - mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("mature") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), F, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("mature") & predicted.celltype.l2 == "hspc", F, azhimut_confirmed) ) |> - - # Omit megacariocyte for stem - mutate(blueprint_confirmed = if_else(cell_type_clean == "megakaryocyte" & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), F, blueprint_confirmed) ) |> - mutate(azhimut_confirmed = if_else(cell_type_clean == "megakaryocyte" & predicted.celltype.l2 == "hspc", F, azhimut_confirmed) ) |> - - # Mast cells - mutate(cell_type_harmonised = if_else(cell_type_clean == "mast", "mast", cell_type_harmonised)) |> - - - # Visualise - #distinct(cell_type_clean, predicted.celltype.l2, blueprint_singler, strong_evidence, azhimut_confirmed, blueprint_confirmed) |> - arrange(!strong_evidence, cell_type_clean) |> - - # set cell names - mutate(cell_type_harmonised = case_when( - cell_type_harmonised == "" & azhimut_confirmed ~ predicted.celltype.l2, - cell_type_harmonised == "" & blueprint_confirmed ~ blueprint_singler, - TRUE ~ cell_type_harmonised - )) |> - - # Add NA - mutate(cell_type_harmonised = case_when(cell_type_harmonised != "" ~ cell_type_harmonised)) |> - - # Add unannotated cells because datasets were too small - mutate(cell_type_harmonised = case_when( - is.na(cell_type_harmonised) & cell_type_clean |> str_detect("progenitor|hematopoietic|stem|precursor") ~ "stem", - - is.na(cell_type_harmonised) & cell_type_clean == "cd14 monocyte" ~ "cd14 mono", - is.na(cell_type_harmonised) & cell_type_clean == "cd16 monocyte" ~ "cd16 mono", - is.na(cell_type_harmonised) & cell_type_clean %in% c("cd4 cytotoxic t", "tem cd4") ~ "cd4 tem", - is.na(cell_type_harmonised) & cell_type_clean %in% c("cd8 cytotoxic t", "tem cd8") ~ "cd8 tem", - is.na(cell_type_harmonised) & cell_type_clean |> str_detect("macrophage") ~ "macrophage", - is.na(cell_type_harmonised) & cell_type_clean %in% c("mature b", "memory b", "transitional stage b") ~ "b memory", - is.na(cell_type_harmonised) & cell_type_clean == "mucosal invariant t" ~ "mait", - is.na(cell_type_harmonised) & cell_type_clean == "naive b" ~ "b naive", - is.na(cell_type_harmonised) & cell_type_clean == "nk" ~ "nk", - is.na(cell_type_harmonised) & cell_type_clean == "naive cd4" ~"cd4 naive", - is.na(cell_type_harmonised) & cell_type_clean == "naive cd8" ~"cd8 naive", - is.na(cell_type_harmonised) & cell_type_clean == "treg" ~ "treg", - is.na(cell_type_harmonised) & cell_type_clean == "tgd" ~ "tgd", - TRUE ~ cell_type_harmonised - )) |> - - mutate(confidence_class = case_when( - !is.na(cell_type_harmonised) & strong_evidence ~ 2, - !is.na(cell_type_harmonised) & !strong_evidence ~ 3 - )) |> - - # Lowest grade annotation UNreliable - mutate(cell_type_harmonised = case_when( - - # Get origincal annotation - is.na(cell_type_harmonised) & cell_type_clean %in% c("neutrophil", "granulocyte") ~ cell_type_clean, - is.na(cell_type_harmonised) & cell_type_clean %in% c("conventional dendritic", "dendritic") ~ "cdc", - is.na(cell_type_harmonised) & cell_type_clean %in% c("classical monocyte") ~ "cd14 mono", - - # Get Seurat annotation - is.na(cell_type_harmonised) & predicted.celltype.l2 != "eryth" & !is.na(predicted.celltype.l2) ~ predicted.celltype.l2, - is.na(cell_type_harmonised) & !blueprint_singler %in% c( - "astrocytes", "smooth muscle", "preadipocytes", "mesangial", "myocytes", - "doublet", "melanocytes", "chondrocytes", "mv endothelial", "fibros", - "neurons", "keratinocytes", "endothelial", "epithelial", "skeletal muscle", "pericytes", "erythrocytes", "adipocytes" - ) & !is.na(blueprint_singler) ~ blueprint_singler, - TRUE ~ cell_type_harmonised - - )) |> - - # Lowest grade annotation UNreliable - mutate(cell_type_harmonised = case_when( - - # Get origincal annotation - !cell_type_harmonised %in% c("doublet", "platelet") ~ cell_type_harmonised - - )) |> - - mutate(confidence_class = case_when( - is.na(confidence_class) & !is.na(cell_type_harmonised) ~ 4, - TRUE ~ confidence_class - )) - - # Another passage - - # annotated_samples = annotation_crated_UNconfirmed |> filter(!is.na(cell_type_harmonised)) |> distinct( cell_type, .sample, file_id) - # - # annotation_crated_UNconfirmed |> - # filter(is.na(cell_type_harmonised)) |> - # count(cell_type , cell_type_harmonised ,predicted.celltype.l2 ,blueprint_singler) |> - # arrange(desc(n)) |> - # print(n=99) - - - annotation_all = - annotation_crated_confirmed |> - clean_cell_types_deeper() |> - bind_rows( - annotation_crated_UNconfirmed - ) |> - - # I have multiple confidence_class per combination of labels - distinct() |> - with_groups(c(cell_type_clean, predicted.celltype.l2, blueprint_singler), ~ .x |> arrange(confidence_class) |> slice(1)) |> - - # Simplify after harmonisation - mutate(cell_type_harmonised = case_when( - cell_type_harmonised %in% c("b memory", "b intermediate", "classswitched memory b", "memory b" ) ~ "b memory", - cell_type_harmonised %in% c("b naive", "naive b") ~ "b naive", - cell_type_harmonised %in% c("nk_cd56bright", "nk", "nk proliferating", "ilc") ~ "ilc", - cell_type_harmonised %in% c("mpp", "clp", "hspc", "mep", "cmp", "hsc", "gmp") ~ "stem", - cell_type_harmonised %in% c("macrophages", "macrophages m1", "macrophages m2") ~ "macrophage", - cell_type_harmonised %in% c("treg", "tregs") ~ "treg", - cell_type_harmonised %in% c("gdt", "tgd") ~ "tgd", - cell_type_harmonised %in% c("cd8 proliferating", "cd8 tem") ~ "cd8 tem", - cell_type_harmonised %in% c("cd4 proliferating", "cd4 tem") ~ "cd4 tem", - cell_type_harmonised %in% c("eosinophils", "neutrophils", "granulocyte", "neutrophil") ~ "granulocyte", - cell_type_harmonised %in% c("cdc", "cdc1", "cdc2", "dc") ~ "cdc", - - TRUE ~ cell_type_harmonised - )) |> - dplyr::select(cell_type_clean, cell_type_harmonised, predicted.celltype.l2, blueprint_singler, confidence_class) |> - distinct() - - - curated_annotation = - annotation |> - clean_cell_types_deeper() |> - filter(lineage_1=="immune") |> - dplyr::select( - .cell, .sample, cell_type, cell_type_clean, predicted.celltype.l2, blueprint_singler, monaco_singler) |> - left_join( - annotation_all , - by = c("cell_type_clean", "predicted.celltype.l2", "blueprint_singler") - ) |> - dplyr::select( - .cell, .sample, cell_type, cell_type_harmonised, confidence_class, - cell_annotation_azimuth_l2 = predicted.celltype.l2, cell_annotation_blueprint_singler = blueprint_singler, - cell_annotation_monaco_singler = monaco_singler - ) |> - - # Reannotation of generic cell types - mutate(cell_type_harmonised = case_when( - cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("effector memory") ~ "cd4 tem", - cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("mait") ~ "mait", - cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("central memory") ~ "cd4 tcm", - cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("naive") ~ "cd4 naive", - cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("effector memory") ~ "cd8 tem", - cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("central memory") ~ "cd8 tcm", - cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("naive") ~ "cd8 naive", - cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler |> str_detect("non classical") ~ "cd16 mono", - cell_type == "nonclassical monocyte" & cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="intermediate monocytes" ~ "cd16 mono", - cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler |> str_detect("^classical") ~ "cd14 mono", - cell_type == "classical monocyte" & cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="intermediate monocytes" ~ "cd14 mono", - cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="myeloid dendritic" & str_detect(cell_annotation_azimuth_l2, "cdc") ~ "cdc", - - - TRUE ~ cell_type_harmonised - )) |> - - # Change CD4 classification for version 0.2.1 - mutate(confidence_class = if_else( - cell_type_harmonised |> str_detect("cd4|mait|treg|tgd") & cell_annotation_monaco_singler %in% c("terminal effector cd4 t", "naive cd4 t", "th2", "th17", "t regulatory", "follicular helper t", "th1/th17", "th1", "nonvd2 gd t", "vd2 gd t"), - 3, - confidence_class - )) |> - - # Change CD4 classification for version 0.2.1 - mutate(cell_type_harmonised = if_else( - cell_type_harmonised |> str_detect("cd4|mait|treg|tgd") & cell_annotation_monaco_singler %in% c("terminal effector cd4 t", "naive cd4 t", "th2", "th17", "t regulatory", "follicular helper t", "th1/th17", "th1", "nonvd2 gd t", "vd2 gd t"), - cell_annotation_monaco_singler, - cell_type_harmonised - )) |> - - - mutate(cell_type_harmonised = cell_type_harmonised |> - str_replace("naive cd4 t", "cd4 naive") |> - str_replace("th2", "cd4 th2") |> - str_replace("^th17$", "cd4 th17") |> - str_replace("t regulatory", "treg") |> - str_replace("follicular helper t", "cd4 fh") |> - str_replace("th1/th17", "cd4 th1/th17") |> - str_replace("^th1$", "cd4 th1") |> - str_replace("nonvd2 gd t", "tgd") |> - str_replace("vd2 gd t", "tgd") - ) |> - - # add immune_unclassified - mutate(cell_type_harmonised = if_else(cell_type_harmonised == "monocytes", "immune_unclassified", cell_type_harmonised)) |> - mutate(cell_type_harmonised = if_else(is.na(cell_type_harmonised), "immune_unclassified", cell_type_harmonised)) |> - mutate(confidence_class = if_else(is.na(confidence_class), 5, confidence_class)) |> - - # drop uncommon cells - mutate(cell_type_harmonised = if_else(cell_type_harmonised %in% c("cd4 t", "cd8 t", "asdc", "cd4 ctl"), "immune_unclassified", cell_type_harmonised)) - - - # Further rescue of unannotated cells, manually - - # curated_annotation |> - # filter(cell_type_harmonised == "immune_unclassified") |> - # count(cell_type , cell_type_harmonised ,confidence_class ,cell_annotation_azimuth_l2 ,cell_annotation_blueprint_singler ,cell_annotation_monaco_singler) |> - # arrange(desc(n)) |> - # write_csv("curated_annotation_still_unannotated_0.2.csv") - - - curated_annotation = - curated_annotation |> - left_join( - read_csv("~/PostDoc/CuratedAtlasQueryR/dev/curated_annotation_still_unannotated_0.2_manually_labelled.csv") |> - select(cell_type, cell_type_harmonised_manually_curated = cell_type_harmonised, confidence_class_manually_curated = confidence_class, everything()), - by = join_by(cell_type, cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler) - ) |> - mutate( - confidence_class = if_else(cell_type_harmonised == "immune_unclassified", confidence_class_manually_curated, confidence_class), - cell_type_harmonised = if_else(cell_type_harmonised == "immune_unclassified", cell_type_harmonised_manually_curated, cell_type_harmonised), - ) |> - select(-contains("manually_curated"), -n) |> - - # drop uncommon cells - mutate(cell_type_harmonised = if_else(cell_type_harmonised %in% c("cd4 tcm", "cd4 tem"), "immune_unclassified", cell_type_harmonised)) - - - - # # Recover confidence class == 4 - - # curated_annotation |> - # filter(confidence_class==4) |> - # count(cell_type , cell_type_harmonised ,confidence_class ,cell_annotation_azimuth_l2 ,cell_annotation_blueprint_singler ,cell_annotation_monaco_singler) |> - # arrange(desc(n)) |> - # write_csv("curated_annotation_still_unannotated_0.2_confidence_class_4.csv") - - curated_annotation = - curated_annotation |> - left_join( - read_csv("~/PostDoc/CuratedAtlasQueryR/dev/curated_annotation_still_unannotated_0.2_confidence_class_4_manually_labelled.csv") |> - select(confidence_class_manually_curated = confidence_class, everything()), - by = join_by(cell_type, cell_type_harmonised, cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler) - ) |> - mutate( - confidence_class = if_else(confidence_class == 4 & !is.na(confidence_class_manually_curated), confidence_class_manually_curated, confidence_class) - ) |> - select(-contains("manually_curated"), -n) - - # Correct fishy stem cell labelling - # If stem for the study's annotation and blueprint is non-immune it is probably wrong, - # even because the heart has too many progenitor/stem - curated_annotation = - curated_annotation |> - mutate(confidence_class = case_when( - cell_type_harmonised == "stem" & cell_annotation_blueprint_singler %in% c( - "skeletal muscle", "adipocytes", "epithelial", "smooth muscle", "chondrocytes", "endothelial" - ) ~ 5, - TRUE ~ confidence_class - )) - - - curated_annotation_merged = - - # Fix cell ID - metadata_df |> - dplyr::select(.cell, .sample, cell_type) |> - as_tibble() |> - - # Add cell type - left_join(curated_annotation |> dplyr::select(-cell_type), by = c(".cell", ".sample")) |> - - # Add non immune - mutate(cell_type_harmonised = if_else(is.na(cell_type_harmonised), "non_immune", cell_type_harmonised)) |> - mutate(confidence_class = if_else(is.na(confidence_class) & cell_type_harmonised == "non_immune", 1, confidence_class)) |> - - # For some unknown reason - distinct() - - - curated_annotation_merged |> - - # Save - saveRDS(file_curated_annotation_merged) - - metadata_annotated = - curated_annotation_merged |> - - # merge with the rest of metadata - left_join( - metadata_df |> - as_tibble(), - by=c(".cell", ".sample", "cell_type") - ) - - # Replace `.` with `_` for all column names as it can create difficoulties for MySQL and Python - colnames(metadata_annotated) = colnames(metadata_annotated) |> str_replace_all("\\.", "_") - metadata_annotated = metadata_annotated |> rename(cell_ = `_cell`, sample_ = `_sample`) - - - dictionary_connie_non_immune = - metadata_annotated |> - filter(cell_type_harmonised == "non_immune") |> - distinct(cell_type) |> - harmonise_names_non_immune() |> - rename(cell_type_harmonised_non_immune = cell_type_harmonised ) - - metadata_annotated = - metadata_annotated |> - left_join(dictionary_connie_non_immune) |> - mutate(cell_type_harmonised = if_else(cell_type_harmonised=="non_immune", cell_type_harmonised_non_immune, cell_type_harmonised)) |> - select(-cell_type_harmonised_non_immune) - - -} +# get_manually_curated_immune_cell_types = function(){ +# +# # library(zellkonverter) +# # library(Seurat) +# # library(SingleCellExperiment) # load early to avoid masking dplyr::count() +# # library(tidySingleCellExperiment) +# # library(dplyr) +# # library(cellxgenedp) +# # library(tidyverse) +# #library(tidySingleCellExperiment) +# # library(stringr) +# # library(scMerge) +# # library(glue) +# # library(tidyseurat) +# # library(celldex) +# # library(SingleR) +# # library(glmGamPoi) +# # library(stringr) +# # library(purrr) +# +# +# #Fix GCHECKS +# metadata_file = NULL +# .cell = NULL +# cell_type = NULL +# file_id = NULL +# .sample = NULL +# azhimut_confirmed = NULL +# blueprint_confirmed <- NULL +# arrange <- NULL # This one is actually a function from dplyr, so you should use it with dplyr::arrange or import it +# cell_type_clean <- NULL +# blueprint_singler <- NULL +# predicted.celltype.l2 <- NULL +# strong_evidence <- NULL +# cell_type_harmonised <- NULL +# confidence_class <- NULL +# lineage_1 <- NULL +# monaco_singler <- NULL +# cell_annotation_monaco_singler <- NULL +# cell_annotation_azimuth_l2 <- NULL +# cell_annotation_blueprint_singler <- NULL +# confidence_class_manually_curated <- NULL +# cell_type_harmonised_manually_curated <- NULL +# file_curated_annotation_merged <- NULL +# .sample <- NULL +# cell_type_harmonised_non_immune <- NULL +# +# # library(zellkonverter) +# # library(Seurat) +# # library(SingleCellExperiment) # load early to avoid masking dplyr::count() +# # library(tidySingleCellExperiment) +# # library(dplyr) +# # library(cellxgenedp) +# # library(tidyverse) +# # #library(tidySingleCellExperiment) +# # library(stringr) +# # library(scMerge) +# # library(glue) +# # library(DelayedArray) +# # library(HDF5Array) +# # library(tidyseurat) +# # library(celldex) +# # library(SingleR) +# # library(glmGamPoi) +# # library(stringr) +# # library(purrr) +# +# # # source("utility.R") +# # +# # metadata_file = "/vast/projects/cellxgene_curated//metadata_0.2.rds" +# # file_curated_annotation_merged = "~/PostDoc/CuratedAtlasQueryR/dev/cell_type_curated_annotation_0.2.3.rds" +# # file_metadata_annotated = "/vast/projects/cellxgene_curated/metadata_annotated_0.2.3.rds" +# # annotation_directory = "/vast/projects/cellxgene_curated//annotated_data_0.2/" +# # +# # # metadata_file = "/vast/projects/cellxgene_curated//metadata.rds" +# # # file_curated_annotation_merged = "~/PostDoc/CuratedAtlasQueryR/dev/cell_type_curated_annotation.rds" +# # # file_metadata_annotated = "/vast/projects/cellxgene_curated//metadata_annotated.rds" +# # # annotation_directory = "/vast/projects/cellxgene_curated//annotated_data_0.1/" +# # +# # +# # annotation_harmonised = +# # dir(annotation_directory, full.names = TRUE) |> +# # enframe(value="file") |> +# # tidyr::extract( file,".sample", "/([a-z0-9]+)\\.rds", remove = F) |> +# # mutate(data = map(file, ~ .x |> readRDS() |> select(-contains("score")) )) |> +# # unnest(data) |> +# # +# # # Format +# # mutate(across(c(predicted.celltype.l1, predicted.celltype.l2, blueprint_singler, monaco_singler, ), tolower )) |> +# # mutate(across(c(predicted.celltype.l1, predicted.celltype.l2, blueprint_singler, monaco_singler, ), clean_cell_types )) |> +# # +# # # Format +# # is_strong_evidence(predicted.celltype.l2, blueprint_singler) |> +# # +# # +# # +# # +# # job::job({ +# # annotation_harmonised |> saveRDS("~/PostDoc/CuratedAtlasQueryR/dev/annotated_data_0.2_temp_table.rds") +# # }) +# # +# +# annotation_harmonised = readRDS("~/PostDoc/CuratedAtlasQueryR/dev/annotated_data_0.2_temp_table.rds") +# +# # library(CuratedAtlasQueryR) +# metadata_df = readRDS(metadata_file) +# +# # Integrate with metadata +# +# annotation = +# metadata_df |> +# select(.cell, cell_type, file_id, .sample) |> +# as_tibble() |> +# left_join(read_csv("~/PostDoc/CuratedAtlasQueryR/dev/metadata_cell_type.csv"), by = "cell_type") |> +# left_join(annotation_harmonised, by = c(".cell", ".sample")) |> +# +# # Clen cell types +# mutate(cell_type_clean = cell_type |> clean_cell_types()) +# +# # annotation |> +# # filter(lineage_1=="immune") |> +# # count(cell_type, predicted.celltype.l2, blueprint_singler, strong_evidence) |> +# # arrange(!strong_evidence, desc(n)) |> +# # write_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm.csv") +# +# +# annotation_crated_confirmed = +# read_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm_manually_curated.csv") |> +# +# # TEMPORARY +# rename(cell_type_clean = cell_type) |> +# +# filter(!is.na(azhimut_confirmed) | !is.na(blueprint_confirmed)) |> +# filter(azhimut_confirmed + blueprint_confirmed > 0) |> +# +# # Format +# mutate(cell_type_harmonised = case_when( +# azhimut_confirmed ~ predicted.celltype.l2, +# blueprint_confirmed ~ blueprint_singler +# )) |> +# +# mutate(confidence_class = 1) +# +# +# +# # To avoid immune cell annotation if very contrasting evidence +# blueprint_definitely_non_immune = c( "astrocytes" , "chondrocytes" , "endothelial" , "epithelial" , "fibros" , "keratinocytes" , "melanocytes" , "mesangial" , "mv endothelial", "myocytes" , "neurons" , "pericytes" , "preadipocytes" , "skeletal muscle" , "smooth muscle" ) +# +# +# +# annotation_crated_UNconfirmed = +# +# # Read +# read_csv("~/PostDoc/CuratedAtlasQueryR/dev/annotation_confirm_manually_curated.csv") |> +# +# # TEMPORARY +# rename(cell_type_clean = cell_type) |> +# +# filter(is.na(azhimut_confirmed) | (azhimut_confirmed + blueprint_confirmed) == 0) |> +# +# clean_cell_types_deeper() |> +# +# mutate(cell_type_harmonised = "") |> +# +# # Classify strong evidence +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("cd8 cytokine secreting tem t") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("cd8 cytotoxic t") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("cd8alphaalpha intraepithelial t") & predicted.celltype.l2 == "cd8 tem" & blueprint_singler == "cd8 tem", T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("mature t") & strong_evidence & predicted.celltype.l2 |> str_detect("tem|tcm"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("myeloid") & strong_evidence & predicted.celltype.l2 == "cd16 mono", T, azhimut_confirmed) ) |> +# +# # Classify weak evidence +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("b", "B") & predicted.celltype.l2 == "b memory" & blueprint_singler == "classswitched memory b", T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("b", "B") & predicted.celltype.l2 %in% c("b memory", "b intermediate", "b naive", "plasma") & !blueprint_singler %in% c("classswitched memory b", "memory b", "naive b"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("b", "B") & !predicted.celltype.l2 %in% c("b memory", "b intermediate", "b naive") & blueprint_singler %in% c("classswitched memory b", "memory b", "naive b", "plasma"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "activated cd4" & predicted.celltype.l2 %in% c("cd4 tcm", "cd4 tem", "tregs"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "activated cd4" & blueprint_singler %in% c("cd4 tcm", "cd4 tem", "tregs"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "activated cd8" & predicted.celltype.l2 %in% c("cd8 tcm", "cd8 tem"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "activated cd8" & blueprint_singler %in% c("cd8 tcm", "cd8 tem"), T, blueprint_confirmed) ) |> +# +# # Monocyte macrophage +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 cd16 monocyte" & predicted.celltype.l2 %in% c("cd14 mono", "cd16 mono"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 cd16negative classical monocyte" & predicted.celltype.l2 %in% c("cd14 mono"), T, azhimut_confirmed) ) |> +# mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14 cd16negative classical monocyte" & blueprint_singler %in% c("monocytes"), "cd14 mono", cell_type_harmonised) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14 monocyte" & predicted.celltype.l2 %in% c("cd14 mono"), T, azhimut_confirmed) ) |> +# mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14 monocyte" & blueprint_singler %in% c("monocytes"), "cd14 mono", cell_type_harmonised) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd14low cd16 monocyte" & predicted.celltype.l2 %in% c("cd16 mono"), T, azhimut_confirmed) ) |> +# mutate(cell_type_harmonised = if_else(cell_type_clean == "cd14low cd16 monocyte" & blueprint_singler %in% c("monocytes"), "cd16 mono", cell_type_harmonised) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd16 monocyte" & predicted.celltype.l2 %in% c("cd16 mono"), T, azhimut_confirmed) ) |> +# mutate(cell_type_harmonised = if_else(cell_type_clean == "cd16 monocyte" & blueprint_singler %in% c("monocytes"), "cd16 mono", cell_type_harmonised) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "monocyte" & blueprint_singler |> str_detect("monocyte|macrophage") & !predicted.celltype.l2 |> str_detect(" mono"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "monocyte" & predicted.celltype.l2 |> str_detect(" mono"), T, azhimut_confirmed) ) |> +# +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd4" & predicted.celltype.l2 |> str_detect("cd4|treg") & !blueprint_singler |> str_detect("cd4"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "cd4" & !predicted.celltype.l2 |> str_detect("cd4") & blueprint_singler |> str_detect("cd4|treg"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> +# +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "memory t" & predicted.celltype.l2 |> str_detect("tem|tcm") & !blueprint_singler |> str_detect("tem|tcm"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "memory t" & !predicted.celltype.l2 |> str_detect("tem|tcm") & blueprint_singler |> str_detect("tem|tcm"), T, blueprint_confirmed) ) |> +# +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8alphaalpha intraepithelial t" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8alphaalpha intraepithelial t" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd8hymocyte" & predicted.celltype.l2 |> str_detect("cd8") & !blueprint_singler |> str_detect("cd8"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "cd8hymocyte" & !predicted.celltype.l2 |> str_detect("cd8") & blueprint_singler |> str_detect("cd8"), T, blueprint_confirmed) ) |> +# +# # B cells +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("memory b") & predicted.celltype.l2 =="b memory", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("memory b") & blueprint_singler |> str_detect("memory b"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "immature b" & predicted.celltype.l2 =="b naive", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "immature b" & blueprint_singler |> str_detect("naive b"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "mature b" & predicted.celltype.l2 %in% c("b memory", "b intermediate"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "mature b" & blueprint_singler |> str_detect("memory b"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "naive b" & predicted.celltype.l2 %in% c("b naive"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "naive b" & blueprint_singler |> str_detect("naive b"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "transitional stage b" & predicted.celltype.l2 %in% c("b intermediate"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "transitional stage b" & blueprint_singler |> str_detect("naive b") & !predicted.celltype.l2 %in% c("b intermediate"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "memory b" & predicted.celltype.l2 %in% c("b intermediate"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & predicted.celltype.l2 %in% c("b naive") & !blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & blueprint_singler |> str_detect("naive b") & predicted.celltype.l2 %in% c("hspc"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & predicted.celltype.l2 %in% c("hspc"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "precursor b", "prob") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> +# +# # Plasma cells +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "plasma") & predicted.celltype.l2 == "plasma" , T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "plasma") & predicted.celltype.l2 == "plasma" , T, blueprint_confirmed) ) |> +# +# mutate(azhimut_confirmed = case_when( +# cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & predicted.celltype.l2 == "cd4 ctl" & blueprint_singler != "cd4 tcm" ~ T, +# cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & predicted.celltype.l2 == "cd4 tem" & blueprint_singler != "cd4 tcm" ~ T, +# TRUE ~ azhimut_confirmed +# ) ) |> +# mutate(blueprint_confirmed = case_when( +# cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & blueprint_singler == "cd4 tem" & predicted.celltype.l2 != "cd4 tcm" ~ T, +# cell_type_clean %in% c("cd4 cytotoxic t", "cd4 helper t") & blueprint_singler == "cd4 t" & predicted.celltype.l2 != "cd4 tcm" ~ T, +# TRUE ~ blueprint_confirmed +# ) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "cd4hymocyte" & predicted.celltype.l2 |> str_detect("cd4|treg") & !blueprint_singler |> str_detect("cd4"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "cd4hymocyte" & !predicted.celltype.l2 |> str_detect("cd4") & blueprint_singler |> str_detect("cd4|treg"), T, blueprint_confirmed) ) |> +# +# mutate(azhimut_confirmed = case_when( +# cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 == "cd8 tem" & blueprint_singler != "cd8 tcm" ~ T, +# cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 == "cd8 tcm" & blueprint_singler != "cd8 tem" ~ T, +# TRUE ~ azhimut_confirmed +# ) ) |> +# mutate(blueprint_confirmed = case_when( +# cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 != "cd8 tem" & blueprint_singler == "cd8 tcm" ~ T, +# cell_type_clean %in% c("cd8 memory t") & predicted.celltype.l2 != "cd8 tcm" & blueprint_singler == "cd8 tem" ~ T, +# TRUE ~ blueprint_confirmed +# ) ) |> +# +# mutate(azhimut_confirmed = case_when( +# cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 == "cd4 tem" & blueprint_singler != "cd8 tcm" ~ T, +# cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 == "cd4 tcm" & blueprint_singler != "cd8 tem" ~ T, +# TRUE ~ azhimut_confirmed +# ) ) |> +# mutate(blueprint_confirmed = case_when( +# cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 != "cd4 tem" & blueprint_singler == "cd4 tcm" ~ T, +# cell_type_clean %in% c("cd4 memory t") & predicted.celltype.l2 != "cd4 tcm" & blueprint_singler == "cd4 tem" ~ T, +# TRUE ~ blueprint_confirmed +# ) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "t") & blueprint_singler =="cd8 t" & predicted.celltype.l2 |> str_detect("cd8"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "t") & blueprint_singler =="cd4 t" & predicted.celltype.l2 |> str_detect("cd4|treg"), T, azhimut_confirmed) ) |> +# +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "treg") & blueprint_singler %in% c("tregs"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "treg") & predicted.celltype.l2 == "treg", T, azhimut_confirmed) ) |> +# +# +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tcm cd4") & blueprint_singler %in% c("cd4 tcm"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tcm cd4") & predicted.celltype.l2 == "cd4 tcm", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tcm cd8") & blueprint_singler %in% c("cd8 tcm"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tcm cd8") & predicted.celltype.l2 == "cd8 tcm", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tem cd4") & blueprint_singler %in% c("cd4 tem"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tem cd4") & predicted.celltype.l2 == "cd4 tem", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "tem cd8") & blueprint_singler %in% c("cd8 tem"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tem cd8") & predicted.celltype.l2 == "cd8 tem", T, azhimut_confirmed) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "tgd") & predicted.celltype.l2 == "gdt", T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "activated cd4") & predicted.celltype.l2 == "cd4 proliferating", T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "activated cd8") & predicted.celltype.l2 == "cd8 proliferating", T, azhimut_confirmed) ) |> +# +# +# +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("naive cd4", "naive t") & predicted.celltype.l2 %in% c("cd4 naive"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("naive cd8", "naive t") & predicted.celltype.l2 %in% c("cd8 naive"), T, azhimut_confirmed) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("cd4 naive") & !blueprint_singler |> str_detect("clp|hcs|mpp|cd8"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("cd8 naive") & !blueprint_singler |> str_detect("clp|hcs|mpp|cd4"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "prot") & predicted.celltype.l2 %in% c("hspc"), T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "prot") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> +# +# mutate(azhimut_confirmed = if_else(cell_type_clean == "dendritic" & predicted.celltype.l2 %in% c("asdc", "cdc2", "cdc1", "pdc"), T, azhimut_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "double negative t regulatory" & predicted.celltype.l2 == "dnt", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "early t lineage precursor", "immature innate lymphoid") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "early t lineage precursor", "immature innate lymphoid") & predicted.celltype.l2 == "hspc" & blueprint_singler != "clp", T, azhimut_confirmed) ) |> +# +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("ilc1", "ilc2", "innate lymphoid") & blueprint_singler == "nk", T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c("ilc1", "ilc2", "innate lymphoid") & predicted.celltype.l2 %in% c( "nk", "ilc", "nk proliferating"), T, azhimut_confirmed) ) |> +# +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "immature t") & blueprint_singler %in% c("naive t"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "immature t") & predicted.celltype.l2 == "t naive", T, azhimut_confirmed) ) |> +# +# mutate(cell_type_harmonised = if_else(cell_type_clean == "fraction a prepro b", "naive b", cell_type_harmonised)) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == "granulocyte" & blueprint_singler %in% c("eosinophils", "neutrophils"), T, blueprint_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c("immature neutrophil", "neutrophil") & blueprint_singler %in% c( "neutrophils"), T, blueprint_confirmed) ) |> +# +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("megakaryocyte") & blueprint_singler |> str_detect("megakaryocyte"), T, blueprint_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("macrophage") & blueprint_singler |> str_detect("macrophage"), T, blueprint_confirmed) ) |> +# +# mutate(blueprint_confirmed = if_else(cell_type_clean %in% c( "nk") & blueprint_singler %in% c("nk"), T, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean %in% c( "nk") & predicted.celltype.l2 %in% c("nk", "nk proliferating", "nk_cd56bright", "ilc"), T, azhimut_confirmed) ) |> +# +# +# # If identical force +# mutate(azhimut_confirmed = if_else(cell_type_clean == predicted.celltype.l2 , T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean == blueprint_singler , T, blueprint_confirmed) ) |> +# +# # Perogenitor +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("progenitor|hematopoietic|precursor") & predicted.celltype.l2 == "hspc", T, azhimut_confirmed) ) |> +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("progenitor|hematopoietic|precursor") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, blueprint_confirmed) ) |> +# +# # Generic original annotation and stem for new annotations +# mutate(azhimut_confirmed = if_else( +# cell_type_clean %in% c("T cell", "myeloid cell", "leukocyte", "myeloid leukocyte", "B cell") & +# predicted.celltype.l2 == "hspc" & +# blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), T, azhimut_confirmed) ) |> +# +# # Omit mature for stem +# mutate(blueprint_confirmed = if_else(cell_type_clean |> str_detect("mature") & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), F, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean |> str_detect("mature") & predicted.celltype.l2 == "hspc", F, azhimut_confirmed) ) |> +# +# # Omit megacariocyte for stem +# mutate(blueprint_confirmed = if_else(cell_type_clean == "megakaryocyte" & blueprint_singler %in% c("clp","hcs", "mpp", "gmp"), F, blueprint_confirmed) ) |> +# mutate(azhimut_confirmed = if_else(cell_type_clean == "megakaryocyte" & predicted.celltype.l2 == "hspc", F, azhimut_confirmed) ) |> +# +# # Mast cells +# mutate(cell_type_harmonised = if_else(cell_type_clean == "mast", "mast", cell_type_harmonised)) |> +# +# +# # Visualise +# #distinct(cell_type_clean, predicted.celltype.l2, blueprint_singler, strong_evidence, azhimut_confirmed, blueprint_confirmed) |> +# arrange(!strong_evidence, cell_type_clean) |> +# +# # set cell names +# mutate(cell_type_harmonised = case_when( +# cell_type_harmonised == "" & azhimut_confirmed ~ predicted.celltype.l2, +# cell_type_harmonised == "" & blueprint_confirmed ~ blueprint_singler, +# TRUE ~ cell_type_harmonised +# )) |> +# +# # Add NA +# mutate(cell_type_harmonised = case_when(cell_type_harmonised != "" ~ cell_type_harmonised)) |> +# +# # Add unannotated cells because datasets were too small +# mutate(cell_type_harmonised = case_when( +# is.na(cell_type_harmonised) & cell_type_clean |> str_detect("progenitor|hematopoietic|stem|precursor") ~ "stem", +# +# is.na(cell_type_harmonised) & cell_type_clean == "cd14 monocyte" ~ "cd14 mono", +# is.na(cell_type_harmonised) & cell_type_clean == "cd16 monocyte" ~ "cd16 mono", +# is.na(cell_type_harmonised) & cell_type_clean %in% c("cd4 cytotoxic t", "tem cd4") ~ "cd4 tem", +# is.na(cell_type_harmonised) & cell_type_clean %in% c("cd8 cytotoxic t", "tem cd8") ~ "cd8 tem", +# is.na(cell_type_harmonised) & cell_type_clean |> str_detect("macrophage") ~ "macrophage", +# is.na(cell_type_harmonised) & cell_type_clean %in% c("mature b", "memory b", "transitional stage b") ~ "b memory", +# is.na(cell_type_harmonised) & cell_type_clean == "mucosal invariant t" ~ "mait", +# is.na(cell_type_harmonised) & cell_type_clean == "naive b" ~ "b naive", +# is.na(cell_type_harmonised) & cell_type_clean == "nk" ~ "nk", +# is.na(cell_type_harmonised) & cell_type_clean == "naive cd4" ~"cd4 naive", +# is.na(cell_type_harmonised) & cell_type_clean == "naive cd8" ~"cd8 naive", +# is.na(cell_type_harmonised) & cell_type_clean == "treg" ~ "treg", +# is.na(cell_type_harmonised) & cell_type_clean == "tgd" ~ "tgd", +# TRUE ~ cell_type_harmonised +# )) |> +# +# mutate(confidence_class = case_when( +# !is.na(cell_type_harmonised) & strong_evidence ~ 2, +# !is.na(cell_type_harmonised) & !strong_evidence ~ 3 +# )) |> +# +# # Lowest grade annotation UNreliable +# mutate(cell_type_harmonised = case_when( +# +# # Get origincal annotation +# is.na(cell_type_harmonised) & cell_type_clean %in% c("neutrophil", "granulocyte") ~ cell_type_clean, +# is.na(cell_type_harmonised) & cell_type_clean %in% c("conventional dendritic", "dendritic") ~ "cdc", +# is.na(cell_type_harmonised) & cell_type_clean %in% c("classical monocyte") ~ "cd14 mono", +# +# # Get Seurat annotation +# is.na(cell_type_harmonised) & predicted.celltype.l2 != "eryth" & !is.na(predicted.celltype.l2) ~ predicted.celltype.l2, +# is.na(cell_type_harmonised) & !blueprint_singler %in% c( +# "astrocytes", "smooth muscle", "preadipocytes", "mesangial", "myocytes", +# "doublet", "melanocytes", "chondrocytes", "mv endothelial", "fibros", +# "neurons", "keratinocytes", "endothelial", "epithelial", "skeletal muscle", "pericytes", "erythrocytes", "adipocytes" +# ) & !is.na(blueprint_singler) ~ blueprint_singler, +# TRUE ~ cell_type_harmonised +# +# )) |> +# +# # Lowest grade annotation UNreliable +# mutate(cell_type_harmonised = case_when( +# +# # Get origincal annotation +# !cell_type_harmonised %in% c("doublet", "platelet") ~ cell_type_harmonised +# +# )) |> +# +# mutate(confidence_class = case_when( +# is.na(confidence_class) & !is.na(cell_type_harmonised) ~ 4, +# TRUE ~ confidence_class +# )) +# +# # Another passage +# +# # annotated_samples = annotation_crated_UNconfirmed |> filter(!is.na(cell_type_harmonised)) |> distinct( cell_type, .sample, file_id) +# # +# # annotation_crated_UNconfirmed |> +# # filter(is.na(cell_type_harmonised)) |> +# # count(cell_type , cell_type_harmonised ,predicted.celltype.l2 ,blueprint_singler) |> +# # arrange(desc(n)) |> +# # print(n=99) +# +# +# annotation_all = +# annotation_crated_confirmed |> +# clean_cell_types_deeper() |> +# bind_rows( +# annotation_crated_UNconfirmed +# ) |> +# +# # I have multiple confidence_class per combination of labels +# distinct() |> +# with_groups(c(cell_type_clean, predicted.celltype.l2, blueprint_singler), ~ .x |> arrange(confidence_class) |> slice(1)) |> +# +# # Simplify after harmonisation +# mutate(cell_type_harmonised = case_when( +# cell_type_harmonised %in% c("b memory", "b intermediate", "classswitched memory b", "memory b" ) ~ "b memory", +# cell_type_harmonised %in% c("b naive", "naive b") ~ "b naive", +# cell_type_harmonised %in% c("nk_cd56bright", "nk", "nk proliferating", "ilc") ~ "ilc", +# cell_type_harmonised %in% c("mpp", "clp", "hspc", "mep", "cmp", "hsc", "gmp") ~ "stem", +# cell_type_harmonised %in% c("macrophages", "macrophages m1", "macrophages m2") ~ "macrophage", +# cell_type_harmonised %in% c("treg", "tregs") ~ "treg", +# cell_type_harmonised %in% c("gdt", "tgd") ~ "tgd", +# cell_type_harmonised %in% c("cd8 proliferating", "cd8 tem") ~ "cd8 tem", +# cell_type_harmonised %in% c("cd4 proliferating", "cd4 tem") ~ "cd4 tem", +# cell_type_harmonised %in% c("eosinophils", "neutrophils", "granulocyte", "neutrophil") ~ "granulocyte", +# cell_type_harmonised %in% c("cdc", "cdc1", "cdc2", "dc") ~ "cdc", +# +# TRUE ~ cell_type_harmonised +# )) |> +# dplyr::select(cell_type_clean, cell_type_harmonised, predicted.celltype.l2, blueprint_singler, confidence_class) |> +# distinct() +# +# +# curated_annotation = +# annotation |> +# clean_cell_types_deeper() |> +# filter(lineage_1=="immune") |> +# dplyr::select( +# .cell, .sample, cell_type, cell_type_clean, predicted.celltype.l2, blueprint_singler, monaco_singler) |> +# left_join( +# annotation_all , +# by = c("cell_type_clean", "predicted.celltype.l2", "blueprint_singler") +# ) |> +# dplyr::select( +# .cell, .sample, cell_type, cell_type_harmonised, confidence_class, +# cell_annotation_azimuth_l2 = predicted.celltype.l2, cell_annotation_blueprint_singler = blueprint_singler, +# cell_annotation_monaco_singler = monaco_singler +# ) |> +# +# # Reannotation of generic cell types +# mutate(cell_type_harmonised = case_when( +# cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("effector memory") ~ "cd4 tem", +# cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("mait") ~ "mait", +# cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("central memory") ~ "cd4 tcm", +# cell_type_harmonised=="cd4 t" & cell_annotation_monaco_singler |> str_detect("naive") ~ "cd4 naive", +# cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("effector memory") ~ "cd8 tem", +# cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("central memory") ~ "cd8 tcm", +# cell_type_harmonised=="cd8 t" & cell_annotation_monaco_singler |> str_detect("naive") ~ "cd8 naive", +# cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler |> str_detect("non classical") ~ "cd16 mono", +# cell_type == "nonclassical monocyte" & cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="intermediate monocytes" ~ "cd16 mono", +# cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler |> str_detect("^classical") ~ "cd14 mono", +# cell_type == "classical monocyte" & cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="intermediate monocytes" ~ "cd14 mono", +# cell_type_harmonised=="monocytes" & cell_annotation_monaco_singler =="myeloid dendritic" & str_detect(cell_annotation_azimuth_l2, "cdc") ~ "cdc", +# +# +# TRUE ~ cell_type_harmonised +# )) |> +# +# # Change CD4 classification for version 0.2.1 +# mutate(confidence_class = if_else( +# cell_type_harmonised |> str_detect("cd4|mait|treg|tgd") & cell_annotation_monaco_singler %in% c("terminal effector cd4 t", "naive cd4 t", "th2", "th17", "t regulatory", "follicular helper t", "th1/th17", "th1", "nonvd2 gd t", "vd2 gd t"), +# 3, +# confidence_class +# )) |> +# +# # Change CD4 classification for version 0.2.1 +# mutate(cell_type_harmonised = if_else( +# cell_type_harmonised |> str_detect("cd4|mait|treg|tgd") & cell_annotation_monaco_singler %in% c("terminal effector cd4 t", "naive cd4 t", "th2", "th17", "t regulatory", "follicular helper t", "th1/th17", "th1", "nonvd2 gd t", "vd2 gd t"), +# cell_annotation_monaco_singler, +# cell_type_harmonised +# )) |> +# +# +# mutate(cell_type_harmonised = cell_type_harmonised |> +# str_replace("naive cd4 t", "cd4 naive") |> +# str_replace("th2", "cd4 th2") |> +# str_replace("^th17$", "cd4 th17") |> +# str_replace("t regulatory", "treg") |> +# str_replace("follicular helper t", "cd4 fh") |> +# str_replace("th1/th17", "cd4 th1/th17") |> +# str_replace("^th1$", "cd4 th1") |> +# str_replace("nonvd2 gd t", "tgd") |> +# str_replace("vd2 gd t", "tgd") +# ) |> +# +# # add immune_unclassified +# mutate(cell_type_harmonised = if_else(cell_type_harmonised == "monocytes", "immune_unclassified", cell_type_harmonised)) |> +# mutate(cell_type_harmonised = if_else(is.na(cell_type_harmonised), "immune_unclassified", cell_type_harmonised)) |> +# mutate(confidence_class = if_else(is.na(confidence_class), 5, confidence_class)) |> +# +# # drop uncommon cells +# mutate(cell_type_harmonised = if_else(cell_type_harmonised %in% c("cd4 t", "cd8 t", "asdc", "cd4 ctl"), "immune_unclassified", cell_type_harmonised)) +# +# +# # Further rescue of unannotated cells, manually +# +# # curated_annotation |> +# # filter(cell_type_harmonised == "immune_unclassified") |> +# # count(cell_type , cell_type_harmonised ,confidence_class ,cell_annotation_azimuth_l2 ,cell_annotation_blueprint_singler ,cell_annotation_monaco_singler) |> +# # arrange(desc(n)) |> +# # write_csv("curated_annotation_still_unannotated_0.2.csv") +# +# +# curated_annotation = +# curated_annotation |> +# left_join( +# read_csv("~/PostDoc/CuratedAtlasQueryR/dev/curated_annotation_still_unannotated_0.2_manually_labelled.csv") |> +# select(cell_type, cell_type_harmonised_manually_curated = cell_type_harmonised, confidence_class_manually_curated = confidence_class, everything()), +# by = join_by(cell_type, cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler) +# ) |> +# mutate( +# confidence_class = if_else(cell_type_harmonised == "immune_unclassified", confidence_class_manually_curated, confidence_class), +# cell_type_harmonised = if_else(cell_type_harmonised == "immune_unclassified", cell_type_harmonised_manually_curated, cell_type_harmonised), +# ) |> +# select(-contains("manually_curated"), -n) |> +# +# # drop uncommon cells +# mutate(cell_type_harmonised = if_else(cell_type_harmonised %in% c("cd4 tcm", "cd4 tem"), "immune_unclassified", cell_type_harmonised)) +# +# +# +# # # Recover confidence class == 4 +# +# # curated_annotation |> +# # filter(confidence_class==4) |> +# # count(cell_type , cell_type_harmonised ,confidence_class ,cell_annotation_azimuth_l2 ,cell_annotation_blueprint_singler ,cell_annotation_monaco_singler) |> +# # arrange(desc(n)) |> +# # write_csv("curated_annotation_still_unannotated_0.2_confidence_class_4.csv") +# +# curated_annotation = +# curated_annotation |> +# left_join( +# read_csv("~/PostDoc/CuratedAtlasQueryR/dev/curated_annotation_still_unannotated_0.2_confidence_class_4_manually_labelled.csv") |> +# select(confidence_class_manually_curated = confidence_class, everything()), +# by = join_by(cell_type, cell_type_harmonised, cell_annotation_azimuth_l2, cell_annotation_blueprint_singler, cell_annotation_monaco_singler) +# ) |> +# mutate( +# confidence_class = if_else(confidence_class == 4 & !is.na(confidence_class_manually_curated), confidence_class_manually_curated, confidence_class) +# ) |> +# select(-contains("manually_curated"), -n) +# +# # Correct fishy stem cell labelling +# # If stem for the study's annotation and blueprint is non-immune it is probably wrong, +# # even because the heart has too many progenitor/stem +# curated_annotation = +# curated_annotation |> +# mutate(confidence_class = case_when( +# cell_type_harmonised == "stem" & cell_annotation_blueprint_singler %in% c( +# "skeletal muscle", "adipocytes", "epithelial", "smooth muscle", "chondrocytes", "endothelial" +# ) ~ 5, +# TRUE ~ confidence_class +# )) +# +# +# curated_annotation_merged = +# +# # Fix cell ID +# metadata_df |> +# dplyr::select(.cell, .sample, cell_type) |> +# as_tibble() |> +# +# # Add cell type +# left_join(curated_annotation |> dplyr::select(-cell_type), by = c(".cell", ".sample")) |> +# +# # Add non immune +# mutate(cell_type_harmonised = if_else(is.na(cell_type_harmonised), "non_immune", cell_type_harmonised)) |> +# mutate(confidence_class = if_else(is.na(confidence_class) & cell_type_harmonised == "non_immune", 1, confidence_class)) |> +# +# # For some unknown reason +# distinct() +# +# +# curated_annotation_merged |> +# +# # Save +# saveRDS(file_curated_annotation_merged) +# +# metadata_annotated = +# curated_annotation_merged |> +# +# # merge with the rest of metadata +# left_join( +# metadata_df |> +# as_tibble(), +# by=c(".cell", ".sample", "cell_type") +# ) +# +# # Replace `.` with `_` for all column names as it can create difficoulties for MySQL and Python +# colnames(metadata_annotated) = colnames(metadata_annotated) |> str_replace_all("\\.", "_") +# metadata_annotated = metadata_annotated |> rename(cell_ = `_cell`, sample_ = `_sample`) +# +# +# dictionary_connie_non_immune = +# metadata_annotated |> +# filter(cell_type_harmonised == "non_immune") |> +# distinct(cell_type) |> +# harmonise_names_non_immune() |> +# rename(cell_type_harmonised_non_immune = cell_type_harmonised ) +# +# metadata_annotated = +# metadata_annotated |> +# left_join(dictionary_connie_non_immune) |> +# mutate(cell_type_harmonised = if_else(cell_type_harmonised=="non_immune", cell_type_harmonised_non_immune, cell_type_harmonised)) |> +# select(-cell_type_harmonised_non_immune) +# +# +# } remove_files_safely <- function(files) { for (file in files) { @@ -2220,10 +2386,7 @@ add_tier_inputs <- function(command, arguments_to_tier, i) { #' @param chunk_size The size of each chunk. Defaults to 100. #' @return A tibble with the features and their corresponding chunk numbers. #' @importFrom dplyr tibble -#' @importFrom purrr rep_along -#' @importFrom purrr ceiling -#' @importFrom purrr seq_len -#' @importFrom purrr length +#' @importFrom rlang rep_along #' @importFrom magrittr divide_by #' #' @@ -2243,6 +2406,8 @@ feature_chunks = function(features, chunk_size = 100){ } + + add_missingh_genes_to_se = function(se, all_genes, missing_genes){ missing_matrix = matrix(rep(0, length(missing_genes) * ncol(se)), ncol = ncol(se)) @@ -2250,17 +2415,16 @@ add_missingh_genes_to_se = function(se, all_genes, missing_genes){ rownames(missing_matrix) = missing_genes colnames(missing_matrix) = colnames(se) - new_se = SummarizedExperiment(assay = list(count = missing_matrix)) - colData(new_se) = colData(se) + new_se = SummarizedExperiment(assays = list(count = missing_matrix |> DelayedArray::DelayedArray() ), + colData = colData(se)) - empty_rowdata = - rowData(se)[seq_len(nrow(new_se)),,drop=FALSE] |> - as_tibble() |> - mutate(across(everything(), ~ replace(., TRUE, NA))) |> - DataFrame(row.names = missing_genes) - rowData(new_se) = empty_rowdata + empty_rowdata = DataFrame(matrix(NA, ncol = ncol(rowData(se)), nrow = length(missing_genes)), + row.names = missing_genes) + names(empty_rowdata) <- names(rowData(se)) + rowData(new_se) = empty_rowdata + se = SummarizedExperiment(assays = assays(se), colData = colData(se), rowData = rowData(se)) se = se |> rbind(new_se) se[all_genes,] @@ -2366,10 +2530,10 @@ arguments_to_action <- function(lst, input_hpc, value) { if ( arg_value |> length() == 0 | is.null(arg_value) | !( - arg_value |> is("character") | - arg_value |> is("name") | - arg_value |> is("list") - )) next + arg_value |> is("character") | + arg_value |> is("name") | + arg_value |> is("list") + )) next # Convert the argument value to a character string vector # arg_value_as_char <- as.character(arg_value) @@ -2384,9 +2548,9 @@ arguments_to_action <- function(lst, input_hpc, value) { input_hpc[[arg_value]]$iterate %in% value ) matching_elements <- c(matching_elements, as.character(arg_value) |> set_names(arg_name)) - - } + } + else{ # Iterate over each element in arg_value_as_char for (val in arg_value) { @@ -2403,7 +2567,7 @@ arguments_to_action <- function(lst, input_hpc, value) { } } - + } return(matching_elements) @@ -2474,27 +2638,27 @@ safe_as_name <- function(input) { #' @importFrom glue glue #' @noRd check_for_name_value_conflicts <- function(...) { -# Capture the arguments passed to the function -args_list <- list(...) - -# Iterate through the list and check for name-value conflicts -for (arg_name in names(args_list)) { - arg_value <- args_list[[arg_name]] - - # Skip NULL values - if (is.null(arg_value)) next + # Capture the arguments passed to the function + args_list <- list(...) - # Convert the argument value to a character string - # arg_value_as_char <- as.character(arg_value) - - # Check if the argument name matches any of the values in arg_value_as_char - if (arg_name %in% c(arg_value)) { - stop(glue::glue("HPCell says: Argument name '{arg_name}' cannot be the same as its value '{arg_value_as_char}'")) + # Iterate through the list and check for name-value conflicts + for (arg_name in names(args_list)) { + arg_value <- args_list[[arg_name]] + + # Skip NULL values + if (is.null(arg_value)) next + + # Convert the argument value to a character string + arg_value_as_char <- as.character(arg_value) + + # Check if the argument name matches any of the values in arg_value_as_char + if (arg_name %in% c(arg_value)) { + stop(glue::glue("HPCell says: Argument name '{arg_name}' cannot be the same as its value '{arg_value_as_char}'")) + } } -} - -# If no conflicts, return the arguments as is or proceed with the function logic -return(args_list) + + # If no conflicts, return the arguments as is or proceed with the function logic + return(args_list) } #' Expand Tiered Arguments in a List @@ -2547,7 +2711,6 @@ return(args_list) #' # $packages #' # [1] "tidySummarizedExperiment" "HPCell" #' -#' @importFrom stats substitute #' @noRd expand_tiered_arguments <- function(lst, tiers, argument_to_replace, tiered_args) { # Check if the argument to replace exists in the list @@ -2558,7 +2721,7 @@ expand_tiered_arguments <- function(lst, tiers, argument_to_replace, tiered_args # Create a vector of tiered values by combining tiered_base with tiers # If no tier do not add the suffix tiered_values <- lapply(tiers, function(tier) paste0(tiered_base, "_", tier) |> as.name() ) - + # Construct the c(...) call with the tiered values c_call <- as.call(c(as.name("c"), tiered_values)) @@ -2594,10 +2757,10 @@ build_pattern = function(arguments_to_tier = c(), other_arguments_to_map = c(), if(other_arguments_to_map |> length() > 0){ - pattern = pattern |> c(other_arguments_to_map |> lapply(as.name)) + pattern = pattern |> c(other_arguments_to_map |> lapply(as.name)) } - + pattern = as.call(pattern) } @@ -2606,3 +2769,269 @@ build_pattern = function(arguments_to_tier = c(), other_arguments_to_map = c(), } +write_source = function(user_function_source_path, target_script){ + if(user_function_source_path |> is.null() |> not()) + + source(s) |> + substitute(env = list(s =user_function_source_path )) |> + deparse() |> + write_lines(target_script, append = TRUE) +} + +#' @export +target_append <- function(target_list, ...) { + # Append the new elements to the list + target_list <<- c(target_list, list(...)) + +} + +write_HDF5_array_safe = function(normalized_rna, name, directory){ + + dir.create(directory, showWarnings = FALSE, recursive = TRUE) + + hash = digest(normalized_rna) + file_name = glue("{directory}/{hash}") + + if ( + file.exists(file_name) && + name %in% rhdf5::h5ls(file_name)$name + ) { + names_to_drop = rhdf5::h5ls(file_name)$name |> str_subset(name) + names_to_drop |> map(~rhdf5::h5delete(file_name, .x)) + } + + normalized_rna |> + HDF5Array::writeHDF5Array( + filepath = file_name, + name = name, + as.sparse = TRUE + ) + +} + + +#' Compute the Mode of a DelayedArray +#' +#' This function computes the mode (most frequent value) of a \code{DelayedArray} without loading the entire array into memory. It processes the array in blocks to maintain memory efficiency, making it suitable for large datasets. +#' +#' @param delayed_array A \code{DelayedArray} object for which the mode is to be computed. +#' +#' @return A list containing the following elements: +#' \describe{ +#' \item{\code{mode}}{Numeric vector of the most frequent value(s) in the array.} +#' \item{\code{frequency}}{Integer representing the count of the most frequent value(s).} +#' } +#' +#' @details +#' The function utilizes block processing via \code{blockApply()} from the \code{DelayedArray} package to avoid loading the entire array into memory. It computes partial frequency tables for each block and combines them to find the overall mode. +#' +#' @import DelayedArray +#' @importFrom DelayedArray blockApply +#' @importFrom methods as +#' @importFrom utils capture.output +#' +#' @examples +#' \dontrun{ +#' # Load required packages +#' library(DelayedArray) +#' +#' # Create a DelayedArray from an in-memory matrix +#' set.seed(123) +#' n_rows <- 1000 +#' n_cols <- 1000 +#' matrix_data <- matrix(sample(0:5, n_rows * n_cols, replace = TRUE, +#' prob = c(0.5, 0.1, 0.1, 0.1, 0.1, 0.1)), +#' nrow = n_rows) +#' delayed_array <- DelayedArray(matrix_data) +#' +#' # Compute the mode +#' mode_result <- compute_mode_delayedarray(delayed_array) +#' +#' # Output the result +#' cat("Most frequent value(s):", paste(mode_result$mode, collapse = ", "), "\n") +#' cat("Frequency:", mode_result$frequency, "\n") +#' } +#' +#' @export +compute_mode_delayedarray <- function(delayed_array) { + # Compute the mode (most frequent value) of a DelayedArray without loading the entire array into memory. + + # Helper function to compute frequency table for a block + block_table <- function(block) { + counts_vector <- as.vector(block) + counts_table <- table(counts_vector) + return(counts_table) + } + + # Helper function to combine two frequency tables + combine_tables <- function(table1, table2) { + if (length(table1) == 0) return(table2) + if (length(table2) == 0) return(table1) + + # Get all unique values + all_names <- union(names(table1), names(table2)) + + # Align counts for all unique values + counts1 <- as.numeric(table1[all_names]) + counts2 <- as.numeric(table2[all_names]) + + # Replace NA with 0 + counts1[is.na(counts1)] <- 0 + counts2[is.na(counts2)] <- 0 + + # Sum counts + combined_counts <- counts1 + counts2 + names(combined_counts) <- all_names + + return(combined_counts) + } + + # Process the DelayedArray in blocks + block_tables <- blockApply(delayed_array, FUN = block_table) + + # Combine all partial frequency tables into a single table + freq_counts <- Reduce(f = combine_tables, x = block_tables) + + # Find the value(s) with the maximum count + max_count <- max(freq_counts) + most_frequent_values <- as.numeric(names(freq_counts)[freq_counts == max_count]) + + # Return the result as a list + result <- list( + mode = most_frequent_values, + frequency = max_count + ) + + return(result) +} + +#' Check if All Assay Values are Greater Than Zero and Subtract One if True +#' +#' This function, `check_if_assay_minimum_count_is_zero_and_correct_TEMPORARY`, checks if all values +#' in a specified assay of a `SingleCellExperiment` or `Seurat` object are greater than zero. +#' If all values are greater than zero, it subtracts one from each value. This operation is useful +#' in cases where a small adjustment to count data is necessary to standardise the minimum count value. +#' +#' For `SingleCellExperiment` objects, the function accesses the assay data using the `assay` function. +#' For `Seurat` objects, it retrieves the data using `GetAssayData` and updates it using `SetAssayData`. +#' This allows seamless handling of different object types in single-cell analysis workflows. +#' +#' @param input_read_RNA_assay A `SingleCellExperiment` or `Seurat` object containing the assay data. +#' @param assay_name A string specifying the name of the assay to be checked and potentially modified. +#' +#' @return The modified `SingleCellExperiment` or `Seurat` object, where one has been subtracted +#' from all values in the specified assay if all values were initially greater than zero. +#' If any values are zero or negative, the object is returned unmodified. +#' +#' @examples +#' # For SingleCellExperiment +#' # sce <- SingleCellExperiment(assays = list(RNA = matrix(1:9, 3, 3))) +#' # modified_sce <- check_if_assay_minimum_count_is_zero_and_correct_TEMPORARY(sce, "RNA") +#' +#' # For Seurat +#' # seurat <- CreateSeuratObject(counts = matrix(1:9, 3, 3)) +#' # modified_seurat <- check_if_assay_minimum_count_is_zero_and_correct_TEMPORARY(seurat, "RNA") +#' +#' @import SingleCellExperiment +#' @import Seurat +#' @importFrom SummarizedExperiment assay +#' +#' @noRd +check_if_assay_minimum_count_is_zero_and_correct_TEMPORARY <- function(input_read_RNA_assay, assay_name, subset_up_to_number_of_cells = dim(input_read_RNA_assay)[2]) { + + # Do now overshoor the number of cells + subset_up_to_number_of_cells = subset_up_to_number_of_cells |> min(dim(input_read_RNA_assay)[2]) + + # Check if object is SCE or Seurat + if (inherits(input_read_RNA_assay, "SingleCellExperiment")) { + # For SingleCellExperiment + assay_data <- assay(input_read_RNA_assay, assay_name) + + my_min = min(assay_data[, 1:subset_up_to_number_of_cells]) + + # Check if all values are > 0 + if (my_min > 0) { + # Subtract 1 from each value + assay(input_read_RNA_assay, assay_name) <- assay_data - my_min + } else { + message("Not all values are greater than 0. No subtraction performed.") + } + + } else if (inherits(input_read_RNA_assay, "Seurat")) { + # For Seurat + assay_data <- GetAssayData(input_read_RNA_assay, assay = assay_name) + + my_min = min(assay_data) + + # Check if all values are > 0 + if (my_min > 0) { + # Subtract 1 from each value + input_read_RNA_assay <- SetAssayData(input_read_RNA_assay, assay = assay_name, + new.data = assay_data - my_min) + } else { + message("Not all values are greater than 0. No subtraction performed.") + } + + } else { + stop("The input object is neither a SingleCellExperiment nor a Seurat object.") + } + + # Return the modified object + return(input_read_RNA_assay) +} + +#' Clean Metadata in SingleCellExperiment Object +#' +#' This function takes a SingleCellExperiment (SCE) object and removes columns +#' that are completely filled with NA values. +#' The cleaned metadata is then returned as a dataframe. +#' +#' @param sce A SingleCellExperiment object containing metadata to be cleaned. +#' @return A SingleCellExperiment with all completely NA columns removed +clean_sce_metadata <- function(sce) { + sce <- sce |> select(where(~ any(!is.na(.)))) + sce +} + +#' @export +computeCommunProbPathway <- function(object = NULL, net = NULL, pairLR.use = NULL, thresh = 0.05) { + if (is.null(net)) { + net <- object@net + } + if (is.null(pairLR.use)) { + pairLR.use <- object@LR$LRsig + } + prob <- net$prob + prob[net$pval > thresh] <- 0 + + LR <- dimnames(prob)[[3]] + LR.sig <- LR[apply(prob, 3, sum) != 0] + + pathways <- unique(pairLR.use$pathway_name) + group <- factor(pairLR.use$pathway_name, levels = pathways) + + # STEFANO FIX + if(length(levels(group))==1){ + xx = apply(prob, c(1, 2), by, group, sum) + prob.pathways = xx |> array(dim = c(nrow(xx), ncol(xx), 1), dimnames = list(rownames(xx), colnames(xx), levels(group))) + } + else + prob.pathways <- aperm(apply(prob, c(1, 2), by, group, sum), + c(2, 3, 1)) + + pathways.sig <- pathways[apply(prob.pathways, 3, sum) != 0] + prob.pathways.sig <- prob.pathways[,,pathways.sig, drop = FALSE] + idx <- sort(apply(prob.pathways.sig, 3, sum), decreasing=TRUE, index.return = TRUE)$ix + pathways.sig <- pathways.sig[idx] + prob.pathways.sig <- prob.pathways.sig[, , idx] + + if (is.null(object)) { + netP = list(pathways = pathways.sig, prob = prob.pathways.sig) + return(netP) + } else { + object@net$LRs <- LR.sig + object@netP$pathways <- pathways.sig + object@netP$prob <- prob.pathways.sig + return(object) + } +} diff --git a/README.md b/README.md index d41edd32..c17d21b9 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ The key features of HPCell include: ## Installation ``` r -remote::install_github("MangiolaLaboratory/HPCell") +remotes::install_github("MangiolaLaboratory/HPCell") ``` ## The input diff --git a/README.rmd b/README.rmd index cf8e90c3..f236a89e 100644 --- a/README.rmd +++ b/README.rmd @@ -35,7 +35,7 @@ The key features of HPCell include: ```{r, eval=FALSE} -remote::install_github("MangiolaLaboratory/HPCell") +remotes::install_github("MangiolaLaboratory/HPCell") ``` @@ -58,6 +58,7 @@ library(SeuratData) options(Seurat.object.assay.version = "v5") input_seurat <- + # LoadPBMCData("pbmc3k") |> LoadData("pbmc3k") |> _[,1:500] @@ -66,6 +67,27 @@ file_path = "~/temp_seurat.rds" input_seurat |> saveRDS(file_path) # Let's pretend we have two samples +input_hpc = + c(file_path, file_path) |> + magrittr::set_names(c("pbmc3k1_1", "pbmc3k1_2")) + +## Test with fibrosis samples +# input_hpc = +# c("~/HPCell/fibrosis_data/GSE122960___GSM3489182.rds", "~/HPCell/fibrosis_data/GSE135893_cHP___THD0001.rds") |> +# magrittr::set_names(c("GSM3489182", "THD0001")) + +# input_hpc = +# c("~/HPCell/fibrosis_data_modified/input1", "~/HPCell/fibrosis_data_modified/input2") |> +# magrittr::set_names(c("GSM3489182", "THD0001")) + +# PBMC dataset +# input_hpc = +# c("~/HPCell/pbmc_data/pbmc_data_500") |> +# magrittr::set_names(c("pbmc3k")) +``` + +Local parallel computing +`computing_resources = crew_controller_local(workers = 10)` input_hpc = c(file_path, file_path, file_path) ``` @@ -83,6 +105,7 @@ This has several advantages: - The pipeline can be easily extended with the modules by the community ```{r, eval= FALSE} + library(HPCell) library(crew) @@ -104,8 +127,16 @@ input_hpc |> "subsets_Ribo_percent", "G2M.Score" )) |> - calculate_pseudobulk(group_by = "monaco_first.labels.fine") - + + hpc_report( + "empty_report", + rmd_path = "~/HPCell/inst/rmd/Empty_droplet_Report_HPC.Rmd", + empty_tbl = "empty_tbl" |> is_target(), + sample_names = "sample_names" |> is_target(), + input_meta = tar_read(data_object)[[1]]@meta.data + ) + +# calculate_pseudobulk(group_by = c("sampleName")) ``` ## Deployment @@ -254,16 +285,23 @@ input_hpc |> gene_nomenclature = "symbol", data_container_type = "seurat_rds" ) |> - hpc_report( - "empty_report", # The name of the report output - rmd_path = paste0(system.file(package = "HPCell"), "/rmd/test.Rmd"), # The path to the Rmd. In this case it is stored within the package - empty_list = "empty_tbl" |> is_target(), # The results and targets needed for the report - sample_names = "sample_names" |> is_target() # The results and targets needed for the report - ) + "empty_report", + rmd_path = "~/HPCell/inst/rmd/Empty_droplet_Report_HPC.Rmd", + empty_tbl = targets::tar_read(empty_tbl), # Explicitly pass the target + sample_names = targets::tar_read(sample_names) +) + + + + + + + -tar_read(empty_report) +tar_read(empty_report) +# paste0(system.file(package = "HPCell"), "/inst/rmd/Empty_droplet_Report_HPC.Rmd") ``` ## Details on prebuilt steps for several popular methods diff --git a/R_scripts/de_parallel.R b/R_scripts/de_parallel.R index a1038983..82f5326b 100644 --- a/R_scripts/de_parallel.R +++ b/R_scripts/de_parallel.R @@ -20,7 +20,8 @@ se |> slurm_memory_gigabytes_per_cpu = 5, slurm_cpus_per_task = 2, workers = 200, - verbose = T + verbose = T, + seconds_idle = 30 ) ) @@ -357,7 +358,8 @@ slurm = crew.cluster::crew_controller_slurm( slurm_memory_gigabytes_per_cpu = 5, slurm_cpus_per_task = 1, workers = 200, - verbose = T + verbose = T, + seconds_idle = 30 ) @@ -488,7 +490,8 @@ se = slurm_memory_gigabytes_per_cpu = 5, slurm_cpus_per_task = 1, workers = 200, - verbose = T + verbose = T, + seconds_idle = 30 ) ) diff --git a/data/CellChatDB.human.rda b/data/CellChatDB.human.rda new file mode 100644 index 00000000..d6ee0db3 Binary files /dev/null and b/data/CellChatDB.human.rda differ diff --git a/data/celltype_unification_maps.rda b/data/celltype_unification_maps.rda new file mode 100644 index 00000000..b7a0a64d Binary files /dev/null and b/data/celltype_unification_maps.rda differ diff --git a/data/ensembl_genes_biomart.rda b/data/ensembl_genes_biomart.rda new file mode 100644 index 00000000..ff693893 Binary files /dev/null and b/data/ensembl_genes_biomart.rda differ diff --git a/data/immune_graph.rda b/data/immune_graph.rda new file mode 100644 index 00000000..0e88081e Binary files /dev/null and b/data/immune_graph.rda differ diff --git a/data/nonimmune_cellxgene.rda b/data/nonimmune_cellxgene.rda new file mode 100644 index 00000000..4743e3ae Binary files /dev/null and b/data/nonimmune_cellxgene.rda differ diff --git a/inst/extdata/immune_map_azimuth.csv b/inst/extdata/immune_map_azimuth.csv new file mode 100755 index 00000000..06b284e6 --- /dev/null +++ b/inst/extdata/immune_map_azimuth.csv @@ -0,0 +1,30 @@ +from,to,is_immune +NK,nk,TRUE +CD8 TEM,cd8 tem,TRUE +CD4 CTL,cytotoxic,TRUE +dnT,t,TRUE +CD8 Naive,cd8 naive,TRUE +CD4 Naive,cd4 naive,TRUE +CD4 TCM,cd4 tcm,TRUE +gdT,tgd,TRUE +CD8 TCM,cd8 tcm,TRUE +MAIT,mait,TRUE +CD4 TEM,cd4 tem,TRUE +ILC,ilc,TRUE +CD14 Mono,cd14 mono,TRUE +cDC1,cdc,TRUE +pDC,pdc,TRUE +cDC2,cdc,TRUE +B naive,b naive,TRUE +B intermediate,b memory,TRUE +B memory,b memory,TRUE +Eryth,erythrocyte,TRUE +CD16 Mono,cd16 mono,TRUE +HSPC,progenitor,TRUE +Treg,treg,TRUE +NK_CD56bright,nk,TRUE +Plasmablast,plasma,TRUE +NK Proliferating,nk,TRUE +ASDC,cdc,TRUE +CD8 Proliferating,cd8 tem,TRUE +CD4 Proliferating,cd4 tem,TRUE \ No newline at end of file diff --git a/inst/extdata/immune_map_blueprint.csv b/inst/extdata/immune_map_blueprint.csv new file mode 100755 index 00000000..345c8904 --- /dev/null +++ b/inst/extdata/immune_map_blueprint.csv @@ -0,0 +1,45 @@ +from,to,is_immune +Neutrophils,granulocyte,TRUE +Monocytes,monocytic,TRUE +MEP,progenitor,TRUE +CD4+ T-cells,t cd4,TRUE +Tregs,treg,TRUE +CD4+ Tcm,cd4 tcm,TRUE +CD4+ Tem,cd4 tem,TRUE +CD8+ Tcm,cd8 tcm,TRUE +CD8+ Tem,cd8 tem,TRUE +NK cells,nk,TRUE +naive B-cells,b naive,TRUE +Memory B-cells,b memory,TRUE +Class-switched memory B-cells,b memory,TRUE +HSC,progenitor,TRUE +MPP,progenitor,TRUE +CLP,progenitor,TRUE +GMP,progenitor,TRUE +Macrophages,macrophage,TRUE +CD8+ T-cells,t cd8,TRUE +CD8 T,t cd8,TRUE +Erythrocytes,erythrocyte,TRUE +Megakaryocytes,non immune,TRUE +CMP,progenitor,TRUE +Macrophages M1,macrophage,TRUE +Macrophages M2,macrophage,TRUE +Endothelial cells,non immune,TRUE +DC,cdc,TRUE +Eosinophils,granulocyte,TRUE +Plasma cells,plasma,TRUE +Chondrocytes,non immune,TRUE +Fibroblasts,non immune,TRUE +Smooth muscle,non immune,TRUE +Epithelial cells,non immune,TRUE +Melanocytes,non immune,TRUE +Skeletal muscle,non immune,TRUE +Keratinocytes,non immune,TRUE +mv Endothelial cells,non immune,TRUE +Myocytes,non immune,TRUE +Adipocytes,non immune,TRUE +Neurons,non immune,TRUE +Pericytes,non immune,TRUE +Preadipocytes,non immune,TRUE +Astrocytes,non immune,TRUE +Mesangial cells,non immune,TRUE \ No newline at end of file diff --git a/inst/extdata/immune_map_cellxgene.csv b/inst/extdata/immune_map_cellxgene.csv new file mode 100755 index 00000000..f835dbe5 --- /dev/null +++ b/inst/extdata/immune_map_cellxgene.csv @@ -0,0 +1,679 @@ +from,to,is_immune +"activated CD4-positive, alpha-beta T cell",cd4 tem,TRUE +"activated CD4-positive, alpha-beta T cell, human",cd4 tem,TRUE +"activated CD8-positive, alpha-beta T cell",cd8 tem,TRUE +"activated CD8-positive, alpha-beta T cell, human",cd8 tem,TRUE +activated type II NK T cell,nkt,TRUE +alpha-beta T cell,t,TRUE +alternatively activated macrophage,macrophage,TRUE +alveolar macrophage,macrophage,TRUE +B cell,b,TRUE +B-1 B cell,b,TRUE +B-1a B cell,b,TRUE +B-1b B cell,b,TRUE +B-2 B cell,b,TRUE +basophil,granulocyte,TRUE +basophil mast progenitor cell,progenitor,TRUE +blood cell,erythrocyte,TRUE +"CD14-low, CD16-positive monocyte",cd16 mono,TRUE +CD14-positive monocyte,cd14 mono,TRUE +"CD14-positive, CD16-negative classical monocyte",cd14 mono,TRUE +"CD14-positive, CD16-positive monocyte",monocytic,TRUE +CD141-positive myeloid dendritic cell,cdc,TRUE +"CD16-negative, CD56-bright natural killer cell, human",nk,TRUE +"CD16-positive, CD56-dim natural killer cell, human",nk,TRUE +CD1c-positive myeloid dendritic cell,cdc,TRUE +"CD34-positive, CD38-negative hematopoietic stem cell",progenitor,TRUE +"CD34-positive, CD56-positive, CD117-positive common innate lymphoid precursor, human",progenitor,TRUE +CD4-positive helper T cell,t cd4,TRUE +"CD4-positive, alpha-beta cytotoxic T cell",cytotoxic,TRUE +"CD4-positive, alpha-beta memory T cell",cd4 tcm,TRUE +"CD4-positive, alpha-beta T cell",t cd4,TRUE +"CD4-positive, alpha-beta thymocyte",cd4 naive,TRUE +"CD4-positive, CD25-positive, alpha-beta regulatory T cell",treg,TRUE +"CD8-alpha alpha positive, gamma-delta intraepithelial T cell",tgd,TRUE +"CD8-alpha-alpha-positive, alpha-beta intraepithelial T cell",t cd8,TRUE +"CD8-alpha-beta-positive, alpha-beta intraepithelial T cell",t cd8,TRUE +"CD8-positive, alpha-beta cytokine secreting effector T cell",t cd8,TRUE +"CD8-positive, alpha-beta cytotoxic T cell",t cd8,TRUE +"CD8-positive, alpha-beta memory T cell",cd8 tcm,TRUE +"CD8-positive, alpha-beta memory T cell, CD45RO-positive",cd8 tcm,TRUE +"CD8-positive, alpha-beta T cell",t cd8,TRUE +"CD8-positive, alpha-beta thymocyte",cd8 naive,TRUE +"central memory CD4-positive, alpha-beta T cell",cd4 tcm,TRUE +"central memory CD8-positive, alpha-beta T cell",cd8 tcm,TRUE +central nervous system macrophage,macrophage,TRUE +class switched memory B cell,b,TRUE +classical monocyte,monocytic,TRUE +colon macrophage,macrophage,TRUE +common dendritic progenitor,progenitor,TRUE +common lymphoid progenitor,progenitor,TRUE +common myeloid progenitor,progenitor,TRUE +conventional dendritic cell,cdc,TRUE +cord blood hematopoietic stem cell,progenitor,TRUE +cytotoxic T cell,cytotoxic,TRUE +"decidual natural killer cell, human",nk,TRUE +dendritic cell,dc,TRUE +"dendritic cell, human",dc,TRUE +DN1 thymic pro-T cell,t,TRUE +DN3 thymocyte,t,TRUE +DN4 thymocyte,t,TRUE +double negative T regulatory cell,treg,TRUE +double negative thymocyte,t,TRUE +"double-positive, alpha-beta thymocyte",t,TRUE +early lymphoid progenitor,progenitor,TRUE +early pro-B cell,b,TRUE +early promyelocyte,progenitor,TRUE +early T lineage precursor,progenitor,TRUE +"effector CD4-positive, alpha-beta T cell",cd4 tem,TRUE +"effector CD8-positive, alpha-beta T cell",cd8 tem,TRUE +"effector memory CD4-positive, alpha-beta T cell",cd4 tem,TRUE +"effector memory CD8-positive, alpha-beta T cell",cd8 tem,TRUE +"effector memory CD8-positive, alpha-beta T cell, terminally differentiated",cd8 tem,TRUE +elicited macrophage,macrophage,TRUE +enucleate erythrocyte,erythrocyte,TRUE +eosinophil,granulocyte,TRUE +erythroblast,erythrocyte,TRUE +erythrocyte,erythrocyte,TRUE +erythroid progenitor cell,progenitor,TRUE +"erythroid progenitor cell, mammalian",progenitor,TRUE +eurydendroid cell,progenitor,TRUE +follicular B cell,b,TRUE +fraction A pre-pro B cell,b,TRUE +gamma-delta T cell,tgd,TRUE +germinal center B cell,b,TRUE +granulocyte,granulocyte,TRUE +granulocyte monocyte progenitor cell,progenitor,TRUE +group 2 innate lymphoid cell,ilc,TRUE +"group 2 innate lymphoid cell, human",ilc,TRUE +group 3 innate lymphoid cell,ilc,TRUE +"group 3 innate lymphoid cell, human",ilc,TRUE +helper T cell,t cd4,TRUE +hematopoietic multipotent progenitor cell,progenitor,TRUE +hematopoietic precursor cell,progenitor,TRUE +hematopoietic stem cell,progenitor,TRUE +Hofbauer cell,macrophage,TRUE +IgA plasma cell,plasma,TRUE +IgA plasmablast,plasma,TRUE +IgG memory B cell,b memory,TRUE +IgG plasma cell,plasma,TRUE +IgG plasmablast,plasma,TRUE +IgG-negative class switched memory B cell,b,TRUE +IgM plasma cell,plasma,TRUE +"ILC1, human",ilc,TRUE +immature alpha-beta T cell,t,TRUE +immature B cell,b,TRUE +immature innate lymphoid cell,ilc,TRUE +immature natural killer cell,nk,TRUE +immature neutrophil,granulocyte,TRUE +immature NK T cell,nkt,TRUE +inflammatory macrophage,macrophage,TRUE +innate lymphoid cell,ilc,TRUE +intermediate monocyte,monocytic,TRUE +kidney interstitial alternatively activated macrophage,macrophage,TRUE +Kupffer cell,macrophage,TRUE +large pre-B-II cell,b,TRUE +late pro-B cell,b,TRUE +late promyelocyte,progenitor,TRUE +liver dendritic cell,dc,TRUE +lung interstitial macrophage,macrophage,TRUE +lung macrophage,macrophage,TRUE +"lung resident memory CD4-positive, alpha-beta T cell",cd4 tcm,TRUE +"lung resident memory CD8-positive, alpha-beta T cell",t cd8,TRUE +lymphocyte of B lineage,b,TRUE +lymphoid lineage restricted progenitor cell,progenitor,TRUE +macrophage,macrophage,TRUE +macrophage dendritic cell progenitor,progenitor,TRUE +mast cell,mast,TRUE +mature alpha-beta T cell,t,TRUE +mature B cell,b,TRUE +mature conventional dendritic cell,cdc,TRUE +mature gamma-delta T cell,tgd,TRUE +mature NK T cell,nkt,TRUE +mature T cell,t,TRUE +memory B cell,b memory,TRUE +memory regulatory T cell,treg,TRUE +memory T cell,t,TRUE +MHC-II-positive classical monocyte,monocytic,TRUE +monocyte,monocytic,TRUE +monocyte-derived dendritic cell,monocytic,TRUE +mucosal invariant T cell,mait,TRUE +myeloid dendritic cell,cdc,TRUE +"myeloid dendritic cell, human",cdc,TRUE +myeloid lineage restricted progenitor cell,progenitor,TRUE +naive B cell,b naive,TRUE +naive regulatory T cell,treg,TRUE +naive T cell,t,TRUE +"naive thymus-derived CD4-positive, alpha-beta T cell",cd4 naive,TRUE +"naive thymus-derived CD8-positive, alpha-beta T cell",cd8 naive,TRUE +natural killer cell,nk,TRUE +natural T-regulatory cell,treg,TRUE +neutrophil,granulocyte,TRUE +neutrophil progenitor cell,progenitor,TRUE +"NKp44-negative group 3 innate lymphoid cell, human",ilc,TRUE +"NKp44-positive group 3 innate lymphoid cell, human",ilc,TRUE +non-classical monocyte,monocytic,TRUE +plasma cell,plasma,TRUE +plasmablast,plasma,TRUE +plasmacytoid dendritic cell,pdc,TRUE +"plasmacytoid dendritic cell, human",pdc,TRUE +pre-B-I cell,b,TRUE +pre-conventional dendritic cell,cdc,TRUE +pre-natural killer cell,nk,TRUE +precursor B cell,b,TRUE +primitive red blood cell,erythrocyte,TRUE +pro-B cell,b,TRUE +pro-T cell,t,TRUE +proerythroblast,erythrocyte,TRUE +promonocyte,monocytic,TRUE +regulatory T cell,treg,TRUE +small pre-B-II cell,b,TRUE +T cell,t,TRUE +T follicular helper cell,cd4 fh em,TRUE +T follicular regulatory cell,treg,TRUE +T-helper 1 cell,cd4 th1 em,TRUE +T-helper 17 cell,cd4 th17 em,TRUE +T-helper 2 cell,cd4 th2 em,TRUE +T-helper 22 cell,t cd4,TRUE +Tc1 cell,t cd8,TRUE +thymocyte,t,TRUE +tonsil germinal center B cell,b,TRUE +transitional stage B cell,b,TRUE +type I NK T cell,nkt,TRUE +unswitched memory B cell,b,TRUE +stromal cell,stromal,FALSE +oligodendrocyte precursor cell,glial,FALSE +mucous neck cell,secretory,FALSE +nasal mucosa goblet cell,secretory,FALSE +ionocyte,secretory,FALSE +parietal epithelial cell,epithelial,FALSE +transit amplifying cell,progenitor,FALSE +platelet,immune,FALSE +capillary endothelial cell,endothelial,FALSE +fibroblast of lung,stromal,FALSE +smooth muscle cell of the pulmonary artery,muscle,FALSE +chondrocyte,cartilage,FALSE +abnormal cell,other,FALSE +paneth cell,secretory,FALSE +PP cell,endocrine,FALSE +endothelial cell of pericentral hepatic sinusoid,endothelial,FALSE +GABAergic neuron,neuron,FALSE +squamous epithelial cell,epithelial,FALSE +embryonic fibroblast,stromal,FALSE +mesenchymal cell,stromal,FALSE +kidney cell,renal,FALSE +kidney loop of Henle epithelial cell,epithelial,FALSE +retinal bipolar neuron,neuron,FALSE +epithelial cell of nephron,epithelial,FALSE +type D enteroendocrine cell,endocrine,FALSE +motor neuron,neuron,FALSE +migratory enteric neural crest cell,neuron,FALSE +skeletal muscle satellite stem cell,muscle,FALSE +subcutaneous adipocyte,fat,FALSE +epicardial adipocyte,fat,FALSE +diffuse bipolar 1 cell,neuron,FALSE +invaginating midget bipolar cell,neuron,FALSE +cardiac muscle myoblast,muscle,FALSE +preosteoblast,progenitor,FALSE +serous secreting cell,epithelial,FALSE +cortical thymic epithelial cell,epithelial,FALSE +OFF-bipolar cell,neuron,FALSE +colon epithelial cell,epithelial,FALSE +transit amplifying cell of colon,progenitor,FALSE +acinar cell of salivary gland,secretory,FALSE +prostate gland microvascular endothelial cell,endothelial,FALSE +indirect pathway medium spiny neuron,neuron,FALSE +direct pathway medium spiny neuron,neuron,FALSE +epithelial cell of proximal tubule segment 3,epithelial,FALSE +skeletal muscle satellite cell,muscle,FALSE +L5/6 near-projecting glutamatergic neuron,neuron,FALSE +respiratory epithelial cell,epithelial,FALSE +type N enteroendocrine cell,endocrine,FALSE +skeletal muscle fiber,muscle,FALSE +vascular lymphangioblast,progenitor,FALSE +progenitor cell of mammary luminal epithelium,epithelial,FALSE +hair follicular keratinocyte,epidermal,FALSE +cerebellar granule cell precursor,progenitor,FALSE +unipolar brush cell,secretory,FALSE +anterior lens cell,lens,FALSE +stromal cell of endometrium,stromal,FALSE +CNS interneuron,neuron,FALSE +transit amplifying cell of small intestine,progenitor,FALSE +centroblast,immune,FALSE +tongue muscle cell,muscle,FALSE +pigmented ciliary epithelial cell,epithelial,FALSE +pulmonary interstitial fibroblast,stromal,FALSE +hepatoblast,progenitor,FALSE +sebum secreting cell,fat,FALSE +epithelial cell of uterus,epithelial,FALSE +microfold cell of epithelium of small intestine,epithelial,FALSE +dopaminergic neuron,neuron,FALSE +connective tissue cell,stromal,FALSE +myometrial cell,muscle,FALSE +kidney collecting duct cell,renal,FALSE +Schwann cell precursor,glial,FALSE +type A enteroendocrine cell,endocrine,FALSE +dermis microvascular lymphatic vessel endothelial cell,endothelial,FALSE +intestinal crypt stem cell of large intestine,progenitor,FALSE +type B pancreatic cell,endocrine,FALSE +kidney loop of Henle thick ascending limb epithelial cell,epithelial,FALSE +mesangial cell,renal,FALSE +pancreatic stellate cell,stromal,FALSE +stem cell,progenitor,FALSE +cardiac muscle cell,muscle,FALSE +astrocyte,glial,FALSE +multi-ciliated epithelial cell,epithelial,FALSE +bronchial goblet cell,secretory,FALSE +mucus secreting cell,secretory,FALSE +luminal hormone-sensing cell of mammary gland,endocrine,FALSE +placental villous trophoblast,progenitor,FALSE +perivascular cell,pericyte,FALSE +epithelial cell of proximal tubule,epithelial,FALSE +M cell of gut,epithelial,FALSE +glial cell,glial,FALSE +adventitial cell,stromal,FALSE +alveolar type 2 fibroblast cell,progenitor,FALSE +hepatocyte,liver,FALSE +brush cell,secretory,FALSE +endothelial cell of periportal hepatic sinusoid,endothelial,FALSE +differentiation-committed oligodendrocyte precursor,glial,FALSE +kidney interstitial cell,stromal,FALSE +kidney collecting duct intercalated cell,renal,FALSE +hepatic pit cell,immune,FALSE +retinal ganglion cell,neuron,FALSE +neural progenitor cell,neuron,FALSE +airway submucosal gland duct basal cell,epithelial,FALSE +blood vessel smooth muscle cell,muscle,FALSE +respiratory suprabasal cell,epithelial,FALSE +hematopoietic cell,immune,FALSE +glycinergic amacrine cell,neuron,FALSE +pancreatic epsilon cell,endocrine,FALSE +tracheobronchial serous cell,epithelial,FALSE +intrahepatic cholangiocyte,epithelial,FALSE +muscle precursor cell,muscle,FALSE +tracheobronchial goblet cell,secretory,FALSE +intestinal crypt stem cell,progenitor,FALSE +intestinal tuft cell,epithelial,FALSE +luminal cell of prostate epithelium,epithelial,FALSE +L6 corticothalamic-projecting glutamatergic cortical neuron,neuron,FALSE +decidual cell,reproductive,FALSE +neuron associated cell,neuron,FALSE +lactocyte,epithelial,FALSE +epithelial cell of prostate,epithelial,FALSE +epithelial cell of exocrine pancreas,epithelial,FALSE +chandelier cell,neuron,FALSE +ciliary muscle cell,muscle,FALSE +regular atrial cardiac myocyte,muscle,FALSE +paneth cell of epithelium of small intestine,epithelial,FALSE +reticulocyte,blood,FALSE +epithelial cell of sweat gland,epithelial,FALSE +kidney connecting tubule principal cell,renal,FALSE +chorionic trophoblast cell,progenitor,FALSE +myoblast,muscle,FALSE +glomerular capillary endothelial cell,endothelial,FALSE +large intestine goblet cell,secretory,FALSE +erythroid lineage cell,blood,FALSE +fibroblast of cardiac tissue,stromal,FALSE +pancreatic A cell,endocrine,FALSE +melanocyte,epidermal,FALSE +cardiac endothelial cell,endothelial,FALSE +enterocyte,epithelial,FALSE +lymphocyte,immune,FALSE +pericyte,pericyte,FALSE +oligodendrocyte,glial,FALSE +leukocyte,immune,FALSE +adipocyte,fat,FALSE +corticothalamic-projecting glutamatergic cortical neuron,neuron,FALSE +vascular leptomeningeal cell,pericyte,FALSE +L6b glutamatergic cortical neuron,neuron,FALSE +cerebral cortex endothelial cell,endothelial,FALSE +respiratory basal cell,epithelial,FALSE +luminal epithelial cell of mammary gland,epithelial,FALSE +extravillous trophoblast,progenitor,FALSE +endothelial cell of artery,endothelial,FALSE +enterocyte of colon,epithelial,FALSE +pulmonary artery endothelial cell,endothelial,FALSE +cholangiocyte,epithelial,FALSE +epithelial cell of lung,epithelial,FALSE +uterine smooth muscle cell,muscle,FALSE +alveolar type 1 fibroblast cell,progenitor,FALSE +preadipocyte,fat,FALSE +acinar cell,secretory,FALSE +enteric neuron,neuron,FALSE +peptic cell,secretory,FALSE +Schwann cell,glial,FALSE +inhibitory interneuron,neuron,FALSE +Mueller cell,glial,FALSE +myoepithelial cell,myoepithelial,FALSE +interstitial cell of Cajal,stromal,FALSE +brush cell of trachebronchial tree,secretory,FALSE +epithelial cell of thymus,epithelial,FALSE +deuterosomal cell,epithelial,FALSE +peripheral nervous system neuron,neuron,FALSE +parasol ganglion cell of retina,neuron,FALSE +professional antigen presenting cell,immune,FALSE +bipolar neuron,neuron,FALSE +precursor cell,progenitor,FALSE +neural crest cell,neuron,FALSE +neuronal brush cell,secretory,FALSE +epithelial cell of urethra,epithelial,FALSE +medium spiny neuron,neuron,FALSE +meningeal macrophage,macrophage,TRUE +follicular dendritic cell,immune,FALSE +trophoblast giant cell,progenitor,FALSE +sympathetic neuron,neuron,FALSE +noradrenergic cell,neuron,FALSE +vasa recta ascending limb cell,renal,FALSE +ovarian surface epithelial cell,epithelial,FALSE +brainstem motor neuron,neuron,FALSE +"BEST4+ intestinal epithelial cell, human",epithelial,FALSE +centrocyte,immune,FALSE +duodenum glandular cell,epithelial,FALSE +ileal goblet cell,secretory,FALSE +non-pigmented ciliary epithelial cell,epithelial,FALSE +epidermal cell,epidermal,FALSE +kidney pelvis urothelial cell,epithelial,FALSE +epithelial cell,epithelial,FALSE +megakaryocyte,blood,FALSE +fibroblast,progenitor,FALSE +enteric smooth muscle cell,muscle,FALSE +gut endothelial cell,endothelial,FALSE +intestine goblet cell,secretory,FALSE +astrocyte of the cerebral cortex,glial,FALSE +ciliated columnar cell of tracheobronchial tree,epithelial,FALSE +renal principal cell,renal,FALSE +malignant cell,other,FALSE +lung pericyte,pericyte,FALSE +neoplastic cell,other,FALSE +glandular epithelial cell,epithelial,FALSE +keratinocyte,epidermal,FALSE +epithelial cell of lower respiratory tract,epithelial,FALSE +taste receptor cell,sensory,FALSE +syncytiotrophoblast cell,progenitor,FALSE +fetal cardiomyocyte,muscle,FALSE +enteroendocrine cell of colon,endocrine,FALSE +smooth muscle cell,muscle,FALSE +kidney interstitial fibroblast,stromal,FALSE +germ cell,reproductive,FALSE +macroglial cell,glial,FALSE +respiratory hillock cell,epithelial,FALSE +primary sensory neuron (sensu Teleostei),neuron,FALSE +photoreceptor cell,neuron,FALSE +epithelial cell of alveolus of lung,epithelial,FALSE +pancreatic PP cell,endocrine,FALSE +fast muscle cell,muscle,FALSE +neuroendocrine cell,endocrine,FALSE +megakaryocyte progenitor cell,blood,FALSE +regular ventricular cardiac myocyte,muscle,FALSE +Sertoli cell,reproductive,FALSE +rod bipolar cell,neuron,FALSE +diffuse bipolar 4 cell,neuron,FALSE +flat midget bipolar cell,neuron,FALSE +midget ganglion cell of retina,neuron,FALSE +pulmonary ionocyte,secretory,FALSE +Bergmann glial cell,glial,FALSE +bladder urothelial cell,epithelial,FALSE +endosteal cell,bone,FALSE +melanocyte of skin,epidermal,FALSE +cone retinal bipolar cell,neuron,FALSE +neuron associated cell (sensu Vertebrata),neuron,FALSE +granule cell,neuron,FALSE +non-myelinating Schwann cell,glial,FALSE +renal intercalated cell,renal,FALSE +salivary gland cell,epithelial,FALSE +sensory neuron,neuron,FALSE +collagen secreting cell,stromal,FALSE +immature astrocyte,glial,FALSE +cerebral cortex GABAergic interneuron,neuron,FALSE +pigmented epithelial cell,epithelial,FALSE +columnar/cuboidal epithelial cell,epithelial,FALSE +immature Schwann cell,glial,FALSE +kidney distal convoluted tubule epithelial cell,epithelial,FALSE +basal cell of epidermis,epithelial,FALSE +mural cell,pericyte,FALSE +myofibroblast cell,stromal,FALSE +foveolar cell of stomach,epithelial,FALSE +myeloid cell,immune,FALSE +microglial cell,glial,FALSE +pvalb GABAergic cortical interneuron,neuron,FALSE +near-projecting glutamatergic cortical neuron,neuron,FALSE +endothelial cell of placenta,endothelial,FALSE +absorptive cell,epithelial,FALSE +type II pneumocyte,pneumocyte,FALSE +type L enteroendocrine cell,endocrine,FALSE +cerebellar granule cell,neuron,FALSE +kidney loop of Henle thin ascending limb epithelial cell,epithelial,FALSE +retinal pigment epithelial cell,epithelial,FALSE +midzonal region hepatocyte,liver,FALSE +centrilobular region hepatocyte,liver,FALSE +stromal cell of ovary,stromal,FALSE +tracheobronchial smooth muscle cell,muscle,FALSE +renal alpha-intercalated cell,renal,FALSE +basal epithelial cell of tracheobronchial tree,epithelial,FALSE +colon goblet cell,secretory,FALSE +P/D1 enteroendocrine cell,endocrine,FALSE +granulosa cell,reproductive,FALSE +fibro/adipogenic progenitor cell,progenitor,FALSE +forebrain neuroblast,progenitor,FALSE +radial glial cell,glial,FALSE +interneuron,neuron,FALSE +bronchial smooth muscle cell,muscle,FALSE +lung neuroendocrine cell,endocrine,FALSE +lung goblet cell,secretory,FALSE +medullary thymic epithelial cell,epithelial,FALSE +small intestine goblet cell,secretory,FALSE +H1 horizontal cell,neuron,FALSE +giant bipolar cell,neuron,FALSE +OFFx cell,neuron,FALSE +hepatic stellate cell,liver,FALSE +neuronal receptor cell,sensory,FALSE +epithelial cell of proximal tubule segment 1,epithelial,FALSE +lens fiber cell,lens,FALSE +basal cell of prostate epithelium,epithelial,FALSE +Cajal-Retzius cell,neuron,FALSE +corneal endothelial cell,endothelial,FALSE +glioblast,glial,FALSE +smooth muscle cell of prostate,muscle,FALSE +secondary lens fiber,lens,FALSE +sst chodl GABAergic cortical interneuron,neuron,FALSE +pancreatic endocrine cell,endocrine,FALSE +paneth cell of colon,secretory,FALSE +myelinating Schwann cell,glial,FALSE +primary cultured cell,other,FALSE +prostate stromal cell,stromal,FALSE +epidermal Langerhans cell,immune,FALSE +primordial germ cell,reproductive,FALSE +endothelial cell of vascular tree,endothelial,FALSE +epithelial cell of esophagus,epithelial,FALSE +mesothelial cell,mesothelial,FALSE +vein endothelial cell,endothelial,FALSE +sst GABAergic cortical interneuron,neuron,FALSE +caudal ganglionic eminence derived GABAergic cortical interneuron,neuron,FALSE +sncg GABAergic cortical interneuron,neuron,FALSE +luminal adaptive secretory precursor cell of mammary gland,progenitor,FALSE +myoepithelial cell of mammary gland,myoepithelial,FALSE +fibroblast of mammary gland,stromal,FALSE +kidney connecting tubule epithelial cell,epithelial,FALSE +intestinal enteroendocrine cell,endocrine,FALSE +type I pneumocyte,pneumocyte,FALSE +endothelial cell of hepatic sinusoid,endothelial,FALSE +glutamatergic neuron,neuron,FALSE +ciliated cell,epithelial,FALSE +secretory cell,secretory,FALSE +stratified epithelial cell,epithelial,FALSE +skin fibroblast,stromal,FALSE +type G enteroendocrine cell,endocrine,FALSE +myelocyte,immune,FALSE +chromaffin cell,endocrine,FALSE +reticular cell,immune,FALSE +renal interstitial pericyte,renal,FALSE +basal cell of epithelium of trachea,epithelial,FALSE +amacrine cell,neuron,FALSE +myeloid leukocyte,immune,FALSE +slow muscle cell,muscle,FALSE +enterocyte of epithelium of small intestine,epithelial,FALSE +ciliated epithelial cell,epithelial,FALSE +Leydig cell,reproductive,FALSE +GABAergic amacrine cell,neuron,FALSE +diffuse bipolar 3b cell,neuron,FALSE +osteoblast,progenitor,FALSE +corneal epithelial cell,epithelial,FALSE +mature microglial cell,glial,FALSE +mature astrocyte,glial,FALSE +retinal astrocyte,glial,FALSE +brush cell of trachea,secretory,FALSE +mesothelial cell of epicardium,mesothelial,FALSE +thyroid follicular cell,endocrine,FALSE +visceromotor neuron,neuron,FALSE +choroid plexus epithelial cell,epithelial,FALSE +skeletal muscle fibroblast,muscle,FALSE +bronchial epithelial cell,epithelial,FALSE +cortical cell of adrenal gland,endocrine,FALSE +inflammatory cell,immune,FALSE +fibroblast of connective tissue of glandular part of prostate,stromal,FALSE +vasa recta descending limb cell,renal,FALSE +lung microvascular endothelial cell,endothelial,FALSE +conjunctival epithelial cell,epithelial,FALSE +smooth muscle cell of sphincter of pupil,muscle,FALSE +eye photoreceptor cell,neuron,FALSE +epithelial cell of small intestine,epithelial,FALSE +pyramidal neuron,neuron,FALSE +sebaceous gland cell,epithelial,FALSE +granular cell of epidermis,epithelial,FALSE +bone marrow cell,bone,FALSE +mesothelial cell of pleura,mesothelial,FALSE +neuron,neuron,FALSE +endothelial cell,endothelial,FALSE +prickle cell,epidermal,FALSE +renal beta-intercalated cell,renal,FALSE +intestinal epithelial cell,epithelial,FALSE +enteroendocrine cell,endocrine,FALSE +L2/3-6 intratelencephalic projecting glutamatergic neuron,neuron,FALSE +vip GABAergic cortical interneuron,neuron,FALSE +club cell,epithelial,FALSE +mammary gland epithelial cell,epithelial,FALSE +endothelial cell of uterus,endothelial,FALSE +endothelial cell of lymphatic vessel,endothelial,FALSE +vascular associated smooth muscle cell,muscle,FALSE +lung perichondrial fibroblast,stromal,FALSE +type EC enteroendocrine cell,endocrine,FALSE +pancreatic acinar cell,secretory,FALSE +supporting cell,epithelial,FALSE +contractile cell,muscle,FALSE +theca cell,reproductive,FALSE +stem cell of epidermis,epithelial,FALSE +retinal rod cell,neuron,FALSE +promyelocyte,immune,FALSE +brain vascular cell,pericyte,FALSE +progenitor cell,progenitor,FALSE +kidney capillary endothelial cell,endothelial,FALSE +mesodermal cell,stromal,FALSE +GIP cell,endocrine,FALSE +mesenchymal lymphangioblast,progenitor,FALSE +mesothelial fibroblast,stromal,FALSE +tendon cell,stromal,FALSE +S cone cell,neuron,FALSE +diffuse bipolar 2 cell,neuron,FALSE +diffuse bipolar 6 cell,neuron,FALSE +parietal cell,epithelial,FALSE +smooth muscle myoblast,muscle,FALSE +endothelial cell of sinusoid,endothelial,FALSE +mononuclear phagocyte,immune,FALSE +retina horizontal cell,neuron,FALSE +embryonic stem cell,progenitor,FALSE +suprabasal keratinocyte,epidermal,FALSE +papillary tips cell,renal,FALSE +retinal blood vessel endothelial cell,endothelial,FALSE +kidney loop of Henle ascending limb epithelial cell,epithelial,FALSE +L4 intratelencephalic projecting glutamatergic neuron,neuron,FALSE +sperm,reproductive,FALSE +fibroblast of connective tissue of nonglandular part of prostate,stromal,FALSE +lens epithelial cell,epithelial,FALSE +glomerular endothelial cell,endothelial,FALSE +kidney resident macrophage,macrophage,TRUE +epithelial cell of stratum germinativum of esophagus,epithelial,FALSE +basal epithelial cell of prostatic duct,epithelial,FALSE +serous cell of epithelium of bronchus,epithelial,FALSE +urothelial cell,epithelial,FALSE +GABAergic interneuron,neuron,FALSE +intestinal crypt stem cell of small intestine,progenitor,FALSE +enterocyte of epithelium proper of ileum,epithelial,FALSE +smooth muscle fiber of ileum,muscle,FALSE +L6 intratelencephalic projecting glutamatergic neuron of the primary motor cortex,neuron,FALSE +ventricular cardiac muscle cell,muscle,FALSE +endocrine cell,endocrine,FALSE +mesenchymal stem cell,progenitor,FALSE +unknown,other,FALSE +neural cell,neuron,FALSE +cardiac neuron,neuron,FALSE +lamp5 GABAergic cortical interneuron,neuron,FALSE +chandelier pvalb GABAergic cortical interneuron,neuron,FALSE +L5 extratelencephalic projecting glutamatergic cortical neuron,neuron,FALSE +blood vessel endothelial cell,endothelial,FALSE +basal cell,epithelial,FALSE +intestinal crypt stem cell of colon,progenitor,FALSE +goblet cell,secretory,FALSE +bronchus fibroblast of lung,progenitor,FALSE +lung secretory cell,secretory,FALSE +metallothionein-positive alveolar macrophage,macrophage,TRUE +pancreatic ductal cell,endocrine,FALSE +pancreatic D cell,endocrine,FALSE +kidney collecting duct principal cell,renal,FALSE +kidney loop of Henle thin descending limb epithelial cell,epithelial,FALSE +periportal region hepatocyte,liver,FALSE +Merkel cell,sensory,FALSE +megakaryocyte-erythroid progenitor cell,blood,FALSE +endothelial tip cell,endothelial,FALSE +glandular cell of esophagus,epithelial,FALSE +kidney epithelial cell,epithelial,FALSE +podocyte,renal,FALSE +interstitial cell of ovary,stromal,FALSE +tracheal goblet cell,secretory,FALSE +lung ciliated cell,epithelial,FALSE +cortical interneuron,neuron,FALSE +ependymal cell,glial,FALSE +serous secreting cell of bronchus submucosal gland,epithelial,FALSE +enucleated reticulocyte,blood,FALSE +neuroblast (sensu Vertebrata),progenitor,FALSE +type I enteroendocrine cell,endocrine,FALSE +fibroblast of breast,stromal,FALSE +retinal cone cell,neuron,FALSE +enterocyte of epithelium of large intestine,epithelial,FALSE +H2 horizontal cell,neuron,FALSE +diffuse bipolar 3a cell,neuron,FALSE +starburst amacrine cell,neuron,FALSE +ON-blue cone bipolar cell,neuron,FALSE +duct epithelial cell,epithelial,FALSE +adipocyte of epicardial fat of left ventricle,fat,FALSE +osteoclast,bone,FALSE +adipocyte of breast,fat,FALSE +cell of skeletal muscle,muscle,FALSE +ganglion interneuron,neuron,FALSE +muscle cell,muscle,FALSE +Purkinje cell,neuron,FALSE +stellate neuron,neuron,FALSE +ON-bipolar cell,neuron,FALSE +forebrain radial glial cell,glial,FALSE +L2/3 intratelencephalic projecting glutamatergic neuron,neuron,FALSE +cerebral cortex neuron,neuron,FALSE +inhibitory motor neuron,neuron,FALSE +tuft cell of colon,epithelial,FALSE +respiratory goblet cell,secretory,FALSE +progenitor cell of endocrine pancreas,progenitor,FALSE +epithelial fate stem cell,epithelial,FALSE +enteroendocrine cell of small intestine,endocrine,FALSE +keratocyte,epithelial,FALSE +endocardial cell,endothelial,FALSE +cardiac mesenchymal cell,stromal,FALSE +L5/6 near-projecting glutamatergic neuron of the primary motor cortex,neuron,FALSE +Langerhans cell,immune,FALSE +surface ectodermal cell,epithelial,FALSE +serous cell of epithelium of trachea,epithelial,FALSE +epithelial cell of lacrimal sac,epithelial,FALSE +intraepithelial lymphocyte,progenitor,FALSE +pneumocyte,pneumocyte,FALSE +non-terminally differentiated cell,progenitor,FALSE +mononuclear cell,immune,FALSE +peripheral blood mononuclear cell,immune,FALSE +exhausted T cell,t,TRUE +endothelial cell of venule,endothelial,FALSE \ No newline at end of file diff --git a/inst/extdata/immune_map_monaco.csv b/inst/extdata/immune_map_monaco.csv new file mode 100755 index 00000000..970f26eb --- /dev/null +++ b/inst/extdata/immune_map_monaco.csv @@ -0,0 +1,38 @@ +from,to,is_immune +Naive CD8 T cells,cd8 naive,TRUE +Central memory CD8 T cells,cd8 tcm,TRUE +Effector memory CD8 T cells,cd8 tem,TRUE +Terminal effector CD8 T cells,cd8 tem,TRUE +MAIT cells,mait,TRUE +Vd2 gd T cells,tgd,TRUE +Non-Vd2 gd T cells,tgd,TRUE +Follicular helper T cells,cd4 fh em,TRUE +T regulatory cells,treg,TRUE +Th1 cells,cd4 th1 em,TRUE +Th1/Th17 cells,cd4 th1/th17 em,TRUE +Th17 cells,cd4 th17 em,TRUE +Th2 cells,cd4 th2 em,TRUE +Naive CD4 T cells,cd4 naive,TRUE +Progenitor cells,progenitor,TRUE +Naive B cells,b naive,TRUE +Naive B,b naive,TRUE +Non-switched memory B cells,b memory,TRUE +Nonswitched memory B,b memory,TRUE +Exhausted B cells,plasma,TRUE +Switched memory B cells,b memory,TRUE +Switched memory B,b memory,TRUE +Plasmablasts,plasma,TRUE +Classical monocytes,cd14 mono,TRUE +Intermediate monocytes,cd14 mono,TRUE +Non classical monocytes,cd16 mono,TRUE +Natural killer cells,nk,TRUE +Natural killer,nk,TRUE +Plasmacytoid dendritic cells,pdc,TRUE +Myeloid dendritic cells,cdc,TRUE +Myeloid dendritic,cdc,TRUE +Low-density neutrophils,granulocyte,TRUE +Lowdensity neutrophils,granulocyte,TRUE +Low-density basophils,granulocyte,TRUE +Lowdensity basophils,granulocyte,TRUE +Terminal effector CD4 T cells,cd4 tem,TRUE +progenitor,progenitor,TRUE \ No newline at end of file diff --git a/inst/extdata/immune_tree.csv b/inst/extdata/immune_tree.csv new file mode 100755 index 00000000..69d0adfc --- /dev/null +++ b/inst/extdata/immune_tree.csv @@ -0,0 +1,38 @@ +,b,b memory,b naive,plasma,ilc,nkt,nk,t,t cd4,cd4 naive,cd4 tcm,cd4 tem,cd4 fh em,cd4 th1/th17 em,cd4 th1 em,cd4 th2 em,cd4 th17 em,t cd8,cd8 naive,cd8 tcm,cd8 tem,tgd,treg,mait,cytotoxic,erythrocyte,granulocyte,monocytic,cd14 mono,cd16 mono,dc,cdc,pdc,macrophage,mast,progenitor,non immune +b,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +b memory,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +b naive,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +plasma,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +ilc,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +nkt,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +nk,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +t,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0 +t cd4,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 naive,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 tcm,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 tem,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 fh em,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 th1/th17 em,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 th1 em,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 th2 em,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd4 th17 em,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +t cd8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd8 naive,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd8 tcm,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd8 tem,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +tgd,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +treg,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +mait,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cytotoxic,0,0,0,0,2,0,2,0,0,0,0,0,0,0,0,0,0,2,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +erythrocyte,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +granulocyte,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +monocytic,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,2,0,0,0 +cd14 mono,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +cd16 mono,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +dc,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0 +cdc,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +pdc,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +macrophage,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +mast,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +progenitor,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +non immune,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 \ No newline at end of file diff --git a/inst/rmd/Doublet_identification_new.qmd b/inst/rmd/Doublet_identification_new.qmd new file mode 100644 index 00000000..c900f8d0 --- /dev/null +++ b/inst/rmd/Doublet_identification_new.qmd @@ -0,0 +1,171 @@ +--- +title: "Doublet Identification Report" +author: "SS" +date: "2024-04-29" +title-block-banner: true +format: + html: + theme: minty + df-print: paged + code-line-numbers: true + embed-resources: true +knitr: + opts_chunk: + message: false + warning: false + echo: false +comments: + hypothesis: + theme: clean +editor: visual +params: + data_object: "NA" + doublet_tbl: "NA" + annotation_tbl: "NA" + sample_names: "NA" +output: html_document +--- + +```{r setup, include=FALSE} +# Load libraries +library(purrr) +library(dplyr) +library(tidyr) +library(ggrepel) +library(Seurat) +library(glue) +library(scDblFinder) +library(tidyseurat) +library(tidySingleCellExperiment) +library(patchwork) +library(tibble) +library(scran) +library(magrittr) + +# Set consistent theme +theme_set(theme_minimal()) + +# Parameters +cell_ann_col <- "seurat_annotations" + +# UMAP Calculation +calc_UMAP <- function(input_seurat) { + assay_name <- input_seurat@assays |> names() |> extract2(1) + if (length(VariableFeatures(input_seurat)) == 0) { + input_seurat <- FindVariableFeatures(input_seurat) + } + var_genes <- VariableFeatures(input_seurat) + if (length(var_genes) > 0) { + ScaleData(input_seurat) |> + RunPCA(features = var_genes) |> + FindNeighbors(dims = 1:30) |> + FindClusters(resolution = 0.5) |> + RunUMAP(dims = 1:30, spread = 0.5, min.dist = 0.01, n.neighbors = 10L) |> + as_tibble() + } else { + stop("No variable features available for UMAP calculation.") + } +} + +# Helper function for cluster label positions +get_labels_clusters <- function(.data, label_column, dim1, dim2){ + label_column <- enquo(label_column) + dim1 <- enquo(dim1) + dim2 <- enquo(dim2) + .data %>% + nest(data = -!!label_column) %>% + mutate( + !!dim1 := map_dbl(data, ~ median(pull(.x, !!dim1))), + !!dim2 := map_dbl(data, ~ median(pull(.x, !!dim2))) + ) %>% + select(-data) +} + +# Generate UMAP +calc_UMAP_dbl_report <- map(params$data_object, calc_UMAP) +``` + +## Introduction + +This report contains UMAP representation of cell clusters and visualization of the distribution of doublets across processed samples. + +## UMAP Visualization of Cell Typing and Doublet Detection + +```{r, out.width='100%', fig.width=15, fig.height=10} +# Merge metadata +merged_data <- list( + calc_UMAP_dbl_report, + params$doublet_tbl, + params$annotation_tbl, + params$sample_names +) |> + pmap(~ ..1 |> + mutate(sample_column = ..4) |> + left_join(..2 |> mutate(sample_column = ..4), by = ".cell") |> + left_join(..3 |> mutate(sample_column = ..4), by = ".cell")) |> + enframe(name = "sample_id", value = "annotated_metadata") |> + mutate(sample_column = params$sample_names) + +# Plot UMAPs +plots_by_doublet <- merged_data |> + mutate(plot = map2( + annotated_metadata, sample_column, + ~ .x |> + ggplot(aes(umap_1, umap_2, color = scDblFinder.class)) + + geom_point(shape = ".", size = 1) + + labs( + title = paste("Doublet Detection -", .y), + x = "UMAP 1", + y = "UMAP 2", + color = "Classification" + ) + + ggrepel::geom_text_repel( + data = get_labels_clusters(.x, scDblFinder.class, umap_1, umap_2), + aes(label = scDblFinder.class), + size = 3 + ) + + guides(color = "none") + )) |> + pull(plot) |> + wrap_plots(ncol = 1) + +plots_by_doublet +``` + +## Singlet and Doublet Composition Across Samples + +```{r, out.width='100%', fig.width=15, fig.height=10} +# Bar Plot of Doublet vs Singlet proportions +composition_plot <- merged_data |> + mutate(composition = map( + annotated_metadata, + ~ .x |> + count(sample_column, !!sym(cell_ann_col), scDblFinder.class, name = "count") |> + group_by(sample_column, !!sym(cell_ann_col)) |> + mutate(proportion = count / sum(count)) |> + ungroup() + )) |> + mutate(plot = map(composition, ~ ggplot(.x, aes(x = !!sym(cell_ann_col), y = proportion, fill = scDblFinder.class)) + + geom_bar(stat = "identity") + + facet_wrap(~ sample_column, scales = "free_x") + + labs( + title = "Proportion of Singlets and Doublets per Cell Type", + x = "Cell Type", + y = "Proportion", + fill = "Classification" + ) + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + )) |> + pull(plot) |> + wrap_plots(ncol = 1) + +composition_plot +``` + +# Session Information + +```{r} +sessionInfo() +``` +``` + diff --git a/inst/rmd/Doublet_identification_report.Rmd b/inst/rmd/Doublet_identification_report.Rmd deleted file mode 100644 index 20101f4e..00000000 --- a/inst/rmd/Doublet_identification_report.Rmd +++ /dev/null @@ -1,253 +0,0 @@ ---- -title: "Doublet identification report" -author: "SS" -date: "2023-12-05" -output: html_document -params: - x1: "NA" - x2: "NA" - x3: "NA" - x4: "NA" - x5: "NA" - x6: "NA" ---- - -```{r setup, include=FALSE} -library(dplyr) -library(tidyr) -library(purrr) -# library(sccomp) -library(ggrepel) -library(Seurat) -library(glue) -library(scDblFinder) -library(Seurat) -library(tidyseurat) -library(tidySingleCellExperiment) -library(patchwork) -library(tibble) -library(scran) - -get_labels_clusters = function(.data, label_column, dim1, dim2){ - - tidy_dist = function(x1, x2, y1, y2){ - - tibble(x1, x2, y1, y2) %>% - rowwise() %>% - mutate(dist = matrix(c(x1, x2, y1, y2), nrow = 2, byrow = T) %>% dist()) %>% - pull(dist) - - } - - label_column = enquo(label_column) - dim1 = enquo(dim1) - dim2 = enquo(dim2) - - .data %>% - nest(data = -!!label_column) %>% - mutate( - !!dim1 := map_dbl(data, ~ .x %>% pull(!!dim1) %>% median()), - !!dim2 := map_dbl(data, ~ .x %>% pull(!!dim2) %>% median()) - ) %>% - dplyr::select(-data) -} -``` - -## Comprehensive UMAP Visualization of Cell Typing and Doublet Detection Across Tissue Samples -- This visualization highlights the clustering of cell types and identifies singlets and doublets in the population. -- This allows for an exploration of similarities and differences in gene expression profiles between cells from different tissues. - -```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} -## Adjusting plot size according to the number of samples -# num_samples <- length(params$x1$Tissue) -# -# # Calculate the grid layout based on the number of samples -# num_columns <- ceiling(sqrt(num_samples)) -# num_rows <- ceiling(num_samples / num_columns) - - -# Joining info and returning a list opf tibbles -merged_combined_annotation_doublets <- list( - #params$x1, - params$x2, - params$x3, - params$x4 -) |> - pmap( - ~ ..1 |> - left_join(..2, by = ".cell") |> - left_join(..3, by = ".cell") - #left_join(..4, by = ".cell") - ) |> - enframe(name = "sample_id", value = "annotated_metadata")|> - mutate( - sample_name = map(annotated_metadata, ~ .x |> pull(params$x5[[1]]))) |> - mutate(plot_by_doublet = map2( - annotated_metadata, - sample_name, - ~ { - #browser() - merged_combined_annotation_doublets = .x |> - - #Sample to non overwhelmm the plotting - nest(doublet_class = -scDblFinder.class) |> - mutate(number_to_sample = if_else(scDblFinder.class=="singlet", 10000, Inf)) |> - replace_na(list(number_to_sample = Inf)) |> - # mutate( - # doublet_class = map2(doublet_class, number_to_sample, ~ .x |> sample_n(min(n(), .y))) - # ) - unnest(doublet_class) - # doublet_plots <- plot_by_doublet$doublet_class[[1]]|> - - merged_combined_annotation_doublets |> - ggplot(aes(umap_1, umap_2, color = scDblFinder.class)) + - geom_point(shape=".", size = 10) + - theme_bw() + - labs(title = .y, color = "Cell Type") + - ggrepel::geom_text_repel( - data= get_labels_clusters( - .x, - scDblFinder.class, - umap_1, - umap_2 - ) , - aes(umap_1, umap_2, label = scDblFinder.class), size = 4) + - guides(color = "none")+ - labs(title = .y) - #print(plot_by_doublet) - #return(plot_by_doublet) - })) |> - - mutate(plot_by_cell_type = map2( - annotated_metadata, - sample_name, - ~ { - #browser() - merged_combined_annotation_doublets = .x |> - # Sample to non overwhelmm the plotting - nest(doublet_class = -scDblFinder.class) |> - mutate(number_to_sample = if_else(scDblFinder.class=="singlet", 10000, Inf)) |> - replace_na(list(number_to_sample = Inf)) |> - #mutate(doublet_class = map2(doublet_class, number_to_sample, ~ .x |> sample_n(min(n(), .y))))|> - unnest(doublet_class) - - merged_combined_annotation_doublets |> - ggplot(aes(umap_1, umap_2, color = all_of(params$x6))) + - geom_point(shape=".") + - theme_bw() + - labs(title = .y, color = "Cell Type") + - ggrepel::geom_text_repel( - data= get_labels_clusters( - .x, - all_of(params$x5), - umap_1, - umap_2 - ) , - aes(umap_1, umap_2, label = all_of(params$x5)), size = 2) + - guides(color = "none") + - labs(title = .y) - })) |> - mutate(overall_plot = map2(plot_by_doublet, plot_by_cell_type, - ~ .x + .y)) - -plot_merged_combined_annotation_doublets <- merged_combined_annotation_doublets |> - pull(overall_plot) |> - wrap_plots(ncol = 1) + - plot_layout(guides = 'collect') - # theme( - # legend.position = "bottom", - # plot.margin = margin(10, 10, 10, 10, "cm") - # ) - -# Print plot -plot_merged_combined_annotation_doublets - # patchwork::wrap_elements() |> - # map(~ .x |> - # left_join( - # params$x4 |> - # purrr::reduce(bind_rows), by=".cell" - # ) |> - # - # #join doublets identified - # left_join( - # params$x3 |> - # purrr::reduce(bind_rows), by = c(".cell") - # ) - # ) - -``` - -## Singlet and Doublet Cell Distributions Across Tissues - -Each bar in the plot corresponds to a specific cell type within each tissue. - -From this plot, we can infer: - -1. The overall quality of the cell separation process in the sequencing data, indicated by the proportion of singlets to doublets. -2. Potential differences in the rate of doublet formation between cell types, which might be related to cell size and tissue type - -```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} -# 2a) Create the composition of the doublets - -doublet_composition<- merged_combined_annotation_doublets |> - mutate(doublet_composition = map2( - annotated_metadata, - sample_name, - ~ { - #browser() - .x|> - dplyr::select(all_of(params$x5), scDblFinder.class)} - )) |> - # table()|> - dplyr::select(sample_name, doublet_composition) |> - deframe() - - # merged_combined_annotation_doublets <- - # merged_combined_annotation_doublets |> - # mutate(doublet_composition_plot = doublet_composition |> - # group_by(params$x5, all_of(params$x5)) |> - # mutate(proportion = count_class/sum(count_class)) |> - # ungroup() - # ) - -# calculate proportion and plot -#calculate proportion and plot - merged_combined_annotation_doublets <- - merged_combined_annotation_doublets |> - mutate(doublet_composition_plot = map( - annotated_metadata, - ~ .x |> - # browser() |> - # create frequency column - dplyr::count(.data[[params$x5]], .data[[params$x6]], scDblFinder.class, name= "count_class") |> - group_by(.data[[params$x5]], .data[[params$x6]]) |> - mutate(proportion = count_class/sum(count_class)) |> - ungroup() |> - - # mutate(frequency = nCount_SCT/sum(nCount_SCT)*100) |> - # - # # create the proportion column - # group_by(sample, scDblFinder.class) |> - # mutate(tot_sample_proportion = sum(frequency)) |> - # mutate(proportion = (frequency * 1)/tot_sample_proportion) |> - - #plot proportion - ggplot(aes(x = .data[[params$x6]] , y = proportion, fill = scDblFinder.class)) + - geom_bar(stat = "identity") + - theme_bw() + - facet_wrap(~sampleName) + - theme(axis.text.x=element_text(angle=70, hjust=1)) - )) - - plot_merged_combined_annotation_doublets<- merged_combined_annotation_doublets|> - pull(doublet_composition_plot)|> - wrap_plots(ncol = 1) + - plot_layout(guides = 'collect') - -# Print plot -plot_merged_combined_annotation_doublets - -``` - - - diff --git a/inst/rmd/Doublet_identification_report.qmd b/inst/rmd/Doublet_identification_report.qmd new file mode 100644 index 00000000..81ac71c5 --- /dev/null +++ b/inst/rmd/Doublet_identification_report.qmd @@ -0,0 +1,311 @@ +--- +title: "Doublet Identification Report" +date: 31 Mar 2024 +title-block-banner: true +author: SS +format: + html: + theme: minty + df-print: paged + code-line-numbers: true + embed-resources: true +knitr: + opts_chunk: + message: false + warning: false + echo: false +comments: + hypothesis: + theme: clean +editor: visual +params: + data_object: "NA" + doublet_tbl: "NA" + annotation_tbl: "NA" + sample_names: "NA" +output: html_document +--- + +## Introduction + +This report contains UMAP representation of cell clusters and visualization of the distribution of doublets across processed samples. + +```{r setup, include=FALSE} +library(purrr) +library(dplyr) +library(tidyr) +library(ggrepel) +library(Seurat) +library(glue) +library(scDblFinder) +library(tidyseurat) +library(tidySingleCellExperiment) +library(patchwork) +library(tibble) +library(scran) +library(magrittr) +library(dplyr) +library(tidyr) +library(purrr) +library(ggrepel) +library(Seurat) +library(glue) +library(scDblFinder) +library(Seurat) +library(tidyseurat) +library(tidySingleCellExperiment) +library(patchwork) +library(tibble) +library(scran) +library(purrr) + +cell_ann_col <- "seurat_annotations" + +theme_set(theme_minimal(base_size = 12)) # or theme_bw(base_size = 12) + +common_theme <- theme( + plot.title = element_text(size = 14, face = "bold"), + axis.title = element_text(size = 12), + axis.text = element_text(size = 10), + legend.title = element_text(size = 11), + legend.text = element_text(size = 10) +) +``` + +```{r, include=FALSE} +calc_UMAP <- function(input_seurat) { + assay_name <- input_seurat@assays |> names() |> extract2(1) + + # Check if variable features are already present, if not calculate them + if (length(VariableFeatures(input_seurat)) == 0) { + input_seurat <- FindVariableFeatures(input_seurat) + } + + # Extract variable features using VariableFeatures() for Seurat v5 + var_genes <- VariableFeatures(input_seurat) + + # Ensure that there are variable features before proceeding + if (length(var_genes) > 0) { + # Scale data and run PCA on variable genes + x <- ScaleData(input_seurat) |> + RunPCA(features = var_genes) |> + FindNeighbors(dims = 1:30) |> + FindClusters(resolution = 0.5) |> + RunUMAP(dims = 1:30, spread = 0.5, min.dist = 0.01, n.neighbors = 10L) |> + as_tibble() + } else { + stop("No variable features available for UMAP calculation.") + } + + return(x) +} + +calc_UMAP_dbl_report <- map(params$data_objec, calc_UMAP) + +``` + +```{r, include=FALSE} + +get_labels_clusters = function(.data, label_column, dim1, dim2){ + + tidy_dist = function(x1, x2, y1, y2){ + + tibble(x1, x2, y1, y2) %>% + rowwise() %>% + mutate(dist = matrix(c(x1, x2, y1, y2), nrow = 2, byrow = T) %>% dist()) %>% + pull(dist) + + } + + label_column = enquo(label_column) + dim1 = enquo(dim1) + dim2 = enquo(dim2) + + .data %>% + nest(data = -!!label_column) %>% + mutate( + !!dim1 := map_dbl(data, ~ .x %>% pull(!!dim1) %>% median()), + !!dim2 := map_dbl(data, ~ .x %>% pull(!!dim2) %>% median()) + ) %>% + dplyr::select(-data) +} +``` + +## Comprehensive UMAP Visualization of Cell Typing and Doublet Detection Across Tissue Samples + +- This visualization highlights the clustering of cell types and identifies singlets and doublets in the population. +- This allows for an exploration of similarities and differences in gene expression profiles between cells from different tissues. + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} +# Joining info and returning a list of tibbles +merged_combined_annotation_doublets <- list( + calc_UMAP_dbl_report, + params$doublet_tbl, + params$annotation_tbl, + params$sample_names +) |> + pmap( + ~ ..1 |> + mutate(sample_column = ..4) |> + left_join(..2 |> mutate(sample_column = ..4), by = ".cell") |> + left_join(..3 |> mutate(sample_column = ..4), by = ".cell") + ) |> + enframe(name = "sample_id", value = "annotated_metadata") |> + mutate( + sample_column = sample_names # Using the sample_names list you already have + ) |> + mutate(plot_by_doublet = map2( + annotated_metadata, + sample_column, + ~ { + # Sample to not overwhelm the plotting + merged_combined_annotation_doublets = .x |> + nest(doublet_class = -scDblFinder.class) |> + mutate(number_to_sample = if_else(scDblFinder.class == "singlet", 10000, Inf)) |> + replace_na(list(number_to_sample = Inf)) |> + unnest(doublet_class) + + # UMAP plot by doublet class + merged_combined_annotation_doublets |> + ggplot(aes(umap_1, umap_2, color = scDblFinder.class)) + + geom_point(shape = ".", size = 10) + + # theme_bw() + + labs(title = .y, color = "Cell Type") + + ggrepel::geom_text_repel( + data = get_labels_clusters( + .x, + scDblFinder.class, + umap_1, + umap_2 + ), + aes(umap_1, umap_2, label = scDblFinder.class), size = 3 + ) + + guides(color = "none") + + labs(title = .y) + + common_theme + } + )) |> + mutate(plot_by_cell_type = map2( + annotated_metadata, + sample_names, + ~ { + # Sample to not overwhelm the plotting + merged_combined_annotation_doublets = .x |> + nest(doublet_class = -scDblFinder.class) |> + mutate(number_to_sample = if_else(scDblFinder.class == "singlet", 10000, Inf)) |> + replace_na(list(number_to_sample = Inf)) |> + unnest(doublet_class) + + # UMAP plot by cell annotation + merged_combined_annotation_doublets |> + ggplot(aes(umap_1, umap_2, color = !!sym(cell_ann_col))) + # Using the cell annotation column dynamically + geom_point(shape = ".") + + # theme_minimal() + + common_theme + + labs(title = .y, color = "Cell Type") + + ggrepel::geom_text_repel( + data = get_labels_clusters( + .x, + !!sym(cell_ann_col), # Assuming cell_ann_col contains your cell annotations + umap_1, + umap_2 + ), + aes(umap_1, umap_2, label = !!sym(cell_ann_col)), size = 3 + ) + + guides(color = "none") + + labs(title = .y) + } + )) |> + mutate(overall_plot = map2(plot_by_doublet, plot_by_cell_type, + ~ .x + .y)) + +# Combine the plots +plot_merged_combined_annotation_doublets <- merged_combined_annotation_doublets |> + pull(overall_plot) |> + wrap_plots(ncol = 1) + + plot_layout(guides = 'collect') + +# Print plot +plot_merged_combined_annotation_doublets + + +``` + +## Singlet and Doublet Cell Distributions Across Tissues + +Each bar in the plot corresponds to a specific cell type within each tissue. + +From this plot, we can infer: + +1. The overall quality of the cell separation process in the sequencing data, indicated by the proportion of singlets to doublets. +2. Potential differences in the rate of doublet formation between cell types, which might be related to cell size and tissue type + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} +# 2a) Create the composition of the doublets +doublet_composition<- merged_combined_annotation_doublets |> + mutate(doublet_composition = map2( + annotated_metadata, + sample_column, + ~ { + #browser() + .x|> + dplyr::select(sample_column, scDblFinder.class)} + )) |> + # table()|> + dplyr::select(sample_column, doublet_composition) |> + deframe() + + # merged_combined_annotation_doublets <- + # merged_combined_annotation_doublets |> + # mutate(doublet_composition_plot = doublet_composition |> + # group_by(x5, all_of(x5)) |> + # mutate(proportion = count_class/sum(count_class)) |> + # ungroup() + # ) + +#calculate proportion and plot +merged_combined_annotation_doublets <- + merged_combined_annotation_doublets |> + mutate(doublet_composition_plot = map( + annotated_metadata, + ~ .x |> + # browser() |> + # create frequency column + dplyr::count(.data$sample_column, .data[[cell_ann_col]], scDblFinder.class, name= "count_class") |> + group_by(.data$sample_column, .data[[cell_ann_col]]) |> + mutate(proportion = count_class/sum(count_class)) |> + ungroup() |> + + # mutate(frequency = nCount_SCT/sum(nCount_SCT)*100) |> + # + # # create the proportion column + # group_by(sample, scDblFinder.class) |> + # mutate(tot_sample_proportion = sum(frequency)) |> + # mutate(proportion = (frequency * 1)/tot_sample_proportion) |> + + #plot proportion + ggplot(aes(x = .data[[cell_ann_col]] , y = proportion, fill = scDblFinder.class)) + + geom_bar(stat = "identity") + + # theme_minimal() + + common_theme + + facet_wrap(~ sample_column) + + theme(axis.text.x=element_text(angle=70, hjust=1)) + )) + +plot_merged_combined_annotation_doublets<- merged_combined_annotation_doublets|> + pull(doublet_composition_plot)|> + wrap_plots(ncol = 1) + + plot_layout(guides = 'collect') + +# Print plot +plot_merged_combined_annotation_doublets + +``` + +::: + +# Session Info + +```{r} +sessionInfo() +``` diff --git a/inst/rmd/Empty_droplet_report.Rmd b/inst/rmd/Empty_droplet_report.Rmd deleted file mode 100644 index 215e2a88..00000000 --- a/inst/rmd/Empty_droplet_report.Rmd +++ /dev/null @@ -1,398 +0,0 @@ ---- -title: "Empty droplet report" -author: "SS" -date: "2023-12-07" -output: html_document -params: - x1: "NA" - x2: "NA" - x3: "NA" - x4: "NA" - x5: "NA" ---- - -```{r, warning=FALSE, message=FALSE, echo=FALSE} -library(HPCell) -library(readr) -library(dplyr) -library(tidyr) -library(ggplot2) -library(purrr) -library(Seurat) -library(tidyseurat) -library(glue) -library(scater) -library(DropletUtils) -library(EnsDb.Hsapiens.v86) -library(here) -library(stringr) -library(rlang) -library(scuttle) -library(scDblFinder) -library(ggupset) -library(tidySummarizedExperiment) -library(broom) -library(tarchetypes) -library(SeuratObject) -library(SingleCellExperiment) -library(SingleR) -library(celldex) -library(tidySingleCellExperiment) -library(tibble) -library(magrittr) -library(qs) -library(S4Vectors) - -# Subsetting tissues in input data -# unique_tissues <- unique(input_seurat_abc@meta.data$Tissue) - -assay = params$x1[[1]]@assays |> names() |> extract2(1) -# Subset 2 tissues (sample types) -# heart <- subset(input_seurat, subset = Tissue == "Heart") -# trachea <- subset(input_seurat, subset = Tissue == "Trachea") -# params$x1 <- c(heart, trachea) - -# # ma plot: mito is green, ribo is red -# col <- rep('black',ncol(empty_droplets_tbl)) -# col[rownames(empty_droplets_tbl) %in% mito_genes] <-'green' -# col[rownames(empty_droplets_tbl) %in% ribo_genes] <-'red' -# -# Process input data -# process_input <- function(input_seurat) { -# #browser() -# input<- input_seurat@meta.data |> -# tibble::rownames_to_column(var = '.cell') -# -# # grep('^MT-', rownames(input_seurat[['RNA']]), value=T) -# #define mito and ribo genes and add the plot: -# mito_genes <- grep('^MT-', rownames(input_seurat[[assay]]), value=T) -# ribo_genes <-grep('^RP(S|L)', rownames(input_seurat[[assay]]), value=T) -# -# col <- rep('cornflowerblue',ncol(input_seurat)) -# col[rownames(input_seurat) %in% mito_genes] <-'green' -# col[rownames(input_seurat) %in% ribo_genes] <-'red' -# col[rownames(input_seurat) %in% NA] <-'grey' -# sample_numbers = 1:length(list(input_seurat)) -# #sample_names <- unique(input$Tissue) -# } -# processed_input_list <- map(params$x1, process_input) - -# input <- input_seurat@meta.data |> -# tibble::rownames_to_column(var = '.cell') -# -# joined_data <- empty_droplets_tbl |> -# left_join(input |> dplyr::select(.cell, Tissue), by = '.cell') - -# Defining Tissue names -# sample_names <- sapply(1:length(params$x1), function(i) { -# #browser() -# return(params$x1[[i]][[i]]) -# }) -# - -# sample_names <- lapply(params$x1, function(seurat_obj) { -# unique(seurat_obj$Tissue) -# }) -# sample_names<- unlist(sample_names) -# -# sample_names <- sapply(1:length(params$x1), function(i) { -# return(params$x1[[i]][[1]][[1]]) -# }) -# sample_names -process_input<- function(input_seurat) { - input<- input_seurat@meta.data |> - tibble::rownames_to_column(var = '.cell') - return(input) -} -processed_input_list <- map(params$x1, process_input) - -# Defining Tissue names -# sample_names <- lapply(params$x1, function(seurat_obj) { -# seurat_obj |> pull(params$x5) -# }) -sample_names<- params$x4 -# sample_names<- unlist(sample_names) -``` - -## Barcode rank plot -```{r echo=FALSE, message=FALSE, warning=FALSE} -# Process empty droplets data -empty_df <- function(input_seurat, empty_droplets_tbl) { - input <- input_seurat@meta.data |> - tibble::rownames_to_column(var = '.cell') - - joined_data <- empty_droplets_tbl |> - left_join(input |> dplyr::select(.cell, params$x5), by = '.cell') - - # Create a data frame with plotting information - plot_data <- data.frame( - x = joined_data$rank, - y = joined_data$total, - rank = joined_data$rank, - inflection = joined_data$inflection, - knee = joined_data$knee, - fitted = joined_data$fitted, - empty = joined_data$empty_droplet, - FDR = joined_data$FDR, - Total = joined_data$Total, - PValue = joined_data$PValue - ) - return(plot_data) -} - - -process_empty_droplet_list <- purrr::map2(params$x1, params$x2, empty_df) - -# Combined tibble with an identifier for each tissue/sample -combined_df <- bind_rows(process_empty_droplet_list, .id = "tissue_id") %>% - mutate(tissue_id = factor(tissue_id, labels = params$x4)) - -# Generate plot -plot <- ggplot(combined_df, aes(x = x, y = y)) + - geom_point(color = 'lightblue', alpha = 0.5) + - scale_x_log10() + - scale_y_log10() + - geom_line(aes(x = rank, y = fitted), color='darkblue') + - geom_hline(aes(yintercept = knee), color='red') + - geom_hline(aes(yintercept = inflection), color='forestgreen') + - scale_linetype_manual(values = c("knee" = "dashed", "inflection" = "dashed"), - guide = guide_legend(override.aes = list(color = c("forestgreen", "red"))) - ) + - facet_wrap(~tissue_id, scales = "free") + - theme_minimal() + - labs(x = "Barcodes", y = "Total UMI count", color = "Legend") + - theme(legend.position = "bottom") # Adjust legend position as needed - -print(plot) -``` - -## Proportion of empty droplets -```{r, warning=FALSE, message=FALSE, echo=FALSE} -empty_count <- function(df) { - # Count the TRUE and FALSE values in the empty_droplet column - tibble <- df %>% - group_by(tissue_id) %>% - summarise( - Empty_count = sum(empty == TRUE), - Cell_count = sum(empty == FALSE) - ) - return(tibble) -} - -# Apply the function to the combined_df -empty_count_results <- empty_count(combined_df) -empty_count_results -``` - -## Number and proportion of cells (non-empty droplets), everything above knee is retained. -```{r, warning=FALSE, message=FALSE, echo=FALSE} -# Number of non-empty droplets ------------------------------------------------- -empty_table <- function(df) { - # Count the TRUE and FALSE values in the empty_droplet column - tibble <- df %>% - group_by(tissue_id) %>% - summarise( - "Number: True cells (FDR<0.001)" = sum(FDR < 0.001, na.rm = TRUE), # Count of FDR values less than 0.001 - "Proportion: True cells (FDR<0.001)" = mean(FDR < 0.001, na.rm = TRUE) # Proportion of FDR values less than 0.001 - ) - return(tibble) -} -empty_count_results <- empty_table(combined_df) -empty_count_results -``` - - - - - - - - - - - - - - - - - - -## Histogram of p-values: (only if empty droplets have been identified) - -- Shows the distribution of p-values for droplets in the lower 10 percentile of total within each tissue -- A low p-value signifies significance therefore we would reject those droplets as empty -```{r, warning=FALSE, message=FALSE, echo=FALSE} -hist_p_val <- function(df) { - if(df |> dplyr::filter(empty) |> nrow() != 0){ - df_filtered <- df %>% - group_by(tissue_id) %>% - dplyr::filter(empty) %>% - mutate(Total_quantile = quantile(Total[Total > 0], 0.1)) %>% - dplyr::filter(Total <= Total_quantile & Total > 0) %>% - ungroup() - -plot_hist <- ggplot(df_filtered, aes(x = PValue)) + - geom_histogram(binwidth = 0.2, fill = "cornflowerblue", color = "grey") + - facet_wrap(~ tissue_id) + - labs(x = "P-value", y = "Frequency") + - ggtitle("Droplets with 0 < libsize <= 10th Percentile of Total per Tissue") + - theme_minimal() -}} - -plot_hist <- hist_p_val(combined_df) -plot_hist -``` - -## Percentage of reads assigned to mitochondrial transcrips against library size - -Scatter plot comparing mitochondrial content percentage to total count of RNA sequencing reads across different samples (in this case tissues) - -The X-axis is on a logarithmic scale and represents the total count of RNA sequencing reads per cell, while the Y-axis shows the percentage of those reads that are mitochondrial. Each point on the plot represents a single cell. - -```{r, warning=FALSE, message=FALSE, echo=FALSE} -plot_mito_data <- function(input_seurat, tissue_name, annotation_labels){ - #browser() - rna_counts <- GetAssayData(input_seurat, layer = "counts", assay=assay) - which_mito = rownames(input_seurat) |> str_which("^MT") - # Compute per-cell QC metrics - qc_metrics <- perCellQCMetrics(rna_counts, subsets=list(Mito=which_mito)) %>% - as_tibble(rownames = ".cell") %>% - dplyr::select(-sum, -detected) - - #Identify mitochondrial content - # mitochondrion <- qc_metrics %>% - # left_join(annotation_labels, by = ".cell") %>% - # nest(data = -blueprint_first.labels.fine) %>% - # mutate(data = map(data, ~ .x %>% - # mutate(high_mitochondrion = isOutlier(subsets_Mito_percent, type="higher"), - # high_mitochondrion = as.logical(high_mitochondrion)))) %>% - # unnest(cols = data) - mitochondrion <- qc_metrics %>% - left_join(annotation_labels, by = ".cell") %>% - mutate(high_mitochondrion = isOutlier(subsets_Mito_percent, type="higher")) %>% - mutate(high_mitochondrion = as.logical(high_mitochondrion), - tissue_name = tissue_name) %>% - group_by(tissue_name) %>% - mutate( - discard = isOutlier(subsets_Mito_percent, type = "higher"), - threshold = attr(discard, "threshold")["higher"] - ) %>% - ungroup() - - # discard <- isOutlier(mitochondrion$subsets_Mito_percent, type = "higher") - # threshold <- attr(discard, "threshold")["higher"] - plot_mito <- data.frame( - tissue_name = tissue_name, - # qc_metrics = qc_metrics, - # mitochondrion = mitochondrion, - discard = as.logical(mitochondrion$discard), - threshold = mitochondrion$threshold, - high_mitochondrion = mitochondrion$high_mitochondrion, - subsets_Mito_sum = mitochondrion$subsets_Mito_sum, - subsets_Mito_percent = mitochondrion$subsets_Mito_percent - ) - return(plot_mito) -} - -all_data <- lapply(seq_along(params$x1), function(i) { - plot_mito_data(params$x1[[i]], sample_names[[i]], params$x3[[i]]) -}) - -# Combine all data into a single tibble -combined_plot_mito_data <- bind_rows(all_data) - -plot_each_sample <- function(combined_plot_mito_data) { - # browser() - num_tissues <- length(unique(combined_plot_mito_data$tissue_name)) - plot <- ggplot(combined_plot_mito_data, aes(x = subsets_Mito_sum, y = subsets_Mito_percent)) + - facet_wrap(~ tissue_name) + - geom_point(aes(color = combined_plot_mito_data$high_mitochondrion), alpha = 0.5) + - scale_x_log10() + - geom_hline(yintercept = combined_plot_mito_data$threshold, color = "red", linetype = "dashed") + - labs(x = "Total count", y = "Mitochondrial %", - title = paste("Percentage library size vs library size with", num_tissues, "tissue types"), - color = "High mitochondrial percentage") + - theme_minimal() - - # unique_tissues <- unique(combined_plot_mito_data$tissue_name) - # for(tissue in unique_tissues) { - # tissue_data <- combined_plot_mito_data[combined_plot_mito_data$tissue_name == tissue,] - # threshold_value <- unique(tissue_data$threshold) # assuming there's one threshold per tissue - # plot <- plot + geom_hline(data = tissue_data, aes(yintercept = threshold_value), color = "red", linetype = "dashed") - # - # } - return(plot) -} -plot_each_sample(combined_plot_mito_data) - -``` - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/inst/rmd/Technical_variation_report.Rmd b/inst/rmd/Technical_variation_report.Rmd deleted file mode 100644 index ec7e0ae8..00000000 --- a/inst/rmd/Technical_variation_report.Rmd +++ /dev/null @@ -1,171 +0,0 @@ ---- -title: "Technical variation report" -author: "SS" -date: "2023-12-05" -output: html_document -params: - x1: "NA" - x2: "NA" - x3: "NA" - x4: "NA" - x5: "NA" ---- -```{r setup, include=FALSE} -# assay_of_choice = "originalexp" -metadata_list <- lapply(params$x1, function(seurat_obj) { - return(seurat_obj@meta.data) -}) -# variable_genes_per_sample = -# -# # input -# tibble( -# seurat_obj_list = params$x1, -# empty_droplets_obj_list = params$x2 -# ) |> -# -# # Reading input -# mutate(variable_genes = map2( -# seurat_obj_list, empty_droplets_obj_list, -# ~ { -# #browser() -# seu = .x -# if("HTO" %in% names(seu@assays)) seu[["HTO"]] = NULL -# if("ADT" %in% names(seu@assays)) seu[["ADT"]] = NULL -# -# -# # Filter -# seu |> -# left_join(.y) |> -# dplyr::filter(!empty_droplet) |> -# -# # Scale -# ScaleData(assay=assay_of_choice, return.only.var.genes=FALSE) |> -# -# # Variable features -# FindVariableFeatures(assay=assay_of_choice, nfeatures = 500) |> -# VariableFeatures(assay=assay_of_choice) -# } -# )) -# - -my_variable_genes = params$x3 |> - # pull(variable_genes) |> - unlist() -# unique() - -``` - -## UMAP colored by Tissue - -```{r echo=FALSE, message=FALSE, warning=FALSE} -# data_umap = -# -# # input -# dplyr::tibble( -# seurat_obj_list = params$x1, -# empty_droplets_obj_list = params$x2 -# ) |> -# -# # Reading input -# dplyr::mutate(variable_genes = purrr::map2( -# seurat_obj_list, empty_droplets_obj_list, -# ~ { -# #browser() -# seu = .x -# empty_droplets = .y -# # Remove HTO and ADT assays if they are present -# # if("HTO" %in% names(seu@assays)) seu[["HTO"]] = NULL -# # if("ADT" %in% names(seu@assays)) seu[["ADT"]] = NULL -# if("HTO" %in% names(seu@assays)) { -# seu <- RemoveAssays(seu, assays = "HTO") -# } -# if("ADT" %in% names(seu@assays)) { -# seu <- RemoveAssays(seu, assays = "ADT") -# } -# -# # Filter empty droplets -# # seu = -# # seu |> -# # left_join(.y) |> -# # dplyr::filter(!empty_droplet) -# cells_to_keep <- empty_droplets %>% -# dplyr::filter(!empty_droplet) %>% -# pull(.cell) -# -# seu <- subset(seu, cells = cells_to_keep) -# -# variable_genes_present <- intersect(my_variable_genes, rownames(seu)) -# sampled_genes <- sample(variable_genes_present, min(length(variable_genes_present), 1000)) -# seu <- seu[sampled_genes, ] -# -# return(seu) -# # seu = -# # seu[my_variable_genes,] |> -# # slice_sample( n=min(ncol(seu), 1000), replace = FALSE ) -# } -# )) - -# data_umap = map(params$x1, function(seu) { -# #browser() -# seu <- ScaleData(seu, assay = assay_of_choice, features = rownames(seu), return.only.var.genes = FALSE) -# VariableFeatures(seu) <- my_variable_genes -# seu<- RunPCA(seu, dims = 1:30, assay=assay_of_choice) |> -# RunUMAP(dims = 1:30, spread = 0.5,min.dist = 0.01, n.neighbors = 10L) -# # as_tibble() |> -# # left_join(input_metadata) -# -# # Extract UMAP coordinates and any other relevant data for plotting -# umap_data <- FetchData(seu, vars = c("umap_1", "umap_2", "Tissue")) -# -# return(umap_data) -# }) %>% bind_rows() - - # #unnest(variable_genes) %>% - # ScaleData(assay=assay_of_choice, return.only.var.genes=FALSE) %>% - # # Variable genes - # { - # .x = (.) - # VariableFeatures(.x) = my_variable_genes - # .x - # } |> - # - # # UMAP - # RunPCA(dims = 1:30, assay=assay_of_choice) |> - # RunUMAP(dims = 1:30, spread = 0.5,min.dist = 0.01, n.neighbors = 10L) |> - # as_tibble() |> - # - # left_join(input_metadata) -data_umap<- params$x4 %>% bind_rows() -# Plot -plot_tissue_color = - data_umap |> - dplyr::mutate(batch = 1) |> - ggplot(aes(umap_1, umap_2, color = data_umap[[params$x5]])) + # Ensure 'Tissue' is a column in 'data_umap' - geom_point(size = 0.2) + - facet_wrap(~data_umap[[params$x5]]) + - theme_minimal() + - labs(title = "UMAP colored by Tissue", color = "data_umap[[params$x5]]") - -# plot_severity_color = -# data_umap |> -# mutate(batch = 1) |> -# # UMAP -# ggplot(aes(umap_1, umap_2, color = severity)) + -# geom_point(size=0.2) + -# facet_wrap(~batch) + -# guides(color="none") + -# theme_multipanel - -# plot_batch_color = -# data_umap |> -# -# mutate(batch = 1) |> -# -# # UMAP -# ggplot(aes(UMAP_1, UMAP_2, color = batch)) + -# geom_point(size=0.2) + -# theme_multipanel -print(plot_tissue_color) -``` - - diff --git a/inst/rmd/pseudobulk_analysis_report.Rmd b/inst/rmd/pseudobulk_analysis_report.Rmd deleted file mode 100644 index fecb69a5..00000000 --- a/inst/rmd/pseudobulk_analysis_report.Rmd +++ /dev/null @@ -1,194 +0,0 @@ ---- -title: "pseudobulk analysis report" -author: "SS" -date: "2024-01-24" -output: html_document -params: - x1: "NA" - x2: "NA" - x3: "NA" ---- - -```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} -library(ggplot2) -library(stringr) -library(tidyverse) -library(tidybulk) -library(tidyseurat) -#library(tidysc) -library(tidyHeatmap) -library(purrr) -library(patchwork) -library(grid) -library(ComplexHeatmap) -library(ggrepel) -library(PCAtools) -library(tidySummarizedExperiment) -library(glue) -library(purrr) -library(plotly) -library(tidybulk) -#library(naniar) #NA -library(magrittr) -library(here) -``` - -```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} -# Load data -# pseudobulk <- do.call(cbind, params$x1) -pseudobulk <- params$x1 -#metadata_clinical_sample <- readRDS(params$metadata_path) -library(ggplot2) -# pseudobulk <- params$x1 -# Extract the proportion of variance explained by each principal component -# var_explained <- my_pca$sdev^2 -# var_explained <- var_explained / sum(var_explained) -# cum_var_explained <- cumsum(var_explained) - -# Find the number of components that explain at least 90% of the variance -# num_components <- which(cum_var_explained >= 0.9)[1] -``` - - -```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} -#pbmc_pseudobulk from sce: -pbmc_pseudobulk <- - pseudobulk %>% - # filter(data_source == assay) |> - #separate( .sample, c("single_cell_rna_id", "batch1"), "__" , remove=FALSE) |> - #left_join(metadata_clinical_sample |> tidybulk::pivot_sample(sample)) |> - tidybulk::identify_abundant() %>% - tidybulk::scale_abundance(method = "TMMwsp") - -data_for_pca = - pbmc_pseudobulk |> - keep_abundant() |> - keep_variable(.abundance = "count_scaled", top=500) |> - dplyr::select(-TMM, -multiplier, -count_scaled) |> - tidybulk::scale_abundance(method = "TMMwsp") -``` - -## Checking that the input counts don't have global sequencing-depth effect - -```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} - -data_for_pca |> - ggplot(aes(count_scaled + 1, color=.sample)) + geom_density(alpha=0.3) + scale_x_log10() + guides(color="none") -``` - -## Calculate PCA of pseudobulk - -```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} -metadata = - data_for_pca |> - pivot_sample() |> - dplyr::select(any_of(params$x2), .sample, alive, any_of(params$x3), .aggregated_cells) - -metadata = as.data.frame(metadata) -rownames(metadata) = metadata$`.sample` -# metadata = metadata[,-1] - -my_pca = - data_for_pca@assays@data$count_scaled |> - log1p() |> - scale() |> - pca(metadata = metadata) -# -# Extract the proportion of variance explained by each principal component -var_explained <- my_pca$sdev^2 -var_explained <- var_explained / sum(var_explained) -cum_var_explained <- cumsum(var_explained) - -# Find the number of components that explain at least 90% of the variance -num_components <- which(cum_var_explained >= 0.9)[1] -## Without metadata -# my_pca = -# data_for_pca@assays@data$count_scaled |> -# log1p() |> -# scale() |> -# prcomp() - -``` - -```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} -# Find the number of components that explain at least 90% of the variance -num_components <- which(cum_var_explained >= 0.9)[1] -``` - -## Scree plot -Graphical representation to show the proportion of variance explained by each principal component. -This gives an idea of how many principal components we need to keep to represent the data faithfully. In this case we see a gradual decrease of variance explained, indicating that we might need up to principal component `num_components` for explaining 90% of the variance. - -```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} -library(ggplot2) - -# # Extract the proportion of variance explained by each principal component -# var_explained <- my_pca$sdev^2 -# var_explained <- var_explained / sum(var_explained) -# cum_var_explained <- cumsum(var_explained) - -# Create a data frame for plotting -scree_data <- data.frame(PC = seq_along(var_explained), Variance = var_explained) - -# Create the scree plot -ggplot(scree_data, aes(x = PC, y = Variance)) + - geom_line() + - geom_point() + - theme_minimal() + - labs(title = "Scree Plot", x = "Principal Component", y = "Proportion of Variance Explained") -``` - -## Principal Component Associations with Biological Variables -Here we see which variable is associated with which principal component. We hope the biological variable are associated with the top principal components. - -In our sample data set we're clustering by Tissue type: Samples from the same tissue type cluster together in the PCA space, which indicates that the gene expression profiles are similar within a tissue type - -The distance of the points from the origin (where PC1 and PC2 both equal zero) indicates how much variance each sample has relative to the principal components. Samples that are further out along PC1 or PC2 axes have higher variance for those components. - -```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} -# x<- plot(my_pca$rotated[, "PC1"], my_pca$rotated[, "PC2"], -# xlab = "PC1", ylab = "PC2", -# main = "PCA Plot", -# asp = 1) -# x - -x<- ggplot(my_pca$metadata, aes(x = my_pca$rotated[, "PC1"], y = my_pca$rotated[, "PC2"], color = my_pca$metadata[[params$x2]])) + - geom_point() + - theme_minimal() + - labs(title = "PCA Plot Colored by Tissue Type", - x = "Principal Component 1", - y = "Principal Component 2") + - scale_color_discrete(name = "Tissue Type") -x -``` - -## Cell type clustering -- The separation or clustering of points with the same color might suggest that similar cell types have similar gene expression profiles, while different colors that group together could indicate distinct profiles between cell types. -- The distance between the points on the plot reflects the similarity or dissimilarity in their gene expression data, as captured by the PCA. - -```{r, out.width='100%', warning=FALSE, message=FALSE, echo=FALSE} -data_for_pca |> -tidybulk::reduce_dimensions(method="PCA") |> -tidybulk::pivot_sample() |> -ggplot(aes(PC1, PC2, color=data_for_pca[[params$x3]])) + -geom_point() + - theme_bw() + - theme( - legend.position = "right", # or choose "bottom" if you prefer - legend.key.size = unit(0.2, "cm"), # Adjust the size of the legend keys - legend.text = element_text(size = 3), # Adjust the text size in the legend - legend.spacing.y = unit(0.1, "cm") # Adjust the spacing between legend entries - ) -``` - - - - - - - - - - - - \ No newline at end of file diff --git a/inst/rmd/pseudobulk_analysis_report.qmd b/inst/rmd/pseudobulk_analysis_report.qmd new file mode 100644 index 00000000..55207001 --- /dev/null +++ b/inst/rmd/pseudobulk_analysis_report.qmd @@ -0,0 +1,351 @@ +--- +title: "Pseudobulk analysis report" +format: + html: + theme: minty + title-block-banner: true + df-print: paged + code-line-numbers: true + embed-resources: true + toc: true + toc-depth: 3 + toc-location: left + number-sections: true + smooth-scroll: true +abstract: > + This report presents a pseudobulk RNA-seq analysis derived from aggregated single-cell profiles. +knitr: + opts_chunk: + message: false + warning: false + echo: false +comments: + hypothesis: + theme: clean +editor: visual +author: "SS" +date: "2023-12-07" +output: html_document +params: + data_object: "NA" + empty_tbl: "NA" + alive_tbl: "NA" + cell_cycle_tbl: "NA" + annotation_tbl: "NA" + doublet_tbl: "NA" + sample_name: "NA" +--- + +```{r setup, include=FALSE} +library(ggplot2) +library(stringr) +library(tidybulk) +library(tidyseurat) +#library(tidysc) +library(tidyHeatmap) +library(purrr) +library(patchwork) +library(grid) +library(ComplexHeatmap) +library(ggrepel) +library(PCAtools) +library(tidySummarizedExperiment) +library(glue) +library(purrr) +library(plotly) +library(tidybulk) +#library(naniar) #NA +library(magrittr) +library(here) +``` + +```{r, include=FALSE} +preprocessing_output <- function(input_read_RNA_assay, + empty_droplets_tbl, + alive_identification_tbl, + cell_cycle_score_tbl, + annotation_label_transfer_tbl, + doublet_identification_tbl){ + + if(!is.null(empty_droplets_tbl)) + input_read_RNA_assay = + input_read_RNA_assay |> + left_join(empty_droplets_tbl, by = ".cell") |> + filter(!empty_droplet) + + input_read_RNA_assay <- input_read_RNA_assay |> + + # Filter dead cells + left_join( + alive_identification_tbl |> + select(.cell, any_of(c("alive", "subsets_Mito_percent", "subsets_Mito_sum", "subsets_Ribo_percent", "high_mitochondrion", "high_ribosome"))), + by = ".cell" + ) |> + filter(alive) |> + + # Filter doublets + left_join(doublet_identification_tbl |> select(.cell, scDblFinder.class), by = ".cell") |> + filter(scDblFinder.class=="singlet") + + # Add cell cycle + if(!is.null(cell_cycle_score_tbl)) + input_read_RNA_assay <- input_read_RNA_assay |> + left_join( + cell_cycle_score_tbl, + by=".cell" + ) + + # Attach annotation + if (inherits(annotation_label_transfer_tbl, "tbl_df")){ + input_read_RNA_assay <- input_read_RNA_assay |> + left_join(annotation_label_transfer_tbl, by = ".cell") + } + + + input_read_RNA_assay + # # Filter Red blood cells and platelets + # if (tolower(tissue) == "pbmc" & "predicted.celltype.l2" %in% c(rownames(annotation_label_transfer_tbl), colnames(annotation_label_transfer_tbl))) { + # filtered_data <- filter(processed_data, !predicted.celltype.l2 %in% c("Eryth", "Platelet")) + # } else { + # filtered_data <- processed_data + # } +} + + + +preprocessing_output_S <- pmap( + list(params$data_object, params$empty_tbl, params$alive_tbl, params$cell_cycle_tbl, params$annotation_tbl, params$doublet_tbl), + ~ preprocessing_output(..1, ..2, ..3, ..4, ..5, ..6) +) +``` + +```{r, include=FALSE} +create_pseudobulk <- function(preprocessing_output_S, assays = NULL, sample_name){ + #browser() + if(assays |> is.null()){ + if(preprocessing_output_S |> is("Seurat")) + assays = Seurat::Assays(preprocessing_output_S) + else if(preprocessing_output_S |> is("SingleCellExperiment")) + assays = preprocessing_output_S@assays |> names() + + } + pseudobulk = + preprocessing_output_S |> + + # Add sample + mutate(sample_hpc = sample_name) |> + + # Aggregate + #aggregate_cells(c(sample_hpc, any_of(x)), slot = "data", assays = assays) + tidySingleCellExperiment::aggregate_cells(c(sample_hpc), slot = "data", assays = assays) + + if(pseudobulk |> is("data.frame")) + pseudobulk = pseudobulk |> + as_SummarizedExperiment(.sample, .feature, any_of(assays)) + + rowData(pseudobulk)$feature_name = rownames(pseudobulk) + + pseudobulk |> + pivot_longer(cols = assays, names_to = "data_source", values_to = "count") |> + filter(!count |> is.na()) |> + + # Some manipulation to get unique feature because RNA and ADT + # both can have same name genes + rename(symbol = .feature) |> + mutate(data_source = stringr::str_remove(data_source, "abundance_")) |> + unite(".feature", c(symbol, data_source), remove = FALSE) |> + + # Covert + as_SummarizedExperiment( + .sample = .sample, + .transcript = .feature, + .abundance = count + ) +} + +pseudobulk_list <- map2(preprocessing_output_S, params$sample_name, ~ create_pseudobulk(.x, sample_name = .y)) + +``` + +```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} +pseudobulk_merge <- function(pseudobulk_list) { + + + # Fix GCHECKS + . = NULL + + # Select only common columns + common_columns = + pseudobulk_list |> + purrr::map(~ .x |> as_tibble() |> colnames()) |> + unlist() |> + table() %>% + .[.==max(.)] |> + names() + + # All genes + all_genes = + pseudobulk_list |> + purrr::map(~ .x |> rownames()) |> + unlist() |> + unique() |> + as.character() + + + se <- pseudobulk_list |> + + # Add missing genes + purrr::map(~{ + + missing_genes = all_genes |> setdiff(rownames(.x)) + + if(missing_genes |> length() == 0) return(.x) + else + .x |> add_missingh_genes_to_se(all_genes, missing_genes) + + }) |> + + purrr::map(~ .x |> dplyr::select(any_of(common_columns))) %>% + + do.call(S4Vectors::cbind, .) + + + return(se) +} +merged_pseudobulk <- pseudobulk_merge(pseudobulk_list) + +``` + +```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} +#pbmc_pseudobulk from sce: +pbmc_pseudobulk <- + merged_pseudobulk %>% + # filter(data_source == assay) |> + #separate( .sample, c("single_cell_rna_id", "batch1"), "__" , remove=FALSE) |> + #left_join(metadata_clinical_sample |> tidybulk::pivot_sample(sample)) |> + tidybulk::identify_abundant() %>% + tidybulk::scale_abundance(method = "TMMwsp") + +# Prepare data for PCA for each element of the list +data_for_pca <- + pbmc_pseudobulk %>% + keep_abundant() %>% + keep_variable(.abundance = "count_scaled", top = 500) %>% + dplyr::select(-TMM, -multiplier, -count_scaled) %>% + tidybulk::scale_abundance(method = "TMMwsp") + +``` + +## Global Sequencing Depth Density Plot + +This density plot compares the distribution of library sizes across samples after TMM normalization. This helps assess global sequencing-depth differences between samples before PCA is applied. + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} + +data_for_pca |> + ggplot(aes(count_scaled + 1, color=.sample)) + geom_density(alpha=0.3) + scale_x_log10() + guides(color="none") +``` + +```{r, echo=FALSE,results='hide', warning=FALSE, message=FALSE} +metadata = + data_for_pca |> + pivot_sample() |> + dplyr::select(.sample, alive, .aggregated_cells) + +metadata = as.data.frame(metadata) +rownames(metadata) = metadata$`.sample` +# metadata = metadata[,-1] + +my_pca = + data_for_pca@assays@data$count_scaled |> + log1p() |> + scale() |> + pca(metadata = metadata) +# +# Extract the proportion of variance explained by each principal component +var_explained <- my_pca$sdev^2 +var_explained <- var_explained / sum(var_explained) +cum_var_explained <- cumsum(var_explained) + +# Find the number of components that explain at least 90% of the variance +num_components <- which(cum_var_explained >= 0.9)[1] +# num_components <- 20 +## Without metadata +# my_pca = +# data_for_pca@assays@data$count_scaled |> +# log1p() |> +# scale() |> +# prcomp() + +``` + +## Scree Plot + +This scree plot shows the proportion of variance explained by each principal component. Components contributing significantly to total variance are prioritized in interpretation of downstream analysis steps. + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} +library(ggplot2) + +# # Extract the proportion of variance explained by each principal component +# var_explained <- my_pca$sdev^2 +# var_explained <- var_explained / sum(var_explained) +# cum_var_explained <- cumsum(var_explained) + +# Create a data frame for plotting +scree_data <- data.frame(PC = seq_along(var_explained), Variance = var_explained) + +# Create the scree plot +ggplot(scree_data, aes(x = PC, y = Variance)) + + geom_line() + + geom_point() + + theme_minimal() + + labs(title = "Scree Plot", x = "Principal Component", y = "Proportion of Variance Explained") +``` + +## PCA Plot (By Sample) + +Principal component projection of samples, colored by sample identity. Distance reflects similarity in gene expression profiles, and clustering indicates shared variance structure. + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} +# x<- plot(my_pca$rotated[, "PC1"], my_pca$rotated[, "PC2"], +# xlab = "PC1", ylab = "PC2", +# main = "PCA Plot", +# asp = 1) +# x + +x<- ggplot(my_pca$metadata, aes(x = my_pca$rotated[, "PC1"], y = my_pca$rotated[, "PC2"], color = my_pca$metadata |> rownames())) + + geom_point() + + theme_minimal() + + labs(title = "PCA Plot Colored by sample Type", + x = "Principal Component 1", + y = "Principal Component 2") + + scale_color_discrete(name = "Tissue Type") +x +``` + +## Cell Type Clustering via PCA + +Samples are grouped based on PCA of their pseudobulk profiles. Color represents number of aggregated cells contributing to each pseudobulk profile. + +```{r, out.width='100%', warning=FALSE, message=FALSE, echo=FALSE} +data_for_pca |> +tidybulk::reduce_dimensions(method="PCA") |> +tidybulk::pivot_sample() |> +ggplot(aes(PC1, PC2, color=data_for_pca$.aggregated_cells)) + +geom_point() + + theme_minimal() + + theme( + legend.position = "right", # or choose "bottom" if you prefer + legend.key.size = unit(0.2, "cm"), # Adjust the size of the legend keys + legend.text = element_text(size = 3), # Adjust the text size in the legend + legend.spacing.y = unit(0.1, "cm") # Adjust the spacing between legend entries + ) +``` + +::: + +# Session Info + +```{r} +sessionInfo() +``` diff --git a/inst/rmd/technical_variation_report.qmd b/inst/rmd/technical_variation_report.qmd new file mode 100644 index 00000000..f5a747a3 --- /dev/null +++ b/inst/rmd/technical_variation_report.qmd @@ -0,0 +1,192 @@ +--- +title: "Technical Variation Report" +format: + html: + theme: minty + title-block-banner: true + df-print: paged + code-line-numbers: true + embed-resources: true + toc: true + toc-depth: 3 + toc-location: left + number-sections: true + smooth-scroll: true +abstract: > + This report summarises the assessment of technical variation across samples. Sample-level UMAP projections are used to evaluate clustering structure and detect potential batch effects between different samples/ conditions. +knitr: + opts_chunk: + message: false + warning: false + echo: false +comments: + hypothesis: + theme: clean +editor: visual +author: "SS" +date: "2023-12-07" +output: html_document +params: + data_object: "NA" + empty_tbl: "NA" + sample_name: "NA" +--- + +```{r setup, include=FALSE} +library(purrr) +library(magrittr) +library(Seurat) +library(dplyr) + +# Global plot theme +theme_set(theme_minimal(base_size = 12)) +common_theme <- theme( + plot.title = element_text(size = 14, face = "bold"), + axis.title = element_text(size = 12), + axis.text = element_text(size = 10), + legend.title = element_text(size = 11), + legend.text = element_text(size = 10), + strip.text = element_text(size = 11), + legend.position = "bottom" +) + +``` + +```{r, include=FALSE} +find_variable_genes <- function(input_seurat, empty_droplet){ + + # Set the assay of choice + assay_of_choice = input_seurat@assays |> names() |> extract2(1) + + # Ensure "HTO" and "ADT" assays are removed if present + if("HTO" %in% names(input_seurat@assays)) input_seurat[["HTO"]] = NULL + if("ADT" %in% names(input_seurat@assays)) input_seurat[["ADT"]] = NULL + + # Filter out empty droplets + seu<- dplyr::left_join(input_seurat, empty_droplet) |> + dplyr::filter(!empty_droplet) + + # Update Seurat object meta.data after filtering + # input_seurat@meta.data <- seu + + # Scale data + input_seurat <- ScaleData(seu, assay=assay_of_choice, return.only.var.genes=FALSE) + + # Find and retrieve variable features + input_seurat <- Seurat::FindVariableFeatures(input_seurat, assay=assay_of_choice, nfeatures = 500) + my_variable_genes <- Seurat::VariableFeatures(input_seurat, assay=assay_of_choice) + + return(my_variable_genes) +} + +variable_gene_list <- map2(params$data_object, params$empty_tbl, find_variable_genes) + +``` + +```{r, include=FALSE} +calc_UMAP <- function(data_object, sample_name) { + assay_name <- data_object@assays |> names() |> extract2(1) + + # Check if variable features are already present, if not calculate them + if (length(VariableFeatures(data_object)) == 0) { + data_object <- FindVariableFeatures(data_object) + } + + # Extract variable features using VariableFeatures() for Seurat v5 + var_genes <- VariableFeatures(data_object) + + # Ensure that there are variable features before proceeding + if (length(var_genes) > 0) { + # Scale data and run PCA on variable genes + x <- ScaleData(data_object) |> + RunPCA(features = var_genes) |> + FindNeighbors(dims = 1:30) |> + FindClusters(resolution = 0.5) |> + RunUMAP(dims = 1:30, spread = 0.5, min.dist = 0.01, n.neighbors = 10L) |> + as_tibble() |> + mutate(sample_column = sample_name) + } else { + stop("No variable features available for UMAP calculation.") + } + + return(x) +} + +calc_UMAP_dbl_report <- map2(params$data_object, params$sample_name, calc_UMAP) +``` + +## UMAP projection of All Samples +This plot displays the UMAP projection of all cells across samples. Each point represents a single cell, and different colors indicate sample of origin. +UMAP was computed based on the top 500 variable genes identified per sample. + +```{r, out.width='100%', fig.width=15, fig.height=10, warning=FALSE, message=FALSE, echo=FALSE} +data_umap<- calc_UMAP_dbl_report %>% bind_rows() +# Plot +plot_tissue_color = + data_umap |> + dplyr::mutate(batch = 1) |> + ggplot(aes(umap_1, umap_2, color = data_umap$sample_column )) + + geom_point(size = 0.2) + + facet_wrap(~data_umap$sample_column) + + common_theme + + # theme_minimal() + + labs(title = "UMAP visualisation of Samples", color = "orig.ident") + +print(plot_tissue_color) +``` + + + +```{r, fig.width=10, fig.height=8, echo=FALSE, message=FALSE, warning=FALSE} +data_umap<- calc_UMAP_dbl_report %>% bind_rows() +# Plot +plot_tissue_color = + data_umap |> + dplyr::mutate(batch = 1) |> + ggplot(aes(umap_1, umap_2, color = data_umap$sample_column )) + + geom_point(size = 0.2) + + facet_wrap(~data_umap$sample_column) + + common_theme + + # theme_minimal() + + labs(title = "UMAP visualisation of Samples", color = "orig.ident") + +print(plot_tissue_color) +``` + +```{r, fig.width=10, fig.height=8, echo=FALSE, message=FALSE, warning=FALSE} +data_umap<- calc_UMAP_dbl_report %>% bind_rows() +# Plot +plot_tissue_color = + data_umap |> + dplyr::mutate(batch = 1) |> + ggplot(aes(umap_1, umap_2, color = data_umap$sample_column )) + + geom_point(size = 0.2) + + facet_wrap(~data_umap$sample_column) + + theme_minimal() + + labs(title = "UMAP visualisation of Samples", color = "orig.ident") + +print(plot_tissue_color) +``` + + + + + + + + + + + + + + + + + + + + + + + diff --git a/inst/scripts/build_graph.R b/inst/scripts/build_graph.R new file mode 100644 index 00000000..9229469b --- /dev/null +++ b/inst/scripts/build_graph.R @@ -0,0 +1,12 @@ +library(igraph) + +# load knowledge graph +adj_immune = read.csv("inst/extdata/immune_tree.csv", row.names = 1, check.names = FALSE) |> + as.matrix() +immune_graph = graph_from_adjacency_matrix(adj_immune, mode = "directed", weighted = TRUE) + +# Hierarchy - true (known) hierarchical relationships +# Consensus-only - temporary relationship used for ambiguous or often confused classes (e.g. macrophages and monocytes are often considered a single class but macrophages are not monocytes) +E(immune_graph)$Type = ifelse(E(immune_graph)$weight == 1, "Hierarchy", "Consensus-only") +E(immune_graph)$weight = 1 +usethis::use_data(immune_graph) diff --git a/inst/scripts/build_unification_maps.R b/inst/scripts/build_unification_maps.R new file mode 100644 index 00000000..3777a9ee --- /dev/null +++ b/inst/scripts/build_unification_maps.R @@ -0,0 +1,41 @@ +library(tidyverse) + +# load mappings between predictions and our dictionary +map_files = list.files("inst/extdata", pattern = "immune_map.+.csv", full.names = TRUE) +names(map_files) = gsub("immune_map_(.+).csv", "\\1", basename(map_files)) +celltype_unification_maps = map_files |> + lapply(read.csv) + +nonimmune_cellxgene = celltype_unification_maps$cellxgene |> + filter(!is_immune) |> + pull("to") |> + unique() + +# harmonise to a common nomenclature +celltype_unification_maps$azimuth = celltype_unification_maps$azimuth |> + select(from, to) |> + dplyr::rename( + azimuth_predicted_celltype_l2 = from, + azimuth = to + ) +celltype_unification_maps$blueprint = celltype_unification_maps$blueprint |> + select(from, to) |> + dplyr::rename( + blueprint_first_labels_fine = from, + blueprint = to + ) +celltype_unification_maps$monaco = celltype_unification_maps$monaco |> + select(from, to) |> + dplyr::rename( + monaco_first_labels_fine = from, + monaco = to + ) +celltype_unification_maps$cellxgene = celltype_unification_maps$cellxgene |> + select(from, to) |> + dplyr::rename( + cell_type = from, + cell_type_unified = to + ) + +usethis::use_data(celltype_unification_maps) +usethis::use_data(nonimmune_cellxgene) diff --git a/inst/scripts/example_run.R b/inst/scripts/example_run.R new file mode 100644 index 00000000..638cb982 --- /dev/null +++ b/inst/scripts/example_run.R @@ -0,0 +1,43 @@ +data(celltype_unification_maps) +data(nonimmune_cellxgene) +cell_metadata = tbl( + dbConnect(duckdb::duckdb(), dbdir = ":memory:"), + sql("SELECT * FROM read_parquet('/vast/scratch/users/shen.m/Census_final_run/cell_annotation.parquet')") +) +# unify cell types +cell_metadata = cell_metadata |> + left_join(celltype_unification_maps$azimuth, copy = TRUE) |> + left_join(celltype_unification_maps$blueprint, copy = TRUE) |> + left_join(celltype_unification_maps$monaco, copy = TRUE) |> + left_join(celltype_unification_maps$cellxgene, copy = TRUE) |> + mutate(ensemble_joinid = paste(azimuth, blueprint, monaco, cell_type_unified, sep = "_")) + +# produce the ensemble map +df_map = cell_metadata |> + count(ensemble_joinid, azimuth, blueprint, monaco, cell_type_unified, name = "NCells") |> + as_tibble() |> + mutate( + cellxgene = if_else(cell_type_unified %in% nonimmune_cellxgene, "non immune", cell_type_unified), + data_driven_ensemble = ensemble_annotation(cbind(azimuth, blueprint, monaco), override_celltype = c("non immune", "nkt", "mast")), + cell_type_unified_ensemble = ensemble_annotation(cbind(azimuth, blueprint, monaco, cellxgene), method_weights = c(1, 1, 1, 2), override_celltype = c("non immune", "nkt", "mast")), + cell_type_unified_ensemble = case_when( + cell_type_unified_ensemble == "non immune" & cellxgene == "non immune" ~ cell_type_unified, + cell_type_unified_ensemble == "non immune" & cellxgene != "non immune" ~ "other", + .default = cell_type_unified_ensemble + ), + is_immune = !cell_type_unified_ensemble %in% nonimmune_cellxgene + ) |> + select( + ensemble_joinid, + data_driven_ensemble, + cell_type_unified_ensemble, + is_immune + ) + +# use map to perform cell type ensemble +cell_metadata = cell_metadata |> + left_join(df_map, by = join_by(ensemble_joinid), copy = TRUE) |> + mutate(cell_type_unified_ensemble = ifelse(cell_type_unified_ensemble |> is.na(), "Unknown", cell_type_unified_ensemble)) + +cell_metadata |> write_parquet_to_parquet(path = "~/scratch/Census_final_run/cell_annotation_new_substitute_cell_type_na_to_unknown.parquet") + diff --git a/man/alive_identification.Rd b/man/alive_identification.Rd index 78af40ef..0f64f37e 100644 --- a/man/alive_identification.Rd +++ b/man/alive_identification.Rd @@ -6,10 +6,11 @@ \usage{ alive_identification( input_read_RNA_assay, - empty_droplets_tbl, - annotation_label_transfer_tbl = NULL, - annotation_column = NULL, - assay = NULL + empty_droplets_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + cell_type_column = NULL, + assay = NULL, + feature_nomenclature ) } \arguments{ @@ -17,7 +18,9 @@ alive_identification( \item{empty_droplets_tbl}{A tibble identifying empty droplets.} -\item{annotation_label_transfer_tbl}{A tibble with annotation label transfer data.} +\item{cell_type_ensembl_harmonised_tbl}{A tibble with annotated cell type label data.} + +\item{cell_type_column}{A character vector indicating the cell type column used for grouping during quality control and dead cell removal.} \item{assay}{assay used, default = "RNA"} } diff --git a/man/annotation_consensus.Rd b/man/annotation_consensus.Rd deleted file mode 100644 index 365c9ca1..00000000 --- a/man/annotation_consensus.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/functions.R -\name{annotation_consensus} -\alias{annotation_consensus} -\title{Harmonize cell type annotations based on consensus} -\usage{ -annotation_consensus( - single_cell_data, - .sample_column, - .cell_type, - .azimuth, - .blueprint, - .monaco -) -} -\arguments{ -\item{single_cell_data}{A data frame containing single-cell data with cell type annotations.} - -\item{.sample_column}{The column name specifying sample information.} - -\item{.cell_type}{The column name for the cell type annotations.} - -\item{.azimuth}{The column name for Azimuth annotations.} - -\item{.blueprint}{The column name for Blueprint annotations.} - -\item{.monaco}{The column name for Monaco annotations.} -} -\value{ -A data frame with harmonized cell type annotations. -} -\description{ -This function harmonizes cell type annotations by matching them with a reference annotation -and applying specific rules for non-immune cell types. -} diff --git a/man/annotation_label_transfer.Rd b/man/annotation_label_transfer.Rd index 912fcc9a..de7dd311 100644 --- a/man/annotation_label_transfer.Rd +++ b/man/annotation_label_transfer.Rd @@ -6,9 +6,10 @@ \usage{ annotation_label_transfer( input_read_RNA_assay, - empty_droplets_tbl, + empty_droplets_tbl = NULL, reference_azimuth = NULL, - assay = NULL + assay = NULL, + feature_nomenclature ) } \arguments{ diff --git a/man/calculate_gamma.Rd b/man/calculate_gamma.Rd new file mode 100644 index 00000000..4c6dadb5 --- /dev/null +++ b/man/calculate_gamma.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{calculate_gamma} +\alias{calculate_gamma} +\title{Calculate Appropriate Gamma Values for Metacell Analysis} +\usage{ +calculate_gamma(cell_count, min_cells_per_metacell = 1) +} +\arguments{ +\item{cell_count}{Integer, the total number of cells.} + +\item{min_cells_per_metacell}{Integer, the minimum number of cells allowed per metacell. Defaults to 30.} +} +\value{ +An Integer vector of viable gamma values. If no viable gamma values are found, returns 0. +} +\description{ +This function determines viable gamma (γ) values to be used in metacell analysis. Gamma is a graining level +parameter that controls the degree of cell aggregation when creating metacells. It represents the ratio +between the original number of cells and the desired number of metacells. +} +\details{ +For example: +\itemize{ +\item γ = 2: combines cells to create metacells, aiming for half as many metacells as original cells +\item γ = 4: aims for one-fourth as many metacells +\item γ = 8: aims for one-eighth as many metacells +And so on, using powers of 2. +} + +The function starts with γ = 2 and doubles it repeatedly (2, 4, 8, 16...) until the ratio of +cells/gamma would result in metacells that are smaller than the minimum allowed size. Higher gamma +values mean more aggressive aggregation (fewer, larger metacells), while lower gamma values preserve +more granularity (more, smaller metacells). +} diff --git a/man/calculate_metacell_for_a_sample_per_cell_type.Rd b/man/calculate_metacell_for_a_sample_per_cell_type.Rd new file mode 100644 index 00000000..363317bd --- /dev/null +++ b/man/calculate_metacell_for_a_sample_per_cell_type.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{calculate_metacell_for_a_sample_per_cell_type} +\alias{calculate_metacell_for_a_sample_per_cell_type} +\title{Calculate Metacell Membership Scores Across Different Gamma Parameters} +\usage{ +calculate_metacell_for_a_sample_per_cell_type( + sample_sce, + min_cells_per_metacell = 1 +) +} +\arguments{ +\item{sample_sce}{a SingleCellExperiment object containing pre-loaded single-cell RNA-seq data.} + +\item{min_cells_per_metacell}{An integer of minimum cells in each metacell.} +} +\value{ +A tibble with metacells membership scores across computed gamma settings. +} +\description{ +This function processes single-cell data to identify metacell membership across various gamma settings. +It preprocesses the single-cell data, calculates gamma values based on the number of columns (typically genes), +and postprocesses each gamma setting to assign cells to metacells. It then aggregates these results and +handles missing values by taking the maximum value in each group, ignoring NAs. +} +\examples{ +# Assume 'sce' is a SingleCellExperiment object with a cell type +calculate_metacell(sce) +} diff --git a/man/cell_communication.Rd b/man/cell_communication.Rd new file mode 100644 index 00000000..307c2262 --- /dev/null +++ b/man/cell_communication.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{cell_communication} +\alias{cell_communication} +\title{Perform Human Cell-Cell Communication Analysis} +\usage{ +cell_communication( + input_read_RNA_assay, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + doublet_identification_tbl = NULL, + cell_type_tbl = NULL, + assay = NULL, + cell_type_column = NULL, + feature_nomenclature, + reference_db = "human", + ... +) +} +\arguments{ +\item{input_read_RNA_assay}{A SingleCellExperiment or Seurat object containing gene expression data} + +\item{empty_droplets_tbl}{Optional tibble identifying empty droplets to be filtered out} + +\item{alive_identification_tbl}{Optional tibble identifying dead cells to be filtered out} + +\item{doublet_identification_tbl}{Optional A tibble from doublet identification.} + +\item{cell_type_tbl}{Optional A tibble containing cell, cell type, and sample_id information} + +\item{assay}{Character string specifying which assay to use} + +\item{cell_type_column}{Character string specifying the column name containing cell type annotations} + +\item{feature_nomenclature}{Character vector specifying gene in Symbol or Ensemble format} + +\item{reference_db}{The ligand-receptor interaction database curated in CellChat tool. Choose between human or mouse.} + +\item{...}{Additional arguments passed to \code{CellChat::subsetDB}} +} +\value{ +A CellChat tibble containing the inferred communication at the level of +ligands/receptors +} +\description{ +This function performs cells communication analysis. +It processes single-cell RNA sequencing data to identify and analyze intercellular communication networks. +} diff --git a/man/cell_cycle_scoring.Rd b/man/cell_cycle_scoring.Rd index e42fc21e..f9570718 100644 --- a/man/cell_cycle_scoring.Rd +++ b/man/cell_cycle_scoring.Rd @@ -6,8 +6,8 @@ \usage{ cell_cycle_scoring( input_read_RNA_assay, - empty_droplets_tbl, - gene_nomenclature, + empty_droplets_tbl = NULL, + feature_nomenclature, assay = NULL ) } diff --git a/man/cell_type_ensembl_harmonised.Rd b/man/cell_type_ensembl_harmonised.Rd new file mode 100644 index 00000000..0cc93d61 --- /dev/null +++ b/man/cell_type_ensembl_harmonised.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cell_type_curated_constructor.R +\name{cell_type_ensembl_harmonised} +\alias{cell_type_ensembl_harmonised} +\title{Harmonize Cell Types Across Datasets} +\usage{ +cell_type_ensembl_harmonised( + input_read_RNA_assay, + annotation_label_transfer_tbl = NULL, + celltype_unification_maps = NULL, + nonimmune = NULL, + available_maps = c("azimuth", "blueprint", "monaco", "cellxgene") +) +} +\arguments{ +\item{input_read_RNA_assay}{SingleCellExperiment or Seurat object containing RNA assay data.} + +\item{annotation_label_transfer_tbl}{A tibble with annotation label transfer data.} + +\item{celltype_unification_maps}{A list containing mapping data frames for different sources +(e.g., Azimuth, Blueprint, Monaco, and cellxgene). Default is \code{NULL}. +If \code{NULL}, it retrieves default maps stored in HPCell.} + +\item{nonimmune}{A character vector specifying non-immune cell types. +Default is \code{NULL}. If \code{NULL}, it retrieves default non-immune types from HPCell.} + +\item{available_maps}{A character vector of cell type annotation sources to include in the ensemble annotation process. +Supported values include \code{"azimuth"}, \code{"blueprint"}, \code{"monaco"}, and \code{"cellxgene"}. +By default, it uses all of the annotations.} +} +\value{ +A tibble of the input SummarizedExperiment metadata enriched with unified cell type annotations +and additional classification details. +} +\description{ +This function integrates and harmonizes cell type annotations across multiple +datasets by applying predefined unification maps and cell type labels. +It uses a combination of transferred annotations and predefined maps to +produce a consensus on cell type identities. +} diff --git a/man/clean_cell_types.Rd b/man/clean_cell_types.Rd deleted file mode 100644 index 97ddcfb6..00000000 --- a/man/clean_cell_types.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{clean_cell_types} -\alias{clean_cell_types} -\title{Clean and Standardize Cell Types} -\usage{ -clean_cell_types(.x) -} -\arguments{ -\item{.x}{A vector of cell types.} -} -\value{ -A cleaned and standardized vector of cell types. -} -\description{ -This function takes a vector of cell types and applies a series of transformations -to clean and standardize them for better consistency. -} -\examples{ -cell_types <- c("CD4+ T-cells", "NK cells", "Blast-cells") -} diff --git a/man/clean_cell_types_deeper.Rd b/man/clean_cell_types_deeper.Rd deleted file mode 100644 index f85f0ed3..00000000 --- a/man/clean_cell_types_deeper.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{clean_cell_types_deeper} -\alias{clean_cell_types_deeper} -\title{Clean and Standardize Cell Types (Deeper)} -\usage{ -clean_cell_types_deeper(x) -} -\arguments{ -\item{x}{A vector of cell types.} -} -\value{ -A cleaned and standardized vector of cell types. -} -\description{ -This function takes a vector of cell types and applies a series of transformations -to clean and standardize them for better consistency. -} diff --git a/man/clean_cellxgene_cell_types.Rd b/man/clean_cellxgene_cell_types.Rd new file mode 100644 index 00000000..b250cd17 --- /dev/null +++ b/man/clean_cellxgene_cell_types.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{clean_cellxgene_cell_types} +\alias{clean_cellxgene_cell_types} +\title{Clean and Standardize Cell Type Names} +\usage{ +clean_cellxgene_cell_types(x) +} +\arguments{ +\item{x}{A character vector of cell type names to be cleaned and standardized.} +} +\value{ +A character vector of cleaned and standardized cell type names. +} +\description{ +Cleans and standardizes a vector of cell type names by applying a series of string transformations to improve consistency. +This function is particularly useful for preprocessing cell type labels in biological datasets where consistent naming conventions are important. +} +\examples{ +cell_types <- c("CD4+ T-cells", "NK cells", "Blast-cells", "Terminally differentiated macrophage") +cleaned_cell_types <- clean_cellxgene_cell_types(cell_types) +print(cleaned_cell_types) + +# Output: +# [1] "cd4 t" "nk" "" "macrophage" + +} diff --git a/man/clean_sce_metadata.Rd b/man/clean_sce_metadata.Rd new file mode 100644 index 00000000..5b61ec87 --- /dev/null +++ b/man/clean_sce_metadata.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{clean_sce_metadata} +\alias{clean_sce_metadata} +\title{Clean Metadata in SingleCellExperiment Object} +\usage{ +clean_sce_metadata(sce) +} +\arguments{ +\item{sce}{A SingleCellExperiment object containing metadata to be cleaned.} +} +\value{ +A SingleCellExperiment with all completely NA columns removed +} +\description{ +This function takes a SingleCellExperiment (SCE) object and removes columns +that are completely filled with NA values. +The cleaned metadata is then returned as a dataframe. +} diff --git a/man/compute_mode_delayedarray.Rd b/man/compute_mode_delayedarray.Rd new file mode 100644 index 00000000..b6de67df --- /dev/null +++ b/man/compute_mode_delayedarray.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{compute_mode_delayedarray} +\alias{compute_mode_delayedarray} +\title{Compute the Mode of a DelayedArray} +\usage{ +compute_mode_delayedarray(delayed_array) +} +\arguments{ +\item{delayed_array}{A \code{DelayedArray} object for which the mode is to be computed.} +} +\value{ +A list containing the following elements: +\describe{ +\item{\code{mode}}{Numeric vector of the most frequent value(s) in the array.} +\item{\code{frequency}}{Integer representing the count of the most frequent value(s).} +} +} +\description{ +This function computes the mode (most frequent value) of a \code{DelayedArray} without loading the entire array into memory. It processes the array in blocks to maintain memory efficiency, making it suitable for large datasets. +} +\details{ +The function utilizes block processing via \code{blockApply()} from the \code{DelayedArray} package to avoid loading the entire array into memory. It computes partial frequency tables for each block and combines them to find the overall mode. +} +\examples{ +\dontrun{ +# Load required packages +library(DelayedArray) + +# Create a DelayedArray from an in-memory matrix +set.seed(123) +n_rows <- 1000 +n_cols <- 1000 +matrix_data <- matrix(sample(0:5, n_rows * n_cols, replace = TRUE, + prob = c(0.5, 0.1, 0.1, 0.1, 0.1, 0.1)), + nrow = n_rows) +delayed_array <- DelayedArray(matrix_data) + +# Compute the mode +mode_result <- compute_mode_delayedarray(delayed_array) + +# Output the result +cat("Most frequent value(s):", paste(mode_result$mode, collapse = ", "), "\n") +cat("Frequency:", mode_result$frequency, "\n") +} + +} diff --git a/man/create_pseudobulk.Rd b/man/create_pseudobulk.Rd index e61c2daf..1f1dd4fc 100644 --- a/man/create_pseudobulk.Rd +++ b/man/create_pseudobulk.Rd @@ -7,14 +7,16 @@ create_pseudobulk( input_read_RNA_assay, sample_names_vec, - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, + annotation_label_transfer_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + doublet_identification_tbl = NULL, x = c(), external_path, - assays = NULL + assays = NULL, + container_type ) } \arguments{ @@ -25,6 +27,8 @@ typically represents a factor such as sample ID or condition.} \item{assays}{A character vector specifying the assays to be included in the pseudobulk creation process, such as c("RNA", "ADT").} +\item{container_type}{A character vector specifying the output file type. Ideally it should match to the input file type.} + \item{preprocessing_output_S}{Processed dataset from preprocessing.} \item{...}{Additional arguments passed to internal functions used within diff --git a/man/doublet_identification.Rd b/man/doublet_identification.Rd index 879c3010..34d0c1a6 100644 --- a/man/doublet_identification.Rd +++ b/man/doublet_identification.Rd @@ -6,8 +6,7 @@ \usage{ doublet_identification( input_read_RNA_assay, - empty_droplets_tbl, - alive_identification_tbl, + empty_droplets_tbl = NULL, assay = NULL ) } @@ -16,13 +15,7 @@ doublet_identification( \item{empty_droplets_tbl}{A tibble identifying empty droplets.} -\item{alive_identification_tbl}{A tibble identifying alive cells.} - \item{assay}{Name of the assay to use.} - -\item{annotation_label_transfer_tbl}{A tibble with annotation label transfer data.} - -\item{reference_label_fine}{Optional reference label for fine-tuning.} } \value{ A tibble containing cells with their scDblFinder scores. diff --git a/man/duplicate_single_column_assay.Rd b/man/duplicate_single_column_assay.Rd new file mode 100644 index 00000000..c656de48 --- /dev/null +++ b/man/duplicate_single_column_assay.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{duplicate_single_column_assay} +\alias{duplicate_single_column_assay} +\title{Duplicate Single-Column Assay in a SingleCellExperiment or Seurat Object} +\usage{ +duplicate_single_column_assay(data) +} +\arguments{ +\item{data}{A \code{SingleCellExperiment} or \code{Seurat} object.} +} +\value{ +A modified \code{SingleCellExperiment} or \code{Seurat} object with the single-column assay +duplicated if applicable. +} +\description{ +This function handles a \code{SingleCellExperiment} or \code{Seurat} object where a specified assay +contains only one column. It duplicates the single-column assay to avoid potential +errors during saving or downstream analysis that require at least two columns. +The duplicated column is marked with a prefix \code{DUMMY___} to distinguish it. +Corresponding entries in the column metadata (\code{colData}) are also duplicated. +} diff --git a/man/empty_droplet_id.Rd b/man/empty_droplet_id.Rd index 93c9882b..54090638 100644 --- a/man/empty_droplet_id.Rd +++ b/man/empty_droplet_id.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R +% Please edit documentation in R/functions.R \name{empty_droplet_id} \alias{empty_droplet_id} \title{Identify Empty Droplets in Single-Cell RNA-seq Data} @@ -7,7 +7,8 @@ empty_droplet_id( input_read_RNA_assay, total_RNA_count_check = -Inf, - assay = NULL + assay = NULL, + feature_nomenclature ) } \arguments{ diff --git a/man/empty_droplet_threshold.Rd b/man/empty_droplet_threshold.Rd new file mode 100644 index 00000000..2e2035e8 --- /dev/null +++ b/man/empty_droplet_threshold.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{empty_droplet_threshold} +\alias{empty_droplet_threshold} +\title{Identify Empty Droplets in Single-Cell RNA-seq Data} +\usage{ +empty_droplet_threshold( + input_read_RNA_assay, + total_RNA_count_check = -Inf, + assay = NULL, + feature_nomenclature, + RNA_feature_threshold +) +} +\arguments{ +\item{input_read_RNA_assay}{SingleCellExperiment or Seurat object containing RNA assay data.} + +\item{RNA_feature_threshold}{An optional integer for the number of feature expressed in a sample.} + +\item{filter_empty_droplets}{Logical value indicating whether to filter the input data.} +} +\value{ +A tibble with columns: Cell, nFeature_expressed_in_sample, nCount_RNA, empty_droplet (classification of droplets). +} +\description{ +\code{empty_droplet_threshold} identifies empty droplets by applying a gene expression threshold per sample. +It excludes mitochondrial and ribosomal genes, and classifies droplets as empty if +the number of expressed genes falls below the specified threshold. + +The function returns a tibble containing the number of expressed genes, +total RNA count for each cell, and a logical annotation indicating whether the droplet was classified as empty. +} diff --git a/man/ensembl_genes_biomart.Rd b/man/ensembl_genes_biomart.Rd new file mode 100644 index 00000000..f534e733 --- /dev/null +++ b/man/ensembl_genes_biomart.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{ensembl_genes_biomart} +\alias{ensembl_genes_biomart} +\title{A data frame of Ensembl genes retrieved from biomaRt package} +\format{ +A data frame map of ensembl_gene_id, external_gene_name and chromosome_name +} +\source{ +biomaRt::getBM() +} +\usage{ +data(ensembl_genes_biomart) +} +\description{ +This dataset contains Ensembl gene IDs, external gene names, and chromosome names +retrieved using the biomaRt package. +} +\keyword{datasets} diff --git a/man/ensemble_annotation.Rd b/man/ensemble_annotation.Rd new file mode 100644 index 00000000..eaa50830 --- /dev/null +++ b/man/ensemble_annotation.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cell_type_curated_constructor.R +\name{ensemble_annotation} +\alias{ensemble_annotation} +\title{Ensemble Annotation for Cell Type Identification} +\usage{ +ensemble_annotation( + celltype_matrix, + method_weights = NULL, + override_celltype = c(), + celltype_tree = NULL +) +} +\arguments{ +\item{celltype_matrix}{A matrix or data frame where columns represent different annotation +methods for cell types. Each element in the matrix represents a cell type determined by +each method.} + +\item{method_weights}{Optional numeric vector or matrix specifying weights for each method. +If not provided, equal weights are used. If provided as a vector, it should match the +number of methods (columns of celltype_matrix).} + +\item{override_celltype}{A character vector of cell types that should override the voting +process if they appear. This can be used to set certain cell types as non-negotiable +when they are detected by any method.} + +\item{celltype_tree}{An igraph object representing the hierarchy of cell types. If NULL, +a default graph named "immune_graph" from the global environment is used.} +} +\value{ +A vector representing the consensus cell type for each row in the input \code{celltype_matrix}. +} +\description{ +This function creates an ensemble annotation for cell types by utilizing a voting mechanism +across different methods. It leverages a hierarchy of cell types, method-specific weights, +and an option to override certain cell types to derive a consensus classification. +} diff --git a/man/find_variable_genes.Rd b/man/find_variable_genes.Rd deleted file mode 100644 index f5d1c7c7..00000000 --- a/man/find_variable_genes.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/functions.R -\name{find_variable_genes} -\alias{find_variable_genes} -\title{Find variable genes} -\usage{ -find_variable_genes(input_seurat, empty_droplet) -} -\arguments{ -\item{input_seurat}{Single Seurat object (Input data)} - -\item{empty_droplet}{Single dataframe containing empty droplet filtering information} -} -\value{ -A vector of variable gene names -} -\description{ -Find variable genes -} diff --git a/man/get_count_per_gene_df.Rd b/man/get_count_per_gene_df.Rd new file mode 100644 index 00000000..29789971 --- /dev/null +++ b/man/get_count_per_gene_df.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{get_count_per_gene_df} +\alias{get_count_per_gene_df} +\title{Transform counts to continous data} +\usage{ +get_count_per_gene_df(counts) +} +\arguments{ +\item{counts}{A SummarizedExperiment object} +} +\description{ +Transform counts to continous data +} diff --git a/man/harmonise_names_non_immune.Rd b/man/harmonise_names_non_immune.Rd deleted file mode 100644 index 998f7267..00000000 --- a/man/harmonise_names_non_immune.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{harmonise_names_non_immune} -\alias{harmonise_names_non_immune} -\title{Harmonize Non-Immune Cell Type Names} -\usage{ -harmonise_names_non_immune(metadata) -} -\arguments{ -\item{metadata}{A data frame containing cell type information.} -} -\value{ -The metadata with harmonized cell type names. -} -\description{ -This function harmonizes non-immune cell type names in the metadata. -} -\examples{ -metadata <- data.frame(cell_type = c("Myofibroblast", "Fibroblast", "Other Fibroblast")) - -} diff --git a/man/hpc_iterate.Rd b/man/hpc_iterate.Rd index 0e28fab3..bfc07169 100644 --- a/man/hpc_iterate.Rd +++ b/man/hpc_iterate.Rd @@ -4,7 +4,13 @@ \alias{hpc_iterate} \title{Add HPC step to pipeline} \usage{ -hpc_iterate(input_hpc, target_output = NULL, user_function = NULL, ...) +hpc_iterate( + input_hpc, + target_output = NULL, + user_function = NULL, + user_function_source_path = NULL, + ... +) } \arguments{ \item{input_hpc}{The input HPC object.} diff --git a/man/hpc_merge.Rd b/man/hpc_merge.Rd index b86f1283..8a8b157f 100644 --- a/man/hpc_merge.Rd +++ b/man/hpc_merge.Rd @@ -4,7 +4,13 @@ \alias{hpc_merge} \title{Add HPC step to pipeline} \usage{ -hpc_merge(input_hpc, target_output = NULL, user_function = NULL, ...) +hpc_merge( + input_hpc, + target_output = NULL, + user_function = NULL, + user_function_source_path = NULL, + ... +) } \arguments{ \item{input_hpc}{The input HPC object.} diff --git a/man/hpc_report.Rd b/man/hpc_report.Rd new file mode 100644 index 00000000..3265a3e3 --- /dev/null +++ b/man/hpc_report.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/factories.R +\name{hpc_report} +\alias{hpc_report} +\title{Add HPC step to pipeline} +\usage{ +hpc_report(input_hpc, target_output = NULL, rmd_path = NULL, ...) +} +\arguments{ +\item{input_hpc}{The input HPC object.} + +\item{target_output}{The output target name (default: NULL).} + +\item{...}{Additional arguments to pass to the internal functions.} + +\item{user_function}{A custom function provided by the user (default: NULL).} +} +\description{ +This function adds a new step to the HPC pipeline by appending the appropriate +targets to the target script. It allows the user to specify the input and output +targets, as well as a custom user function to be applied. +} diff --git a/man/hpc_single.Rd b/man/hpc_single.Rd index 2a2da0a0..480969bb 100644 --- a/man/hpc_single.Rd +++ b/man/hpc_single.Rd @@ -8,6 +8,7 @@ hpc_single( input_hpc, target_output = NULL, user_function = NULL, + user_function_source_path = NULL, iterate = "none", ... ) diff --git a/man/initialise_hpc.Rd b/man/initialise_hpc.Rd index 910847d4..ed73b43b 100644 --- a/man/initialise_hpc.Rd +++ b/man/initialise_hpc.Rd @@ -12,7 +12,12 @@ initialise_hpc( debug_step = NULL, RNA_assay_name = "RNA", gene_nomenclature = "symbol", - data_container_type + data_container_type, + verbosity = targets::tar_config_get("reporter_make"), + error = NULL, + update = "thorough", + garbage_collection = 0, + workspace_on_error = FALSE ) } \arguments{ diff --git a/man/is_strong_evidence.Rd b/man/is_strong_evidence.Rd deleted file mode 100644 index 0cdc1866..00000000 --- a/man/is_strong_evidence.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{is_strong_evidence} -\alias{is_strong_evidence} -\title{Check for Strong Evidence} -\usage{ -is_strong_evidence( - single_cell_data, - cell_annotation_azimuth_l2, - cell_annotation_blueprint_singler -) -} -\arguments{ -\item{single_cell_data}{A data frame containing single-cell data.} - -\item{cell_annotation_azimuth_l2}{A column representing Azimuth L2 cell annotation.} - -\item{cell_annotation_blueprint_singler}{A column representing Blueprint Singler cell annotation.} -} -\value{ -A data frame with a column indicating strong evidence. -} -\description{ -This function checks for strong evidence in cell annotations. -} diff --git a/man/map2_test_differential_abundance_hpc.Rd b/man/map2_test_differential_abundance_hpc.Rd deleted file mode 100644 index 68935308..00000000 --- a/man/map2_test_differential_abundance_hpc.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/targets_functions.R -\name{map2_test_differential_abundance_hpc} -\alias{map2_test_differential_abundance_hpc} -\title{Main Function for HPCell Map Test Differential Abundance} -\usage{ -map2_test_differential_abundance_hpc( - data_list, - formula_list, - .abundance = NULL, - store = tempfile(tmpdir = "."), - computing_resources = crew_controller_local(workers = 1), - cpus_per_task = 1, - debug_job_id = NULL, - append = FALSE, - ... -) -} -\arguments{ -\item{data_list}{list of dataframes to be processed} - -\item{formula_list}{List of formula for the differential abundance test.} - -\item{.abundance}{(optional) A symbol or string indicating the column name in the \code{SingleCellExperiment} object to be used for abundance measures. If not explicitly provided, the function attempts to automatically detect an appropriate column by examining the first object in \code{data_list}.} - -\item{store}{File path for temporary storage.} - -\item{computing_resources}{Computing resources configuration.} - -\item{cpus_per_task}{Number of CPUs allocated per task.} - -\item{debug_job_id}{Optional job ID for debugging.} - -\item{append}{Flag to append to existing script.} - -\item{...}{additional arguments} -} -\value{ -A \code{targets} pipeline output, typically a nested tibble with differential abundance estimates. -} -\description{ -This function prepares and runs a differential abundance test pipeline using the 'targets' package. It sets up necessary files, appends scripts, and executes the pipeline. -} diff --git a/man/map_add_dispersion_to_se.Rd b/man/map_add_dispersion_to_se.Rd deleted file mode 100644 index 92270dfa..00000000 --- a/man/map_add_dispersion_to_se.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/functions.R -\name{map_add_dispersion_to_se} -\alias{map_add_dispersion_to_se} -\title{Add Dispersion Estimates to SingleCellExperiment Object} -\usage{ -map_add_dispersion_to_se(se_df, .col, abundance = NULL) -} -\arguments{ -\item{se_df}{A data frame or list containing SingleCellExperiment objects.} - -\item{.col}{A symbol indicating the column in \code{se_df} that contains SingleCellExperiment objects.} - -\item{abundance}{(Optional) A character vector specifying the name of the assay to be used -for dispersion estimation. If NULL or not provided, the first assay is used.} -} -\value{ -The input data frame or list (\code{se_df}) with the specified \code{.col} modified to include -dispersion estimates in each SingleCellExperiment object. -} -\description{ -\code{map_add_dispersion_to_se} function adds dispersion estimates to each feature (gene) in a -SingleCellExperiment object. Dispersion estimates are added based on the abundance measure specified. -} -\details{ -The function iterates over each SingleCellExperiment object in the specified column of the input data frame -or list. It calculates dispersion estimates for the features (genes) based on the specified abundance assay. -The results are joined back to each SingleCellExperiment object. If no abundance assay is specified, -the function defaults to the first assay in each SingleCellExperiment object. -} diff --git a/man/map_split_sce_by_gene.Rd b/man/map_split_sce_by_gene.Rd deleted file mode 100644 index be4b5344..00000000 --- a/man/map_split_sce_by_gene.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/functions.R -\name{map_split_sce_by_gene} -\alias{map_split_sce_by_gene} -\title{map_split_sce_by_gene Split SingleCellExperiment by Gene} -\usage{ -map_split_sce_by_gene( - sce_df, - .col, - how_many_chunks_base = 10, - max_cells_before_split = 4763 -) -} -\arguments{ -\item{sce_df}{A dataframe (or tibble) where one of the columns contains SingleCellExperiment objects} - -\item{.col}{A symbol or string indicating the column in \code{sce_df} which should be dynamically split into multiple chunks} - -\item{how_many_chunks_base}{A base number of chunks to divide the data into, adjusted by the actual size of the data in each group.} - -\item{max_cells_before_split}{The maximum number of cells a single chunk can have before it is split into another chunk.} -} -\value{ -Returns the input SingleCellExperiment DataFrame with an additional column \code{sce_md5} containing MD5 hashes of the chunks, and with the data split according to the specified parameters. -} -\description{ -Splits a SingleCellExperiment object into multiple chunks based on the number of cells. -This function dynamically partitions a SingleCellExperiment object into multiple chunks based on the number of cells per gene across the specified column. It computes the number of splits by dividing the total number of cells by a maximum threshold and multiplying the result by a base number of chunks. This approach allows handling of large datasets by reducing the complexity in each chunk, making it feasible to perform detailed analyses or computational tasks on subsets of data efficiently. -The function also assigns a unique MD5 hash to each chunk as an identifier, facilitating tracking and referencing of data subsets in subsequent analyses. -} diff --git a/man/map_split_se_by_gene.Rd b/man/map_split_se_by_gene.Rd deleted file mode 100644 index 1c8a5fbc..00000000 --- a/man/map_split_se_by_gene.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/functions.R -\name{map_split_se_by_gene} -\alias{map_split_se_by_gene} -\title{Split SummarizedExperiment Object by Gene} -\usage{ -map_split_se_by_gene(se_df, .col, .number_of_chunks) -} -\arguments{ -\item{se_df}{Data frame containing SummarizedExperiment objects.} - -\item{.col}{Column in the data frame containing the SummarizedExperiment objects.} - -\item{.number_of_chunks}{Number of chunks to split into.} -} -\value{ -Data frame with SummarizedExperiment objects split into chunks. -} -\description{ -Splits each SummarizedExperiment object in a data frame into chunks by gene. -} diff --git a/man/non_batch_variation_removal.Rd b/man/non_batch_variation_removal.Rd index c747c3b0..c1f2af70 100644 --- a/man/non_batch_variation_removal.Rd +++ b/man/non_batch_variation_removal.Rd @@ -6,9 +6,9 @@ \usage{ non_batch_variation_removal( input_read_RNA_assay, - empty_droplets_tbl, - alive_identification_tbl, - cell_cycle_score_tbl, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, assay = NULL, factors_to_regress = NULL, external_path diff --git a/man/postprocess_SCimplify.Rd b/man/postprocess_SCimplify.Rd new file mode 100644 index 00000000..5bff0286 --- /dev/null +++ b/man/postprocess_SCimplify.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{postprocess_SCimplify} +\alias{postprocess_SCimplify} +\title{Detection of metacells with the SuperCell approach} +\usage{ +postprocess_SCimplify( + preprocessed, + cell.annotation = NULL, + cell.split.condition = NULL, + gamma, + block.size = 10000, + igraph.clustering = c("walktrap", "louvain"), + return.singlecell.NW = TRUE, + return.hierarchical.structure = TRUE, + ... +) +} +\arguments{ +\item{preprocessed}{A list returned by \code{preprocess_SCimplify} containing preprocessed single-cell data, +PCA results, and kNN graph.} + +\item{cell.annotation}{a vector of cell type annotation, if provided, metacells that contain single cells of different cell type annotation will be split in multiple pure metacell (may result in slightly larger numbe of metacells than expected with a given gamma)} + +\item{cell.split.condition}{a vector of cell conditions that must not be mixed in one metacell. If provided, metacells will be split in condition-pure metacell (may result in significantly(!) larger number of metacells than expected)} + +\item{gamma}{graining level of data (proportion of number of single cells in the initial dataset to the number of metacells in the final dataset)} + +\item{block.size}{number of cells to map to the nearest metacell at the time (for approx coarse-graining)} + +\item{igraph.clustering}{clustering method to identify metacells (available methods "walktrap" (default) and "louvain" (not recommended, gamma is ignored)).} + +\item{return.singlecell.NW}{whether return single-cell network (which consists of approx.N if \code{"do.approx"} or all cells otherwise)} + +\item{return.hierarchical.structure}{whether return hierarchical structure of metacell} + +\item{...}{other parameters of \link{build_knn_graph} function} +} +\value{ +A tibble with column 'cell' and 'membership' indicating which metacell cluster each cell belongs to. +} +\description{ +This function detects metacells (former super-cells) from single-cell gene expression matrix +} diff --git a/man/preprocess_SCimplify.Rd b/man/preprocess_SCimplify.Rd new file mode 100644 index 00000000..821831c8 --- /dev/null +++ b/man/preprocess_SCimplify.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{preprocess_SCimplify} +\alias{preprocess_SCimplify} +\title{Preprocess metacells with the SuperCell approach} +\usage{ +preprocess_SCimplify( + input_read_RNA_assay, + assay = NULL, + genes.use = NULL, + genes.exclude = NULL, + n.var.genes = min(1000, nrow(input_read_RNA_assay)), + k.knn = 5, + do.scale = TRUE, + n.pc = 10, + fast.pca = TRUE, + do.approx = FALSE, + approx.N = 5000, + seed = 12345, + ... +) +} +\arguments{ +\item{input_read_RNA_assay}{A \code{SingleCellExperiment} or \code{Seurat} object containing RNA assay data.} + +\item{assay}{assay used, default = "RNA"} + +\item{genes.use}{a vector of genes used to compute PCA} + +\item{genes.exclude}{a vector of genes to be excluded when computing PCA} + +\item{n.var.genes}{if \code{"genes.use"} is not provided, \code{"n.var.genes"} genes with the largest variation are used} + +\item{k.knn}{parameter to compute single-cell kNN network} + +\item{do.scale}{whether to scale gene expression matrix when computing PCA} + +\item{n.pc}{number of principal components to use for construction of single-cell kNN network} + +\item{fast.pca}{use \link[irlba]{irlba} as a faster version of prcomp (one used in Seurat package)} + +\item{do.approx}{compute approximate kNN in case of a large dataset (>50'000)} + +\item{approx.N}{number of cells to subsample for an approximate approach. By default, 5000 cells are used +for approximation to capture biological meaningful result.} + +\item{seed}{seed to use to subsample cells for an approximate approach} + +\item{...}{other parameters of \link{build_knn_graph} function} +} +\value{ +A list of variables to be passed to the \code{SuperCell::SCimplify} gamma involved function. +} +\description{ +This function preprocesses a single-cell gene expression matrix for downstream simplification using PCA +and k-nearest neighbor (kNN) graph construction. It includes options for scaling, feature selection, +approximate sampling, and PCA computation methods. +} diff --git a/man/preprocessing_output.Rd b/man/preprocessing_output.Rd index 5b7721a6..5e72e21a 100644 --- a/man/preprocessing_output.Rd +++ b/man/preprocessing_output.Rd @@ -6,12 +6,13 @@ \usage{ preprocessing_output( input_read_RNA_assay, - empty_droplets_tbl, - non_batch_variation_removal_S, - alive_identification_tbl, - cell_cycle_score_tbl, - annotation_label_transfer_tbl, - doublet_identification_tbl + empty_droplets_tbl = NULL, + non_batch_variation_removal_S = NULL, + alive_identification_tbl = NULL, + cell_cycle_score_tbl = NULL, + cell_type_ensembl_harmonised_tbl = NULL, + annotation_label_transfer_tbl = NULL, + doublet_identification_tbl = NULL ) } \arguments{ diff --git a/man/reference_annotation_to_consensus.Rd b/man/reference_annotation_to_consensus.Rd new file mode 100644 index 00000000..bbd146d1 --- /dev/null +++ b/man/reference_annotation_to_consensus.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{reference_annotation_to_consensus} +\alias{reference_annotation_to_consensus} +\title{reference_annotation_to_consensus} +\usage{ +reference_annotation_to_consensus(azimuth_input, monaco_input, blueprint_input) +} +\arguments{ +\item{azimuth_input}{A vector of cell type annotations from the Azimuth dataset.} + +\item{monaco_input}{A vector of cell type annotations from the Monaco dataset.} + +\item{blueprint_input}{A vector of cell type annotations from the Blueprint dataset.} +} +\value{ +A vector of consensus cell type annotations, merging inputs from the three datasets. +} +\description{ +This function takes cell type annotations from multiple datasets (Azimuth, Monaco, Blueprint) and harmonizes them into a consensus annotation. The function utilizes predefined mappings between cell type labels in these datasets to generate standardized cell types across references. +} +\note{ +This function is designed to harmonize specific cell types, especially T cells, B cells, monocytic cells, and innate lymphoid cells (ILCs), across reference datasets. +} +\examples{ +# Example usage: +tibble::tibble( + azimuth_predicted.celltype.l2 = c("CD8 TEM", "NK", "CD4 Naive"), + monaco_first.labels.fine = c("Effector memory CD8 T cells", "Natural killer cells", "Naive CD4 T cells"), + blueprint_first.labels.fine = c("CD8+ Tem", "NK cells", "Naive B-cells") +) |> + dplyr::mutate(consensus = reference_annotation_to_consensus( + azimuth_predicted.celltype.l2, monaco_first.labels.fine, blueprint_first.labels.fine)) + +} +\seealso{ +\code{\link[dplyr]{mutate}}, \code{\link[stringr]{str_detect}}, \code{\link[tidyr]{expand_grid}} +} diff --git a/man/run_targets_pipeline.Rd b/man/run_targets_pipeline.Rd deleted file mode 100644 index c1ba5b74..00000000 --- a/man/run_targets_pipeline.Rd +++ /dev/null @@ -1,57 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/execute_pipeline.R -\name{run_targets_pipeline} -\alias{run_targets_pipeline} -\title{Run Targets Pipeline for HPCell} -\usage{ -run_targets_pipeline( - input_data, - store = "./", - input_reference = NULL, - tissue, - computing_resources = crew_controller_local(workers = 1), - debug_step = NULL, - filter_empty_droplets = NULL, - RNA_assay_name = "RNA", - sample_column = "sample", - cell_type_annotation_column = "Cell_type_in_each_tissue", - data_container_type -) -} -\arguments{ -\item{input_data}{Input data for the pipeline.} - -\item{store}{Directory path for storing the pipeline files.} - -\item{input_reference}{Optional reference data.} - -\item{tissue}{Tissue type for the analysis.} - -\item{computing_resources}{Configuration for computing resources.} - -\item{debug_step}{Optional step for debugging.} - -\item{filter_empty_droplets}{Flag to indicate if input filtering is needed.} - -\item{RNA_assay_name}{Name of the RNA assay.} - -\item{sample_column}{Column name for sample identification.} - -\item{cell_type_annotation_column}{Column name for cell type annotation in input data} - -\item{data_container_type}{A character vector of length one specifies the input data type.} - -\item{profiler}{Optional step for profilling. Default is FALSE -data type can be one of the following: anndata for annotated data mainly used in python. -sce_rds and seurat_rds for \code{SingleCellExperiment} and \code{Seurat} RDS format representively -seurat_rds for \code{Seurat} RDS format. -sce_hdf5 for \code{SingleCellExperiment} HDF5 format -seurat_hdf5 for \code{Seurat} HDF5 format} -} -\value{ -The output of the \code{targets} pipeline, typically a pre-processed data set. -} -\description{ -This function sets up and executes a \code{targets} pipeline for HPCell. It saves input data and configurations, -writes a pipeline script, and runs the pipeline using the 'targets' package. -} diff --git a/man/save_experiment_data.Rd b/man/save_experiment_data.Rd new file mode 100644 index 00000000..40220119 --- /dev/null +++ b/man/save_experiment_data.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{save_experiment_data} +\alias{save_experiment_data} +\title{Save various types of single-cell data} +\usage{ +save_experiment_data(data, dir, container_type = "anndata") +} +\arguments{ +\item{data}{A data object to save.} + +\item{dir}{A character vector of length one specifies the file path, or directory path.} + +\item{container_type}{A character vector of length one specifies the input data type.} +} +\value{ +An object stored in the defined path. +} +\description{ +Save various types of single-cell data +} diff --git a/man/seurat_to_ligand_receptor_count.Rd b/man/seurat_to_ligand_receptor_count.Rd deleted file mode 100644 index 91d7a160..00000000 --- a/man/seurat_to_ligand_receptor_count.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CellChat.R -\name{seurat_to_ligand_receptor_count} -\alias{seurat_to_ligand_receptor_count} -\title{Ligand-Receptor Count from Seurat Data} -\usage{ -seurat_to_ligand_receptor_count( - counts, - .cell_group, - assay, - sample_for_plotting = "" -) -} -\arguments{ -\item{counts}{Seurat object.} - -\item{.cell_group}{Cell group variable.} - -\item{assay}{Name of the assay to use.} - -\item{sample_for_plotting}{Sample name for plotting.} -} -\value{ -A list of communication results including interactions and signaling pathways. -} -\description{ -Calculates ligand-receptor interactions for each cell type in a Seurat object using CellChat. -} diff --git a/man/split_sample_cell_type_calculate_metacell_membership.Rd b/man/split_sample_cell_type_calculate_metacell_membership.Rd new file mode 100644 index 00000000..61eacf93 --- /dev/null +++ b/man/split_sample_cell_type_calculate_metacell_membership.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functions.R +\name{split_sample_cell_type_calculate_metacell_membership} +\alias{split_sample_cell_type_calculate_metacell_membership} +\title{Calculate Metacell Membership for Each Cell Type} +\usage{ +split_sample_cell_type_calculate_metacell_membership( + sample_sce, + cell_type_tbl, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + doublet_identification_tbl = NULL, + x = "cell_type", + min_cells_per_metacell = NULL +) +} +\arguments{ +\item{sample_sce}{A SingleCellExperiment object containing single-cell data.} + +\item{cell_type_tbl}{A tibble of cell type.} + +\item{empty_droplets_tbl}{A tibble identifying empty droplets.} + +\item{alive_identification_tbl}{A tibble from alive cell identification.} + +\item{doublet_identification_tbl}{A tibble from doublet identification.} + +\item{x}{A character vector of cell type aggregation column.} + +\item{min_cells_per_metacell}{An integer of minimum cells in each metacell.} +} +\value{ +A tibble with metacell membership data for each cell type. +} +\description{ +This function processes a SingleCellExperiment object by grouping cells according +to their type, calculates metacell membership for each group, and combines the +results into a single tibble. +} diff --git a/man/test_differential_abundance.Rd b/man/test_differential_abundance.Rd index f3ad5392..87f74b71 100644 --- a/man/test_differential_abundance.Rd +++ b/man/test_differential_abundance.Rd @@ -1,31 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/modules_grammar_hpc.R -\name{test_differential_abundance,HPCell-method} -\alias{test_differential_abundance,HPCell-method} +\name{test_differential_abundance-HPCell-method} +\alias{test_differential_abundance-HPCell-method} +\alias{evaluate_hpc} \title{Test Differential Abundance for HPCell} \usage{ -\S4method{test_differential_abundance}{HPCell}( - .data, - .formula, - .sample = NULL, - .transcript = NULL, - .abundance = NULL, - contrasts = NULL, - method = "edgeR_quasi_likelihood", - test_above_log2_fold_change = NULL, - scaling_method = "TMM", - omit_contrast_in_colnames = FALSE, - prefix = "", - action = "add", - factor_of_interest = NULL, - target_input = "pseudobulk_se", - target_output = "de", - group_by_column = NULL, - ..., - significance_threshold = NULL, - fill_missing_values = NULL, - .contrasts = NULL -) +evaluate_hpc(input_hpc) } \arguments{ \item{.data}{An HPCell object.} @@ -66,135 +46,3 @@ The result of the differential abundance test. \description{ This function tests differential abundance for HPCell objects. } -\details{ -`r lifecycle::badge("maturing")` - -This function provides the option to use edgeR \url{https://doi.org/10.1093/bioinformatics/btp616}, limma-voom \url{https://doi.org/10.1186/gb-2014-15-2-r29}, limma_voom_sample_weights \url{https://doi.org/10.1093/nar/gkv412} or DESeq2 \url{https://doi.org/10.1186/s13059-014-0550-8} to perform the testing. -All methods use raw counts, irrespective of if scale_abundance or adjust_abundance have been calculated, therefore it is essential to add covariates such as batch effects (if applicable) in the formula. - -Underlying method for edgeR framework: - - .data |> - - # Filter -keep_abundant( - factor_of_interest = !!(as.symbol(parse_formula(.formula)[1])), - minimum_counts = minimum_counts, - minimum_proportion = minimum_proportion - ) |> - - # Format - select(!!.transcript,!!.sample,!!.abundance) |> - spread(!!.sample,!!.abundance) |> - as_matrix(rownames = !!.transcript) %>% - - # edgeR - edgeR::DGEList(counts = .) |> - edgeR::calcNormFactors(method = scaling_method) |> - edgeR::estimateDisp(design) |> - - # Fit - edgeR::glmQLFit(design) |> // or glmFit according to choice - edgeR::glmQLFTest(coef = 2, contrast = my_contrasts) // or glmLRT according to choice - - - -Underlying method for DESeq2 framework: - -keep_abundant( - factor_of_interest = !!as.symbol(parse_formula(.formula)[[1]]), - minimum_counts = minimum_counts, - minimum_proportion = minimum_proportion -) |> - -# DESeq2 -DESeq2::DESeqDataSet(design = .formula) |> -DESeq2::DESeq() |> -DESeq2::results() - - - -Underlying method for glmmSeq framework: - -counts = -.data %>% - assay(my_assay) - -# Create design matrix for dispersion, removing random effects -design = - model.matrix( - object = .formula |> lme4::nobars(), - data = metadata - ) - -dispersion = counts |> edgeR::estimateDisp(design = design) %$% tagwise.dispersion |> setNames(rownames(counts)) - - glmmSeq( .formula, - countdata = counts , - metadata = metadata |> as.data.frame(), - dispersion = dispersion, - progress = TRUE, - method = method |> str_remove("(?i)^glmmSeq_" ), - ) -} -\examples{ -# edgeR - - tidybulk::se_mini |> - identify_abundant() |> - test_differential_abundance( ~ condition ) - - # The function `test_differential_abundance` operates with contrasts too - - tidybulk::se_mini |> - identify_abundant(factor_of_interest = condition) |> - test_differential_abundance( - ~ 0 + condition, - contrasts = c( "conditionTRUE - conditionFALSE") - ) - - # DESeq2 - equivalent for limma-voom - -my_se_mini = tidybulk::se_mini -my_se_mini$condition = factor(my_se_mini$condition) - -# demontrating with `fitType` that you can access any arguments to DESeq() -my_se_mini |> - identify_abundant(factor_of_interest = condition) |> - test_differential_abundance( ~ condition, method="deseq2", fitType="local") - -# testing above a log2 threshold, passes along value to lfcThreshold of results() -res <- my_se_mini |> - identify_abundant(factor_of_interest = condition) |> - test_differential_abundance( ~ condition, method="deseq2", - fitType="local", - test_above_log2_fold_change=4 ) - -# Use random intercept and random effect models - - se_mini[1:50,] |> - identify_abundant(factor_of_interest = condition) |> - test_differential_abundance( - ~ condition + (1 + condition | time), - method = "glmmseq_lme4", cores = 1 - ) - -# confirm that lfcThreshold was used -\dontrun{ - res |> - mcols() |> - DESeq2::DESeqResults() |> - DESeq2::plotMA() -} - -# The function `test_differential_abundance` operates with contrasts too - - my_se_mini |> - identify_abundant() |> - test_differential_abundance( - ~ 0 + condition, - contrasts = list(c("condition", "TRUE", "FALSE")), - method="deseq2", - fitType="local" - ) -} diff --git a/man/test_differential_abundance_hpc.Rd b/man/test_differential_abundance_hpc.Rd deleted file mode 100644 index 2aa94ae4..00000000 --- a/man/test_differential_abundance_hpc.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/targets_functions.R -\name{test_differential_abundance_hpc} -\alias{test_differential_abundance_hpc} -\title{Wrapper Function for HPCell Test Differential Abundance} -\usage{ -test_differential_abundance_hpc( - .data, - formula, - store = tempfile(tmpdir = "."), - computing_resources = crew_controller_local(workers = 1), - debug_job_id = NULL, - append = FALSE, - ... -) -} -\arguments{ -\item{.data}{Data frame or similar object for analysis.} - -\item{formula}{Formula for the differential abundance test.} - -\item{store}{File path for temporary storage.} - -\item{computing_resources}{Computing resources configuration.} - -\item{debug_job_id}{Optional job ID for debugging.} - -\item{append}{Flag to append to existing script.} - -\item{...}{additional arguments} -} -\value{ -A \code{targets} pipeline output, typically a nested tibble with differential abundance estimates. -} -\description{ -A wrapper function that formats data into a tibble and calls \code{map2_test_differential_abundance_hpc} for differential abundance testing. -} diff --git a/man/transform_utility.Rd b/man/transform_utility.Rd index ba2bfcfa..92395a41 100644 --- a/man/transform_utility.Rd +++ b/man/transform_utility.Rd @@ -4,14 +4,21 @@ \alias{transform_utility} \title{Apply a transformation to an assay and save as HDF5} \usage{ -transform_utility(input_read_RNA_assay, transform_fx, external_path) +transform_utility( + input_read_RNA_assay, + transform_fx, + external_path, + container_type +) } \arguments{ \item{input_read_RNA_assay}{A SummarizedExperiment object to be transformed.} +\item{transform_fx}{A function to apply to the assay of the SummarizedExperiment object.} + \item{external_path}{A character string specifying the directory path to save the transformed object.} -\item{transform}{A function to apply to the assay of the SummarizedExperiment object.} +\item{container_type}{A character vector specifying the output file type. Ideally it should match to the input file type.} } \value{ The function does not return an object. It saves the transformed SummarizedExperiment object to the specified path. diff --git a/meta/meta b/meta/meta deleted file mode 100644 index 2550b41c..00000000 --- a/meta/meta +++ /dev/null @@ -1,37 +0,0 @@ -name|type|data|command|depend|seed|path|time|size|bytes|format|repository|iteration|parent|children|seconds|warnings|error -alive_identification_tbl|pattern|6c2a81fce8511059|0c470b224392b9c8||-1204631748||||284783|qs|local|list||alive_identification_tbl_bfea2a3c|1.758|| -alive_identification_tbl_bfea2a3c|branch|657eb2649f040bbf|0c470b224392b9c8|cba3ac6da15725f9|116204086||t19697.8992807877s|06d6340ca23f910f|284783|qs|local|list|alive_identification_tbl||1.758|Unable to map 111 of 12021 requested IDs.| -annotation_label_transfer_tbl|pattern|a74f279069e42bda|b46c162789ce7f7e||1549267431||||279192|qs|local|list||annotation_label_transfer_tbl_ab819f51|200.999|| -annotation_label_transfer_tbl_ab819f51|branch|4c226faccd2e86b3|b46c162789ce7f7e|3850e3590ba7a4f0|799748093||t19697.9007444997s|45fcf08f579c2696|279192|qs|local|list|annotation_label_transfer_tbl||27.66|| -cell_cycle_score_tbl|pattern|5b9ca4174cd9e132|ea4bf8a601982fa2||-138952697||||6601|qs|local|list||cell_cycle_score_tbl_ab819f51|0.49|| -cell_cycle_score_tbl_ab819f51|branch|59cfcae64667f442|ea4bf8a601982fa2|9bc1be1596998016|-1808743825||t19697.8969280266s|f5e35ace23a2fdda|6601|qs|local|list|cell_cycle_score_tbl||0.49|The following features are not present in the object CDCA7, MLF1IP, RAD51, CDC45, EXO1, BRIP1, E2F8, not searching for symbol synonyms. The following features are not present in the object MKI67, FAM64A, CCNB2, CKAP2L, AURKB, BUB1, HJURP, TTK, KIF2C, DLGAP5, KIF23, ANLN, NEK2, GAS2L3, CENPA, not searching for symbol synonyms| -computing_resources|object|93294ef4833c2926||||||||||||||| -debug_step|object|da7e5646cbdfced7||||||||||||||| -doublet_identification_tbl|pattern|ba621e7c32b3306f|028ec7db45e45897||908803128||||7498|qs|local|list||doublet_identification_tbl_c49acd50|4.942|| -doublet_identification_tbl_c49acd50|branch|8f0a944514893e6e|028ec7db45e45897|b2f79717f6dd74dc|-734311874||t19697.8994625234s|a00d98f8f91cf9a7|7498|qs|local|list|doublet_identification_tbl||4.942|| -empty_droplets_tbl|pattern|b6dd08fb07a0e23e|3353d3f2aaaa393a||-205985081||||13188|qs|local|list||empty_droplets_tbl_2a87e9d4|16.659|| -empty_droplets_tbl_2a87e9d4|branch|7e4b3c5c1914c6ae|3353d3f2aaaa393a|49d048f9fea7c78e|-972596521||t19697.8969091841s|4a4de1274f781a77|13188|qs|local|list|empty_droplets_tbl||16.659|Unable to map 111 of 12021 requested IDs.| -file|stem|9f2bb0ae498de616|b86bb8ebf53f9beb|ef46db3751d8e999|-1301001980||t19697.8966235944s|9dfd31c781e2fd5b|66|rds|local|vector|||0.001|| -filter_empty_droplets|stem|e51d8d193be16a87|9801ac7a0759bef2|dac0abdc56420f5d|555608163||t19697.8967060595s|506f9f6b3747f807|42|qs|local|vector|||0|| -filtered_file|stem|e51d8d193be16a87|4242e213a9d0492f|ef46db3751d8e999|-1828649942||t19697.8966953651s|506f9f6b3747f807|42|qs|local|vector|||0.001|| -input_data|object|76e86bca832dbafc||||||||||||||| -input_read|pattern|d03b8077db2172f2|c4a42f616d359352||-1928478173||||1382219|qs|local|list||input_read_58a1fafa|0.051|| -input_read_58a1fafa|branch|c4d754d87a984643|c4a42f616d359352|ef46db3751d8e999|-1100213721||t19697.8966855271s|32fad64f913e5498|1382219|qs|local|list|input_read||0.051|| -input_reference|object|da7e5646cbdfced7||||||||||||||| -non_batch_variation_removal_S|pattern|3a96417f529e5d75|fe9c434b5c1f2e9f||-1502599574||||24484807|qs|local|list||non_batch_variation_removal_S_2405b948|8.659|| -non_batch_variation_removal_S_2405b948|branch|ce183af41f977b88|fe9c434b5c1f2e9f|6b13bc72d4a3dd8a|-1912965340||t19697.8993942365s|dfeb160f3f1e5bb8|24484807|qs|local|list|non_batch_variation_removal_S||8.659|| -preprocessing_output_S|pattern|5d27a4b100e4ee75|258639e4385855e6||46538738||||22870055|qs|local|list||preprocessing_output_S_269c823b|0.273|| -preprocessing_output_S_269c823b|branch|97b4d10365fad9bd|258639e4385855e6|1c6188711c5cbe71|-2034187342||t19697.8994787965s|ad6422af65e871c0|22870055|qs|local|list|preprocessing_output_S||0.273|| -pseudobulk_preprocessing_SE|stem|9351bf90de1319f4|5659bdc37ee17bd6|dd2d30e8ac595c99|647724283||t19697.899555706s|ca0fd45832ad8bd8|207105|qs|local|vector|||5.571|Key originalexp_ taken, using rna_ instead. Key originalexp_ taken, using rna_ instead| -data_object|stem|de6cc79c370c44ae|5a0bb3630c52f9fd|ef46db3751d8e999|-355275297||t19697.8966741961s|8a2d295a6f6be5b7|61|qs|local|vector||read_file_3b879ae1|0.001|| -reference_file|stem|6dd71d12008128c1|c3689936a5c436fe|ef46db3751d8e999|-505379189||t19697.8965949718s|de1c6d017cb4e8a8|38|qs|local|vector|||0.576|| -reference_label_coarse|stem|47d778ae3c351e14|356a370377b0dfc0|b27a9324d11b2897|1988768850||t19697.8966644045s|1d635f53cb385f1d|65|qs|local|vector|||0|| -reference_label_fine|stem|6b5e6dd280940374|0f0c7019782f3d6f|b27a9324d11b2897|2112238395||t19697.8966542772s|b2c2d69496a0fbf4|63|qs|local|vector|||0.001|| -reference_read|stem|6dd71d12008128c1|45de7fb6fe4d2958|50f371d3da9cf845|-804588208||t19697.8966136986s|de1c6d017cb4e8a8|38|qs|local|vector|||0.001|| -RNA_assay_name|object|12667ef66f726082||||||||||||||| -sample_column|stem|c78ab07039f21f00|da7093a0351eb8f8|6fe80592cf47985c|282716379||t19697.8995784375s|4956b68a23f9e1fc|122|qs|local|vector|||0|| -sample_column_file|stem|c78ab07039f21f00|61a2077b7feb362e|ef46db3751d8e999|1250955058||t19697.899567419s|4956b68a23f9e1fc|122|qs|local|vector|||0.002|| -store|object|aa663b47d2e83456||||||||||||||| -target_list|object|905b407a82e7432e||||||||||||||| -tissue|stem|5f7ae0a6397c0eae|0da269393e1dde90|e7b0d939ef60d865|-1069396715||t19697.8966441268s|44e327d1ee1978d7|43|qs|local|vector|||0.001|| -tissue_file|stem|5f7ae0a6397c0eae|a59d3287c8d51bf1|ef46db3751d8e999|-354459537||t19697.8966334208s|44e327d1ee1978d7|43|qs|local|vector|||0.001|| diff --git a/meta/process b/meta/process deleted file mode 100644 index 7bcfebf3..00000000 --- a/meta/process +++ /dev/null @@ -1,4 +0,0 @@ -name|value -pid|56293 -version_r|4.3.0 -version_targets|1.3.2 diff --git a/meta/progress b/meta/progress deleted file mode 100644 index 791bdac7..00000000 --- a/meta/progress +++ /dev/null @@ -1,30 +0,0 @@ -name|type|parent|branches|progress -reference_file|stem|reference_file|0|skipped -tissue_file|stem|tissue_file|0|skipped -sample_column_file|stem|sample_column_file|0|skipped -sample_column|stem|sample_column|0|skipped -tissue|stem|tissue|0|skipped -reference_label_fine|stem|reference_label_fine|0|skipped -data_object|stem|data_object|0|skipped -input_read_58a1fafa|branch|input_read|0|skipped -input_read|pattern|input_read|1|skipped -file|stem|file|0|skipped -filtered_file|stem|filtered_file|0|skipped -filter_empty_droplets|stem|filter_empty_droplets|0|skipped -empty_droplets_tbl_2a87e9d4|branch|empty_droplets_tbl|0|skipped -empty_droplets_tbl|pattern|empty_droplets_tbl|1|skipped -cell_cycle_score_tbl_ab819f51|branch|cell_cycle_score_tbl|0|skipped -cell_cycle_score_tbl|pattern|cell_cycle_score_tbl|1|skipped -reference_read|stem|reference_read|0|skipped -annotation_label_transfer_tbl_ab819f51|branch|annotation_label_transfer_tbl|0|skipped -annotation_label_transfer_tbl|pattern|annotation_label_transfer_tbl|1|skipped -alive_identification_tbl_bfea2a3c|branch|alive_identification_tbl|0|skipped -alive_identification_tbl|pattern|alive_identification_tbl|1|skipped -doublet_identification_tbl_c49acd50|branch|doublet_identification_tbl|0|skipped -doublet_identification_tbl|pattern|doublet_identification_tbl|1|skipped -non_batch_variation_removal_S_2405b948|branch|non_batch_variation_removal_S|0|skipped -non_batch_variation_removal_S|pattern|non_batch_variation_removal_S|1|skipped -preprocessing_output_S_269c823b|branch|preprocessing_output_S|0|skipped -preprocessing_output_S|pattern|preprocessing_output_S|1|skipped -reference_label_coarse|stem|reference_label_coarse|0|skipped -pseudobulk_preprocessing_SE|stem|pseudobulk_preprocessing_SE|0|skipped diff --git a/plots_chunk_1.pdf b/plots_chunk_1.pdf new file mode 100644 index 00000000..f82636ee Binary files /dev/null and b/plots_chunk_1.pdf differ diff --git a/tests/testthat/test_single_functions.R b/tests/testthat/test_single_functions.R index 414737e1..3e32fe02 100644 --- a/tests/testthat/test_single_functions.R +++ b/tests/testthat/test_single_functions.R @@ -12,29 +12,39 @@ input_seurat_abc = as.Seurat(data = NULL) |> subset(subset = Tissue %in% c("Blood")) +cell_type_column <- "Cell_type_in_each_tissue" # sample_column<- "Tissue" ## Defining functions # reference_label_fine = HPCell:::reference_label_fine_id(tissue) -empty_droplets_tbl = HPCell:::empty_droplet_id(input_seurat_abc, filter_empty_droplets = TRUE) +empty_droplets_tbl = HPCell:::empty_droplet_threshold(input_seurat_abc, + feature_nomenclature = "symbol") # Define output from annotation_label_transfer annotation_label_transfer_tbl = HPCell:::annotation_label_transfer(input_seurat_abc, - empty_droplets_tbl) + empty_droplets_tbl, + reference_azimuth = "pbmcref", + feature_nomenclature = "symbol") + +# Define output from cell_type_ensembl_harmonised +cell_type_ensemble_tbl = HPCell:::cell_type_ensembl_harmonised(input_seurat_abc, + annotation_label_transfer_tbl) # Define output from alive_identification alive_identification_tbl = HPCell:::alive_identification(input_seurat_abc, empty_droplets_tbl, - annotation_label_transfer_tbl) + cell_type_ensemble_tbl, + cell_type_column = "cell_type_unified_ensemble", + feature_nomenclature = "symbol") # Define output from doublet_identification doublet_identification_tbl = HPCell:::doublet_identification(input_seurat_abc, empty_droplets_tbl, alive_identification_tbl, - annotation_label_transfer_tbl, - reference_label_fine) + cell_type_ensemble_tbl, + reference_label_fine = "cell_type_unified_ensemble") # Define output from cell_cycle_scoring cell_cycle_score_tbl = HPCell:::cell_cycle_scoring(input_seurat_abc, empty_droplets_tbl) @@ -52,6 +62,34 @@ preprocessing_output_S = HPCell:::preprocessing_output(tissue, cell_cycle_score_tbl, annotation_label_transfer_tbl, doublet_identification_tbl) + +# Calculate metacell for a sample cell type +metacell_per_cell_type <- HPCell:::calculate_metacell_for_a_sample_per_cell_type(input_seurat_abc, + min_cells_per_metacell = 10) + +# Calculate metacell membership +metacell_tbl <- split_sample_cell_type_calculate_metacell_membership(input_seurat_abc, + input_seurat_abc[[]] |> + rownames_to_column(var = ".cell") |> + as_tibble(), + empty_droplets_tbl, + alive_identification_tbl, + doublet_identification_tbl, + x = cell_type_column, + min_cells_per_metacell = 10) + +# Define output from cell_communication +cell_communication_tbl = HPCell:::cell_communication(input_seurat_abc, + empty_droplets_tbl = NULL, + alive_identification_tbl = NULL, + doublet_identification_tbl = NULL, + cell_type_tbl = input_seurat_abc[[]] |> + rownames_to_column(var = ".cell") |> + as_tibble() |> mutate(sample_id = "sample1"), + assay = NULL, + cell_type_column = "Cell_type_in_each_tissue", + feature_nomenclature = "symbol") + # empty_droplets_tbl = HPCell:::empty_droplet_id(input_seurat_list[[1]], filter_empty_droplets = TRUE) # # # Define output from annotation_label_transfer @@ -361,11 +399,21 @@ path<- paste0(system.file(package = "HPCell"), "extdata/Test.Rmd") ## Testing in Targets +file_paths <- tar_read(read_file_files, store = store) +data_container_type <- tar_read(data_container_type_file, store = store) + +input_file <- list() + +# Loop over elements in file_paths list +for (i in seq_along(file_paths)) { + input_file[[i]] <- read_data_container(file_paths[[i]], container_type = data_container_type) +} + ## Empty Droplets rmarkdown::render( input = paste0(system.file(package = "HPCell"), "/rmd/Empty_droplet_report.Rmd"), output_file = paste0(system.file(package = "HPCell"), "/Empty_droplet_report.html"), - params = list(x1 = tar_read(input_read, store = store), + params = list(x1 = read_data_container(tar_read(file_path, store = store), container_type = tar_read(data_container_type_file, store = store)), x2 = tar_read(empty_droplets_tbl, store = store), x3 = tar_read(annotation_label_transfer_tbl, store = store), x4 = tar_read(unique_tissues, store = store), @@ -397,7 +445,6 @@ rmarkdown::render( ) ## Pseudobulk analysis report - rmarkdown::render( input = paste0(system.file(package = "HPCell"), "/rmd/pseudobulk_analysis_report.Rmd"), output_file = paste0(system.file(package = "HPCell"), "/pseudobulk_analysis_report.html"), @@ -462,9 +509,9 @@ library(crew.cluster) # library(SeuratData) # InstallData("pbmc3k") # options(Seurat.object.assay.version = "v5") -# input_seurat <- -# LoadData("pbmc3k") |> -# _[,1:500] +input_seurat <- + LoadData("pbmc3k") |> + _[,1:500] # # change_seurat_counts = function(data){ # @@ -482,12 +529,61 @@ library(crew.cluster) # input_seurat |> mutate(condition = "untreated") |> change_seurat_counts() |> as.SingleCellExperiment() |> saveRDS("dev/input_seurat_UNtreated_1_SCE.rds") # input_seurat |> mutate(condition = "untreated") |> change_seurat_counts() |> as.SingleCellExperiment() |> saveRDS("dev/input_seurat_UNtreated_2_SCE.rds") - - # library(SeuratData) # InstallData("pbmcsca") # pbmcsca <- LoadData("pbmcsca") # save this to disk, so you can recall every time you execute HPCell +computing_resources = crew_controller_local(workers = 8) #resource_tuned_slurm + +# tier = rep(c("tier_1", "tier_2"), times = 6), +# computing_resources = list( +# +# crew_controller_local( +# name = "tier_1", +# workers = 4 +# ), +# crew_controller_local( +# name = "tier_2", +# workers = 4 +# ) +# ) + + computing_resources = list( + + crew_controller_slurm( + name = "tier_1", + slurm_memory_gigabytes_per_cpu = 5, + slurm_cpus_per_task = 1, + workers = 50, + tasks_max = 5, + verbose = T, + seconds_idle = 30 + ), + crew_controller_slurm( + name = "tier_2", + slurm_memory_gigabytes_per_cpu = 10, + slurm_cpus_per_task = 1, + workers = 50, + tasks_max = 5, + verbose = T, + seconds_idle = 30 + ) +) + +# Slurm resources +# computing_resources = +# crew.cluster::crew_controller_slurm( +# slurm_memory_gigabytes_per_cpu = 5, +# workers = 500, +# tasks_max = 5, +# verbose = T, +# slurm_cpus_per_task = 1 +# ) + +{ foo_function = function(x, y){x |> dplyr::mutate(foo = y)} } |> + substitute() |> + deparse() |> + readr::write_lines("dev/my_custom_script.R") # # Define and execute the pipeline file_list = @@ -498,85 +594,52 @@ file_list = # purrr::map_chr(here::here) |> # magrittr::set_names(c("pbmc3k1_1", "pbmc3k1_2", "pbmc3k1_3", "pbmc3k1_4")) # - - dir("dev/CAQ_sce/", full.names = T) - + dir("dev/CAQ_sce/", full.names = T) |> head(2) # Initialise pipeline characteristics -file_list |> +# file_list |> +input_hpc |> initialise_hpc( gene_nomenclature = "symbol", data_container_type = "sce_hdf5", - + store = "~/scratch/Census/temp5/", + tier = c("tier_1","tier_1"), + computing_resources = computing_resources, + #debug_step ="empty_tbl_0cf8d597acd380df" # debug_step = "non_batch_variation_removal_S_1", + # Default resourced - computing_resources = crew_controller_local(workers = 8), #resource_tuned_slurm - - # tier = rep(c("tier_1", "tier_2"), times = 6), - # computing_resources = list( - # - # crew_controller_local( - # name = "tier_1", - # workers = 4 - # ), - # crew_controller_local( - # name = "tier_2", - # workers = 4 - # ) - # ) - - # computing_resources = list( - # - # crew_controller_slurm( - # name = "tier_1", - # slurm_memory_gigabytes_per_cpu = 5, - # slurm_cpus_per_task = 1, - # workers = 50, - # tasks_max = 5, - # verbose = T - # ), - # crew_controller_slurm( - # name = "tier_2", - # slurm_memory_gigabytes_per_cpu = 10, - # slurm_cpus_per_task = 1, - # workers = 50, - # tasks_max = 5, - # verbose = T - # ) - # ) - - # # Slurm resources - # computing_resources = - # crew.cluster::crew_controller_slurm( - # slurm_memory_gigabytes_per_cpu = 5, - # workers = 500, - # tasks_max = 5, - # verbose = T, - # slurm_cpus_per_task = 1 - # ) - ) |> - - - hpc_report( - "empty_report", - rmd_path = paste0(system.file(package = "HPCell"), "/rmd/test.Rmd"), - empty_list = "empty_tbl" |> is_target(), - sample_names = "sample_names" |> is_target() ) |> # ONLY APPLICABLE TO SCE FOR NOW - tranform_assay(fx = file_list |> purrr::map(~identity), target_output = "sce_transformed") |> + transform_assay(fx = file_list |> purrr::map(~identity), target_output = "sce_transformed") |> + # hpc_report( + # "empty_report", + # rmd_path = paste0(system.file(package = "HPCell"), "/rmd/test.Rmd"), + # empty_list = "empty_tbl" |> is_target(), + # sample_names = "sample_names" |> is_target() + # ) |> + # + # + # hpc_iterate( + # target_output = "o", + # user_function = function(x, y){x |> dplyr::mutate(bla = y)}, + # x = "data_object" |> is_target(), + # y = "works" + # ) |> + hpc_iterate( - target_output = "o", - user_function = function(x, y){x |> dplyr::mutate(bla = y)}, + target_output = "foo", + user_function = foo_function |> quote(), x = "data_object" |> is_target(), - y = "works" + y = "works", + user_function_source_path = "dev/my_custom_script.R" |> here::here() ) |> - + # Remove empty outliers - remove_empty_DropletUtils( target_input = "data_object") |> + remove_empty_DropletUtils( target_input = "sce_transformed") |> # Annotation annotate_cell_type( @@ -594,10 +657,9 @@ file_list |> # Remove doublets remove_doublets_scDblFinder(target_input = "data_object") |> - normalise_abundance_seurat_SCT(factors_to_regress = c( - "subsets_Mito_percent", - "subsets_Ribo_percent", + "subsets_Mito_percent", + "subsets_Ribo_percent", "G2M.Score" ), target_input = "data_object") |> @@ -605,8 +667,200 @@ file_list |> calculate_pseudobulk(group_by = "monaco_first.labels.fine", target_input = "data_object") |> # test_differential_abundance(~ age_days + (1|collection_id), .abundance="counts") |> - test_differential_abundance(~ age_days, .abundance="counts", group_by_column = "monaco_first.labels.fine") |> + test_differential_abundance(~ age_days, .abundance="counts", group_by_column = "monaco_first.labels.fine") |> # For the moment only available for single cell get_single_cell(target_input = "data_object") + +## Report testing + +library(HPCell) +library(targets) +library(Seurat) +library(SeuratData) +library(crew) +library(crew.cluster) + +bp<- scRNAseq::fetchDataset("baron-pancreas-2016", "2023-12-14", path="human") + +file.path <- ("~/HPCell/bp.rds") +split_values <- unique(bp$label) + +# Create a list of SCE objects split by the column +sce_list <- lapply(split_values, function(value) { + bp[, bp$label == value] +}) + + +##### Testing args +# empty_tbl <- tar_read(empty_tbl) +# data_object <- tar_read(data_object) +# alive_tbl <- tar_read(alive_tbl) +# sample_name <- tar_read(sample_names) +# cell_cycle_tbl <- tar_read(cell_cycle_tbl) +# annotation_tbl <- tar_read(annotation_tbl) +# doublet_tbl <- tar_read(doublet_tbl) +# data_object <- tar_read(data_object) +######################################### +library(HPCell) +library(targets) +library(Seurat) +library(SeuratData) +library(crew) +library(crew.cluster) + +InstallData("ifnb") +ifnb <- UpdateSeuratObject(ifnb) +ifnb.list <- SplitObject(ifnb, split.by = "stim") +file_paths <- c("~/CTRL_seurat_tibble.rds", "~/STIM_seurat_tibble.rds") + +#Subset 300 cells +ctrl_subset <- subset(ifnb.list$CTRL, cells = sample(Cells(ifnb.list$CTRL), size = 300)) +stim_subset <- subset(ifnb.list$STIM, cells = sample(Cells(ifnb.list$STIM), size = 300)) + +# Save the Seurat objects to the specified file paths +saveRDS(ctrl_subset, file_paths[1]) # Save CTRL object +saveRDS(stim_subset, file_paths[2]) # Save STIM object + +input_hpc = + file_paths |> + magrittr::set_names(c("CTRL", "STIM")) + +input_hpc |> + initialise_hpc( + gene_nomenclature = "symbol", + data_container_type = "seurat_rds", + computing_resources = crew_controller_local(workers = 8), + ) |> + remove_empty_DropletUtils() |> # Remove empty outliers + remove_dead_scuttle() |> # Remove dead cells + score_cell_cycle_seurat() |> # Score cell cycle + remove_doublets_scDblFinder() |> # Remove doublets + annotate_cell_type() |> # Annotation across SingleR and Seurat Azimuth + normalise_abundance_seurat_SCT(factors_to_regress = c( + "subsets_Mito_percent", + "subsets_Ribo_percent", + "G2M.Score" + )) |> + + hpc_report( + "empty_report", + rmd_path = system.file("rmd", "Empty_droptlet_report.qmd", package = "HPCell"), + empty_tbl = "empty_tbl" |> is_target(), + data_object = "data_object" |> is_target(), + alive_tbl = "alive_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) +# |> + hpc_report( + "doublet_report", + rmd_path = system.file("rmd", "Doublet_identification_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + doublet_tbl = "doublet_tbl" |> is_target(), + annotation_tbl = "annotation_tbl" |> is_target(), + sample_names = "sample_names" |> is_target() + ) |> + hpc_report( + "Technical_variation_report", + rmd_path = system.file("rmd", "technical_variation_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + empty_tbl = "empty_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) |> + hpc_report( + "pseudo_bulk_report", + rmd_path = system.file("rmd", "pseudobulk_analysis_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + empty_tbl = "empty_tbl" |> is_target(), + alive_tbl = "alive_tbl" |> is_target(), + cell_cycle_tbl = "cell_cycle_tbl" |> is_target(), + annotation_tbl = "annotation_tbl" |> is_target(), + doublet_tbl = "doublet_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) + + + + + +library(HPCell) +library(targets) +library(Seurat) +library(SeuratData) +library(crew) +library(crew.cluster) + +file_paths <- file.path(getwd(), c("CTRL_seurat_tibble.rds", "STIM_seurat_tibble.rds")) +names(file_paths) <- c("CTRL", "STIM") + +# Install and prepare IFNB demo dataset +SeuratData::InstallData("ifnb") +ifnb <- ifnb |> UpdateSeuratObject() +ifnb.list <- SplitObject(ifnb, split.by = "stim") + +# Sample 300 cells per condition +set.seed(42) +ctrl_subset <- subset(ifnb.list$CTRL, cells = sample(Cells(ifnb.list$CTRL), size = 300)) +stim_subset <- subset(ifnb.list$STIM, cells = sample(Cells(ifnb.list$STIM), size = 300)) + +saveRDS(ctrl_subset, file_paths["CTRL"]) +saveRDS(stim_subset, file_paths["STIM"]) + +input_hpc <- file_paths + +input_hpc = + file_paths |> + magrittr::set_names(c("CTRL", "STIM")) + +input_hpc |> + initialise_hpc( + gene_nomenclature = "symbol", + data_container_type = "seurat_rds", + computing_resources = crew_controller_local(workers = 8), + ) |> + remove_empty_DropletUtils() |> # Remove empty outliers + remove_dead_scuttle() |> # Remove dead cells + score_cell_cycle_seurat() |> # Score cell cycle + remove_doublets_scDblFinder() |> # Remove doublets + annotate_cell_type() |> # Annotation across SingleR and Seurat Azimuth + normalise_abundance_seurat_SCT(factors_to_regress = c( + "subsets_Mito_percent", + "subsets_Ribo_percent", + "G2M.Score" + )) |> + hpc_report( + "empty_report", + rmd_path = system.file("rmd", "Empty_droptlet_report.qmd", package = "HPCell"), + empty_tbl = "empty_tbl" |> is_target(), + data_object = "data_object" |> is_target(), + alive_tbl = "alive_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) |> + hpc_report( + "doublet_report", + rmd_path = system.file("rmd", "Doublet_identification_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + doublet_tbl = "doublet_tbl" |> is_target(), + annotation_tbl = "annotation_tbl" |> is_target(), + sample_names = "sample_names" |> is_target() + ) |> + hpc_report( + "Technical_variation_report", + rmd_path = system.file("rmd", "technical_variation_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + empty_tbl = "empty_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) |> + hpc_report( + "pseudo_bulk_report", + rmd_path = system.file("rmd", "pseudobulk_analysis_report.qmd", package = "HPCell"), + data_object = "data_object" |> is_target(), + empty_tbl = "empty_tbl" |> is_target(), + alive_tbl = "alive_tbl" |> is_target(), + cell_cycle_tbl = "cell_cycle_tbl" |> is_target(), + annotation_tbl = "annotation_tbl" |> is_target(), + doublet_tbl = "doublet_tbl" |> is_target(), + sample_name = "sample_names" |> is_target() + ) +