reset outputs on updated data

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-04-30 10:02:29 +02:00
parent f45ced3083
commit 1e85fd347f
No known key found for this signature in database
7 changed files with 409 additions and 251 deletions

View file

@ -1 +1 @@
app_version <- function()'v25.4.4.250429' app_version <- function()'v25.4.4.250430'

View file

@ -351,9 +351,25 @@ data_visuals_server <- function(id,
prismCodeBlock(paste0("#Plotting\n", rv$code)) prismCodeBlock(paste0("#Plotting\n", rv$code))
}) })
shiny::observeEvent(
list(
data()
),
{
shiny::req(data())
rv$plot <- NULL
}
)
output$plot <- shiny::renderPlot({ output$plot <- shiny::renderPlot({
shiny::req(rv$plot) # shiny::req(rv$plot)
# rv$plot
if (!is.null(rv$plot)) {
rv$plot rv$plot
} else {
return(NULL)
}
}) })
output$download_plot <- shiny::downloadHandler( output$download_plot <- shiny::downloadHandler(

View file

@ -331,7 +331,7 @@ regression_server <- function(id,
"Multivariable" = "regression_model_list" "Multivariable" = "regression_model_list"
) |> ) |>
lapply(\(.fun){ lapply(\(.fun){
parameters=list( parameters <- list(
data = data_r()[regression_vars()], data = data_r()[regression_vars()],
outcome.str = input$outcome_var, outcome.str = input$outcome_var,
fun.descr = input$regression_type fun.descr = input$regression_type
@ -413,6 +413,8 @@ regression_server <- function(id,
shiny::req(rv$check_plot) shiny::req(rv$check_plot)
shiny::req(input$plot_checks) shiny::req(input$plot_checks)
## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) {
p <- rv$check_plot() + p <- rv$check_plot() +
# patchwork::wrap_plots() + # patchwork::wrap_plots() +
patchwork::plot_annotation(title = "Multivariable regression model checks") patchwork::plot_annotation(title = "Multivariable regression model checks")
@ -422,7 +424,7 @@ regression_server <- function(id,
patchwork::area(.x, 1) patchwork::area(.x, 1)
}) })
out <- p + patchwork::plot_layout(design = Reduce(c, layout)) p_list <- p + patchwork::plot_layout(design = Reduce(c, layout))
index <- match( index <- match(
input$plot_checks, input$plot_checks,
@ -434,28 +436,45 @@ regression_server <- function(id,
ls <- list() ls <- list()
for (i in index) { for (i in index) {
p <- out[[i]] + p <- p_list[[i]] +
ggplot2::theme(axis.text = ggplot2::element_text(size = 10), ggplot2::theme(
axis.text = ggplot2::element_text(size = 10),
axis.title = ggplot2::element_text(size = 12), axis.title = ggplot2::element_text(size = 12),
legend.text = ggplot2::element_text(size = 12), legend.text = ggplot2::element_text(size = 12),
plot.subtitle = ggplot2::element_text(size = 12), plot.subtitle = ggplot2::element_text(size = 12),
plot.title = ggplot2::element_text(size = 18)) plot.title = ggplot2::element_text(size = 18)
)
ls <- c(ls, list(p)) ls <- c(ls, list(p))
} }
# browser() # browser()
tryCatch( tryCatch(
{ {
patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2) out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
}, },
error = function(err) { error = function(err) {
showNotification(err, type = "err") showNotification(err, type = "err")
} }
) )
out
} else {
return(NULL)
}
}, },
alt = "Assumptions testing of the multivariable regression model" alt = "Assumptions testing of the multivariable regression model"
) )
### Creating the regression table shiny::observeEvent(
list(
data_r(),
regression_vars()
),
{
rv$list$regression$tables <- NULL
}
)
### Creating the regression table
shiny::observeEvent( shiny::observeEvent(
input$load, input$load,
{ {
@ -475,9 +494,9 @@ regression_server <- function(id,
purrr::map(\(.x){ purrr::map(\(.x){
do.call( do.call(
regression_table, regression_table,
append_list(.x,parameters,"x") append_list(.x, parameters, "x")
) )
}) })
# if (input$add_regression_p == "no") { # if (input$add_regression_p == "no") {
# out <- out |> # out <- out |>
@ -490,16 +509,18 @@ regression_server <- function(id,
# } # }
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(
.x$code, .x$code,
expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n") expression_string(rlang::call2(.fn = "regression_table", !!!parameters, .ns = "FreesearchR"), assign.str = NULL),
sep = "|>\n"
)
}) })
list( list(
rv$code$import, rv$code$import,
rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"), rlang::call2(.fn = "select", !!!list(input$import_var), .ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR") rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
) |> ) |>
merge_expression() |> merge_expression() |>
expression_string() expression_string()
@ -519,11 +540,15 @@ regression_server <- function(id,
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$tables) ## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) {
rv$list$regression$tables |> rv$list$regression$tables |>
tbl_merge() |> tbl_merge() |>
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}**")))
} else {
return(NULL)
}
}) })
############################################################################## ##############################################################################
@ -619,5 +644,3 @@ regression_server <- function(id,
} }
) )
} }

Binary file not shown.

View file

@ -11,45 +11,54 @@
|collate |en_US.UTF-8 | |collate |en_US.UTF-8 |
|ctype |en_US.UTF-8 | |ctype |en_US.UTF-8 |
|tz |Europe/Copenhagen | |tz |Europe/Copenhagen |
|date |2025-04-29 | |date |2025-04-30 |
|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|quarto |1.6.40 @ /usr/local/bin/quarto | |quarto |1.6.40 @ /usr/local/bin/quarto |
|FreesearchR |25.4.4.250429 | |FreesearchR |25.4.4.250430 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
----------------------------------- packages ----------------------------------- ----------------------------------- packages -----------------------------------
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
|package |loadedversion |date |source | |package |loadedversion |date |source |
|:-------------|:-------------|:----------|:--------------| |:-----------------|:-------------|:----------|:--------------|
|apexcharter |0.4.4 |2024-09-06 |CRAN (R 4.4.1) | |apexcharter |0.4.4 |2024-09-06 |CRAN (R 4.4.1) |
|assertthat |0.2.1 |2019-03-21 |CRAN (R 4.4.1) | |assertthat |0.2.1 |2019-03-21 |CRAN (R 4.4.1) |
|backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) | |backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) |
|bayestestR |0.15.3 |2025-04-28 |CRAN (R 4.4.1) | |bayestestR |0.15.3 |2025-04-28 |CRAN (R 4.4.1) |
|bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) | |bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) |
|bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) | |bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) |
|bitops |1.0-9 |2024-10-03 |CRAN (R 4.4.1) |
|boot |1.3-31 |2024-08-28 |CRAN (R 4.4.1) | |boot |1.3-31 |2024-08-28 |CRAN (R 4.4.1) |
|broom |1.0.8 |2025-03-28 |CRAN (R 4.4.1) | |broom |1.0.8 |2025-03-28 |CRAN (R 4.4.1) |
|broom.helpers |1.21.0 |2025-04-24 |CRAN (R 4.4.1) | |broom.helpers |1.21.0 |2025-04-24 |CRAN (R 4.4.1) |
|bsicons |0.1.2 |2023-11-04 |CRAN (R 4.4.0) | |bsicons |0.1.2 |2023-11-04 |CRAN (R 4.4.0) |
|bslib |0.9.0 |2025-01-30 |CRAN (R 4.4.1) | |bslib |0.9.0 |2025-01-30 |CRAN (R 4.4.1) |
|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | |cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) |
|callr |3.7.6 |2024-03-25 |CRAN (R 4.4.0) |
|cards |0.6.0 |2025-04-11 |CRAN (R 4.4.1) |
|caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) |
|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) |
|cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) |
|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) |
|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) |
|cli |3.6.5 |2025-04-23 |CRAN (R 4.4.1) | |cli |3.6.5 |2025-04-23 |CRAN (R 4.4.1) |
|codetools |0.2-20 |2024-03-31 |CRAN (R 4.4.1) |
|commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) | |commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) |
|correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | |correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) |
|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | |crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) |
|crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) | |crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) |
|curl |6.2.2 |2025-03-24 |CRAN (R 4.4.1) |
|data.table |1.17.0 |2025-02-22 |CRAN (R 4.4.1) | |data.table |1.17.0 |2025-02-22 |CRAN (R 4.4.1) |
|datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) | |datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) |
|datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) | |datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) |
|DEoptimR |1.1-3-1 |2024-11-23 |CRAN (R 4.4.1) |
|desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) | |desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) |
|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | |devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) |
|DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) | |DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) |
|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | |digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) |
|doParallel |1.0.17 |2022-02-07 |CRAN (R 4.4.0) |
|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | |dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) |
|DT |0.33 |2024-04-04 |CRAN (R 4.4.0) | |DT |0.33 |2024-04-04 |CRAN (R 4.4.0) |
|e1071 |1.7-16 |2024-09-16 |CRAN (R 4.4.1) | |e1071 |1.7-16 |2024-09-16 |CRAN (R 4.4.1) |
@ -61,9 +70,11 @@
|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) |
|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) | |fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) |
|forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | |forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) |
|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) |
|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) |
|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | |generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) |
|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) |
|ggstats |0.9.0 |2025-03-10 |CRAN (R 4.4.1) |
|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) |
|gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) |
|gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | |gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) |
@ -76,40 +87,60 @@
|httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) |
|IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) |
|insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) | |insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) |
|iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) |
|jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) |
|jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) |
|jsonvalidate |1.5.0 |2025-02-07 |CRAN (R 4.4.1) |
|KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) |
|keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) |
|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | |knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) |
|labeling |0.4.3 |2023-08-29 |CRAN (R 4.4.1) |
|labelled |2.14.0 |2025-01-08 |CRAN (R 4.4.1) |
|later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) | |later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) |
|lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) |
|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) |
|litedown |0.7 |2025-04-08 |CRAN (R 4.4.1) |
|lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) |
|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | |magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) |
|markdown |2.0 |2025-03-23 |CRAN (R 4.4.1) |
|MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) |
|Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) | |Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) |
|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | |memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) |
|mgcv |1.9-3 |2025-04-04 |CRAN (R 4.4.1) |
|mime |0.13 |2025-03-17 |CRAN (R 4.4.1) | |mime |0.13 |2025-03-17 |CRAN (R 4.4.1) |
|miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) | |miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) |
|minqa |1.2.8 |2024-08-17 |CRAN (R 4.4.1) | |minqa |1.2.8 |2024-08-17 |CRAN (R 4.4.1) |
|modelbased |0.10.0 |2025-03-10 |CRAN (R 4.4.1) | |modelbased |0.10.0 |2025-03-10 |CRAN (R 4.4.1) |
|nlme |3.1-168 |2025-03-31 |CRAN (R 4.4.1) | |nlme |3.1-168 |2025-03-31 |CRAN (R 4.4.1) |
|nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | |nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) |
|opdisDownsampling |1.0.1 |2024-04-15 |CRAN (R 4.4.0) |
|openxlsx2 |1.15 |2025-04-25 |CRAN (R 4.4.1) |
|parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) | |parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) |
|patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) |
|pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.4.1) |
|performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | |performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) |
|phosphoricons |0.2.1 |2024-04-08 |CRAN (R 4.4.0) | |phosphoricons |0.2.1 |2024-04-08 |CRAN (R 4.4.0) |
|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | |pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) |
|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | |pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) |
|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | |pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) |
|pkgdown |2.1.2 |2025-04-28 |CRAN (R 4.4.1) |
|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | |pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) |
|pracma |2.4.4 |2023-11-10 |CRAN (R 4.4.1) |
|processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) |
|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | |profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) |
|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | |promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) |
|proxy |0.4-27 |2022-06-09 |CRAN (R 4.4.1) | |proxy |0.4-27 |2022-06-09 |CRAN (R 4.4.1) |
|ps |1.9.1 |2025-04-12 |CRAN (R 4.4.1) | |ps |1.9.1 |2025-04-12 |CRAN (R 4.4.1) |
|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | |purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) |
|qqconf |1.3.2 |2023-04-14 |CRAN (R 4.4.0) |
|qqplotr |0.0.6 |2023-01-25 |CRAN (R 4.4.0) |
|quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | |quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) |
|R.cache |0.16.0 |2022-07-21 |CRAN (R 4.4.0) |
|R.methodsS3 |1.8.2 |2022-06-13 |CRAN (R 4.4.1) |
|R.oo |1.27.0 |2024-11-01 |CRAN (R 4.4.1) |
|R.utils |2.13.0 |2025-02-24 |CRAN (R 4.4.1) |
|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) |
|ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) |
|rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) |
|RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) |
|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) |
@ -118,13 +149,17 @@
|readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | |readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) |
|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | |readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) |
|readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | |readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) |
|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) |
|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) |
|reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | |reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) |
|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | |remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) |
|rempsyc |0.1.9 |2025-02-01 |CRAN (R 4.4.1) |
|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | |renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) |
|report |0.6.1 |2025-02-07 |CRAN (R 4.4.1) | |report |0.6.1 |2025-02-07 |CRAN (R 4.4.1) |
|rio |1.2.3 |2024-09-25 |CRAN (R 4.4.1) | |rio |1.2.3 |2024-09-25 |CRAN (R 4.4.1) |
|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) | |rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) |
|rmarkdown |2.29 |2024-11-04 |CRAN (R 4.4.1) | |rmarkdown |2.29 |2024-11-04 |CRAN (R 4.4.1) |
|robustbase |0.99-4-1 |2024-09-27 |CRAN (R 4.4.1) |
|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) | |rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) |
|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) | |rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) |
|rstudioapi |0.17.1 |2024-10-22 |CRAN (R 4.4.1) | |rstudioapi |0.17.1 |2024-10-22 |CRAN (R 4.4.1) |
@ -136,13 +171,20 @@
|shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | |shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) |
|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) |
|shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) | |shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) |
|stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) |
|stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) |
|styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) |
|systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) |
|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) |
|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | |tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) |
|tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | |tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) |
|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) |
|toastui |0.4.0 |2025-04-03 |CRAN (R 4.4.1) | |toastui |0.4.0 |2025-04-03 |CRAN (R 4.4.1) |
|twosamples |2.0.1 |2023-06-23 |CRAN (R 4.4.1) |
|tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) | |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) |
|urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) | |urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) |
|usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | |usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) |
|V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) |
|vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) |
|vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) | |vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) |
|withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) | |withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) |
@ -151,3 +193,4 @@
|xml2 |1.3.8 |2025-03-14 |CRAN (R 4.4.1) | |xml2 |1.3.8 |2025-03-14 |CRAN (R 4.4.1) |
|xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) | |xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) |
|yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) | |yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) |
|zip |2.3.2 |2025-02-01 |CRAN (R 4.4.1) |

View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'v25.4.4.250429' app_version <- function()'v25.4.4.250430'
######## ########
@ -1925,9 +1925,25 @@ data_visuals_server <- function(id,
prismCodeBlock(paste0("#Plotting\n", rv$code)) prismCodeBlock(paste0("#Plotting\n", rv$code))
}) })
shiny::observeEvent(
list(
data()
),
{
shiny::req(data())
rv$plot <- NULL
}
)
output$plot <- shiny::renderPlot({ output$plot <- shiny::renderPlot({
shiny::req(rv$plot) # shiny::req(rv$plot)
# rv$plot
if (!is.null(rv$plot)) {
rv$plot rv$plot
} else {
return(NULL)
}
}) })
output$download_plot <- shiny::downloadHandler( output$download_plot <- shiny::downloadHandler(
@ -7370,7 +7386,7 @@ regression_server <- function(id,
"Multivariable" = "regression_model_list" "Multivariable" = "regression_model_list"
) |> ) |>
lapply(\(.fun){ lapply(\(.fun){
parameters=list( parameters <- list(
data = data_r()[regression_vars()], data = data_r()[regression_vars()],
outcome.str = input$outcome_var, outcome.str = input$outcome_var,
fun.descr = input$regression_type fun.descr = input$regression_type
@ -7452,6 +7468,8 @@ regression_server <- function(id,
shiny::req(rv$check_plot) shiny::req(rv$check_plot)
shiny::req(input$plot_checks) shiny::req(input$plot_checks)
## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) {
p <- rv$check_plot() + p <- rv$check_plot() +
# patchwork::wrap_plots() + # patchwork::wrap_plots() +
patchwork::plot_annotation(title = "Multivariable regression model checks") patchwork::plot_annotation(title = "Multivariable regression model checks")
@ -7461,7 +7479,7 @@ regression_server <- function(id,
patchwork::area(.x, 1) patchwork::area(.x, 1)
}) })
out <- p + patchwork::plot_layout(design = Reduce(c, layout)) p_list <- p + patchwork::plot_layout(design = Reduce(c, layout))
index <- match( index <- match(
input$plot_checks, input$plot_checks,
@ -7473,28 +7491,45 @@ regression_server <- function(id,
ls <- list() ls <- list()
for (i in index) { for (i in index) {
p <- out[[i]] + p <- p_list[[i]] +
ggplot2::theme(axis.text = ggplot2::element_text(size = 10), ggplot2::theme(
axis.text = ggplot2::element_text(size = 10),
axis.title = ggplot2::element_text(size = 12), axis.title = ggplot2::element_text(size = 12),
legend.text = ggplot2::element_text(size = 12), legend.text = ggplot2::element_text(size = 12),
plot.subtitle = ggplot2::element_text(size = 12), plot.subtitle = ggplot2::element_text(size = 12),
plot.title = ggplot2::element_text(size = 18)) plot.title = ggplot2::element_text(size = 18)
)
ls <- c(ls, list(p)) ls <- c(ls, list(p))
} }
# browser() # browser()
tryCatch( tryCatch(
{ {
patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2) out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
}, },
error = function(err) { error = function(err) {
showNotification(err, type = "err") showNotification(err, type = "err")
} }
) )
out
} else {
return(NULL)
}
}, },
alt = "Assumptions testing of the multivariable regression model" alt = "Assumptions testing of the multivariable regression model"
) )
### Creating the regression table shiny::observeEvent(
list(
data_r(),
regression_vars()
),
{
rv$list$regression$tables <- NULL
}
)
### Creating the regression table
shiny::observeEvent( shiny::observeEvent(
input$load, input$load,
{ {
@ -7514,9 +7549,9 @@ regression_server <- function(id,
purrr::map(\(.x){ purrr::map(\(.x){
do.call( do.call(
regression_table, regression_table,
append_list(.x,parameters,"x") append_list(.x, parameters, "x")
) )
}) })
# if (input$add_regression_p == "no") { # if (input$add_regression_p == "no") {
# out <- out |> # out <- out |>
@ -7529,16 +7564,18 @@ regression_server <- function(id,
# } # }
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(
.x$code, .x$code,
expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n") expression_string(rlang::call2(.fn = "regression_table", !!!parameters, .ns = "FreesearchR"), assign.str = NULL),
sep = "|>\n"
)
}) })
list( list(
rv$code$import, rv$code$import,
rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"), rlang::call2(.fn = "select", !!!list(input$import_var), .ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR") rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
) |> ) |>
merge_expression() |> merge_expression() |>
expression_string() expression_string()
@ -7558,11 +7595,15 @@ regression_server <- function(id,
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$tables) ## Print checks if a regression table is present
if (!is.null(rv$list$regression$tables)) {
rv$list$regression$tables |> rv$list$regression$tables |>
tbl_merge() |> tbl_merge() |>
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}**")))
} else {
return(NULL)
}
}) })
############################################################################## ##############################################################################
@ -7660,8 +7701,6 @@ regression_server <- function(id,
} }
######## ########
#### Current file: /Users/au301842/FreesearchR/R//report.R #### Current file: /Users/au301842/FreesearchR/R//report.R
######## ########
@ -9678,10 +9717,13 @@ dark <- custom_theme(
ui <- bslib::page_fixed( ui <- bslib::page_fixed(
prismDependencies, prismDependencies,
prismRDependency, prismRDependency,
## Basic Umami page tracking
shiny::tags$head( shiny::tags$head(
includeHTML(("www/umami-app.html")), includeHTML(("www/umami-app.html")),
tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), tags$link(rel = "stylesheet", type = "text/css", href = "style.css")),
tags$head(tags$link(rel="shortcut icon", href="favicon.svg")), ## This adds the actual favicon
## png and ico versions are kept for compatibility
shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")),
title = "FreesearchR", title = "FreesearchR",
theme = light, theme = light,
shiny::useBusyIndicators(), shiny::useBusyIndicators(),
@ -9751,7 +9793,7 @@ library(gtsummary)
data(starwars) data(starwars)
data(mtcars) data(mtcars)
mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) mtcars_date$date <- as.Date(sample(seq_len(365), nrow(mtcars)))
data(trial) data(trial)
@ -10182,6 +10224,20 @@ server <- function(input, output, session) {
)) ))
}) })
## Evaluation table/plots reset on data change
## This does not work (!?)
shiny::observeEvent(
list(
rv$data_filtered
),
{
shiny::req(rv$data_filtered)
rv$list$table1 <- NULL
rv$regression <- NULL
}
)
############################################################################## ##############################################################################
######### #########
@ -10243,6 +10299,7 @@ server <- function(input, output, session) {
## Just a note to self ## Just a note to self
## This is a very rewarding couple of lines marking new insights to dynamically rendering code ## This is a very rewarding couple of lines marking new insights to dynamically rendering code
shiny::observe({ shiny::observe({
shiny::req(rv$regression)
rv$regression()$regression$models |> purrr::imap(\(.x, .i){ rv$regression()$regression$models |> purrr::imap(\(.x, .i){
output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({ output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({
prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table)) prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table))
@ -10319,11 +10376,13 @@ server <- function(input, output, session) {
}) })
output$table1 <- gt::render_gt({ output$table1 <- gt::render_gt({
shiny::req(rv$list$table1) if (!is.null(rv$list$table1)) {
rv$list$table1 |> rv$list$table1 |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**")) gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
} else {
return(NULL)
}
}) })
data_correlations_server( data_correlations_server(

View file

@ -33,7 +33,7 @@ library(gtsummary)
data(starwars) data(starwars)
data(mtcars) data(mtcars)
mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) mtcars_date$date <- as.Date(sample(seq_len(365), nrow(mtcars)))
data(trial) data(trial)
@ -464,6 +464,20 @@ server <- function(input, output, session) {
)) ))
}) })
## Evaluation table/plots reset on data change
## This does not work (!?)
shiny::observeEvent(
list(
rv$data_filtered
),
{
shiny::req(rv$data_filtered)
rv$list$table1 <- NULL
rv$regression <- NULL
}
)
############################################################################## ##############################################################################
######### #########
@ -525,6 +539,7 @@ server <- function(input, output, session) {
## Just a note to self ## Just a note to self
## This is a very rewarding couple of lines marking new insights to dynamically rendering code ## This is a very rewarding couple of lines marking new insights to dynamically rendering code
shiny::observe({ shiny::observe({
shiny::req(rv$regression)
rv$regression()$regression$models |> purrr::imap(\(.x, .i){ rv$regression()$regression$models |> purrr::imap(\(.x, .i){
output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({ output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({
prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table)) prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table))
@ -601,11 +616,13 @@ server <- function(input, output, session) {
}) })
output$table1 <- gt::render_gt({ output$table1 <- gt::render_gt({
shiny::req(rv$list$table1) if (!is.null(rv$list$table1)) {
rv$list$table1 |> rv$list$table1 |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**")) gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
} else {
return(NULL)
}
}) })
data_correlations_server( data_correlations_server(