Complete UI refresh using bslib cards and shinyWidgets dropdowns …

…to get a more responsive design.

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: eCerto
 Title: Statistical Tests for the Production of Reference Materials
-Version: 0.3.1
-Date: 2024-04-04
+Version: 0.4
+Date: 2024-04-18
 Authors@R: c(
     person("Jan", "Lisec", , "jan.lisec@bam.de", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0003-1220-2286")),
@@ -29,6 +29,7 @@ LazyDataCompression: bzip2
 Depends:
     R (>= 3.5.0)
 Imports: 
+    bslib,
     config,
     DT,
     golem,

R/app_ui.R

@@ -5,36 +5,47 @@
 #' @import shiny
 #' @noRd
 app_ui <- function(request) {
+  navbar_padding <- 56
   shiny::tagList(
     # Leave this function for adding external resources
     golem_add_external_resources(),
 
+    tags$head(
+      tags$style(HTML(".control-label{ font-weight: bold; }"))
+    ),
+
     # the following lines can be used to check for problems with the 'www' folder on different App places
     # message("UI, 'www': ", shiny::resourcePaths()["www"]),
     # message("UI, app_sys: ", app_sys('app/www')),
     # message("UI, tempdir: ", tempdir()),
 
-    shiny::navbarPage(
-      # use an alternative theme
-      # currently difficult, as 'hidden' feature of tabPanel is not supported by bslib
-      # theme = bslib::bs_theme(
-      #   version = 3,
-      #   bootswatch = "readable",
-      #   base_font = bslib::font_google(c("Assistant", "Anonymous Pro")[1])
-      # ),
+    # shiny::navbarPage(
+    bslib::page_navbar(
+    #
+    #   # use an alternative theme
+    #   # currently difficult, as 'hidden' feature of tabPanel is not supported by bslib
+    #   theme = bslib::bs_theme(
+    #     version = 5,
+    #     bootswatch = c("sandstone","readable","zephyr")[3],
+    #     base_font = bslib::font_google(c("Assistant", "Anonymous Pro")[1])
+    #   ),
+
       id = "navbarpage",
-      title = shiny::div(
-        style = "position: relative;",
-        class = "verticalhorizontal",
-        shiny::img(src = "www/bam_logo_20pt.gif", position = "absolute", margin = "auto", alt = "BAM Logo"),
-        shiny::strong("BAM"),
-        shiny::em(get_golem_config("golem_name"))
+      #title = shiny::div(
+        #style = "position: relative;",
+        #class = "verticalhorizontal",
+        #shiny::img(src = "www/bam_logo_20pt.gif", position = "absolute", margin = "auto", alt = "BAM Logo"),
+      title = list(
+        shiny::img(src = "www/bam_logo_20pt.gif", position = "absolute", margin = "auto", alt = "BAM Logo", style="background-color: black;"),
+        shiny::strong("BAM", style = "color: rgb(210,0,30);"),
+        shiny::em(get_golem_config("golem_name"), style = "color: rgb(0,175,240);")
       ),
       selected = "Start",
-      windowTitle = paste("BAM", get_golem_config("golem_name")),
+      # windowTitle = paste("BAM", get_golem_config("golem_name")),
+      window_title = paste("BAM", get_golem_config("golem_name")),
       position = "fixed-top",
       footer = shiny::div(
-        style = "position: fixed; bottom: 0px; left: 0px; width: 100%; padding-left: 15px; padding-top: 5px; padding-bottom: 5px; background-color: #f8f8f8; font-family: Lucida Console, monospace;",
+        style = "position: fixed; bottom: 0px; left: 0px; width: 100%; padding-left: 15px; padding-top: 2px; padding-bottom: 2px; background-color: #f8f8f8; font-family: Lucida Console, monospace;",
         # shiny::pre(
         shiny::HTML(
           get_golem_config("golem_name"), "|",
@@ -45,45 +56,50 @@ app_ui <- function(request) {
         )
         # )
       ),
-      shiny::tabPanel(
+      bslib::nav_panel(
         id = "start",
         title = "Start",
         icon = shiny::icon("angle-right"),
-        shiny::div(style = "padding-top: 60px;", page_startUI("Start"))
+        shiny::div(style = paste0("padding-top: ", navbar_padding, "px;"), page_startUI("Start"))
       ),
-      shiny::tabPanel(
+      bslib::nav_panel(
         id = "homog_tab",
         title = "Homogeneity",
         icon = shiny::icon("angle-right"),
         value = "tP_homogeneity",
-        shiny::div(style = "padding-top: 60px;", page_HomogeneityUI("Homogeneity"))
+        shiny::div(style = paste0("padding-top: ", navbar_padding, "px;"), page_HomogeneityUI("Homogeneity"))
       ),
-      shiny::tabPanel(
+      bslib::nav_panel(
         id = "stab_tab",
         title = "Stability",
         icon = shiny::icon("angle-right"),
         value = "tP_stability",
-        shiny::div(style = "padding-top: 60px;", page_StabilityUI("Stability"))
+        shiny::div(style = paste0("padding-top: ", navbar_padding, "px;"), page_StabilityUI("Stability"))
       ),
-      shiny::tabPanel(
+      bslib::nav_panel(
         id = "certif_tab",
         title = "Certification",
         value = "tP_certification",
         icon = shiny::icon("angle-right"),
-        shiny::div(style = "padding-top: 60px;", page_CertificationUI("certification"))
+        shiny::div(style = paste0("padding-top: ", navbar_padding, "px;"), page_CertificationUI("certification"))
       ),
       # Long term stability
-      shiny::tabPanel(
+      bslib::nav_panel(
         title = "LTS",
         icon = shiny::icon("angle-right"),
         value = "tP_LTS",
-        shiny::div(style = "padding-top: 60px;", m_longtermstabilityUI("lts"))
+        shiny::div(style = paste0("padding-top: ", navbar_padding, "px;"), m_longtermstabilityUI("lts"))
       ),
-      shiny::tabPanel(
+      #shiny::tabPanel(
+      bslib::nav_panel(
         title = "Help",
         icon = shiny::icon("angle-right"),
         value = "tP_help",
-        shiny::div(style = "padding-top: 60px; float: left", shiny::withMathJax(shiny::includeCSS(path = get_local_file("help_start.html"))))
+        shiny::div(
+          style = paste0("padding-top: ", navbar_padding, "px; float: left"),
+          shiny::withMathJax(shiny::includeCSS(path = get_local_file("help_start.html")))
+          #uiOutput('help_page')
+        )
       )
     )
   )

R/app_utils.R

@@ -262,7 +262,7 @@ h_statement <- function(x, a) {
         width = 12,
         shiny::HTML(
           "The tested items are ", s1, "(ANOVA", ifelse(P_col == "P_adj", "P-value<sub>adj</sub>", "P-value"), "=", pn(a_P, 2), "using alpha-level = 0.05).",
-          "<p>The uncertainty value for analyte<b>", a_name, "</b>was determined as<b>", a_type, "=", pn(a_sd), "</b>.</p>", s2
+          "<br>The uncertainty value for analyte<b>", a_name, "</b>was determined as<b>", a_type, "=", pn(a_sd), "</b>.", s2
         )
       )
     )
@@ -342,7 +342,8 @@ get_input_data <- function(rv, type = c("kompakt", "standard"), excl_file = FALS
     if (!is.factor(df[, "Lab"])) df[, "Lab"] <- factor(df[, "Lab"], levels = unique(df[, "Lab"]))
     fn <- rv$c_lab_codes()
     p <- rv$a_p("precision")[an]
-    n_reps <- sort(unique(df$replicate))
+    n_reps <- as.character(sort(unique(df$replicate)))
+    if (min(as.numeric(n_reps))!=1) warning("No replicate with ID=1 found. Please check import data format (probably an additional column is present).")
     data <- plyr::ldply(split(df, df$Lab), function(x) {
       out <- rep(NA, length(n_reps))
       out[x$replicate] <- x$value
@@ -488,41 +489,43 @@ encode_fmt <- function(x) {
 welcome_screen <- function(id = id) {
   ns <- shiny::NS(id)
   shiny::tagList(
-    shiny::div(
-      style = "height: 70vh;",
-      shiny::div(
-        style = "height: 100%; background-color: rgb(210,0,30); text-align: center; border-radius: 4px; padding: 15px;",
-        # style = "position: absolute; bottom: 50px; top: 50px; height: 100%; background-color: rgb(210,0,30); text-align: center;",
-        shiny::div(
-          style = "background-color: rgb(0,175,240); color: white; margin: 15px; border-radius: 4px; text-shadow: 2px 2px 0px #D2001E; font-weight: 700; padding: 15px;",
-          p(style = "font-size: 28px", "Are you looking for a software to compute statistical tests on data generated in Reference Material production?"),
-          p(style = "font-size: 42px", "Welcome to eCerto!"),
-          shiny::img(src = "www/hex-eCerto.png", width = "120px", margin = "auto", alt = "eCerto Hex-Logo")
-        ),
-        shiny::fluidRow(
-          shiny::column(
-            width = 6,
+    bslib::layout_columns(
+      shiny::tagList(
+        bslib::card(
+          style = "background-color: rgb(0,175,240); color: white; text-shadow: 2px 2px 0px #D2001E; display: inline-block;",
+          shiny::span(
+            shiny::img(src = "www/hex-eCerto.png", alt = "eCerto Hex-Logo", width = "120px"),
             shiny::div(
-              style = "background-color: #f5f5f5; margin: 15px; padding: 15px; border-radius: 4px;",
-              "Click on", shiny::actionLink(inputId = ns("getHelp"), label = shiny::HTML("<strong>this Link</strong>")), shiny::HTML("when you are <span style='color: red;'>a first time user</span> to get help!")
-            ),
-            shiny::div(
-              style = "background-color: #f5f5f5; margin: 15px; padding: 15px; border-radius: 4px;",
-              "Read the extensive", shiny::actionLink(inputId = ns("showHelp"), label = shiny::HTML("<strong>Online Help</strong>")), shiny::HTML("(see top menue) if you want to know everything!"),
+              style = "display: inline-block;",
+              shiny::h3("Are you looking for a software to compute statistical tests on data generated in Reference Material production?"),
+              shiny::h1("Welcome to eCerto!")
             )
+          )
+        )
+      ),
+      shiny::tagList(
+        bslib::layout_columns(col_widths = 6,
+          bslib::card(
+            style = "background-color: #f5f5f5;",
+            shiny::div("Click on", shiny::actionLink(inputId = ns("getHelp"), label = shiny::HTML("<strong>this Link</strong>")), shiny::HTML("when you are <span style='color: red;'>a first time user</span> to get help!"))
           ),
-          shiny::column(
-            width = 6,
-            shiny::div(
-              style = "background-color: #f5f5f5; margin: 15px; padding: 15px; border-radius: 4px;",
-              shiny::HTML("Open some <strong>Test Data</strong> using the 'Load' button in the top right corner!")
-            ),
-            shiny::div(
-              style = "background-color: #f5f5f5; margin: 15px; padding: 15px; border-radius: 4px;",
-              shiny::HTML("Import your own data from <strong>Excel files</strong> using the 'Browse' button at the top!")
-            )
+          bslib::card(
+            style = "background-color: #f5f5f5;",
+            shiny::div("Read the extensive", shiny::actionLink(inputId = ns("showHelp"), label = shiny::HTML("<strong>Online Help</strong>")), shiny::HTML("(see top menue) if you want to know everything!"))
+          ),
+          bslib::card(
+            style = "background-color: #f5f5f5;",
+            shiny::div(shiny::HTML("Open some <strong>Test Data</strong> using the 'Load Test Data' button in the menu! You also can import a real life data set from Zenodo"))
+          ),
+          bslib::card(
+            style = "background-color: #f5f5f5;",
+            shiny::div(shiny::HTML("Import your own data from <strong>Excel files</strong> slecting the 'File format' and using the 'Browse' button at the top!"))
           )
         )
+      ),
+      col_widths =  bslib::breakpoints(
+        sm = c(12, 12),
+        xl = c(6, 6)
       )
     )
   )

R/fnc_prepFigH1.R

@@ -34,8 +34,10 @@ prepFigH1 <- function(x, sa = NULL, prec = 4, xlab = "Flasche", showIDs = FALSE)
     ylab <- expression(plain(Normalized ~ analyte ~ values) ~ ~ (x["a,i"] - bar(x[a])) / sigma[a])
   } else {
     unique_H_type <- length(unique(h_dat[, "H_type"])) == 1
-    an <- as.character(h_dat[interaction(h_dat[, "analyte"], h_dat[, "H_type"]) == sa, "analyte"])
-    ylab <- paste(ifelse(unique_H_type, an, sa), " [", unique(h_dat["unit"]), "]")
+    idx <- which(interaction(h_dat[, "analyte"], h_dat[, "H_type"]) == sa)[1]
+    an <- as.character(h_dat[idx, "analyte"])
+    au <- as.character(h_dat[idx, "unit"])
+    ylab <- paste(ifelse(unique_H_type, an, sa), " [", au, "]")
   }
   h_dat <- h_dat[interaction(h_dat[, "analyte"], h_dat[, "H_type"]) == sa, ]
   h_dat[, "Flasche"] <- factor(h_dat[, "Flasche"])

R/fnc_styleTabC1.R

@@ -36,7 +36,7 @@ styleTabC1 <- function(x, n = 4, fmt = c("alpha", "pval", "cval", "cval05", "cva
         list(className = "dt-right", targets = "_all")
       )
     ),
-    selection = "none", rownames = NULL, escape = FALSE
+    selection = "none", rownames = NULL, escape = FALSE,
   )
   dt <- DT::formatCurrency(
     table = dt, columns = c(2, 3), currency = "", digits = n

R/fnc_styleTabC3.R

@@ -67,6 +67,9 @@ styleTabC3 <- function(x, apm = NULL, selected_row = 1) {
   )
   dt <- DT::formatCurrency(table = dt, columns = u_cols, currency = "", digits = precision_U)
   # if (!is.null(prec_exp)) dt <- DT::formatCurrency(table = dt, columns = "cert_val", currency = "", digits = prec_exp)
-  if (!is.null(prec_exp)) dt <- DT::formatCurrency(table = dt, columns = "\u00B5<sub>c</sub>", currency = "", digits = prec_exp)
+  if (!is.null(prec_exp)) {
+    #browser()
+    #dt <- DT::formatCurrency(table = dt, columns = "\u00B5<sub>c</sub>", currency = "", digits = prec_exp)
+  }
   return(dt)
 }

R/m_ExcelUpload.R

@@ -38,34 +38,35 @@ m_ExcelUpload_UI <- function(id) {
     # [JL] calling useShinyjs() here is required because ???
     shinyjs::useShinyjs(),
     shiny::tagList(
-      shiny::fluidRow(
-        style = "background-color: #f5f5f5; border: 1px; border-radius: 4px; border-color: #e3e3e3; border-style: solid; margin: 0px; padding-top: 6px",
+      #shiny::fluidRow(
+      bslib::card(
+        #style = "background-color: #f5f5f5; border: 1px; border-radius: 4px; border-color: #e3e3e3; border-style: solid; margin: 0px; padding-top: 6px",
+        style = "background-color: #f5f5f5;",
         shiny::div(
-          style = "width: 130px; float: left; margin-left: 15px;",
-          shiny::radioButtons(
-            inputId = ns("moduleSelect"),
-            label = "File format",
-            choices = "dummy"
+          shiny::div(
+            style = "width: 120px; float: left; margin-bottom: -12px;",
+            shiny::radioButtons(
+              inputId = ns("moduleSelect"),
+              label = "File format",
+              choices = "dummy"
+            )
+          ),
+          shiny::div(
+            style = "width: 300px; float: left; margin-left: 16px;",
+            shiny::uiOutput(outputId = ns("inp_file"))
+          ),
+          shiny::div(
+            style = "width: 280px; float: left; margin-left: 16px;",
+            shinyjs::hidden(shiny::selectInput(inputId = ns("file_name"), label = "File", choices = ""))
+          ),
+          shiny::div(
+            style = "width: 90px; float: left; margin-left: 16px;",
+            shinyjs::hidden(shiny::selectInput(inputId = ns("sheet_number"), label = "Sheet #", choices = "1"))
+          ),
+          shiny::div(
+            style = "width:130px; float: left; margin-left: 16px; margin-top: 32px;",
+            shinyjs::hidden(shiny::actionButton(inputId = ns("btn_load"), label = "Load selected cell range", style = "background-color: rgb(140,180,15)"))
           )
-        ),
-        shiny::div(
-          style = "width: 260px; float: left; margin-left: 15px;",
-          shiny::uiOutput(outputId = ns("inp_file"))
-        ),
-        shiny::div(
-          style = "width: 260px; float: left; margin-left: 15px;",
-          shinyjs::hidden(shiny::selectInput(inputId = ns("file_name"), label = "File", choices = ""))
-        ),
-        shiny::div(
-          style = "width: 70px; float: left; margin-left: 15px;",
-          shinyjs::hidden(shiny::selectInput(inputId = ns("sheet_number"), label = "Sheet #", choices = "1"))
-        ),
-        shiny::div(
-          style = "width:270px; float: left; margin-left: 15px; color: red", id = ns("info_msg")
-        ),
-        shiny::div(
-          style = "float: right; margin-right: 15px; margin-top: 15px;",
-          shinyjs::hidden(shiny::actionButton(inputId = ns("btn_load"), label = "Load selected cell range", style = "background-color: rgb(140,180,15)"))
         )
       )
     ),
@@ -114,13 +115,6 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
     })
 
     shiny::observe({
-      req(exl_fmt() %in% names(rv$e_present()))
-      # browser()
-      if (rv$e_present()[exl_fmt()]) {
-        shinyjs::html(id = "info_msg", html = shiny::HTML("Note! You have uploaded <strong>", exl_fmt(), "</strong> data already. If you upload a different file, all your selected parameters may be lost."))
-      } else {
-        shinyjs::html(id = "info_msg", html = "")
-      }
       # hide welcome screen when some data was loaded already
       shinyjs::toggleElement(id = "welcome_screen", condition = !any(rv$e_present()) & is.null(current_file_input()))
     })
@@ -152,6 +146,11 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
       which(input$excel_file$name %in% input$file_name)
     })
 
+    check <- shiny::reactive({
+      req(any(rv$e_present()), exl_fmt() %in% names(rv$e_present()))
+      rv$e_present()[exl_fmt()]
+    })
+
     # Show file preview to select rows and columns
     rv_xlsx_range_select <- m_xlsx_range_select_Server(
       id = "rng_select",
@@ -160,7 +159,8 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
         as.numeric(input$sheet_number)
       }),
       file = file_number,
-      excelformat = exl_fmt
+      excelformat = exl_fmt,
+      check = check
     )
 
     # initialize return object 'out'

R/m_RData_export.R

@@ -28,12 +28,15 @@
 m_RDataExport_UI <- function(id) {
   ns <- shiny::NS(id)
   shiny::tagList(
-    shiny::div(
+    shinyWidgets::dropdown(
+      up = TRUE,
       id = ns("savepanel"),
-      sub_header("Save Current Analysis"),
-      shiny::textInput(inputId = ns("user"), label = "User", value = "Jan Lisec"),
-      shiny::textInput(inputId = ns("study_id"), label = "Study ID", value = "CRM001"),
-      shiny::downloadButton(outputId = ns("ecerto_backup"), label = "Backup")
+      label = "Save Current Analysis",
+      shiny::tagList(
+        shiny::textInput(inputId = ns("user"), label = "User", value = "Jan Lisec"),
+        shiny::textInput(inputId = ns("study_id"), label = "Study ID", value = "CRM001"),
+        shiny::downloadButton(outputId = ns("ecerto_backup"), label = "Backup", style = "background-color: rgb(140, 180, 15);")
+      )
     )
   )
 }