HeatMap.Rmd 1.52 KB
Newer Older
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
---
title: "Untitled"
author: "David Dorchies"
date: "24/04/2021"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

# Setup

```{r cars}
library(irmara)
library(ggplot2)
con <- DBI::dbConnect(RSQLite::SQLite(), dbname = irmara:::app_sys("cdf", "Qgen_5000y_unbiased_median.sqlite"))
objectiveStorageCurves <- irmara:::objectiveStorageCurves
```

#

```{r}
ruleset <- 1
iObjective <- 1
objective <- rvgest::objectives[iObjective,]
lake <- objective$lakes[[1]]$name[1]
```

```{r}
objCurve <- data.frame(day = objectiveStorageCurves$day, V = round(objectiveStorageCurves[[lake]]))
objCurve <- objCurve[seq.int(1, 365,3),]
head(objCurve)
```


```{r}
indexMonths <- c(1,31,28,31,30,31,30,31,31,30,31,30)
labels <- unlist(strsplit("JFMAMJJASOND", NULL))
iBreaks <- sapply(seq.int(12), function(i) sum(indexMonths[1:i]))
```

```{r}
dfDiscretProbs <- irmara:::calcRiskHeatMap(con, ruleset, objective$station, objective$level, lake)
breaks <- sapply(iBreaks, function(x) levels(dfDiscretProbs$day)[x])
head(dfDiscretProbs)
```

```{r}
p <- ggplot(dfDiscretProbs, aes(x = day, y = V)) +
            geom_tile(aes(fill = prob)) +
            scale_fill_continuous(low = "green", high = "red", name = "Failure probability") +
            geom_point(data = objCurve, color = "black", size = 1, shape = 21, fill = "grey") +
            ggtitle(paste("Lake", lake)) +
            scale_x_discrete("Calendar days", breaks = breaks, labels = labels) +
            scale_y_continuous(name="Reservoir storage (hm3)")
p
```