Merge pull request #85 from GSK-Biostatistics/pass-data

Allow users to pass tfrmt/data as arguments
GSK-Biostatistics · Aug 2, 2024 · baa1573 · baa1573
2 parents fde77ac + f45cc14
commit baa1573
Show file tree

Hide file tree

Showing 8 changed files with 49 additions and 26 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -29,13 +29,12 @@ Description: Provides an interactive interface to the 'tfrmt' package. Users
 License: Apache License (>= 2)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Imports: 
     tfrmt (>= 0.1.0),
     shiny,
     shinyjs,
     dplyr,
-    tidyr,
     forcats,
     stringr,
     purrr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -12,7 +12,6 @@ import(shinyWidgets)
 import(sortable)
 import(stringr)
 import(tfrmt)
-import(tidyr)
 import(webshot2)
 importFrom(DT,DTOutput)
 importFrom(DT,datatable)

diff --git a/R/mod_load.R b/R/mod_load.R
@@ -12,17 +12,21 @@ load_ui <- function(id){
              wellPanel(
                div(style = "height: 650px",
                    h3("Table Metadata", class = "heading_style"),
-                   radioGroupButtons(ns("tfrmt_source"), label = NULL, choices = c("None", "Upload", "Example")),
-                   fluidRow(
-                     column(12,
-                            shinyjs::hidden(fileInput(ns("tfrmt_load"), buttonLabel = "Load JSON", label = NULL, accept = c(".json")))
+                   shinyjs::hidden(
+                     div(
+                     id = ns("tfrmt_opts"),
+                     radioGroupButtons(ns("tfrmt_source"), label = NULL, choices = c("None", "Upload", "Example")),
+                     fluidRow(
+                       column(12,
+                              shinyjs::hidden(fileInput(ns("tfrmt_load"), buttonLabel = "Load JSON", label = NULL, accept = c(".json")))
+                       )
+                     ),
+                     fluidRow(
+                       shinyjs::hidden(radioGroupButtons(ns("tfrmt_ex"),
+                                                         label = NULL,
+                                                         choices = c("demog","ae","efficacy")))
                      )
-                   ),
-                   fluidRow(
-                     shinyjs::hidden(radioGroupButtons(ns("tfrmt_ex"),
-                                                       label = NULL,
-                                                       choices = c("demog","ae","efficacy")))
-                   ),
+                   )),
                    fluidRow(
                      div(style = "height: 500px; overflow-y:auto; ",
                          shinycssloaders::withSpinner(
@@ -39,6 +43,9 @@ load_ui <- function(id){
              wellPanel(
                div(style = "height: 650px",
                    h3("Data", class = "heading_style"),
+                   shinyjs::hidden(
+                     div(
+                       id = ns("data_opts"),
                    radioGroupButtons(ns("data_source"), label = NULL,
                                      choices = c("Auto", "Upload", "Example"), selected = "Auto"),
                    fluidRow(
@@ -50,6 +57,8 @@ load_ui <- function(id){
                      conditionalPanel("input.data_source=='Example'",
                                       radioGroupButtons(ns("data_ex"), label = NULL, choices = c("demog","ae","labs","efficacy")),
                                       ns = ns)
+                   )
+                   )
                    ),
                    fluidRow(
                      div(style = "height: 550px;",
@@ -67,14 +76,18 @@ load_ui <- function(id){
   )
 }
 
-load_server <- function(id, mockmode){
+load_server <- function(id, tfrmt_in = reactive(NULL), data_in = reactive(NULL), mockmode){
 
     moduleServer(
       id,
       function(input, output, session) {
 
         ns <- session$ns
 
+        observe({
+          shinyjs::toggle("tfrmt_opts", condition = is.null(tfrmt_in()))
+          shinyjs::toggle("data_opts", condition = is.null(data_in()))
+        })
         observe({
           shinyjs::toggle("tfrmt_load", condition = input$tfrmt_source=="Upload")
           shinyjs::toggle("tfrmt_ex", condition = input$tfrmt_source=="Example")
@@ -122,10 +135,12 @@ load_server <- function(id, mockmode){
 
         })
 
+
         # tfrmt to be used in the app
         tfrmt_out <- reactive({
-
-          if (input$tfrmt_source=="None"){
+          if (!is.null(tfrmt_in())){
+            tfrmt_in()
+          } else if (input$tfrmt_source=="None"){
             prep_tfrmt_app(tfrmt())
           }  else if (input$tfrmt_source=="Example"){
             tfrmt_ex()
@@ -160,7 +175,9 @@ load_server <- function(id, mockmode){
         # data to be used in the app
         data_out <- reactive({
 
-          if (mockmode()==TRUE && input$data_source=="Auto"){
+          if (!is.null(data_in())){
+            data_in()
+          } else if (mockmode()==TRUE && input$data_source=="Auto"){
             NULL
           } else if (input$data_source=="Example"){
             data_ex()

diff --git a/R/tfrmtbuilder.R b/R/tfrmtbuilder.R
@@ -1,17 +1,20 @@
 #' Run tfrmt Builder Shiny App
 #'
+#' @param tfrmt tfrmt object to be loaded into app from R session. Defaults to `NULL`
+#' @param data data frame to be loaded into app from R session. Defaults to `NULL`
+#' @param mockmode Whether to initialize the app in mock mode. Defaults to `TRUE`
 #' @param run Boolean for whether the created object should be run directly. Set to `FALSE` for deployment
 #' @export
 #' @return Shiny app for creating and modifying tfrmt objects
 #' @examples
 #' if (interactive()){
 #'   tfrmtbuilder()
 #' }
-tfrmtbuilder <- function(run = TRUE){
+tfrmtbuilder <- function(tfrmt = NULL, data = NULL, mockmode = TRUE, run = TRUE){
   app <- shinyApp(
-    ui =  tfrmtbuilder_ui("tb"),
+    ui =  tfrmtbuilder_ui("tb", mockmode),
     server = function(input,output,session){
-      tfrmtbuilder_server("tb")
+      tfrmtbuilder_server("tb", tfrmt, data)
       session$onSessionEnded(function() {
         stopApp()
       })

diff --git a/R/tfrmtbuilder_server.R b/R/tfrmtbuilder_server.R
@@ -1,6 +1,6 @@
 #' Main server function
 #' @noRd
-tfrmtbuilder_server <- function(id) {
+tfrmtbuilder_server <- function(id, tfrmt, data) {
 
   moduleServer(
     id,
@@ -10,7 +10,7 @@ tfrmtbuilder_server <- function(id) {
       home_out <- home_server("home")
 
       # ui for loading
-      settings_orig <- load_server("load", reactive(input$mockmode))
+      settings_orig <- load_server("load", reactive(tfrmt), reactive(data), reactive(input$mockmode))
 
       # tfrmt data mapping - returns an updated tfrmt/data to be fed into the other modules
       settings <- datamapping_server("overview", settings_orig$data, settings_orig$tfrmt, settings_orig$mode)

diff --git a/R/tfrmtbuilder_ui.R b/R/tfrmtbuilder_ui.R
@@ -1,7 +1,7 @@
 #' Main UI function
 #' @noRd
 
-tfrmtbuilder_ui <- function(id){
+tfrmtbuilder_ui <- function(id, mockmode){
 
   ns <- NS(id)
 
@@ -92,7 +92,7 @@ tfrmtbuilder_ui <- function(id){
                              "header.append('<div style=\"float:right; margin-bottom:0; color:#fff;\">",
                                 "<div class=\"form-group shiny-input-container\" style = \"margin-bottom:0; color:#fff;\">",
                                     "<div class=\"pretty p-default p-switch p-fill\">",
-                                      "<input id=\"", ns("mockmode"), "\" type=\"checkbox\"/ checked=\"checked\">",
+                                      "<input id=\"", ns("mockmode"), "\" type=\"checkbox\"/ ", ifelse(mockmode, "checked=\"checked\">", ">"),
                                       "<div class=\"state p-danger\">",
                                         "<label>",
                                         "<span >Mock Mode</span>",

diff --git a/R/zzz.R b/R/zzz.R
@@ -2,7 +2,6 @@
 #' @import tfrmt
 #' @importFrom shinyjs useShinyjs enable disable addClass removeClass toggleState show hide toggle onclick toggleClass
 #' @import dplyr
-#' @import tidyr
 #' @import stringr
 #' @import purrr
 #' @importFrom DT datatable DTOutput renderDT

diff --git a/man/tfrmtbuilder.Rd b/man/tfrmtbuilder.Rd