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 rows

Load 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 rows

compute 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.24
precip.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 rows

Save 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):