Multi-row x-axis with separator inside using ggplot

Viewed 95

How can I implement histogram with such complex x-axis?

enter image description here

First x-axis row is the week start, second - week end. Data for tests in csv: https://gofile.io/d/FrhLZh.

What I managed to

  hist_data %>%
   ggplot(aes(x = week, y = count)) + 
        geom_col(fill = "#5B879E", width = 0.9, size = 0.7) +
      
        labs(title = "", x = "", y = "") +
        
        theme_bw() + theme_minimal() + theme(legend.position="none")+ 
        theme(
          panel.grid.major.x = element_blank(),
          panel.grid.minor.x = element_blank(),
          
          panel.grid.major.y = element_blank(),
          panel.grid.minor.y = element_blank(),
          
          axis.text.y = element_blank(),
          
          axis.text.x = element_text(vjust = 0.5, size = 8, family = "Inter", colour = "#ffffff"),
          
          axis.line.x = element_blank(),
          axis.title.x = element_blank(),
          
          
          plot.background = element_rect(fill = "#3A464F"),
          plot.margin=unit(c(0,0.25,0.5,0), "cm"))+ 
          scale_x_discrete(expand=c(0,0), labels = format(as.Date(hist_data$week_start), "%d-%m"), position = "bottom") +
        scale_y_continuous() 

enter image description here

2 Answers

Thanks to teunbrand and his ggh4x package, solution:

   hist_data %>%
   
   ggplot(aes(x = week, y = count)) + 
        geom_col(fill = "#5B879E", width = 0.8, size = 0.7)+
   
  labs(title = "", x = "", y = "") +
        
        theme_bw() + theme_minimal() + theme(legend.position="none")+ 
        theme(
          panel.grid.major.x = element_blank(),
          panel.grid.minor.x = element_blank(),
          
          panel.grid.major.y = element_blank(),
          panel.grid.minor.y = element_blank(),
          
          axis.text.y = element_blank(),
          
          axis.text.x = element_text(vjust = 0.5, size = 8, lineheight = 0.8, family = "Inter", colour = "#ffffff"),
          
          axis.line.x = element_blank(),
          axis.title.x = element_blank(),
          
          ggh4x.axis.nestline.x = element_line(size = 0.5, colour = "#5B879E", lineend = "square"),
          
          plot.background = element_rect(fill = "#3A464F"),
          plot.margin=unit(c(1,0.5,1,0.5), "cm"))+ 
          scale_x_discrete(expand=c(0,0), 
                           labels = paste0(format(as.Date(sort(hist_data$week_start)), "%d.%m"), 
                                           "\n", "nonsense", "\n", 
                                           format(as.Date(sort(hist_data$week_end)), "%d.%m")), position = "bottom") +
        scale_y_continuous() +
  guides(x = guide_axis_nested(delim = "nonsense"))

enter image description here

You can add multiple layers of geom_text and geom_segment. Adjust the relative y positions of these layers using a scaling factor.

plotscale <- max(hist_data$count)/50

library(ggplot2)
ggplot(data = hist_data,
       aes(x = week_start + floor(week_end-week_start)/2, y = count)) + 
  geom_col(fill = "#5B879E", width = 4) +
  geom_text(aes(y = -6 * plotscale ,
                label = format(week_start, "%m-%d")),
            color = "#ffffff")+
  geom_segment(aes(x = week_start, xend = week_end,
                y = -10 * plotscale, yend = -10 * plotscale),
            color = "#5B879E", size = 1.5)+
  geom_text(aes(y = -14 * plotscale,
                label = format(week_end, "%m-%d")),
            color = "#ffffff")+
  theme_minimal() + 
  theme(
    panel.grid = element_blank(),
    axis.text = element_blank(),
    axis.title = element_blank(),
    plot.background = element_rect(fill = "#3A464F"))+
  scale_x_date(expand=c(0,0), date_breaks = "1 week",
               labels = NULL)

enter image description here

Consider using ggh4x package for more complex nested x axes.


Raw Data

hist_data <- read.table(text='"","week","count","week_start","week_end"
"1","1",21.5823972708382,2021-01-04,2021-01-10
"2","2",36.122556304552,2021-01-11,2021-01-17
"3","3",34.2809483156697,2021-01-18,2021-01-24
"4","4",25.8546925450454,2021-01-25,2021-01-31
"5","5",29.0309819292706,2021-02-01,2021-02-07
"6","6",33.1503608888827,2021-02-08,2021-02-14
"7","7",27.0490347440184,2021-02-15,2021-02-21
"8","8",30.3031289757874,2021-02-22,2021-02-28
"9","50",32.2876434072602,2020-12-07,2020-12-13
"10","51",33.1939593686481,2020-12-14,2020-12-20
"11","52",26.6853246329896,2020-12-21,2020-12-27
"12","53",23.0715199391151,2020-12-28,2021-01-03', header = TRUE, sep = ",")

hist_data$week_start <- as.Date(hist_data$week_start)
hist_data$week_end <- as.Date(hist_data$week_end)
Related