From 069d6d79fae2d0e709a10c3f99475a7fa88106b5 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Fri, 22 Nov 2024 11:48:08 +0100
Subject: [PATCH] added option to specify categorical variables and print input
 classes

---
 R/helpers.R                                   | 22 ++++++++++++
 .../shinyapps.io/agdamsbo/webResearch.dcf     |  2 +-
 inst/apps/data_analysis/server.R              | 34 +++++++++++++++++--
 inst/apps/data_analysis/ui.R                  | 21 +++++++++++-
 4 files changed, 75 insertions(+), 4 deletions(-)

diff --git a/R/helpers.R b/R/helpers.R
index 2e814fb..14cb1fb 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -94,3 +94,25 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
 argsstring2list <- function(string){
   eval(parse(text = paste0("list(", string, ")")))
 }
+
+
+#' Factorize variables in data.frame
+#'
+#' @param data data.frame
+#' @param vars variables to force factorize
+#'
+#' @return data.frame
+#' @export
+factorize <- function(data,vars){
+  if (!is.null(vars)) {
+    data |>
+      dplyr::mutate(
+        dplyr::across(
+          dplyr::all_of(vars),
+          REDCapCAST::as_factor
+        )
+      )
+  } else {
+    data
+  }
+}
diff --git a/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf b/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf
index fdfc73c..e27fef2 100644
--- a/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf
+++ b/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: 9397035
+bundleId:
 url: https://agdamsbo.shinyapps.io/webResearch/
 version: 1
diff --git a/inst/apps/data_analysis/server.R b/inst/apps/data_analysis/server.R
index 3aa5379..d30f23c 100644
--- a/inst/apps/data_analysis/server.R
+++ b/inst/apps/data_analysis/server.R
@@ -19,6 +19,10 @@ library(quarto)
 library(here)
 library(broom)
 library(broom.helpers)
+if (!requireNamespace("REDCapCAST")) {
+  devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never")
+}
+library(REDCapCAST)
 if (!requireNamespace("webResearch")) {
   devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
 }
@@ -34,19 +38,27 @@ server <- function(input, output, session) {
     ds = NULL,
     input = exists("webResearch_data"),
     local_temp = NULL,
-    quarto = NULL
+    quarto = NULL,
+    test = "no"
   )
 
+  test_data <- shiny::eventReactive(input$test_data, {
+    v$test <- "test"
+  })
+
   ds <- shiny::reactive({
     # input$file1 will be NULL initially. After the user selects
     # and uploads a file, head of that data file by default,
     # or all rows if selected, will be shown.
     if (v$input) {
       out <- webResearch_data
+    } else if (v$test=="test") {
+      out <- gtsummary::trial
     } else {
       shiny::req(input$file)
       out <- read_input(input$file$datapath)
     }
+
     v$ds <- "present"
     return(out)
   })
@@ -71,8 +83,24 @@ server <- function(input, output, session) {
     )
   })
 
+  output$factor_vars <- shiny::renderUI({
+    selectizeInput(
+      inputId = "factor_vars",
+      selected = colnames(ds())[sapply(ds(), is.factor)],
+      label = "Covariables to format as categorical",
+      choices = colnames(ds())[sapply(ds(), is.character)],
+      multiple = TRUE
+    )
+  })
+
   output$data.input <- shiny::renderTable({
-    ds()
+    utils::head(ds(),20)
+  })
+
+  output$data.classes <- shiny::renderTable({
+    shiny::req(input$file)
+    data.frame(matrix(sapply(ds(),\(.x){class(.x)[1]}),nrow=1)) |>
+      stats::setNames(names(ds()))
   })
 
   shiny::observeEvent(
@@ -86,6 +114,8 @@ server <- function(input, output, session) {
       data <- ds() |>
         dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
 
+      data <- data |> factorize(vars = input$factor_vars)
+
       if (is.factor(data[[input$outcome_var]])) {
         by.var <- input$outcome_var
       } else {
diff --git a/inst/apps/data_analysis/ui.R b/inst/apps/data_analysis/ui.R
index 282dd10..3ee8968 100644
--- a/inst/apps/data_analysis/ui.R
+++ b/inst/apps/data_analysis/ui.R
@@ -32,6 +32,7 @@ cards <- list(
 panels <- list(
   bslib::nav_panel(
     title = "Data overview",
+    shiny::uiOutput("data.classes"),
     shiny::uiOutput("data.input")
   ),
   bslib::nav_panel(
@@ -54,6 +55,7 @@ ui <- bslib::page(
 
     # sidebarPanel(
     sidebar = bslib::sidebar(
+      width = 300,
       open = "open",
       shiny::h4("Upload your dataset"),
       shiny::conditionalPanel(
@@ -76,7 +78,10 @@ ui <- bslib::page(
             ".ods",
             ".rds"
           )
-        )
+        ),
+        # Does not work??
+      #   shiny::actionButton(inputId = "test_data",
+      #                       label = "Load test data", class = "btn-primary")
       ),
       shiny::conditionalPanel(
         condition = "output.uploaded=='yes'",
@@ -125,6 +130,20 @@ ui <- bslib::page(
           condition = "input.all==1",
           shiny::uiOutput("include_vars")
         ),
+        shiny::radioButtons(
+          inputId = "specify_factors",
+          label = "Specify categorical variables?",
+          selected = "no",
+          inline = TRUE,
+          choices = list(
+            "No" = "no",
+            "Yes" = "yes"
+          )
+        ),
+        shiny::conditionalPanel(
+          condition = "input.specify_factors=='yes'",
+          shiny::uiOutput("factor_vars")
+        ),
         shiny::actionButton("load", "Analyse", class = "btn-primary"),
         #
         # # Horizontal line ----