I'm trying to create a mirror bar graph like the example code below, which is very verbose and convoluted as I wanted horizontal bars showing the oldest months up top and in descending order and bars showing user1 first.

If possible more concise code would be good, but the main improvement would be aesthetic, in particular labels should be centered on the section showing the difference (they're currently centered only by one axis) and showing the duration as %H:%M only, even for periods longer than a day.

Original dataset durations are in minutes which I converted to hours dividing by 60.

Here a reprex with my current results.

set.seed(123)
library(tidyverse)
library(ggplot2)
library(zoo)
#> 
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#> 
#>     as.Date, as.Date.numeric
library(ggnewscale)
dat <- tibble(
  user = c("user1", "user1", "user1", "user2", "user2", "user2", "user1", "user1", "user1", "user2", "user2", "user2"),
  type = c("tv", "tv", "tv", "tv", "tv", "tv", "movie", "movie", "movie", "movie", "movie", "movie"),
  yearmonth = as.yearmon(rep_len(seq.Date(as.Date("2024-12-01"), as.Date("2025-02-01"), "month"), 12)),
  cumulative_minutes = sample(200:900, 12, replace = TRUE)
)

diff_dat <- dat |>
  pivot_wider(
    names_from = user,
    values_from = cumulative_minutes
  ) |>
  group_by(type, yearmonth) %>%
  mutate(
    diff = user1 - user2,
    max_y = max(user1, user2),
    min_y = min(user1, user2),
    pos_y = (max_y - min_y) / 2 + min_y,
    u1_higher = user1 > user2,
  )

ggplot() +
  scale_x_yearmon(breaks = dat$yearmonth, labels = rev(dat$yearmonth)) +
  geom_col(
    data = filter(diff_dat, type == "movie"),
    aes(x = rev(yearmonth), y = max_y / 60),
    fill = ifelse(filter(diff_dat, type == "movie")$u1_higher, "#C7E9C0", "#FCBBA1"),
  ) +
  geom_col(
    data = filter(dat, type == "movie"),
    aes(x = rev(yearmonth),y = cumulative_minutes / 60, group = rev(user), fill = user),
    position = "dodge",
  ) +
  geom_text(
    data = filter(diff_dat, type == "movie"),
    aes(x = rev(yearmonth), y = pos_y / 60, label = round(diff/60, digits = 1)),
    position = position_dodge(0.1),
    vjust = ifelse(filter(diff_dat, type == "movie")$u1_higher, +2, -2),
    size = 3,
  ) +
  scale_fill_brewer(palette = "Dark2", guide = guide_legend("Movies", order = 1)) +
  new_scale_fill() +
  geom_col(
    data = filter(diff_dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (max_y / 60)),
    fill = ifelse(filter(diff_dat, type == "tv")$u1_higher, "#C7E9C0", "#FCBBA1"),
  ) +
  geom_col(
    data = filter(dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (cumulative_minutes / 60), group = rev(user), fill = user),
    position = "dodge"
  ) +
  geom_text(
    data = filter(diff_dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (pos_y / 60), label = round(diff/60, digits = 1)),
    position = position_dodge(0.1),
    vjust = ifelse(filter(diff_dat, type == "tv")$u1_higher, +2, -2),
    size = 3,
  ) +
  scale_fill_brewer(palette = "Set1", guide = guide_legend("TV", order = 2)) +
  scale_y_continuous(labels = abs) +
  ylab("Hours") +
  xlab("Month") +
  theme_light() +
  coord_flip()
#> Warning: `position_dodge()` requires non-overlapping x intervals.
#> `position_dodge()` requires non-overlapping x intervals.

^{Created on 2025-02-18 with reprex v2.1.1}

Any suggestion?

I'm trying to create a mirror bar graph like the example code below, which is very verbose and convoluted as I wanted horizontal bars showing the oldest months up top and in descending order and bars showing user1 first.

If possible more concise code would be good, but the main improvement would be aesthetic, in particular labels should be centered on the section showing the difference (they're currently centered only by one axis) and showing the duration as %H:%M only, even for periods longer than a day.

Original dataset durations are in minutes which I converted to hours dividing by 60.

Here a reprex with my current results.

set.seed(123)
library(tidyverse)
library(ggplot2)
library(zoo)
#> 
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#> 
#>     as.Date, as.Date.numeric
library(ggnewscale)
dat <- tibble(
  user = c("user1", "user1", "user1", "user2", "user2", "user2", "user1", "user1", "user1", "user2", "user2", "user2"),
  type = c("tv", "tv", "tv", "tv", "tv", "tv", "movie", "movie", "movie", "movie", "movie", "movie"),
  yearmonth = as.yearmon(rep_len(seq.Date(as.Date("2024-12-01"), as.Date("2025-02-01"), "month"), 12)),
  cumulative_minutes = sample(200:900, 12, replace = TRUE)
)

diff_dat <- dat |>
  pivot_wider(
    names_from = user,
    values_from = cumulative_minutes
  ) |>
  group_by(type, yearmonth) %>%
  mutate(
    diff = user1 - user2,
    max_y = max(user1, user2),
    min_y = min(user1, user2),
    pos_y = (max_y - min_y) / 2 + min_y,
    u1_higher = user1 > user2,
  )

ggplot() +
  scale_x_yearmon(breaks = dat$yearmonth, labels = rev(dat$yearmonth)) +
  geom_col(
    data = filter(diff_dat, type == "movie"),
    aes(x = rev(yearmonth), y = max_y / 60),
    fill = ifelse(filter(diff_dat, type == "movie")$u1_higher, "#C7E9C0", "#FCBBA1"),
  ) +
  geom_col(
    data = filter(dat, type == "movie"),
    aes(x = rev(yearmonth),y = cumulative_minutes / 60, group = rev(user), fill = user),
    position = "dodge",
  ) +
  geom_text(
    data = filter(diff_dat, type == "movie"),
    aes(x = rev(yearmonth), y = pos_y / 60, label = round(diff/60, digits = 1)),
    position = position_dodge(0.1),
    vjust = ifelse(filter(diff_dat, type == "movie")$u1_higher, +2, -2),
    size = 3,
  ) +
  scale_fill_brewer(palette = "Dark2", guide = guide_legend("Movies", order = 1)) +
  new_scale_fill() +
  geom_col(
    data = filter(diff_dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (max_y / 60)),
    fill = ifelse(filter(diff_dat, type == "tv")$u1_higher, "#C7E9C0", "#FCBBA1"),
  ) +
  geom_col(
    data = filter(dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (cumulative_minutes / 60), group = rev(user), fill = user),
    position = "dodge"
  ) +
  geom_text(
    data = filter(diff_dat, type == "tv"),
    aes(x = rev(yearmonth), y = - (pos_y / 60), label = round(diff/60, digits = 1)),
    position = position_dodge(0.1),
    vjust = ifelse(filter(diff_dat, type == "tv")$u1_higher, +2, -2),
    size = 3,
  ) +
  scale_fill_brewer(palette = "Set1", guide = guide_legend("TV", order = 2)) +
  scale_y_continuous(labels = abs) +
  ylab("Hours") +
  xlab("Month") +
  theme_light() +
  coord_flip()
#> Warning: `position_dodge()` requires non-overlapping x intervals.
#> `position_dodge()` requires non-overlapping x intervals.

^{Created on 2025-02-18 with reprex v2.1.1}

Any suggestion?

• r
• ggplot2
• time-series
• bar-chart

1 Answer 1

One option to achieve your desired result would be to shift the positions for the labels manually instead of relying on position_dodge. For the labels I use a small helper function to create the desired format:

library(tidyverse)
library(ggnewscale)

label_helper <- function(x) {
  sprintf("%s%02d:%02d", ifelse(x < 0, "-", ""), abs(x) %/% 60, abs(x) %% 60)
}


dw <- 1 / 12 * .9 / 2

ggplot() +
  scale_x_yearmon(breaks = dat$yearmonth, labels = rev(dat$yearmonth)) +
  geom_col(
    data = filter(diff_dat, type == "movie"),
    aes(
      x = rev(yearmonth), y = max_y / 60,
      fill = I(ifelse(diff > 0, "#C7E9C0", "#FCBBA1"))
    )
  ) +
  geom_col(
    data = filter(dat, type == "movie"),
    aes(
      x = rev(yearmonth), y = cumulative_minutes / 60, group = rev(user),
      fill = user
    ),
    position = "dodge"
  ) +
  geom_text(
    data = filter(diff_dat, type == "movie"),
    aes(
      x = as.numeric(rev(yearmonth)) + dw / 2 * ifelse(diff > 0, -1, 1),
      y = pos_y / 60,
      label = label_helper(diff),
    ),
    size = 3,
  ) +
  scale_fill_brewer(
    palette = "Dark2",
    guide = guide_legend("Movies", order = 1)
  ) +
  new_scale_fill() +
  geom_col(
    data = filter(diff_dat, type == "tv"),
    aes(
      x = rev(yearmonth), y = -(max_y / 60),
      fill = I(ifelse(diff > 0, "#C7E9C0", "#FCBBA1"))
    )
  ) +
  geom_col(
    data = filter(dat, type == "tv"),
    aes(
      x = rev(yearmonth), y = -(cumulative_minutes / 60),
      group = rev(user), fill = user
    ),
    position = "dodge"
  ) +
  geom_text(
    data = filter(diff_dat, type == "tv"),
    aes(
      x = as.numeric(rev(yearmonth)) + dw / 2 * ifelse(diff > 0, -1, 1),
      y = -(pos_y / 60),
      label = label_helper(diff)
    ),
    size = 3,
  ) +
  scale_fill_brewer(
    palette = "Set1",
    guide = guide_legend("TV", order = 2)
  ) +
  scale_y_continuous(labels = abs) +
  ylab("Hours") +
  xlab("Month") +
  theme_light() +
  coord_flip()