diff --git a/DESCRIPTION b/DESCRIPTION index 911ff61f..e1f3dc38 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: infercnv Type: Package Title: Infer Copy Number Variation from Single-Cell RNA-Seq Data -Version: 0.8 +Version: 0.8.1 Date: 2017-05-25 Authors@R: c( person("Timothy", "Tickle", email = "ttickle@broadinstitute.org", role = c("aut", "cre")), person("Itay", "Tirosh", email = "tirosh@broadinstitute.org", role = "aut"), person("Christophe", "Georgescu", email = "cgeorges@broadinstitute.org", role = "aut"), person("Maxwell", "Brown", email = "mbrown@broadinstitute.org", role = "aut"), person("Brian", "Haas", email = "bhaas@broadinstitute.org", role = "aut")) Author: Timothy Tickle [aut, cre], Itay Tirosh [aut], Christophe Georgescu [aut], Maxwell Brown [aut], Brian Haas [aut] diff --git a/R/inferCNV.R b/R/inferCNV.R index 5420bd83..0ab26e7b 100755 --- a/R/inferCNV.R +++ b/R/inferCNV.R @@ -377,3 +377,23 @@ validate_infercnv_obj <- function(infercnv_obj) { } + +get_cell_name_by_grouping <- function(infercnv_obj) { + + cell_name_groupings = list() + + groupings = c(infercnv_obj@reference_grouped_cell_indices, infercnv_obj@observation_grouped_cell_indices) + + for (group_name in names(groupings)) { + + cell_names = colnames(infercnv_obj@expr.data[, groupings[[ group_name ]] ] ) + + cell_name_groupings[[ group_name ]] = cell_names + + } + + return(cell_name_groupings) +} + + + diff --git a/R/inferCNV_heatmap.R b/R/inferCNV_heatmap.R index 98093cbc..af5771bb 100755 --- a/R/inferCNV_heatmap.R +++ b/R/inferCNV_heatmap.R @@ -145,7 +145,8 @@ plot_cnv <- function(infercnv_obj, # Row separation based on reference ref_idx <- unlist(infercnv_obj@reference_grouped_cell_indices) - + ref_idx = ref_idx[order(ref_idx)] + # Column seperation by contig and label axes with only one instance of name contig_tbl <- table(contigs)[unique_contigs] col_sep <- cumsum(contig_tbl) @@ -176,13 +177,14 @@ plot_cnv <- function(infercnv_obj, counter <- counter + 1 } # restrict to just the obs indices - obs_annotations_groups <- obs_annotations_groups[ unlist(obs_index_groupings) ] - + obs_annotations_groups <- obs_annotations_groups[-ref_idx] + grouping_key_coln[1] <- floor(123/(max(nchar(obs_annotations_names)) + 4)) ## 123 is the max width in number of characters, 4 is the space taken by the color box itself and the spacing around it if (grouping_key_coln[1] < 1) { grouping_key_coln[1] <- 1 } + name_ref_groups = names(infercnv_obj@reference_grouped_cell_indices) grouping_key_coln[2] <- floor(123/(max(nchar(name_ref_groups)) + 4)) ## 123 is the max width in number of characters, 4 is the space taken by the color box itself and the spacing around it if (grouping_key_coln[2] < 1) { @@ -195,7 +197,7 @@ plot_cnv <- function(infercnv_obj, # Calculate how much bigger the output needs to be to accodomate for the grouping key grouping_key_height <- c((grouping_key_rown[2] + 2) * 0.175, (grouping_key_rown[1] + 3) * 0.175) - # Rows observations, Columns CHR + # Rows observations, Columns CHR if (! is.na(output_format)) { if (output_format == "pdf") { pdf(paste(out_dir, paste(output_filename, ".pdf", sep=""), sep="/"), @@ -219,7 +221,7 @@ plot_cnv <- function(infercnv_obj, ## They are more informative anyway obs_data <- infercnv_obj@expr.data if (!is.null(ref_idx)){ - obs_data <- plot_data[, -1 * ref_idx, drop=FALSE] + obs_data <- plot_data[, -ref_idx, drop=FALSE] if (ncol(obs_data) == 1) { # hack for dealing with single entries plot_data <- cbind(obs_data, obs_data) @@ -244,7 +246,7 @@ plot_cnv <- function(infercnv_obj, current_grp_idx <- current_grp_idx + 1 } ref_groups <- updated_ref_groups - + nb_breaks <- 16 breaksList_t <- seq(min(min(obs_data_t, na.rm=TRUE), min(ref_data_t, na.rm=TRUE)), diff --git a/example/example.Rmd b/example/example.Rmd index 3ec8aa44..1e6b4c71 100644 --- a/example/example.Rmd +++ b/example/example.Rmd @@ -292,8 +292,10 @@ plot_cnv(infercnv_obj, ```{r} knitr::include_graphics("infercnv.finalized_view.png") +``` + And that's it. You can experiment with each step to fine-tune your data exploration. See the documentation for uploading the resulting data matrix into the Next Generation Clustered Heatmap Viewer for more interactive exploration of the infercnv-processed data: -``` + diff --git a/scripts/inferCNV_utils.R b/scripts/inferCNV_utils.R index edbf5d17..78e7085d 100644 --- a/scripts/inferCNV_utils.R +++ b/scripts/inferCNV_utils.R @@ -1,9 +1,9 @@ library(tidyverse) - +library(futile.logger) # plot expression density by chromosome for each observation group, reference groups are shown as single 'normal' group. -plot_density_by_chr <- function(infercnv_obj, pdf_filename=NULL, exclude_range=NULL, chrs=NULL) { +plot_density_by_chr <- function(infercnv_obj, pdf_filename=NULL, exclude_range=NULL, include_range = NULL, chrs=NULL) { ref_group_cell_indices = infercnv:::get_reference_grouped_cell_indices(infercnv_obj) @@ -15,6 +15,9 @@ plot_density_by_chr <- function(infercnv_obj, pdf_filename=NULL, exclude_range=N if (! is.null(pdf_filename)) { pdf(pdf_filename) } + + + chr_expr_vals = list() for (chr in chrs) { @@ -40,16 +43,25 @@ plot_density_by_chr <- function(infercnv_obj, pdf_filename=NULL, exclude_range=N excl_range_right = exclude_range[2] df = df %>% filter(vals < excl_range_left | vals > excl_range_right) + } else if (! is.null(include_range)) { + include_range_left = include_range[1] + include_range_right = include_range[2] + + df = df %>% filter(vals >= include_range_left & vals <= include_range_right) } - + p = df %>% ggplot(aes(vals, fill=class)) + geom_density(alpha=0.3) + scale_y_continuous(trans='log10', limits=c(1,NA)) + ggtitle(chr) plot(p) + + chr_expr_vals[[ chr ]] = df } if (! is.null(pdf_filename)) { dev.off() } + + return(chr_expr_vals) } @@ -87,6 +99,8 @@ plot_dist_counts_expr_genes_by_chr <- function(infercnv_obj, pdf_filename=NULL, if (! is.null(pdf_filename)) { pdf(pdf_filename) } + + gene_counts_dfs = list() for (chr in chrs) { gene_idx = which(infercnv_obj@gene_order$chr == chr) @@ -104,11 +118,15 @@ plot_dist_counts_expr_genes_by_chr <- function(infercnv_obj, pdf_filename=NULL, } p = df %>% ggplot(aes(gene_counts, fill=class)) + geom_density(alpha=0.3) + ggtitle(chr) plot(p) + + gene_counts_dfs[[ chr ]] = df } if (! is.null(pdf_filename)) { dev.off() } + + return(gene_counts_dfs) } @@ -133,7 +151,9 @@ compare_gene_expr_means_by_group_pair <- function(infercnv_obj, groupA, groupB, groupA.gene_mean = rowMeans(groupA.expr.data) groupB.gene_mean = rowMeans(groupB.expr.data) - plot(groupA.gene_mean, groupB.gene_mean) + #plot(groupA.gene_mean, groupB.gene_mean) + smoothScatter(groupA.gene_mean, groupB.gene_mean) + abline(a=0, b=1, col='magenta') df=data.frame(groupA=groupA.gene_mean, groupB=groupB.gene_mean)