mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
version bump - regression - data overview
This commit is contained in:
parent
f73af16ae1
commit
f249aaa9ab
29 changed files with 2888 additions and 1239 deletions
File diff suppressed because it is too large
Load diff
|
|
@ -75,6 +75,7 @@ server <- function(input, output, session) {
|
|||
|
||||
rv <- shiny::reactiveValues(
|
||||
list = list(),
|
||||
regression = list(),
|
||||
ds = NULL,
|
||||
local_temp = NULL,
|
||||
ready = NULL,
|
||||
|
|
@ -165,7 +166,7 @@ server <- function(input, output, session) {
|
|||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_temp)
|
||||
# browser()
|
||||
# browser()
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
default_parsing()
|
||||
|
|
@ -251,7 +252,12 @@ server <- function(input, output, session) {
|
|||
|
||||
shiny::observeEvent(
|
||||
input$modal_variables,
|
||||
modal_update_variables("modal_variables", title = "Update and select variables")
|
||||
modal_update_variables(
|
||||
id = "modal_variables",
|
||||
title = "Update and select variables",
|
||||
footer = tagList(
|
||||
actionButton("ok", "OK")
|
||||
))
|
||||
)
|
||||
|
||||
output$data_info <- shiny::renderUI({
|
||||
|
|
@ -259,12 +265,6 @@ server <- function(input, output, session) {
|
|||
data_description(data_filter())
|
||||
})
|
||||
|
||||
output$data_info_regression <- shiny::renderUI({
|
||||
shiny::req(regression_vars())
|
||||
shiny::req(rv$list$data)
|
||||
data_description(rv$list$data[regression_vars()])
|
||||
})
|
||||
|
||||
|
||||
######### Create factor
|
||||
|
||||
|
|
@ -348,7 +348,7 @@ server <- function(input, output, session) {
|
|||
shiny::reactive(rv$data),
|
||||
shiny::reactive(rv$data_original),
|
||||
data_filter(),
|
||||
regression_vars(),
|
||||
# regression_vars(),
|
||||
input$complete_cutoff
|
||||
),
|
||||
{
|
||||
|
|
@ -409,28 +409,32 @@ server <- function(input, output, session) {
|
|||
pagination = 20
|
||||
)
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
output$table_mod <- toastui::renderDatagrid({
|
||||
shiny::req(rv$data)
|
||||
# data <- rv$data
|
||||
toastui::datagrid(
|
||||
# data = rv$data # ,
|
||||
data = data_filter(),
|
||||
pagination = 10
|
||||
# bordered = TRUE,
|
||||
# compact = TRUE,
|
||||
# striped = TRUE
|
||||
)
|
||||
})
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
}
|
||||
)
|
||||
observeEvent(input$modal_browse, {
|
||||
datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
|
||||
})
|
||||
|
||||
# tryCatch(
|
||||
# {
|
||||
# output$table_mod <- toastui::renderDatagrid({
|
||||
# shiny::req(rv$data)
|
||||
# # data <- rv$data
|
||||
# toastui::datagrid(
|
||||
# # data = rv$data # ,
|
||||
# data = data_filter(),
|
||||
# pagination = 10
|
||||
# # bordered = TRUE,
|
||||
# # compact = TRUE,
|
||||
# # striped = TRUE
|
||||
# )
|
||||
# })
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0(err), type = "err")
|
||||
# }
|
||||
# )
|
||||
|
||||
output$original_str <- renderPrint({
|
||||
str(rv$data_original)
|
||||
|
|
@ -486,65 +490,65 @@ server <- function(input, output, session) {
|
|||
## Keep these "old" selection options as a simple alternative to the modification pane
|
||||
|
||||
|
||||
output$regression_vars <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = "regression_vars",
|
||||
selected = NULL,
|
||||
label = "Covariables to include",
|
||||
data = rv$data_filtered,
|
||||
multiple = TRUE,
|
||||
)
|
||||
})
|
||||
|
||||
output$outcome_var <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = "outcome_var",
|
||||
selected = NULL,
|
||||
label = "Select outcome variable",
|
||||
data = rv$data_filtered,
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$regression_type <- shiny::renderUI({
|
||||
shiny::req(input$outcome_var)
|
||||
shiny::selectizeInput(
|
||||
inputId = "regression_type",
|
||||
label = "Choose regression analysis",
|
||||
## The below ifelse statement handles the case of loading a new dataset
|
||||
choices = possible_functions(
|
||||
data = dplyr::select(
|
||||
rv$data_filtered,
|
||||
ifelse(input$outcome_var %in% names(rv$data_filtered),
|
||||
input$outcome_var,
|
||||
names(rv$data_filtered)[1]
|
||||
)
|
||||
), design = "cross-sectional"
|
||||
),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$factor_vars <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
inputId = "factor_vars",
|
||||
selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
|
||||
label = "Covariables to format as categorical",
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
## Collected regression variables
|
||||
regression_vars <- shiny::reactive({
|
||||
if (is.null(input$regression_vars)) {
|
||||
out <- colnames(rv$data_filtered)
|
||||
} else {
|
||||
out <- unique(c(input$regression_vars, input$outcome_var))
|
||||
}
|
||||
return(out)
|
||||
})
|
||||
|
||||
# output$regression_vars <- shiny::renderUI({
|
||||
# columnSelectInput(
|
||||
# inputId = "regression_vars",
|
||||
# selected = NULL,
|
||||
# label = "Covariables to include",
|
||||
# data = rv$data_filtered,
|
||||
# multiple = TRUE,
|
||||
# )
|
||||
# })
|
||||
#
|
||||
# output$outcome_var <- shiny::renderUI({
|
||||
# columnSelectInput(
|
||||
# inputId = "outcome_var",
|
||||
# selected = NULL,
|
||||
# label = "Select outcome variable",
|
||||
# data = rv$data_filtered,
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# })
|
||||
#
|
||||
# output$regression_type <- shiny::renderUI({
|
||||
# shiny::req(input$outcome_var)
|
||||
# shiny::selectizeInput(
|
||||
# inputId = "regression_type",
|
||||
# label = "Choose regression analysis",
|
||||
# ## The below ifelse statement handles the case of loading a new dataset
|
||||
# choices = possible_functions(
|
||||
# data = dplyr::select(
|
||||
# rv$data_filtered,
|
||||
# ifelse(input$outcome_var %in% names(rv$data_filtered),
|
||||
# input$outcome_var,
|
||||
# names(rv$data_filtered)[1]
|
||||
# )
|
||||
# ), design = "cross-sectional"
|
||||
# ),
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# })
|
||||
#
|
||||
# output$factor_vars <- shiny::renderUI({
|
||||
# shiny::selectizeInput(
|
||||
# inputId = "factor_vars",
|
||||
# selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
|
||||
# label = "Covariables to format as categorical",
|
||||
# choices = colnames(rv$data_filtered),
|
||||
# multiple = TRUE
|
||||
# )
|
||||
# })
|
||||
#
|
||||
# ## Collected regression variables
|
||||
# regression_vars <- shiny::reactive({
|
||||
# if (is.null(input$regression_vars)) {
|
||||
# out <- colnames(rv$data_filtered)
|
||||
# } else {
|
||||
# out <- unique(c(input$regression_vars, input$outcome_var))
|
||||
# }
|
||||
# return(out)
|
||||
# })
|
||||
#
|
||||
output$strat_var <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = "strat_var",
|
||||
|
|
@ -557,18 +561,18 @@ server <- function(input, output, session) {
|
|||
)
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
output$plot_model <- shiny::renderUI({
|
||||
shiny::req(rv$list$regression$tables)
|
||||
shiny::selectInput(
|
||||
inputId = "plot_model",
|
||||
selected = "none",
|
||||
label = "Select models to plot",
|
||||
choices = names(rv$list$regression$tables),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
#
|
||||
#
|
||||
# output$plot_model <- shiny::renderUI({
|
||||
# shiny::req(rv$list$regression$tables)
|
||||
# shiny::selectInput(
|
||||
# inputId = "plot_model",
|
||||
# selected = "none",
|
||||
# label = "Select models to plot",
|
||||
# choices = names(rv$list$regression$tables),
|
||||
# multiple = TRUE
|
||||
# )
|
||||
# })
|
||||
|
||||
|
||||
##############################################################################
|
||||
|
|
@ -656,193 +660,197 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
shiny::req(input$outcome_var)
|
||||
# browser()
|
||||
# Assumes all character variables can be formatted as factors
|
||||
# data <- data_filter$filtered() |>
|
||||
tryCatch(
|
||||
{
|
||||
## Which models to create should be decided by input
|
||||
## Could also include
|
||||
## imputed or
|
||||
## minimally adjusted
|
||||
model_lists <- list(
|
||||
"Univariable" = regression_model_uv_list,
|
||||
"Multivariable" = regression_model_list
|
||||
) |>
|
||||
lapply(\(.fun){
|
||||
ls <- do.call(
|
||||
.fun,
|
||||
c(
|
||||
list(data = rv$list$data |>
|
||||
(\(.x){
|
||||
.x[regression_vars()]
|
||||
})()),
|
||||
list(outcome.str = input$outcome_var),
|
||||
list(fun.descr = input$regression_type)
|
||||
)
|
||||
)
|
||||
})
|
||||
rv$regression <- regression_server("regression", data = shiny::reactive(rv$data_filtered))
|
||||
|
||||
# browser()
|
||||
# rv$list$regression <- regression_server("regression", data = shiny::reactive(rv$data_filtered))
|
||||
|
||||
rv$list$regression$params <- get_fun_options(input$regression_type) |>
|
||||
(\(.x){
|
||||
.x[[1]]
|
||||
})()
|
||||
|
||||
rv$list$regression$models <- model_lists
|
||||
|
||||
# names(rv$list$regression)
|
||||
|
||||
# rv$models <- lapply(model_lists, \(.x){
|
||||
# .x$model
|
||||
# })
|
||||
},
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
error = function(err) {
|
||||
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(
|
||||
ignoreInit = TRUE,
|
||||
list(
|
||||
rv$list$regression$models
|
||||
),
|
||||
{
|
||||
shiny::req(rv$list$regression$models)
|
||||
tryCatch(
|
||||
{
|
||||
rv$check <- lapply(rv$list$regression$models, \(.x){
|
||||
.x$model
|
||||
}) |>
|
||||
purrr::pluck("Multivariable") |>
|
||||
performance::check_model()
|
||||
},
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
error = function(err) {
|
||||
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
output$check <- shiny::renderPlot(
|
||||
{
|
||||
shiny::req(rv$check)
|
||||
# browser()
|
||||
# p <- plot(rv$check) +
|
||||
# patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
|
||||
p <- plot(rv$check) +
|
||||
patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
|
||||
for (i in seq_len(length(p))) {
|
||||
p[[i]] <- p[[i]] + gg_theme_shiny()
|
||||
}
|
||||
|
||||
p
|
||||
|
||||
# p + patchwork::plot_layout(ncol = 1, design = ggplot2::waiver())
|
||||
|
||||
# Generate checks in one column
|
||||
# layout <- sapply(seq_len(length(p)), \(.x){
|
||||
# patchwork::area(.x, 1)
|
||||
# })
|
||||
#
|
||||
# p + patchwork::plot_layout(design = Reduce(c, layout))
|
||||
|
||||
# patchwork::wrap_plots(ncol=1) +
|
||||
# patchwork::plot_annotation(title = 'Multivariable regression model checks')
|
||||
},
|
||||
height = 600,
|
||||
alt = "Assumptions testing of the multivariable regression model"
|
||||
)
|
||||
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
shiny::req(rv$list$regression$models)
|
||||
tryCatch(
|
||||
{
|
||||
out <- lapply(rv$list$regression$models, \(.x){
|
||||
.x$model
|
||||
}) |>
|
||||
purrr::map(regression_table)
|
||||
|
||||
if (input$add_regression_p == "no") {
|
||||
out <- out |>
|
||||
lapply(\(.x){
|
||||
.x |>
|
||||
gtsummary::modify_column_hide(
|
||||
column = "p.value"
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
rv$list$regression$tables <- out
|
||||
|
||||
# rv$list$regression$table <- out |>
|
||||
# tbl_merge()
|
||||
|
||||
# gtsummary::as_kable(rv$list$regression$table) |>
|
||||
# readr::write_lines(file="./www/_regression_table.md")
|
||||
|
||||
rv$list$input <- input
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
rv$ready <- "ready"
|
||||
}
|
||||
)
|
||||
|
||||
output$table2 <- gt::render_gt({
|
||||
shiny::req(rv$list$regression$tables)
|
||||
rv$list$regression$tables |>
|
||||
tbl_merge() |>
|
||||
gtsummary::as_gt() |>
|
||||
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
|
||||
})
|
||||
|
||||
output$regression_plot <- shiny::renderPlot(
|
||||
{
|
||||
# shiny::req(rv$list$regression$plot)
|
||||
shiny::req(input$plot_model)
|
||||
|
||||
out <- merge_long(rv$list$regression, input$plot_model) |>
|
||||
plot.tbl_regression(
|
||||
colour = "variable",
|
||||
facet_col = "model"
|
||||
)
|
||||
|
||||
out +
|
||||
ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
gg_theme_shiny()
|
||||
|
||||
# rv$list$regression$tables$Multivariable |>
|
||||
# plot(colour = "variable") +
|
||||
# ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
# gg_theme_shiny()
|
||||
},
|
||||
height = 500,
|
||||
alt = "Regression coefficient plot"
|
||||
)
|
||||
# shiny::observeEvent(
|
||||
# input$load,
|
||||
# {
|
||||
# shiny::req(input$outcome_var)
|
||||
# # browser()
|
||||
# # Assumes all character variables can be formatted as factors
|
||||
# # data <- data_filter$filtered() |>
|
||||
# tryCatch(
|
||||
# {
|
||||
# ## Which models to create should be decided by input
|
||||
# ## Could also include
|
||||
# ## imputed or
|
||||
# ## minimally adjusted
|
||||
# model_lists <- list(
|
||||
# "Univariable" = regression_model_uv_list,
|
||||
# "Multivariable" = regression_model_list
|
||||
# ) |>
|
||||
# lapply(\(.fun){
|
||||
# ls <- do.call(
|
||||
# .fun,
|
||||
# c(
|
||||
# list(data = rv$list$data |>
|
||||
# (\(.x){
|
||||
# .x[regression_vars()]
|
||||
# })()),
|
||||
# list(outcome.str = input$outcome_var),
|
||||
# list(fun.descr = input$regression_type)
|
||||
# )
|
||||
# )
|
||||
# })
|
||||
#
|
||||
# # browser()
|
||||
#
|
||||
# rv$list$regression$params <- get_fun_options(input$regression_type) |>
|
||||
# (\(.x){
|
||||
# .x[[1]]
|
||||
# })()
|
||||
#
|
||||
# rv$list$regression$models <- model_lists
|
||||
#
|
||||
# # names(rv$list$regression)
|
||||
#
|
||||
# # rv$models <- lapply(model_lists, \(.x){
|
||||
# # .x$model
|
||||
# # })
|
||||
# },
|
||||
# # warning = function(warn) {
|
||||
# # showNotification(paste0(warn), type = "warning")
|
||||
# # },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
|
||||
# }
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
#
|
||||
# shiny::observeEvent(
|
||||
# ignoreInit = TRUE,
|
||||
# list(
|
||||
# rv$list$regression$models
|
||||
# ),
|
||||
# {
|
||||
# shiny::req(rv$list$regression$models)
|
||||
# tryCatch(
|
||||
# {
|
||||
# rv$check <- lapply(rv$list$regression$models, \(.x){
|
||||
# .x$model
|
||||
# }) |>
|
||||
# purrr::pluck("Multivariable") |>
|
||||
# performance::check_model()
|
||||
# },
|
||||
# # warning = function(warn) {
|
||||
# # showNotification(paste0(warn), type = "warning")
|
||||
# # },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
|
||||
# }
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
#
|
||||
# output$check <- shiny::renderPlot(
|
||||
# {
|
||||
# shiny::req(rv$check)
|
||||
# # browser()
|
||||
# # p <- plot(rv$check) +
|
||||
# # patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
#
|
||||
# p <- plot(rv$check) +
|
||||
# patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
#
|
||||
# for (i in seq_len(length(p))) {
|
||||
# p[[i]] <- p[[i]] + gg_theme_shiny()
|
||||
# }
|
||||
#
|
||||
# p
|
||||
#
|
||||
# # p + patchwork::plot_layout(ncol = 1, design = ggplot2::waiver())
|
||||
#
|
||||
# # Generate checks in one column
|
||||
# # layout <- sapply(seq_len(length(p)), \(.x){
|
||||
# # patchwork::area(.x, 1)
|
||||
# # })
|
||||
# #
|
||||
# # p + patchwork::plot_layout(design = Reduce(c, layout))
|
||||
#
|
||||
# # patchwork::wrap_plots(ncol=1) +
|
||||
# # patchwork::plot_annotation(title = 'Multivariable regression model checks')
|
||||
# },
|
||||
# height = 600,
|
||||
# alt = "Assumptions testing of the multivariable regression model"
|
||||
# )
|
||||
#
|
||||
#
|
||||
# shiny::observeEvent(
|
||||
# input$load,
|
||||
# {
|
||||
# shiny::req(rv$list$regression$models)
|
||||
# tryCatch(
|
||||
# {
|
||||
# out <- lapply(rv$list$regression$models, \(.x){
|
||||
# .x$model
|
||||
# }) |>
|
||||
# purrr::map(regression_table)
|
||||
#
|
||||
# if (input$add_regression_p == "no") {
|
||||
# out <- out |>
|
||||
# lapply(\(.x){
|
||||
# .x |>
|
||||
# gtsummary::modify_column_hide(
|
||||
# column = "p.value"
|
||||
# )
|
||||
# })
|
||||
# }
|
||||
#
|
||||
# rv$list$regression$tables <- out
|
||||
#
|
||||
# # rv$list$regression$table <- out |>
|
||||
# # tbl_merge()
|
||||
#
|
||||
# # gtsummary::as_kable(rv$list$regression$table) |>
|
||||
# # readr::write_lines(file="./www/_regression_table.md")
|
||||
#
|
||||
# rv$list$input <- input
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
|
||||
# }
|
||||
# )
|
||||
# rv$ready <- "ready"
|
||||
# }
|
||||
# )
|
||||
#
|
||||
# output$table2 <- gt::render_gt({
|
||||
# shiny::req(rv$list$regression$tables)
|
||||
# rv$list$regression$tables |>
|
||||
# tbl_merge() |>
|
||||
# gtsummary::as_gt() |>
|
||||
# gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
|
||||
# })
|
||||
#
|
||||
# output$regression_plot <- shiny::renderPlot(
|
||||
# {
|
||||
# # shiny::req(rv$list$regression$plot)
|
||||
# shiny::req(input$plot_model)
|
||||
#
|
||||
# out <- merge_long(rv$list$regression, input$plot_model) |>
|
||||
# plot.tbl_regression(
|
||||
# colour = "variable",
|
||||
# facet_col = "model"
|
||||
# )
|
||||
#
|
||||
# out +
|
||||
# ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
# gg_theme_shiny()
|
||||
#
|
||||
# # rv$list$regression$tables$Multivariable |>
|
||||
# # plot(colour = "variable") +
|
||||
# # ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
# # gg_theme_shiny()
|
||||
# },
|
||||
# height = 500,
|
||||
# alt = "Regression coefficient plot"
|
||||
# )
|
||||
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "output.uploaded == 'yes'",
|
||||
|
|
@ -912,21 +920,26 @@ server <- function(input, output, session) {
|
|||
# shiny::req(rv$list$regression)
|
||||
## Notification is not progressing
|
||||
## Presumably due to missing
|
||||
|
||||
# browser()
|
||||
# Simplified for .rmd output attempt
|
||||
format <- ifelse(type == "docx", "word_document", "odt_document")
|
||||
|
||||
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
|
||||
rv$list |>
|
||||
write_rmd(
|
||||
output_format = format,
|
||||
input = file.path(getwd(), "www/report.rmd")
|
||||
)
|
||||
# browser()
|
||||
rv$list$regression <- rv$regression()
|
||||
|
||||
# write_quarto(
|
||||
# output_format = type,
|
||||
# input = file.path(getwd(), "www/report.qmd")
|
||||
# )
|
||||
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
|
||||
tryCatch(
|
||||
{
|
||||
rv$list |>
|
||||
write_rmd(
|
||||
output_format = format,
|
||||
input = file.path(getwd(), "www/report.rmd")
|
||||
)
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error creating your report: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
file.rename(paste0("www/report.", type), file)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -146,27 +146,34 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::column(
|
||||
width = 3,
|
||||
shiny::actionButton(
|
||||
inputId = "modal_browse",
|
||||
label = "Browse data",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
IDEAFilter::IDEAFilter_ui("data_filter"),
|
||||
shiny::tags$br()
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Browse",
|
||||
tags$h3("Browse the provided data"),
|
||||
shiny::tags$p(
|
||||
"Below is a table with all the modified data provided to browse and understand data."
|
||||
),
|
||||
shinyWidgets::html_dependency_winbox(),
|
||||
fluidRow(
|
||||
toastui::datagridOutput(outputId = "table_mod")
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
),
|
||||
# bslib::nav_panel(
|
||||
# title = "Browse",
|
||||
# tags$h3("Browse the provided data"),
|
||||
# shiny::tags$p(
|
||||
# "Below is a table with all the modified data provided to browse and understand data."
|
||||
# ),
|
||||
# shinyWidgets::html_dependency_winbox(),
|
||||
# fluidRow(
|
||||
# toastui::datagridOutput(outputId = "table_mod")
|
||||
# ),
|
||||
# shiny::tags$br(),
|
||||
# shiny::tags$br(),
|
||||
# shiny::tags$br(),
|
||||
# shiny::tags$br(),
|
||||
# shiny::tags$br()
|
||||
# ),
|
||||
bslib::nav_panel(
|
||||
title = "Modify",
|
||||
tags$h3("Subset, rename and convert variables"),
|
||||
|
|
@ -178,26 +185,31 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
update_variables_ui("modal_variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 2
|
||||
),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
tags$h4("Advanced data manipulation"),
|
||||
shiny::tags$br(),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
tags$h4("Update or modify variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_variables",
|
||||
label = "Subset, rename and change class/type",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
# tags$h4("Update or modify variables"),
|
||||
# shiny::tags$br(),
|
||||
# shiny::actionButton(
|
||||
# inputId = "modal_variables",
|
||||
# label = "Subset, rename and change class/type",
|
||||
# width = "100%"
|
||||
# ),
|
||||
# shiny::tags$br(),
|
||||
# shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
|
||||
# shiny::tags$br(),
|
||||
# shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_update",
|
||||
label = "Reorder factor levels",
|
||||
|
|
@ -206,12 +218,21 @@ ui_elements <- list(
|
|||
shiny::tags$br(),
|
||||
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
tags$h4("Create new variables"),
|
||||
shiny::tags$br(),
|
||||
# tags$h4("Create new variables"),
|
||||
# shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_cut",
|
||||
label = "New factor",
|
||||
|
|
@ -231,15 +252,15 @@ ui_elements <- list(
|
|||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
)
|
||||
),
|
||||
tags$h4("Restore"),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
|
||||
) # ,
|
||||
# tags$h4("Restore"),
|
||||
# shiny::actionButton(
|
||||
# inputId = "data_reset",
|
||||
# label = "Restore original data",
|
||||
# width = "100%"
|
||||
# ),
|
||||
# shiny::tags$br(),
|
||||
# shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
|
||||
),
|
||||
shiny::column(
|
||||
width = 2
|
||||
|
|
@ -247,10 +268,10 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
tags$h4("Restore"),
|
||||
tags$h4("Compare modified data to original"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$p(
|
||||
"Below, you'll find a raw overview of the original vs the modified data."
|
||||
"Here is a overview of the original vs the modified data."
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
|
|
@ -385,110 +406,114 @@ ui_elements <- list(
|
|||
bslib::nav_panel(
|
||||
title = "Regression",
|
||||
id = "navanalyses",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
# fillable = TRUE,
|
||||
sidebar = bslib::sidebar(
|
||||
shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
|
||||
bslib::accordion(
|
||||
open = "acc_reg",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_reg",
|
||||
title = "Regression",
|
||||
icon = bsicons::bs_icon("calculator"),
|
||||
shiny::uiOutput("outcome_var"),
|
||||
# shiny::selectInput(
|
||||
# inputId = "design",
|
||||
# label = "Study design",
|
||||
# selected = "no",
|
||||
# inline = TRUE,
|
||||
# choices = list(
|
||||
# "Cross-sectional" = "cross-sectional"
|
||||
# )
|
||||
# ),
|
||||
shiny::uiOutput("regression_type"),
|
||||
shiny::radioButtons(
|
||||
inputId = "add_regression_p",
|
||||
label = "Add p-value",
|
||||
inline = TRUE,
|
||||
selected = "yes",
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
),
|
||||
bslib::input_task_button(
|
||||
id = "load",
|
||||
label = "Analyse",
|
||||
# icon = shiny::icon("pencil", lib = "glyphicon"),
|
||||
icon = bsicons::bs_icon("pencil"),
|
||||
label_busy = "Working...",
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("Press 'Analyse' again after changing parameters."),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput("plot_model")
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
value = "acc_advanced",
|
||||
title = "Advanced",
|
||||
icon = bsicons::bs_icon("gear"),
|
||||
shiny::radioButtons(
|
||||
inputId = "all",
|
||||
label = "Specify covariables",
|
||||
inline = TRUE, selected = 2,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c(1, 2)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.all==1",
|
||||
shiny::uiOutput("regression_vars")
|
||||
)
|
||||
)
|
||||
),
|
||||
# shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
# shiny::radioButtons(
|
||||
# inputId = "specify_factors",
|
||||
# label = "Specify categorical variables?",
|
||||
# selected = "no",
|
||||
# inline = TRUE,
|
||||
# choices = list(
|
||||
# "Yes" = "yes",
|
||||
# "No" = "no"
|
||||
# )
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "input.specify_factors=='yes'",
|
||||
# shiny::uiOutput("factor_vars")
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "output.ready=='yes'",
|
||||
# shiny::tags$hr(),
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
gt::gt_output(outputId = "table2")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Coefficient plot",
|
||||
shiny::plotOutput(outputId = "regression_plot")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Model checks",
|
||||
shiny::plotOutput(outputId = "check")
|
||||
# shiny::uiOutput(outputId = "check_1")
|
||||
)
|
||||
do.call(
|
||||
bslib::navset_bar,
|
||||
regression_ui("regression")
|
||||
)
|
||||
# bslib::navset_bar(
|
||||
# title = "",
|
||||
# # bslib::layout_sidebar(
|
||||
# # fillable = TRUE,
|
||||
# sidebar = bslib::sidebar(
|
||||
# shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
|
||||
# bslib::accordion(
|
||||
# open = "acc_reg",
|
||||
# multiple = FALSE,
|
||||
# bslib::accordion_panel(
|
||||
# value = "acc_reg",
|
||||
# title = "Regression",
|
||||
# icon = bsicons::bs_icon("calculator"),
|
||||
# shiny::uiOutput("outcome_var"),
|
||||
# # shiny::selectInput(
|
||||
# # inputId = "design",
|
||||
# # label = "Study design",
|
||||
# # selected = "no",
|
||||
# # inline = TRUE,
|
||||
# # choices = list(
|
||||
# # "Cross-sectional" = "cross-sectional"
|
||||
# # )
|
||||
# # ),
|
||||
# shiny::uiOutput("regression_type"),
|
||||
# shiny::radioButtons(
|
||||
# inputId = "add_regression_p",
|
||||
# label = "Add p-value",
|
||||
# inline = TRUE,
|
||||
# selected = "yes",
|
||||
# choices = list(
|
||||
# "Yes" = "yes",
|
||||
# "No" = "no"
|
||||
# )
|
||||
# ),
|
||||
# bslib::input_task_button(
|
||||
# id = "load",
|
||||
# label = "Analyse",
|
||||
# # icon = shiny::icon("pencil", lib = "glyphicon"),
|
||||
# icon = bsicons::bs_icon("pencil"),
|
||||
# label_busy = "Working...",
|
||||
# icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
# class = "fa-spin",
|
||||
# "aria-hidden" = "true"
|
||||
# ),
|
||||
# type = "secondary",
|
||||
# auto_reset = TRUE
|
||||
# ),
|
||||
# shiny::helpText("Press 'Analyse' again after changing parameters."),
|
||||
# shiny::tags$br(),
|
||||
# shiny::uiOutput("plot_model")
|
||||
# ),
|
||||
# bslib::accordion_panel(
|
||||
# value = "acc_advanced",
|
||||
# title = "Advanced",
|
||||
# icon = bsicons::bs_icon("gear"),
|
||||
# shiny::radioButtons(
|
||||
# inputId = "all",
|
||||
# label = "Specify covariables",
|
||||
# inline = TRUE, selected = 2,
|
||||
# choiceNames = c(
|
||||
# "Yes",
|
||||
# "No"
|
||||
# ),
|
||||
# choiceValues = c(1, 2)
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "input.all==1",
|
||||
# shiny::uiOutput("regression_vars")
|
||||
# )
|
||||
# )
|
||||
# ),
|
||||
# # shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
# # shiny::radioButtons(
|
||||
# # inputId = "specify_factors",
|
||||
# # label = "Specify categorical variables?",
|
||||
# # selected = "no",
|
||||
# # inline = TRUE,
|
||||
# # choices = list(
|
||||
# # "Yes" = "yes",
|
||||
# # "No" = "no"
|
||||
# # )
|
||||
# # ),
|
||||
# # shiny::conditionalPanel(
|
||||
# # condition = "input.specify_factors=='yes'",
|
||||
# # shiny::uiOutput("factor_vars")
|
||||
# # ),
|
||||
# # shiny::conditionalPanel(
|
||||
# # condition = "output.ready=='yes'",
|
||||
# # shiny::tags$hr(),
|
||||
# ),
|
||||
# bslib::nav_panel(
|
||||
# title = "Regression table",
|
||||
# gt::gt_output(outputId = "table2")
|
||||
# ),
|
||||
# bslib::nav_panel(
|
||||
# title = "Coefficient plot",
|
||||
# shiny::plotOutput(outputId = "regression_plot")
|
||||
# ),
|
||||
# bslib::nav_panel(
|
||||
# title = "Model checks",
|
||||
# shiny::plotOutput(outputId = "check")
|
||||
# # shiny::uiOutput(outputId = "check_1")
|
||||
# )
|
||||
# )
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -635,7 +660,7 @@ ui <- bslib::page_fixed(
|
|||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
"AG Damsbo | v", app_version(), " | ", shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
|
|||
BIN
inst/apps/FreesearchR/www/favicon.ico
Normal file
BIN
inst/apps/FreesearchR/www/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 31 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 6.4 KiB After Width: | Height: | Size: 31 KiB |
|
|
@ -15,6 +15,7 @@ knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
|
|||
|
||||
```{r}
|
||||
web_data <- readr::read_rds(file = params$data.file)
|
||||
# web_data <- readr::read_rds(file = "~/FreesearchR/inst/apps/FreesearchR/www/web_data.rds")
|
||||
library(gtsummary)
|
||||
library(gt)
|
||||
|
||||
|
|
@ -52,21 +53,21 @@ Analyses were conducted in the *FreesearchR* data analysis web-tool based on R v
|
|||
Below are the baseline characteristics.
|
||||
|
||||
```{r, results = 'asis'}
|
||||
if ("table1" %in% names(web_data)){
|
||||
tbl <- gtsummary::as_gt(web_data$table1)
|
||||
knitr::knit_print(tbl)}
|
||||
if ("table1" %in% names(web_data)) {
|
||||
tbl <- gtsummary::as_gt(web_data$table1)
|
||||
knitr::knit_print(tbl)
|
||||
}
|
||||
```
|
||||
|
||||
`r if ("regression" %in% names(web_data)) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$tables)))} {web_data$regression$params$descr}.")`
|
||||
`r if (length(web_data$regression) > 0) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$regression$tables)))} {web_data$regression$regression$params$descr}.")`
|
||||
|
||||
```{r, results = 'asis'}
|
||||
if ("regression" %in% names(web_data)){
|
||||
reg_tbl <- web_data$regression$tables
|
||||
knitr::knit_print(tbl_merge(reg_tbl))
|
||||
if ("regression" %in% names(web_data) && length(web_data$regression) > 0) {
|
||||
reg_tbl <- web_data$regression$regression$tables
|
||||
knitr::knit_print(tbl_merge(reg_tbl))
|
||||
}
|
||||
```
|
||||
|
||||
## Discussion
|
||||
|
||||
Good luck on your further work!
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue