added option to specify categorical variables and print input classes

This commit is contained in:
Andreas Gammelgaard Damsbo 2024-11-22 11:48:08 +01:00
parent 9c0cb53862
commit 069d6d79fa
No known key found for this signature in database
4 changed files with 75 additions and 4 deletions

View file

@ -94,3 +94,25 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
argsstring2list <- function(string){ argsstring2list <- function(string){
eval(parse(text = paste0("list(", 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
}
}

View file

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

View file

@ -19,6 +19,10 @@ library(quarto)
library(here) library(here)
library(broom) library(broom)
library(broom.helpers) library(broom.helpers)
if (!requireNamespace("REDCapCAST")) {
devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never")
}
library(REDCapCAST)
if (!requireNamespace("webResearch")) { if (!requireNamespace("webResearch")) {
devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never") devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
} }
@ -34,19 +38,27 @@ server <- function(input, output, session) {
ds = NULL, ds = NULL,
input = exists("webResearch_data"), input = exists("webResearch_data"),
local_temp = NULL, local_temp = NULL,
quarto = NULL quarto = NULL,
test = "no"
) )
test_data <- shiny::eventReactive(input$test_data, {
v$test <- "test"
})
ds <- shiny::reactive({ ds <- shiny::reactive({
# input$file1 will be NULL initially. After the user selects # input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default, # and uploads a file, head of that data file by default,
# or all rows if selected, will be shown. # or all rows if selected, will be shown.
if (v$input) { if (v$input) {
out <- webResearch_data out <- webResearch_data
} else if (v$test=="test") {
out <- gtsummary::trial
} else { } else {
shiny::req(input$file) shiny::req(input$file)
out <- read_input(input$file$datapath) out <- read_input(input$file$datapath)
} }
v$ds <- "present" v$ds <- "present"
return(out) 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({ 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( shiny::observeEvent(
@ -86,6 +114,8 @@ server <- function(input, output, session) {
data <- ds() |> data <- ds() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
data <- data |> factorize(vars = input$factor_vars)
if (is.factor(data[[input$outcome_var]])) { if (is.factor(data[[input$outcome_var]])) {
by.var <- input$outcome_var by.var <- input$outcome_var
} else { } else {

View file

@ -32,6 +32,7 @@ cards <- list(
panels <- list( panels <- list(
bslib::nav_panel( bslib::nav_panel(
title = "Data overview", title = "Data overview",
shiny::uiOutput("data.classes"),
shiny::uiOutput("data.input") shiny::uiOutput("data.input")
), ),
bslib::nav_panel( bslib::nav_panel(
@ -54,6 +55,7 @@ ui <- bslib::page(
# sidebarPanel( # sidebarPanel(
sidebar = bslib::sidebar( sidebar = bslib::sidebar(
width = 300,
open = "open", open = "open",
shiny::h4("Upload your dataset"), shiny::h4("Upload your dataset"),
shiny::conditionalPanel( shiny::conditionalPanel(
@ -76,7 +78,10 @@ ui <- bslib::page(
".ods", ".ods",
".rds" ".rds"
) )
) ),
# Does not work??
# shiny::actionButton(inputId = "test_data",
# label = "Load test data", class = "btn-primary")
), ),
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "output.uploaded=='yes'", condition = "output.uploaded=='yes'",
@ -125,6 +130,20 @@ ui <- bslib::page(
condition = "input.all==1", condition = "input.all==1",
shiny::uiOutput("include_vars") 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"), shiny::actionButton("load", "Analyse", class = "btn-primary"),
# #
# # Horizontal line ---- # # Horizontal line ----