1. NanoMethViz
  2. R
  3. plot_heatmap.R
Browse code

Refactored code

Shians authored on 12/12/2023 00:55:52
Showing 1 changed files
R/plot_heatmap.R
History View file @ a14b05a
... ... 
@@ -44,7 +44,9 @@ plot_methy_data_heatmap <- function(
44 44 
                 axis.text.x = ggplot2::element_blank(),
45 45 
                 axis.ticks.y = ggplot2::element_blank(),
46 46 
                 axis.title.y = ggplot2::element_blank(),
47 
-                axis.text.y = ggplot2::element_blank()
47 
+                axis.text.y = ggplot2::element_blank(),
48 
+                panel.grid.minor = ggplot2::element_blank(),
49 
+                panel.grid.major = ggplot2::element_blank()
48 50 
             ) +
49 51 
             ggplot2::xlab("Site")
50 52 
     } else if (pos_style == "to_scale") {
Browse code

Fixed compact format heatmap

Shians authored on 14/07/2023 07:02:15
Showing 1 changed files
R/plot_heatmap.R
History View file @ b667984
... ... 
@@ -13,7 +13,6 @@ plot_methy_data_heatmap <- function(
13 13 
         x
14 14 
     }
15 15
16 
-
17 16 
     methy_data <- methy_data %>%
18 17 
         dplyr::nest_by(group = .data[[group_col]], read_group = .data$read_group) %>%
19 18 
         dplyr::group_by(.data$group) %>%
... ... 
@@ -42,7 +41,10 @@ plot_methy_data_heatmap <- function(
42 41 
             heatmap_fill_scale +
43 42 
             ggplot2::theme(
44 43 
                 axis.ticks.x = ggplot2::element_blank(),
45 
-                axis.text.x = ggplot2::element_blank()
44 
+                axis.text.x = ggplot2::element_blank(),
45 
+                axis.ticks.y = ggplot2::element_blank(),
46 
+                axis.title.y = ggplot2::element_blank(),
47 
+                axis.text.y = ggplot2::element_blank()
46 48 
             ) +
47 49 
             ggplot2::xlab("Site")
48 50 
     } else if (pos_style == "to_scale") {
... ... 
@@ -58,14 +60,14 @@ plot_methy_data_heatmap <- function(
58 60 
                 height = 0
59 61 
             ) +
60 62 
             ggplot2::geom_point(aes(x = .data$pos, col = .data$mod_prob), alpha = 1, shape = 15) +
63 
+            ggplot2::scale_x_continuous(
64 
+                labels = scales::label_number(scale_cut = scales::cut_si("b")),
65 
+                expand = ggplot2::expansion(0, 0)
66 
+            ) +
61 67 
             heatmap_col_scale +
68 
+            theme_methy_heatmap +
62 69 
             ggplot2::xlab("Position")
63 70 
     }
64 71
65 
-    p + ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
66 
-        ggplot2::scale_x_continuous(
67 
-            labels = scales::label_number(scale_cut = scales::cut_si("b")),
68 
-            expand = ggplot2::expansion(0, 0)
69 
-        ) +
70 
-        theme_methy_heatmap
72 
+    p + ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right")
71 73 
 }
Browse code

Fixed mod_scale not being applied

Shians authored on 13/07/2023 01:24:55
Showing 1 changed files
R/plot_heatmap.R
History View file @ d738644
... ... 
@@ -2,7 +2,8 @@ plot_methy_data_heatmap <- function(
2 2 
         methy_data,
3 3 
         pos_style,
4 4 
         subsample,
5 
-        group_col = "group"
5 
+        group_col = "group",
6 
+        mod_scale = c(0, 1)
6 7 
 ) {
7 8 
     # subsample reads down to a certain number of read groups
8 9 
     subsample_groups <- function(x, key, subsample) {
Browse code

Refactored internal plotting code

Shians authored on 12/07/2023 14:16:52
Showing 1 changed files
R/plot_heatmap.R
History View file @ 5950d85
... ... 
@@ -1,4 +1,4 @@
1 
-plot_heatmap_internal <- function(
1 
+plot_methy_data_heatmap <- function(
2 2 
         methy_data,
3 3 
         pos_style,
4 4 
         subsample,
... ... 
@@ -62,5 +62,9 @@ plot_heatmap_internal <- function(
62 62 
     }
63 63
64 64 
     p + ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
65 
+        ggplot2::scale_x_continuous(
66 
+            labels = scales::label_number(scale_cut = scales::cut_si("b")),
67 
+            expand = ggplot2::expansion(0, 0)
68 
+        ) +
65 69 
         theme_methy_heatmap
66 70 
 }
Browse code

Refactored code

Shians authored on 24/05/2023 03:22:08
Showing 1 changed files
R/plot_heatmap.R
History View file @ a75d521
... ... 
@@ -39,11 +39,9 @@ plot_heatmap_internal <- function(
39 39 
         ) +
40 40 
             ggplot2::geom_raster() +
41 41 
             heatmap_fill_scale +
42 
-            ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
43 
-            theme_methy_heatmap +
44 42 
             ggplot2::theme(
45 43 
                 axis.ticks.x = ggplot2::element_blank(),
46 
-                axis.text.x = ggplot2::element_blank(),
44 
+                axis.text.x = ggplot2::element_blank()
47 45 
             ) +
48 46 
             ggplot2::xlab("Site")
49 47 
     } else if (pos_style == "to_scale") {
... ... 
@@ -51,23 +49,18 @@ plot_heatmap_internal <- function(
51 49 
         # data will overlap
52 50 
         p <- ggplot2::ggplot(methy_data, aes(y = .data$read_group)) +
53 51 
             ggplot2::geom_errorbarh(
54 
-                ggplot2::aes(
55 
-                    xmin = .data$start,
56 
-                    xmax = .data$end
57 
-                ),
52 
+                ggplot2::aes(xmin = .data$start, xmax = .data$end),
58 53 
                 data = read_data,
59 54 
                 alpha = 1,
60 55 
                 color = "darkgray",
61 56 
                 linewidth = 0.8,
62 57 
                 height = 0
63 58 
             ) +
64 
-            ggplot2::geom_point(
65 
-                aes(x = .data$pos, col = .data$mod_prob), alpha = 1, shape = 15) +
59 
+            ggplot2::geom_point(aes(x = .data$pos, col = .data$mod_prob), alpha = 1, shape = 15) +
66 60 
             heatmap_col_scale +
67 
-            ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
68 
-            theme_methy_heatmap +
69 61 
             ggplot2::xlab("Position")
70 62 
     }
71 63
72 
-    p
64 
+    p + ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
65 
+        theme_methy_heatmap
73 66 
 }
Browse code

Refactored plot_heatmap

Shians authored on 23/05/2023 07:30:55
Showing 1 changed files
R/plot_heatmap.R
History View file @ 2b05bf8
... ... 
@@ -1,7 +1,5 @@
1 1 
 plot_heatmap_internal <- function(
2 2 
         methy_data,
3 
-        read_data,
4 
-        grouping_data,
5 3 
         pos_style,
6 4 
         subsample,
7 5 
         group_col = "group"
... ... 
@@ -14,13 +12,20 @@ plot_heatmap_internal <- function(
14 12 
         x
15 13 
     }
16 14
15 
+
17 16 
     methy_data <- methy_data %>%
18 17 
         dplyr::nest_by(group = .data[[group_col]], read_group = .data$read_group) %>%
19 
-        dplyr::group_by(.data[[group_col]]) %>%
18 
+        dplyr::group_by(.data$group) %>%
20 19 
         dplyr::group_modify(subsample_groups, subsample = subsample)
21 20 
     methy_data <- tidyr::unnest(methy_data, "data")
22 
-    read_data <- read_data %>%
23 
-        dplyr::filter(.data$read_name %in% methy_data$read_name)
21 
+
22 
+    read_data <- methy_data %>%
23 
+        dplyr::group_by(.data$read_name) %>%
24 
+        dplyr::summarise(start = min(.data$pos), end = max(.data$pos)) %>%
25 
+        dplyr::inner_join(
26 
+            dplyr::select(methy_data, "read_name", "read_group", "group"),
27 
+            by = "read_name"
28 
+        )
24 29
25 30 
     if (pos_style == "compact") {
26 31 
         # only plots sites with measured modification, evenly spaced
... ... 
@@ -50,15 +55,10 @@ plot_heatmap_internal <- function(
50 55 
                     xmin = .data$start,
51 56 
                     xmax = .data$end
52 57 
                 ),
53 
-                data = dplyr::left_join(
54 
-                    read_data,
55 
-                    grouping_data,
56 
-                    by = c("read_name", "start", "end", "group"),
57 
-                    multiple = "all"
58 
-                ),
58 
+                data = read_data,
59 59 
                 alpha = 1,
60 60 
                 color = "darkgray",
61 
-                linewidth = 1.2,
61 
+                linewidth = 0.8,
62 62 
                 height = 0
63 63 
             ) +
64 64 
             ggplot2::geom_point(
Browse code

Added group_col argument

Shians authored on 19/05/2023 01:21:41
Showing 1 changed files
R/plot_heatmap.R
History View file @ bf21e56
... ... 
@@ -1,4 +1,11 @@
1 
-plot_heatmap_internal <- function(methy_data, read_data, grouping_data, pos_style = "compact", subsample) {
1 
+plot_heatmap_internal <- function(
2 
+        methy_data,
3 
+        read_data,
4 
+        grouping_data,
5 
+        pos_style,
6 
+        subsample,
7 
+        group_col = "group"
8 
+) {
2 9 
     # subsample reads down to a certain number of read groups
3 10 
     subsample_groups <- function(x, key, subsample) {
4 11 
         if (nrow(x) > subsample) {
... ... 
@@ -8,8 +15,8 @@ plot_heatmap_internal <- function(methy_data, read_data, grouping_data, pos_styl
8 15 
     }
9 16
10 17 
     methy_data <- methy_data %>%
11 
-        dplyr::nest_by(group = .data$group, read_group = .data$read_group) %>%
12 
-        dplyr::group_by(.data$group) %>%
18 
+        dplyr::nest_by(group = .data[[group_col]], read_group = .data$read_group) %>%
19 
+        dplyr::group_by(.data[[group_col]]) %>%
13 20 
         dplyr::group_modify(subsample_groups, subsample = subsample)
14 21 
     methy_data <- tidyr::unnest(methy_data, "data")
15 22 
     read_data <- read_data %>%
Browse code

Refactored heatmap plot

Shians authored on 11/05/2023 06:09:31
Showing 1 changed files
R/plot_heatmap.R
History View file @ 9b0468f
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,66 @@
1 
+plot_heatmap_internal <- function(methy_data, read_data, grouping_data, pos_style = "compact", subsample) {
2 
+    # subsample reads down to a certain number of read groups
3 
+    subsample_groups <- function(x, key, subsample) {
4 
+        if (nrow(x) > subsample) {
5 
+            x <- dplyr::sample_n(x, subsample)
6 
+        }
7 
+        x
8 
+    }
9 
+
10 
+    methy_data <- methy_data %>%
11 
+        dplyr::nest_by(group = .data$group, read_group = .data$read_group) %>%
12 
+        dplyr::group_by(.data$group) %>%
13 
+        dplyr::group_modify(subsample_groups, subsample = subsample)
14 
+    methy_data <- tidyr::unnest(methy_data, "data")
15 
+    read_data <- read_data %>%
16 
+        dplyr::filter(.data$read_name %in% methy_data$read_name)
17 
+
18 
+    if (pos_style == "compact") {
19 
+        # only plots sites with measured modification, evenly spaced
20 
+        p <- ggplot2::ggplot(
21 
+            methy_data,
22 
+            aes(
23 
+                x = factor(.data$pos),
24 
+                y = .data$read_group,
25 
+                fill = .data$mod_prob
26 
+            )
27 
+        ) +
28 
+            ggplot2::geom_raster() +
29 
+            heatmap_fill_scale +
30 
+            ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
31 
+            theme_methy_heatmap +
32 
+            ggplot2::theme(
33 
+                axis.ticks.x = ggplot2::element_blank(),
34 
+                axis.text.x = ggplot2::element_blank(),
35 
+            ) +
36 
+            ggplot2::xlab("Site")
37 
+    } else if (pos_style == "to_scale") {
38 
+        # plots all sites in range, evenly spaced with square geoms
39 
+        # data will overlap
40 
+        p <- ggplot2::ggplot(methy_data, aes(y = .data$read_group)) +
41 
+            ggplot2::geom_errorbarh(
42 
+                ggplot2::aes(
43 
+                    xmin = .data$start,
44 
+                    xmax = .data$end
45 
+                ),
46 
+                data = dplyr::left_join(
47 
+                    read_data,
48 
+                    grouping_data,
49 
+                    by = c("read_name", "start", "end", "group"),
50 
+                    multiple = "all"
51 
+                ),
52 
+                alpha = 1,
53 
+                color = "darkgray",
54 
+                linewidth = 1.2,
55 
+                height = 0
56 
+            ) +
57 
+            ggplot2::geom_point(
58 
+                aes(x = .data$pos, col = .data$mod_prob), alpha = 1, shape = 15) +
59 
+            heatmap_col_scale +
60 
+            ggplot2::facet_wrap(~group, scales = "free_y", ncol = 1, strip.position = "right") +
61 
+            theme_methy_heatmap +
62 
+            ggplot2::xlab("Position")
63 
+    }
64 
+
65 
+    p
66 
+}