En raison d'une défaillance matérielle, les jobs d'intégration continue peuvent échouer sans raison évidente sur les runners partagés. Les disques incriminés devraient être changés en fin de semaine. Merci de votre compréhension.

Commit 3a586e26 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch 'sheetTabPanel' into 'master'

Sheet tab panel

See merge request !3
parents f68c15dc 6a1c6122
Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.8.75
Date: 2020-03-26
Version: 0.2.9.9
Date: 2020-03-27
Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
person("Laurent", "Coron", role = c("aut"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -36,6 +36,7 @@ exportPattern(".DiagramGR")
exportPattern(".TypeModelGR")
exportPattern(".StartStop")
exportPattern(".DyShadingMulti")
exportPattern(".CheckUrl")
......
......@@ -4,7 +4,7 @@
### 0.2.8.75 Release Notes (2020-03-26)
### 0.2.9.9 Release Notes (2020-03-27)
____________________________________________________________________________________
......
......@@ -25,6 +25,20 @@ if (getRversion() >= "2.15.1") {
## =================================================================================
## function to test if a remote url exists
## =================================================================================
.CheckUrl <- function(url, timeout = 2) {
con <- url(description = url)
check <- suppressWarnings(try(open.connection(con = con, open = "rt", timeout = t), silent = TRUE)[1])
suppressWarnings(try(close.connection(con), silent = TRUE))
is.null(check)
}
## =================================================================================
## function to compute the start and stop id of equal values in a vector
## =================================================================================
......
......@@ -171,7 +171,7 @@ shinyServer(function(input, output, session) {
verbose = FALSE)
## Criteria computation
CRIT_opt <- list(Crit = c(rep("ErrorCrit_NSE", 3), rep("ErrorCrit_KGE", 3)),
CRIT_opt <- list(Crit = c(rep("ErrorCrit_NSE", 3), rep("ErrorCrit_KGE", 3)),
Transfo = rep(c("", "sqrt", "inv"), times = 2))
nCRIT_opt <- length(CRIT_opt$Crit)
if (!getPrep()$isUngauged) {
......@@ -441,13 +441,24 @@ shinyServer(function(input, output, session) {
}, priority = +10)
## Time window slider
## Time window slider and dataset choosen on the Summary sheet panel
observeEvent({input$Dataset}, {
updateSliderInput(session, inputId = "Period",
min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"),
max = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][2L], tz = "UTC"),
value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"),
timeFormat = "%F", timezone = "+0000")
updateSelectInput(session, inputId = "DatasetSheet",
choices = .ShinyGR.args$NamesObsBV,
selected = input$Dataset)
})
## Dataset choosen on the SInterface panel
observeEvent({input$DatasetSheet}, {
updateSelectInput(session, inputId = "Dataset",
choices = .ShinyGR.args$NamesObsBV,
selected = input$DatasetSheet)
})
......@@ -764,6 +775,8 @@ shinyServer(function(input, output, session) {
## --------------- Criteria table
output$Criteria <- renderTable({
......@@ -846,7 +859,7 @@ shinyServer(function(input, output, session) {
ParamUnits <- c("mm", "mm/%s", "mm", "%s", "", "mm")[seq_len(getPrep()$TMGR$NbParam)]
if (input$SnowModel == "CemaNeige") {
ParamTitle <- c(ParamTitle, "C1", "C2")
ParamUnits <- c(ParamUnits, "", "mm/°C/%s")
ParamUnits <- c(ParamUnits, "", "mm/°C/%s")
}
ParamTitle <- paste(ParamTitle, paste(getSim()$PARAM, sprintf(ParamUnits, getPrep()$TMGR$TimeUnit)), sep = " = ", collapse = ", ")
ParamTitle <- gsub(" ,", ",", ParamTitle)
......@@ -855,7 +868,7 @@ shinyServer(function(input, output, session) {
paste0(input$Period, collapse = " - "),
ParamTitle)
if (getPlotType() == 1) {
png(filename = file, width = 1000*k, height = ifelse(input$SnowModel != "CemaNeige", 700*k, 1100*k), pointsize = 14, res = 150)
png(filename = file, width = 1000*k, height = ifelse(input$SnowModel != "CemaNeige", 700*k, 1100*k), pointsize = 14, res = 150)
par(oma = c(0, 0, 4, 0))
plot(getSim()$SIM)
mtext(text = PngTitle, side = 3, outer = TRUE, cex = 0.8, line = 1.2)
......@@ -901,7 +914,7 @@ shinyServer(function(input, output, session) {
polygon(c(data$Dates, rev(range(data$Dates))), c(data$prod., rep(0, 2)), border = "darkblue", col = adjustcolor("darkblue", alpha.f = 0.30))
polygon(c(data$Dates, rev(range(data$Dates))), c(data$rout., rep(0, 2)), border = "cyan4" , col = adjustcolor("cyan4" , alpha.f = 0.30))
if (input$HydroModel == "GR6J") {
minQrExp <- min(data$prod., data$rout., data$exp., 0)
minQrExp <- min(data$prod., data$rout., data$exp., 0)
colQrExp <- ifelse(minQrExp > 0, "#10B510", "#FF0303")
polygon(c(data$Dates, rev(range(data$Dates))), c(data$exp., rep(0, 2)), border = colQrExp, col = adjustcolor(colQrExp, alpha.f = 0.30))
}
......@@ -962,5 +975,41 @@ shinyServer(function(input, output, session) {
)
## --------------- Summary sheet
output$Sheet <- renderUI({
codeRegex <- "\\D{1}\\d{7}"
codeBH <- gsub(sprintf("(.*)(%s)(.*)", codeRegex), "\\2", input$DatasetSheet)
urlRegex <- "https://webgr.inrae.fr/wp-content/uploads/fiches/%s_fiche.png"
urlSheet <- sprintf(urlRegex, codeBH)
if (.CheckUrl(urlSheet)) {
tags$p(tags$h6("Click on the image to open it in a new window and to enlarge it."),
tags$a(href = urlSheet, target = "_blank", rel = "noopener noreferrer",
tags$img(src = urlSheet, height = "770px",
alt = sprintf("If the image does not appear, click on this link."),
title = "Click to open in a new window")))
} else {
urlSheet <- "fig/sheet_W1110010_thumbnail.png"
urlWebGR <- "https://webgr.inrae.fr"
txtWebGR <- "webgr.inrae.fr"
urlFraDb <- file.path(urlWebGR, "activites/base-de-donnees/")
txtFraDb <- "All the summary sheets are available on"
tags$p(tags$h1("Sorry, the summary sheet is not available for this dataset."),
tags$br(),
tags$h5("Only sheets of stations of the Banque Hydro French database are available."),
tags$h5("To show a summary sheet, the name of the chosen dataset has to contain the Banque Hydro station code (8 characters : 1 letter and 7 numbers)."),
txtFraDb, tags$a(href = urlFraDb, target = "_blank", rel = "noopener noreferrer", txtWebGR), ".",
tags$br(),
tags$br(),
tags$a(href = urlFraDb, target = "_blank", rel = "noopener noreferrer",
tags$img(src = urlSheet, width = "30%", height = "30%",
alt = txtWebGR,
title = paste("Visit", txtWebGR))))
}
})
})
......@@ -3,21 +3,21 @@
#library(markdown)
navbarPage(title = div("airGRteaching",
navbarPage(title = div("airGRteaching",
a(href = "https://hydrogr.github.io/airGRteaching/",
title = "airGRteaching",
target = "_blank", rel = "noopener noreferrer nofollow",
img(src = "fig/logo_airGRteaching_CMJN_square_0125x0121.png", height = 350 / 9)),
a(href = "https://webgr.inrae.fr/en/",
title = "webgr.inrae.fr",
target = "_blank", rel = "noopener noreferrer nofollow",
img(src = "fig/logo_inrae_hydro_CMJN_square.svg", height = 350 / 9)),
target = "_blank", rel = "noopener noreferrer",
img(src = "fig/logo_airGR_CMJN_square.svg" , height = 350 / 9)),
a(href = "https://webgr.inrae.fr/en/home/",
title = "webgr.inrae.fr",
target = "_blank", rel = "noopener noreferrer",
img(src = "fig/logo_inrae_hydro_CMJN_square.svg", height = 350 / 9)),
a(href = "https://www.inrae.fr/en/",
title = "inrae.fr",
target = "_blank", rel = "noopener noreferrer nofollow",
img(src = "fig/logo_inrae_CMJN_square.svg" , height = 350 / 9)),
target = "_blank", rel = "noopener noreferrer",
img(src = "fig/logo_inrae_CMJN_square.svg" , height = 350 / 9)),
style = "position:relative; top:-9px;"),
windowTitle = "airGRteaching",
theme = switch(.GlobalEnv$.ShinyGR.args$theme,
......@@ -191,9 +191,22 @@ navbarPage(title = div("airGRteaching",
)
)
),
tabPanel(title = "Functionalities" , fluidRow(column(6, includeMarkdown("www/tab_fun.md"))),
icon = icon("cog")),
tabPanel(title = "About" , fluidRow(column(6, includeMarkdown("www/tab_about.md")),
column(5, includeMarkdown("www/tab_authors.md"))),
icon = icon("navicon"))
tabPanel(title = "Summary sheet",
icon = icon("th"),
sidebarPanel(width = 3,
h4("Choose a dataset:"),
fluidRow(column(width = 12, selectInput("DatasetSheet", label = NULL, choices = .ShinyGR.args$NamesObsBV)),
style = "height:720px;")),
mainPanel(width = 9,
fluidRow(uiOutput("Sheet")))
),
tabPanel(title = "Functionalities",
fluidRow(column(6, includeMarkdown("www/tab_fun.md"))),
icon = icon("cog")
),
tabPanel(title = "About",
fluidRow(column(6, includeMarkdown("www/tab_about.md")),
column(5, includeMarkdown("www/tab_authors.md"))),
icon = icon("navicon")
)
)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment