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::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(
|
||||||
|
@ -486,7 +499,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 +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 |>
|
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(
|
||||||
|
@ -520,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")
|
||||||
|
@ -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({
|
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 |>
|
gtsummary::theme_gtsummary_journal(journal = "jama")
|
||||||
tbl_merge() |>
|
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() |>
|
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)
|
||||||
}
|
}
|
||||||
|
|
|
@ -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,
|
||||||
|
@ -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")) {
|
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))
|
||||||
|
|
|
@ -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,
|
||||||
|
@ -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")) {
|
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))
|
||||||
|
@ -7241,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",
|
||||||
|
@ -7281,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(
|
||||||
|
@ -7662,7 +7682,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 +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 |>
|
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(
|
||||||
|
@ -7696,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")
|
||||||
|
@ -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({
|
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 |>
|
gtsummary::theme_gtsummary_journal(journal = "jama")
|
||||||
tbl_merge() |>
|
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() |>
|
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)
|
||||||
}
|
}
|
||||||
|
|
|
@ -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,
|
||||||
|
|
Loading…
Add table
Reference in a new issue