diff --git a/R/app_server.R b/R/app_server.R index f03730f22ce0c731bc9668ca42cf4a09e08ea341..ad5fa1a2433da0e9ca3b8344c22d52fa1aad97b5 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -9,5 +9,5 @@ app_server <- function( input, output, session ) { SGL_RT_storage <- getSGLrealTimeStorage() # List the first level callModules here mod_instant_risk_overview_server("instant_risk_overview", con = con, SGL_RT_storage = SGL_RT_storage) - mod_one_objective_focus_server("one_objective_focus", con = con) + mod_one_objective_focus_server("one_objective_focus", con = con, SGL_RT_storage = SGL_RT_storage) } diff --git a/R/getCurves.R b/R/getCurves.R new file mode 100644 index 0000000000000000000000000000000000000000..93cfc16abce9539269d2543652043a689e783e92 --- /dev/null +++ b/R/getCurves.R @@ -0,0 +1,12 @@ +getCurves <- function(SGL_RT_storage, lake) { + objCurve <- data.frame(day = objectiveStorageCurves$day, V = round(objectiveStorageCurves[[lake]])) + objCurve <- objCurve[seq.int(1, 365,3),] + + RTcurve <- data.frame( + day = as.factor(format(as.POSIXct(SGL_RT_storage[,"datetime"], origin="1970-01-01"), "%m%d")), + V = SGL_RT_storage[, lake] + ) + + return(rbind(cbind(objCurve, type = "objective"), + cbind(RTcurve, type = "real time"))) +} diff --git a/R/mod_one_objective_focus.R b/R/mod_one_objective_focus.R index 93e12681ae0931a046408f3291d7472cb1cfdda5..a42dbfe515c14e8009fd6f57510726c7c825d311 100644 --- a/R/mod_one_objective_focus.R +++ b/R/mod_one_objective_focus.R @@ -55,7 +55,7 @@ mod_one_objective_focus_ui <- function(id){ #' #' @noRd #' @importFrom scales percent -mod_one_objective_focus_server <- function(id, con){ +mod_one_objective_focus_server <- function(id, con, SGL_RT_storage){ moduleServer( id, function(input, output, session){ ns <- session$ns observe({ @@ -67,12 +67,15 @@ mod_one_objective_focus_server <- function(id, con){ dfDiscretProbs <- calcRiskHeatMap(con, input$ruleset, objective$station, objective$level, lake) if(!is.null(dfDiscretProbs)) { breaks <- sapply(iBreaks, function(x) levels(dfDiscretProbs$day)[x]) - objCurve <- data.frame(day = objectiveStorageCurves$day, V = round(objectiveStorageCurves[[lake]])) - objCurve <- objCurve[seq.int(1, 365,3),] + Curves <- getCurves(SGL_RT_storage, lake) p <- ggplot(dfDiscretProbs, aes(x = day, y = V)) + geom_tile(aes(fill = prob)) + - scale_fill_continuous(low = "green", high = "red", name = "Failure probability", labels = percent) + - geom_point(data = objCurve, color = "black", size = 1, shape = 21, fill = "grey") + + scale_fill_continuous(low = "green", high = "red", name = "Failure probability") + + geom_point(data = Curves, + aes(x = day, y = V, color = type), + size = 1, shape = 21, fill = "#275662") + + scale_color_manual(name = "Filling curve", + values = c("objective" = "#797870", "real time" = "black")) + ggtitle(paste("Lake", lake)) + scale_x_discrete("Calendar days", breaks = breaks, labels = labels) + scale_y_continuous(name="Reservoir storage (hm3)") diff --git a/vignettes/debugging/HeatMap.Rmd b/vignettes/debugging/HeatMap.Rmd index bb9fd52325a002ef23791a98b9781544b796906c..dd1f4eb96cfa13c1ee485a893bee95d334a3a01b 100644 --- a/vignettes/debugging/HeatMap.Rmd +++ b/vignettes/debugging/HeatMap.Rmd @@ -46,11 +46,29 @@ breaks <- sapply(iBreaks, function(x) levels(dfDiscretProbs$day)[x]) head(dfDiscretProbs) ``` +```{r} +SGL_RT_storage <- irmara:::getSGLrealTimeStorage() +RTcurve <- data.frame( + day = as.factor(format(as.POSIXct(SGL_RT_storage[,"datetime"], origin="1970-01-01"), "%m%d")), + V = SGL_RT_storage[, lake] +) +``` + +```{r} +Curves <- rbind(cbind(objCurve, type = "objective"), + cbind(RTcurve, type = "real time")) +``` + + + ```{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") + + geom_point(data = Curves, aes(x = day, y = V, color = type), size = 1, shape = 21, fill = "#275662") + + scale_color_manual( + name = "Filling curve", + values = c("objective" = "#797870", "real time" = "black")) + ggtitle(paste("Lake", lake)) + scale_x_discrete("Calendar days", breaks = breaks, labels = labels) + scale_y_continuous(name="Reservoir storage (hm3)")