Heatmap

Visualising event occurrences within a period, using Heatmap.

R Code

 

# Libraries --------------------------------------------------------------------

library(tidyverse)
# Data --------------------------------------------------------------------

data <- read_csv2("data/road accidents in bulgaria for the period 01-01-2017 to 31-12-2017.csv")
weekdays <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")

data <-
gather(data, Monday:Sunday, key = "Day", value ="Accidents") %>%
mutate(Day = factor(Day, levels = weekdays )) %>%
mutate(Hour = factor(Hour, levels = min(Hour):max(Hour) ))
# Theme --------------------------------------------------------------------

plotTitle <- "Road accidents in Bulgaria during 2017"
plotSubTitle <- "only accidents with injuries shown - by day/hour"
plotCaption <- "Source: https://www.mvr.bg/dokkpbdp\n Inspired by: http://bl.ocks.org/nbremer/62cf60e116ae821c06602793d265eaf6"

familyPrimary <- "IBM Plex Serif Light"
familySecondary <- "IBM Plex Serif Text"

colorTextPrimary <- "#2a2a2a"
colorTextSecondary <- "#7a7a7a"

update_geom_defaults("text", list(family = familySecondary, size = 3, face = "bold", color = colorTextSecondary )) # update default geom text

theme_histogram <- function(){
theme(
aspect.ratio = 6/20,
text = element_text(family = familyPrimary),

plot.margin = unit(c(32, 64, 32, 64), "pt"),
plot.title = element_text(size = 16, color = colorTextPrimary, margin = unit(c(0, 0, 8, 0), "pt") ),
plot.subtitle = element_text(size = 12, color = colorTextSecondary, face = "italic", margin = unit(c(0, 0, 16, 0), "pt") ),
plot.caption = element_text(size = 8, color = colorTextSecondary, face = "italic", lineheight = 1.5, margin = unit(c(24, 0, 0, 0), "pt") ),

axis.ticks.y = element_blank(),
axis.ticks.x = element_line(color = "white"),

axis.ticks.length=unit(8, "pt"), 
axis.text.y = element_text(size = 10, family = familyPrimary, hjust = 0, color = colorTextPrimary, margin = unit(c(0, 8, 0, 0), "pt")),
axis.text.x = element_text(size = 8, family = familyPrimary, hjust = 0.5, color = colorTextPrimary ),

panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),

legend.position = "bottom",
legend.title = element_text(size = 8, family = familySecondary, face = "italic", color = colorTextSecondary, margin = unit(c(8, 0, 0, 0), "pt") ),
legend.text = element_text(size = 8, color = colorTextSecondary, margin = unit(c(4, 0, 0, 0), "pt") ),
legend.text.align = 0.5
)
}
# Plot --------------------------------------------------------------------

plot_histogram <- ggplot(data, aes(x = Hour, y = Day )) +
geom_tile(aes(fill = Accidents)) +
scale_fill_gradient( low = "#f1f1f1", high = "#1f1f1f", space = "Lab", aesthetics = "fill", breaks=c(min(data$Accidents), max(data$Accidents) ) ) +
scale_x_discrete(position = "top") +
scale_y_discrete(limits = rev(levels(data$Day))) +
guides(fill = guide_colorbar(title = "Number of accidents", title.position = "top", barwidth = 7, barheight = 0.5, ticks = FALSE), alpha = FALSE) +
labs(x = "", y = "", title = plotTitle, subtitle = plotSubTitle, caption = plotCaption) +
theme_histogram()

plot_histogram
# Export --------------------------------------------------------------------

#ggsave(plot_histogram, height = 9, width = 13, device = cairo_pdf, filename = paste("export/", plotTitle, ".pdf", sep = "") )
#ggsave(plot_histogram, height = 9, width = 13, dpi = "retina", filename = paste("export/", plotTitle, ".png", sep = "") )