andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 01:49:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

regression module reactively hides/shows p-values

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-05-13 08:16:10 +02:00
parent 6db500d13a
commit 07797b2adf
No known key found for this signature in database
5 changed files with 45 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
R/hosted_version.R
View file

@ -1 +1 @@
hosted_version <- function()'v25.5.4-250512' hosted_version <- function()'v25.5.4-250513'

24
R/regression-module.R
View file

@ -486,7 +486,7 @@ regression_server <- function(id,
tryCatch( tryCatch(
{ {
parameters <- list( parameters <- list(
add_p = input$add_regression_p == "no" p.values = input$add_regression_p == "no"
) )
out <- lapply(rv$list$regression$models, \(.x){ 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 |> rv$list$regression$models |>
purrr::imap(\(.x, .i){ purrr::imap(\(.x, .i){
rv$list$regression$models[[.i]][["code_table"]] <- paste( rv$list$regression$models[[.i]][["code_table"]] <- paste(
@ -532,11 +522,19 @@ regression_server <- function(id,
} }
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
## Print checks if a regression table is present ## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) { if (!is.null(rv$list$regression$tables)) {
rv$list$regression$tables |> out <- rv$list$regression$tables |>
tbl_merge() |> tbl_merge()
if (input$add_regression_p == "no") {
out <- out |>
gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
}
out |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
} else { } else {

7
R/regression_table.R
View file

@ -46,6 +46,13 @@
#' args.list = list(family = stats::binomial(link = "logit")) #' args.list = list(family = stats::binomial(link = "logit"))
#' ) |> #' ) |>
#' regression_table() #' regression_table()
#' mtcars|>
#' regression_model(
#' outcome.str = "mpg",
#' args.list = NULL)
#' ) |>
#' regression_table()
#'
#' #'
#' list( #' list(
#' "Univariable" = regression_model_uv, #' "Univariable" = regression_model_uv,

33
inst/apps/FreesearchR/app.R
View file

@ -3996,7 +3996,7 @@ simple_snake <- function(data){
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R #### 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")) #' args.list = list(family = stats::binomial(link = "logit"))
#' ) |> #' ) |>
#' regression_table() #' regression_table()
#' mtcars|>
#' regression_model(
#' outcome.str = "mpg",
#' args.list = NULL)
#' ) |>
#' regression_table()
#'
#' #'
#' list( #' list(
#' "Univariable" = regression_model_uv, #' "Univariable" = regression_model_uv,
@ -7662,7 +7669,7 @@ regression_server <- function(id,
tryCatch( tryCatch(
{ {
parameters <- list( parameters <- list(
add_p = input$add_regression_p == "no" p.values = input$add_regression_p == "no"
) )
out <- lapply(rv$list$regression$models, \(.x){ 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 |> rv$list$regression$models |>
purrr::imap(\(.x, .i){ purrr::imap(\(.x, .i){
rv$list$regression$models[[.i]][["code_table"]] <- paste( rv$list$regression$models[[.i]][["code_table"]] <- paste(
@ -7708,11 +7705,19 @@ regression_server <- function(id,
} }
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
## Print checks if a regression table is present ## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) { if (!is.null(rv$list$regression$tables)) {
rv$list$regression$tables |> out <- rv$list$regression$tables |>
tbl_merge() |> tbl_merge()
if (input$add_regression_p == "no") {
out <- out |>
gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
}
out |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**"))) gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
} else { } else {

7
man/regression_table.Rd
View file

@ -58,6 +58,13 @@ gtsummary::trial |>
args.list = list(family = stats::binomial(link = "logit")) args.list = list(family = stats::binomial(link = "logit"))
) |> ) |>
regression_table() regression_table()
mtcars|>
regression_model(
outcome.str = "mpg",
args.list = NULL)
) |>
regression_table()
list( list(
"Univariable" = regression_model_uv, "Univariable" = regression_model_uv,