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..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( @@ -486,7 +499,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 +512,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( @@ -520,7 +523,6 @@ regression_server <- function(id, rv$list$regression$tables <- out rv$list$input <- input - }, warning = function(warn) { showNotification(paste0(warn), type = "warning") @@ -532,13 +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)) { - rv$list$regression$tables |> - tbl_merge() |> + gtsummary::theme_gtsummary_journal(journal = "jama") + merged <- rv$list$regression$tables |> + tbl_merge() + + if (input$add_regression_p == "no") { + merged <- merged |> + gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) + } + + 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) } @@ -632,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 71e99272..b0331c72 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, @@ -133,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 7882c2ca..646d4417 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, @@ -7127,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)) @@ -7241,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", @@ -7281,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( @@ -7662,7 +7682,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 +7695,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( @@ -7696,7 +7706,6 @@ regression_server <- function(id, rv$list$regression$tables <- out rv$list$input <- input - }, warning = function(warn) { showNotification(paste0(warn), type = "warning") @@ -7708,13 +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)) { - rv$list$regression$tables |> - tbl_merge() |> + gtsummary::theme_gtsummary_journal(journal = "jama") + merged <- rv$list$regression$tables |> + tbl_merge() + + if (input$add_regression_p == "no") { + merged <- merged |> + gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) + } + + 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) } @@ -7808,7 +7832,7 @@ regression_server <- function(id, ############################################################################## return(shiny::reactive({ - rv$list + rv$list })) } ) 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,