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

Compare commits

base: andreas:bc9a895d3bf3ab30032db298688c3a6f8f02eb7f
Branches Tags
andreas:main
andreas:gh-pages
andreas:v25.8.2
andreas:v25.8.1
andreas:v25.7.2
andreas:v25.7.1
andreas:v25.6.3
andreas:v25.6.2
andreas:v25.6.1
andreas:v25.5.6
andreas:v25.5.4
andreas:v25.5.3
andreas:v25.5.2
andreas:v25.5.1
andreas:v25.4.5
andreas:v25.4.4
andreas:v25.4.3
andreas:v25.4.2
andreas:v25.4.1
andreas:v25.3.1
andreas:v24.12.1
..
compare: andreas:6db500d13a9cd7009092ae544d0604e435e1c625
Branches Tags
andreas:main
andreas:gh-pages
andreas:v25.8.2
andreas:v25.8.1
andreas:v25.7.2
andreas:v25.7.1
andreas:v25.6.3
andreas:v25.6.2
andreas:v25.6.1
andreas:v25.5.6
andreas:v25.5.4
andreas:v25.5.3
andreas:v25.5.2
andreas:v25.5.1
andreas:v25.4.5
andreas:v25.4.4
andreas:v25.4.3
andreas:v25.4.2
andreas:v25.4.1
andreas:v25.3.1
andreas:v24.12.1

No commits in common. "bc9a895d3bf3ab30032db298688c3a6f8f02eb7f" and "6db500d13a9cd7009092ae544d0604e435e1c625" have entirely different histories.
bc9a895d3b ... 6db500d13a

5 changed files with 54 additions and 109 deletions
Show stats Expand all files Collapse all files

2
R/hosted_version.R
View file

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

67
R/regression-module.R
View file

@ -65,6 +65,16 @@ 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",
@ -95,29 +105,6 @@ 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(
@ -499,7 +486,7 @@ regression_server <- function(id,
tryCatch( tryCatch(
{ {
parameters <- list( parameters <- list(
p.values = input$add_regression_p == "no" add_p = input$add_regression_p == "no"
) )
out <- lapply(rv$list$regression$models, \(.x){ 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 |> 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(
@ -523,6 +520,7 @@ 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")
@ -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({ 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)) {
gtsummary::theme_gtsummary_journal(journal = "jama") rv$list$regression$tables |>
merged <- rv$list$regression$tables |> tbl_merge() |>
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)
} }
@ -649,7 +632,7 @@ regression_server <- function(id,
############################################################################## ##############################################################################
return(shiny::reactive({ return(shiny::reactive({
rv$list rv$list
})) }))
} }
) )

9
R/regression_table.R
View file

@ -46,13 +46,6 @@
#' 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,
@ -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")) { 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))

78
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-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")) #' 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,
@ -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")) { 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,6 +7241,16 @@ 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",
@ -7278,29 +7281,6 @@ 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(
@ -7682,7 +7662,7 @@ regression_server <- function(id,
tryCatch( tryCatch(
{ {
parameters <- list( parameters <- list(
p.values = input$add_regression_p == "no" add_p = input$add_regression_p == "no"
) )
out <- lapply(rv$list$regression$models, \(.x){ 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 |> 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(
@ -7706,6 +7696,7 @@ 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")
@ -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({ 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)) {
gtsummary::theme_gtsummary_journal(journal = "jama") rv$list$regression$tables |>
merged <- rv$list$regression$tables |> tbl_merge() |>
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)
} }
@ -7832,7 +7808,7 @@ regression_server <- function(id,
############################################################################## ##############################################################################
return(shiny::reactive({ return(shiny::reactive({
rv$list rv$list
})) }))
} }
) )

7
man/regression_table.Rd
View file

@ -58,13 +58,6 @@ 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,