mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
Compare commits
No commits in common. "bc9a895d3bf3ab30032db298688c3a6f8f02eb7f" and "6db500d13a9cd7009092ae544d0604e435e1c625" have entirely different histories.
bc9a895d3b
...
6db500d13a
5 changed files with 54 additions and 109 deletions
|
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v25.5.4-250513'
|
||||
hosted_version <- function()'v25.5.4-250512'
|
||||
|
|
|
|||
|
|
@ -65,6 +65,16 @@ 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",
|
||||
|
|
@ -95,29 +105,6 @@ 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(
|
||||
|
|
@ -499,7 +486,7 @@ regression_server <- function(id,
|
|||
tryCatch(
|
||||
{
|
||||
parameters <- list(
|
||||
p.values = input$add_regression_p == "no"
|
||||
add_p = input$add_regression_p == "no"
|
||||
)
|
||||
|
||||
out <- lapply(rv$list$regression$models, \(.x){
|
||||
|
|
@ -512,6 +499,16 @@ 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(
|
||||
|
|
@ -523,6 +520,7 @@ regression_server <- function(id,
|
|||
|
||||
rv$list$regression$tables <- out
|
||||
rv$list$input <- input
|
||||
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
|
|
@ -534,28 +532,13 @@ 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)) {
|
||||
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 |>
|
||||
rv$list$regression$tables |>
|
||||
tbl_merge() |>
|
||||
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)
|
||||
}
|
||||
|
|
@ -649,7 +632,7 @@ regression_server <- function(id,
|
|||
##############################################################################
|
||||
|
||||
return(shiny::reactive({
|
||||
rv$list
|
||||
rv$list
|
||||
}))
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -46,13 +46,6 @@
|
|||
#' 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,
|
||||
|
|
@ -140,7 +133,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-250513'
|
||||
hosted_version <- function()'v25.5.4-250512'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -7040,13 +7040,6 @@ 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,
|
||||
|
|
@ -7134,7 +7127,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))
|
||||
|
|
@ -7248,6 +7241,16 @@ 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",
|
||||
|
|
@ -7278,29 +7281,6 @@ 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(
|
||||
|
|
@ -7682,7 +7662,7 @@ regression_server <- function(id,
|
|||
tryCatch(
|
||||
{
|
||||
parameters <- list(
|
||||
p.values = input$add_regression_p == "no"
|
||||
add_p = input$add_regression_p == "no"
|
||||
)
|
||||
|
||||
out <- lapply(rv$list$regression$models, \(.x){
|
||||
|
|
@ -7695,6 +7675,16 @@ 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(
|
||||
|
|
@ -7706,6 +7696,7 @@ regression_server <- function(id,
|
|||
|
||||
rv$list$regression$tables <- out
|
||||
rv$list$input <- input
|
||||
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
|
|
@ -7717,28 +7708,13 @@ 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)) {
|
||||
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 |>
|
||||
rv$list$regression$tables |>
|
||||
tbl_merge() |>
|
||||
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)
|
||||
}
|
||||
|
|
@ -7832,7 +7808,7 @@ regression_server <- function(id,
|
|||
##############################################################################
|
||||
|
||||
return(shiny::reactive({
|
||||
rv$list
|
||||
rv$list
|
||||
}))
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -58,13 +58,6 @@ 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