Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
258 lines (204 sloc) 7.61 KB
---
author: 'Giorgio Comai'
date: '2018-10-12'
params:
city: Granada
output:
html_document:
self_contained: true
---
---
title: `r params$city`
---
```{r message=FALSE, echo = FALSE, warning=FALSE}
if(!require("pacman")) install.packages("pacman")
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
# pacman::p_load("googlesheets") # to get the data from google docs
pacman::p_load("readxl") # to read xlsx file
pacman::p_load("ggrepel") # used for labeling
if (!require("gganimate")) devtools::install_github("thomasp85/gganimate")
library("gganimate") # get moving!
pacman::p_load("tidyverse") # all the goodies!
# If you want to change font
# pacman::p_load("extrafont")
# extrafont::loadfonts()
```
```{r message=FALSE}
# indicators
# https://docs.google.com/spreadsheets/d/1X5J3GbAKGL5DxwB0aUzAutslHgZ7XFazkVmfQyXhIqM/edit#gid=595233479
# Temperature per year and location
#https://docs.google.com/spreadsheets/d/1avuUJmVNljyb2uotHKDGgrG8T74O7CcwG15p0budkH8/edit?usp=sharing
dir.create(path =
file.path("data"),
showWarnings = FALSE)
temperatures_xlsx_location <-
file.path("data",
"temperatures.xlsx")
temperaturesMerged_csv_location <-
file.path("data",
"temperaturesMerged.csv")
if (!file.exists(temperaturesMerged_csv_location)) {
#gets each sheet of the excel file, and reads it separately
temperaturesL <- lapply(excel_sheets(temperatures_xlsx_location),
read_excel,
path = temperatures_xlsx_location)
names(temperaturesL) <- excel_sheets(temperatures_xlsx_location)
temperatures <- purrr::map_df(.x = temperaturesL,
.f = bind_cols,
.id = "City") %>%
select(-2)
write_csv(x = temperatures,
path = temperaturesMerged_csv_location)
} else {
temperatures <- read_csv(temperaturesMerged_csv_location)
}
cityTranslations <- read_csv(file = file.path("data", "cityTranslations.csv"))
```
```{r message=FALSE}
indicators <- read_csv(file = file.path("data",
"indicators.csv"))
tempCoord <- left_join(x = temperatures,
y = indicators %>%
select(City = city, lat, lon, size),
by = "City")
```
# Static graph
```{r staticOneCity}
i <- params$city
# get the title in English
cityNameEnglish <- cityTranslations$English[cityTranslations$Original==i]
oneCity <-
temperatures %>%
filter(City == i) %>%
mutate(century = str_extract(string = date,
pattern = "[[:digit:]][[:digit:]]")) %>%
group_by(century) %>%
mutate(AverageTempCentury = mean(temperature)) %>%
mutate(date = lubridate::year(date)) %>%
rename(Date = date)
oneCity <- oneCity %>%
mutate(TempDifference = max(oneCity$AverageTempCentury)-min(oneCity$AverageTempCentury))
staticOneCity <-
ggplot(data = oneCity,
mapping = aes(x = Date,
y = temperature,
colour = `temperature`,
AverageTempCentury)) +
geom_line(size = 1, color = "gray") +
geom_point() +
# 21st century horizontal line
geom_segment(aes(x = 1900,
y = unique(oneCity$AverageTempCentury)[1],
xend = 2000,
yend = unique(oneCity$AverageTempCentury)[1]),
colour = "#6f2c91",
linetype=2) +
geom_segment(aes(x = 2000,
y = unique(oneCity$AverageTempCentury)[1],
xend = 2017,
yend = unique(oneCity$AverageTempCentury)[1]),
colour = "#a6ce39",
linetype=1) +
# 20th century horizontal line
geom_segment(aes(x = 1900,
y = unique(oneCity$AverageTempCentury)[2],
xend = 2000,
yend = unique(oneCity$AverageTempCentury)[2]),
colour = "#a6ce39") +
geom_segment(aes(x = 2000,
y = unique(oneCity$AverageTempCentury)[2],
xend = 2017,
yend = unique(oneCity$AverageTempCentury)[2]),
colour = "#6f2c91",
linetype=2) +
# define colour of points
scale_color_viridis_c(option = "magma",
direction = -1,
guide = FALSE) +
# define breaks and labeling on scales
scale_x_continuous(name = "",
breaks = c(1900, 1925, 1950, 1975, 2000, 2017)) +
scale_y_continuous(name = "",
labels = function(x) scales::number(x = x, suffix = "°")) +
# basic styling and font
theme_minimal(base_family = "Carlito",
base_size = 16)+
# labels for horizontal lines
annotate(geom = "text",
x = 1915,
y = unique(oneCity$AverageTempCentury),
label = c("20th century average",
"21st century average"),
vjust = -1,
fontface = 2,
size = 4) +
labs(title = paste("Average temperature in", cityNameEnglish, "(1900-2017)"),
caption = "Source: EdjNet/ECMWF") +
theme(plot.caption=element_text(hjust = 0,
colour = "darkgray")) +
coord_cartesian(clip = 'off') +
# label final temperatures
geom_label_repel(data = oneCity %>%
distinct(century, .keep_all = TRUE) %>%
select(-Date),
mapping = aes(x = 2000,
y = AverageTempCentury,
label = scales::number(AverageTempCentury,
accuracy = 0.01,
suffix = "°")),
nudge_x = c(3, -3),
nudge_y = c(-1,3),
segment.size = 0.2,
colour = "black") +
# draw curved line
geom_curve(aes(x = 2000,
y = unique(oneCity$AverageTempCentury)[1],
xend = 2017,
yend = unique(oneCity$AverageTempCentury)[2]),
colour = "#6f2c91",
linetype=1,
curvature = 0.6,
arrow = arrow(length = unit(0.15, "inches"))) +
geom_label(data = oneCity %>%
distinct(TempDifference, .keep_all = TRUE),
mapping = aes(x = 2020,
y = mean(AverageTempCentury),
label = scales::number(TempDifference,
accuracy = 0.01,
suffix = "°")), colour = "black")
staticOneCity
dir.create(path = "png", showWarnings = FALSE)
ggsave(filename = file.path("png", paste0(i, ".png")))
```
# Animated graph
```{r}
animatedOneCity <- staticOneCity +
transition_reveal(id = City,
along = Date,
range = as.numeric(c(1900, 2080))) # to add pause at the last frame
```
```{r animatedOneCity}
dir.create("gif", showWarnings = FALSE)
animate(plot = animatedOneCity,
width = 800,
height = 600,
res = 120,
renderer =
gifski_renderer(file =
file.path("gif", paste0(i, ".gif"))))
```
```{r eval = TRUE}
# High quality video
pacman::p_load("av") # for video rendering
dir.create("mp4", showWarnings = FALSE)
# Render and show the video
df <- animate(animatedOneCity,
renderer =
av_renderer(file =
file.path("mp4", paste0(i, ".mp4"))),
width = 1920,
height = 1080,
res = 250,
fps = 25,
nframes = 300)
```