mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
new completeness filter, analyses have been split, correlation plot included.
This commit is contained in:
parent
f728bb1e8e
commit
b268b90aae
17 changed files with 10563 additions and 2495 deletions
|
|
@ -63,7 +63,8 @@ Imports:
|
|||
gvlma,
|
||||
psych,
|
||||
jtools,
|
||||
Hmisc
|
||||
Hmisc,
|
||||
ggstats
|
||||
Suggests:
|
||||
styler,
|
||||
devtools,
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250130_1152'
|
||||
app_version <- function()'250207_1622'
|
||||
|
|
|
|||
136
R/correlations-module.R
Normal file
136
R/correlations-module.R
Normal file
|
|
@ -0,0 +1,136 @@
|
|||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id. (Use 'ns("id")')
|
||||
#'
|
||||
#' @name data-correlations
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
data_correlations_ui <- function(id, ...) {
|
||||
ns <- NS(id)
|
||||
|
||||
shiny::tagList(
|
||||
shiny::textOutput(outputId = ns("suggest")),
|
||||
shiny::plotOutput(outputId = ns("correlation_plot"), ...)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param color.main main color
|
||||
#' @param color.sec secondary color
|
||||
#' @param ... arguments passed to toastui::datagrid
|
||||
#'
|
||||
#' @name data-correlations
|
||||
#' @returns shiny server module
|
||||
#' @export
|
||||
data_correlations_server <- function(id,
|
||||
data,
|
||||
include.class = NULL,
|
||||
cutoff = .7,
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
# ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data = NULL
|
||||
)
|
||||
|
||||
rv$data <- shiny::reactive({
|
||||
shiny::req(data)
|
||||
if (!is.null(include.class)) {
|
||||
filter <- sapply(data(), class) %in% include.class
|
||||
out <- data()[filter]
|
||||
} else {
|
||||
out <- data()
|
||||
}
|
||||
out
|
||||
})
|
||||
|
||||
# rv <- list()
|
||||
# rv$data <- mtcars
|
||||
|
||||
output$suggest <- shiny::renderPrint({
|
||||
shiny::req(rv$data)
|
||||
shiny::req(cutoff)
|
||||
pairs <- correlation_pairs(rv$data(), threshold = cutoff())
|
||||
|
||||
more <- ifelse(nrow(pairs) > 1, "from each pair ", "")
|
||||
|
||||
if (nrow(pairs) == 0) {
|
||||
out <- glue::glue("No variables have a correlation measure above the threshold.")
|
||||
} else {
|
||||
out <- pairs |>
|
||||
apply(1, \(.x){
|
||||
glue::glue("'{.x[1]}'x'{.x[2]}'({round(as.numeric(.x[3]),2)})")
|
||||
}) |>
|
||||
(\(.x){
|
||||
glue::glue("The following variable pairs are highly correlated: {sentence_paste(.x)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.")
|
||||
})()
|
||||
}
|
||||
out
|
||||
})
|
||||
|
||||
output$correlation_plot <- shiny::renderPlot({
|
||||
psych::pairs.panels(rv$data())
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
correlation_pairs <- function(data, threshold = .8) {
|
||||
data <- data[!sapply(data, is.character)]
|
||||
data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
|
||||
cor <- Hmisc::rcorr(as.matrix(data))
|
||||
r <- cor$r %>% as.table()
|
||||
d <- r |>
|
||||
as.data.frame() |>
|
||||
dplyr::filter(abs(Freq) > threshold, Freq != 1)
|
||||
|
||||
d[1:2] |>
|
||||
apply(1, \(.x){
|
||||
sort(unname(.x))
|
||||
},
|
||||
simplify = logical(1)
|
||||
) |>
|
||||
duplicated() |>
|
||||
(\(.x){
|
||||
d[!.x, ]
|
||||
})() |>
|
||||
setNames(c("var1", "var2", "cor"))
|
||||
}
|
||||
|
||||
sentence_paste <- function(data, and.str = "and") {
|
||||
and.str <- gsub(" ", "", and.str)
|
||||
if (length(data) < 2) {
|
||||
data
|
||||
} else if (length(data) == 2) {
|
||||
paste(data, collapse = glue::glue(" {and.str} "))
|
||||
} else if (length(data) > 2) {
|
||||
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} "))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
cor_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::sliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .1,
|
||||
value = .7,
|
||||
ticks = FALSE
|
||||
),
|
||||
data_correlations_ui("data", height = 600)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_correlations_server("data", data = shiny::reactive(mtcars), cutoff = shiny::reactive(input$cor_cutoff))
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
cor_app()
|
||||
17
R/helpers.R
17
R/helpers.R
|
|
@ -249,3 +249,20 @@ remove_na_attr <- function(data,attr="label"){
|
|||
|
||||
dplyr::bind_cols(out)
|
||||
}
|
||||
|
||||
#' Removes columns with completenes below cutoff
|
||||
#'
|
||||
#' @param data data frame
|
||||
#' @param cutoff numeric
|
||||
#'
|
||||
#' @returns data frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#'data.frame(a=1:10,b=NA, c=c(2,NA)) |> remove_empty_cols(cutoff=.5)
|
||||
remove_empty_cols <- function(data,cutoff=.7){
|
||||
filter <- apply(X = data,MARGIN = 2,FUN = \(.x){
|
||||
sum(as.numeric(!is.na(.x)))/length(.x)
|
||||
}) >= cutoff
|
||||
data[filter]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -79,3 +79,4 @@ modify_qmd <- function(file, format) {
|
|||
specify_qmd_format(fileformat = "all") |>
|
||||
writeLines(paste0(tools::file_path_sans_ext(file), "_format.", tools::file_ext(file)))
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ custom_theme <- function(...,
|
|||
){
|
||||
bslib::bs_theme(
|
||||
...,
|
||||
"navbar-bg" = primary,
|
||||
version = version,
|
||||
primary = primary,
|
||||
secondary = secondary,
|
||||
|
|
|
|||
|
|
@ -461,6 +461,15 @@ update_variables_datagrid <- function(data, height = NULL, selectionId = NULL, b
|
|||
fontStyle = "italic"
|
||||
)
|
||||
|
||||
grid <- toastui::grid_filters(
|
||||
grid = grid,
|
||||
column = "name",
|
||||
# columns = unname(std_names[std_names!="vals"]),
|
||||
showApplyBtn = FALSE,
|
||||
showClearBtn = TRUE,
|
||||
type = "text"
|
||||
)
|
||||
|
||||
# grid <- toastui::grid_columns(
|
||||
# grid = grid,
|
||||
# columns = "name_toset",
|
||||
|
|
@ -571,6 +580,7 @@ convert_to <- function(data,
|
|||
new_class <- match.arg(new_class, several.ok = TRUE)
|
||||
stopifnot(length(new_class) == length(variable))
|
||||
args <- list(...)
|
||||
args$format <- clean_sep(args$format)
|
||||
if (length(variable) > 1) {
|
||||
for (i in seq_along(variable)) {
|
||||
data <- convert_to(data, variable[i], new_class[i], ...)
|
||||
|
|
@ -602,10 +612,10 @@ convert_to <- function(data,
|
|||
setNames(list(expr(as.integer(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "date")) {
|
||||
data[[variable]] <- as.Date(x = data[[variable]], ...)
|
||||
data[[variable]] <- as.Date(x = clean_date(data[[variable]]), ...)
|
||||
attr(data, "code_03_convert") <- c(
|
||||
attr(data, "code_03_convert"),
|
||||
setNames(list(expr(as.Date(!!sym(variable), origin = !!args$origin))), variable)
|
||||
setNames(list(expr(as.Date(clean_date(!!sym(variable)), origin = !!args$origin, format=clean_sep(!!args$format)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "datetime")) {
|
||||
data[[variable]] <- as.POSIXct(x = data[[variable]], ...)
|
||||
|
|
@ -710,3 +720,39 @@ get_vars_to_convert <- function(vars, classes_input) {
|
|||
}
|
||||
|
||||
|
||||
#' gsub wrapper for piping with default values for separator substituting
|
||||
#'
|
||||
#' @param data character vector
|
||||
#' @param old.sep old separator
|
||||
#' @param new.sep new separator
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
clean_sep <- function(data,old.sep="[-.,/]",new.sep="-"){
|
||||
gsub(old.sep,new.sep,data)
|
||||
}
|
||||
|
||||
#' Attempts at applying uniform date format
|
||||
#'
|
||||
#' @param data character string vector of possible dates
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
clean_date <- function(data){
|
||||
data |>
|
||||
clean_sep() |>
|
||||
sapply(\(.x){
|
||||
if (is.na(.x)){
|
||||
.x
|
||||
} else {
|
||||
strsplit(.x,"-") |>
|
||||
unlist()|>
|
||||
lapply(\(.y){
|
||||
if (nchar(.y)==1) paste0("0",.y) else .y
|
||||
}) |> paste(collapse="-")
|
||||
}
|
||||
}) |>
|
||||
unname()
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250130_1152'
|
||||
app_version <- function()'250207_1622'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -41,6 +41,148 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
|
|||
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//correlations-module.R
|
||||
########
|
||||
|
||||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id. (Use 'ns("id")')
|
||||
#'
|
||||
#' @name data-correlations
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
data_correlations_ui <- function(id, ...) {
|
||||
ns <- NS(id)
|
||||
|
||||
shiny::tagList(
|
||||
shiny::textOutput(outputId = ns("suggest")),
|
||||
shiny::plotOutput(outputId = ns("correlation_plot"), ...)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param color.main main color
|
||||
#' @param color.sec secondary color
|
||||
#' @param ... arguments passed to toastui::datagrid
|
||||
#'
|
||||
#' @name data-correlations
|
||||
#' @returns shiny server module
|
||||
#' @export
|
||||
data_correlations_server <- function(id,
|
||||
data,
|
||||
include.class = NULL,
|
||||
cutoff = .7,
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
# ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data = NULL
|
||||
)
|
||||
|
||||
rv$data <- shiny::reactive({
|
||||
shiny::req(data)
|
||||
if (!is.null(include.class)) {
|
||||
filter <- sapply(data(), class) %in% include.class
|
||||
out <- data()[filter]
|
||||
} else {
|
||||
out <- data()
|
||||
}
|
||||
out
|
||||
})
|
||||
|
||||
# rv <- list()
|
||||
# rv$data <- mtcars
|
||||
|
||||
output$suggest <- shiny::renderPrint({
|
||||
shiny::req(rv$data)
|
||||
shiny::req(cutoff)
|
||||
pairs <- correlation_pairs(rv$data(), threshold = cutoff())
|
||||
|
||||
more <- ifelse(nrow(pairs) > 1, "from each pair ", "")
|
||||
|
||||
if (nrow(pairs) == 0) {
|
||||
out <- glue::glue("No variables have a correlation measure above the threshold.")
|
||||
} else {
|
||||
out <- pairs |>
|
||||
apply(1, \(.x){
|
||||
glue::glue("'{.x[1]}'x'{.x[2]}'({round(as.numeric(.x[3]),2)})")
|
||||
}) |>
|
||||
(\(.x){
|
||||
glue::glue("The following variable pairs are highly correlated: {sentence_paste(.x)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.")
|
||||
})()
|
||||
}
|
||||
out
|
||||
})
|
||||
|
||||
output$correlation_plot <- shiny::renderPlot({
|
||||
psych::pairs.panels(rv$data())
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
correlation_pairs <- function(data, threshold = .8) {
|
||||
data <- data[!sapply(data, is.character)]
|
||||
data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
|
||||
cor <- Hmisc::rcorr(as.matrix(data))
|
||||
r <- cor$r %>% as.table()
|
||||
d <- r |>
|
||||
as.data.frame() |>
|
||||
dplyr::filter(abs(Freq) > threshold, Freq != 1)
|
||||
|
||||
d[1:2] |>
|
||||
apply(1, \(.x){
|
||||
sort(unname(.x))
|
||||
},
|
||||
simplify = logical(1)
|
||||
) |>
|
||||
duplicated() |>
|
||||
(\(.x){
|
||||
d[!.x, ]
|
||||
})() |>
|
||||
setNames(c("var1", "var2", "cor"))
|
||||
}
|
||||
|
||||
sentence_paste <- function(data, and.str = "and") {
|
||||
and.str <- gsub(" ", "", and.str)
|
||||
if (length(data) < 2) {
|
||||
data
|
||||
} else if (length(data) == 2) {
|
||||
paste(data, collapse = glue::glue(" {and.str} "))
|
||||
} else if (length(data) > 2) {
|
||||
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} "))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
cor_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::sliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .1,
|
||||
value = .7,
|
||||
ticks = FALSE
|
||||
),
|
||||
data_correlations_ui("data", height = 600)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_correlations_server("data", data = shiny::reactive(mtcars), cutoff = shiny::reactive(input$cor_cutoff))
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
cor_app()
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//cut-variable-dates.R
|
||||
########
|
||||
|
|
@ -1367,6 +1509,23 @@ remove_na_attr <- function(data,attr="label"){
|
|||
dplyr::bind_cols(out)
|
||||
}
|
||||
|
||||
#' Removes columns with completenes below cutoff
|
||||
#'
|
||||
#' @param data data frame
|
||||
#' @param cutoff numeric
|
||||
#'
|
||||
#' @returns data frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#'data.frame(a=1:10,b=NA, c=c(2,NA)) |> remove_empty_cols(cutoff=.5)
|
||||
remove_empty_cols <- function(data,cutoff=.7){
|
||||
filter <- apply(X = data,MARGIN = 2,FUN = \(.x){
|
||||
sum(as.numeric(!is.na(.x)))/length(.x)
|
||||
}) >= cutoff
|
||||
data[filter]
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//redcap_read_shiny_module.R
|
||||
|
|
@ -2743,6 +2902,7 @@ modify_qmd <- function(file, format) {
|
|||
}
|
||||
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//shiny_freesearcheR.R
|
||||
########
|
||||
|
|
@ -2805,6 +2965,7 @@ custom_theme <- function(...,
|
|||
){
|
||||
bslib::bs_theme(
|
||||
...,
|
||||
"navbar-bg" = primary,
|
||||
version = version,
|
||||
primary = primary,
|
||||
secondary = secondary,
|
||||
|
|
@ -3322,6 +3483,15 @@ update_variables_datagrid <- function(data, height = NULL, selectionId = NULL, b
|
|||
fontStyle = "italic"
|
||||
)
|
||||
|
||||
grid <- toastui::grid_filters(
|
||||
grid = grid,
|
||||
column = "name",
|
||||
# columns = unname(std_names[std_names!="vals"]),
|
||||
showApplyBtn = FALSE,
|
||||
showClearBtn = TRUE,
|
||||
type = "text"
|
||||
)
|
||||
|
||||
# grid <- toastui::grid_columns(
|
||||
# grid = grid,
|
||||
# columns = "name_toset",
|
||||
|
|
@ -3432,6 +3602,7 @@ convert_to <- function(data,
|
|||
new_class <- match.arg(new_class, several.ok = TRUE)
|
||||
stopifnot(length(new_class) == length(variable))
|
||||
args <- list(...)
|
||||
args$format <- clean_sep(args$format)
|
||||
if (length(variable) > 1) {
|
||||
for (i in seq_along(variable)) {
|
||||
data <- convert_to(data, variable[i], new_class[i], ...)
|
||||
|
|
@ -3463,10 +3634,10 @@ convert_to <- function(data,
|
|||
setNames(list(expr(as.integer(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "date")) {
|
||||
data[[variable]] <- as.Date(x = data[[variable]], ...)
|
||||
data[[variable]] <- as.Date(x = clean_date(data[[variable]]), ...)
|
||||
attr(data, "code_03_convert") <- c(
|
||||
attr(data, "code_03_convert"),
|
||||
setNames(list(expr(as.Date(!!sym(variable), origin = !!args$origin))), variable)
|
||||
setNames(list(expr(as.Date(clean_date(!!sym(variable)), origin = !!args$origin, format=clean_sep(!!args$format)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "datetime")) {
|
||||
data[[variable]] <- as.POSIXct(x = data[[variable]], ...)
|
||||
|
|
@ -3571,6 +3742,42 @@ get_vars_to_convert <- function(vars, classes_input) {
|
|||
}
|
||||
|
||||
|
||||
#' gsub wrapper for piping with default values for separator substituting
|
||||
#'
|
||||
#' @param data character vector
|
||||
#' @param old.sep old separator
|
||||
#' @param new.sep new separator
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
clean_sep <- function(data,old.sep="[-.,/]",new.sep="-"){
|
||||
gsub(old.sep,new.sep,data)
|
||||
}
|
||||
|
||||
#' Attempts at applying uniform date format
|
||||
#'
|
||||
#' @param data character string vector of possible dates
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
clean_date <- function(data){
|
||||
data |>
|
||||
clean_sep() |>
|
||||
sapply(\(.x){
|
||||
if (is.na(.x)){
|
||||
.x
|
||||
} else {
|
||||
strsplit(.x,"-") |>
|
||||
unlist()|>
|
||||
lapply(\(.y){
|
||||
if (nchar(.y)==1) paste0("0",.y) else .y
|
||||
}) |> paste(collapse="-")
|
||||
}
|
||||
}) |>
|
||||
unname()
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -3597,61 +3804,69 @@ ui_elements <- list(
|
|||
##############################################################################
|
||||
"import" = bslib::nav_panel(
|
||||
title = "Import",
|
||||
shiny::tagList(
|
||||
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::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
# label = "Choice: ",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
),
|
||||
# checkIcon = list(
|
||||
# yes = icon("square-check"),
|
||||
# no = icon("square")
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "output.has_input=='no'",
|
||||
# Input: Select a file ----
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
# label = "Choice: ",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
),
|
||||
# checkIcon = list(
|
||||
# yes = icon("square-check"),
|
||||
# no = icon("square")
|
||||
# ),
|
||||
width = "100%"
|
||||
),
|
||||
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=='env'",
|
||||
import_globalenv_ui(id = "env", title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
)
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
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=='env'",
|
||||
import_globalenv_ui(id = "env", title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Exclude in-complete variables"),
|
||||
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
|
||||
shiny::br(),
|
||||
shiny::sliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Choose completeness threshold (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
ticks = FALSE
|
||||
),
|
||||
shiny::helpText("Only include variables with completeness above a specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -3731,7 +3946,7 @@ ui_elements <- list(
|
|||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
shiny::tags$p("Below, you can subset the data (by not selecting the variables to exclude on applying changes), rename variables, set new labels (for nicer tables in the analysis report) and change variable classes.
|
||||
shiny::tags$p("Below, you can subset the data (select variables to include on clicking 'Apply changes'), rename variables, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).
|
||||
Italic text can be edited/changed.
|
||||
On the right, you can create and modify factor/categorical variables as well as resetting the data to the originally imported data.")
|
||||
)
|
||||
|
|
@ -3851,15 +4066,13 @@ ui_elements <- list(
|
|||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data analyses panel
|
||||
######### Descriptive analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"analyze" =
|
||||
# bslib::nav_panel_hidden(
|
||||
"describe" =
|
||||
bslib::nav_panel(
|
||||
# value = "analyze",
|
||||
title = "Analyses",
|
||||
id = "navanalyses",
|
||||
title = "Evaluate",
|
||||
id = "navdescribe",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
|
|
@ -3889,6 +4102,47 @@ ui_elements <- list(
|
|||
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
title = "Correlations",
|
||||
shiny::sliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .02,
|
||||
value = .7,
|
||||
ticks = FALSE
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Variable correlations",
|
||||
data_correlations_ui(id = "correlations", height = 600)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"analyze" =
|
||||
bslib::nav_panel(
|
||||
title = "Regression",
|
||||
id = "navanalyses",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
# fillable = TRUE,
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
open = "acc_reg",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_reg",
|
||||
title = "Regression",
|
||||
|
|
@ -3927,23 +4181,14 @@ ui_elements <- list(
|
|||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("If you change the parameters, press 'Analyse' again to update the regression analysis"),
|
||||
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::sliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Cut-off for column completeness (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
ticks = FALSE
|
||||
),
|
||||
shiny::helpText("To improve speed, columns are removed before analysing data, if copleteness is below above value."),
|
||||
shiny::radioButtons(
|
||||
inputId = "all",
|
||||
label = "Specify covariables",
|
||||
|
|
@ -3958,52 +4203,6 @@ ui_elements <- list(
|
|||
condition = "input.all==1",
|
||||
shiny::uiOutput("include_vars")
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
value = "acc_down",
|
||||
title = "Download",
|
||||
icon = bsicons::bs_icon("download"),
|
||||
shiny::h4("Report"),
|
||||
shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
|
||||
shiny::selectInput(
|
||||
inputId = "output_type",
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"LibreOffice" = "odt"
|
||||
# ,
|
||||
# "PDF" = "pdf",
|
||||
# "All the above" = "all"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "report",
|
||||
label = "Download report",
|
||||
icon = shiny::icon("download")
|
||||
),
|
||||
# shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
|
||||
shiny::tags$hr(),
|
||||
shiny::h4("Data"),
|
||||
shiny::helpText("Choose your favourite output data format to download the modified data."),
|
||||
shiny::selectInput(
|
||||
inputId = "data_type",
|
||||
label = "Data format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"R" = "rds",
|
||||
"stata" = "dta"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "data_modified",
|
||||
label = "Download data",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
),
|
||||
# shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
|
|
@ -4025,10 +4224,6 @@ ui_elements <- list(
|
|||
# condition = "output.ready=='yes'",
|
||||
# shiny::tags$hr(),
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
gt::gt_output(outputId = "table2")
|
||||
|
|
@ -4046,6 +4241,66 @@ ui_elements <- list(
|
|||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Download panel
|
||||
#########
|
||||
##############################################################################
|
||||
"download" =
|
||||
bslib::nav_panel(
|
||||
title = "Download",
|
||||
id = "navdownload",
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Report"),
|
||||
shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
|
||||
shiny::selectInput(
|
||||
inputId = "output_type",
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"LibreOffice" = "odt"
|
||||
# ,
|
||||
# "PDF" = "pdf",
|
||||
# "All the above" = "all"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "report",
|
||||
label = "Download report",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
# shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Data"),
|
||||
shiny::helpText("Choose your favourite output data format to download the modified data."),
|
||||
shiny::selectInput(
|
||||
inputId = "data_type",
|
||||
label = "Data format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"R" = "rds",
|
||||
"stata" = "dta",
|
||||
"CSV" = "csv"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "data_modified",
|
||||
label = "Download data",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br()
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Documentation panel
|
||||
#########
|
||||
##############################################################################
|
||||
|
|
@ -4065,7 +4320,6 @@ ui_elements <- list(
|
|||
# shiny::br()
|
||||
# )
|
||||
)
|
||||
|
||||
# Initial attempt at creating light and dark versions
|
||||
light <- custom_theme()
|
||||
dark <- custom_theme(
|
||||
|
|
@ -4090,17 +4344,15 @@ ui <- bslib::page_fixed(
|
|||
theme = light,
|
||||
shiny::useBusyIndicators(),
|
||||
bslib::page_navbar(
|
||||
# title = "freesearcheR",
|
||||
id = "main_panel",
|
||||
# header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")),
|
||||
ui_elements$home,
|
||||
ui_elements$import,
|
||||
ui_elements$overview,
|
||||
ui_elements$describe,
|
||||
ui_elements$analyze,
|
||||
ui_elements$download,
|
||||
bslib::nav_spacer(),
|
||||
ui_elements$docs,
|
||||
# bslib::nav_spacer(),
|
||||
# bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")),
|
||||
fillable = FALSE,
|
||||
footer = shiny::tags$footer(
|
||||
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
|
||||
|
|
@ -4213,7 +4465,7 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
consider.na <- c("NA", "\"\"", "")
|
||||
consider.na <- c("NA", "\"\"", "", "\'\'", "na")
|
||||
|
||||
data_file <- datamods::import_file_server(
|
||||
id = "file_import",
|
||||
|
|
@ -4228,7 +4480,8 @@ server <- function(input, output, session) {
|
|||
haven::read_dta(file = file, .name_repair = "unique_quiet")
|
||||
},
|
||||
csv = function(file) {
|
||||
readr::read_csv(file = file, na = consider.na)
|
||||
readr::read_csv(file = file, na = consider.na, name_repair = "unique_quiet") #|>
|
||||
# janitor::remove_empty(which = "cols", cutoff = 1, quiet = TRUE)
|
||||
},
|
||||
# xls = function(file){
|
||||
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
|
||||
|
|
@ -4237,7 +4490,7 @@ server <- function(input, output, session) {
|
|||
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
|
||||
# },
|
||||
rds = function(file) {
|
||||
readr::read_rds(file = file)
|
||||
readr::read_rds(file = file, name_repair = "unique_quiet")
|
||||
}
|
||||
)
|
||||
)
|
||||
|
|
@ -4284,11 +4537,22 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
rv$data <- rv$data_original |>
|
||||
default_parsing() |>
|
||||
janitor::clean_names()
|
||||
})
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
rv$data_original,
|
||||
input$reset_confirm,
|
||||
input$complete_cutoff
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_original)
|
||||
rv$data <- rv$data_original |>
|
||||
# janitor::clean_names() |>
|
||||
default_parsing() |>
|
||||
remove_empty_cols(
|
||||
cutoff = input$complete_cutoff / 100
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(input$data_reset, {
|
||||
shinyWidgets::ask_confirmation(
|
||||
|
|
@ -4297,9 +4561,9 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$reset_confirm, {
|
||||
rv$data <- rv$data_original |> default_parsing()
|
||||
})
|
||||
# shiny::observeEvent(input$reset_confirm, {
|
||||
# rv$data <- rv$data_original |> default_parsing()
|
||||
# })
|
||||
|
||||
######### Overview
|
||||
|
||||
|
|
@ -4366,7 +4630,8 @@ server <- function(input, output, session) {
|
|||
)
|
||||
|
||||
######### Show result
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
output$table_mod <- toastui::renderDatagrid({
|
||||
shiny::req(rv$data)
|
||||
# data <- rv$data
|
||||
|
|
@ -4379,6 +4644,13 @@ server <- function(input, output, session) {
|
|||
# striped = TRUE
|
||||
)
|
||||
})
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
})
|
||||
|
||||
output$code <- renderPrint({
|
||||
attr(rv$data, "code")
|
||||
|
|
@ -4422,14 +4694,14 @@ server <- function(input, output, session) {
|
|||
rv$data_filtered <- data_filter()
|
||||
|
||||
rv$list$data <- data_filter() |>
|
||||
REDCapCAST::fct_drop.data.frame() |>
|
||||
REDCapCAST::fct_drop() |>
|
||||
(\(.x){
|
||||
.x[base_vars()]
|
||||
})() |>
|
||||
janitor::remove_empty(
|
||||
which = "cols",
|
||||
cutoff = input$complete_cutoff / 100
|
||||
)
|
||||
})() #|>
|
||||
# janitor::remove_empty(
|
||||
# which = "cols",
|
||||
# cutoff = input$complete_cutoff / 100
|
||||
# )
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -4488,13 +4760,17 @@ server <- function(input, output, session) {
|
|||
shiny::req(input$outcome_var)
|
||||
shiny::selectizeInput(
|
||||
inputId = "regression_type",
|
||||
# selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
|
||||
label = "Choose regression analysis",
|
||||
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"),
|
||||
## 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
|
||||
)
|
||||
})
|
||||
|
|
@ -4553,90 +4829,9 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
|
||||
|
||||
|
||||
## Have a look at column filters at some point
|
||||
## There should be a way to use the filtering the filter data for further analyses
|
||||
## Disabled for now, as the JS is apparently not isolated
|
||||
# output$data_table <-
|
||||
# DT::renderDT(
|
||||
# {
|
||||
# DT::datatable(ds()[base_vars()])
|
||||
# },
|
||||
# server = FALSE
|
||||
# )
|
||||
#
|
||||
# output$data.classes <- gt::render_gt({
|
||||
# shiny::req(input$file)
|
||||
# data.frame(matrix(sapply(ds(), \(.x){
|
||||
# class(.x)[1]
|
||||
# }), nrow = 1)) |>
|
||||
# stats::setNames(names(ds())) |>
|
||||
# gt::gt()
|
||||
# })
|
||||
|
||||
|
||||
### Outputs
|
||||
|
||||
# shiny::observeEvent(data_filter(), {
|
||||
# rv$data_filtered <- data_filter()
|
||||
# })
|
||||
|
||||
# shiny::observeEvent(
|
||||
# shiny::reactive(rv$data_filtered),
|
||||
# {
|
||||
# rv$list$data <- rv$data_filtered |>
|
||||
# # dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
|
||||
# REDCapCAST::fct_drop.data.frame() |>
|
||||
# # factorize(vars = input$factor_vars) |>
|
||||
# remove_na_attr()
|
||||
#
|
||||
# # rv$list$data <- data
|
||||
# # rv$list$data <- data[base_vars()]
|
||||
# }
|
||||
# )
|
||||
|
||||
# shiny::observe({
|
||||
# if (input$strat_var == "none") {
|
||||
# by.var <- NULL
|
||||
# } else {
|
||||
# by.var <- input$strat_var
|
||||
# }
|
||||
#
|
||||
# rv$list$table1 <- rv$list$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
|
||||
# }
|
||||
# })()
|
||||
# })
|
||||
#
|
||||
# output$table1 <- gt::render_gt(
|
||||
# rv$list$table1 |>
|
||||
# gtsummary::as_gt() |>
|
||||
# gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
|
||||
# )
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data analyses results
|
||||
######### Descriptive evaluations
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
|
|
@ -4701,6 +4896,18 @@ server <- function(input, output, session) {
|
|||
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
|
||||
})
|
||||
|
||||
|
||||
data_correlations_server(id = "correlations",
|
||||
data = shiny::reactive(rv$list$data),
|
||||
cutoff = shiny::reactive(input$cor_cutoff))
|
||||
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression model analyses
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
|
|
@ -4779,37 +4986,6 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
# plot_check_r <- shiny::reactive({plot(rv$check)})
|
||||
#
|
||||
# output$check_1 <- shiny::renderUI({
|
||||
# shiny::req(rv$check)
|
||||
# list <- lapply(seq_len(length(plot_check_r())),
|
||||
# function(i) {
|
||||
# plotname <- paste0("check_plot_", i)
|
||||
# shiny::htmlOutput(plotname)
|
||||
# })
|
||||
#
|
||||
# do.call(shiny::tagList,list)
|
||||
# })
|
||||
#
|
||||
# # Call renderPlot for each one. Plots are only actually generated when they
|
||||
# # are visible on the web page.
|
||||
#
|
||||
# shiny::observe({
|
||||
# shiny::req(rv$check)
|
||||
# # browser()
|
||||
# for (i in seq_len(length(plot_check_r()))) {
|
||||
# local({
|
||||
# my_i <- i
|
||||
# plotname <- paste0("check_plot_", my_i)
|
||||
#
|
||||
# output[[plotname]] <- shiny::renderPlot({
|
||||
# plot_check_r()[[my_i]] + gg_theme_shiny()
|
||||
# })
|
||||
# })
|
||||
# }
|
||||
# })
|
||||
|
||||
output$check <- shiny::renderPlot(
|
||||
{
|
||||
shiny::req(rv$check)
|
||||
|
|
@ -4932,7 +5108,7 @@ server <- function(input, output, session) {
|
|||
)
|
||||
|
||||
out +
|
||||
ggplot2::scale_y_discrete(labels = scales::label_wrap(15))+
|
||||
ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
gg_theme_shiny()
|
||||
|
||||
# rv$list$regression$tables$Multivariable |>
|
||||
|
|
@ -5044,8 +5220,10 @@ server <- function(input, output, session) {
|
|||
content = function(file, type = input$data_type) {
|
||||
if (type == "rds") {
|
||||
readr::write_rds(rv$list$data, file = file)
|
||||
} else {
|
||||
} else if (type == "dta") {
|
||||
haven::write_dta(as.data.frame(rv$list$data), path = file)
|
||||
} else if (type == "csv"){
|
||||
readr::write_csv(rv$list$data, file = file)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9693816
|
||||
bundleId:
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
consider.na <- c("NA", "\"\"", "")
|
||||
consider.na <- c("NA", "\"\"", "", "\'\'", "na")
|
||||
|
||||
data_file <- datamods::import_file_server(
|
||||
id = "file_import",
|
||||
|
|
@ -105,7 +105,8 @@ server <- function(input, output, session) {
|
|||
haven::read_dta(file = file, .name_repair = "unique_quiet")
|
||||
},
|
||||
csv = function(file) {
|
||||
readr::read_csv(file = file, na = consider.na)
|
||||
readr::read_csv(file = file, na = consider.na, name_repair = "unique_quiet") #|>
|
||||
# janitor::remove_empty(which = "cols", cutoff = 1, quiet = TRUE)
|
||||
},
|
||||
# xls = function(file){
|
||||
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
|
||||
|
|
@ -114,7 +115,7 @@ server <- function(input, output, session) {
|
|||
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
|
||||
# },
|
||||
rds = function(file) {
|
||||
readr::read_rds(file = file)
|
||||
readr::read_rds(file = file, name_repair = "unique_quiet")
|
||||
}
|
||||
)
|
||||
)
|
||||
|
|
@ -161,11 +162,22 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
rv$data <- rv$data_original |>
|
||||
default_parsing() |>
|
||||
janitor::clean_names()
|
||||
})
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
rv$data_original,
|
||||
input$reset_confirm,
|
||||
input$complete_cutoff
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_original)
|
||||
rv$data <- rv$data_original |>
|
||||
# janitor::clean_names() |>
|
||||
default_parsing() |>
|
||||
remove_empty_cols(
|
||||
cutoff = input$complete_cutoff / 100
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(input$data_reset, {
|
||||
shinyWidgets::ask_confirmation(
|
||||
|
|
@ -174,9 +186,9 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$reset_confirm, {
|
||||
rv$data <- rv$data_original |> default_parsing()
|
||||
})
|
||||
# shiny::observeEvent(input$reset_confirm, {
|
||||
# rv$data <- rv$data_original |> default_parsing()
|
||||
# })
|
||||
|
||||
######### Overview
|
||||
|
||||
|
|
@ -243,7 +255,8 @@ server <- function(input, output, session) {
|
|||
)
|
||||
|
||||
######### Show result
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
output$table_mod <- toastui::renderDatagrid({
|
||||
shiny::req(rv$data)
|
||||
# data <- rv$data
|
||||
|
|
@ -256,6 +269,13 @@ server <- function(input, output, session) {
|
|||
# striped = TRUE
|
||||
)
|
||||
})
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
})
|
||||
|
||||
output$code <- renderPrint({
|
||||
attr(rv$data, "code")
|
||||
|
|
@ -299,14 +319,14 @@ server <- function(input, output, session) {
|
|||
rv$data_filtered <- data_filter()
|
||||
|
||||
rv$list$data <- data_filter() |>
|
||||
REDCapCAST::fct_drop.data.frame() |>
|
||||
REDCapCAST::fct_drop() |>
|
||||
(\(.x){
|
||||
.x[base_vars()]
|
||||
})() |>
|
||||
janitor::remove_empty(
|
||||
which = "cols",
|
||||
cutoff = input$complete_cutoff / 100
|
||||
)
|
||||
})() #|>
|
||||
# janitor::remove_empty(
|
||||
# which = "cols",
|
||||
# cutoff = input$complete_cutoff / 100
|
||||
# )
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -434,90 +454,9 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
|
||||
|
||||
|
||||
## Have a look at column filters at some point
|
||||
## There should be a way to use the filtering the filter data for further analyses
|
||||
## Disabled for now, as the JS is apparently not isolated
|
||||
# output$data_table <-
|
||||
# DT::renderDT(
|
||||
# {
|
||||
# DT::datatable(ds()[base_vars()])
|
||||
# },
|
||||
# server = FALSE
|
||||
# )
|
||||
#
|
||||
# output$data.classes <- gt::render_gt({
|
||||
# shiny::req(input$file)
|
||||
# data.frame(matrix(sapply(ds(), \(.x){
|
||||
# class(.x)[1]
|
||||
# }), nrow = 1)) |>
|
||||
# stats::setNames(names(ds())) |>
|
||||
# gt::gt()
|
||||
# })
|
||||
|
||||
|
||||
### Outputs
|
||||
|
||||
# shiny::observeEvent(data_filter(), {
|
||||
# rv$data_filtered <- data_filter()
|
||||
# })
|
||||
|
||||
# shiny::observeEvent(
|
||||
# shiny::reactive(rv$data_filtered),
|
||||
# {
|
||||
# rv$list$data <- rv$data_filtered |>
|
||||
# # dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
|
||||
# REDCapCAST::fct_drop.data.frame() |>
|
||||
# # factorize(vars = input$factor_vars) |>
|
||||
# remove_na_attr()
|
||||
#
|
||||
# # rv$list$data <- data
|
||||
# # rv$list$data <- data[base_vars()]
|
||||
# }
|
||||
# )
|
||||
|
||||
# shiny::observe({
|
||||
# if (input$strat_var == "none") {
|
||||
# by.var <- NULL
|
||||
# } else {
|
||||
# by.var <- input$strat_var
|
||||
# }
|
||||
#
|
||||
# rv$list$table1 <- rv$list$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
|
||||
# }
|
||||
# })()
|
||||
# })
|
||||
#
|
||||
# output$table1 <- gt::render_gt(
|
||||
# rv$list$table1 |>
|
||||
# gtsummary::as_gt() |>
|
||||
# gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
|
||||
# )
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data analyses results
|
||||
######### Descriptive evaluations
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
|
|
@ -582,6 +521,18 @@ server <- function(input, output, session) {
|
|||
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
|
||||
})
|
||||
|
||||
|
||||
data_correlations_server(id = "correlations",
|
||||
data = shiny::reactive(rv$list$data),
|
||||
cutoff = shiny::reactive(input$cor_cutoff))
|
||||
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression model analyses
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
|
|
@ -660,37 +611,6 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
# plot_check_r <- shiny::reactive({plot(rv$check)})
|
||||
#
|
||||
# output$check_1 <- shiny::renderUI({
|
||||
# shiny::req(rv$check)
|
||||
# list <- lapply(seq_len(length(plot_check_r())),
|
||||
# function(i) {
|
||||
# plotname <- paste0("check_plot_", i)
|
||||
# shiny::htmlOutput(plotname)
|
||||
# })
|
||||
#
|
||||
# do.call(shiny::tagList,list)
|
||||
# })
|
||||
#
|
||||
# # Call renderPlot for each one. Plots are only actually generated when they
|
||||
# # are visible on the web page.
|
||||
#
|
||||
# shiny::observe({
|
||||
# shiny::req(rv$check)
|
||||
# # browser()
|
||||
# for (i in seq_len(length(plot_check_r()))) {
|
||||
# local({
|
||||
# my_i <- i
|
||||
# plotname <- paste0("check_plot_", my_i)
|
||||
#
|
||||
# output[[plotname]] <- shiny::renderPlot({
|
||||
# plot_check_r()[[my_i]] + gg_theme_shiny()
|
||||
# })
|
||||
# })
|
||||
# }
|
||||
# })
|
||||
|
||||
output$check <- shiny::renderPlot(
|
||||
{
|
||||
shiny::req(rv$check)
|
||||
|
|
@ -925,8 +845,10 @@ server <- function(input, output, session) {
|
|||
content = function(file, type = input$data_type) {
|
||||
if (type == "rds") {
|
||||
readr::write_rds(rv$list$data, file = file)
|
||||
} else {
|
||||
} else if (type == "dta") {
|
||||
haven::write_dta(as.data.frame(rv$list$data), path = file)
|
||||
} else if (type == "csv"){
|
||||
readr::write_csv(rv$list$data, file = file)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -18,61 +18,69 @@ ui_elements <- list(
|
|||
##############################################################################
|
||||
"import" = bslib::nav_panel(
|
||||
title = "Import",
|
||||
shiny::tagList(
|
||||
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::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
# label = "Choice: ",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
),
|
||||
# checkIcon = list(
|
||||
# yes = icon("square-check"),
|
||||
# no = icon("square")
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "output.has_input=='no'",
|
||||
# Input: Select a file ----
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
# label = "Choice: ",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
),
|
||||
# checkIcon = list(
|
||||
# yes = icon("square-check"),
|
||||
# no = icon("square")
|
||||
# ),
|
||||
width = "100%"
|
||||
),
|
||||
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=='env'",
|
||||
import_globalenv_ui(id = "env", title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
)
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
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=='env'",
|
||||
import_globalenv_ui(id = "env", title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Exclude in-complete variables"),
|
||||
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
|
||||
shiny::br(),
|
||||
shiny::sliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Choose completeness threshold (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
ticks = FALSE
|
||||
),
|
||||
shiny::helpText("Only include variables with completeness above a specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -152,7 +160,7 @@ ui_elements <- list(
|
|||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
shiny::tags$p("Below, you can subset the data (by not selecting the variables to exclude on applying changes), rename variables, set new labels (for nicer tables in the analysis report) and change variable classes.
|
||||
shiny::tags$p("Below, you can subset the data (select variables to include on clicking 'Apply changes'), rename variables, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).
|
||||
Italic text can be edited/changed.
|
||||
On the right, you can create and modify factor/categorical variables as well as resetting the data to the originally imported data.")
|
||||
)
|
||||
|
|
@ -272,15 +280,13 @@ ui_elements <- list(
|
|||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data analyses panel
|
||||
######### Descriptive analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"analyze" =
|
||||
# bslib::nav_panel_hidden(
|
||||
"describe" =
|
||||
bslib::nav_panel(
|
||||
# value = "analyze",
|
||||
title = "Analyses",
|
||||
id = "navanalyses",
|
||||
title = "Evaluate",
|
||||
id = "navdescribe",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
|
|
@ -310,6 +316,47 @@ ui_elements <- list(
|
|||
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
title = "Correlations",
|
||||
shiny::sliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .02,
|
||||
value = .7,
|
||||
ticks = FALSE
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Variable correlations",
|
||||
data_correlations_ui(id = "correlations", height = 600)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"analyze" =
|
||||
bslib::nav_panel(
|
||||
title = "Regression",
|
||||
id = "navanalyses",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
# fillable = TRUE,
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
open = "acc_reg",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_reg",
|
||||
title = "Regression",
|
||||
|
|
@ -348,23 +395,14 @@ ui_elements <- list(
|
|||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("If you change the parameters, press 'Analyse' again to update the regression analysis"),
|
||||
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::sliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Cut-off for column completeness (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
ticks = FALSE
|
||||
),
|
||||
shiny::helpText("To improve speed, columns are removed before analysing data, if copleteness is below above value."),
|
||||
shiny::radioButtons(
|
||||
inputId = "all",
|
||||
label = "Specify covariables",
|
||||
|
|
@ -379,52 +417,6 @@ ui_elements <- list(
|
|||
condition = "input.all==1",
|
||||
shiny::uiOutput("include_vars")
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
value = "acc_down",
|
||||
title = "Download",
|
||||
icon = bsicons::bs_icon("download"),
|
||||
shiny::h4("Report"),
|
||||
shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
|
||||
shiny::selectInput(
|
||||
inputId = "output_type",
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"LibreOffice" = "odt"
|
||||
# ,
|
||||
# "PDF" = "pdf",
|
||||
# "All the above" = "all"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "report",
|
||||
label = "Download report",
|
||||
icon = shiny::icon("download")
|
||||
),
|
||||
# shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
|
||||
shiny::tags$hr(),
|
||||
shiny::h4("Data"),
|
||||
shiny::helpText("Choose your favourite output data format to download the modified data."),
|
||||
shiny::selectInput(
|
||||
inputId = "data_type",
|
||||
label = "Data format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"R" = "rds",
|
||||
"stata" = "dta"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "data_modified",
|
||||
label = "Download data",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
),
|
||||
# shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
|
|
@ -446,10 +438,6 @@ ui_elements <- list(
|
|||
# condition = "output.ready=='yes'",
|
||||
# shiny::tags$hr(),
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
gt::gt_output(outputId = "table2")
|
||||
|
|
@ -467,6 +455,66 @@ ui_elements <- list(
|
|||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Download panel
|
||||
#########
|
||||
##############################################################################
|
||||
"download" =
|
||||
bslib::nav_panel(
|
||||
title = "Download",
|
||||
id = "navdownload",
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Report"),
|
||||
shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
|
||||
shiny::selectInput(
|
||||
inputId = "output_type",
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"LibreOffice" = "odt"
|
||||
# ,
|
||||
# "PDF" = "pdf",
|
||||
# "All the above" = "all"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "report",
|
||||
label = "Download report",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
# shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Data"),
|
||||
shiny::helpText("Choose your favourite output data format to download the modified data."),
|
||||
shiny::selectInput(
|
||||
inputId = "data_type",
|
||||
label = "Data format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"R" = "rds",
|
||||
"stata" = "dta",
|
||||
"CSV" = "csv"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "data_modified",
|
||||
label = "Download data",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br()
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Documentation panel
|
||||
#########
|
||||
##############################################################################
|
||||
|
|
@ -486,7 +534,6 @@ ui_elements <- list(
|
|||
# shiny::br()
|
||||
# )
|
||||
)
|
||||
|
||||
# Initial attempt at creating light and dark versions
|
||||
light <- custom_theme()
|
||||
dark <- custom_theme(
|
||||
|
|
@ -511,17 +558,15 @@ ui <- bslib::page_fixed(
|
|||
theme = light,
|
||||
shiny::useBusyIndicators(),
|
||||
bslib::page_navbar(
|
||||
# title = "freesearcheR",
|
||||
id = "main_panel",
|
||||
# header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")),
|
||||
ui_elements$home,
|
||||
ui_elements$import,
|
||||
ui_elements$overview,
|
||||
ui_elements$describe,
|
||||
ui_elements$analyze,
|
||||
ui_elements$download,
|
||||
bslib::nav_spacer(),
|
||||
ui_elements$docs,
|
||||
# bslib::nav_spacer(),
|
||||
# bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")),
|
||||
fillable = FALSE,
|
||||
footer = shiny::tags$footer(
|
||||
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
|
||||
|
|
|
|||
|
|
@ -354,22 +354,21 @@ display: none;
|
|||
|
||||
<div id="welcome" class="section level1">
|
||||
<h1>Welcome</h1>
|
||||
<p>This is the <strong><em>freesearcheR</em></strong> web data analysis
|
||||
<p>This is the <strong><em>freesearcheR</em></strong> data analysis
|
||||
tool. We intend the <strong><em>freesearcheR</em></strong> to be a
|
||||
powerful and free tool for easy data evaluation and analysis at the
|
||||
hands of the clinician.</p>
|
||||
<p>By intention, this tool has been designed to be simple to use with a
|
||||
minimum of mandatory options to keep the workflow streamlined, while
|
||||
also including a few options to go even further.</p>
|
||||
<p>There are four simple steps to go through (see corresponding tabs in
|
||||
<p>There are some simple steps to go through (see corresponding tabs in
|
||||
the top):</p>
|
||||
<ol style="list-style-type: decimal">
|
||||
<li><p>Import data (a spreadsheet/file on your machine, direct export
|
||||
from a REDCap server, or a local file provided with a package) to get
|
||||
started.</p></li>
|
||||
<li><p>An <em>optional</em> step of data modification (change variable
|
||||
classes and creating categorical variables (factors) from numeric or
|
||||
time data)</p></li>
|
||||
<li><p>Inspec of data modification (change variable classes and creating
|
||||
categorical variables (factors) from numeric or time data)</p></li>
|
||||
<li><p>Data analysis of cross-sectionally designed studies (more study
|
||||
designs are planned to be included)</p>
|
||||
<ul>
|
||||
|
|
@ -382,10 +381,9 @@ depending on specified outcome variable</p></li>
|
|||
<li><p>Export the the analyses results for MS Word or <a href="https://www.libreoffice.org/">LibreOffice</a> as well as the data
|
||||
with preserved metadata.</p></li>
|
||||
</ol>
|
||||
<p>Have a look at the <a href>documentations page</a> for further
|
||||
project description. If you’re interested in the source code, then go
|
||||
on, <a href="https://github.com/agdamsbo/freesearcheR">have a
|
||||
look</a>!</p>
|
||||
<p>Have a look at the <a href="https://agdamsbo.github.io/freesearcheR/">documentations page</a>
|
||||
for further project description. If you’re interested in the source
|
||||
code, then go on, <a href="https://github.com/agdamsbo/freesearcheR">have a look</a>!</p>
|
||||
<p>If you encounter anything strange or the app doesn’t act as expected.
|
||||
Please <a href="https://github.com/agdamsbo/freesearcheR/issues">report
|
||||
on Github</a>.</p>
|
||||
|
|
|
|||
|
|
@ -1,24 +1,26 @@
|
|||
# Welcome
|
||||
|
||||
This is the ***freesearcheR*** web data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician.
|
||||
This is the ***freesearcheR*** data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician.
|
||||
|
||||
By intention, this tool has been designed to be simple to use with a minimum of mandatory options to keep the workflow streamlined, while also including a few options to go even further.
|
||||
|
||||
There are four simple steps to go through (see corresponding tabs in the top):
|
||||
There are some simple steps to go through (see corresponding tabs in the top):
|
||||
|
||||
1. Import data (a spreadsheet/file on your machine, direct export from a REDCap server, or a local file provided with a package) to get started.
|
||||
|
||||
2. An *optional* step of data modification (change variable classes and creating categorical variables (factors) from numeric or time data)
|
||||
1. Data inspection and modification (change variable classes, create new variables (categorical from numeric or time data, or completely new variables from the data)
|
||||
|
||||
3. Data analysis of cross-sectionally designed studies (more study designs are planned to be included)
|
||||
1. Evaluate data using descriptive analyses methods and inspect cross-correlations
|
||||
|
||||
- Classic baseline charactieristics (options to stratify and compare variables)
|
||||
1. Create regression models for even more advanced data analyses
|
||||
|
||||
- Linear, dichotomous or ordinal logistic regression will be used depending on specified outcome variable
|
||||
|
||||
- Plot regression analysis coefficients
|
||||
|
||||
- Evaluation of model assumptions
|
||||
|
||||
4. Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata.
|
||||
1. Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata.
|
||||
|
||||
Have a look at the [documentations page](https://agdamsbo.github.io/freesearcheR/) for further project description. If you're interested in the source code, then go on, [have a look](https://github.com/agdamsbo/freesearcheR)!
|
||||
|
||||
|
|
|
|||
|
|
@ -1,55 +0,0 @@
|
|||
---
|
||||
title: "freesearcheR analysis results"
|
||||
date: today
|
||||
format: docx
|
||||
author: freesearcheR Tool
|
||||
toc: false
|
||||
execute:
|
||||
echo: false
|
||||
params:
|
||||
data.file: NA
|
||||
---
|
||||
|
||||
```{r}
|
||||
#| message: false
|
||||
#| warning: false
|
||||
web_data <- readr::read_rds(file = params$data.file)
|
||||
library(gtsummary)
|
||||
library(gt)
|
||||
|
||||
tbl_merge <- function(data) {
|
||||
if (is.null(names(data))) {
|
||||
data |> gtsummary::tbl_merge()
|
||||
} else {
|
||||
data |> gtsummary::tbl_merge(tab_spanner = names(data))
|
||||
}
|
||||
}
|
||||
```
|
||||
|
||||
## Introduction
|
||||
|
||||
Research should be free and open with easy access for all. The freesearcheR tool attempts to help lower the bar to participate in contributing to science by making guided data analysis easily accessible in the web-browser.
|
||||
|
||||
## Methods
|
||||
|
||||
Analyses were conducted in the *freesearcheR* data analysis web-tool based on R version 4.4.1.
|
||||
|
||||
## Results
|
||||
|
||||
Below are the baseline characteristics.
|
||||
|
||||
```{r, results = 'asis'}
|
||||
tbl <- gtsummary::as_gt(web_data$table1)
|
||||
knitr::knit_print(tbl)
|
||||
```
|
||||
|
||||
Below are the results from the
|
||||
|
||||
```{r, results = 'asis'}
|
||||
reg_tbl <- web_data$regression$tables
|
||||
knitr::knit_print(tbl_merge(reg_tbl))
|
||||
```
|
||||
|
||||
## Discussion
|
||||
|
||||
Good luck on your further work!
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
---
|
||||
title: "freesearcheR analysis results"
|
||||
date: today
|
||||
title: "freesearcheR data report"
|
||||
date: "Report generated `r gsub('(\\D)0', '\\1', format(Sys.time(), '%A, %d.%m.%Y'))`"
|
||||
format: docx
|
||||
author: freesearcheR Tool
|
||||
author: freesearcheR data analysis tool
|
||||
toc: false
|
||||
params:
|
||||
data.file: NA
|
||||
|
|
@ -10,6 +10,7 @@ params:
|
|||
|
||||
```{r setup, echo = FALSE}
|
||||
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
|
||||
# glue::glue("{format(lubridate::today(),'%A')}, {lubridate::day(lubridate::today())}.{lubridate::month(lubridate::today())}.{lubridate::year(lubridate::today())}")
|
||||
```
|
||||
|
||||
|
||||
|
|
@ -52,15 +53,18 @@ Analyses were conducted in the *freesearcheR* data analysis web-tool based on R
|
|||
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)
|
||||
knitr::knit_print(tbl)}
|
||||
```
|
||||
|
||||
Below are the results from the `r tolower(vec2sentence(names(web_data$regression$tables)))` `r web_data$regression$params$descr`.
|
||||
`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, results = 'asis'}
|
||||
if ("regression" %in% names(web_data)){
|
||||
reg_tbl <- web_data$regression$tables
|
||||
knitr::knit_print(tbl_merge(reg_tbl))
|
||||
}
|
||||
```
|
||||
|
||||
## Discussion
|
||||
|
|
|
|||
11350
renv.lock
11350
renv.lock
File diff suppressed because one or more lines are too long
190
renv/activate.R
190
renv/activate.R
|
|
@ -2,7 +2,7 @@
|
|||
local({
|
||||
|
||||
# the requested version of renv
|
||||
version <- "1.0.11"
|
||||
version <- "1.1.0"
|
||||
attr(version, "sha") <- NULL
|
||||
|
||||
# the project directory
|
||||
|
|
@ -42,7 +42,7 @@ local({
|
|||
return(FALSE)
|
||||
|
||||
# next, check environment variables
|
||||
# TODO: prefer using the configuration one in the future
|
||||
# prefer using the configuration one in the future
|
||||
envvars <- c(
|
||||
"RENV_CONFIG_AUTOLOADER_ENABLED",
|
||||
"RENV_AUTOLOADER_ENABLED",
|
||||
|
|
@ -209,10 +209,6 @@ local({
|
|||
|
||||
}
|
||||
|
||||
startswith <- function(string, prefix) {
|
||||
substring(string, 1, nchar(prefix)) == prefix
|
||||
}
|
||||
|
||||
bootstrap <- function(version, library) {
|
||||
|
||||
friendly <- renv_bootstrap_version_friendly(version)
|
||||
|
|
@ -563,6 +559,9 @@ local({
|
|||
|
||||
# prepare download options
|
||||
token <- renv_bootstrap_github_token()
|
||||
if (is.null(token))
|
||||
token <- ""
|
||||
|
||||
if (nzchar(Sys.which("curl")) && nzchar(token)) {
|
||||
fmt <- "--location --fail --header \"Authorization: token %s\""
|
||||
extra <- sprintf(fmt, token)
|
||||
|
|
@ -951,8 +950,14 @@ local({
|
|||
}
|
||||
|
||||
renv_bootstrap_validate_version_dev <- function(version, description) {
|
||||
|
||||
expected <- description[["RemoteSha"]]
|
||||
is.character(expected) && startswith(expected, version)
|
||||
if (!is.character(expected))
|
||||
return(FALSE)
|
||||
|
||||
pattern <- sprintf("^\\Q%s\\E", version)
|
||||
grepl(pattern, expected, perl = TRUE)
|
||||
|
||||
}
|
||||
|
||||
renv_bootstrap_validate_version_release <- function(version, description) {
|
||||
|
|
@ -1132,10 +1137,10 @@ local({
|
|||
|
||||
renv_bootstrap_exec <- function(project, libpath, version) {
|
||||
if (!renv_bootstrap_load(project, libpath, version))
|
||||
renv_bootstrap_run(version, libpath)
|
||||
renv_bootstrap_run(project, libpath, version)
|
||||
}
|
||||
|
||||
renv_bootstrap_run <- function(version, libpath) {
|
||||
renv_bootstrap_run <- function(project, libpath, version) {
|
||||
|
||||
# perform bootstrap
|
||||
bootstrap(version, libpath)
|
||||
|
|
@ -1146,7 +1151,7 @@ local({
|
|||
|
||||
# try again to load
|
||||
if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) {
|
||||
return(renv::load(project = getwd()))
|
||||
return(renv::load(project = project))
|
||||
}
|
||||
|
||||
# failed to download or load renv; warn the user
|
||||
|
|
@ -1192,98 +1197,101 @@ local({
|
|||
jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
|
||||
}
|
||||
|
||||
renv_json_read_patterns <- function() {
|
||||
|
||||
list(
|
||||
|
||||
# objects
|
||||
list("{", "\t\n\tobject(\t\n\t"),
|
||||
list("}", "\t\n\t)\t\n\t"),
|
||||
|
||||
# arrays
|
||||
list("[", "\t\n\tarray(\t\n\t"),
|
||||
list("]", "\n\t\n)\n\t\n"),
|
||||
|
||||
# maps
|
||||
list(":", "\t\n\t=\t\n\t")
|
||||
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
renv_json_read_envir <- function() {
|
||||
|
||||
envir <- new.env(parent = emptyenv())
|
||||
|
||||
envir[["+"]] <- `+`
|
||||
envir[["-"]] <- `-`
|
||||
|
||||
envir[["object"]] <- function(...) {
|
||||
result <- list(...)
|
||||
names(result) <- as.character(names(result))
|
||||
result
|
||||
}
|
||||
|
||||
envir[["array"]] <- list
|
||||
|
||||
envir[["true"]] <- TRUE
|
||||
envir[["false"]] <- FALSE
|
||||
envir[["null"]] <- NULL
|
||||
|
||||
envir
|
||||
|
||||
}
|
||||
|
||||
renv_json_read_remap <- function(object, patterns) {
|
||||
|
||||
# repair names if necessary
|
||||
if (!is.null(names(object))) {
|
||||
|
||||
nms <- names(object)
|
||||
for (pattern in patterns)
|
||||
nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE)
|
||||
names(object) <- nms
|
||||
|
||||
}
|
||||
|
||||
# repair strings if necessary
|
||||
if (is.character(object)) {
|
||||
for (pattern in patterns)
|
||||
object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE)
|
||||
}
|
||||
|
||||
# recurse for other objects
|
||||
if (is.recursive(object))
|
||||
for (i in seq_along(object))
|
||||
object[i] <- list(renv_json_read_remap(object[[i]], patterns))
|
||||
|
||||
# return remapped object
|
||||
object
|
||||
|
||||
}
|
||||
|
||||
renv_json_read_default <- function(file = NULL, text = NULL) {
|
||||
|
||||
# find strings in the JSON
|
||||
# read json text
|
||||
text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
|
||||
pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
|
||||
locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
|
||||
|
||||
# if any are found, replace them with placeholders
|
||||
replaced <- text
|
||||
strings <- character()
|
||||
replacements <- character()
|
||||
|
||||
if (!identical(c(locs), -1L)) {
|
||||
|
||||
# get the string values
|
||||
starts <- locs
|
||||
ends <- locs + attr(locs, "match.length") - 1L
|
||||
strings <- substring(text, starts, ends)
|
||||
|
||||
# only keep those requiring escaping
|
||||
strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE)
|
||||
|
||||
# compute replacements
|
||||
replacements <- sprintf('"\032%i\032"', seq_along(strings))
|
||||
|
||||
# replace the strings
|
||||
mapply(function(string, replacement) {
|
||||
replaced <<- sub(string, replacement, replaced, fixed = TRUE)
|
||||
}, strings, replacements)
|
||||
|
||||
}
|
||||
|
||||
# transform the JSON into something the R parser understands
|
||||
transformed <- replaced
|
||||
transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE)
|
||||
transformed <- gsub("[[{]", "list(", transformed, perl = TRUE)
|
||||
transformed <- gsub("[]}]", ")", transformed, perl = TRUE)
|
||||
transformed <- gsub(":", "=", transformed, fixed = TRUE)
|
||||
text <- paste(transformed, collapse = "\n")
|
||||
# convert into something the R parser will understand
|
||||
patterns <- renv_json_read_patterns()
|
||||
transformed <- text
|
||||
for (pattern in patterns)
|
||||
transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE)
|
||||
|
||||
# parse it
|
||||
json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]]
|
||||
rfile <- tempfile("renv-json-", fileext = ".R")
|
||||
on.exit(unlink(rfile), add = TRUE)
|
||||
writeLines(transformed, con = rfile)
|
||||
json <- parse(rfile, keep.source = FALSE, srcfile = NULL)[[1L]]
|
||||
|
||||
# construct map between source strings, replaced strings
|
||||
map <- as.character(parse(text = strings))
|
||||
names(map) <- as.character(parse(text = replacements))
|
||||
# evaluate in safe environment
|
||||
result <- eval(json, envir = renv_json_read_envir())
|
||||
|
||||
# convert to list
|
||||
map <- as.list(map)
|
||||
|
||||
# remap strings in object
|
||||
remapped <- renv_json_read_remap(json, map)
|
||||
|
||||
# evaluate
|
||||
eval(remapped, envir = baseenv())
|
||||
# fix up strings if necessary
|
||||
renv_json_read_remap(result, patterns)
|
||||
|
||||
}
|
||||
|
||||
renv_json_read_remap <- function(json, map) {
|
||||
|
||||
# fix names
|
||||
if (!is.null(names(json))) {
|
||||
lhs <- match(names(json), names(map), nomatch = 0L)
|
||||
rhs <- match(names(map), names(json), nomatch = 0L)
|
||||
names(json)[rhs] <- map[lhs]
|
||||
}
|
||||
|
||||
# fix values
|
||||
if (is.character(json))
|
||||
return(map[[json]] %||% json)
|
||||
|
||||
# handle true, false, null
|
||||
if (is.name(json)) {
|
||||
text <- as.character(json)
|
||||
if (text == "true")
|
||||
return(TRUE)
|
||||
else if (text == "false")
|
||||
return(FALSE)
|
||||
else if (text == "null")
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
# recurse
|
||||
if (is.recursive(json)) {
|
||||
for (i in seq_along(json)) {
|
||||
json[i] <- list(renv_json_read_remap(json[[i]], map))
|
||||
}
|
||||
}
|
||||
|
||||
json
|
||||
|
||||
}
|
||||
|
||||
# load the renv profile, if any
|
||||
renv_bootstrap_profile_load(project)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue