Initial commit

R/add.R

@@ -465,7 +465,6 @@ add_violin <- function(gg, dodge_width = NULL, saturation = 0.3, draw_quantiles
 #' @param group bla
 #' @param dodge_width bla
 #' @param linewidth bla
-#' @param preserve bla
 #' @param ... bla
 #' @export
 add_line <- function(gg, group, dodge_width = NULL, linewidth = 0.25, preserve = "total", ...) {
@@ -680,9 +679,12 @@ add_density_curve <- function(gg, bw = "nrd0", adjust = 1, kernel = "gaussian",
 #' Add heatmap
 #' @param gg bla
 #' @param scale bla
+#' @param rasterize bla
+#' @param rasterize_dpi bla
 #' @param ... bla
 #' @export
-add_heatmap <- function(gg, scale = c("none", "row", "column"), ...) {
+add_heatmap <- function(gg, scale = c("none", "row", "column"), rotate_labels = 90,
+                        rasterize = FALSE, rasterize_dpi = 300, ...) {
   mapping <- NULL
   scale <- match.arg(scale)
 
@@ -703,16 +705,16 @@ add_heatmap <- function(gg, scale = c("none", "row", "column"), ...) {
 
   gg <-
     gg %>%
-    adjust_x_axis(rotate_labels = 90) %>%
+    adjust_x_axis(rotate_labels = rotate_labels) %>%
     remove_x_axis_line() %>%
     remove_y_axis_line() +
-    ggplot2::coord_cartesian(expand = FALSE) +
-    ggplot2::geom_raster(mapping = mapping, ...)
+    ggplot2::coord_cartesian(expand = FALSE)
 
   if (scale %in% c("row", "column"))
     gg <- gg %>% adjust_colors(c("blue", "white", "red"), as_palette = TRUE)
 
-  gg
+  add_geom(gg, ggplot2::geom_raster(mapping = mapping, ...),
+           rasterize = rasterize, rasterize_dpi = rasterize_dpi)
 }
 
 #' Add plot title or caption

R/todo.R

@@ -1,10 +1,4 @@
 
-# "rasterize" option for add_heatmap()
-
-# re-think add_area() and add_line()
-
-# rename adjust_labels() to adjust_variable() ?
-
 # data set "de_analysis" for volcano plots
 
 # work on check_pipeline()
@@ -14,6 +8,8 @@
 
 # make hex sticker
 
+# rename adjust_labels() to adjust_variable() ? Not sure.
+
 # add easteregg: add_funkyness()
 
 ## BEYOND SCOPE:

data-raw/de_analysis.R

@@ -0,0 +1,60 @@
+## code to prepare `de_analysis` dataset goes here
+
+library(tidyverse)
+
+de_analysis <-
+  read_tsv("../../projects/2015_Bactrap_Chat_EAE_acute_v2/deseq2/results/statResult_Hip_vs_Hin.txt") %>%
+  mutate(negLog10Padj = -log10(padj)) %>%
+  mutate(
+    cand = "none",
+    cand = if_else(log2FoldChange > 1 & padj < 0.05, "up", cand),
+    cand = if_else(log2FoldChange < -1 & padj < 0.05, "down", cand)
+  )
+
+de_analysis %>%
+  tidyplot(log2FoldChange, negLog10Padj) %>%
+  add_points(color = "grey", alpha = 0.1) %>%
+  add_points(data = filter_rows(log2FoldChange > 1, padj < 0.05), color = "red", alpha = 0.1) %>%
+  add_points(data = filter_rows(log2FoldChange < -1, padj < 0.05), color = "blue",  alpha = 0.1)
+
+de_analysis %>%
+  tidyplot(log2FoldChange, negLog10Padj, color = negLog10Padj) %>%
+  add_points()
+
+de_analysis %>%
+  tidyplot(log2FoldChange, negLog10Padj, color = cand) %>%
+  add_points()
+
+# usethis::use_data(de_analysis, overwrite = TRUE)
+
+
+
+eae_analysis <-
+  readxl::read_xlsx("../../projects/2020_EAEanalyzer/BsnMUT_EAE_02.xlsx", sheet = "score") %>%
+  pivot_longer(cols = c(-day), names_to = "animal_id", values_to = "score") %>%
+  left_join(readxl::read_xlsx("../../projects/2020_EAEanalyzer/BsnMUT_EAE_02.xlsx", sheet = "metadata") %>%
+              mutate(animal_id = as.character(animal_id))) %>%
+  mutate(age = floor(lubridate::interval(start = date_birth, end = date_immunization) /
+                       lubridate::duration(num = 1, units = "weeks")))
+
+eae_analysis %>%
+  tidyplot(day, score, color = genotype) %>%
+  add_mean_line() %>%
+  add_mean_dot() %>%
+  add_error(width = 3)
+
+eae_analysis %>%
+  tidyplot(day, score, color = genotype) %>%
+  add_mean_line() %>%
+  add_error_ribbon()
+
+eae_analysis %>%
+  tidyplot(day, animal_id, color = score) %>%
+  add_heatmap(rotate_labels = 0) +
+  facet_grid(vars(genotype), scales = "free")
+
+eae_analysis %>%
+  tidyplot(day, animal_id, color = score) %>%
+  add_heatmap(rotate_labels = 0) %>%
+  split_plot(genotype)
+

data-raw/distributions.R

@@ -7,8 +7,8 @@ diff2 <- c(2.4,2.7,3.3,4.6)
 
 distributions <-
   tibble(
-    normal = c(6.5, 7.5, (7 + diff), (7 - diff)),
     bimodal = c((7 + diff2), (7 - diff2)),
+    normal = c(6.5, 7.5, (7 + diff), (7 - diff)),
     skewed = c(6,6.2,6.5,6.9,7.2,9,12.5,16)-1.8
   ) %>%
   pivot_longer(everything(), names_to = "name", values_to = "value") %>%
@@ -27,11 +27,6 @@ distributions %>%
   add_mean_bar(alpha = 0.3) %>%
   add_error()
 
-distributions %>%
-  tidyplot(x = group, y = value, color = group) %>%
-  add_mean_bar(alpha = 0.3) %>%
-  add_error()
-
 distributions %>%
   tidyplot(x = group, y = value, color = group) %>%
   add_box()
@@ -46,11 +41,8 @@ distributions %>%
   add_jitter(jitter_width = 0.2)
 
 distributions %>%
-  tidyplot(x = name, y = value) %>%
+  tidyplot(x = name, y = value, color = group) %>%
   add_violin() %>%
-  add_jitter(jitter_width = 0.2) %>%
-  add_mean_dash(color = "red") %>%
-  add_error(color = "red") %>%
-  add_reference_lines(y = c(7, 8.25, 5.75))
+  add_jitter(jitter_width = 0.2)
 
 usethis::use_data(distributions, overwrite = TRUE)

data-raw/testing.R

@@ -50,7 +50,7 @@ mapping <- ggplot2::aes(color = dose, fill = ggplot2::after_scale(apply_saturati
 
 ##
 # try to use after_scale to get lighter bars
-# not really possible.
+# not possible for bars with color = NA
 
 library(tidyverse)
 # this works
@@ -104,11 +104,16 @@ study %>%
   add_points()
 
 study %>%
-  tidyplot(group, score, color = dose) %>%
-  add_areastack_absolute(alpha = 0.1) %>%
+  tidyplot(group, score, color = dose, group = participant, dodge_width = 0) %>%
+  add_area(alpha = 0.1) %>%
   add_points()
 
+study %>%
+  tidyplot(group, score, color = dose) %>%
+  add_areastack_absolute(alpha = 0.1)
+
 # stat_count and stat_sum are ignoring categories with no data
+# this is fixed
 
 vars <- c("number_of_legs", "family")
 

vignettes/tidyplots.Rmd

@@ -276,6 +276,12 @@ gene_expression %>%
   adjust_labels(external_gene_name, sort_by = -dplyr::desc(direction)) %>%
   adjust_size(height = 90)
 
+gene_expression %>% 
+  tidyplot(x = sample, y = external_gene_name, color = expression) %>% 
+  add_heatmap(scale = "row", rasterize = TRUE, rasterize_dpi = 20) %>% 
+  adjust_labels(external_gene_name, sort_by = -dplyr::desc(direction)) %>%
+  adjust_size(height = 90)
+
 gene_expression %>% 
   tidyplot(x = sample, y = external_gene_name, color = expression) %>% 
   add_heatmap(scale = "column") %>% 
@@ -479,8 +485,8 @@ study %>%
 # solution: bring them to different x axis labels
 
 study %>% 
-  tidyplot(x = treatment, y = score, color = group, dodge_width = 0) %>% 
-  add_line(group = participant) %>% 
+  tidyplot(x = treatment, y = score, color = group) %>% 
+  add_line(group = participant, dodge_width = 0, color = "grey") %>% 
   add_mean_dash() %>% 
   add_error() %>% 
   add_points()
@@ -490,7 +496,7 @@ study %>%
   add_mean_bar(alpha = 0.3) %>%
   add_error() %>%
   add_points() %>%
-  add_line(group = participant, dodge_width = 0) %>%
+  add_line(group = participant, dodge_width = 0, color = "grey") %>%
   adjust_labels(treatment, sort_by = dose)
 
 # proportions