Marking Specific Position on NumberLine Chart Graph

Question

I'm trying to plot something but unfourtanetely I couldn't find any tutorial or similar graph that I want. I tried on python and R such as binary timeline, chromomap or timeline graphs but none of them was the right one. Hope you can help me. The desired graph is like;

So, here I have 4 different length, and in this length I want to mark some specific positions.Let say I just want to mark it by using three different colours. For example:

if I detect a position range here let say for Length_1 I want to mark btw 3-7 and I wanna dye with white, I'll dye between 3-7 as white for Length_1. And maybe other positions with other colours. Same thing with different lenghth (Length_1,Length_2,Length_3,Length_4).

Data for plotting is look like:

Thank you.

Answer 1

This is updated answer.

Please, read how to prepare example dataset. Posting images instead of data isn't really helpful.

As I imagine your data, it must be something like this:

dat <- data.frame(
    x = c('K', 'M', 'L', 'N'),   
    y = c(400, 200, 80, 1000),
    m = c(
        '410:419, 200:209', 
        '171:180, 15:24, 39:48', 
        '18:27', 
        '484:493, 200:209, 803:812'
        )
    )  

With these data in hand, you need to apply some transformations. It is totally the matter of your personal taste how you do it. My approach is as follows:

dat <- dat |>
    mutate(m = strsplit(m, ',\\s*')) |>
    unnest(m) |>
    separate(m, c('ymin', 'ymax'), ':', , TRUE) |>
    mutate(
        h  = ymax - ymin,
        y2 = ymin + h / 2,
        ymin = NULL,
        ymax = NULL
    ) |>
    pivot_longer(c('y', 'y2')) |>
    mutate(
        x = factor(x, levels = sort(unique(x), TRUE)),
        h = ifelse(name == 'y', value, h),
        y = ifelse(name == 'y', value / 2, value),
        w = .95,
        f = ifelse(name == 'y', '#4472c4', heat.colors(100, .5)[cut(y + h / 2, 100)])
    ) |>
    select(x, y, h, w, f) |>
    distinct() |>
    arrange(x, desc(h))

Your data now, look like this:

dat

# # A tibble: 13 × 5
#    x         y     h     w f        
#    <fct> <dbl> <dbl> <dbl> <chr>    
# 1  N     500    1000  0.95 #4472c4  
# 2  N     488.      9  0.95 #FFA50080
# 3  N     204.      9  0.95 #FF3E0080
# 4  N     808.      9  0.95 #FFFF3880
# 5  M     100     200  0.95 #4472c4  
# 6  M     176.      9  0.95 #FF340080
# 7  M      19.5     9  0.95 #FF000080
# 8  M      43.5     9  0.95 #FF070080
# 9  L      40      80  0.95 #4472c4  
# 10 L      22.5     9  0.95 #FF000080
# 11 K     200     400  0.95 #4472c4  
# 12 K     414.      9  0.95 #FF8A0080
# 13 K     204.      9  0.95 #FF3E0080

Now, after data have been cleaned, it is easy to plot data using geom_tile():

dat |>
    ggplot(aes(x = x, y = y, height = h, width = w)) +
    geom_tile(fill = dat$f, show.legend = FALSE) +
    ggtitle('Stack question #6890748♡') +
    coord_flip() +
    theme_void() +
    theme(
        axis.text  = element_text(face = 'italic', size = 12, colour = 'gray50'),
        axis.line.x  = element_line(colour = 'gray10', size = .25),
        axis.ticks.x = element_line(colour = 'gray10', size = .25, ),
        axis.ticks.length.x = unit(2, 'points'),
        aspect.ratio = 7 / 16 
    )

Answer 2

An alternative approach using geom_rect

library(ggplot2)
library(dplyr)

df_bar <- data.frame(len = paste("Length", 1:4, sep = "_"),
                     xmin = 0,
                     xmax = c(1000, 200, 600, 800),
                     ymin = 1:4,
                     ymax = 1:4 + 0.9,
                     y_lab = 1:4 + 0.5)



df_pos <- data.frame(len = paste("Length", c(1, 1, 2, 3, 3, 4, 4), sep = "_"),
                     pos_col = c("w", "w", "r", "r", "g", "g", "w"),
                     pos_start = c(100, 300, 50, 150, 200, 300, 500),
                     pos_end = c(100, 300, 50, 150, 200, 300, 500) + sample(2:20, 7)) 

df_pos <- 
  df_pos %>% 
  left_join(select(df_bar, len, ymin, ymax))

ggplot(df_bar)+
  geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), fill = "blue")+
  geom_text(aes(x = xmin, y = y_lab, label = len), hjust = 1.2)+
  geom_rect(data = df_pos, aes(xmin = pos_start, xmax = pos_end, ymin = ymin, ymax = ymax, fill = pos_col))+
  scale_fill_manual(breaks = c("w", "r", "g"),
                    values = c("white", "red", "green"))+
  scale_x_continuous(expand = expansion(mult = c(0.15, 0.05)))+
  labs(x = NULL,
       y = NULL,
       fill = NULL)+
  theme(legend.position = "none",
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        panel.background = element_blank())

^{Created on 2021-08-24 by the reprex package (v2.0.0)}