Add summary

R/appStatic.R

@@ -15,6 +15,8 @@
 #' element's name indicates the type of text it will fill. The order of these
 #' elements is important when displaying the content. Markdown sythax for text
 #' styling is supported.
+#' @param summary Whether to include a panel with a summary of content in the
+#' `result`.
 #' @param open Whether to open the shiny app project.
 #'
 #' @return The shiny app will be created in directory.
@@ -30,6 +32,7 @@ exportStaticApp <- function(result = emptySummarisedResult(),
                             logo = "HDS",
                             title = "My study",
                             background = character(),
+                            summary = TRUE,
                             directory = getwd(),
                             open = rlang::is_interactive()) {
   # input check
@@ -39,6 +42,8 @@ exportStaticApp <- function(result = emptySummarisedResult(),
   omopgenerics::assertLogical(open, length = 1)
   omopgenerics::assertCharacter(logo, length = 1, null = TRUE)
   omopgenerics::assertCharacter(title, length = 1)
+  omopgenerics::assertLogical(summary, length = 1)
+  sum <- validateSummary(summary, result)
 
   # create directory if it does not exit
   if (!dir.exists(directory)) {
@@ -69,7 +74,7 @@ exportStaticApp <- function(result = emptySummarisedResult(),
   dir.create(path = directory, showWarnings = FALSE)
   cli::cli_inform(c("i" = "Creating shiny from provided data"))
   logo <- copyLogos(logo, directory)
-  ui <- c(messageShiny(), uiStatic(choices = choices, logo = logo, title = title, background = background))
+  ui <- c(messageShiny(), uiStatic(choices = choices, logo = logo, title = title, summary = sum, background = background))
   server <- c(messageShiny(), serverStatic(resultTypes = names(choices)))
   global <- c(messageShiny(), omopViewerGlobal)
   dir.create(paste0(directory, "/data"), showWarnings = FALSE)
@@ -145,7 +150,8 @@ logoPath <- function(logo) {
 uiStatic <- function(choices = list(),
                      logo = NULL,
                      title = "My study",
-                     background = NULL) {
+                     background = NULL,
+                     summary = NULL) {
   # initial checks
   omopgenerics::assertList(choices, named = TRUE)
   omopgenerics::assertCharacter(logo, length = 1, null = TRUE)
@@ -156,6 +162,7 @@ uiStatic <- function(choices = list(),
     c(
       pageTitle(title, logo),
       createBackground(background = background, logo = logo),
+      createSummary(summary, logo),
       createUi(names(choices), choices),
       'bslib::nav_spacer()',
       createAbout("hds_logo.svg"),

R/background.R

@@ -53,8 +53,8 @@ validateBackground <- function(background) {
   } else {
     omopgenerics::assertCharacter(x = background, null = TRUE, named = TRUE)
     notAllowed <- ! names(background) %in% c("header", "title", "body", "footer")
-    if (sum(notAllowed) > 0) {
-      cli::cli_warn("{background[notAllowed]} {?is/are} not allowed named for `background` and will be ignored.")
+    if (any(notAllowed)) {
+      cli::cli_warn("{names(background)[notAllowed]} {?is/are} not allowed named for `background` and will be ignored.")
       background <- background[!notAllowed]
     }
   }

R/summary.R

@@ -0,0 +1,41 @@
+createSummary <- function(sum, logo) {
+
+  if (length(sum) == 0) {return(NULL)}
+
+  if (!is.null(logo)) {
+    logoImg <- ',
+    shiny::tags$img(
+      src = "{logo}",
+      width = "auto",
+      height = "100px",
+      alt = "logo",
+      align = "left"
+    )' |>
+      glue::glue() |>
+      as.character()
+  } else {
+    logoImg <- ""
+  }
+
+  return(
+    'bslib::nav_panel(
+       title = "Summary",
+       icon = shiny::icon("file-alt"),
+       bslib::card(
+         bslib::card_header("Summary of results"),
+         {styleSummary(sum)}
+         {logoImg}
+      )
+    )' |>
+      glue::glue() |>
+      as.character()
+  )
+}
+
+styleSummary <- function(sum) {
+  sum[1] <- gsub("(\\d+)", "**\\1**", sum[1])
+  sum[-1] <- paste0(" - **", gsub(": ", ":** ", sum[-1]))
+  purrr::map(sum, function(x){
+    glue::glue('shiny::p(shiny::markdown("{x}"))')
+  }) |> unlist() |> paste0(collapse = ", ")
+}

R/utilities.R

@@ -0,0 +1,7 @@
+validateSummary <- function(summary, result){
+  if (summary) {
+    sum <- utils::capture.output(summary(result), type = "message")
+  } else {
+    sum <- NULL
+  }
+}