126 add support for shinylive

DESCRIPTION

@@ -15,29 +15,23 @@ Imports:
   data.table,
   dplyr,
   DT,
-  egg,
   glue,
   ggplot2  (>= 3.4),
   ggpubr,
-  grid,
   httr,
   jpeg,
   jsonlite,
   lubridate,
-  mailR,
   officer,
   openxlsx,
   png,
   purrr,
   R.utils,
-  randomcoloR,
-  RColorBrewer,
   RcppEigen,
   reactlog,
   rhandsontable,
   rvg,
   shiny,
-  shinyBS,
   shinydashboard,
   shinyjs,
   splines,
@@ -101,7 +95,6 @@ Collate:
   packages.R
   processdoseTable.R
   recoveryCalc.R
-  sendError.R
   server-helpers.R
   setLinetypes.R
   simCpCe.R

R/packages.R

@@ -1,38 +1,20 @@
-suppressWarnings(suppressPackageStartupMessages({
 library(shiny)
 library(shinyjs)
 library(shinydashboard)
-library(shinyBS)
 library(tryCatchLog)
 library(waiter)
-library(httr)
 library(ggpubr)
-library(mailR)
 library(ggplot2)
-library(grid)
-library(RColorBrewer)
-library(openxlsx)
 library(dplyr)
-library(officer)
-library(rvg)
 library(R.utils)
-library(jpeg)
-library(egg)
 library(ggpubr)
-library(splines)
-library(randomcoloR)
 library(rhandsontable)
 library(DT)
-library(config)
 library(purrr)
 library(data.table)
 library(stringi)
 library(png)
 library(jsonlite)
-# library(ggplotify)
-# library(facetscales)
 library(tidyr)
-#library(shinyWidgets)
 library(glue)
 library(lubridate)
-}))

R/sendSlide.R

@@ -1,3 +1,7 @@
+library(openxlsx)
+library(officer) # word and xls
+library(rvg) # vector graphics for word xls
+
 # Send a copy of the current plot to the designated recipient
 sendSlide <- function(
   values,
@@ -54,6 +58,249 @@ sendSlide <- function(
   return(emailData$pngfileName)
 }
 
+# Write a PPTX to the supplied filename
+generatePPTX <- function(values,
+                         recipient,
+                         plotObject,
+                         allResults,
+                         plotResults,
+                         isShinyLocal,
+                         slide,
+                         drugs,
+                         drugDefaults,
+                         file)
+{
+  tryCatchLog({
+    outputComments(paste("Generating PPTX"))
+
+    title = values$title
+    DT <- values$DT
+    url <- values$url
+
+    outputComments("In function sendSlide()")
+
+    TIMESTAMP <- format(Sys.time(), format = "%y%m%d-%H%M%S")
+    DATE <- format(Sys.Date(), "%m/%d/%y")
+    outputComments("reading Template.pptx")
+    PPTX <- read_pptx("misc/Template.pptx")
+    outputComments("Template.pptx loaded")
+    MASTER <- "Office Theme"
+
+    PPTX <- add_slide(PPTX, layout = "Title and Content", master = MASTER)
+    PPTX <- ph_with(PPTX, title, location = ph_location_type("title"))
+    PPTX <- ph_with(PPTX, dml(code = print(plotObject)), location = ph_location_type("body"))
+
+    PPTX <- ph_with(PPTX, DATE, location = ph_location_type ("dt"))
+    PPTX <- ph_with(PPTX, slide, location = ph_location_type ("sldNum"))
+    PPTX <- ph_with(PPTX, "From StanpumpR", location = ph_location_type ("ftr"))
+
+    outputComments("Saving PPTX")
+    print(PPTX, target = file)
+  })
+}
+
+# Write the spreadsheet to the supplied filename
+generateXLSX <- function(values,
+                         recipient,
+                         plotObject,
+                         allResults,
+                         plotResults,
+                         isShinyLocal,
+                         slide,
+                         drugs,
+                         drugDefaults,
+                         file)
+{
+  tryCatchLog({
+    outputComments(paste("Generating XLSX"))
+
+    title = values$title
+    DT <- values$DT
+    url <- values$url
+
+    outputComments("Fixing Units for export")
+    if (values$ageUnit == "1")
+    {
+      ageUnit <- "years"
+    } else {
+      ageUnit <- "months"
+    }
+
+    if (values$weightUnit == "1")
+    {
+      weightUnit <- "kilograms"
+    } else {
+      weightUnit <- "pounds"
+    }
+
+    if (values$heightUnit == "1")
+    {
+      heightUnit <- "cms"
+    } else {
+      heightUnit <- "inches"
+    }
+
+    outputComments("Creating workbook")
+    wb <- createWorkbook("SLS")
+    covariates <- data.frame(
+      Covariate = c(
+        "Age",
+        "Age Unit",
+        "Weight",
+        "Weight Unit",
+        "Height",
+        "Height Unit",
+        "Sex"
+      ),
+      Value = c(
+        values$age / values$ageUnit,
+        ageUnit,
+        values$weight / values$weightUnit,
+        weightUnit,
+        values$height / values$heightUnit,
+        heightUnit,
+        values$sex
+      ))
+    outputComments("Writing covariates")
+    addWorksheet(wb, "Covariates")
+    writeData(wb, sheet = 1, covariates)
+
+    outputComments("Writing dose table")
+    addWorksheet(wb, "Dose Table")
+    writeData(wb, sheet = 2, DT)
+
+    outputComments("Writing simulation results")
+    addWorksheet(wb, "Simulation Results")
+    writeData(wb, sheet = 3, allResults)
+
+    outputComments("Writing results for plotting")
+    addWorksheet(wb, "Results for Plotting")
+    writeData(wb, sheet = 4, plotResults)
+
+    outputComments("Writing PK parameters")
+    sheet = 5
+    for (drug in sort(unique(as.character(DT$Drug))))
+    {
+      cat("Drug = ", drug, "\n")
+      thisDrug <- which(drugDefaults$Drug == drug)
+      cat("thisDrug = ", thisDrug, "\n")
+
+      pkSets <- drugs[[drug]]$PK
+      parameters <-   as.data.frame(
+        cbind(
+          v1 = map_dbl(pkSets, "v1"),
+          v2 = map_dbl(pkSets, "v2"),
+          v3 = map_dbl(pkSets, "v3"),
+          cl1 = map_dbl(pkSets, "cl1"),
+          cl2 = map_dbl(pkSets, "cl2"),
+          cl3 = map_dbl(pkSets, "cl3"),
+          k10 = map_dbl(pkSets, "k10"),
+          k12 = map_dbl(pkSets, "k12"),
+          k13 = map_dbl(pkSets, "k13"),
+          k21 = map_dbl(pkSets, "k21"),
+          k31 = map_dbl(pkSets, "k31"),
+          lambda_1 = map_dbl(pkSets, "lambda_1"),
+          lambda_2 = map_dbl(pkSets, "lambda_2"),
+          lambda_3 = map_dbl(pkSets, "lambda_3"),
+          ke0 = map_dbl(pkSets, "ke0"),
+          p_coef_bolus_l1 = map_dbl(pkSets, "p_coef_bolus_l1"),
+          p_coef_bolus_l2 = map_dbl(pkSets, "p_coef_bolus_l2"),
+          p_coef_bolus_l3 = map_dbl(pkSets, "p_coef_bolus_l3"),
+          e_coef_bolus_l1 = map_dbl(pkSets, "e_coef_bolus_l1"),
+          e_coef_bolus_l2 = map_dbl(pkSets, "e_coef_bolus_l2"),
+          e_coef_bolus_l3 = map_dbl(pkSets, "e_coef_bolus_l3"),
+          e_coef_bolus_ke0 = map_dbl(pkSets, "e_coef_bolus_ke0"),
+          p_coef_infusion_l1 = map_dbl(pkSets, "p_coef_infusion_l1"),
+          p_coef_infusion_l2 = map_dbl(pkSets, "p_coef_infusion_l2"),
+          p_coef_infusion_l3 = map_dbl(pkSets, "p_coef_infusion_l3"),
+          e_coef_infusion_l1 = map_dbl(pkSets, "e_coef_infusion_l1"),
+          e_coef_infusion_l2 = map_dbl(pkSets, "e_coef_infusion_l2"),
+          e_coef_infusion_l3 = map_dbl(pkSets, "e_coef_infusion_l3"),
+          e_coef_infusion_ke0 = map_dbl(pkSets, "e_coef_infusion_ke0"),
+          ka_PO = map_dbl(pkSets, "ka_PO"),
+          bioavailability_PO = map_dbl(pkSets, "bioavailability_PO"),
+          tlag_PO = map_dbl(pkSets, "tlag_PO"),
+          ka_IM = map_dbl(pkSets, "ka_IM"),
+          bioavailability_IM = map_dbl(pkSets, "bioavailability_IM"),
+          tlag_IM = map_dbl(pkSets, "tlag_IM"),
+          ka_IN = map_dbl(pkSets, "ka_IN"),
+          bioavailability_IN = map_dbl(pkSets, "bioavailability_IN"),
+          tlag_IN = map_dbl(pkSets, "tlag_IN"),
+          p_coef_PO_l1 = map_dbl(pkSets, "p_coef_PO_l1"),
+          p_coef_PO_l2 = map_dbl(pkSets, "p_coef_PO_l2"),
+          p_coef_PO_l3 = map_dbl(pkSets, "p_coef_PO_l3"),
+          p_coef_PO_ka = map_dbl(pkSets, "p_coef_PO_ka"),
+          e_coef_PO_l1 = map_dbl(pkSets, "e_coef_PO_l1"),
+          e_coef_PO_l2 = map_dbl(pkSets, "e_coef_PO_l2"),
+          e_coef_PO_l3 = map_dbl(pkSets, "e_coef_PO_l3"),
+          e_coef_PO_ke0 = map_dbl(pkSets, "e_coef_PO_ke0"),
+          e_coef_PO_ka = map_dbl(pkSets, "e_coef_PO_ka"),
+          p_coef_IM_l1 = map_dbl(pkSets, "p_coef_IM_l1"),
+          p_coef_IM_l2 = map_dbl(pkSets, "p_coef_IM_l2"),
+          p_coef_IM_l3 = map_dbl(pkSets, "p_coef_IM_l3"),
+          p_coef_IM_ka = map_dbl(pkSets, "p_coef_IM_ka"),
+          e_coef_IM_l1 = map_dbl(pkSets, "e_coef_IM_l1"),
+          e_coef_IM_l2 = map_dbl(pkSets, "e_coef_IM_l2"),
+          e_coef_IM_l3 = map_dbl(pkSets, "e_coef_IM_l3"),
+          e_coef_IM_ke0 = map_dbl(pkSets, "e_coef_IM_ke0"),
+          e_coef_IM_ka = map_dbl(pkSets, "e_coef_IM_ka"),
+          p_coef_IN_l1 = map_dbl(pkSets, "p_coef_IN_l1"),
+          p_coef_IN_l2 = map_dbl(pkSets, "p_coef_IN_l2"),
+          p_coef_IN_l3 = map_dbl(pkSets, "p_coef_IN_l3"),
+          p_coef_IN_ka = map_dbl(pkSets, "p_coef_IN_ka"),
+          e_coef_IN_l1 = map_dbl(pkSets, "e_coef_IN_l1"),
+          e_coef_IN_l2 = map_dbl(pkSets, "e_coef_IN_l2"),
+          e_coef_IN_l3 = map_dbl(pkSets, "e_coef_IN_l3"),
+          e_coef_IN_ke0 = map_dbl(pkSets, "e_coef_IN_ke0"),
+          e_coef_IN_ka = map_dbl(pkSets, "e_coef_IN_ka")
+        ))
+      parameters <- t(parameters)
+      addWorksheet(wb, paste(drug,"PK"))
+      writeData(wb, sheet = sheet, parameters, rowNames=TRUE)
+      sheet <- sheet + 1
+    }
+
+    outputComments("Saving XLSX")
+    saveWorkbook(wb, file, overwrite = TRUE)
+  })
+}
+
+# Write the spreadsheet to the supplied filename
+generatePNG <- function(values,
+                         recipient,
+                         plotObject,
+                         allResults,
+                         plotResults,
+                         isShinyLocal,
+                         slide,
+                         drugs,
+                         drugDefaults,
+                         file)
+{
+  tryCatchLog({
+    outputComments(paste("Generating PNG export"))
+
+    title = values$title
+    DT <- values$DT
+    url <- values$url
+
+    # does not rely on ggpubr (can be removed)
+
+    plotObject + labs(title = "", caption = NULL, x = NULL, y = NULL) +
+    theme(strip.text.y = element_text(size = 6, angle = 180),
+          axis.text.y = element_text(size = 6),
+          axis.text.x = element_text(size = 4),
+          legend.background = element_blank(),
+          legend.box.background = element_blank(),
+          legend.key = element_blank(),
+          legend.text=element_text(size=4),
+          legend.title = element_text(color="darkblue", size=6, face="bold")
+    )
+
+    ggsave(file, device = "png")
+  })
+}
+
 generateEmail <- function(values, recipient, plotObject, allResults, plotResults, slide, drugs, drugDefaults) {
   title = values$title
   DT <- values$DT

global.R

@@ -154,3 +154,13 @@ bookmarksToExclude <- c(
   "newEndCe",
   "hoverInfo"
 )
+
+# shinylive workaround
+# downloadButton() does not work in Chromium-based browsers
+# Workaround for Chromium Issue 468227
+# https://github.com/posit-dev/r-shinylive/issues/74
+downloadButton <- function(...) {
+  tag <- shiny::downloadButton(...)
+  tag$attribs$download <- NULL
+  tag
+}