diff --git a/R/regression_model.R b/R/regression_model.R index bc718b8..62eb010 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -15,7 +15,7 @@ #' #' @examples #' gtsummary::trial |> -#' regression_model(outcome.str = "age") +#' regression_model(outcome.str = "age",) #' gtsummary::trial |> #' regression_model( #' outcome.str = "age", @@ -35,7 +35,11 @@ regression_model <- function(data, args.list = NULL, fun = NULL, vars = NULL) { - if (!is.null(formula.str) | formula.str != "") { + if (formula.str==""){ + formula.str <- NULL + } + + if (!is.null(formula.str)) { formula.str <- glue::glue(formula.str) } else { assertthat::assert_that(outcome.str %in% names(data), diff --git a/app/functions.R b/app/functions.R index 2541691..52341bb 100644 --- a/app/functions.R +++ b/app/functions.R @@ -131,6 +131,19 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { + + + + + + + + +argsstring2list <- function(string){ + eval(parse(text = paste0("list(", string, ")"))) +} + + ######## #### Current file: R//regression_model.R ######## @@ -172,6 +185,10 @@ regression_model <- function(data, args.list = NULL, fun = NULL, vars = NULL) { + if (formula.str==""){ + formula.str <- NULL + } + if (!is.null(formula.str)) { formula.str <- glue::glue(formula.str) } else { @@ -181,10 +198,10 @@ regression_model <- function(data, formula.str <- glue::glue("{outcome.str}~.") if (!is.null(vars)) { - if (outcome.str %in% vars){ + if (outcome.str %in% vars) { vars <- vars[vars %in% outcome.str] } - data <- data |> dplyr::select(dplyr::all_of(c(vars,outcome.str))) + data <- data |> dplyr::select(dplyr::all_of(c(vars, outcome.str))) } } @@ -194,16 +211,15 @@ regression_model <- function(data, # browser() if (auto.mode) { - if (is.numeric(data[[outcome.str]])){ + if (is.numeric(data[[outcome.str]])) { fun <- "stats::lm" - } else if (is.factor(data[[outcome.str]])){ - if (length(levels(data[[outcome.str]]))==2){ + } else if (is.factor(data[[outcome.str]])) { + if (length(levels(data[[outcome.str]])) == 2) { fun <- "stats::glm" - args.list = list(family = binomial(link = "logit")) - - } else if (length(levels(data[[outcome.str]]))>2){ + args.list <- list(family = binomial(link = "logit")) + } else if (length(levels(data[[outcome.str]])) > 2) { fun <- "MASS::polr" - args.list = list( + args.list <- list( Hess = TRUE, method = "logistic" ) @@ -213,7 +229,6 @@ regression_model <- function(data, } else { stop("Output variable should be either numeric or factor for auto.mode") } - } assertthat::assert_that("character" %in% class(fun), diff --git a/app/server.R b/app/server.R index 995ad11..2ce9eae 100644 --- a/app/server.R +++ b/app/server.R @@ -1,5 +1,5 @@ # project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R")) -# source(here::here("functions.R")) +# source(here::here("app/functions.R")) source("https://raw.githubusercontent.com/agdamsbo/webResearch/refs/heads/main/app/functions.R") @@ -43,7 +43,7 @@ server <- function(input, output, session) { inputId = "include_vars", selected = NULL, label = "Covariables to include", - choices = colnames(ds()), + choices = colnames(ds())[-match(input$outcome_var, colnames(ds()))], multiple = TRUE ) }) @@ -70,12 +70,25 @@ server <- function(input, output, session) { { shiny::req(input$outcome_var) - v$list <- ds() |> - (\(data){ - # browser() - list( + # Assumes all character variables can be formatted as factors + data <- ds() |> + dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) + + if (is.factor(data[[input$outcome_var]])) { + by.var <- input$outcome_var + } else { + by.var <- NULL + } + + v$list <- list( data = data, - table1 = data |> baseline_table(), + table1 = data |> + baseline_table( + fun.args = + list( + by = by.var + ) + ), table2 = data |> regression_model( outcome.str = input$outcome_var, @@ -87,7 +100,6 @@ server <- function(input, output, session) { ) |> regression_table() ) - })() output$table1 <- gt::render_gt( v$list$table1 |> @@ -98,7 +110,6 @@ server <- function(input, output, session) { v$list$table2 |> gtsummary::as_gt() ) - } ) @@ -129,8 +140,10 @@ server <- function(input, output, session) { filename = "analyses.html", content = function(file) { v$list |> - write_quarto(file = file, - qmd.file = "www/analyses.qmd") + write_quarto( + file = file, + qmd.file = "www/analyses.qmd" + ) } ) diff --git a/app/ui.R b/app/ui.R index d436581..a6c6b34 100644 --- a/app/ui.R +++ b/app/ui.R @@ -28,6 +28,15 @@ cards <- list( ) ) +panels <- list( + bslib::nav_panel(title="Data overview", + shiny::uiOutput("data.input")), + bslib::nav_panel(title="Baseline characteristics", + gt::gt_output(outputId = "table1")), + bslib::nav_panel(title="Multivariable regression table", + gt::gt_output(outputId = "table2")) +) + ui <- bslib::page_sidebar( theme = bslib::bs_theme(bootswatch = "minty"), @@ -73,7 +82,7 @@ ui <- bslib::page_sidebar( textInput( inputId = "regression_formula", label = "Formula string to render with 'glue::glue'", - value = "{outcome.str}~." + value = NULL ), textInput( inputId = "regression_fun", @@ -115,10 +124,17 @@ ui <- bslib::page_sidebar( # label= "Download", # icon = shiny::icon("download")) ), - layout_columns( - cards[[1]] - ), - layout_columns( - cards[[2]], cards[[3]] + bslib::navset_card_underline( + title="Data and results", + panels[[1]], + panels[[2]], + panels[[3]] ) + + # layout_columns( + # cards[[1]] + # ), + # layout_columns( + # cards[[2]], cards[[3]] + # ) ) diff --git a/publish_shiny.R b/publish_shiny.R index 794f3bc..ac2efb5 100644 --- a/publish_shiny.R +++ b/publish_shiny.R @@ -4,6 +4,7 @@ project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R")) # Typical shiny +shiny::runApp(appDir = here::here("app/")) shiny::runApp(appDir = here::here("app/"), launch.browser = TRUE) project.aid::deploy_shiny(