-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathREADME.Rmd
124 lines (88 loc) · 4.48 KB
/
README.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
---
title: "Glaser 2010"
author: "Kmicha71"
date: "6 8 2019"
output:
html_document:
keep_md: true
pdf_document: default
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## Download Monthly Precipitatation Indices for Germany
Use tamboRapi to inq data (take some time)
Data is taken from data set: "Monthly Temperature and Hygric Indices for Central Europe since AD 1500" as provided on tambora.org.
[DOI:10.6094/tambora.org/2019/c493/csv.zip](https://doi.org/10.6094/tambora.org/2019/c493/csv.zip)
```{r tambora}
if (!require("devtools")) install.packages("devtools")
library("devtools")
devtools::install_github('tambora-org/tamboRapi')
library(dplyr)
## Large chunks seem to fail, so try some redundancy import
tempData0b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1500&t[ye]=1549")
tempData0b <- distinct(tempData0b, begin_year,begin_month_id, .keep_all= TRUE)
tempData1 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1500&t[ye]=1599")
tempData1 <- distinct(tempData1, begin_year,begin_month_id, .keep_all= TRUE)
tempData1b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1550&t[ye]=1649")
tempData1b <- distinct(tempData1b, begin_year,begin_month_id, .keep_all= TRUE)
tempData2 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1600&t[ye]=1699")
tempData2 <- distinct(tempData2, begin_year,begin_month_id, .keep_all= TRUE)
tempData2b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1650&t[ye]=1749")
tempData2b <- distinct(tempData2b, begin_year,begin_month_id, .keep_all= TRUE)
tempData3 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1700&t[ye]=1799")
tempData3 <- distinct(tempData3, begin_year,begin_month_id, .keep_all= TRUE)
tempData3b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1750&t[ye]=1849")
tempData3b <- distinct(tempData3b, begin_year,begin_month_id, .keep_all= TRUE)
tempData4 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1800&t[ye]=1899")
tempData4 <- distinct(tempData4, begin_year,begin_month_id, .keep_all= TRUE)
tempData4b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1850&t[ye]=1949")
tempData4b <- distinct(tempData4b, begin_year,begin_month_id, .keep_all= TRUE)
tempData5 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1900&t[ye]=2000")
tempData5 <- distinct(tempData5, begin_year,begin_month_id, .keep_all= TRUE)
tempData5b <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1950&t[ye]=2000")
tempData5b <- distinct(tempData5b, begin_year,begin_month_id, .keep_all= TRUE)
tempData <- rbind(tempData1,tempData2,tempData3,tempData4,tempData5)
tempData <- distinct(tempData, begin_year,begin_month_id, .keep_all= TRUE)
tempDataB <- rbind(tempData0b,tempData1b,tempData2b,tempData3b,tempData4b,tempData5b)
tempDataB <- distinct(tempDataB, begin_year,begin_month_id, .keep_all= TRUE)
tempData0 <- tamboRapi::fromTambora("g[cid]=493&c[nd]=237&t[yb]=1500&t[ye]=2000")
tempData <- rbind(tempData, tempData0)
tempData <- rbind(tempData, tempDataB)
tempData <- distinct(tempData, begin_year,begin_month_id, .keep_all= TRUE)
```
## Convert to simple time series data
```{r convert}
library(dplyr)
tempTs <- data.frame(tempData$begin_year, tempData$begin_month_id, tempData$value_index)
names(tempTs)[names(tempTs) == "tempData.begin_year"] <- "year"
names(tempTs)[names(tempTs) == "tempData.begin_month_id"] <- "month"
names(tempTs)[names(tempTs) == "tempData.value_index"] <- "ti"
tempTs$ts <- signif(tempTs$year + (tempTs$month-0.5)/12, digits=6)
tempTs$time <- paste(tempTs$year,tempTs$month, '15 00:00:00', sep='-')
tempTs <- distinct(tempTs, year,month, .keep_all= TRUE)
tempTs <- tempTs[order(tempTs$ts),]
```
## Store as csv file
```{r csv}
write.table(tempTs, file = "csv/ti_1500_2xxx_monthly.csv", append = FALSE, quote = TRUE, sep = ",",
eol = "\n", na = "NA", dec = ".", row.names = FALSE,
col.names = TRUE, qmethod = "escape", fileEncoding = "UTF-8")
```
## Plot Drought time line
```{r plot, echo=TRUE}
require("ggplot2")
library("RColorBrewer")
tempTs <- read.csv("csv/ti_1500_2xxx_monthly.csv", sep=",", na = "NA")
tempColors = rev(brewer.pal(n = 9, name = "RdBu"))
mp <- ggplot(tempTs, aes(year, month))
mp + geom_raster(aes(fill=ti))+
#theme_classic(base_size=80) +
theme_classic() +
labs(x="Year", y="Month", title="", subtitle="") +
scale_y_continuous(breaks=c(1,6,12))+
scale_x_continuous(limits=c(1500,2020)) +
scale_fill_gradientn(colors=tempColors) +
theme( legend.key.width = unit(2,"cm")) +
guides(fill=guide_legend(title="TI", reverse = TRUE))
```