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(
inputId = ns("n_breaks"),
label = i18n("Number of breaks:"),
value = 5,
value = 3,
min = 2,
max = 12,
width = "100%"

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

@ -296,7 +296,7 @@ cut_variable_ui <- function(id) {
numericInput(
inputId = ns("n_breaks"),
label = i18n("Number of breaks:"),
value = 5,
value = 3,
min = 2,
max = 12,
width = "100%"
@ -2215,7 +2215,7 @@ server <- function(input, output, session) {
})
rv <- shiny::reactiveValues(
list = NULL,
list = list(),
ds = NULL,
input = exists("webResearch_data"),
local_temp = NULL,
@ -2494,6 +2494,8 @@ server <- function(input, output, session) {
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
tryCatch(
{
data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
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()
rv$list <- list(
data = data,
check = check,
table1 = data |>
rv$list$table1 <- data |>
baseline_table(
fun.args =
list(
@ -2561,12 +2564,47 @@ server <- function(input, output, session) {
} else {
.x
}
})(),
table2 = models |>
})()
rv$list$table2 <- models |>
purrr::map(regression_table) |>
tbl_merge(),
input = input
)
tbl_merge()
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(
rv$list$table1 |>
@ -2579,7 +2617,7 @@ server <- function(input, output, session) {
)
output$check <- shiny::renderPlot({
p <- plot(check) +
p <- plot(rv$list$check) +
patchwork::plot_annotation(title = "Multivariable regression model checks")
p
# Generate checks in one column
@ -2591,9 +2629,16 @@ server <- function(input, output, session) {
# patchwork::wrap_plots(ncol=1) +
# 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
########

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

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

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

@ -60,7 +60,7 @@ server <- function(input, output, session) {
})
rv <- shiny::reactiveValues(
list = NULL,
list = list(),
ds = NULL,
input = exists("webResearch_data"),
local_temp = NULL,
@ -339,6 +339,8 @@ server <- function(input, output, session) {
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
tryCatch(
{
data <- data_filter() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
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()
rv$list <- list(
data = data,
check = check,
table1 = data |>
rv$list$table1 <- data |>
baseline_table(
fun.args =
list(
@ -406,12 +409,47 @@ server <- function(input, output, session) {
} else {
.x
}
})(),
table2 = models |>
})()
rv$list$table2 <- models |>
purrr::map(regression_table) |>
tbl_merge(),
input = input
)
tbl_merge()
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(
rv$list$table1 |>
@ -424,7 +462,7 @@ server <- function(input, output, session) {
)
output$check <- shiny::renderPlot({
p <- plot(check) +
p <- plot(rv$list$check) +
patchwork::plot_annotation(title = "Multivariable regression model checks")
p
# Generate checks in one column
@ -436,9 +474,16 @@ server <- function(input, output, session) {
# patchwork::wrap_plots(ncol=1) +
# 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) {
})
})
}