## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
    collapse = TRUE,
    comment = "#>",
    fig.align="center",
    fig.width = 7,
    fig.height = 4, 
    root.dir = "vignettes"
)

## ----captions, echo = FALSE, error = FALSE, warning = FALSE, message = FALSE, include = FALSE----
library(hyd1d)
library(stringr)
library(yaml)
library(desc)

# set english locale to produce english plot labels
Sys.setlocale(category = "LC_MESSAGES", locale = "en_US.utf8")

# Determine the output format of the document
outputFormat <- knitr::opts_knit$get("rmarkdown.pandoc.to")
if (outputFormat == "html") {
    is_html <- TRUE
} else {
    is_html <- FALSE
}

# Figure and Table Caption Numbering, for HTML do it manually
capTabNo <- 1
capFigNo <- 1

# Function to add the Table Number
capTab <- function(x){
    if(outputFormat == 'html'){
        x <- paste0("**Tab. ", capTabNo, "**: ", x)
        capTabNo <<- capTabNo + 1
    } else if (outputFormat == 'latex'){
        y <- str_replace_all(x, '(^.*)(\\[.*\\])(\\(.*\\))(.*$)', 
                             '\\1\\\\href{\\3}{\\2}\\4')
        y <- gsub("{(", "{", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub("{[", "{", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub(")}", "}", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub("]}", "}", y, fixed = TRUE, useBytes = TRUE)
        x <- gsub("_", "\\_", y, fixed = TRUE, useBytes = TRUE)
    }
    return(x)
}

# Function to add the Figure Number
capFig <- function(x){
    if(outputFormat == 'html'){
        x <- paste0("**Fig. ", capFigNo, "**: ", x)
        capFigNo <<- capFigNo + 1
    } else if (outputFormat == 'latex'){
        y <- str_replace_all(x, '(^.*)(\\[.*\\])(\\(.*\\))(.*$)', 
                             '\\1\\\\href{\\3}{\\2}\\4')
        y <- gsub("{(", "{", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub("{[", "{", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub(")}", "}", y, fixed = TRUE, useBytes = TRUE)
        y <- gsub("]}", "}", y, fixed = TRUE, useBytes = TRUE)
        x <- gsub("_", "\\_", y, fixed = TRUE, useBytes = TRUE)
    }
    return(x)
}

href <- function(x, y) {
    if (outputFormat == 'html') {
        x <- paste0("[", x, "](", y, ")")
    } else if (outputFormat == 'latex') {
        x <- paste0("\\href{", y, "}{", x, "}")
    }
    return(x)
}

bf <- function(x) {
    if (outputFormat == 'html') {
        x <- paste0("**", x, "**")
    } else if (outputFormat == 'latex') {
        x <- paste0("\\textbf{", x, "}")
    }
    return(x)
}
# Function to simplify linking to references/rd
lrd <- function(x, y) {
    # standard url
    url <- "https://hyd1d.bafg.de"
    
    # url from DESCRIPTION file
    if (file.exists("DESCRIPTION")) {
        url_desc <- description$new("DESCRIPTION")$get_urls()[1]
    }
    
    # url from pkgdown/_pkgdown.yml
    pwd <- Sys.getenv("PWD")
    if (pwd != "") {
        if (file.exists(paste0(pwd, "/pkgdown/_pkgdown.yml"))) {
            url_pkgdown <- yaml.load_file(
                paste0(pwd, "/pkgdown/_pkgdown.yml"))$url
        }
    }
    
    if (exists("url_desc")) {
        url <- url_desc
        if (exists("url_pkgdown")) {
            url <- url_pkgdown
        }
    }
    
    # outputformat latex
    if (knitr::is_latex_output()) {
        if (missing(y)) {
            if (endsWith(x, "()")) {
                x1 <- gsub("()", "", x, fixed = TRUE)
                str <- paste0("[", x, "](", url, "/reference/", x1, ".html)")
            } else {
                str <- paste0("[", x, "](", url, "/reference/", x, ".html)")
            }
        } else {
            str <- paste0("[", x, "](", url, "/reference/", y, ")")
        }
        return(str)
    }
    
    # outputformat html
    if (missing(y)) {
        if (endsWith(x, "()")) {
            # x1 <- gsub("()", "", x, fixed = TRUE)
            str <- paste0("`", x, "`")
        } else {
            str <- paste0("<code>[", x, "](", url, "/reference/", x, ".html)</",
                          "code>")
        }
    } else {
        str <- paste0("<code>[", x, "](", url, "/reference/", y, ")</code>")
    }
    
    return(str)
}

## ----install_cran, eval = FALSE-----------------------------------------------
# install.packages("hyd1d")

## ----install_git, eval = FALSE------------------------------------------------
# install.packages("devtools")
# library(devtools)
# devtools::install_github("bafg-bund/hyd1d")

## ----library, eval = TRUE, echo = TRUE, error = FALSE, warning = FALSE, message = FALSE----
library(hyd1d)

## ----wldf, eval = TRUE--------------------------------------------------------
wldf <- WaterLevelDataFrame(river   = "Elbe",
                            time    = as.POSIXct("2016-12-21"),
                            station = seq(257, 262, 0.1))

## ----structure, eval = TRUE---------------------------------------------------
str(wldf)
summary(wldf)

## ----waterlevel, eval = TRUE--------------------------------------------------
wldf <- waterLevel(wldf)
summary(wldf)

## ----figure1, fig.show = 'asis', fig.cap = capFig("Interpolated water level, computation-relevant stationary [FLYS3](https://www.bafg.de/DE/5_Informiert/1_Portale_Dienste/FLYS/flys_node.html) water levels (**0.5MQ**, **a** and **0.75MQ**) and gauge height as of 2016-12-21 at River Elbe between Rosslau and Dessau."), eval = TRUE----
wldf <- waterLevel(wldf, shiny = TRUE)
summary(wldf)

xlim_min <- 257
xlim_max <- 263
{
    plotShiny(wldf, TRUE, TRUE, TRUE, xlim = c(xlim_min, xlim_max),
              xlab = "river station (km)",
              ylab = "elevation (m a.s.l. (DHHN92))")
    legend("topright", 
           col = c("darkblue", "darkblue", "darkblue", "red", "black"), 
           pch = c(21, NA, NA, NA, NA), 
           pt.bg = c("darkblue", NA, NA, NA, NA), 
           pt.cex = c(1, NA, NA, NA, NA), 
           lty = c(0, 0, 1, 1, 1), 
           lwd = c(0, 0, 1, 0.6, 0.6), 
           legend = c("gauge height", "gauge weight", "waterLevel", 
                      "upper FLYS w.l.", "lower FLYS w.l."), 
           text.col = c(1, "darkblue", 1, 1, 1), 
           cex = 0.7, bty = "n")
}

## ----figure2, fig.show = 'asis', fig.cap = capFig(paste0("Interpolated water level, computation-relevant stationary [FLYS3](https://www.bafg.de/DE/5_Informiert/1_Portale_Dienste/FLYS/flys_node.html) water levels (**0.5MQ**, **a** and **0.75MQ**) and gauge height as of ", strftime(Sys.time() - 3600, format = "%Y-%m-%d %H:%M")," at River Elbe between Rosslau and Dessau.")), eval = hyd1d:::.pegelonline_status()----
# one hour ago
time <- as.POSIXct(Sys.time() - 3600)

# initialize a WaterLevelDataFrame
wldf <- WaterLevelDataFrame(river   = "Elbe",
                            time    = time,
                            station = seq(257, 262, 0.1))

# compute w
wldf <- waterLevelPegelonline(wldf, shiny = TRUE)
summary(wldf)

# and plot the results
{
    plotShiny(wldf, TRUE, TRUE, TRUE, xlim = c(xlim_min, xlim_max),
              xlab = "river station (km)",
              ylab = "elevation (m a.s.l. (DHHN92))")
    legend("topright", 
           col = c("darkblue", "darkblue", "darkblue", "red", "black"), 
           pch = c(21, NA, NA, NA, NA), 
           pt.bg = c("darkblue", NA, NA, NA, NA), 
           pt.cex = c(1, NA, NA, NA, NA), 
           lty = c(0, 0, 1, 1, 1), 
           lwd = c(0, 0, 1, 0.6, 0.6), 
           legend = c("gauge height", "gauge weight", "waterLevel", 
                      "upper FLYS w.l.", "lower FLYS w.l."), 
           text.col = c(1, "darkblue", 1, 1, 1), 
           cex = 0.7, bty = "n")
}


## ----figure3-prep-------------------------------------------------------------
wldf <- WaterLevelDataFrame(river   = "Elbe",
                            time    = as.POSIXct("2016-12-21"),
                            station = seq(257, 262, 0.1))

wldf1 <- waterLevelFlood1(wldf, "ROSSLAU", shiny = TRUE)
summary(wldf1)

wldf2 <- waterLevelFlood1(wldf, "DESSAU", shiny = TRUE)
summary(wldf2)

wldf3 <- waterLevelFlood2(wldf)
summary(wldf3)

## ----figure3, fig.show = 'asis', fig.cap = capFig("Water levels computed according to the Flood1-method with the reference gauges Rosslau (wldf1) and Dessau (wldf2) and the Flood2-method as of 2016-12-21 at River Elbe between Rosslau and Dessau."), eval = TRUE, echo = FALSE----
df.gs2 <- getGaugingStations(wldf2)

{
    plotShiny(wldf1, FALSE, FALSE, FALSE, xlim = c(xlim_min, xlim_max),
              xlab = "river station (km)",
              ylab = "elevation (m a.s.l. (DHHN92))")
    lines(wldf2$station, wldf2$w, col = "darkblue", lty = 2)
    lines(wldf3$station, wldf3$w, col = "red", lty = 2)
    abline(v = df.gs2$km_qps, lty = 3, lwd = 0.5)
    points(df.gs2$km_qps, df.gs2$wl, pch=21, col="darkblue", bg="darkblue")
    hyd1d:::.boxed.labels(df.gs2$km_qps, 55.4, df.gs2$gauging_station,
                          bg="white", srt = 90, border = FALSE, xpad = 4,
                          ypad = 0.7, cex = 0.7)
    legend("topright", 
           col = c("darkblue", "darkblue", "darkblue", "red"), 
           pch = c(21, NA, NA, NA), 
           pt.bg = c("darkblue", NA, NA, NA), 
           pt.cex = c(1, NA, NA, NA), 
           lty = c(0, 1, 2, 2), 
           lwd = c(0, 1, 1, 1), 
           legend = c("gauge height", "wldf1", "wldf2", "wldf3"), 
           cex = 0.7, bty = "n")
}

## ----figure4-prep-------------------------------------------------------------
wldf <- waterLevelFlys3InterpolateY(wldf, "ROSSLAU", shiny = TRUE)
summary(wldf)

## ----figure4, fig.show = 'asis', fig.cap = capFig("Water levels according to [FLYS3](https://www.bafg.de/DE/5_Informiert/1_Portale_Dienste/FLYS/flys_node.html) with the reference gauge Rosslau as of 2016-12-21 at River Elbe between Rosslau and Dessau."), eval = TRUE, echo = FALSE----
{
    plotShiny(wldf, TRUE, TRUE, TRUE, xlim = c(xlim_min, xlim_max),
              xlab = "river station (km)",
              ylab = "elevation (m a.s.l. (DHHN92))")
    abline(v = df.gs2$km_qps, lty = 3, lwd = 0.5)
    points(df.gs2$km_qps, df.gs2$wl, pch=21, col="darkblue", bg="darkblue")
    hyd1d:::.boxed.labels(df.gs2$km_qps, 55.4, df.gs2$gauging_station,
                          bg="white", srt = 90, border = FALSE, xpad = 4,
                          ypad = 0.7, cex = 0.7)
    legend("topright", 
           col = c("darkblue", "darkblue", "darkblue", "red", "black"), 
           pch = c(21, NA, NA, NA, NA), 
           pt.bg = c("darkblue", NA, NA, NA, NA), 
           pt.cex = c(1, NA, NA, NA, NA), 
           lty = c(0, 0, 1, 1, 1), 
           lwd = c(0, 0, 1, 0.6, 0.6), 
           legend = c("gauge height", "gauge weight", "waterLevel", 
                      "upper FLYS w.l.", "lower FLYS w.l."), 
           text.col = c(1, "darkblue", 1, 1, 1), 
           cex = 0.7, bty = "n")
}

## ----link_waterlevel, eval = is_html, echo = FALSE, results = 'asis'----------
cat('<p style="text-align: center;"><a href="https://shiny.bafg.de/waterlevel/" target="_blank">https://shiny.bafg.de/waterlevel/</a></p>')

## ----figure20, echo = FALSE, fig.cap = capFig(paste0("Screenshot of the ", href("waterLevel-ShinyApp", "https://shiny.bafg.de/waterlevel/"), " with the interpolated water level, caomputationrevelvant stationary ", href("FLYS3", "https://www.bafg.de/DE/5_Informiert/1_Portale_Dienste/FLYS/flys_node.html"), "-waterlevels (", bf("0.5MQ"), ", ", bf("a"), " and ", bf("0.75MQ"), ") and gauge heights at 2016-12-21 at the River Elbe between Rosslau and Dessau, Germany.")), fig.show = 'asis', out.width = "100%", results = 'asis'----
knitr::include_graphics('screenshot_waterLevel.png')

## ----link_waterlevelpegelonline, eval = is_html, echo = FALSE, results = 'asis'----
cat('<p style="text-align: center;"><a href="https://shiny.bafg.de/waterlevelpegelonline/" target="_blank">https://shiny.bafg.de/waterlevelpegelonline/</a></p>')

## ----figure21, echo = FALSE, fig.cap = capFig(paste0("Screenshot of the ", href("waterLevelPegelonline-ShinyApp", "https://shiny.bafg.de/waterlevelpegelonline/"), " with the interpolated water level, computationrevelvant stationary ", href("FLYS3", "https://www.bafg.de/DE/5_Informiert/1_Portale_Dienste/FLYS/flys_node.html"), "-waterlevels (", bf("a"), ", ", bf("0.75MQ"), " and ", bf("0.5MQ"), ") and gauge heights at 2018-04-13 11:00 a.m. at the River Elbe between Rosslau and Dessau, Germany.")), fig.show = 'asis', out.width = "100%"----
knitr::include_graphics('screenshot_waterLevelPegelonline.png')

## ----link_hydflood, eval = is_html, echo = FALSE, results = 'asis'------------
cat('<p style="text-align: center;"><a href="https://hydflood.bafg.de" target="_blank">https://hydflood.bafg.de</a></p>')