Multi-level circular bar chart with hourly crime patterns

About

---

This tutorial presents an original data visualization developed by Morgan Attannon. I am a data scientist with an engineering background in applied mathematics and mathematical modelling. I use R and its visualization ecosystem to explore datasets and create clear, reproducible, and visually engaging graphics.

You can find more of my projects and source code on GitHub.

As a teaser, here is the plot we’re gonna try building:

knitr::include_graphics("/cloud/project/plot_21.png")

Libraries

---

We’re going to load the packages we need for our work, just a few tips to help us better structure our code. So we need the essentials:

1. Tidyverse, which needs no introduction;
2. janitor, which will be used to apply uniform formatting to all the column names in our database;
3. ggrepel, the ultimate package for automatic annotation without overlapping text;
4. ggnewscale, which I also discovered. It allows you to use different color scales on the same graph. More on that later!

library(tidyverse)
library(janitor)
library(ggrepel)
library(ggnewscale)

Dataset

---

The database used in this tutorial comes from the Los Angeles Police Department (LAPD) and covers the period from January 2020 to September 2023. It has already been processed and only the columns needed for this tutorial are available, to make it less voluminous.

#df <- read_csv("los_angeles_crime_data.csv") 
df <- read_csv("https://drive.google.com/uc?export=download&id=15GVDzPx6AMSUPZk5gBtg6ETNyRRD-aBR")

Basic circular bar chart with hours

---

First we’ll define a theme and also a set of colors to be used for the graphic.

 theme<-theme_minimal()+
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    panel.grid = element_blank(),
    plot.margin = unit(rep(-2,4), "cm"),
    legend.position = "none",
    plot.background = element_blank()
  )

bg = "#FDF6E3"
text_color = "#9C2949"
primary_color = "#6B0F1A"
bar_color = "#0C1821"
hour_class_color = c("#256EFF", "#FF2E00", "#BF6900", "#3E8914")

Let’s create a simple circular bar chart, adding watch elements such as hour markers and two hands pointing to the bars representing the two highest crime numbers.

df %>%
  count(hour_occ, sort = TRUE) %>%
  ggplot(aes(x=hour_occ,y=n))+
  geom_col()+
  geom_text(aes(x=hour_occ, y=-14000, label=hour_occ, hjust=0.5), color=primary_color, fontface="bold", size=2.5)+
  geom_point(aes(x=hour_occ, y=-7000),size=2)+
  labs(
    x=NULL,
    y=NULL
    )+
  ylim(-60000,70000)+
  coord_polar(start = -0.13)+
  theme+
  annotate("segment", x=13, xend=13, y=-27000, yend=-60000, linewidth=0.4, color= primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) +
  annotate("segment", x=19, xend=19, y=-27000, yend=-60000, linewidth=0.4, color=primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) 

The problem with this graph is that it doesn’t really look like a watch, at least not very much, and the bars representing 11 p.m.(23) and 00 a.m.(0) are stuck together. So how do you do it?

In fact, a watch is marked with hours and minutes. What we need to do is set up dots to represent hours separated by minutes. The problem is that our graph is represented over 24 hours instead of 12 for a normal watch. However, separating the hour dots from 4 minute dots wouldn’t be very aesthetic, so we’ll do it with two (what we call gap=3 in the following).

Especially as it would be impossible to do this with the current state of the database. You’re probably wondering why this is impossible. In fact, the x-axis of the current graph has 24 discrete (categorical) values, so increasing the number of points to gap*24=72 in the geom_point function would create a shifted graph that’s completely different from what we want the result to be. So we’re going to have to get crafty!

First circular level of the graph, with the watch.

---

Firstly, we’re going to reformat our database so as to obtain a hollow matrix, i.e. integrate two empty rows supposed to represent the minutes after each hour.

gap = 3
width = gap*2.75/3

Why this width expression? By replacing the gap value=3 in the expression, we get width=2.75. In fact, we want to represent 24 bars on an axis of 3*24=72 values. There will therefore be a lot of empty space between each bar. To avoid this, width must be proportional to the available space, which is 3, reduced by .25 to give a little space. We then took the liberty of making the expression compatible with any gap value.

Secondly, we’re going to create the value_data database, which, as you may have guessed, contains counts of the number of crimes committed over 24 hours.

value_data <- df %>%
  count(hour_occ, sort = TRUE) %>%
  mutate(
    id = as.factor(as.numeric(hour_occ)*gap)
  ) 

which we’ll then join with a 72-line empty_data database to obtain mixed_data.

empty_data <- data.frame(id=as.factor(seq(0, nrow(value_data)*gap-1)))

mixed_data <- left_join(empty_data, value_data, by = join_by(id)) 

We are now ready to plot the result.

mixed_data %>%
  slice(1:(gap*24-1)) %>%
  ggplot(aes(x=id, y=n))+
  geom_col(width=width)+
  geom_text(aes(x=id, y=-14000, label=hour_occ, hjust=0.5), color=primary_color, fontface="bold", size=1.75)+
  annotate("segment", x=37, xend=37, y=-27000, yend=-60000, linewidth=0.4, color= primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) +
  annotate("segment", x=55, xend=55, y=-27000, yend=-60000, linewidth=0.4, color=primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) +
  geom_point(aes(x=id, y=-7000))+
  geom_point(aes(x=0, y=-60000), color=primary_color, size=gap/1.5)+
  labs(
    x=NULL,
    y=NULL
    )+
  ylim(-60000,70000) +
  coord_polar(start = -0.13)+
  theme

Now that’s much better!

We’re now going to integrate:

• A color scale on the graph using the highlight variable, using a more accentuated color on the two largest bars.
• A different size for each point used to mark hours and minutes,
• An annotation of the representative number of each bar, but only for the two largest.
• colors representative of each hour class, which we’ll use later.

value_data <- df %>%
  count(hour_occ) %>%
  mutate(
    id = as.factor(as.numeric(hour_occ)*gap),
    highlight = if_else(hour_occ %in% c("12","18"), "1","0"),
    value = if_else(hour_occ %in% c("12","18"), format(n, big.mark = ","), NA)
  ) 

mixed_data <- 
  left_join(empty_data, value_data, by = join_by(id)) %>%
  mutate(
    size = if_else(is.na(hour_occ),gap/6,gap/3),
    angle = 5-(360 * (as.integer(id))/nrow(.)),
    angle = ifelse(angle <= -90 & angle > -270, angle+180, angle),
    hour_class = cut(as.numeric(id), breaks = c(-1,6,12,18,24)*gap, labels = c("00-06H", "06-12H", "12-18H", "18-00H"))
  )


plot<-mixed_data %>%
  slice(1:(gap*24-1)) %>%
  ggplot(aes(x=id, y=n))+
  geom_col(aes(fill=highlight), width=width)+
  geom_text(aes(x=id, y=-14000, label=hour_occ, hjust=0.5), color=primary_color, fontface="bold", size=1.75)+
  geom_text(aes(x=id, y=n+4000, label=value, hjust=0.5,), color=primary_color, alpha=1, size=1.75, angle=mixed_data$angle[1:71], fontface="bold")+
  annotate("segment", x=37, xend=37, y=-27000, yend=-60000, linewidth=0.4, color= primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) +
  annotate("segment", x=55, xend=55, y=-27000, yend=-60000, linewidth=0.4, color=primary_color, arrow = arrow(ends="first", type="closed", length = unit(0.15, "cm"))) +
  annotate("text", x=0, y=-30000, label="Hours", hjust=0.4, color=primary_color, fontface="bold", size=2) +
  geom_point(aes(x=0, y=-60000), color=primary_color, size=gap/1.5)+
  scale_fill_manual(values = c(alpha(bar_color,0.6), alpha(bar_color,1)))+
  geom_point(aes(x=id, y=-7000, color=hour_class), size=mixed_data$size[1:71])+
  labs(
    x=NULL,
    y=NULL
    )+
  ylim(-60000,70000) +
  theme+
  coord_polar(start = -0.13)


plot

You’ll notice that both annotations are subject to a certain angle. To find out more about how to determine the angle, you can read the tutorial (Circular barplot with groups) [https://r-graph-gallery.com/297-circular-barplot-with-groups.html] in the gallery.

Now that the first circular level of the graphic has been completed, we can move on to the second level, where another challenge awaits!

Second circular chart level

The second circular level of the graph represents the most frequent crimes over a period of time corresponding to the hour class we described earlier.

Let’s start by adding to our main graph, the bar graph of the frequency of occurrence of a crime over a class of time.

Note that our x-axis can only carry 24*gap=72 bars, so we can only represent 72/4=18 per hour class. But we’ll limit ourselves to the top 16 frequencies of occurrence for each hour class.

crm_by_hour_class <- df %>%
  count(hour_class, crm_cd) %>%
  group_by(hour_class) %>%
  mutate(percentage = n*100/sum(n), lim=sum(n)) %>%
  top_n(percentage,n=(24*gap/4)-2) %>%
  ungroup()%>%
  group_split(hour_class) %>%
  map_dfr(~ .x[1:(nrow(.x)+2),]) %>%
  mutate(id = mixed_data$id)

plot+
  geom_col(data = filter(crm_by_hour_class, !(id==71)), aes(x=id, y=percentage*2500), show.legend = FALSE, inherit.aes = FALSE, fill=primary_color)

Why y=percentage*2500? In fact, to represent the frequencies of values between 0 and 100, there’s a problem of scale: the bars are then invisible compared to those of the first circular level, which represents values 1000 times higher. But we can modify the scale of all the values so that the bars are visible, since we’re just trying to visualize the difference in frequency between the different crimes.

But as you can see, the main flaw in this graph is its legibility, due to the fact that all the bars in the second circular level start at x=0. Once again, we’re going to have to work out how to change the origin of the bars.

How do we do it? We’re going to use a stacked bar chart, then assign zero opacity to the first stacking level.

duplicated_data<-rbind(
  crm_by_hour_class %>% mutate(lab=1, percentage=2500*percentage),
  crm_by_hour_class %>% mutate(
    lab=0,
    percentage=if_else(is.na(percentage),percentage, lim*0.29))
  )

plot+
  geom_col(data = filter(duplicated_data, !(id==71)),aes(x=id, y=percentage, fill=as.factor(lab)), position = position_stack(reverse = TRUE), show.legend = FALSE, inherit.aes = FALSE)+
  ylim(-60000,150000) 

The second circular level retains the same fill scale defined for the first circular level. Fortunately, the new_scale_fill function allows us to adjust this.

plot+
  new_scale_fill()+
  geom_col(data = filter(duplicated_data, !(id==71)),aes(x=id, y=percentage, fill=as.factor(lab)), position = position_stack(reverse = TRUE), show.legend = FALSE, inherit.aes = FALSE)+
  scale_fill_manual(values = c(alpha("skyblue",0), alpha(primary_color,1)))+
  ylim(-60000,150000)

Final plot

---

top3_label_crm_by_class_hour <- df %>%
  count(hour_class, crm_cd) %>%
  group_by(hour_class) %>%
  mutate(per = n*100/sum(n), label=paste0(round(per),"%")) %>%
  top_n(per,n=3) %>%
  ungroup() %>%
  left_join(.,distinct(select(df,crm_cd,crm_cd_desc)), by=join_by(crm_cd)) %>%
  select(-c(n,per)) %>%
  mutate(
    hjust = c(rep("left",6),rep("right",6)),
    nudge_x = c(-1,-.5,-0.8,1,-1,2,rep(-.2,3),0.5,-1,2),
    crm_cd_desc = stringr::str_replace(crm_cd_desc, pattern = " ", replacement = "\n"),
    crm_cd_desc = stringr::str_remove(crm_cd_desc, pattern = "-")
  )

crm_by_hour_class <- crm_by_hour_class %>%
  left_join(top3_label_crm_by_class_hour, by=join_by(hour_class, crm_cd))

duplicated_data<-rbind(
  crm_by_hour_class %>% mutate(lab=1, percentage=2500*percentage),
  crm_by_hour_class %>% mutate(
    lab=0,
    percentage=if_else(is.na(percentage),percentage, lim*0.29))
  )



plot+
  ylim(-60000,150000)+
  scale_fill_manual(values = c(alpha(bar_color,0.6), alpha(bar_color,1)))+
  new_scale_fill()+
  geom_point(aes(x=id, y=-7000, color=hour_class), size=mixed_data$size[1:71])+
  geom_line(data = filter(crm_by_hour_class, !(id==71)), aes(x = as.numeric(id), y=lim*0.27, color=hour_class), linewidth=1.5)+
  scale_color_manual(values = hour_class_color)+
  new_scale_color()+
  #scale_fill_viridis_d(option = "B")+
  geom_col(data = filter(duplicated_data, !(id==71)),aes(x=id, y=percentage, fill=as.factor(lab)), position = position_stack(reverse = TRUE), show.legend = FALSE, inherit.aes = FALSE)+
  scale_fill_manual(values = c(alpha("skyblue",0), alpha(primary_color,1)))+
  geom_text_repel(
    data = filter(duplicated_data, !(id==71)),
    aes(y=percentage+lim*0.29, label = crm_cd_desc, color=as.factor(lab)),
    #family = "Poppins",
    seed=1234,
    fontface="bold",
    size = 1.75,
    hjust=filter(duplicated_data, !(id==71))$hjust,
    #vjust=1,
    min.segment.length = 0, 
    arrow = arrow(length = unit(0.002, "npc")),
    nudge_x = filter(duplicated_data, !(id==71))$nudge_x,
    #nudge_y = .5,
    na.rm = TRUE,
    direction = "y",
  )+
  scale_color_manual(values = c(alpha("black",0), alpha(primary_color,1)))