Merge pull request #13 from openearth/sealevelVisual

Sealevel visual
openearth · Feb 8, 2022 · 4321def · 4321def
2 parents f07067d + 315e70b
commit 4321def
Show file tree

Hide file tree

Showing 42 changed files with 29,861 additions and 76 deletions.
diff --git a/.gitignore b/.gitignore
@@ -184,3 +184,4 @@ ENV/
 # Rope project settings
 .ropeproject
 dashboard/r-sealevel/sealevel/.Rhistory
+.Rproj.user
diff --git a/dashboard/navbar/images/IW_KNMI_Logo_druk_ex_pos_nl.png b/dashboard/navbar/images/IW_KNMI_Logo_druk_ex_pos_nl.png
diff --git a/dashboard/navbar/images/Rijkswaterstaat-logo-e1473888123824-1-300x300.jpg b/dashboard/navbar/images/Rijkswaterstaat-logo-e1473888123824-1-300x300.jpg
diff --git a/dashboard/navbar/images/deltares_logo.png b/dashboard/navbar/images/deltares_logo.png
diff --git a/dashboard/navbar/images/icon-deltares.svg b/dashboard/navbar/images/icon-deltares.svg
diff --git a/dashboard/navbar/images/rijkswaterstaat.jpg b/dashboard/navbar/images/rijkswaterstaat.jpg
diff --git a/dashboard/navbar/images/rws_logo.png b/dashboard/navbar/images/rws_logo.png
diff --git a/dashboard/navbar/images/rws_logo_cropped.png b/dashboard/navbar/images/rws_logo_cropped.png
diff --git a/dashboard/navbar/navbar.css b/dashboard/navbar/navbar.css
@@ -0,0 +1,21 @@
+.navigation-bar {
+    width: 100%;
+    height: 60px; 
+    background-color: #BEE9E6; 
+}
+.logos {
+    display: inline-flex;
+    vertical-align: middle;
+    height: 60px;
+    float: right;
+}
+
+.logo {
+    height: 60px;
+}
+
+.navbar-caption {
+    line-height: 60px;
+    position: relative;
+    margin-left: 8px;
+}
diff --git a/dashboard/navbar/navbar.html b/dashboard/navbar/navbar.html
@@ -0,0 +1,20 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
+    <link rel="shortcut icon" type="image/jpg" href="navbar/images/icon-deltares.svg"/>
+    <title>Sea-level visualization</title>
+  </head>
+  <body>
+    <nav class="navigation-bar">
+      <span class="caption navbar-caption">
+        This visualization was made by Deltares in collaboration with the Dutch Ministry of Infrastructure and Water Management
+      </span>
+      <div class="logos">
+        <img class="logo" src="navbar/images/IW_KNMI_Logo_druk_ex_pos_nl.png" alt="logo knmi"/>
+        <img class="logo" src="navbar/images/deltares_logo.png" alt="logo deltares"/>
+        <img class="logo" src="navbar/images/rws_logo_cropped.png" alt="logo rijkswaterstaat"/>
+      </div>
+    </nav>
+  </body>
+</html>
diff --git a/dashboard/prepareModelResults.Rmd b/dashboard/prepareModelResults.Rmd
@@ -0,0 +1,149 @@
+---
+title: "Data handling of KNMI21 projections"
+date: '`r lubridate::today()`'
+author: Willem Stolte, Fedor Baart (Deltares)
+output: html_notebook
+---
+
+## Data delivery from KNMI to Deltares
+
+*   klimaatsignaal referenced data and scenarios (for visual only)
+*   raw model output data
+
+
+## Klimaatsignaal grafiek 
+
+Gerefereerde scenarios - voor klimaatsignaal. The data that we use and publish is only the total sea level, this is given in the csv file. It includes vertical land motion of 0.45 mm/yr and is given with a reference period of 1995-2014. Like the IPCC AR6 report.
+
+```{r, eval=F, echo = F}
+ref_scenario <- read_csv(file.path(datadir, "DataKlimaatsignaal21_SeaLevel_2100_ref_period_1995_2014.csv"))
+
+ggplot(ref_scenario, aes(x = time)) +
+  geom_point(aes(y = Zeespiegelmonitor)) +
+  geom_line(aes(y = `Trend Zeespiegelmonitor`)) +
+  geom_line(aes(y = ssp245_50pc)) +
+  geom_line(aes(y = ssp245_95pc)) +
+  geom_line(aes(y = ssp245_5pc))
+```
+
+
+
+## Model output data delivery
+
+Model output data were delivered as NetCDF containing modelled sea level (total) and the contribution of individual processes. This notebook extracts the data and makes correction for vertical reference so that the model results can be compared to the observations. 
+
+
+```{r readData}
+
+require(tidync)
+require(tidyverse)
+
+datadir <- "../data/knmi/knmi21"
+scen = c("ssp126", "ssp245", "ssp585")
+# scen = scen[1]
+scenarios <- list()
+for(scen in scen){
+  con <- file.path(datadir, paste0("SeaLevelPerc_KNMIsignal_BiasCorr_NoWind_",scen,".nc"))
+  df <- tidync::tidync(con, "perc_ts") %>% hyper_tibble()
+  scenarios[[scen]] <- df
+  rm(df)
+}
+df.scenarios <- data.table::rbindlist(scenarios, use.names = TRUE, idcol = "scenario")
+rm(scenarios)
+
+# TODO: this is still in cm
+# divide by 10 for use in dashboard in mm
+```
+
+
+Model output for KNMI21 scenario's sent 2021-10-25 was used here. 
+
+It contained the following files:
+
+`r paste(list.files(datadir, pattern = "*.nc"), collapse = "</br>")`
+
+The model ouputs do not include vertical land motion (Le Bars, personal communication)
+
+It contains output for the processes `r df.scenarios %>% distinct(proc) %>%  knitr::kable()`
+
+
+## Model output exploration
+
+The plot below depicts the model outcomes as 5, 50 and 95 percentiles of the three scenarios (columns) and all individual processes including the total (rows).
+
+
+
+```{r exploreData, fig.width = 8, fig.height=10}
+df.scenarios %>%
+  filter(percentiles %in% c(5, 50, 95)) %>%
+  mutate(percentiles = as.factor(percentiles)) %>%
+ggplot(aes(time, perc_ts)) +
+  geom_path(aes(color = percentiles)) +
+  facet_grid(proc ~ scenario) +
+  theme(strip.text.y = element_text(angle = 0))
+```
+
+It is important to note that "sum anta." is the sum of "Antarctic dynamics" and "Antarctic SMB". One of those should be kept out of the visualization. In the contributing factors for observations there is only the total effect of Antarctica. Therefore, "sum anta." was used in the mapping comparing observations with projections. 
+
+
+
+## Correct vertical position for reference period
+
+Dewi:
+
+> Since my code still uses the 1986-2005 as reference period (like AR5) I don't have the 
+components with respect to 1995-2014 but only 1986-2005. One reason I keep 1986-2005 as 
+reference period is that it allows a better evaluation, otherwise the overlap between 
+scenarios and observations is too small. I therefore attach the data for individual 
+contributors and total sea level as netcdf files. These do not include vertical 
+land motion, as the previous data that I sent you. 
+
+```{r}
+# read seas level data
+sealevel <- read_csv("../data/deltares/results/dutch-sea-level-monitor-export-2020-11-25.csv", comment = "#")
+
+# calculate mean sea level over period 1986 - 2005 for vertical correction
+meanSL86_05 <- sealevel %>% 
+  filter(year %in% c(1986:2005)) %>% 
+  summarize(meanHeight = mean(height)) %>% 
+  unlist() %>% unname()
+```
+
+Mean sea level during the reference period was `r round(meanSL86_05, 3)` mm. This value is then added to the KNMI projection results, but only to the "Total" sea level. The contribution of the individual processes is unaffected by the reference period. 
+
+
+```{r}
+df.scenarios <- df.scenarios %>%
+  mutate(
+    perc_ts_corr = case_when(
+      proc == "Total" ~ perc_ts + meanSL86_05,
+      proc != "Total" ~ perc_ts
+    )
+  )
+```
+
+```{r}
+cols <- c(
+  "uncorrected" = "red",
+  "t.o.v. NAP" = "green"
+)
+df.scenarios %>%
+  filter( percentiles == 50 & proc == "Total") %>%
+ggplot(aes(x = time)) +
+  geom_line(aes(y = perc_ts, lineshape = scenario, color = "uncorrected"), size = 1) +
+  geom_line(aes(y = perc_ts_corr, lineshape = scenario, color = "t.o.v. NAP"), size = 1) +
+  facet_wrap(~scenario) +
+  scale_color_manual(values = cols)
+```
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/dashboard/r-sealevel/sealevel/examples.R b/dashboard/r-sealevel/sealevel/examples.R
@@ -0,0 +1,26 @@
+
+library(readr)
+library(dplyr)
+
+url <- "~/src/sealevel/data/deltares/results/dutch-sea-level-monitor-export-2020-11-25.csv"
+
+deltares_df <- read_csv(url, comment = "#")
+
+url <- "~/src/sealevel/data/knmi/cmip5/SeaLevelPerc_KNMI14.csv"
+
+knmi_df <- read_csv(url, comment = "#")
+
+
+
+ggplot() + geom_line(data=knmi_median_df, mapping=aes(time, perc_ts, colour=scenario))
+
+# merge with percentiles
+knmi_perc10_df <- knmi_df %>% filter(percentiles==10) %>% select(time, scenario, proc, perc_ts) %>%  rename(perc_ts_10=perc_ts)
+knmi_perc50_df <- knmi_df %>% filter(percentiles==50) %>% select(time, scenario, proc, perc_ts) %>%  rename(perc_ts_50=perc_ts)
+knmi_perc90_df <- knmi_df %>% filter(percentiles==90) %>% select(time, scenario, proc, perc_ts) %>%  rename(perc_ts_90=perc_ts)
+knmi_perc_df <- merge(merge(knmi_perc10_df, knmi_perc50_df), knmi_perc90_df) %>% filter(proc=="Total")
+
+fig <- (ggplot() 
+  + geom_line(data=knmi_perc_df, mapping=aes(time, perc_ts_50, colour=scenario)) 
+  + geom_ribbon(data=knmi_perc_df, mapping=aes(x=time, ymin=perc_ts_10, ymax=perc_ts_90, colour=scenario, fill=scenario), alpha=0.1)
+)