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

prepare for reactive theming - only setting theme on render
Some checks are pending
pkgdown.yaml / pkgdown (push) Waiting to run
Details

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

47
R/regression-module.R
View file

@ -65,16 +65,6 @@ regression_ui <- function(id, ...) {
# ) # )
# ), # ),
shiny::uiOutput(outputId = ns("regression_type")), 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( shiny::radioButtons(
inputId = ns("all"), inputId = ns("all"),
label = "Specify covariables", label = "Specify covariables",
@ -105,6 +95,29 @@ regression_ui <- function(id, ...) {
auto_reset = TRUE auto_reset = TRUE
), ),
shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."), 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() shiny::tags$br()
), ),
do.call( do.call(
@ -510,7 +523,6 @@ regression_server <- function(id,
rv$list$regression$tables <- out rv$list$regression$tables <- out
rv$list$input <- input rv$list$input <- input
}, },
warning = function(warn) { warning = function(warn) {
showNotification(paste0(warn), type = "warning") 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({ 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)) {
out <- rv$list$regression$tables |> gtsummary::theme_gtsummary_journal(journal = "jama")
merged <- rv$list$regression$tables |>
tbl_merge() tbl_merge()
if (input$add_regression_p == "no") { if (input$add_regression_p == "no") {
out <- out |> merged <- merged |>
gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
} }
out |> out <- merged |>
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}**")))
rv$list$regression$table_merged
out
} else { } else {
return(NULL) return(NULL)
} }

2
R/regression_table.R
View file

@ -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")) { if (inherits(x, "polr")) {
# browser() # browser()
out <- do.call(getfun(fun), c(list(x = x), args.list)) out <- do.call(getfun(fun), c(list(x = x), args.list))

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

@ -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")) { if (inherits(x, "polr")) {
# browser() # browser()
out <- do.call(getfun(fun), c(list(x = x), args.list)) 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::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( shiny::radioButtons(
inputId = ns("all"), inputId = ns("all"),
label = "Specify covariables", label = "Specify covariables",
@ -7288,6 +7278,29 @@ regression_ui <- function(id, ...) {
auto_reset = TRUE auto_reset = TRUE
), ),
shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."), 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() shiny::tags$br()
), ),
do.call( do.call(
@ -7693,7 +7706,6 @@ regression_server <- function(id,
rv$list$regression$tables <- out rv$list$regression$tables <- out
rv$list$input <- input rv$list$input <- input
}, },
warning = function(warn) { warning = function(warn) {
showNotification(paste0(warn), type = "warning") 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({ 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)) {
out <- rv$list$regression$tables |> gtsummary::theme_gtsummary_journal(journal = "jama")
merged <- rv$list$regression$tables |>
tbl_merge() tbl_merge()
if (input$add_regression_p == "no") { if (input$add_regression_p == "no") {
out <- out |> merged <- merged |>
gtsummary::modify_column_hide(column = dplyr::starts_with("p.value")) gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
} }
out |> out <- merged |>
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}**")))
rv$list$regression$table_merged
out
} else { } else {
return(NULL) return(NULL)
} }