From 86a36cf82faed1c04fe0a4c3ce5d9cd3e9e6ea76 Mon Sep 17 00:00:00 2001 From: Lorena Pantano Date: Mon, 29 Apr 2024 17:00:52 -0400 Subject: [PATCH] update colors --- R/cb_friendly.R | 34 +++++------ .../templates/rnaseq/skeleton/DE/DEG.Rmd | 58 +++++++++++++++---- 2 files changed, 64 insertions(+), 28 deletions(-) diff --git a/R/cb_friendly.R b/R/cb_friendly.R index 6303fa3..a22aa2d 100644 --- a/R/cb_friendly.R +++ b/R/cb_friendly.R @@ -1,15 +1,15 @@ #' list of colorblind-friendly colors, developed by James and client cb_friendly_colors <- c( `blue` = "#2759F6", - `dark_purple` = "#402999", + `light_orange` = "#FFD37D", + `olive_green` = "olivedrab3", `purple` = "#9176C8", + `pink` = "#E93380", `sky_blue` = "#4FAEEB", `blue_grey` = "#92A6BC", `forest_green` = "#3C877B", - `pink` = "#E93380", - `olive_green` = "olivedrab3", `yellow` = "yellow", - `light_orange` = "#FFD37D", + `dark_purple` = "#402999", `dark_orange` = "#D5392C", `army_green` = "#C3C380", `black` = "black", @@ -29,20 +29,20 @@ list_cb_friendly_cols <- function(){ #' @export cb_friendly_cols <- function(...) { cols <- c(...) - + if (is.null(cols)) return (cb_friendly_colors) - + cb_friendly_colors[cols] } #' define main colorblind-friendly palette as well as sub-palettes cb_friendly_palettes <- list( - `main` = cb_friendly_cols("blue", "dark_purple", "purple", "sky_blue", - "blue_grey", "forest_green", "pink", "olive_green", - "yellow", "light_orange", "dark_orange", - "army_green", "black", "dark_grey", "light_blue", - "brown"), + `main` = cb_friendly_cols("blue", "purple", "sky_blue", + "blue_grey", "forest_green", "pink", "olive_green", + "yellow", "dark_purple", "dark_orange", + "army_green", "black", "dark_grey", "light_blue", + "brown","light_orange"), `cool` = cb_friendly_cols("blue", "dark_purple", "purple", "sky_blue"), `hot` = cb_friendly_cols("yellow", "light_orange", "dark_orange"), `grey` = cb_friendly_cols("black", "dark_grey", "blue_grey"), @@ -50,7 +50,7 @@ cb_friendly_palettes <- list( ) #' access cb friendly palette by name, reversing if necessary -#' +#' #' @param palette name of the palette to be returned #' @param reverse boolean, reverse order of colors in palette #' @export @@ -61,14 +61,14 @@ cb_friendly_pal <-function(palette = 'main', reverse = F, ...){ } #' use cb friendly colors as color aesthetic with ggplot -#' +#' #' @param palette name of the palette to be returned #' @param discrete boolean, whether to make palette discretely divided into colors or continuous #' @param reverse boolean, reverse order of colors in palette #' @export scale_color_cb_friendly <- function(palette = "main", discrete = TRUE, reverse = FALSE, ...) { pal <- cb_friendly_pal(palette = palette, reverse = reverse) - + if (discrete) { discrete_scale("colour", paste0("cb_friendly_", palette), palette = pal, ...) } else { @@ -77,17 +77,17 @@ scale_color_cb_friendly <- function(palette = "main", discrete = TRUE, reverse = } #' use cb friendly colors as fill aesthetic with ggplot -#' +#' #' @param palette name of the palette to be returned #' @param discrete boolean, whether to make palette discretely divided into colors or continuous #' @param reverse boolean, reverse order of colors in palette #' @export scale_fill_cb_friendly <- function(palette = "main", discrete = TRUE, reverse = FALSE, ...) { pal <- cb_friendly_pal(palette = palette, reverse = reverse) - + if (discrete) { discrete_scale("fill", paste0("cb_friendly_", palette), palette = pal, ...) } else { scale_fill_gradientn(colours = pal(256), ...) } -} \ No newline at end of file +} diff --git a/inst/rmarkdown/templates/rnaseq/skeleton/DE/DEG.Rmd b/inst/rmarkdown/templates/rnaseq/skeleton/DE/DEG.Rmd index 83ef510..f390ad4 100644 --- a/inst/rmarkdown/templates/rnaseq/skeleton/DE/DEG.Rmd +++ b/inst/rmarkdown/templates/rnaseq/skeleton/DE/DEG.Rmd @@ -20,7 +20,7 @@ params: numerator: tumor denominator: normal subset_value: NA - ruv: false + ruv: true params_file: params_de.R project_file: ../information.R --- @@ -45,7 +45,9 @@ library(knitr) library(EnhancedVolcano) library(bcbioR) library(ggprism) - +library(viridis) +library(pheatmap) +colors=cb_friendly_cols(1:15) ggplot2::theme_set(theme_prism(base_size = 14)) opts_chunk[["set"]]( cache = F, @@ -156,13 +158,15 @@ degCovariates( ```{r before_RUV} pca1 <- degPCA(norm_matrix, colData(dds_to_use), - condition = column) + ggtitle('Before RUV') + condition = column) + ggtitle('PCA') pca1 + scale_color_cb_friendly() ``` ```{r init_DESEQ} formula <- as.formula(paste0("~ ", " + ", column)) +## Check if sample name matches +stopifnot(all(names(counts) == rownames(coldata))) dds_to_use <- DESeqDataSetFromMatrix(counts, coldata, design = formula) @@ -170,17 +174,18 @@ vsd_before <- vst(dds_to_use) norm_matrix = assay(vsd_before) ``` -```{eval=params$ruv, results='asis'} -# Remove Unwanted Variability +```{r, eval=params$ruv, results='asis', echo=FALSE} +cat("# Remove Unwanted Variability -When performing differential expression analysis, it is important to ensure that any detected differences are truly a result of the experimental comparison being made and not any additional variability in the data. +When performing differential expression analysis, it is important to ensure that any detected differences are truly a result of the experimental comparison being made and not any additional variability in the data.") ``` ```{r do_RUV, eval=params$ruv} # If you want to skip the code, just set up formula to be your model in the next chunk of code +design <- coldata[[column]] diffs <- makeGroups(design) -dat <- assay(vsd_before) +dat <- norm_matrix ruvset <- RUVs(dat, cIdx=rownames(dat), k=1, diffs, isLog = T, round = F) vars <- ruvset$W @@ -200,8 +205,6 @@ pca2 + scale_color_cb_friendly() ``` ```{r after_RUV, eval=params$ruv} -## Check if sample name matches -stopifnot(all(names(counts) == rownames(new_cdata))) dds_to_use <- DESeqDataSetFromMatrix(counts, new_cdata, design = formula) vsd_to_use<- vst(dds_to_use, blind=FALSE) @@ -244,11 +247,15 @@ show <- as.data.frame(res_mod[1:10, c("lfc", "padj", "gene_name")]) degMA(as.DEGSet(resLFC)) + ggtitle('Before LFC Shrinking') ``` +## MA plot + ```{r after_lfc_shrink} degMA(as.DEGSet(resLFCS), limit = 2) + ggtitle('After LFC Shrinking') ``` +## Volcano plot + This volcano plot shows the genes that are significantly up- and down-regulated as a result of the analysis comparison. The points highlighted in red are genes that have padj < 0.05 and a log2-fold change > 1. Points in blue have a padj < 0.05 and a log2-fold change < 1 and points in green have a padj > 0.05 and a log2-fold change > 2. Grey points are non-significant. The dashed lines correspond to the cutoff values of log2 foldchance and padj that we have chosen. ```{r volcano_plot, fig.height=6} @@ -260,12 +267,41 @@ EnhancedVolcano(res_mod, FCcutoff = 0.5, x = 'lfc', y = 'padj', - title="Volcano Tumor vs. Normal", - subtitle = "", xlim=c(-5,5)) + scale_color_cb_friendly() + title="Volcano Tumor vs. Normal", + col=as.vector(colors[c("dark_grey", "light_blue", + "purple", "purple")]), + subtitle = "", xlim=c(-5,5)) + +``` +## Heatmap + +```{r heapmap} +### Run pheatmap using the metadata data frame for the annotation +ma=norm_matrix[res_sig$gene_id,] +colma=coldata[,c("sample_type"), drop=FALSE] +colors=lapply(colnames(colma), function(c){ + l.col=colors[1:length(unique(colma[[c]]))] + names(l.col)=unique(colma[[c]]) + l.col +}) +names(colors)=colnames(colma) +pheatmap(ma, + color = inferno(10), + cluster_rows = T, + show_rownames = F, + annotation = colma, + annotation_colors = colors, + border_color = NA, + fontsize = 10, + scale = "row", + fontsize_row = 10, + height = 20) ``` + ## Differentially Expressed Genes + ```{r sig_genes_table} res_sig %>% sanitize_datatable ```