Mouse muscle stem cell: plot bulk data

Génome Québec Innovation Centre, McGill University, Montreal, Canada

Prepare analysis workflow

Set filepaths and parameters

knitr::opts_knit$set(root.dir = rprojroot::find_rstudio_root_file())
options(
  readr.show_progress = FALSE,
  digits = 2,
  scipen = 8,
  future.globals.maxSize = +Inf
)

library(tidyverse)
library(scran)
library(scater)
library(EnhancedVolcano)
theme_set(theme_bw())

data_dir <- "./data"
figures_dir <- file.path("./figures")

plot_volcano <- function(var_name, lfc_thresh, svalue_thresh, lfc, suffix, label = NULL) {
  p <- EnhancedVolcano(lfc,
    lab = lfc %>% pull(gene_name),
    x = paste0("lfc_", var_name),
    selectLab = label,
    y = paste0("svalue_", var_name),
    xlab = bquote(~ italic(Moderated) ~ Log[2] ~ FC),
    ylab = bquote(~ -Log[10] ~ italic(svalue)),
    col = c("grey30", "forestgreen", "red2", "royalblue"),
    pCutoff = svalue_thresh,
    FCcutoff = lfc_thresh,
    legendLabels = c(
      "NS",
      expression(Log[2] ~ FC),
      "s-value",
      expression(s - value ~ and ~ log[2] ~ FC)
    )
  )

  ggsave(file.path(figures_dir, paste0("volcano_bulk_", var_name, "_effect_", suffix, ".pdf")), p)
  return(p)
}

bulk_lfc <-
  read_tsv(file.path(data_dir, "preprocessed", "leg_trunk_moderated_lfc_1_svalue_05_marked.txt"))

Parsed with column specification:
cols(
  .default = col_double(),
  gene_name = col_character(),
  gene_id = col_character(),
  EAN_leg = col_character(),
  keep_niche_leg = col_logical(),
  keep_age_leg = col_logical(),
  keep_engraf_leg = col_logical(),
  EAN_trunk = col_character(),
  keep_niche_trunk = col_logical(),
  keep_age_trunk = col_logical(),
  keep_engraf_trunk = col_logical(),
  seqnames = col_character(),
  gene_biotype = col_character(),
  description = col_character(),
  ensembl_gene_id_version = col_character()
)
See spec(...) for full column specifications.

lfc_thresh <- 1
svalue_thresh <- .05
volcano_plots <-
  map(c("engraf_leg", "age_leg", "niche_leg", "engraf_trunk", "age_trunk", "niche_trunk"),
    plot_volcano,
    lfc_thresh = lfc_thresh,
    svalue_thresh = svalue_thresh,
    lfc = bulk_lfc,
    suffix = "labeled"
  )

Saving 7 x 7 in image

volcano_plots

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

volcano_plots_unlabeled <-
  map(c("engraf_leg", "age_leg", "niche_leg", "engraf_trunk", "age_trunk", "niche_trunk"),
    plot_volcano,
    lfc_thresh = lfc_thresh,
    svalue_thresh = svalue_thresh,
    lfc = bulk_lfc,
    suffix = "unlabeled",
    label = c("")
  )

Saving 7 x 7 in image

volcano_plots_unlabeled

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

p1 <- ggplot(bulk_lfc, aes(x = lfc_age_leg, y = lfc_niche_leg, color = lfc_engraf_leg)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  # coord_fixed(ratio = 1) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic()
p1

ggsave(file.path(figures_dir, "niche_vs_age_lfc_leg_labelled.pdf"), p1)

Saving 12 x 7.41 in image

p2 <- ggplot(bulk_lfc, aes(x = lfc_age_leg, y = lfc_niche_leg, color = lfc_engraf_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  # coord_fixed(ratio = 1) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic()
p2

ggsave(file.path(figures_dir, "niche_vs_age_lfc_leg_unlabeled.pdf"), p2)

Saving 12 x 7.41 in image

p3 <- ggplot(bulk_lfc %>% filter(abs(lfc_engraf_leg) < 2), aes(x = lfc_age_leg, y = lfc_niche_leg, color = lfc_engraf_leg)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic() +
  xlim(c(-5, 5)) +
  ylim(c(-6, 6))
p3

ggsave(file.path(figures_dir, "niche_vs_age_lfc_leg_labeled_inset_labeled.pdf"), p3)

Saving 12 x 7.41 in image

p4 <- ggplot(bulk_lfc %>% filter(abs(lfc_engraf_leg) < 2), aes(x = lfc_age_leg, y = lfc_niche_leg, color = lfc_engraf_leg)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic() +
  xlim(c(-5, 5)) +
  ylim(c(-6, 6))
p4

ggsave(file.path(figures_dir, "niche_vs_age_lfc_leg_labeled_inset_unlabeled.pdf"), p3)

Saving 12 x 7.41 in image

p1 <- ggplot(bulk_lfc, aes(x = lfc_age_trunk, y = lfc_niche_trunk, color = lfc_engraf_trunk)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  # coord_fixed(ratio = 1) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic()
p1

ggsave(file.path(figures_dir, "niche_vs_age_lfc_trunk_labelled.pdf"), p1)

Saving 12 x 7.41 in image

p2 <- ggplot(bulk_lfc, aes(x = lfc_age_trunk, y = lfc_niche_trunk, color = lfc_engraf_trunk)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  # coord_fixed(ratio = 1) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic()
p2

ggsave(file.path(figures_dir, "niche_vs_age_lfc_trunk_unlabeled.pdf"), p2)

Saving 12 x 7.41 in image

p3 <- ggplot(bulk_lfc %>% filter(abs(lfc_engraf_trunk) < 2), aes(x = lfc_age_trunk, y = lfc_niche_trunk, color = lfc_engraf_trunk)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic() +
  xlim(c(-5, 5)) +
  ylim(c(-6, 6))
p3

ggsave(file.path(figures_dir, "niche_vs_age_lfc_trunk_labeled_inset_labeled.pdf"), p3)

Saving 12 x 7.41 in image

p4 <- ggplot(bulk_lfc %>% filter(abs(lfc_engraf_trunk) < 2), aes(x = lfc_age_trunk, y = lfc_niche_trunk, color = lfc_engraf_trunk)) +
  geom_point(
    size = 0.5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1) +
  scale_colour_viridis_c(option = "C", direction = -1) +
  theme_classic() +
  xlim(c(-5, 5)) +
  ylim(c(-6, 6))
p4

ggsave(file.path(figures_dir, "niche_vs_age_lfc_trunk_labeled_inset_unlabeled.pdf"), p3)

Saving 12 x 7.41 in image

p5 <- ggplot(bulk_lfc, aes(x = lfc_age_trunk, y = lfc_age_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p5

ggsave(file.path(figures_dir, "trunk_vs_leg_age_lfc_labeled.pdf"), p5)

Saving 12 x 7.41 in image

p6 <- ggplot(bulk_lfc, aes(x = lfc_age_trunk, y = lfc_age_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p6

ggsave(file.path(figures_dir, "trunk_vs_leg_age_lfc_unlabeled.pdf"), p6)

Saving 12 x 7.41 in image

p7 <- ggplot(bulk_lfc, aes(x = lfc_niche_trunk, y = lfc_niche_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p7

ggsave(file.path(figures_dir, "trunk_vs_leg_niche_lfc_labeled.pdf"), p7)

Saving 12 x 7.41 in image

p8 <- ggplot(bulk_lfc, aes(x = lfc_niche_trunk, y = lfc_niche_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p8

ggsave(file.path(figures_dir, "trunk_vs_leg_niche_lfc_unlabeled.pdf"), p8)

Saving 12 x 7.41 in image

p9 <- ggplot(bulk_lfc, aes(x = lfc_engraf_trunk, y = lfc_engraf_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_text(aes(
    label = gene_name
  ),
  check_overlap = TRUE, nudge_y = -0.15, size = 3
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p9

ggsave(file.path(figures_dir, "trunk_vs_leg_engraf_lfc_labeled.pdf"), p9)

Saving 12 x 7.41 in image

p10 <- ggplot(bulk_lfc, aes(x = lfc_engraf_trunk, y = lfc_engraf_leg)) +
  geom_point(
    size = .5,
    alpha = 0.5
  ) +
  geom_smooth(alpha = 0.2, colour = "grey") +
  coord_fixed(ratio = 1)
p10

ggsave(file.path(figures_dir, "trunk_vs_leg_engraf_lfc_unlabeled.pdf"), p10)

Saving 12 x 7.41 in image

sessionInfo()

R version 4.0.2 (2020-06-22)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 18.04.5 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8   
 [6] LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] parallel  stats4    stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] EnhancedVolcano_1.6.0       ggrepel_0.8.2               scater_1.16.2               scran_1.16.0                SingleCellExperiment_1.10.1
 [6] SummarizedExperiment_1.18.2 DelayedArray_0.14.1         matrixStats_0.56.0          Biobase_2.48.0              GenomicRanges_1.40.0       
[11] GenomeInfoDb_1.24.2         IRanges_2.22.2              S4Vectors_0.26.1            BiocGenerics_0.34.0         forcats_0.5.0              
[16] stringr_1.4.0               dplyr_1.0.2                 purrr_0.3.4                 readr_1.3.1                 tidyr_1.1.2                
[21] tibble_3.0.3                ggplot2_3.3.2               tidyverse_1.3.0            

loaded via a namespace (and not attached):
 [1] nlme_3.1-149              bitops_1.0-6              fs_1.5.0                  lubridate_1.7.9           httr_1.4.2               
 [6] rprojroot_1.3-2           tools_4.0.2               backports_1.1.9           R6_2.4.1                  irlba_2.3.3              
[11] vipor_0.4.5               mgcv_1.8-33               DBI_1.1.0                 colorspace_1.4-1          withr_2.2.0              
[16] tidyselect_1.1.0          gridExtra_2.3             compiler_4.0.2            cli_2.0.2                 rvest_0.3.6              
[21] BiocNeighbors_1.6.0       xml2_1.3.2                labeling_0.3              scales_1.1.1              digest_0.6.25            
[26] XVector_0.28.0            pkgconfig_2.0.3           dbplyr_1.4.4              limma_3.44.3              rlang_0.4.7              
[31] readxl_1.3.1              rstudioapi_0.11           DelayedMatrixStats_1.10.1 farver_2.0.3              generics_0.0.2           
[36] jsonlite_1.7.1            BiocParallel_1.22.0       RCurl_1.98-1.2            magrittr_1.5              BiocSingular_1.4.0       
[41] GenomeInfoDbData_1.2.3    Matrix_1.2-18             Rcpp_1.0.5                ggbeeswarm_0.6.0          munsell_0.5.0            
[46] fansi_0.4.1               viridis_0.5.1             lifecycle_0.2.0           stringi_1.5.3             edgeR_3.30.3             
[51] zlibbioc_1.34.0           grid_4.0.2                blob_1.2.1                dqrng_0.2.1               crayon_1.3.4             
[56] lattice_0.20-41           splines_4.0.2             haven_2.3.1               hms_0.5.3                 locfit_1.5-9.4           
[61] knitr_1.29                pillar_1.4.6              igraph_1.2.5              reprex_0.3.0              glue_1.4.2               
[66] packrat_0.5.0             modelr_0.1.8              vctrs_0.3.4               cellranger_1.1.0          gtable_0.3.0             
[71] assertthat_0.2.1          xfun_0.17                 rsvd_1.0.3                broom_0.7.0               viridisLite_0.3.0        
[76] beeswarm_0.2.3            statmod_1.4.34            ellipsis_0.3.1