experiments with teal. usage examples are sparse

inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 13276335
-bundleId: 9433115
+bundleId: 9436643
 url: https://agdamsbo.shinyapps.io/webResearch/
 version: 1

inst/apps/data_analysis/server.R

@@ -22,6 +22,8 @@ library(broom.helpers)
 library(REDCapCAST)
 library(easystats)
 library(patchwork)
+library(DHARMa)
+library(IDEAFilter)
 # if (!requireNamespace("webResearch")) {
 #   devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
 # }
@@ -123,13 +125,11 @@ server <- function(input, output, session) {
     return(out)
   })
 
-  # output$data.input <- shiny::renderTable({
-  #   utils::head(ds(), 20)
-  # })
-
-  output$data.input <- DT::renderDT({
-    ds()[base_vars()]
-  })
+  output$data.input <-
+    DT::renderDT({
+      shiny::req(input$file)
+      ds()[base_vars()]
+    })
 
   output$data.classes <- gt::render_gt({
     shiny::req(input$file)
@@ -234,7 +234,8 @@ server <- function(input, output, session) {
           })(),
         table2 = models |>
           purrr::map(regression_table) |>
-          tbl_merge()
+          tbl_merge(),
+        input = input
       )
 
       output$table1 <- gt::render_gt(

inst/apps/data_analysis/ui.R

@@ -1,5 +1,7 @@
 library(shiny)
 library(bslib)
+library(IDEAFilter)
+library(teal)
 requireNamespace("gt")
 
 panels <- list(
@@ -7,11 +9,11 @@ panels <- list(
     title = "Data overview",
     # shiny::uiOutput("data.classes"),
     # shiny::uiOutput("data.input"),
-    shiny::p("Classes of uploaded data"),
-    gt::gt_output("data.classes"),
+    # shiny::p("Classes of uploaded data"),
+    # gt::gt_output("data.classes"),
     shiny::p("Subset data"),
     DT::DTOutput("data.input")
-  ),
+      ),
   bslib::nav_panel(
     title = "Baseline characteristics",
     gt::gt_output(outputId = "table1")
@@ -158,8 +160,9 @@ ui <- bslib::page(
           icon = shiny::icon("pencil", lib = "glyphicon"),
           label_busy = "Working...",
           icon_busy = fontawesome::fa_i("arrows-rotate",
-                                        class = "fa-spin",
-                                        "aria-hidden" = "true"),
+            class = "fa-spin",
+            "aria-hidden" = "true"
+          ),
           type = "primary",
           auto_reset = TRUE
         ),

inst/apps/redcap_module/rc_modules.R

@@ -0,0 +1,103 @@
+m_redcap_readUI <- function(id) {
+  ns <- NS(id)
+  tagList(
+    shiny::textInput(
+      inputId = "uri",
+      label = "URI",
+      value = "https://redcap.your.institution/api/"
+    ),
+    shiny::textInput(
+      inputId = "api",
+      label = "API token",
+      value = ""
+    ),
+    shiny::tableOutput(outputId = ns("table")),
+    shiny::uiOutput(outputId = ns("fields")),
+    shiny::uiOutput(outputId = ns("instruments")),
+    shiny::uiOutput(outputId = ns("arms")),
+    shiny::actionButton(inputId = ns("submit"), "Submit")
+  )
+}
+
+m_redcap_readServer <- function(id) {
+  ns <- NS(id)
+  moduleServer(
+    id,
+    function(input, output, session) {
+      ns <- NS(id)
+      instr <- shiny::reactive({
+        shiny::req(input$api)
+        shiny::req(input$uri)
+        REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
+      })
+
+      output$instruments <- shiny::renderUI({
+        shiny::selectizeInput(
+          inputId = ns("instruments"),
+          selected = NULL,
+          label = "Instruments to include",
+          choices = instr()[["data"]][[1]],
+          multiple = TRUE
+        )
+      })
+
+      dd <- shiny::reactive({
+        shiny::req(input$api)
+        shiny::req(input$uri)
+        REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api)
+      })
+
+      output$fields <- shiny::renderUI({
+        shiny::selectizeInput(
+          inputId = ns("fields"),
+          selected = NULL,
+          label = "Fields/variables to include",
+          choices = dd()[["data"]][[1]],
+          multiple = TRUE
+        )
+      })
+
+      arms <- shiny::reactive({
+        shiny::req(input$api)
+        shiny::req(input$uri)
+        REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api)
+      })
+
+      output$arms <- shiny::renderUI({
+        shiny::selectizeInput(
+          inputId = ns("arms"),
+          selected = NULL,
+          label = "Arms/events to include",
+          choices = arms()[["data"]][[3]],
+          multiple = TRUE
+        )
+      })
+
+      output$table <- shiny::renderTable({
+        dd()[["data"]]
+      })
+
+      shiny::eventReactive(input$submit, {
+        shiny::req(input$api)
+        data <- REDCapCAST::read_redcap_tables(
+          uri=input$uri,
+          token = input$api,
+          fields = unique(c(dd()[["data"]][[1]][1],input$fields)),
+          forms = input$instruments,
+          events = input$arms,
+          raw_or_label = "both"
+        )
+
+        info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api)
+        filename <- info$data$project_title
+
+        data |>
+          REDCapCAST::redcap_wider() |>
+          REDCapCAST::suffix2label() |>
+          REDCapCAST::as_factor() |>
+          dplyr::select(-dplyr::ends_with("_complete")) |>
+          dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1]))
+      })
+    }
+  )
+}

inst/apps/redcap_module/server.R

@@ -0,0 +1,91 @@
+library(REDCapCAST)
+library(REDCapR)
+library(shiny)
+
+# ns <- shiny::NS(id)
+
+
+
+
+server <- function(input, output, session) {
+  # ns <- NS(id)
+
+  instr <- shiny::reactive({
+    shiny::req(input$api)
+    shiny::req(input$uri)
+    REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
+  })
+
+  output$instruments <- shiny::renderUI({
+    shiny::selectizeInput(
+      inputId = "instruments",
+      selected = NULL,
+      label = "Instruments to include",
+      choices = instr()[["data"]][[1]],
+      multiple = TRUE
+    )
+  })
+
+  dd <- shiny::reactive({
+    shiny::req(input$api)
+    shiny::req(input$uri)
+    REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api)
+  })
+
+  output$fields <- shiny::renderUI({
+    shiny::selectizeInput(
+      inputId = "fields",
+      selected = NULL,
+      label = "Fields/variables to include",
+      choices = dd()[["data"]][[1]],
+      multiple = TRUE
+    )
+  })
+
+  arms <- shiny::reactive({
+    shiny::req(input$api)
+    shiny::req(input$uri)
+    REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api)
+  })
+
+  output$arms <- shiny::renderUI({
+    shiny::selectizeInput(
+      inputId = "arms",
+      selected = NULL,
+      label = "Arms/events to include",
+      choices = arms()[["data"]][[3]],
+      multiple = TRUE
+    )
+  })
+
+  output$table <- shiny::renderTable({
+    dd()[["data"]]
+  })
+
+  data <- shiny::eventReactive(input$submit, {
+    browser()
+    shiny::req(input$api)
+    data <- REDCapCAST::read_redcap_tables(
+      uri = input$uri,
+      token = input$api,
+      fields = unique(c(dd()[["data"]][[1]][1], input$fields)),
+      forms = input$instruments,
+      events = input$arms,
+      raw_or_label = "both"
+    )
+
+    info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api)
+    filename <- info$data$project_title
+
+    data |>
+      REDCapCAST::redcap_wider() |>
+      REDCapCAST::suffix2label() |>
+      REDCapCAST::as_factor() |>
+      dplyr::select(-dplyr::ends_with("_complete")) |>
+      dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1]))
+  })
+
+  output$export <- DT::renderDT({
+    data()
+  })
+}

inst/apps/redcap_module/ui.R

@@ -0,0 +1,23 @@
+library(REDCapCAST)
+library(REDCapR)
+library(shiny)
+
+ui <- shiny::fluidPage(
+  # shiny::helpText("Submit URL and API token to browse download options"),
+  shiny::textInput(
+    inputId = "uri",
+    label = "URI",
+    value = "https://redcap.your.institution/api/"
+  ),
+  shiny::textInput(
+    inputId = "api",
+    label = "API token",
+    value = ""
+  ),
+  shiny::tableOutput("table"),
+  shiny::uiOutput("fields"),
+  shiny::uiOutput("instruments"),
+  shiny::uiOutput("arms"),
+  shiny::actionButton("submit", "Submit"),
+  DT::DTOutput("export")
+)

inst/apps/teal_test/app.R

@@ -0,0 +1,113 @@
+library(teal)
+library(teal.modules.general)
+library(teal.widgets)
+library(readr)
+library(MASS)
+library(stats)
+library(gtsummary)
+library(gt)
+library(openxlsx2)
+library(haven)
+library(readODS)
+library(shiny)
+library(bslib)
+library(assertthat)
+library(dplyr)
+library(quarto)
+library(here)
+library(broom)
+library(broom.helpers)
+library(REDCapCAST)
+library(easystats)
+library(patchwork)
+library(DHARMa)
+# library(IDEAFilter)
+# if (!requireNamespace("webResearch")) {
+#   devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
+# }
+# library(webResearch)
+
+if (file.exists(here::here("functions.R"))) {
+  source(here::here("functions.R"))
+}
+
+data_upload <- teal_data_module(
+  ui <- function(id) {
+    ns <- NS(id)
+    shiny::fluidPage(
+      shiny::radioButtons(
+        inputId = "import",
+        label = "Specify categorical variables?",
+        selected = "no",
+        inline = TRUE,
+        choices = list(
+          "Upload file" = "file",
+          "Export from REDCap" = "redcap"
+        )
+      ),
+      shiny::conditionalPanel(
+        condition = "input.import=='file'",
+      m_datafileUI(id)
+      ),
+      shiny::conditionalPanel(
+        condition = "input.import=='redcap'",
+        m_redcap_readUI(id)
+      )
+    )
+  },
+  server = function(id) {
+    ns <- NS(id)
+    moduleServer(id, function(input, output, session) {
+    shiny::reactive({
+    if (input$import == "file") {
+    m_datafileServer(id, output.format = "teal")
+      } else {
+        m_redcap_readServer(id, output.format = "teal")
+      }
+    })
+    })
+  }
+)
+
+tm_variable_browser_module <- tm_variable_browser(
+  label = "Variable browser",
+  ggplot2_args = ggplot2_args(
+    labs = list(subtitle = "Plot generated by Variable Browser Module")
+  )
+)
+
+
+filters <- teal::teal_slices()
+
+app_source <- "https://github.com/agdamsbo/webresearch"
+gh_issues_page <- "https://github.com/agdamsbo/webresearch/issues"
+
+header <- tags$span(
+  style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;",
+  tags$span("webResearch (teal)", style = "font-size: 30px;") # ,
+  # tags$span(
+  #   style = "display: flex; align-items: center;",
+  #   tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"),
+  #   tags$span(style = "font-size: 24px;", "agdamsbo")
+  # )
+)
+
+footer <- tags$p(
+  "This teal app was developed by AGDamsbo using the {teal} framework for Shiny apps:",
+  tags$a(href = app_source, target = "_blank", "Source Code"), ", ",
+  tags$a(href = gh_issues_page, target = "_blank", "Report Issues")
+)
+
+app <- init(
+  data = data_upload,
+  filter = filters,
+  modules = modules(
+    tm_data_table("Data Table"),
+    tm_variable_browser_module
+  ),
+  title = build_app_title("webResearch (teal)"),
+  header = header,
+  footer = footer
+)
+
+shinyApp(app$ui, app$server)