From 07797b2adf30074c9011f2a6fa3a67fcf13aa481 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 13 May 2025 08:16:10 +0200 Subject: [PATCH 1/2] regression module reactively hides/shows p-values --- R/hosted_version.R | 2 +- R/regression-module.R | 24 +++++++++++------------- R/regression_table.R | 7 +++++++ inst/apps/FreesearchR/app.R | 33 +++++++++++++++++++-------------- man/regression_table.Rd | 7 +++++++ 5 files changed, 45 insertions(+), 28 deletions(-) diff --git a/R/hosted_version.R b/R/hosted_version.R index 32d9fe0f..a898784a 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.4-250512' +hosted_version <- function()'v25.5.4-250513' diff --git a/R/regression-module.R b/R/regression-module.R index 57806bde..4d7f6568 100644 --- a/R/regression-module.R +++ b/R/regression-module.R @@ -486,7 +486,7 @@ regression_server <- function(id, tryCatch( { parameters <- list( - add_p = input$add_regression_p == "no" + p.values = input$add_regression_p == "no" ) out <- lapply(rv$list$regression$models, \(.x){ @@ -499,16 +499,6 @@ regression_server <- function(id, ) }) - # if (input$add_regression_p == "no") { - # out <- out |> - # lapply(\(.x){ - # .x |> - # gtsummary::modify_column_hide( - # column = "p.value" - # ) - # }) - # } - rv$list$regression$models |> purrr::imap(\(.x, .i){ rv$list$regression$models[[.i]][["code_table"]] <- paste( @@ -532,11 +522,19 @@ regression_server <- function(id, } ) + output$table2 <- gt::render_gt({ ## Print checks if a regression table is present if (!is.null(rv$list$regression$tables)) { - rv$list$regression$tables |> - tbl_merge() |> + out <- rv$list$regression$tables |> + tbl_merge() + + if (input$add_regression_p == "no") { + out <- out |> + gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) + } + + out |> gtsummary::as_gt() |> gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) } else { diff --git a/R/regression_table.R b/R/regression_table.R index 71e99272..557359b3 100644 --- a/R/regression_table.R +++ b/R/regression_table.R @@ -46,6 +46,13 @@ #' args.list = list(family = stats::binomial(link = "logit")) #' ) |> #' regression_table() +#' mtcars|> +#' regression_model( +#' outcome.str = "mpg", +#' args.list = NULL) +#' ) |> +#' regression_table() +#' #' #' list( #' "Univariable" = regression_model_uv, diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 7882c2ca..a0180725 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -3996,7 +3996,7 @@ simple_snake <- function(data){ #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.5.4-250512' +hosted_version <- function()'v25.5.4-250513' ######## @@ -7040,6 +7040,13 @@ symmetrical_scale_x_log10 <- function(plot, breaks = c(1, 2, 3, 5, 10), ...) { #' args.list = list(family = stats::binomial(link = "logit")) #' ) |> #' regression_table() +#' mtcars|> +#' regression_model( +#' outcome.str = "mpg", +#' args.list = NULL) +#' ) |> +#' regression_table() +#' #' #' list( #' "Univariable" = regression_model_uv, @@ -7662,7 +7669,7 @@ regression_server <- function(id, tryCatch( { parameters <- list( - add_p = input$add_regression_p == "no" + p.values = input$add_regression_p == "no" ) out <- lapply(rv$list$regression$models, \(.x){ @@ -7675,16 +7682,6 @@ regression_server <- function(id, ) }) - # if (input$add_regression_p == "no") { - # out <- out |> - # lapply(\(.x){ - # .x |> - # gtsummary::modify_column_hide( - # column = "p.value" - # ) - # }) - # } - rv$list$regression$models |> purrr::imap(\(.x, .i){ rv$list$regression$models[[.i]][["code_table"]] <- paste( @@ -7708,11 +7705,19 @@ regression_server <- function(id, } ) + output$table2 <- gt::render_gt({ ## Print checks if a regression table is present if (!is.null(rv$list$regression$tables)) { - rv$list$regression$tables |> - tbl_merge() |> + out <- rv$list$regression$tables |> + tbl_merge() + + if (input$add_regression_p == "no") { + out <- out |> + gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) + } + + out |> gtsummary::as_gt() |> gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) } else { diff --git a/man/regression_table.Rd b/man/regression_table.Rd index 4a47c6f9..d319247b 100644 --- a/man/regression_table.Rd +++ b/man/regression_table.Rd @@ -58,6 +58,13 @@ gtsummary::trial |> args.list = list(family = stats::binomial(link = "logit")) ) |> regression_table() +mtcars|> + regression_model( + outcome.str = "mpg", + args.list = NULL) + ) |> + regression_table() + list( "Univariable" = regression_model_uv, From bc9a895d3bf3ab30032db298688c3a6f8f02eb7f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 13 May 2025 08:48:45 +0200 Subject: [PATCH 2/2] prepare for reactive theming - only setting theme on render --- R/regression-module.R | 49 ++++++++++++++++++++++++----------- R/regression_table.R | 2 +- inst/apps/FreesearchR/app.R | 51 +++++++++++++++++++++++++------------ 3 files changed, 70 insertions(+), 32 deletions(-) diff --git a/R/regression-module.R b/R/regression-module.R index 4d7f6568..f79c0c50 100644 --- a/R/regression-module.R +++ b/R/regression-module.R @@ -65,16 +65,6 @@ regression_ui <- function(id, ...) { # ) # ), shiny::uiOutput(outputId = ns("regression_type")), - shiny::radioButtons( - inputId = ns("add_regression_p"), - label = "Add p-value", - inline = TRUE, - selected = "yes", - choices = list( - "Yes" = "yes", - "No" = "no" - ) - ), shiny::radioButtons( inputId = ns("all"), label = "Specify covariables", @@ -105,6 +95,29 @@ regression_ui <- function(id, ...) { auto_reset = TRUE ), shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."), + shiny::tags$br(), + shiny::radioButtons( + inputId = ns("add_regression_p"), + label = "Show p-value", + inline = TRUE, + selected = "yes", + choices = list( + "Yes" = "yes", + "No" = "no" + ) + ), + # shiny::tags$br(), + # shiny::radioButtons( + # inputId = ns("tbl_theme"), + # label = "Show p-value", + # inline = TRUE, + # selected = "jama", + # choices = list( + # "JAMA" = "jama", + # "Lancet" = "lancet", + # "NEJM" = "nejm" + # ) + # ), shiny::tags$br() ), do.call( @@ -510,7 +523,6 @@ regression_server <- function(id, rv$list$regression$tables <- out rv$list$input <- input - }, warning = function(warn) { showNotification(paste0(warn), type = "warning") @@ -522,21 +534,28 @@ regression_server <- function(id, } ) + ## Consider creating merged table with theming and then passing object + ## to render. output$table2 <- gt::render_gt({ ## Print checks if a regression table is present if (!is.null(rv$list$regression$tables)) { - out <- rv$list$regression$tables |> + gtsummary::theme_gtsummary_journal(journal = "jama") + merged <- rv$list$regression$tables |> tbl_merge() if (input$add_regression_p == "no") { - out <- out |> + merged <- merged |> gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) } - out |> + out <- merged |> gtsummary::as_gt() |> gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) + + rv$list$regression$table_merged + + out } else { return(NULL) } @@ -630,7 +649,7 @@ regression_server <- function(id, ############################################################################## return(shiny::reactive({ - rv$list + rv$list })) } ) diff --git a/R/regression_table.R b/R/regression_table.R index 557359b3..b0331c72 100644 --- a/R/regression_table.R +++ b/R/regression_table.R @@ -140,7 +140,7 @@ regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary:: } } - gtsummary::theme_gtsummary_journal(journal = theme) + # gtsummary::theme_gtsummary_journal(journal = theme) if (inherits(x, "polr")) { # browser() out <- do.call(getfun(fun), c(list(x = x), args.list)) diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index a0180725..646d4417 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -7134,7 +7134,7 @@ regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary:: } } - gtsummary::theme_gtsummary_journal(journal = theme) + # gtsummary::theme_gtsummary_journal(journal = theme) if (inherits(x, "polr")) { # browser() out <- do.call(getfun(fun), c(list(x = x), args.list)) @@ -7248,16 +7248,6 @@ regression_ui <- function(id, ...) { # ) # ), shiny::uiOutput(outputId = ns("regression_type")), - shiny::radioButtons( - inputId = ns("add_regression_p"), - label = "Add p-value", - inline = TRUE, - selected = "yes", - choices = list( - "Yes" = "yes", - "No" = "no" - ) - ), shiny::radioButtons( inputId = ns("all"), label = "Specify covariables", @@ -7288,6 +7278,29 @@ regression_ui <- function(id, ...) { auto_reset = TRUE ), shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."), + shiny::tags$br(), + shiny::radioButtons( + inputId = ns("add_regression_p"), + label = "Show p-value", + inline = TRUE, + selected = "yes", + choices = list( + "Yes" = "yes", + "No" = "no" + ) + ), + # shiny::tags$br(), + # shiny::radioButtons( + # inputId = ns("tbl_theme"), + # label = "Show p-value", + # inline = TRUE, + # selected = "jama", + # choices = list( + # "JAMA" = "jama", + # "Lancet" = "lancet", + # "NEJM" = "nejm" + # ) + # ), shiny::tags$br() ), do.call( @@ -7693,7 +7706,6 @@ regression_server <- function(id, rv$list$regression$tables <- out rv$list$input <- input - }, warning = function(warn) { showNotification(paste0(warn), type = "warning") @@ -7705,21 +7717,28 @@ regression_server <- function(id, } ) + ## Consider creating merged table with theming and then passing object + ## to render. output$table2 <- gt::render_gt({ ## Print checks if a regression table is present if (!is.null(rv$list$regression$tables)) { - out <- rv$list$regression$tables |> + gtsummary::theme_gtsummary_journal(journal = "jama") + merged <- rv$list$regression$tables |> tbl_merge() if (input$add_regression_p == "no") { - out <- out |> + merged <- merged |> gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) } - out |> + out <- merged |> gtsummary::as_gt() |> gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) + + rv$list$regression$table_merged + + out } else { return(NULL) } @@ -7813,7 +7832,7 @@ regression_server <- function(id, ############################################################################## return(shiny::reactive({ - rv$list + rv$list })) } )