This commit is contained in:
Andreas Gammelgaard Damsbo 2024-12-13 13:37:19 +01:00
commit 7b1d55ebc8
No known key found for this signature in database
7 changed files with 1070 additions and 200 deletions

View file

@ -23,6 +23,9 @@ library(REDCapCAST)
library(easystats)
library(patchwork)
library(DHARMa)
library(datamods)
library(toastui)
library(IDEAFilter)
# if (!requireNamespace("webResearch")) {
# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
# }
@ -43,13 +46,14 @@ server <- function(input, output, session) {
input = exists("webResearch_data"),
local_temp = NULL,
quarto = NULL,
test = "no"
test = "no",
data = NULL
)
data_file <- datamods::import_file_server(
id = "file_import",
show_data_in = "popup",
trigger_return = "button",
trigger_return = "change",
return_class = "data.frame",
read_fns = list(
ods = function(file) {
@ -68,13 +72,28 @@ server <- function(input, output, session) {
output$redcap_prev <- DT::renderDT(
{
DT::datatable(head(purrr::pluck(data_redcap(), 1)(), 5),
DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
caption = "First 5 observations"
)
},
server = TRUE
)
data_rv <- shiny::reactiveValues(data = NULL)
#
# shiny::observeEvent(data_file$data(), {
# data_rv$data <- data_file$data() |>
# REDCapCAST::numchar2fct()
# })
#
# shiny::observeEvent(purrr::pluck(ds(), "data")(), {
# data_rv$data <- purrr::pluck(ds(), "data")() |>
# REDCapCAST::parse_data() |>
# REDCapCAST::as_factor() |>
# REDCapCAST::numchar2fct()
# })
ds <- shiny::reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
@ -82,13 +101,11 @@ server <- function(input, output, session) {
if (v$input) {
out <- webResearch_data
} else if (input$source == "file") {
out <- data_file$data() |>
REDCapCAST::numchar2fct()
req(data_file$data())
out <- data_file$data()
} else if (input$source == "redcap") {
out <- purrr::pluck(data_redcap(), 1)() |>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
REDCapCAST::numchar2fct()
req(purrr::pluck(data_redcap(), "data")())
out <- purrr::pluck(data_redcap(), "data")()
}
v$ds <- "loaded"
@ -97,53 +114,206 @@ server <- function(input, output, session) {
# out <- out |>
# REDCapCAST::numchar2fct()
# }
out <- out|>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
REDCapCAST::numchar2fct()
data_rv$data <- shiny::reactive(out)
out
})
# shiny::reactive({
# if (!is.null(data_rv$data)){
# data_rv$data <- shiny::reactive(data_rv$data() |> REDCapCAST::parse_data() |>
# REDCapCAST::as_factor() |>
# REDCapCAST::numchar2fct())
# }
# })
output$table <-
DT::renderDT(
{
DT::datatable(
ds())
},
server = FALSE
)
##############################################################################
#########
######### Data modification section
#########
##############################################################################
######### Modifications
rv <- shiny::reactiveValues(data = reactive(ds() ))
observeEvent(ds(), rv$data <- ds())
observeEvent(input$data_reset, rv$data <- ds())
## Using modified version of the datamods::cut_variable_server function
## Further modifications are needed to have cut/bin options based on class of variable
## Could be defined server-side
observeEvent(input$modal_cut, modal_cut_variable("modal_cut"))
data_modal_cut <- cut_variable_server(
id = "modal_cut",
data_r = reactive(rv$data)
)
observeEvent(data_modal_cut(), rv$data <- data_modal_cut())
observeEvent(input$modal_update, datamods::modal_update_factor("modal_update"))
data_modal_update <- datamods::update_factor_server(
id = "modal_update",
data_r = reactive(rv$data)
)
observeEvent(data_modal_update(), {
shiny::removeModal()
rv$data <- data_modal_update()
})
# Show result
output$table_mod <- toastui::renderDatagrid2({
req(rv$data)
# data <- rv$data
toastui::datagrid(
data = rv$data#,
# bordered = TRUE,
# compact = TRUE,
# striped = TRUE
)
})
output$code <- renderPrint({
attr(rv$data, "code")
})
updated_data <- datamods::update_variables_server(
id = "vars_update",
data = reactive(rv$data),
return_data_on_init = FALSE
)
output$original_str <- renderPrint({
str(ds())
})
output$modified_str <- renderPrint({
str(rv$data)
})
observeEvent(updated_data(), {
rv$data <- updated_data()
})
# datamods filtering has the least attractive ui, but it does work well
#
# output$filter_vars <- shiny::renderUI({
# shinyWidgets::virtualSelectInput(
# inputId = "filter_vars",
# selected = NULL,
# label = "Covariables to include",
# choices = colnames(ds()),
# multiple = TRUE,
# updateOn = "change"
# )
# })
# data_filter <- datamods::filter_data_server(
# id = "filtering",
# data = ds,
# widget_num = "slider",
# widget_date = "slider",
# label_na = "Missing",
# vars = shiny::reactive(input$filter_vars)
# )
#
# output$filtered_table <-
# DT::renderDT(
# {
# DT::datatable(data_filter$filtered())
# },
# server = TRUE
# )
#
# output$filtered_code <- shiny::renderPrint({
# data_filter$code()
# })
# IDEAFilter has the least cluttered UI, but might have a License issue
data_filter <- IDEAFilter::IDEAFilter("data_filter", data = reactive(rv$data), verbose = TRUE)
observeEvent(input$save_filter, {
rv$data <- data_filter()
})
output$filtered_code <- shiny::renderPrint({
gsub("reactive(rv$data)", "data",
cat(gsub("%>%", "|> \n ",
gsub("\\s{2,}", " ",
paste0(
capture.output(attr(data_filter(), "code")),
collapse = " "))
)))
})
##############################################################################
#########
######### Data analyses section
#########
##############################################################################
## Keep these "old" selection options as a simple alternative to the modification pane
output$include_vars <- shiny::renderUI({
selectizeInput(
shiny::selectizeInput(
inputId = "include_vars",
selected = NULL,
label = "Covariables to include",
choices = colnames(ds()),
choices = colnames(rv$data),
multiple = TRUE
)
})
output$outcome_var <- shiny::renderUI({
selectInput(
shiny::selectInput(
inputId = "outcome_var",
selected = NULL,
label = "Select outcome variable",
choices = colnames(ds()),
choices = colnames(rv$data),
multiple = FALSE
)
})
output$strat_var <- shiny::renderUI({
selectInput(
shiny::selectInput(
inputId = "strat_var",
selected = "none",
label = "Select variable to stratify baseline",
choices = c("none", colnames(ds()[base_vars()])),
choices = c("none", colnames(rv$data[base_vars()])),
multiple = FALSE
)
})
output$factor_vars <- shiny::renderUI({
selectizeInput(
shiny::selectizeInput(
inputId = "factor_vars",
selected = colnames(ds())[sapply(ds(), is.factor)],
selected = colnames(rv$data)[sapply(rv$data, is.factor)],
label = "Covariables to format as categorical",
choices = colnames(ds()),
choices = colnames(rv$data),
multiple = TRUE
)
})
base_vars <- shiny::reactive({
if (is.null(input$include_vars)) {
out <- colnames(ds())
out <- colnames(rv$data)
} else {
out <- unique(c(input$include_vars, input$outcome_var))
}
@ -171,7 +341,7 @@ server <- function(input, output, session) {
})
shiny::observeEvent(input$act_start, {
bslib::nav_select(id = "main_panel", selected = "Data analysis")
bslib::nav_select(id = "main_panel", selected = "Overview and modifications")
})
shiny::observeEvent(
@ -180,12 +350,13 @@ server <- function(input, output, session) {
},
{
shiny::req(input$outcome_var)
# browser()
# Assumes all character variables can be formatted as factors
data <- ds() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
data <- data |> factorize(vars = input$factor_vars)
# data <- data_filter$filtered() |>
data <- rv$data |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
REDCapCAST::fct_drop.data.frame() |>
factorize(vars = input$factor_vars)
# if (is.factor(data[[input$strat_var]])) {
# by.var <- input$strat_var

View file

@ -8,68 +8,149 @@ requireNamespace("gt")
# ns <- NS(id)
ui_elements <- list(
# bslib::nav_panel(
# title = "Data overview",
# # shiny::uiOutput("data.classes"),
# # shiny::uiOutput("data.input"),
# # shiny::p("Classes of uploaded data"),
# # gt::gt_output("data.classes"),
# shiny::p("Subset data"),
# DT::DTOutput(outputId = "data.input")
# ),
# bslib::nav_panel(
# title = "Baseline characteristics",
# gt::gt_output(outputId = "table1")
# ),
# bslib::nav_panel(
# title = "Regression table",
# gt::gt_output(outputId = "table2")
# ),
# bslib::nav_panel(
# title = "Regression checks",
# shiny::plotOutput(outputId = "check")
# ),
##############################################################################
#########
######### Import panel
#########
##############################################################################
"import" = bslib::nav_panel(
title = "Data import",
shiny::h4("Upload your dataset"),
shiny::conditionalPanel(
condition = "output.has_input=='yes'",
# Input: Select a file ----
shiny::helpText("Analyses are performed on provided data")
),
shiny::conditionalPanel(
condition = "output.has_input=='no'",
# Input: Select a file ----
shiny::radioButtons(
inputId = "source",
label = "Upload file or export from REDCap?",
selected = "file",
inline = TRUE,
choices = list(
"File" = "file",
"REDCap" = "redcap"
title = "Import",
shiny::fluidRow(
column(
width = 6,
shiny::h4("Choose your data source"),
shiny::conditionalPanel(
condition = "output.has_input=='yes'",
# Input: Select a file ----
shiny::helpText("Analyses are performed on provided data")
),
shiny::conditionalPanel(
condition = "output.has_input=='no'",
# Input: Select a file ----
shiny::radioButtons(
inputId = "source",
label = "Upload file or export from REDCap?",
selected = "file",
inline = TRUE,
choices = list(
"File" = "file",
"REDCap" = "redcap"
)
),
shiny::conditionalPanel(
condition = "input.source=='file'",
datamods::import_file_ui("file_import",
title = "Choose a datafile to upload",
file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta")
)
),
shiny::conditionalPanel(
condition = "input.source=='redcap'",
m_redcap_readUI("redcap_import")
)
)
),
shiny::conditionalPanel(
condition = "input.source=='file'",
datamods::import_file_ui("file_import",
title = "Choose a datafile to upload",
file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta")
)
),
shiny::conditionalPanel(
condition = "input.source=='redcap'",
m_redcap_readUI("redcap_import"),
DT::DTOutput(outputId = "redcap_prev")
column(
width = 6,
shiny::markdown("
# Welcome
This is the ***freesearchR*** web data analysis tool. An opiniotaed tool for easy data analysis at the hands of the clinician.
By intention, this is a focused app, with only few data modification tools included to keep the workflow streamlined.
")
)
),
shiny::conditionalPanel(
condition = "input.source=='redcap'",
DT::DTOutput(outputId = "redcap_prev")
),
shiny::br(),
shiny::actionButton(inputId = "act_start",label = "Start")
shiny::actionButton(inputId = "act_start", label = "Start")
),
##############################################################################
#########
######### Data overview panel
#########
##############################################################################
"overview" = bslib::nav_panel(
title = "Overview and modifications",
bslib::navset_bar(fillable = TRUE,
# bslib::nav_panel(
# title = "Edit",
# datamods::edit_data_ui(id = "edit_data")
# ),
# bslib::nav_panel(
# title = "Overview",
# DT::DTOutput(outputId = "table")
# ),
bslib::nav_panel(
title = "Rename and select",
tags$h3("Select, rename and convert variables"),
fluidRow(
column(
width = 6,
# radioButtons()
shiny::actionButton("data_reset", "Restore original data"),
datamods::update_variables_ui("vars_update")
),
column(
width = 6,
tags$b("Original data:"),
# verbatimTextOutput("original"),
verbatimTextOutput("original_str"),
tags$b("Modified data:"),
# verbatimTextOutput("modified"),
verbatimTextOutput("modified_str")
)
)
),
bslib::nav_panel(
title = "Filter and modify",
shinyWidgets::html_dependency_winbox(),
fluidRow(
# column(
# width = 3,
# shiny::uiOutput("filter_vars"),
# shiny::conditionalPanel(
# condition = "(typeof input.filter_vars !== 'undefined' && input.filter_vars.length > 0)",
# datamods::filter_data_ui("filtering", max_height = "500px")
# )
# ),
# column(
# width = 9,
# DT::DTOutput(outputId = "filtered_table"),
# tags$b("Code dplyr:"),
# verbatimTextOutput(outputId = "filtered_code")
# ),
shiny::column(
width = 8,
toastui::datagridOutput2(outputId = "table_mod"),
shiny::tags$b("Reproducible code:"),
shiny::verbatimTextOutput(outputId = "filtered_code")
),
shiny::column(
width = 4,
shiny::actionButton("modal_cut", "Cut a variable"),
shiny::tags$br(),
shiny::tags$br(),
shiny::actionButton("modal_update", "Update factor's levels"),
shiny::tags$br(),
shiny::tags$br(),
IDEAFilter::IDEAFilter_ui("data_filter"),
shiny::actionButton("save_filter", "Apply the filter")
)
)
)
# column(
# 8,
# shiny::verbatimTextOutput("filtered_code"),
# DT::DTOutput("filtered_table")
# ),
# column(4, IDEAFilter::IDEAFilter_ui("data_filter"))
)
),
##############################################################################
#########
@ -77,77 +158,72 @@ ui_elements <- list(
#########
##############################################################################
"analyze" = bslib::nav_panel(
title = "Data analysis",
bslib::page_navbar(
title = "Analysis",
bslib::navset_bar(
title = "",
# bslib::layout_sidebar(
# fillable = TRUE,
sidebar = bslib::sidebar(
shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
shiny::uiOutput("outcome_var"),
shiny::uiOutput("strat_var"),
shiny::conditionalPanel(
condition = "input.strat_var!='none'",
shiny::radioButtons(
inputId = "add_p",
label = "Compare strata?",
selected = "no",
inline = TRUE,
choices = list(
"No" = "no",
"Yes" = "yes"
)
),
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
),
sidebar = bslib::sidebar(
shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
shiny::uiOutput("outcome_var"),
shiny::uiOutput("strat_var"),
shiny::conditionalPanel(
condition = "input.strat_var!='none'",
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("include_vars")
),
shiny::radioButtons(
inputId = "specify_factors",
label = "Specify categorical variables?",
inputId = "add_p",
label = "Compare strata?",
selected = "no",
inline = TRUE,
choices = list(
"Yes" = "yes",
"No" = "no"
"No" = "no",
"Yes" = "yes"
)
),
shiny::conditionalPanel(
condition = "input.specify_factors=='yes'",
shiny::uiOutput("factor_vars")
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
),
shiny::radioButtons(
inputId = "all",
label = "Specify covariables",
inline = TRUE, selected = 2,
choiceNames = c(
"Yes",
"No"
),
bslib::input_task_button(
id = "load",
label = "Analyse",
icon = shiny::icon("pencil", lib = "glyphicon"),
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"
),
type = "primary",
auto_reset = TRUE
choiceValues = c(1, 2)
),
shiny::conditionalPanel(
condition = "input.all==1",
shiny::uiOutput("include_vars")
),
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")
),
bslib::input_task_button(
id = "load",
label = "Analyse",
icon = shiny::icon("pencil", lib = "glyphicon"),
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"
),
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables")
type = "primary",
auto_reset = TRUE
),
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables")
# )
),
bslib::nav_spacer(),
bslib::nav_panel(
title = "Data overview",
DT::DTOutput(outputId = "data_table")
),
bslib::nav_panel(
title = "Baseline characteristics",
gt::gt_output(outputId = "table1")
@ -168,22 +244,22 @@ ui_elements <- list(
#########
##############################################################################
"docs" = bslib::nav_panel(
title = "Intro",
title = "Documentation",
shiny::markdown(readLines("www/intro.md")),
shiny::br()
)
)
# cards <- list(
# "overview"=bslib::card(
# title = "Data overview",
# # shiny::uiOutput("data.classes"),
# # shiny::uiOutput("data.input"),
# # shiny::p("Classes of uploaded data"),
# # gt::gt_output("data.classes"),
# shiny::p("Subset data"),
# DT::DTOutput(outputId = "data_table")
# ),
# "overview"=bslib::card(
# title = "Data overview",
# # shiny::uiOutput("data.classes"),
# # shiny::uiOutput("data.input"),
# # shiny::p("Classes of uploaded data"),
# # gt::gt_output("data.classes"),
# shiny::p("Subset data"),
# DT::DTOutput(outputId = "data_table")
# ),
# "baseline"=bslib::card(
# title = "Baseline characteristics",
# gt::gt_output(outputId = "table1")
@ -210,6 +286,7 @@ ui <- bslib::page(
bslib::page_navbar(
id = "main_panel",
ui_elements$import,
ui_elements$overview,
ui_elements$analyze,
ui_elements$docs
)