Skip to content

Commit

Permalink
update colors
Browse files Browse the repository at this point in the history
  • Loading branch information
@lpantano
lpantano committed Apr 29, 2024
1 parent 4251e6e commit 86a36cf
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 28 deletions.
34 changes: 17 additions & 17 deletions R/cb_friendly.R
View file
Original file line number Diff line number Diff line change
@@ -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",
Expand All @@ -29,28 +29,28 @@ 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"),
`heatmap` = cb_friendly_cols("blue", "white", "brown")
)

#' 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
Expand All @@ -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 {
Expand All @@ -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), ...)
}
}
}
58 changes: 47 additions & 11 deletions inst/rmarkdown/templates/rnaseq/skeleton/DE/DEG.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
---
Expand All @@ -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,
Expand Down Expand Up @@ -156,31 +158,34 @@ 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)
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
Expand All @@ -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)
Expand Down Expand Up @@ -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}
Expand All @@ -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
```
Expand Down

0 comments on commit 86a36cf

Please sign in to comment.