Weekly chart data analysis
Gregor Aisch
9/22/2020
R Markdown
Load some useful packages using needs
needs(tidyverse, directlabels, ggrepel)Let’s load yearly, seasonal and monthly averages for air temperature
## # A tibble: 2,373 x 4
## year time value measure
## <dbl> <chr> <dbl> <chr>
## 1 1881 Year 7.31 temperature
## 2 1882 Year 8.34 temperature
## 3 1883 Year 7.88 temperature
## 4 1884 Year 8.57 temperature
## 5 1885 Year 7.74 temperature
## 6 1886 Year 8.02 temperature
## 7 1887 Year 6.95 temperature
## 8 1888 Year 6.85 temperature
## 9 1889 Year 7.38 temperature
## 10 1890 Year 7.31 temperature
## # … with 2,363 more rowsLoad yearly, seasonal and monthly averages for precipitation
## # A tibble: 2,373 x 4
## year time value measure
## <dbl> <chr> <dbl> <chr>
## 1 1881 Year 694. precipitation
## 2 1882 Year 927. precipitation
## 3 1883 Year 687. precipitation
## 4 1884 Year 732. precipitation
## 5 1885 Year 718. precipitation
## 6 1886 Year 723. precipitation
## 7 1887 Year 602. precipitation
## 8 1888 Year 766. precipitation
## 9 1889 Year 751. precipitation
## 10 1890 Year 744. precipitation
## # … with 2,363 more rowscompute climate baseline (1961-1990)
temp.base <- temp %>%
filter(year>1960 & year <= 1990) %>%
group_by(time) %>%
summarise(base=mean(value))
temp.base## # A tibble: 17 x 2
## time base
## <chr> <dbl>
## 1 April 7.36
## 2 August 16.5
## 3 Autumn 8.79
## 4 December 0.824
## 5 February 0.388
## 6 January -0.499
## 7 July 16.9
## 8 June 15.4
## 9 March 3.50
## 10 May 12.1
## 11 November 4.04
## 12 October 9.02
## 13 September 13.3
## 14 Spring 7.66
## 15 Summer 16.3
## 16 Winter 0.243
## 17 Year 8.24precip.base <- precip %>%
filter(year>1960 & year <= 1990) %>%
group_by(time) %>%
summarise(base=mean(value))
precip.base## # A tibble: 17 x 2
## time base
## <chr> <dbl>
## 1 April 58.2
## 2 August 77.2
## 3 Autumn 183.
## 4 December 70.2
## 5 February 49.4
## 6 January 60.8
## 7 July 77.6
## 8 June 84.6
## 9 March 56.5
## 10 May 71.1
## 11 November 66.4
## 12 October 55.8
## 13 September 61.1
## 14 Spring 186.
## 15 Summer 239.
## 16 Winter 181.
## 17 Year 789.Join temperature and precipitation data, add baseline, compute anomalies.
out <- temp %>%
left_join(temp.base) %>%
bind_rows(left_join(precip, precip.base)) %>%
mutate(anomaly=ifelse(measure=='temperature',
value-base, # difference anomaly for temp.
(value-base)/base*100)) %>% # pct. anomaly for rain
select(year, time, measure, anomaly) %>%
pivot_wider(names_from=measure, values_from=anomaly)
out## # A tibble: 2,373 x 4
## year time temperature precipitation
## <dbl> <chr> <dbl> <dbl>
## 1 1881 Year -0.930 -12.1
## 2 1882 Year 0.0997 17.5
## 3 1883 Year -0.360 -12.9
## 4 1884 Year 0.330 -7.19
## 5 1885 Year -0.500 -8.94
## 6 1886 Year -0.220 -8.41
## 7 1887 Year -1.29 -23.7
## 8 1888 Year -1.39 -2.88
## 9 1889 Year -0.860 -4.77
## 10 1890 Year -0.930 -5.63
## # … with 2,363 more rowsSave the 2019 & 2020 data for our first plot.
out %>%
filter(year==2019 & !(time %in% c('Year','Spring','Summer','Winter','Autumn'))) %>%
write_csv('temp-precip-anomalies-2019.csv')
out %>%
filter(year==2020 & !(time %in% c('Year','Spring','Summer','Winter','Autumn'))) %>%
write_csv('temp-precip-anomalies-2020.csv')For the scatterplot custom line annotations we need to generate some markup:
colors <- tribble(#####1976b3
~time, ~color,
'Year', '#333333',
'Summer', '#308c00',
'June', '#308c00',
'July', '#308c00',
'August', '#308c00',
#~~~~~~~~~~~~~~~~~
'Winter', '#6ea2ff',
'December', '#6ea2ff',
'January', '#6ea2ff',
'February', '#6ea2ff',
#~~~~~~~~~~~~~~~~~
'Autumn', '#ac2125',
'September', '#ac2125',
'October', '#ac2125',
'November', '#ac2125',
#~~~~~~~~~~~~~~~~~
'Spring', '#fac10e',
'March', '#fac10e',
'April', '#fac10e',
'May', '#fac10e',
)
out %>%
filter(year==2020) %>%
filter(!(time %in% c('Year','Summer','Winter','Spring','Autumn'))) %>%
left_join(colors) %>%
transmute(x1=0,
y1=0,
x2=round(temperature,2),
y2=round(precipitation,2),
paste0('@color:',color),
'@width:2') %>%
format_csv(col_names = F) %>%
str_replace_all(',@', ' @')## Joining, by = "time"## [1] "0,0,3.98,-33.38 @color:#6ea2ff @width:2\n0,0,4.9,151.32 @color:#6ea2ff @width:2\n0,0,1.77,-9.99 @color:#fac10e @width:2\n0,0,2.99,-72.02 @color:#fac10e @width:2\n0,0,-0.22,-45.98 @color:#fac10e @width:2\n0,0,1.54,7.43 @color:#308c00 @width:2\n0,0,0.75,-33.22 @color:#308c00 @width:2\n0,0,3.44,10.75 @color:#308c00 @width:2\n"Time for some plotting
Plot all months for 2019
out %>%
filter(year==2019) %>%
filter(!(time %in% c('Summer','Winter','Spring','Autumn', 'Year'))) %>%
ggplot(aes(xend=temperature, yend=precipitation,color=time)) +
geom_hline(yintercept=0) +
geom_vline(xintercept=0) +
geom_segment(x=0,y=0, arrow = arrow(length = unit(7, 'points'))) +
geom_text(aes(temperature, precipitation, label=time)) +
theme_minimal()
Plot all months for 2020
out %>%
filter(year==2020) %>%
filter(!(time %in% c('Summer','Winter','Spring','Autumn', 'Year'))) %>%
ggplot(aes(xend=temperature, yend=precipitation,color=time)) +
geom_hline(yintercept=0) +
geom_vline(xintercept=0) +
geom_segment(x=0,y=0, arrow = arrow(length = unit(7, 'points'))) +
geom_text(aes(temperature, precipitation, label=time)) +
theme_minimal()
Plot all seasons for years since 2010
d <- out %>%
filter(year>=2010) %>%
filter(time %in% c('Summer','Winter','Spring','Autumn'))
d %>% write_csv('temp-precip-anomalies-2010-2020.csv')
d %>%
ggplot(aes(xend=temperature, yend=precipitation,color=time)) +
geom_hline(yintercept=0) +
geom_vline(xintercept=0) +
geom_segment(x=0,y=0, arrow = arrow(length = unit(7, 'points'))) +
geom_text(aes(temperature, precipitation, label=year)) +
theme_minimal()
Average seasons since 2000:
out %>%
filter(year>=2000) %>%
filter(time %in% c('Summer','Winter','Spring','Autumn')) %>%
group_by(time) %>%
summarise(temperature=mean(temperature), precipitation=mean(precipitation)) %>%
ggplot(aes(xend=temperature, yend=precipitation,color=time)) +
geom_hline(yintercept=0) +
geom_vline(xintercept=0) +
geom_text_repel(aes(temperature, precipitation, label=time)) +
theme_minimal() +
geom_segment(x=0,y=0, arrow = arrow(length = unit(7, 'points')))
Let’s look at where all the years since 1961 are in the plot (highlighting the most recent years):
