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

error handling

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-12-18 15:46:02 +01:00
parent b0f63ab2a4
commit 96c37219aa
No known key found for this signature in database
4 changed files with 283 additions and 197 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
R/cut-variable-dates.R
View file

@ -256,7 +256,7 @@ cut_variable_ui <- function(id) {
numericInput( numericInput(
inputId = ns("n_breaks"), inputId = ns("n_breaks"),
label = i18n("Number of breaks:"), label = i18n("Number of breaks:"),
value = 5, value = 3,
min = 2, min = 2,
max = 12, max = 12,
width = "100%" width = "100%"

77
inst/apps/data_analysis_modules/app.R
View file

@ -296,7 +296,7 @@ cut_variable_ui <- function(id) {
numericInput( numericInput(
inputId = ns("n_breaks"), inputId = ns("n_breaks"),
label = i18n("Number of breaks:"), label = i18n("Number of breaks:"),
value = 5, value = 3,
min = 2, min = 2,
max = 12, max = 12,
width = "100%" width = "100%"
@ -2215,7 +2215,7 @@ server <- function(input, output, session) {
}) })
rv <- shiny::reactiveValues( rv <- shiny::reactiveValues(
list = NULL, list = list(),
ds = NULL, ds = NULL,
input = exists("webResearch_data"), input = exists("webResearch_data"),
local_temp = NULL, local_temp = NULL,
@ -2494,6 +2494,8 @@ server <- function(input, output, session) {
# browser() # browser()
# Assumes all character variables can be formatted as factors # Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |> # data <- data_filter$filtered() |>
tryCatch(
{
data <- data_filter() |> data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
REDCapCAST::fct_drop.data.frame() |> REDCapCAST::fct_drop.data.frame() |>
@ -2533,13 +2535,14 @@ server <- function(input, output, session) {
) )
}) })
check <- purrr::pluck(models, "Multivariable") |> rv$list$data <- data
rv$list$check <- purrr::pluck(models, "Multivariable") |>
performance::check_model() performance::check_model()
rv$list <- list( rv$list$table1 <- data |>
data = data,
check = check,
table1 = data |>
baseline_table( baseline_table(
fun.args = fun.args =
list( list(
@ -2561,12 +2564,47 @@ server <- function(input, output, session) {
} else { } else {
.x .x
} }
})(), })()
table2 = models |>
rv$list$table2 <- models |>
purrr::map(regression_table) |> purrr::map(regression_table) |>
tbl_merge(), tbl_merge()
input = input
)
rv$list$input <- input
# rv$list <- list(
# data = data,
# check = check,
# table1 = data |>
# baseline_table(
# fun.args =
# list(
# by = by.var
# )
# ) |>
# (\(.x){
# if (!is.null(by.var)) {
# .x |> gtsummary::add_overall()
# } else {
# .x
# }
# })() |>
# (\(.x){
# if (input$add_p == "yes") {
# .x |>
# gtsummary::add_p() |>
# gtsummary::bold_p()
# } else {
# .x
# }
# })(),
# table2 = models |>
# purrr::map(regression_table) |>
# tbl_merge(),
# input = input
# )
output$table1 <- gt::render_gt( output$table1 <- gt::render_gt(
rv$list$table1 |> rv$list$table1 |>
@ -2579,7 +2617,7 @@ server <- function(input, output, session) {
) )
output$check <- shiny::renderPlot({ output$check <- shiny::renderPlot({
p <- plot(check) + p <- plot(rv$list$check) +
patchwork::plot_annotation(title = "Multivariable regression model checks") patchwork::plot_annotation(title = "Multivariable regression model checks")
p p
# Generate checks in one column # Generate checks in one column
@ -2591,9 +2629,16 @@ server <- function(input, output, session) {
# patchwork::wrap_plots(ncol=1) + # patchwork::wrap_plots(ncol=1) +
# patchwork::plot_annotation(title = 'Multivariable regression model checks') # patchwork::plot_annotation(title = 'Multivariable regression model checks')
rv$ready <- "ready"
}) })
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0("There was the following error. Inspect your data and adjust settings. Error: ",err), type = "err")
}
)
rv$ready <- "ready"
} }
) )
@ -2672,8 +2717,6 @@ server <- function(input, output, session) {
} }
######## ########
#### Current file: /Users/au301842/webResearch/inst/apps/data_analysis_modules/launch.R #### Current file: /Users/au301842/webResearch/inst/apps/data_analysis_modules/launch.R
######## ########

2
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1 hostUrl: https://api.shinyapps.io/v1
appId: 13611288 appId: 13611288
bundleId: bundleId: 9539876
url: https://agdamsbo.shinyapps.io/freesearcheR/ url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1 version: 1

75
inst/apps/data_analysis_modules/server.R
View file

@ -60,7 +60,7 @@ server <- function(input, output, session) {
}) })
rv <- shiny::reactiveValues( rv <- shiny::reactiveValues(
list = NULL, list = list(),
ds = NULL, ds = NULL,
input = exists("webResearch_data"), input = exists("webResearch_data"),
local_temp = NULL, local_temp = NULL,
@ -339,6 +339,8 @@ server <- function(input, output, session) {
# browser() # browser()
# Assumes all character variables can be formatted as factors # Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |> # data <- data_filter$filtered() |>
tryCatch(
{
data <- data_filter() |> data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
REDCapCAST::fct_drop.data.frame() |> REDCapCAST::fct_drop.data.frame() |>
@ -378,13 +380,14 @@ server <- function(input, output, session) {
) )
}) })
check <- purrr::pluck(models, "Multivariable") |> rv$list$data <- data
rv$list$check <- purrr::pluck(models, "Multivariable") |>
performance::check_model() performance::check_model()
rv$list <- list( rv$list$table1 <- data |>
data = data,
check = check,
table1 = data |>
baseline_table( baseline_table(
fun.args = fun.args =
list( list(
@ -406,12 +409,47 @@ server <- function(input, output, session) {
} else { } else {
.x .x
} }
})(), })()
table2 = models |>
rv$list$table2 <- models |>
purrr::map(regression_table) |> purrr::map(regression_table) |>
tbl_merge(), tbl_merge()
input = input
)
rv$list$input <- input
# rv$list <- list(
# data = data,
# check = check,
# table1 = data |>
# baseline_table(
# fun.args =
# list(
# by = by.var
# )
# ) |>
# (\(.x){
# if (!is.null(by.var)) {
# .x |> gtsummary::add_overall()
# } else {
# .x
# }
# })() |>
# (\(.x){
# if (input$add_p == "yes") {
# .x |>
# gtsummary::add_p() |>
# gtsummary::bold_p()
# } else {
# .x
# }
# })(),
# table2 = models |>
# purrr::map(regression_table) |>
# tbl_merge(),
# input = input
# )
output$table1 <- gt::render_gt( output$table1 <- gt::render_gt(
rv$list$table1 |> rv$list$table1 |>
@ -424,7 +462,7 @@ server <- function(input, output, session) {
) )
output$check <- shiny::renderPlot({ output$check <- shiny::renderPlot({
p <- plot(check) + p <- plot(rv$list$check) +
patchwork::plot_annotation(title = "Multivariable regression model checks") patchwork::plot_annotation(title = "Multivariable regression model checks")
p p
# Generate checks in one column # Generate checks in one column
@ -436,9 +474,16 @@ server <- function(input, output, session) {
# patchwork::wrap_plots(ncol=1) + # patchwork::wrap_plots(ncol=1) +
# patchwork::plot_annotation(title = 'Multivariable regression model checks') # patchwork::plot_annotation(title = 'Multivariable regression model checks')
rv$ready <- "ready"
}) })
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0("There was the following error. Inspect your data and adjust settings. Error: ",err), type = "err")
}
)
rv$ready <- "ready"
} }
) )
@ -515,5 +560,3 @@ server <- function(input, output, session) {
}) })
}) })
} }