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){
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
hostUrl: https://api.shinyapps.io/v1
appId: 13276335
bundleId: 9397035
bundleId:
url: https://agdamsbo.shinyapps.io/webResearch/
version: 1

View file

@ -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 {

View file

@ -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 ----