This commit is contained in:
Andreas Gammelgaard Damsbo 2025-07-03 16:19:51 +02:00
parent c7b879f458
commit ec5603d368
No known key found for this signature in database
4 changed files with 807 additions and 745 deletions

View file

@ -11,10 +11,8 @@
data_visuals_ui <- function(id, tab_title = "Plots", ...) {
ns <- shiny::NS(id)
# bslib::navset_bar(
list(
# Sidebar with a slider input
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
multiple = FALSE,
@ -37,10 +35,6 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
),
shiny::helpText('Adjust settings, then press "Plot".')
),
# bslib::accordion_panel(
# title = "Advanced",
# icon = bsicons::bs_icon("gear")
# ),
bslib::accordion_panel(
title = "Download",
icon = bsicons::bs_icon("download"),
@ -92,16 +86,21 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
icon = shiny::icon("download")
)
)
)
),
bslib::nav_panel(
title = tab_title,
shiny::p("We have collected a few notes on visualising data and details on the options included in FreesearchR:", shiny::tags$a(
href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
"View notes in new tab",
target = "_blank",
rel = "noopener noreferrer"
))
),
shiny::plotOutput(ns("plot"), height = "70vh"),
shiny::tags$br(),
shiny::tags$br(),
shiny::htmlOutput(outputId = ns("code_plot"))
)
)
# )
}
@ -725,6 +724,7 @@ get_label <- function(data, var = NULL) {
#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
line_break <- function(data, lineLength = 20, force = FALSE) {
if (isTRUE(force)) {
## This eats some letters when splitting a sentence... ??
gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
} else {
paste(strwrap(data, lineLength), collapse = "\n")
@ -746,7 +746,7 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
wrap_plot_list <- function(data,
tag_levels = NULL,
title = NULL,
axis.font.family=NULL,
axis.font.family = NULL,
...) {
if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) {

View file

@ -44,14 +44,7 @@ data_missings_server <- function(id,
tryCatch(
{
if (!is.null(by_var) && by_var != "" && by_var %in% names(df_tbl)) {
df_tbl[[by_var]] <- ifelse(is.na(df_tbl[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(df_tbl, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(df_tbl)
}
out <- compare_missings(df_tbl,by_var)
},
error = function(err) {
showNotification(paste0("Error: ", err), type = "err")
@ -129,10 +122,22 @@ missing_demo_app <- function() {
missing_demo_app()
#' Pairwise comparison of missings across covariables
#'
#' @param data data frame
#' @param by_var variable to stratify by missingness
#'
#' @returns gtsummary list object
#' @export
#'
compare_missings <- function(data,by_var){
if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) {
data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(data, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(data)
}
out
}

View file

@ -44,7 +44,10 @@ regression_ui <- function(id, ...) {
ns <- shiny::NS(id)
shiny::tagList(
title = "",
# title = "",
bslib::nav_panel(
title = "Regression table",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
bslib::accordion(
@ -119,7 +122,19 @@ regression_ui <- function(id, ...) {
# )
# ),
shiny::tags$br()
)
)
),
gt::gt_output(outputId = ns("table2"))
)
),
bslib::nav_panel(
title = "Coefficient plot",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
do.call(
bslib::accordion_panel,
c(
@ -173,7 +188,19 @@ regression_ui <- function(id, ...) {
)
)
)
)
)
),
shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
)
),
bslib::nav_panel(
title = "Model checks",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
bslib::accordion_panel(
value = "acc_checks",
title = "Checks",
@ -182,19 +209,10 @@ regression_ui <- function(id, ...) {
)
)
),
bslib::nav_panel(
title = "Regression table",
gt::gt_output(outputId = ns("table2"))
),
bslib::nav_panel(
title = "Coefficient plot",
shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
),
bslib::nav_panel(
title = "Model checks",
shiny::plotOutput(outputId = ns("check"), height = "90vh")
)
)
)
}

View file

@ -5,7 +5,7 @@
########
library(shiny)
# library(shinyjs)
library(shinyjs)
# library(methods)
# library(readr)
# library(MASS)
@ -49,7 +49,7 @@ library(rlang)
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
########
app_version <- function()'25.6.4'
app_version <- function()'25.7.1'
########
@ -1611,10 +1611,8 @@ plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color =
data_visuals_ui <- function(id, tab_title = "Plots", ...) {
ns <- shiny::NS(id)
# bslib::navset_bar(
list(
# Sidebar with a slider input
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
multiple = FALSE,
@ -1637,10 +1635,6 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
),
shiny::helpText('Adjust settings, then press "Plot".')
),
# bslib::accordion_panel(
# title = "Advanced",
# icon = bsicons::bs_icon("gear")
# ),
bslib::accordion_panel(
title = "Download",
icon = bsicons::bs_icon("download"),
@ -1692,16 +1686,21 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
icon = shiny::icon("download")
)
)
)
),
bslib::nav_panel(
title = tab_title,
shiny::p("We have collected a few notes on visualising data and details on the options included in FreesearchR:", shiny::tags$a(
href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
"View notes in new tab",
target = "_blank",
rel = "noopener noreferrer"
))
),
shiny::plotOutput(ns("plot"), height = "70vh"),
shiny::tags$br(),
shiny::tags$br(),
shiny::htmlOutput(outputId = ns("code_plot"))
)
)
# )
}
@ -2325,6 +2324,7 @@ get_label <- function(data, var = NULL) {
#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
line_break <- function(data, lineLength = 20, force = FALSE) {
if (isTRUE(force)) {
## This eats some letters when splitting a sentence... ??
gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
} else {
paste(strwrap(data, lineLength), collapse = "\n")
@ -2346,7 +2346,7 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
wrap_plot_list <- function(data,
tag_levels = NULL,
title = NULL,
axis.font.family=NULL,
axis.font.family = NULL,
...) {
if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) {
@ -4026,7 +4026,7 @@ simple_snake <- function(data){
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
########
hosted_version <- function()'v25.6.4-250627'
hosted_version <- function()'v25.7.1-250703'
########
@ -4735,14 +4735,7 @@ data_missings_server <- function(id,
tryCatch(
{
if (!is.null(by_var) && by_var != "" && by_var %in% names(df_tbl)) {
df_tbl[[by_var]] <- ifelse(is.na(df_tbl[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(df_tbl, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(df_tbl)
}
out <- compare_missings(df_tbl,by_var)
},
error = function(err) {
showNotification(paste0("Error: ", err), type = "err")
@ -4820,13 +4813,25 @@ missing_demo_app <- function() {
missing_demo_app()
#' Pairwise comparison of missings across covariables
#'
#' @param data data frame
#' @param by_var variable to stratify by missingness
#'
#' @returns gtsummary list object
#' @export
#'
compare_missings <- function(data,by_var){
if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) {
data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(data, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(data)
}
out
}
########
@ -7415,7 +7420,10 @@ regression_ui <- function(id, ...) {
ns <- shiny::NS(id)
shiny::tagList(
title = "",
# title = "",
bslib::nav_panel(
title = "Regression table",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
bslib::accordion(
@ -7490,7 +7498,19 @@ regression_ui <- function(id, ...) {
# )
# ),
shiny::tags$br()
)
)
),
gt::gt_output(outputId = ns("table2"))
)
),
bslib::nav_panel(
title = "Coefficient plot",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
do.call(
bslib::accordion_panel,
c(
@ -7544,7 +7564,19 @@ regression_ui <- function(id, ...) {
)
)
)
)
)
),
shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
)
),
bslib::nav_panel(
title = "Model checks",
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
bslib::accordion_panel(
value = "acc_checks",
title = "Checks",
@ -7553,19 +7585,10 @@ regression_ui <- function(id, ...) {
)
)
),
bslib::nav_panel(
title = "Regression table",
gt::gt_output(outputId = ns("table2"))
),
bslib::nav_panel(
title = "Coefficient plot",
shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
),
bslib::nav_panel(
title = "Model checks",
shiny::plotOutput(outputId = ns("check"), height = "90vh")
)
)
)
}
@ -9873,6 +9896,8 @@ ui_elements <- list(
##############################################################################
"home" = bslib::nav_panel(
title = "FreesearchR",
# title = shiny::div(htmltools::img(src="FreesearchR-logo-white-nobg-h80.png")),
icon = shiny::icon("house"),
shiny::fluidRow(
## On building the dev-version for shinyapps.io, the dev_banner() is redefined
## Default just output "NULL"
@ -9884,8 +9909,7 @@ ui_elements <- list(
shiny::markdown(readLines("www/intro.md")),
shiny::column(width = 2)
)
),
icon = shiny::icon("home")
)
),
##############################################################################
#########
@ -9893,7 +9917,8 @@ ui_elements <- list(
#########
##############################################################################
"import" = bslib::nav_panel(
title = "Import",
title = "Get started",
icon = shiny::icon("upload"),
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(
@ -10011,15 +10036,13 @@ ui_elements <- list(
######### Data overview panel
#########
##############################################################################
"overview" =
# bslib::nav_panel_hidden(
bslib::nav_panel(
# value = "overview",
title = "Data",
bslib::navset_bar(
fillable = TRUE,
"prepare" = bslib::nav_menu(
title = "Prepare",
icon = shiny::icon("pen-to-square"),
bslib::nav_panel(
title = "Overview",
icon = shiny::icon("eye"),
value = "nav_prepare_overview",
tags$h3("Overview and filtering"),
fluidRow(
shiny::column(
@ -10061,22 +10084,6 @@ ui_elements <- list(
),
shiny::column(
width = 3,
# shiny::actionButton(
# inputId = "modal_missings",
# label = "Visual overview",
# width = "100%",
# disabled = TRUE
# ),
# shiny::br(),
# shiny::br(),
# shiny::actionButton(
# inputId = "modal_browse",
# label = "Browse data",
# width = "100%",
# disabled = TRUE
# ),
# shiny::br(),
# shiny::br(),
shiny::tags$h6("Filter data types"),
shiny::uiOutput(
outputId = "column_filter"
@ -10098,12 +10105,11 @@ ui_elements <- list(
),
shiny::br(),
shiny::br(),
# shiny::br(),
# shiny::br(),
shiny::br()
),
bslib::nav_panel(
title = "Modify",
icon = shiny::icon("file-pen"),
tags$h3("Subset, rename and convert variables"),
fluidRow(
shiny::column(
@ -10115,7 +10121,6 @@ ui_elements <- list(
)
)
),
# shiny::tags$br(),
update_variables_ui("modal_variables"),
shiny::tags$br(),
shiny::tags$br(),
@ -10171,13 +10176,11 @@ ui_elements <- list(
shiny::column(
width = 6,
shiny::tags$b("Original data:"),
# verbatimTextOutput("original"),
shiny::verbatimTextOutput("original_str")
),
shiny::column(
width = 6,
shiny::tags$b("Modified data:"),
# verbatimTextOutput("modified"),
shiny::verbatimTextOutput("modified_str")
)
),
@ -10191,7 +10194,7 @@ ui_elements <- list(
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
shiny::tags$br()
)
)
# )
),
##############################################################################
#########
@ -10199,22 +10202,28 @@ ui_elements <- list(
#########
##############################################################################
"describe" =
bslib::nav_panel(
bslib::nav_menu(
title = "Evaluate",
id = "navdescribe",
bslib::navset_bar(
title = "",
icon = shiny::icon("magnifying-glass-chart"),
# id = "navdescribe",
# bslib::navset_bar(
# title = "",
bslib::nav_panel(
title = "Characteristics",
icon = bsicons::bs_icon("table"),
bslib::layout_sidebar(
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
bslib::accordion(
open = "acc_chars",
multiple = FALSE,
bslib::accordion_panel(
open = TRUE,
value = "acc_chars",
title = "Characteristics",
title = "Settings",
icon = bsicons::bs_icon("table"),
shiny::uiOutput("strat_var"),
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Data' tab to reclass a variable if it's not on the list."),
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."),
shiny::conditionalPanel(
condition = "input.strat_var!='none'",
shiny::radioButtons(
@ -10238,9 +10247,23 @@ ui_elements <- list(
icon = shiny::icon("calculator"),
disabled = TRUE
)
)
)
),
gt::gt_output(outputId = "table1")
)
),
bslib::nav_panel(
title = "Correlations",
icon = bsicons::bs_icon("bounding-box"),
bslib::layout_sidebar(
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
bslib::accordion(
open = "acc_chars",
multiple = FALSE,
bslib::accordion_panel(
vlaue = "acc_cor",
value = "acc_cor",
title = "Correlations",
icon = bsicons::bs_icon("bounding-box"),
shiny::uiOutput("outcome_var_cor"),
@ -10257,26 +10280,29 @@ ui_elements <- list(
color = datamods:::get_primary_color()
),
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
)
)
),
data_correlations_ui(id = "correlations", height = 600)
)
),
bslib::nav_panel(
title = "Missings",
icon = bsicons::bs_icon("x-circle"),
bslib::layout_sidebar(
sidebar = bslib::sidebar(
bslib::accordion(
open = "acc_chars",
multiple = FALSE,
bslib::accordion_panel(
vlaue = "acc_mis",
title = "Missings",
icon = bsicons::bs_icon("x-circle"),
shiny::uiOutput("missings_var"),
shiny::helpText("To consider if daata is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
shiny::helpText("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
)
)
),
bslib::nav_panel(
title = "Characteristics",
gt::gt_output(outputId = "table1")
),
bslib::nav_panel(
title = "Correlations",
data_correlations_ui(id = "correlations", height = 600)
),
bslib::nav_panel(
title = "Missings",
data_missings_ui(id = "missingness")
)
)
@ -10286,27 +10312,23 @@ ui_elements <- list(
######### Download panel
#########
##############################################################################
"visuals" = bslib::nav_panel(
title = "Visuals",
id = "navvisuals",
do.call(
bslib::navset_bar,
"visuals" = do.call(
bslib::nav_panel,
c(
data_visuals_ui("visuals"),
shiny::tagList(
bslib::nav_spacer(),
bslib::nav_item(
# shiny::img(shiny::icon("book")),
shiny::tags$a(
href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
"Notes (external)",
target = "_blank",
rel = "noopener noreferrer"
)
)
)
)
list(
title = "Visuals",
icon = shiny::icon("chart-line"),
id = "navvisuals"
),
data_visuals_ui("visuals")
)
# do.call(
# bslib::navset_bar,
# data_visuals_ui("visuals")#,
# c(
# )
# )
),
##############################################################################
#########
@ -10316,9 +10338,10 @@ ui_elements <- list(
"analyze" =
bslib::nav_panel(
title = "Regression",
icon = shiny::icon("calculator"),
id = "navanalyses",
do.call(
bslib::navset_bar,
bslib::navset_card_tab,
regression_ui("regression")
)
),
@ -10330,6 +10353,7 @@ ui_elements <- list(
"download" =
bslib::nav_panel(
title = "Download",
icon = shiny::icon("download"),
id = "navdownload",
shiny::fluidRow(
shiny::column(width = 2),
@ -10455,9 +10479,24 @@ dark <- custom_theme(
# https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/
ui <- bslib::page_fixed(
## Code formatting dependencies
prismDependencies,
prismRDependency,
## Version dependent header
header_include(),
## Automatically close drop-downs on navigation
## Thanks to claude.ai
tags$script("
$(document).on('shown.bs.tab', '#main_panel', function(e) {
// Close dropdown in this specific navset only
$('#main_panel .dropdown-menu').removeClass('show');
$('#main_panel .dropdown-toggle').removeClass('show').attr('aria-expanded', 'false');
// Close navbar collapse (burger menu)
$('#main_panel .navbar-collapse collapse').removeClass('show');
$('#main_panel .navbar-toggle').removeClass('collapsed').attr('aria-expanded', 'false');
});
"),
## This adds the actual favicon
## png and ico versions are kept for compatibility
shiny::tags$head(tags$link(rel = "shortcut icon", href = "favicon.svg")),
@ -10477,14 +10516,14 @@ ui <- bslib::page_fixed(
id = "main_panel",
ui_elements$home,
ui_elements$import,
ui_elements$overview,
ui_elements$prepare,
ui_elements$describe,
ui_elements$visuals,
ui_elements$analyze,
ui_elements$download,
bslib::nav_spacer(),
ui_elements$feedback,
ui_elements$docs,
# ui_elements$feedback,
# ui_elements$docs,
fillable = FALSE,
footer = shiny::tags$footer(
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
@ -10494,7 +10533,7 @@ ui <- bslib::page_fixed(
),
shiny::p(
style = "margin: 1; color: #888;",
shiny::tags$a("Docs", href = "https://agdamsbo.github.io/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", hosted_version(), " | ", shiny::tags$a("License: AGPLv3", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Share feedback", href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8", target = "_blank", rel = "noopener noreferrer")
shiny::tags$a("Documentation", href = "https://agdamsbo.github.io/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", hosted_version(), " | ", shiny::tags$a("License: AGPLv3", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Share feedback", href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8", target = "_blank", rel = "noopener noreferrer")
),
)
)
@ -11206,7 +11245,7 @@ server <- function(input, output, session) {
##############################################################################
shiny::observeEvent(input$act_start, {
bslib::nav_select(id = "main_panel", selected = "Data")
bslib::nav_select(id = "main_panel", selected = "nav_prepare_overview")
})
##############################################################################