3

I'm working on the facet plot below; however, I have two main issues:

  1. I can't properly set independent space values for the between chr* and the between G* facets e. g. I wish to set 0.1 for the former and 0 for the latter

  2. I can't break the plot in two columns according to the outmost nesting level in this case chr*; that is, I want to have two columns of 11 chromosomes the first one 1-11, the second one 12-22

test


Point 1

I tested a few options for the panel.spacing.y=unit(0.1, "lines") both specifying each individual gap as a list or using rep() to replicate sets of (0, 0, 0, 0.1) assuming the spacing in the nesting structure starts from the innermost level.

Point 2

I have no clear idea how to address it... other than changing ncol=1 to ncol=2 which, however, splits the plot according to the innermost nesting level (G*) that is not what I need. Maybe I should change to facet_nested only?


This is the code I'm using to produce the image above

library(elementalist)
library(paletteer)
library(ggplot2)
library(ggh4x)

###this is just a function to shade colors, I used it to make the legend background semitransparent
t_col <- function(color, percent = 50, name = NULL) {
  #      color = color name
  #      percent = % transparency
  #      name = an optional name for the color
  
  ## Get RGB values for named color
  rgb.val <- col2rgb(color)
  
  ## Make new color using input color as base and alpha set by transparency
  t.col <- rgb(rgb.val[1], rgb.val[2], rgb.val[3],
               max = 255,
               alpha = (100 - percent) * 255 / 100,
               names = name)
  
  ## Save the color
  invisible(t.col)
}
legend_fill <- t_col("white", perc=25, name="lt.fill")

m2 <- ggplot() + geom_line(data=stacked_model2_gen, aes(x=`M-pattern`, y=values, group=interaction(id, hap), color=hap, linetype=hap)) + theme_bw() + 
  facet_nested_wrap(~chr + gen, ncol=1, strip.position="left") +
  scale_color_paletteer_d("ggsci::alternating_igv") +
  guides(color=guide_legend(title='haplotype', 
                            title.position='top', 
                            title.hjust=.5, ncol=2, 
                            keywidth=1, position='inside'),
         linetype=guide_legend(title='haplotype',
                               title.position='top',
                               title.hjust=.5, ncol=2,
                               keywidth=1, position='inside')) +
  theme(legend.box.background=element_rect_round(color="black", fill=legend_fill, linetype="solid", radius=unit(1,"mm")),
        legend.background=element_rect(fill="transparent"),
        legend.title=element_text(face='italic', size=8), 
        legend.position.inside=c(0.945,0.8375),
        legend.text=element_text(size=6),
        legend.key.size=unit(0.1,"line"),
        panel.spacing.y=unit(0.1, "lines"),
        axis.title.x=element_text(size=8),
        axis.text=element_text(size=4),
        axis.title.y=element_blank()
  )
m2

and a dput() using one individual and mock values since the actual df is huge

stacked_model2_gen <- structure(list(`M-pattern` = c("M0", "M1", "M10", "M0", "M1", 
"M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", 
"M0", "M1", "M10", "M0", "M1", "M11", "M0", "M1", "M11", "M0", 
"M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", 
"M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", 
"M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", 
"M1", "M11", "M0", "M1", "M11", "M0", "M1", "M11", "M0", "M1", 
"M11", "M0", "M1", "M11", "M0", "M1", "M11", "M0", "M1", "M11", 
"M0", "M1", "M11", "M0", "M1", "M14", "M0", "M1", "M14", "M0", 
"M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", 
"M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", "M11", 
"M0", "M1", "M11", "M0", "M1", "M10", "M0", "M1", "M10", "M0", 
"M1", "M10", "M0", "M1", "M10", "M0", "M1", "M10", "M0", "M1", 
"M10", "M0", "M1", "M10", "M0", "M1", "M10"), id = c(200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080, 200080, 200080, 200080, 200080, 200080, 
200080, 200080, 200080), hap = c("hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2", 
"hap1", "hap1", "hap1", "hap2", "hap2", "hap2", "hap1", "hap1", 
"hap1", "hap2", "hap2", "hap2", "hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2", 
"hap1", "hap1", "hap1", "hap2", "hap2", "hap2", "hap1", "hap1", 
"hap1", "hap2", "hap2", "hap2", "hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2", 
"hap1", "hap1", "hap1", "hap2", "hap2", "hap2", "hap1", "hap1", 
"hap1", "hap2", "hap2", "hap2", "hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2", 
"hap1", "hap1", "hap1", "hap2", "hap2", "hap2", "hap1", "hap1", 
"hap1", "hap2", "hap2", "hap2", "hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2", 
"hap1", "hap1", "hap1", "hap2", "hap2", "hap2", "hap1", "hap1", 
"hap1", "hap2", "hap2", "hap2", "hap1", "hap1", "hap1", "hap2", 
"hap2", "hap2", "hap1", "hap1", "hap1", "hap2", "hap2", "hap2"
), values = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 
15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 
47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 
63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 
95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 
109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 
122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132), gen = c("G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", 
"G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3", "G3"), 
chr = c("chr1", "chr1", "chr1", "chr1", "chr1", "chr1", "chr2", 
"chr2", "chr2", "chr2", "chr2", "chr2", "chr3", "chr3", "chr3", 
"chr3", "chr3", "chr3", "chr4", "chr4", "chr4", "chr4", "chr4", 
"chr4", "chr5", "chr5", "chr5", "chr5", "chr5", "chr6", "chr6", 
"chr6", "chr6", "chr6", "chr6", "chr6", "chr7", "chr7", "chr7", 
"chr7", "chr7", "chr7", "chr8", "chr8", "chr8", "chr8", "chr8", 
"chr8", "chr9", "chr9", "chr9", "chr9", "chr9", "chr9", "chr10", 
"chr10", "chr10", "chr10", "chr10", "chr10", "chr11", "chr11", 
"chr11", "chr11", "chr11", "chr11", "chr12", "chr12", "chr12", 
"chr12", "chr12", "chr12", "chr13", "chr13", "chr13", "chr13", 
"chr13", "chr13", "chr14", "chr14", "chr14", "chr14", "chr14", 
"chr14", "chr15", "chr15", "chr15", "chr15", "chr15", "chr15", 
"chr16", "chr16", "chr16", "chr16", "chr16", "chr16", "chr17", 
"chr17", "chr17", "chr17", "chr17", "chr17", "chr18", "chr18", 
"chr18", "chr18", "chr18", "chr18", "chr19", "chr19", "chr19", 
"chr19", "chr19", "chr19", "chr20", "chr20", "chr20", "chr20", 
"chr20", "chr20", "chr21", "chr21", "chr21", "chr21", "chr21", 
"chr21", "chr22", "chr22", "chr22", "chr22", "chr22", "chr22"
)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-132L))
1
  • 1
    regarding the order of facets, you can use dir="v". Commented Aug 6 at 19:49

2 Answers 2

3

One option would be to create your columns as separate plots and merge them using patchwork. For the panel spacing you can use a vector to set the panel spacing:

Note: I modified your example data to include two categories of gens.

library(elementalist)
library(paletteer)
library(ggplot2)
library(ggh4x)
library(patchwork)

plot_fun <- function(.data) {
  ggplot() +
    geom_line(
      data = .data,
      aes(
        x = `M-pattern`, y = values,
        group = interaction(id, hap),
        color = hap, linetype = hap
      )
    ) +
    theme_bw() +
    facet_nested_wrap(~ chr + gen,
      ncol = 1,
      strip.position = "left"
    ) +
    theme(
      panel.spacing.y = unit(
        # 21 = 11 * 2 - 1
        # i.e. number of chr * number of gen - 1
        rep_len(c(0, 0.1), 21), "lines"
      )
    )
}

# Add a second gen
stacked_model2_gen$gen <- ifelse(
  stacked_model2_gen$hap == "hap1",
  "G2",
  "G3"
)

stacked_model2_gen_split <- stacked_model2_gen |>
  split(~ readr::parse_number(stacked_model2_gen$chr) > 11)

m2 <- lapply(stacked_model2_gen_split, plot_fun) |>
  wrap_plots(
    ncol = 2,
    guides = "collect",
    axes = "collect_x"
  ) &
  scale_color_paletteer_d("ggsci::alternating_igv") &
  guides(
    color = guide_legend(
      title = "haplotype",
      title.position = "top",
      title.hjust = .5, ncol = 2,
      keywidth = 1, position = "inside"
    ),
    linetype = guide_legend(
      title = "haplotype",
      title.position = "top",
      title.hjust = .5, ncol = 2,
      keywidth = 1, position = "inside"
    )
  ) &
  theme(
    legend.box.background = element_rect_round(color = "black", fill = legend_fill, linetype = "solid", radius = unit(1, "mm")),
    legend.background = element_rect(fill = "transparent"),
    legend.title = element_text(face = "italic", size = 8),
    legend.position.inside = c(0.945, 0.8375),
    legend.text = element_text(size = 6),
    legend.key.size = unit(0.1, "line"),
    axis.title.x = element_text(size = 8),
    axis.text = element_text(size = 4),
    axis.title.y = element_blank()
  ) &
  scale_y_continuous(
    limits = range(stacked_model2_gen$values)
  ) &
  scale_x_discrete(
    limits = unique(stacked_model2_gen$`M-pattern`)
  )

m2

enter image description here

Sign up to request clarification or add additional context in comments.

Comments

2

We can use dir = "v" in facet_nested_wrap() to order the plots vertically. And use a vector for spacing between facets.

library(elementalist)
library(paletteer)
library(ggplot2)
library(ggh4x)
library(dplyr)

set.seed(42)
n_chr <- 22
n_gen <- 2
n_hap <- 2
n_patterns <- 5
n_ids <- 3

stacked_model2_gen <- tidyr::expand_grid(
  chr = paste0("chr", 1:n_chr),
  gen = paste0("G", 2:(n_gen + 1)),
  hap = paste0("hap", 1:n_hap),
  id = sample(200000:299999, n_ids),
  `M-pattern` = paste0("M", c(0, 1, sample(10:20, n_patterns - 2)))
) %>%
  mutate(
    values = runif(n(), min = 1, max = 500)
  ) %>%
  distinct(chr, gen, hap, `M-pattern`, .keep_all = TRUE) %>%
  mutate(
    chr = factor(chr, levels = paste0("chr", 1:22))
  ) %>%
  arrange(chr, gen, hap, `M-pattern`)


t_col <- function(color, percent = 50, name = NULL) {
  rgb.val <- col2rgb(color)
  t.col <- rgb(rgb.val[1], rgb.val[2], rgb.val[3],
               max = 255,
               alpha = (100 - percent) * 255 / 100,
               names = name)
  invisible(t.col)
}
legend_fill <- t_col("white", perc=25, name="lt.fill")

n_col <- 2
spacing_vector <- rep(c(0, 0.1), length.out = (n_chr * n_gen) / n_col - 1)

ggplot() + 
  geom_line(data = stacked_model2_gen, 
            aes(x = `M-pattern`, y = values, 
                group = interaction(id, hap), 
                color = hap, linetype = hap)) + 
  theme_bw() + 
  facet_nested_wrap(~chr + gen, 
                    ncol = 2,
                    dir = "v",  
                    strip.position = "left") +
  scale_color_paletteer_d("ggsci::alternating_igv") +
  guides(color = guide_legend(title = 'haplotype', 
                              title.position = 'top', 
                              title.hjust = .5, ncol = n_col, 
                              keywidth = 1, position = 'inside'),
         linetype = guide_legend(title = 'haplotype',
                                 title.position = 'top',
                                 title.hjust = .5, ncol = 2,
                                 keywidth = 1, position = 'inside')) +
  theme(panel.spacing.y = unit(spacing_vector, "lines"), 
    panel.spacing.x = unit(0.2, "lines"), 
    strip.text.x.top = element_text(size = 7, 
                                    margin = margin(2, 1, 2, 1)),
    strip.text.x.bottom = element_text(size = 6, margin = margin(0, 0, 0, 0)),
    strip.placement = "outside",
    plot.margin = margin(5, 10, 5, 5),
    panel.border = element_rect(color = "grey80", fill = NA, size = 0.3),
    legend.box.background = element_rect_round(color = "black", 
                                               fill = legend_fill, 
                                               linetype = "solid", 
                                               radius = unit(1,"mm")),
    legend.background = element_rect(fill = "transparent"),
    legend.title = element_text(face = 'italic', size = 8), 
    legend.position.inside = c(0.925, 0.825),
    legend.text = element_text(size = 6),
    legend.key.size = unit(0.1, "line"),
    axis.title.x = element_text(size = 8, margin = margin(5, 0, 0, 0)),
    axis.text = element_text(size = 4),
    strip.text = element_text(size = 7),
    axis.title.y = element_blank()
  )

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.