mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
Compare commits
2 commits
6db500d13a
...
bc9a895d3b
Author | SHA1 | Date | |
---|---|---|---|
bc9a895d3b | |||
07797b2adf |
5 changed files with 109 additions and 54 deletions
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v25.5.4-250512'
|
||||
hosted_version <- function()'v25.5.4-250513'
|
||||
|
|
|
@ -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)
|
||||
}
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
}
|
||||
|
|
|
@ -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,
|
||||
|
|
Loading…
Add table
Reference in a new issue