Merge pull request #27 from RConsortium/golem_app

Golem version and pkglite bundle

.Rbuildignore

@@ -13,4 +13,12 @@
 ^readme.md$
 ^adam$
 ^vignettes$
-^\.github$
+^\.github$
+^data-raw$
+dev_history.R
+^dev$
+$run_dev.*
+^.devcontainer$
+^app\.R$
+^rsconnect$
+^LICENSE\.md$

.gitignore

@@ -5,5 +5,5 @@
 pilot1wrappers.Rcheck/
 pilot1wrappers*.tar.gz
 pilot1wrappers*.tgz
-docs
-inst/doc
+inst/doc
+tmp/*

DESCRIPTION

@@ -1,22 +1,51 @@
 Package: pilot2wrappers
 Type: Package
 Title: R Consortium R Submission Pilot 2
-Version: 0.0.0.9000
+Version: 0.2.0
 Authors@R: c(
-        person("xxx", email = "[email protected]", role = c("aut", "cre")),
+        person("Eric", "Nantz", email = "[email protected]", role = c("aut", "cre")),
+        person("Yilong", "Zhang", role = c("aut")),
+        person("Heng", "Wang", role = c("aut")),
+        person("Gregory", "Chen", role = c("aut")),
+        person("Eli", "Miller", role = c("aut")),
+        person("Ning", "Leng", role = c("aut")),
         person("copyright", role = c("cph"))
        )
 Description: Insert Package Description. 
 Depends: R (>= 3.6.0)
-License: file LICENSE
+License: GPL (>= 3)
 Imports: 
+    config (>= 0.3.1),
+    golem (>= 0.3.1),
+    teal,
+    teal.data,
+    shiny (>= 1.7.1),
+    rtables,
+    haven,
+    dplyr,
+    Tplyr,
+    tidyr,
+    glue,
+    stringr,
+    huxtable,
+    ggplot2,
+    cowplot,
+    visR,
+    emmeans,
+    reactable,
+    magrittr,
+    tibble,
+    utils,
+    htmltools,
+    pkgload,
+    tippy,
+    markdown
 Suggests: 
     devtools,
     testthat,
     knitr,
     rmarkdown,
-    covr,
-    dplyr
+    covr
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)  

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%>%")
 export(efficacy_models)
 export(fmt_ci)
 export(fmt_est)
@@ -8,15 +9,56 @@ export(fmt_pval)
 export(nest_rowlabels)
 export(num_fmt)
 export(pad_row)
+export(run_app)
+export(tooltip_text)
+import(Tplyr)
+import(ggplot2)
+import(rtables)
+import(tippy)
 importFrom(dplyr,across)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
+importFrom(dplyr,case_when)
 importFrom(dplyr,distinct)
+importFrom(dplyr,filter)
+importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
+importFrom(dplyr,n)
 importFrom(dplyr,rename)
+importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
 importFrom(dplyr,starts_with)
+importFrom(dplyr,summarise)
 importFrom(glue,glue)
+importFrom(golem,with_golem_options)
+importFrom(graphics,pairs)
+importFrom(magrittr,"%>%")
+importFrom(reactable,colDef)
+importFrom(reactable,colGroup)
+importFrom(reactable,reactable)
+importFrom(reactable,renderReactable)
+importFrom(shiny,NS)
+importFrom(shiny,column)
+importFrom(shiny,fluidPage)
+importFrom(shiny,fluidRow)
+importFrom(shiny,h4)
+importFrom(shiny,h6)
+importFrom(shiny,plotOutput)
+importFrom(shiny,reactive)
+importFrom(shiny,renderPlot)
+importFrom(shiny,renderUI)
+importFrom(shiny,shinyApp)
+importFrom(shiny,tagList)
+importFrom(shiny,tags)
+importFrom(shiny,uiOutput)
+importFrom(stats,confint)
+importFrom(stats,drop1)
+importFrom(stats,lm)
+importFrom(stats,median)
+importFrom(stats,sd)
 importFrom(stringr,str_pad)
+importFrom(teal,init)
+importFrom(teal,module)
+importFrom(teal,modules)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,replace_na)

NEWS.md

@@ -1,3 +1,8 @@
+# pilot2 0.2.0
+
+- Convert Shiny application to a package structure using [`{golem}`](https://thinkr-open.github.io/golem).
+- Incorporate the open-source [`{teal}`](https://insightsengineering.github.io/teal/main) package inside application to provide dynamic filters in all modules
+
 # pilot2 0.1.0
 
 - Initial version.

R/Tplyr_helpers.R

@@ -6,8 +6,7 @@
 #'
 #' @param .dat Input data set - should come from a built Tplyr table. 
 #'
-#' @importFrom dplyr distinct rename bind_rows mutate select arrange across
-#' @importFrom dplyr starts_with
+#' @importFrom dplyr distinct rename bind_rows mutate select arrange across starts_with
 #' @importFrom tidyr replace_na
 #' 
 #' @return data.frame with row labels nested

R/app_config.R

@@ -0,0 +1,43 @@
+#' Access files in the current app
+#' 
+#' NOTE: If you manually change your package name in the DESCRIPTION, 
+#' don't forget to change it here too, and in the config file. 
+#' For a safer name change mechanism, use the `golem::set_golem_name()` function.
+#' 
+#' @param ... character vectors, specifying subdirectory and file(s) 
+#' within your package. The default, none, returns the root of the app. 
+#' 
+#' @noRd
+app_sys <- function(...){
+  system.file(..., package = "pilot2wrappers")
+}
+
+
+#' Read App Config
+#' 
+#' @param value Value to retrieve from the config file. 
+#' @param config GOLEM_CONFIG_ACTIVE value. If unset, R_CONFIG_ACTIVE. 
+#' If unset, "default".
+#' @param use_parent Logical, scan the parent directory for config file.
+#' 
+#' @noRd
+get_golem_config <- function(
+  value, 
+  config = Sys.getenv(
+    "GOLEM_CONFIG_ACTIVE", 
+    Sys.getenv(
+      "R_CONFIG_ACTIVE", 
+      "default"
+    )
+  ), 
+  use_parent = TRUE
+){
+  config::get(
+    value = value, 
+    config = config, 
+    # Modify this if your config file is somewhere else:
+    file = app_sys("golem-config.yml"), 
+    use_parent = use_parent
+  )
+}
+

R/app_teal.R

@@ -0,0 +1,71 @@
+#' @importFrom teal init modules module
+#' @importFrom shiny tags
+create_teal <- function() {
+  adsl  <- haven::read_xpt(app_sys("adam", "adsl.xpt"))
+  adsl <- adsl %>%
+    dplyr::mutate(
+      TRT01P = factor(TRT01P, levels = c("Placebo", "Xanomeline Low Dose",  "Xanomeline High Dose")),
+      AGEGR1 = factor(AGEGR1, levels = c("<65", "65-80", ">80")),
+      RACE = factor(RACE, levels = c("WHITE", "BLACK OR AFRICAN AMERICAN", "AMERICAN INDIAN OR ALASKA NATIVE"))
+    )
+  adas  <- haven::read_xpt(app_sys("adam", "adadas.xpt")) %>%
+    dplyr::filter(
+      EFFFL == "Y",
+      ITTFL == 'Y',
+      PARAMCD == 'ACTOT',
+      ANL01FL == 'Y'
+    )
+  adtte <- haven::read_xpt(app_sys("adam", "adtte.xpt")) %>%
+    dplyr::filter(PARAMCD == "TTDE")
+  adlb <- haven::read_xpt(app_sys("adam", "adlbc.xpt")) %>%
+    subset(TRTPN %in% c(0, 81) & PARAMCD == "GLUC" & !is.na(AVISITN)) %>%
+    dplyr::mutate(TRTPN = ifelse(TRTPN == 0, 99, TRTPN)) # change treatment order for pairwise comparison
+
+  app <- teal::init(
+    data = teal.data::cdisc_data(
+      teal.data::cdisc_dataset("ADSL", adsl),
+      teal.data::cdisc_dataset("ADAS", adas, keys = c("STUDYID", "USUBJID", "PARAMCD", "AVISIT", "QSSEQ")),
+      teal.data::cdisc_dataset("ADTTE", adtte),
+      teal.data::cdisc_dataset("ADLB", adlb)
+    ),
+    modules = modules(
+      module(
+        label = "App Information",
+        server = function(input, output, session, datasets){},
+        ui = function(id, ...) {
+          shiny::includeMarkdown(app_sys("app", "docs", "about.md"))
+        },
+        filters = NULL
+      ),
+      module(
+        label = "Demographic Table",
+        ui = ui_t_demographic,
+        server = srv_t_demographic,
+        filters = "ADSL"
+      ),
+      module(
+        label = "KM plot for TTDE",
+        ui = ui_g_kmplot,
+        server = srv_g_kmplot,
+        filters = c("ADSL", "ADTTE")
+      ),
+      module(
+        label = "Primary Table",
+        ui = ui_t_primary,
+        server = srv_t_primary,
+        filters = c("ADSL", "ADAS")
+      ),
+      module(
+        label = "Efficacy Table",
+        ui = ui_t_efficacy,
+        server = srv_t_efficacy,
+        filters = c("ADSL", "ADLB")
+      )
+
+    ),
+    header = "Pilot2 app (draft)",
+    footer = tags$p(class="text-muted", "Source: R Consortium")
+  )
+
+  return(app)
+}

R/eff_models.R

@@ -12,10 +12,12 @@
 #' @param wk Visit to be modeled
 #'
 #' @return Formatted dataframe
+#' 
+#' @importFrom dplyr filter mutate case_when rowwise select bind_rows arrange
+#' @importFrom stats drop1 confint
 #' @export
 #'
 efficacy_models <- function(data, var=NULL, wk=NULL) {
-
   # Need to set contrasts to work for Type III SS. See analysis results metadata for
   # table 14-3.01. Reference for R here: https://www.r-bloggers.com/anova-%E2%80%93-type-iiiiii-ss-explained/
   op <- options(contrasts = c("contr.sum","contr.poly"))
@@ -52,7 +54,7 @@ efficacy_models <- function(data, var=NULL, wk=NULL) {
   ancova <- drop1(model1, .~., test="F")
 
   # Pull it out into a table
-  sect1 <- tibble(row_label=c('p-value(Dose Response) [1][2]'),
+  sect1 <- tibble::tibble(row_label=c('p-value(Dose Response) [1][2]'),
                   `81` = c(num_fmt(ancova[2, 'Pr(>F)'], int_len=4, digits=3, size=12))
   ) %>%
     pad_row()
@@ -74,23 +76,23 @@ efficacy_models <- function(data, var=NULL, wk=NULL) {
   cntrst_ci <- confint(cntrst_p)
 
   # merge and convert into dataframe
-  pw_data <- as_tibble(summary(cntrst_p)) %>%
-    merge(as_tibble(cntrst_ci)) %>%
+  pw_data <- tibble::as_tibble(summary(cntrst_p)) %>%
+    merge(tibble::as_tibble(cntrst_ci)) %>%
     rowwise() %>%
     # Create the display strings
     mutate(
       p = num_fmt(p.value, int_len=4, digits=3, size=12),
       diff_se = as.character(
-        glue('{num_fmt(estimate, int_len=2, digits=1, size=4)} ({num_fmt(SE, int_len=1, digits=2, size=4)})')
+        glue::glue('{num_fmt(estimate, int_len=2, digits=1, size=4)} ({num_fmt(SE, int_len=1, digits=2, size=4)})')
       ),
       ci = as.character(
-        glue('({num_fmt(lower.CL, int_len=2, digits=1, size=4)};{num_fmt(upper.CL, int_len=1, digits=1, size=3)})')
+        glue::glue('({num_fmt(lower.CL, int_len=2, digits=1, size=4)};{num_fmt(upper.CL, int_len=1, digits=1, size=3)})')
       )
     ) %>%
     # Clean out the numeric variables
     select(contrast, p, diff_se, ci) %>%
     # Transpose
-    pivot_longer(c('p', 'diff_se', 'ci'), names_to = 'row_label')
+    tidyr::pivot_longer(c('p', 'diff_se', 'ci'), names_to = 'row_label')
 
   # Subset Xan_Lo - Pbo into table variables
   xan_lo <- pw_data %>%

R/globals.R

@@ -0,0 +1,15 @@
+utils::globalVariables(
+  c(
+    "TRT01P", "AGEGR1", "RACE", "EFFFL", "ITTFL", "PARAMCD", "ANL01FL", "TRTPN", 
+    "AVISITN", "p.value", "contrast", "p", "diff_se",
+    "ci", "value", "ord", "row_label", "54", "81", "row_label1", "ord_layer_index", "row_label2", "ord_layer_1", 
+    "ord_layer_2", "TRTP", "USUBJID",
+    "sd", "median", "AVAL", "CHG", ".", "TRTP", "BASE",
+    "SE", "df", "N", "mean_bl",
+    "sd_bl", "sd", "mean_chg", "sd_chg", 
+    "emmean", "lower.CL", "upper.CL", "Trt",
+    "CI", "estimate", "lower", "upper", "p.value",
+    "comp", "SAFFL", "STUDYID", "USUBJID", "TRT01A",
+    "AVAL", "CNSR", "PARAM", "PARAMCD", "anl"
+  )
+)

R/helpers.R

@@ -49,4 +49,15 @@ num_fmt <- Vectorize(function(var, digits=0, size=10, int_len=3) {
     # Overall width padding
     side='right', size
   ))
-})
+})
+
+#' style a tooltip produced by the tippy package
+#' 
+#' @param text String for text in tooltip
+#' @param font_size Font size (in pixels)
+#'
+#' @return HTML with font size applied
+#' @export
+tooltip_text <- function(text, font_size = 16) {
+  glue::glue("<span style='font-size:{font_size}px;'>{text}<span>")
+}

R/run_app.R

@@ -0,0 +1,29 @@
+#' Run the Shiny Application
+#'
+#' @param ... arguments to pass to golem_opts. 
+#' See `?golem::get_golem_options` for more details.
+#' @inheritParams shiny::shinyApp
+#'
+#' @export
+#' @importFrom shiny shinyApp
+#' @importFrom golem with_golem_options 
+run_app <- function(
+  onStart = NULL,
+  options = list(), 
+  enableBookmarking = NULL,
+  uiPattern = "/",
+  ...
+) {
+  app <- create_teal()
+  with_golem_options(
+    app = shinyApp(
+      ui = app$ui,
+      server = app$server,
+      onStart = onStart,
+      options = options, 
+      enableBookmarking = enableBookmarking, 
+      uiPattern = uiPattern
+    ), 
+    golem_opts = list(...)
+  )
+}