The longest set of continuous daily meteorological records is from a station in the centre of Oxford. The position of the station is shown on the map and code to pull the data from NOA’s GHCND data base using the package rnoaa is provided.
library(tidyverse)
library(xts)
library(dygraphs)
library(lubridate)
get_noa<-function(id="UK000056225"){
require(reshape2)
require(rnoaa)
climate_data<-ghcnd(id)
meas<-paste("VALUE",1:31,sep="")
climate_data<-melt(climate_data,id=c("year","month","element"),m=meas)
climate_days<-as.numeric(gsub("VALUE","",climate_data$variable))
climate_year<-as.numeric(as.character(climate_data$year))
climate_month<-as.numeric(as.character(climate_data$month))
climate_data$date<-as.Date(sprintf("%04d-%02d-%02d",climate_year,climate_month,climate_days))
d<-data.frame(date=climate_data$date,element=climate_data$element,value=climate_data$value)
d<-na.omit(d)
d
}
ox<-get_noa()
The winter of 1947/48 was exceptional in length leading to the very marked overall drop, mainly due to the length of time that snow covered the ground. The minimum temperatures themselves were not exceptionally low. 1962 was famously cold. Change the rolling average in the bottom left corner to view the data using different time windows.
https://www.theguardian.com/uk/2010/jan/05/coldest-winters-britain-snow
ox %>% filter(element=="TMIN") ->tmin
dygraph(xts(tmin$value/10,tmin$date)) %>% dyRoller(rollPeriod = 365) %>% dyRangeSelector(dateWindow = c(dmy("1/1/1820"), dmy("31/12/2022")))
ox %>% filter(element=="TMAX") ->tmax
dygraph(xts(tmax$value/10,tmax$date)) %>% dyRoller(rollPeriod = 365) %>% dyRangeSelector(dateWindow = c(dmy("1/1/1820"), dmy("31/12/2020")))
ox %>% filter(element=="PRCP") ->prcp
dygraph(xts(prcp$value/10,prcp$date)) %>% dyRoller(rollPeriod = 365) %>% dyRangeSelector(dateWindow = c(dmy("1/1/1820"), dmy("31/12/2020")))
One way to extract short lived extremes of temperature and precipitation is to take a rolling (running) mean throughout the time series. The choice of window alters the results, but this is preferable to looking simply at weekly or monthly averages as it does not assume a fixed start or end date. A window of seven days is convenient, as it represents a week which has a meaningful interpretation. The most extreme weekly period for each year can then be extracted from the data. It is interesting to see which years has heat waves, cold snaps and floods. It is also interesting to look at the relationship between the overall mean for the year in which these extremes occur in the context of predicting whether an overall change in climate would lead to an increase in the values of the extreme event.
library(zoo)
tmin %>% dplyr::arrange(date) %>% mutate(weekly=rollmean(value, k=7,fill = NA)) %>%
mutate(year=year(date)) %>% group_by(year) %>%
summarise(mean=mean(value)/10, coldest=min(weekly)/10) %>%
filter(year>1840 & year<2020) ->cold_snaps
dd<-data.frame(year=cold_snaps$year, coldest=cold_snaps$coldest)
dygraph(dd)
cold_snaps %>% ggplot(aes(x=mean,y=coldest)) +geom_point() +geom_smooth(method="lm")
mod<-lm(data=cold_snaps,coldest~mean)
summary(mod)
##
## Call:
## lm(formula = coldest ~ mean, data = cold_snaps)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0265 -1.0092 0.2709 1.1563 5.5072
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -12.7736 1.1291 -11.313 <2e-16 ***
## mean 1.3642 0.1819 7.498 3e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.833 on 177 degrees of freedom
## Multiple R-squared: 0.2411, Adjusted R-squared: 0.2368
## F-statistic: 56.22 on 1 and 177 DF, p-value: 3.004e-12
d<-data.frame(year=cold_snaps$year,resid=residuals(mod))
ggplot(d,aes(x=year,y=resid)) +geom_point() +geom_smooth()
library(zoo)
tmax %>% dplyr::arrange(date) %>% mutate(weekly=rollmean(value, k=7,fill = NA)) %>%
mutate(year=year(date)) %>% group_by(year) %>% summarise(mean=mean(value)/10, warmest=max(weekly)/10) %>%
filter(year>1840 & year<2020)->heat_waves
dd<-data.frame(year=heat_waves$year, warmest=heat_waves$warmest)
dygraph(dd)
heat_waves %>% ggplot(aes(x=mean,y=warmest)) +geom_point() +geom_smooth(method="lm")
mod<-lm(data=heat_waves,warmest~mean)
summary(mod)
##
## Call:
## lm(formula = warmest ~ mean, data = heat_waves)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.468 -1.043 0.036 1.073 4.746
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.4066 2.1421 1.59 0.114
## mean 1.6391 0.1534 10.68 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.739 on 177 degrees of freedom
## Multiple R-squared: 0.3921, Adjusted R-squared: 0.3886
## F-statistic: 114.2 on 1 and 177 DF, p-value: < 2.2e-16
d<-data.frame(year=heat_waves$year,resid=residuals(mod))
ggplot(d,aes(x=year,y=resid)) +geom_point() +geom_smooth()
library(zoo)
prcp %>% dplyr::arrange(date) %>% mutate(weekly=rollmean(value, k=7,fill = NA)) %>%
mutate(year=year(date)) %>% group_by(year) %>% summarise(mean=mean(value)/10, wettest=max(weekly)/10) %>%
filter(year>1840 & year<2020)->floods
dd<-data.frame(year=floods$year, wettest=floods$wettest)
dygraph(dd)
floods %>% ggplot(aes(x=mean,y=wettest)) +geom_point() +geom_smooth(method="lm")
mod<-lm(data=floods,wettest~mean)
summary(mod)
##
## Call:
## lm(formula = wettest ~ mean, data = floods)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.2977 -1.3310 -0.4503 0.8993 7.7312
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.6143 0.8595 4.205 4.14e-05 ***
## mean 3.0558 0.4728 6.463 9.64e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.98 on 177 degrees of freedom
## Multiple R-squared: 0.1909, Adjusted R-squared: 0.1864
## F-statistic: 41.77 on 1 and 177 DF, p-value: 9.638e-10
d<-data.frame(year=floods$year,resid=residuals(mod))
ggplot(d,aes(x=year,y=resid)) +geom_point() +geom_smooth()
As droughts occur over a longer period than floods the time window is changed to represent 6 month (180 days)
library(zoo)
prcp %>% dplyr::arrange(date) %>% mutate(weekly=rollmean(value, k=180,fill = NA)) %>%
mutate(year=year(date)) %>% group_by(year) %>% summarise(mean=mean(value)/10, driest=min(weekly)/10) %>%
filter(year>1840 & year<2020)->droughts
dd<-data.frame(year=droughts$year, driest=droughts$driest)
dygraph(dd)
The plot in this case is against the mean annual temperature, rather than rainfall (which would automatically produce a strong correlation due to the time window used)
droughts %>% ggplot(aes(x=heat_waves$mean,y=droughts$driest)) +geom_point() +geom_smooth(method="lm")
It must be noted that this does not take into acccount the effect of temperature on evapotranspiration. Nevertheless it is interesting that droughts, as defined by rainfall in a 180 day period, are not statistically significantly related to yearly mean temperature.
mod<-lm(droughts$driest~heat_waves$mean)
summary(mod)
##
## Call:
## lm(formula = droughts$driest ~ heat_waves$mean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.62200 -0.18269 -0.03277 0.19644 0.53417
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.53727 0.32780 4.690 5.45e-06 ***
## heat_waves$mean -0.02457 0.02348 -1.047 0.297
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2661 on 177 degrees of freedom
## Multiple R-squared: 0.006152, Adjusted R-squared: 0.0005373
## F-statistic: 1.096 on 1 and 177 DF, p-value: 0.2966
Because the station is situated in an urban area there will be a “heat island” effect that may add to any warming trend. This could be compensated for by comparing records from nearby rural stations. This has not been done here and the crude data is provided without adjustment.