diff --git a/DESCRIPTION b/DESCRIPTION index 5a9d85b9..3e2cc6ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -141,6 +141,5 @@ Collate: 'update-variables-ext.R' 'utils-labels.R' 'validation.R' - 'version_check.R' 'visual_summary.R' 'wide2long.R' diff --git a/NEWS.md b/NEWS.md index 3cfed098..f08ae0b2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,6 @@ # FreesearchR 26.3.4 -*NEW* Added app version check against latest release on GitHub. Only runs if internet connection present. No other polling. -*NEW* Added a "Missing" level to the sankey plot function and adjusted the label font size. # FreesearchR 26.3.3 diff --git a/R/hosted_version.R b/R/hosted_version.R index 17135440..f0c656d1 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v26.3.4-260323' +hosted_version <- function()'v26.3.4-260312' diff --git a/R/launch_FreesearchR.R b/R/launch_FreesearchR.R index 92d09a51..a789f185 100644 --- a/R/launch_FreesearchR.R +++ b/R/launch_FreesearchR.R @@ -8,8 +8,6 @@ #' @param data_limit_default default data set observations limit #' @param data_limit_upper data set observations upper limit #' @param data_limit_lower data set observations lower limit -#' @param check_app_version always attempt to check app version against latest -#' release on GitHub. Default is FALSE #' @param ... passed on to `shiny::runApp()` #' #' @returns shiny app @@ -24,14 +22,12 @@ launch_FreesearchR <- function(include_globalenv = TRUE, data_limit_default = 1000, data_limit_upper = 100000, data_limit_lower = 1, - check_app_version = FALSE, ...) { Sys.setenv( INCLUDE_GLOBALENV = include_globalenv, DATA_LIMIT_DEFAULT = data_limit_default, DATA_LIMIT_UPPER = data_limit_upper, - DATA_LIMIT_LOWER = data_limit_lower, - CHECK_APP_VERSION = check_app_version + DATA_LIMIT_LOWER = data_limit_lower ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") diff --git a/R/plot_sankey.R b/R/plot_sankey.R index 4fd879b8..b3aa1b55 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -33,17 +33,15 @@ sankey_ready <- function(data, pri, sec, numbers = "count", ...) { dplyr::ungroup() if (numbers == "count") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(n=", gx.sum, ")" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(n=", gy.sum, ")" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(n=", gx.sum, ")")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(n=", gy.sum, ")")) + ) } else if (numbers == "percentage") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)")) + ) } if (is.factor(data[[pri]])) { @@ -85,39 +83,20 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -#' -#' # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") -#' # stRoke::trial |> plot_sankey("active", "male") -plot_sankey <- function(data, - pri, - sec, - ter = NULL, - color.group = "pri", - colors = NULL, - missing.level = "Missing") { +plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { if (!is.null(ter)) { ds <- split(data, data[ter]) } else { ds <- list(data) } - - out <- lapply(ds, \(.ds) { - plot_sankey_single( - .ds, - pri = pri, - sec = sec, - color.group = color.group, - colors = colors, - missing.level = missing.level - ) + out <- lapply(ds, \(.ds){ + plot_sankey_single(.ds, pri = pri, sec = sec, color.group = color.group, colors = colors,missing.level=missing.level) }) patchwork::wrap_plots(out) } - - #' Beautiful sankey plot #' #' @param color.group set group to colour by. "x" or "y". @@ -144,66 +123,41 @@ plot_sankey <- function(data, #' stRoke::trial |> #' default_parsing() |> #' plot_sankey_single("diabetes", "hypertension") -plot_sankey_single <- function(data, - pri, - sec, - color.group = c("pri", "sec"), - colors = NULL, - missing.level = "Missing", - ...) { +plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL,missing.level="Missing", ...) { color.group <- match.arg(color.group) + # browser() data_orig <- data - - data[c(pri, sec)] <- with_labels(data,{ - data[c(pri, sec)] |> - dplyr::mutate( - dplyr::across(dplyr::where(is.logical), as.factor), - dplyr::across(dplyr::where(is.factor), forcats::fct_drop), - dplyr::across(dplyr::where(is.factor), \(.x) { - if (anyNA(.x)) forcats::fct_na_value_to_level(.x, missing.level) else .x - }) - ) - }) + data[c(pri, sec)] <- data[c(pri, sec)] |> + dplyr::mutate( + # dplyr::across(dplyr::where(is.logical), as.factor), + dplyr::across(dplyr::where(is.factor), forcats::fct_drop)#, + # dplyr::across(dplyr::where(is.factor), \(.x){forcats::fct_na_value_to_level(.x,missing.level)}) + ) - ## Aggregate data - data_aggr <- data |> sankey_ready(pri = pri, sec = sec, ...) + data <- data |> sankey_ready(pri = pri, sec = sec, ...) na.color <- "#2986cc" box.color <- "#1E4B66" if (is.null(colors)) { if (color.group == "sec") { - if (anyNA(data_orig[[sec]])){ main.colors <- viridisLite::viridis(n = length(levels(data_orig[[sec]]))) - } else { - main.colors <- viridisLite::viridis(n = length(levels(data[[sec]]))) - } ## Only keep colors for included levels - main.colors <- main.colors[match(levels(data[[sec]]), levels(data[[sec]]))] + main.colors <- main.colors[match(levels(data[[sec]]), levels(data_orig[[sec]]))] secondary.colors <- rep(na.color, length(levels(data[[pri]]))) - label.colors <- Reduce(c, lapply(list( - secondary.colors, rev(main.colors) - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(secondary.colors, rev(main.colors)), contrast_text)) } else { - if (anyNA(data_orig[[sec]])){ - main.colors <- viridisLite::viridis(n = length(levels(data_orig[[pri]]))) - } else { - main.colors <- viridisLite::viridis(n = length(levels(data[[pri]]))) - } - # main.colors <- viridisLite::viridis(n = length(levels(data[[pri]]))) + main.colors <- viridisLite::viridis(n = length(levels(data_orig[[pri]]))) ## Only keep colors for included levels - main.colors <- main.colors[match(levels(data[[pri]]), levels(data[[pri]]))] + main.colors <- main.colors[match(levels(data[[pri]]), levels(data_orig[[pri]]))] secondary.colors <- rep(na.color, length(levels(data[[sec]]))) - label.colors <- Reduce(c, lapply(list( - rev(main.colors), secondary.colors - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(rev(main.colors), secondary.colors), contrast_text)) } colors <- c(na.color, main.colors, secondary.colors) - colors[is.na(colors)] <- "grey80" } else { label.colors <- contrast_text(colors) } @@ -212,9 +166,7 @@ plot_sankey_single <- function(data, sapply(line_break) |> unname() - # browser() - - p <- ggplot2::ggplot(data_aggr, ggplot2::aes(y = n, axis1 = lx, axis2 = ly)) + p <- ggplot2::ggplot(data, ggplot2::aes(y = n, axis1 = lx, axis2 = ly)) if (color.group == "sec") { p <- p + @@ -229,8 +181,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } else { p <- p + ggalluvial::geom_alluvium( @@ -243,8 +196,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } ## Will fail to use stat="stratum" if library is not loaded. @@ -254,10 +208,13 @@ plot_sankey_single <- function(data, stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 6, + size = 8, lineheight = 1 ) + - ggplot2::scale_x_continuous(breaks = 1:2, labels = group_labels) + + ggplot2::scale_x_continuous( + breaks = 1:2, + labels = group_labels + ) + ggplot2::scale_fill_manual(values = colors[-1], na.value = colors[1]) + # ggplot2::scale_color_manual(values = main.colors) + ggplot2::theme_void() + diff --git a/R/sysdata.rda b/R/sysdata.rda index efea72cf..f8b0df59 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/ui_elements.R b/R/ui_elements.R index 96175376..cac844a0 100644 --- a/R/ui_elements.R +++ b/R/ui_elements.R @@ -25,7 +25,6 @@ ui_elements <- function(selection) { ## Default just output "NULL" ## This could probably be achieved more legantly, but this works. dev_banner(), - version_banner, landing_page_ui(i18n = i18n), # shiny::column(width = 2), # shiny::column( diff --git a/R/validation.R b/R/validation.R index 8d6847b4..2ea65d76 100644 --- a/R/validation.R +++ b/R/validation.R @@ -65,6 +65,33 @@ validation_server <- function(id, data_r <- if (shiny::is.reactive(data)) data else shiny::reactive(data) + # observeEvent(data_r(), { + # to_validate <- data() + # valid_dims <- check_data(to_validate, n_row = n_row, n_col = n_col) + # + # if (all(c(valid_dims$nrows, valid_dims$ncols))) { + # valid_status <- "OK" + # } else { + # valid_status <- "Failed" + # } + # + # valid_results <- lapply( + # X = c("nrows", "ncols"), + # FUN = function(x) { + # if (is.null(valid_dims[[x]])) + # return(NULL) + # label <- switch( + # x, + # "nrows" = n_row_label, + # "ncols" = n_col_label + # ) + # list( + # status = ifelse(valid_dims[[x]], "OK", "Failed"), + # label = paste0("", label, "") + # ) + # } + # ) + shiny::observeEvent( data_r(), { diff --git a/R/version_check.R b/R/version_check.R deleted file mode 100644 index 4f6932e4..00000000 --- a/R/version_check.R +++ /dev/null @@ -1,325 +0,0 @@ -# version_check.R -# -# Runs a one-time version check at app startup and returns a ready-made -# shinyWidgets::alert() UI element that can be placed directly in the UI -# definition -- no server(), no renderUI(), no uiOutput() required. -# -# Because the check runs outside server(), it executes once when the app -# process starts, so the banner is present immediately on first render with -# no loading delay. -# -# Version detection uses two strategies, tried in order: -# 1. utils::packageVersion() -- works when the package is installed locally. -# 2. app_version argument -- explicit fallback for environments where the -# package is not installed (e.g. shinyapps.io). Pass the result of your -# app_version() function here. -# -# Quick start: -# -# # global.R (or top of app.R, before ui / server) -# source("version_check.R") -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version() # fallback for shinyapps.io -# ) -# -# # ui.R -- drop the result anywhere in the UI tree -# fluidPage( -# version_banner, -# ... -# ) -# -# # Verbose / debug mode -- always show the banner: -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version(), -# verbose = TRUE -# ) - - -# -- Internal helpers ---------------------------------------------------------- - -#' Check internet connectivity -#' -#' @return Logical; TRUE if an internet connection is available. -.has_internet <- function() { - tryCatch({ - con <- url("https://api.github.com", open = "r") - close(con) - TRUE - }, error = function(e) FALSE) -} - - -#' Fetch the latest release version from a GitHub repository -#' -#' @param github_user GitHub username or organisation. -#' @param github_repo Repository name. -#' -#' @return A character string with the version tag (e.g. "1.2.0"), or NULL on -#' failure. -.get_latest_github_version <- function(github_user, github_repo) { - api_url <- sprintf( - "https://api.github.com/repos/%s/%s/releases/latest", - github_user, - github_repo - ) - - tryCatch({ - response <- readLines(url(api_url), warn = FALSE) - json_text <- paste(response, collapse = "") - - tag <- regmatches( - json_text, - regexpr('"tag_name"\\s*:\\s*"([^"]+)"', json_text) - ) - - if (length(tag) == 0 || nchar(tag) == 0) return(NULL) - - # Strip a leading "v" if present (e.g. "v1.2.0" -> "1.2.0") - sub('^"tag_name"\\s*:\\s*"v?([^"]+)"$', "\\1", tag) - }, error = function(e) NULL) -} - - -#' Resolve the current app version -#' -#' Tries two strategies in order: -#' \enumerate{ -#' \item \code{utils::packageVersion(package_name)} -- works when the package -#' is installed locally (development, local \code{runApp()}). -#' \item \code{app_version} argument -- an explicit version string supplied by -#' the caller, e.g. from an \code{app_version()} function bundled with the -#' app. Used on shinyapps.io where the package is not installed. -#' } -#' -#' @param package_name Name of the package / repository. -#' @param app_version Optional fallback version string. -#' -#' @return A character string with the version (e.g. "1.1.0"), or NULL if -#' neither strategy succeeds. -.resolve_app_version <- function(package_name, app_version = NULL) { - - # Strategy 1: installed package - v <- tryCatch( - as.character(utils::packageVersion(package_name)), - error = function(e) NULL - ) - if (!is.null(v)) { - message("[version_check] Version source: installed package") - return(v) - } - - # Strategy 2: explicit fallback supplied by the caller - if (!is.null(app_version)) { - message("[version_check] Version source: app_version() fallback") - return(as.character(app_version)) - } - - NULL -} - - -#' Build a shinyWidgets::alert() UI element for the version banner -#' -#' @param current Current installed version string. -#' @param latest Latest GitHub release version string, or NULL when -#' the check could not complete (e.g. no internet). -#' @param update_available Logical; whether latest > current. -#' @param github_user GitHub username / organisation. -#' @param github_repo Repository name. -#' -#' @return A \code{shinyWidgets::alert()} UI element. -.build_version_alert <- function(current, - latest, - update_available, - github_user, - github_repo) { - - repo_url <- sprintf( - "https://github.com/%s/%s/releases/latest", - github_user, - github_repo - ) - - if (is.null(latest)) { - # Version check could not complete (no internet or API failure) - return( - shinyWidgets::alert( - tags$b("Version check failed. "), - sprintf( - "Running version %s. Could not reach GitHub to check for updates.", - current - ), - status = "warning", - dismissible = TRUE - ) - ) - } - - if (update_available) { - shinyWidgets::alert( - tags$b("Update available! "), - sprintf( - "You are running version %s. Version %s is available on GitHub.", - current, latest - ), - " ", - tags$a(href = repo_url, target = "_blank", "View release"), - status = "warning", - dismissible = TRUE - ) - } else { - # Up to date -- only shown in verbose mode - shinyWidgets::alert( - tags$b("Up to date. "), - sprintf( - "You are running version %s, which matches the latest release (%s).", - current, latest - ), - status = "success", - dismissible = TRUE - ) - } -} - - -# -- Public API ---------------------------------------------------------------- - -#' Run a startup version check and return a banner UI element -#' -#' Call this \strong{outside} \code{server()} -- typically in -#' \code{global.R} or at the top of \code{app.R} -- and embed the returned -#' value directly in your UI definition. Because the check runs at startup -#' the banner is present on first render with no loading delay, and no -#' \code{uiOutput()} / \code{renderUI()} wiring is needed. -#' -#' \strong{Normal mode} (\code{verbose = FALSE}): returns a banner only when -#' a newer version is available or when the check fails. Returns \code{NULL} -#' when the app is up to date (Shiny silently ignores \code{NULL} in the UI). -#' -#' \strong{Verbose / debug mode} (\code{verbose = TRUE}): always returns a -#' banner -- including a success banner when up to date -- so you can confirm -#' the check ran and inspect both version strings during development. -#' -#' @param github_user GitHub username or organisation that owns the repository. -#' @param github_repo Repository name. Also used as the package name for -#' \code{utils::packageVersion()}. -#' @param app_version Optional fallback version string for environments where -#' the package is not installed (e.g. shinyapps.io). Pass the result of your -#' \code{app_version()} function here. Ignored when \code{packageVersion()} -#' succeeds. -#' @param verbose Logical; if \code{TRUE} a banner is always returned. -#' Defaults to \code{FALSE}. -#' -#' @return A \code{shinyWidgets::alert()} UI element, or \code{NULL} when there -#' is nothing to show (up to date in non-verbose mode). -#' -#' @examples -#' \dontrun{ -#' # global.R or top of app.R -#' source("version_check.R") -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version() # fallback for shinyapps.io -#' ) -#' -#' # ui.R -#' fluidPage( -#' version_banner, -#' # ... rest of UI -#' ) -#' -#' # Verbose mode for development -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version(), -#' verbose = TRUE -#' ) -#' } -check_app_version <- function(github_user, - github_repo, - app_version = NULL, - verbose = FALSE) { - - # -- 1. Resolve current version ---------------------------------------------- - local_version <- .resolve_app_version(github_repo, app_version) - if (is.null(local_version)) { - message(sprintf( - "[version_check] Could not determine version for '%s' (package not installed and no app_version() fallback supplied).", - github_repo - )) - return(NULL) - } - - message(sprintf("[version_check] Current version: %s", local_version)) - - # -- 2. Internet check ------------------------------------------------------- - if (!.has_internet()) { - message("[version_check] No internet connection detected -- skipping.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - # -- 3. Fetch latest GitHub release ------------------------------------------ - latest_version <- .get_latest_github_version(github_user, github_repo) - if (is.null(latest_version)) { - message("[version_check] Could not retrieve latest version from GitHub.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - message(sprintf("[version_check] Latest GitHub release: %s", latest_version)) - - # -- 4. Compare versions ----------------------------------------------------- - update_available <- numeric_version(latest_version) > numeric_version(local_version) - - if (update_available) { - message(sprintf( - "[version_check] Update available: %s -> %s", - local_version, latest_version - )) - } else { - message(sprintf("[version_check] App is up to date (%s).", local_version)) - } - - # -- 5. Return banner -------------------------------------------------------- - # An update was found -> always return a warning banner - # Up to date + verbose -> return a success banner - # Up to date + not verbose -> return NULL (Shiny ignores NULL in the UI) - if (update_available || verbose) { - .build_version_alert( - current = local_version, - latest = latest_version, - update_available = update_available, - github_user = github_user, - github_repo = github_repo - ) - } else { - NULL - } -} diff --git a/README.md b/README.md index b6444c6d..344b8649 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,10 @@ -# FreesearchR FreesearchR website +# FreesearchR FreesearchR website - -[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429) [![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) [![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/) - +[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429) +[![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) +[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/) The [***FreesearchR***](https://app.freesearchr.org) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. @@ -18,11 +19,11 @@ All feedback is welcome and can be shared as a GitHub issue. Any suggestions on This app has the following simple goals: -1. help the health clinician getting an overview of data in quality improvement projects and clinical research +1. help the health clinician getting an overview of data in quality improvement projects and clinical research -2. help learners get a good start analysing data and coding in *R* +1. help learners get a good start analysing data and coding in *R* -3. ease quick data overview and basic visualisations for any clinical researcher +1. ease quick data overview and basic visualisations for any clinical researcher Here’s a polished and restructured version of your README section for clarity, conciseness, and user-friendliness: @@ -34,32 +35,32 @@ The **FreesearchR** app can be run locally on your machine, ensuring no data is The app can be configured either by passing a named list to `run_app()` or by setting environment variables in a **Docker Compose** file. The following variables control data access and display behavior. If no values are provided, the app will use the defaults listed below. + **Configuration Variables** -| Variable | Description | Default | -|--------------|--------------------------------------------|--------------| -| `INCLUDE_GLOBALENV` | Load datasets already present in the global R environment into the app | `FALSE` | -| `DATA_LIMIT_DEFAULT` | Default number of observations for previewing or working with a dataset | `10,000` | -| `DATA_LIMIT_UPPER` | Maximum number of observations a user can set for the upper limit. If set to 0, no uppper limit is applied. | `100,000` | -| `DATA_LIMIT_LOWER` | Minimum number of observations a user can set for the lower limit | `1` | -| `CHECK_APP_VERSION` | Always print version check results. Checks app version against latest release on GitHub. | `FALSE` | +| Variable | Description | Default | +|-------------------------|-----------------------------------------------------------------------------|-----------| +| `INCLUDE_GLOBALENV` | Load datasets already present in the global R environment into the app | `FALSE` | +| `DATA_LIMIT_DEFAULT` | Default number of observations for previewing or working with a dataset | `10,000` | +| `DATA_LIMIT_UPPER` | Maximum number of observations a user can set for the upper limit. If set to 0, no uppper limit is applied. | `100,000` | +| `DATA_LIMIT_LOWER` | Minimum number of observations a user can set for the lower limit | `1` | ### Run from R (or RStudio) If you're working with data in R, **FreesearchR** is a quick and easy tool for exploratory analysis. -1. **Requirement:** Ensure you have [R](https://www.r-project.org/) installed, and optionally an editor like [RStudio](https://posit.co/download/rstudio-desktop/). +1. **Requirement:** Ensure you have [R](https://www.r-project.org/) installed, and optionally an editor like [RStudio](https://posit.co/download/rstudio-desktop/). -2. Open the **R console** and run the following code to install the `{FreesearchR}` package and launch the app: +2. Open the **R console** and run the following code to install the `{FreesearchR}` package and launch the app: - ``` r - if (!require("devtools")) install.packages("devtools") - devtools::install_github("agdamsbo/FreesearchR") - library(FreesearchR) - # Load sample data (e.g., mtcars) to make it available in the app - data(mtcars) - launch_FreesearchR(INCLUDE_GLOBALENV=TRUE,CHECK_APP_VERSION=TRUE) - ``` + ```r + if (!require("devtools")) install.packages("devtools") + devtools::install_github("agdamsbo/FreesearchR") + library(FreesearchR) + # Load sample data (e.g., mtcars) to make it available in the app + data(mtcars) + launch_FreesearchR(INCLUDE_GLOBALENV=TRUE) + ``` All the variables specified above can also be passed to the app on launch from R. Set DATA_LIMIT_UPPER=0 to remove upper data limit. This limit is set to protect the online app version from choking and crashing on large data sets. @@ -69,7 +70,7 @@ For advanced users, you can deploy **FreesearchR** using Docker. A data folder c To mount a local data folder, add a `volumes` entry to your `docker-compose.yml` file: -``` yaml +```yaml services: shiny: image: ghcr.io/agdamsbo/freesearchr:latest @@ -85,9 +86,9 @@ services: restart: on-failure ``` -- The `:ro` flag mounts the folder as **read-only**, preventing the app from modifying your original data files. +- The `:ro` flag mounts the folder as **read-only**, preventing the app from modifying your original data files. -- If no volume is mounted, the app will start without any preloaded datasets. +- If no volume is mounted, the app will start without any preloaded datasets. ## Code of Conduct diff --git a/SESSION.md b/SESSION.md index 44778018..1bd978b0 100644 --- a/SESSION.md +++ b/SESSION.md @@ -11,11 +11,11 @@ |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |Europe/Copenhagen | -|date |2026-03-23 | +|date |2026-03-12 | |rstudio |2026.01.1+403 Apple Blossom (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |26.3.4.260323 | +|FreesearchR |26.3.4.260312 | -------------------------------------------------------------------------------- @@ -33,7 +33,6 @@ |bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.5.0) | |bitops |1.0-9 |2024-10-03 |CRAN (R 4.5.0) | |boot |1.3-32 |2025-08-29 |CRAN (R 4.5.0) | -|brio |1.1.5 |2024-04-24 |CRAN (R 4.5.0) | |broom |1.0.12 |2026-01-27 |CRAN (R 4.5.2) | |broom.helpers |1.22.0 |2025-09-17 |CRAN (R 4.5.0) | |bsicons |0.1.2 |2023-11-04 |CRAN (R 4.5.0) | @@ -44,7 +43,6 @@ |cardx |0.3.2 |2026-02-05 |CRAN (R 4.5.2) | |caTools |1.18.3 |2024-09-04 |CRAN (R 4.5.0) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.5.0) | -|cffr |1.2.1 |2026-01-12 |CRAN (R 4.5.2) | |checkmate |2.3.4 |2026-02-03 |CRAN (R 4.5.2) | |class |7.3-23 |2025-01-01 |CRAN (R 4.5.0) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.5.0) | @@ -54,7 +52,6 @@ |colorspace |2.1-2 |2025-09-22 |CRAN (R 4.5.0) | |commonmark |2.0.0 |2025-07-07 |CRAN (R 4.5.0) | |crayon |1.5.3 |2024-06-20 |CRAN (R 4.5.0) | -|curl |7.0.0 |2025-08-19 |CRAN (R 4.5.0) | |data.table |1.18.2.1 |2026-01-27 |CRAN (R 4.5.2) | |datamods |1.5.3 |2024-10-02 |CRAN (R 4.5.0) | |datawizard |1.3.0 |2025-10-11 |CRAN (R 4.5.0) | @@ -69,7 +66,7 @@ |e1071 |1.7-17 |2025-12-18 |CRAN (R 4.5.2) | |easystats |0.7.5 |2025-07-11 |CRAN (R 4.5.0) | |ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.5.0) | -|emmeans |2.0.1 |2025-12-16 |CRAN (R 4.5.2) | +|emmeans |2.0.2 |2026-03-05 |CRAN (R 4.5.2) | |esquisse |2.1.0 |2025-02-21 |CRAN (R 4.5.0) | |estimability |1.5.1 |2024-05-12 |CRAN (R 4.5.0) | |eulerr |7.0.4 |2025-09-24 |CRAN (R 4.5.0) | @@ -77,7 +74,6 @@ |farver |2.1.2 |2024-05-13 |CRAN (R 4.5.0) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.5.0) | |flextable |0.9.11 |2026-02-13 |CRAN (R 4.5.2) | -|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.5.0) | |fontBitstreamVera |0.1.1 |2017-02-01 |CRAN (R 4.5.0) | |fontLiberation |0.1.0 |2016-10-15 |CRAN (R 4.5.0) | |fontquiver |0.2.1 |2017-02-01 |CRAN (R 4.5.0) | @@ -113,11 +109,9 @@ |iterators |1.0.14 |2022-02-05 |CRAN (R 4.5.0) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.5.0) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.5.0) | -|jsonvalidate |1.5.0 |2025-02-07 |CRAN (R 4.5.0) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.5.0) | |keyring |1.4.1 |2025-06-15 |CRAN (R 4.5.0) | |knitr |1.51 |2025-12-20 |CRAN (R 4.5.2) | -|labeling |0.4.3 |2023-08-29 |CRAN (R 4.5.0) | |later |1.4.8 |2026-03-05 |CRAN (R 4.5.2) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.5.2) | |lifecycle |1.0.5 |2026-01-08 |CRAN (R 4.5.2) | @@ -129,7 +123,7 @@ |memoise |2.0.1 |2021-11-26 |CRAN (R 4.5.0) | |mime |0.13 |2025-03-17 |CRAN (R 4.5.0) | |minqa |1.2.8 |2024-08-17 |CRAN (R 4.5.0) | -|mvtnorm |1.3-2 |2024-11-04 |CRAN (R 4.5.2) | +|mvtnorm |1.3-5 |2026-03-11 |CRAN (R 4.5.2) | |NHANES |2.1.0 |2015-07-02 |CRAN (R 4.5.0) | |nlme |3.1-168 |2025-03-31 |CRAN (R 4.5.0) | |nloptr |2.2.1 |2025-03-17 |CRAN (R 4.5.0) | @@ -162,7 +156,6 @@ |R6 |2.6.1 |2025-02-15 |CRAN (R 4.5.0) | |ragg |1.5.1 |2026-03-06 |CRAN (R 4.5.2) | |rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.5.0) | -|rappdirs |0.3.4 |2026-01-17 |CRAN (R 4.5.2) | |rbibutils |2.4.1 |2026-01-21 |CRAN (R 4.5.2) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.5.0) | |Rcpp |1.1.1 |2026-01-10 |CRAN (R 4.5.2) | @@ -204,7 +197,6 @@ |stringr |1.6.0 |2025-11-04 |CRAN (R 4.5.0) | |stRoke |25.9.2 |2025-09-30 |CRAN (R 4.5.0) | |systemfonts |1.3.2 |2026-03-05 |CRAN (R 4.5.2) | -|testthat |3.3.2 |2026-01-11 |CRAN (R 4.5.2) | |textshaping |1.0.5 |2026-03-06 |CRAN (R 4.5.2) | |thematic |0.1.8 |2025-09-29 |CRAN (R 4.5.0) | |tibble |3.3.1 |2026-01-11 |CRAN (R 4.5.2) | @@ -216,9 +208,7 @@ |twosamples |2.0.1 |2023-06-23 |CRAN (R 4.5.0) | |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.5.0) | |usethis |3.2.1 |2025-09-06 |CRAN (R 4.5.0) | -|utf8 |1.2.6 |2025-06-08 |CRAN (R 4.5.0) | |uuid |1.2-2 |2026-01-23 |CRAN (R 4.5.2) | -|V8 |8.0.1 |2025-10-10 |CRAN (R 4.5.0) | |vctrs |0.7.1 |2026-01-23 |CRAN (R 4.5.2) | |viridis |0.6.5 |2024-01-29 |CRAN (R 4.5.0) | |viridisLite |0.4.3 |2026-02-04 |CRAN (R 4.5.2) | diff --git a/app_docker/app.R b/app_docker/app.R index 7d30c295..1355da88 100644 --- a/app_docker/app.R +++ b/app_docker/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprPVhaz/file70562aff8e9e.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpZZ6Yua/file58174f49b1bf.R ######## i18n_path <- here::here("translations") @@ -4514,7 +4514,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.4-260323' +hosted_version <- function()'v26.3.4-260312' ######## @@ -5964,8 +5964,6 @@ landing_page_ui <- function(i18n) { #' @param data_limit_default default data set observations limit #' @param data_limit_upper data set observations upper limit #' @param data_limit_lower data set observations lower limit -#' @param check_app_version always attempt to check app version against latest -#' release on GitHub. Default is FALSE #' @param ... passed on to `shiny::runApp()` #' #' @returns shiny app @@ -5980,14 +5978,12 @@ launch_FreesearchR <- function(include_globalenv = TRUE, data_limit_default = 1000, data_limit_upper = 100000, data_limit_lower = 1, - check_app_version = FALSE, ...) { Sys.setenv( INCLUDE_GLOBALENV = include_globalenv, DATA_LIMIT_DEFAULT = data_limit_default, DATA_LIMIT_UPPER = data_limit_upper, - DATA_LIMIT_LOWER = data_limit_lower, - CHECK_APP_VERSION = check_app_version + DATA_LIMIT_LOWER = data_limit_lower ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") @@ -7058,17 +7054,15 @@ sankey_ready <- function(data, pri, sec, numbers = "count", ...) { dplyr::ungroup() if (numbers == "count") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(n=", gx.sum, ")" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(n=", gy.sum, ")" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(n=", gx.sum, ")")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(n=", gy.sum, ")")) + ) } else if (numbers == "percentage") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)")) + ) } if (is.factor(data[[pri]])) { @@ -7110,38 +7104,20 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -#' -#' # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") -plot_sankey <- function(data, - pri, - sec, - ter = NULL, - color.group = "pri", - colors = NULL, - missing.level = "Missing") { +plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { if (!is.null(ter)) { ds <- split(data, data[ter]) } else { ds <- list(data) } - - out <- lapply(ds, \(.ds) { - plot_sankey_single( - .ds, - pri = pri, - sec = sec, - color.group = color.group, - colors = colors, - missing.level = missing.level - ) + out <- lapply(ds, \(.ds){ + plot_sankey_single(.ds, pri = pri, sec = sec, color.group = color.group, colors = colors,missing.level=missing.level) }) patchwork::wrap_plots(out) } - - #' Beautiful sankey plot #' #' @param color.group set group to colour by. "x" or "y". @@ -7168,31 +7144,19 @@ plot_sankey <- function(data, #' stRoke::trial |> #' default_parsing() |> #' plot_sankey_single("diabetes", "hypertension") -plot_sankey_single <- function(data, - pri, - sec, - color.group = c("pri", "sec"), - colors = NULL, - missing.level = "Missing", - ...) { +plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL,missing.level="Missing", ...) { color.group <- match.arg(color.group) - - # browser() - # if (is.na(ds[c(pri,sec)])) - # browser() data_orig <- data - data[c(pri, sec)] <- data[c(pri, sec)] |> dplyr::mutate( - dplyr::across(dplyr::where(is.logical), as.factor), - dplyr::across(dplyr::where(is.factor), forcats::fct_drop), - dplyr::across(dplyr::where(is.factor), \(.x) { - forcats::fct_na_value_to_level(.x, missing.level) - }) + # dplyr::across(dplyr::where(is.logical), as.factor), + dplyr::across(dplyr::where(is.factor), forcats::fct_drop)#, + # dplyr::across(dplyr::where(is.factor), \(.x){forcats::fct_na_value_to_level(.x,missing.level)}) ) + data <- data |> sankey_ready(pri = pri, sec = sec, ...) na.color <- "#2986cc" @@ -7205,26 +7169,21 @@ plot_sankey_single <- function(data, main.colors <- main.colors[match(levels(data[[sec]]), levels(data_orig[[sec]]))] secondary.colors <- rep(na.color, length(levels(data[[pri]]))) - label.colors <- Reduce(c, lapply(list( - secondary.colors, rev(main.colors) - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(secondary.colors, rev(main.colors)), contrast_text)) } else { main.colors <- viridisLite::viridis(n = length(levels(data_orig[[pri]]))) ## Only keep colors for included levels main.colors <- main.colors[match(levels(data[[pri]]), levels(data_orig[[pri]]))] secondary.colors <- rep(na.color, length(levels(data[[sec]]))) - label.colors <- Reduce(c, lapply(list( - rev(main.colors), secondary.colors - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(rev(main.colors), secondary.colors), contrast_text)) } colors <- c(na.color, main.colors, secondary.colors) - colors[is.na(colors)] <- "grey80" } else { label.colors <- contrast_text(colors) } - group_labels <- c(get_label(data_orig, pri), get_label(data_orig, sec)) |> + group_labels <- c(get_label(data, pri), get_label(data, sec)) |> sapply(line_break) |> unname() @@ -7243,8 +7202,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } else { p <- p + ggalluvial::geom_alluvium( @@ -7257,8 +7217,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } ## Will fail to use stat="stratum" if library is not loaded. @@ -7268,10 +7229,13 @@ plot_sankey_single <- function(data, stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 6, + size = 8, lineheight = 1 ) + - ggplot2::scale_x_continuous(breaks = 1:2, labels = group_labels) + + ggplot2::scale_x_continuous( + breaks = 1:2, + labels = group_labels + ) + ggplot2::scale_fill_manual(values = colors[-1], na.value = colors[1]) + # ggplot2::scale_color_manual(values = main.colors) + ggplot2::theme_void() + @@ -10808,7 +10772,6 @@ ui_elements <- function(selection) { ## Default just output "NULL" ## This could probably be achieved more legantly, but this works. dev_banner(), - version_banner, landing_page_ui(i18n = i18n), # shiny::column(width = 2), # shiny::column( @@ -12869,6 +12832,33 @@ validation_server <- function(id, data_r <- if (shiny::is.reactive(data)) data else shiny::reactive(data) + # observeEvent(data_r(), { + # to_validate <- data() + # valid_dims <- check_data(to_validate, n_row = n_row, n_col = n_col) + # + # if (all(c(valid_dims$nrows, valid_dims$ncols))) { + # valid_status <- "OK" + # } else { + # valid_status <- "Failed" + # } + # + # valid_results <- lapply( + # X = c("nrows", "ncols"), + # FUN = function(x) { + # if (is.null(valid_dims[[x]])) + # return(NULL) + # label <- switch( + # x, + # "nrows" = n_row_label, + # "ncols" = n_col_label + # ) + # list( + # status = ifelse(valid_dims[[x]], "OK", "Failed"), + # label = paste0("", label, "") + # ) + # } + # ) + shiny::observeEvent( data_r(), { @@ -13252,337 +13242,6 @@ make_validation_alerts <- function(data) { } -######## -#### Current file: /Users/au301842/FreesearchR/R//version_check.R -######## - -# version_check.R -# -# Runs a one-time version check at app startup and returns a ready-made -# shinyWidgets::alert() UI element that can be placed directly in the UI -# definition -- no server(), no renderUI(), no uiOutput() required. -# -# Because the check runs outside server(), it executes once when the app -# process starts, so the banner is present immediately on first render with -# no loading delay. -# -# Version detection uses two strategies, tried in order: -# 1. utils::packageVersion() -- works when the package is installed locally. -# 2. app_version argument -- explicit fallback for environments where the -# package is not installed (e.g. shinyapps.io). Pass the result of your -# app_version() function here. -# -# Quick start: -# -# # global.R (or top of app.R, before ui / server) -# source("version_check.R") -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version() # fallback for shinyapps.io -# ) -# -# # ui.R -- drop the result anywhere in the UI tree -# fluidPage( -# version_banner, -# ... -# ) -# -# # Verbose / debug mode -- always show the banner: -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version(), -# verbose = TRUE -# ) - - -# -- Internal helpers ---------------------------------------------------------- - -#' Check internet connectivity -#' -#' @return Logical; TRUE if an internet connection is available. -.has_internet <- function() { - tryCatch({ - con <- url("https://api.github.com", open = "r") - close(con) - TRUE - }, error = function(e) FALSE) -} - - -#' Fetch the latest release version from a GitHub repository -#' -#' @param github_user GitHub username or organisation. -#' @param github_repo Repository name. -#' -#' @return A character string with the version tag (e.g. "1.2.0"), or NULL on -#' failure. -.get_latest_github_version <- function(github_user, github_repo) { - api_url <- sprintf( - "https://api.github.com/repos/%s/%s/releases/latest", - github_user, - github_repo - ) - - tryCatch({ - response <- readLines(url(api_url), warn = FALSE) - json_text <- paste(response, collapse = "") - - tag <- regmatches( - json_text, - regexpr('"tag_name"\\s*:\\s*"([^"]+)"', json_text) - ) - - if (length(tag) == 0 || nchar(tag) == 0) return(NULL) - - # Strip a leading "v" if present (e.g. "v1.2.0" -> "1.2.0") - sub('^"tag_name"\\s*:\\s*"v?([^"]+)"$', "\\1", tag) - }, error = function(e) NULL) -} - - -#' Resolve the current app version -#' -#' Tries two strategies in order: -#' \enumerate{ -#' \item \code{utils::packageVersion(package_name)} -- works when the package -#' is installed locally (development, local \code{runApp()}). -#' \item \code{app_version} argument -- an explicit version string supplied by -#' the caller, e.g. from an \code{app_version()} function bundled with the -#' app. Used on shinyapps.io where the package is not installed. -#' } -#' -#' @param package_name Name of the package / repository. -#' @param app_version Optional fallback version string. -#' -#' @return A character string with the version (e.g. "1.1.0"), or NULL if -#' neither strategy succeeds. -.resolve_app_version <- function(package_name, app_version = NULL) { - - # Strategy 1: installed package - v <- tryCatch( - as.character(utils::packageVersion(package_name)), - error = function(e) NULL - ) - if (!is.null(v)) { - message("[version_check] Version source: installed package") - return(v) - } - - # Strategy 2: explicit fallback supplied by the caller - if (!is.null(app_version)) { - message("[version_check] Version source: app_version() fallback") - return(as.character(app_version)) - } - - NULL -} - - -#' Build a shinyWidgets::alert() UI element for the version banner -#' -#' @param current Current installed version string. -#' @param latest Latest GitHub release version string, or NULL when -#' the check could not complete (e.g. no internet). -#' @param update_available Logical; whether latest > current. -#' @param github_user GitHub username / organisation. -#' @param github_repo Repository name. -#' -#' @return A \code{shinyWidgets::alert()} UI element. -.build_version_alert <- function(current, - latest, - update_available, - github_user, - github_repo) { - - repo_url <- sprintf( - "https://github.com/%s/%s/releases/latest", - github_user, - github_repo - ) - - if (is.null(latest)) { - # Version check could not complete (no internet or API failure) - return( - shinyWidgets::alert( - tags$b("Version check failed. "), - sprintf( - "Running version %s. Could not reach GitHub to check for updates.", - current - ), - status = "warning", - dismissible = TRUE - ) - ) - } - - if (update_available) { - shinyWidgets::alert( - tags$b("Update available! "), - sprintf( - "You are running version %s. Version %s is available on GitHub.", - current, latest - ), - " ", - tags$a(href = repo_url, target = "_blank", "View release"), - status = "warning", - dismissible = TRUE - ) - } else { - # Up to date -- only shown in verbose mode - shinyWidgets::alert( - tags$b("Up to date. "), - sprintf( - "You are running version %s, which matches the latest release (%s).", - current, latest - ), - status = "success", - dismissible = TRUE - ) - } -} - - -# -- Public API ---------------------------------------------------------------- - -#' Run a startup version check and return a banner UI element -#' -#' Call this \strong{outside} \code{server()} -- typically in -#' \code{global.R} or at the top of \code{app.R} -- and embed the returned -#' value directly in your UI definition. Because the check runs at startup -#' the banner is present on first render with no loading delay, and no -#' \code{uiOutput()} / \code{renderUI()} wiring is needed. -#' -#' \strong{Normal mode} (\code{verbose = FALSE}): returns a banner only when -#' a newer version is available or when the check fails. Returns \code{NULL} -#' when the app is up to date (Shiny silently ignores \code{NULL} in the UI). -#' -#' \strong{Verbose / debug mode} (\code{verbose = TRUE}): always returns a -#' banner -- including a success banner when up to date -- so you can confirm -#' the check ran and inspect both version strings during development. -#' -#' @param github_user GitHub username or organisation that owns the repository. -#' @param github_repo Repository name. Also used as the package name for -#' \code{utils::packageVersion()}. -#' @param app_version Optional fallback version string for environments where -#' the package is not installed (e.g. shinyapps.io). Pass the result of your -#' \code{app_version()} function here. Ignored when \code{packageVersion()} -#' succeeds. -#' @param verbose Logical; if \code{TRUE} a banner is always returned. -#' Defaults to \code{FALSE}. -#' -#' @return A \code{shinyWidgets::alert()} UI element, or \code{NULL} when there -#' is nothing to show (up to date in non-verbose mode). -#' -#' @examples -#' \dontrun{ -#' # global.R or top of app.R -#' source("version_check.R") -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version() # fallback for shinyapps.io -#' ) -#' -#' # ui.R -#' fluidPage( -#' version_banner, -#' # ... rest of UI -#' ) -#' -#' # Verbose mode for development -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version(), -#' verbose = TRUE -#' ) -#' } -check_app_version <- function(github_user, - github_repo, - app_version = NULL, - verbose = FALSE) { - - # -- 1. Resolve current version ---------------------------------------------- - local_version <- .resolve_app_version(github_repo, app_version) - if (is.null(local_version)) { - message(sprintf( - "[version_check] Could not determine version for '%s' (package not installed and no app_version() fallback supplied).", - github_repo - )) - return(NULL) - } - - message(sprintf("[version_check] Current version: %s", local_version)) - - # -- 2. Internet check ------------------------------------------------------- - if (!.has_internet()) { - message("[version_check] No internet connection detected -- skipping.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - # -- 3. Fetch latest GitHub release ------------------------------------------ - latest_version <- .get_latest_github_version(github_user, github_repo) - if (is.null(latest_version)) { - message("[version_check] Could not retrieve latest version from GitHub.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - message(sprintf("[version_check] Latest GitHub release: %s", latest_version)) - - # -- 4. Compare versions ----------------------------------------------------- - update_available <- numeric_version(latest_version) > numeric_version(local_version) - - if (update_available) { - message(sprintf( - "[version_check] Update available: %s -> %s", - local_version, latest_version - )) - } else { - message(sprintf("[version_check] App is up to date (%s).", local_version)) - } - - # -- 5. Return banner -------------------------------------------------------- - # An update was found -> always return a warning banner - # Up to date + verbose -> return a success banner - # Up to date + not verbose -> return NULL (Shiny ignores NULL in the UI) - if (update_available || verbose) { - .build_version_alert( - current = local_version, - latest = latest_version, - update_available = update_available, - github_user = github_user, - github_repo = github_repo - ) - } else { - NULL - } -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//visual_summary.R ######## @@ -14055,7 +13714,6 @@ INCLUDE_GLOBALENV <- get_config("INCLUDE_GLOBALENV", default = FALSE) DATA_LIMIT_DEFAULT <- get_config("DATA_LIMIT_DEFAULT", default = 10000) DATA_LIMIT_UPPER <- get_config("DATA_LIMIT_UPPER", default = 100000) DATA_LIMIT_LOWER <- get_config("DATA_LIMIT_LOWER", default = 1) -CHECK_APP_VERSION <- get_config("CHECK_APP_VERSION", default = FALSE) ## Loads folder passed to the docker container and mounted as below: ## @@ -14068,10 +13726,6 @@ CHECK_APP_VERSION <- get_config("CHECK_APP_VERSION", default = FALSE) ## All files in the ./data/ folder is attempted loaded load_folder() -## App version check - -version_banner <- check_app_version("agdamsbo", "FreesearchR",app_version = app_version(),verbose=CHECK_APP_VERSION) - ######## #### Current file: /Users/au301842/FreesearchR/app/ui.R diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 68fad36f..2ee84131 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprPVhaz/file70565b30c8af.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpmhqokQ/file1a147dcf977e.R ######## i18n_path <- system.file("translations", package = "FreesearchR") @@ -64,7 +64,7 @@ i18n$set_translation_language("en") #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'26.3.4' +app_version <- function()'26.3.3' ######## @@ -4514,7 +4514,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.4-260323' +hosted_version <- function()'v26.3.3-260312' ######## @@ -5964,8 +5964,6 @@ landing_page_ui <- function(i18n) { #' @param data_limit_default default data set observations limit #' @param data_limit_upper data set observations upper limit #' @param data_limit_lower data set observations lower limit -#' @param check_app_version always attempt to check app version against latest -#' release on GitHub. Default is FALSE #' @param ... passed on to `shiny::runApp()` #' #' @returns shiny app @@ -5980,14 +5978,12 @@ launch_FreesearchR <- function(include_globalenv = TRUE, data_limit_default = 1000, data_limit_upper = 100000, data_limit_lower = 1, - check_app_version = FALSE, ...) { Sys.setenv( INCLUDE_GLOBALENV = include_globalenv, DATA_LIMIT_DEFAULT = data_limit_default, DATA_LIMIT_UPPER = data_limit_upper, - DATA_LIMIT_LOWER = data_limit_lower, - CHECK_APP_VERSION = check_app_version + DATA_LIMIT_LOWER = data_limit_lower ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") @@ -7058,17 +7054,15 @@ sankey_ready <- function(data, pri, sec, numbers = "count", ...) { dplyr::ungroup() if (numbers == "count") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(n=", gx.sum, ")" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(n=", gy.sum, ")" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(n=", gx.sum, ")")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(n=", gy.sum, ")")) + ) } else if (numbers == "percentage") { - out <- out |> dplyr::mutate(lx = factor(paste0( - !!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)" - )), ly = factor(paste0( - !!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)" - ))) + out <- out |> dplyr::mutate( + lx = factor(paste0(!!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")), + ly = factor(paste0(!!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)")) + ) } if (is.factor(data[[pri]])) { @@ -7110,38 +7104,20 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -#' -#' # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") -plot_sankey <- function(data, - pri, - sec, - ter = NULL, - color.group = "pri", - colors = NULL, - missing.level = "Missing") { +plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { if (!is.null(ter)) { ds <- split(data, data[ter]) } else { ds <- list(data) } - - out <- lapply(ds, \(.ds) { - plot_sankey_single( - .ds, - pri = pri, - sec = sec, - color.group = color.group, - colors = colors, - missing.level = missing.level - ) + out <- lapply(ds, \(.ds){ + plot_sankey_single(.ds, pri = pri, sec = sec, color.group = color.group, colors = colors,missing.level=missing.level) }) patchwork::wrap_plots(out) } - - #' Beautiful sankey plot #' #' @param color.group set group to colour by. "x" or "y". @@ -7168,31 +7144,19 @@ plot_sankey <- function(data, #' stRoke::trial |> #' default_parsing() |> #' plot_sankey_single("diabetes", "hypertension") -plot_sankey_single <- function(data, - pri, - sec, - color.group = c("pri", "sec"), - colors = NULL, - missing.level = "Missing", - ...) { +plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL,missing.level="Missing", ...) { color.group <- match.arg(color.group) - - # browser() - # if (is.na(ds[c(pri,sec)])) - # browser() data_orig <- data - data[c(pri, sec)] <- data[c(pri, sec)] |> dplyr::mutate( - dplyr::across(dplyr::where(is.logical), as.factor), - dplyr::across(dplyr::where(is.factor), forcats::fct_drop), - dplyr::across(dplyr::where(is.factor), \(.x) { - forcats::fct_na_value_to_level(.x, missing.level) - }) + # dplyr::across(dplyr::where(is.logical), as.factor), + dplyr::across(dplyr::where(is.factor), forcats::fct_drop)#, + # dplyr::across(dplyr::where(is.factor), \(.x){forcats::fct_na_value_to_level(.x,missing.level)}) ) + data <- data |> sankey_ready(pri = pri, sec = sec, ...) na.color <- "#2986cc" @@ -7205,26 +7169,21 @@ plot_sankey_single <- function(data, main.colors <- main.colors[match(levels(data[[sec]]), levels(data_orig[[sec]]))] secondary.colors <- rep(na.color, length(levels(data[[pri]]))) - label.colors <- Reduce(c, lapply(list( - secondary.colors, rev(main.colors) - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(secondary.colors, rev(main.colors)), contrast_text)) } else { main.colors <- viridisLite::viridis(n = length(levels(data_orig[[pri]]))) ## Only keep colors for included levels main.colors <- main.colors[match(levels(data[[pri]]), levels(data_orig[[pri]]))] secondary.colors <- rep(na.color, length(levels(data[[sec]]))) - label.colors <- Reduce(c, lapply(list( - rev(main.colors), secondary.colors - ), contrast_text)) + label.colors <- Reduce(c, lapply(list(rev(main.colors), secondary.colors), contrast_text)) } colors <- c(na.color, main.colors, secondary.colors) - colors[is.na(colors)] <- "grey80" } else { label.colors <- contrast_text(colors) } - group_labels <- c(get_label(data_orig, pri), get_label(data_orig, sec)) |> + group_labels <- c(get_label(data, pri), get_label(data, sec)) |> sapply(line_break) |> unname() @@ -7243,8 +7202,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } else { p <- p + ggalluvial::geom_alluvium( @@ -7257,8 +7217,9 @@ plot_sankey_single <- function(data, knot.pos = 0.4, curve_type = "sigmoid" ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)), - size = 2, - width = 1 / 3.4) + size = 2, + width = 1 / 3.4 + ) } ## Will fail to use stat="stratum" if library is not loaded. @@ -7268,10 +7229,13 @@ plot_sankey_single <- function(data, stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 6, + size = 8, lineheight = 1 ) + - ggplot2::scale_x_continuous(breaks = 1:2, labels = group_labels) + + ggplot2::scale_x_continuous( + breaks = 1:2, + labels = group_labels + ) + ggplot2::scale_fill_manual(values = colors[-1], na.value = colors[1]) + # ggplot2::scale_color_manual(values = main.colors) + ggplot2::theme_void() + @@ -10808,7 +10772,6 @@ ui_elements <- function(selection) { ## Default just output "NULL" ## This could probably be achieved more legantly, but this works. dev_banner(), - version_banner, landing_page_ui(i18n = i18n), # shiny::column(width = 2), # shiny::column( @@ -12869,6 +12832,33 @@ validation_server <- function(id, data_r <- if (shiny::is.reactive(data)) data else shiny::reactive(data) + # observeEvent(data_r(), { + # to_validate <- data() + # valid_dims <- check_data(to_validate, n_row = n_row, n_col = n_col) + # + # if (all(c(valid_dims$nrows, valid_dims$ncols))) { + # valid_status <- "OK" + # } else { + # valid_status <- "Failed" + # } + # + # valid_results <- lapply( + # X = c("nrows", "ncols"), + # FUN = function(x) { + # if (is.null(valid_dims[[x]])) + # return(NULL) + # label <- switch( + # x, + # "nrows" = n_row_label, + # "ncols" = n_col_label + # ) + # list( + # status = ifelse(valid_dims[[x]], "OK", "Failed"), + # label = paste0("", label, "") + # ) + # } + # ) + shiny::observeEvent( data_r(), { @@ -13252,337 +13242,6 @@ make_validation_alerts <- function(data) { } -######## -#### Current file: /Users/au301842/FreesearchR/R//version_check.R -######## - -# version_check.R -# -# Runs a one-time version check at app startup and returns a ready-made -# shinyWidgets::alert() UI element that can be placed directly in the UI -# definition -- no server(), no renderUI(), no uiOutput() required. -# -# Because the check runs outside server(), it executes once when the app -# process starts, so the banner is present immediately on first render with -# no loading delay. -# -# Version detection uses two strategies, tried in order: -# 1. utils::packageVersion() -- works when the package is installed locally. -# 2. app_version argument -- explicit fallback for environments where the -# package is not installed (e.g. shinyapps.io). Pass the result of your -# app_version() function here. -# -# Quick start: -# -# # global.R (or top of app.R, before ui / server) -# source("version_check.R") -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version() # fallback for shinyapps.io -# ) -# -# # ui.R -- drop the result anywhere in the UI tree -# fluidPage( -# version_banner, -# ... -# ) -# -# # Verbose / debug mode -- always show the banner: -# version_banner <- check_app_version( -# github_user = "your-github-username", -# github_repo = "your-repo-name", -# app_version = app_version(), -# verbose = TRUE -# ) - - -# -- Internal helpers ---------------------------------------------------------- - -#' Check internet connectivity -#' -#' @return Logical; TRUE if an internet connection is available. -.has_internet <- function() { - tryCatch({ - con <- url("https://api.github.com", open = "r") - close(con) - TRUE - }, error = function(e) FALSE) -} - - -#' Fetch the latest release version from a GitHub repository -#' -#' @param github_user GitHub username or organisation. -#' @param github_repo Repository name. -#' -#' @return A character string with the version tag (e.g. "1.2.0"), or NULL on -#' failure. -.get_latest_github_version <- function(github_user, github_repo) { - api_url <- sprintf( - "https://api.github.com/repos/%s/%s/releases/latest", - github_user, - github_repo - ) - - tryCatch({ - response <- readLines(url(api_url), warn = FALSE) - json_text <- paste(response, collapse = "") - - tag <- regmatches( - json_text, - regexpr('"tag_name"\\s*:\\s*"([^"]+)"', json_text) - ) - - if (length(tag) == 0 || nchar(tag) == 0) return(NULL) - - # Strip a leading "v" if present (e.g. "v1.2.0" -> "1.2.0") - sub('^"tag_name"\\s*:\\s*"v?([^"]+)"$', "\\1", tag) - }, error = function(e) NULL) -} - - -#' Resolve the current app version -#' -#' Tries two strategies in order: -#' \enumerate{ -#' \item \code{utils::packageVersion(package_name)} -- works when the package -#' is installed locally (development, local \code{runApp()}). -#' \item \code{app_version} argument -- an explicit version string supplied by -#' the caller, e.g. from an \code{app_version()} function bundled with the -#' app. Used on shinyapps.io where the package is not installed. -#' } -#' -#' @param package_name Name of the package / repository. -#' @param app_version Optional fallback version string. -#' -#' @return A character string with the version (e.g. "1.1.0"), or NULL if -#' neither strategy succeeds. -.resolve_app_version <- function(package_name, app_version = NULL) { - - # Strategy 1: installed package - v <- tryCatch( - as.character(utils::packageVersion(package_name)), - error = function(e) NULL - ) - if (!is.null(v)) { - message("[version_check] Version source: installed package") - return(v) - } - - # Strategy 2: explicit fallback supplied by the caller - if (!is.null(app_version)) { - message("[version_check] Version source: app_version() fallback") - return(as.character(app_version)) - } - - NULL -} - - -#' Build a shinyWidgets::alert() UI element for the version banner -#' -#' @param current Current installed version string. -#' @param latest Latest GitHub release version string, or NULL when -#' the check could not complete (e.g. no internet). -#' @param update_available Logical; whether latest > current. -#' @param github_user GitHub username / organisation. -#' @param github_repo Repository name. -#' -#' @return A \code{shinyWidgets::alert()} UI element. -.build_version_alert <- function(current, - latest, - update_available, - github_user, - github_repo) { - - repo_url <- sprintf( - "https://github.com/%s/%s/releases/latest", - github_user, - github_repo - ) - - if (is.null(latest)) { - # Version check could not complete (no internet or API failure) - return( - shinyWidgets::alert( - tags$b("Version check failed. "), - sprintf( - "Running version %s. Could not reach GitHub to check for updates.", - current - ), - status = "warning", - dismissible = TRUE - ) - ) - } - - if (update_available) { - shinyWidgets::alert( - tags$b("Update available! "), - sprintf( - "You are running version %s. Version %s is available on GitHub.", - current, latest - ), - " ", - tags$a(href = repo_url, target = "_blank", "View release"), - status = "warning", - dismissible = TRUE - ) - } else { - # Up to date -- only shown in verbose mode - shinyWidgets::alert( - tags$b("Up to date. "), - sprintf( - "You are running version %s, which matches the latest release (%s).", - current, latest - ), - status = "success", - dismissible = TRUE - ) - } -} - - -# -- Public API ---------------------------------------------------------------- - -#' Run a startup version check and return a banner UI element -#' -#' Call this \strong{outside} \code{server()} -- typically in -#' \code{global.R} or at the top of \code{app.R} -- and embed the returned -#' value directly in your UI definition. Because the check runs at startup -#' the banner is present on first render with no loading delay, and no -#' \code{uiOutput()} / \code{renderUI()} wiring is needed. -#' -#' \strong{Normal mode} (\code{verbose = FALSE}): returns a banner only when -#' a newer version is available or when the check fails. Returns \code{NULL} -#' when the app is up to date (Shiny silently ignores \code{NULL} in the UI). -#' -#' \strong{Verbose / debug mode} (\code{verbose = TRUE}): always returns a -#' banner -- including a success banner when up to date -- so you can confirm -#' the check ran and inspect both version strings during development. -#' -#' @param github_user GitHub username or organisation that owns the repository. -#' @param github_repo Repository name. Also used as the package name for -#' \code{utils::packageVersion()}. -#' @param app_version Optional fallback version string for environments where -#' the package is not installed (e.g. shinyapps.io). Pass the result of your -#' \code{app_version()} function here. Ignored when \code{packageVersion()} -#' succeeds. -#' @param verbose Logical; if \code{TRUE} a banner is always returned. -#' Defaults to \code{FALSE}. -#' -#' @return A \code{shinyWidgets::alert()} UI element, or \code{NULL} when there -#' is nothing to show (up to date in non-verbose mode). -#' -#' @examples -#' \dontrun{ -#' # global.R or top of app.R -#' source("version_check.R") -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version() # fallback for shinyapps.io -#' ) -#' -#' # ui.R -#' fluidPage( -#' version_banner, -#' # ... rest of UI -#' ) -#' -#' # Verbose mode for development -#' version_banner <- check_app_version( -#' github_user = "my-org", -#' github_repo = "my-shiny-app", -#' app_version = app_version(), -#' verbose = TRUE -#' ) -#' } -check_app_version <- function(github_user, - github_repo, - app_version = NULL, - verbose = FALSE) { - - # -- 1. Resolve current version ---------------------------------------------- - local_version <- .resolve_app_version(github_repo, app_version) - if (is.null(local_version)) { - message(sprintf( - "[version_check] Could not determine version for '%s' (package not installed and no app_version() fallback supplied).", - github_repo - )) - return(NULL) - } - - message(sprintf("[version_check] Current version: %s", local_version)) - - # -- 2. Internet check ------------------------------------------------------- - if (!.has_internet()) { - message("[version_check] No internet connection detected -- skipping.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - # -- 3. Fetch latest GitHub release ------------------------------------------ - latest_version <- .get_latest_github_version(github_user, github_repo) - if (is.null(latest_version)) { - message("[version_check] Could not retrieve latest version from GitHub.") - - if (verbose) { - return(.build_version_alert( - current = local_version, - latest = NULL, - update_available = FALSE, - github_user = github_user, - github_repo = github_repo - )) - } - - return(NULL) - } - - message(sprintf("[version_check] Latest GitHub release: %s", latest_version)) - - # -- 4. Compare versions ----------------------------------------------------- - update_available <- numeric_version(latest_version) > numeric_version(local_version) - - if (update_available) { - message(sprintf( - "[version_check] Update available: %s -> %s", - local_version, latest_version - )) - } else { - message(sprintf("[version_check] App is up to date (%s).", local_version)) - } - - # -- 5. Return banner -------------------------------------------------------- - # An update was found -> always return a warning banner - # Up to date + verbose -> return a success banner - # Up to date + not verbose -> return NULL (Shiny ignores NULL in the UI) - if (update_available || verbose) { - .build_version_alert( - current = local_version, - latest = latest_version, - update_available = update_available, - github_user = github_user, - github_repo = github_repo - ) - } else { - NULL - } -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//visual_summary.R ######## @@ -14055,7 +13714,6 @@ INCLUDE_GLOBALENV <- get_config("INCLUDE_GLOBALENV", default = FALSE) DATA_LIMIT_DEFAULT <- get_config("DATA_LIMIT_DEFAULT", default = 10000) DATA_LIMIT_UPPER <- get_config("DATA_LIMIT_UPPER", default = 100000) DATA_LIMIT_LOWER <- get_config("DATA_LIMIT_LOWER", default = 1) -CHECK_APP_VERSION <- get_config("CHECK_APP_VERSION", default = FALSE) ## Loads folder passed to the docker container and mounted as below: ## @@ -14068,10 +13726,6 @@ CHECK_APP_VERSION <- get_config("CHECK_APP_VERSION", default = FALSE) ## All files in the ./data/ folder is attempted loaded load_folder() -## App version check - -version_banner <- check_app_version("agdamsbo", "FreesearchR",app_version = app_version(),verbose=CHECK_APP_VERSION) - ######## #### Current file: /Users/au301842/FreesearchR/app/ui.R diff --git a/man/check_app_version.Rd b/man/check_app_version.Rd deleted file mode 100644 index 749901e7..00000000 --- a/man/check_app_version.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/version_check.R -\name{check_app_version} -\alias{check_app_version} -\title{Run a startup version check and return a banner UI element} -\usage{ -check_app_version( - github_user, - github_repo, - app_version = NULL, - verbose = FALSE -) -} -\arguments{ -\item{github_user}{GitHub username or organisation that owns the repository.} - -\item{github_repo}{Repository name. Also used as the package name for -\code{utils::packageVersion()}.} - -\item{app_version}{Optional fallback version string for environments where -the package is not installed (e.g. shinyapps.io). Pass the result of your -\code{app_version()} function here. Ignored when \code{packageVersion()} -succeeds.} - -\item{verbose}{Logical; if \code{TRUE} a banner is always returned. -Defaults to \code{FALSE}.} -} -\value{ -A \code{shinyWidgets::alert()} UI element, or \code{NULL} when there -is nothing to show (up to date in non-verbose mode). -} -\description{ -Call this \strong{outside} \code{server()} -- typically in -\code{global.R} or at the top of \code{app.R} -- and embed the returned -value directly in your UI definition. Because the check runs at startup -the banner is present on first render with no loading delay, and no -\code{uiOutput()} / \code{renderUI()} wiring is needed. -} -\details{ -\strong{Normal mode} (\code{verbose = FALSE}): returns a banner only when -a newer version is available or when the check fails. Returns \code{NULL} -when the app is up to date (Shiny silently ignores \code{NULL} in the UI). - -\strong{Verbose / debug mode} (\code{verbose = TRUE}): always returns a -banner -- including a success banner when up to date -- so you can confirm -the check ran and inspect both version strings during development. -} -\examples{ -\dontrun{ -# global.R or top of app.R -source("version_check.R") -version_banner <- check_app_version( - github_user = "my-org", - github_repo = "my-shiny-app", - app_version = app_version() # fallback for shinyapps.io -) - -# ui.R -fluidPage( - version_banner, - # ... rest of UI -) - -# Verbose mode for development -version_banner <- check_app_version( - github_user = "my-org", - github_repo = "my-shiny-app", - app_version = app_version(), - verbose = TRUE -) -} -} diff --git a/man/data-plots.Rd b/man/data-plots.Rd index cd9efdfd..e5f94f58 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -170,8 +170,6 @@ mtcars |> mtcars |> default_parsing() |> plot_sankey("cyl", "gear", "vs", color.group = "pri") - - # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") mtcars |> plot_scatter(pri = "mpg", sec = "wt") mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear") } diff --git a/man/dot-build_version_alert.Rd b/man/dot-build_version_alert.Rd deleted file mode 100644 index d9998740..00000000 --- a/man/dot-build_version_alert.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/version_check.R -\name{.build_version_alert} -\alias{.build_version_alert} -\title{Build a shinyWidgets::alert() UI element for the version banner} -\usage{ -.build_version_alert( - current, - latest, - update_available, - github_user, - github_repo -) -} -\arguments{ -\item{current}{Current installed version string.} - -\item{latest}{Latest GitHub release version string, or NULL when -the check could not complete (e.g. no internet).} - -\item{update_available}{Logical; whether latest > current.} - -\item{github_user}{GitHub username / organisation.} - -\item{github_repo}{Repository name.} -} -\value{ -A \code{shinyWidgets::alert()} UI element. -} -\description{ -Build a shinyWidgets::alert() UI element for the version banner -} diff --git a/man/dot-get_latest_github_version.Rd b/man/dot-get_latest_github_version.Rd deleted file mode 100644 index 30b16a66..00000000 --- a/man/dot-get_latest_github_version.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/version_check.R -\name{.get_latest_github_version} -\alias{.get_latest_github_version} -\title{Fetch the latest release version from a GitHub repository} -\usage{ -.get_latest_github_version(github_user, github_repo) -} -\arguments{ -\item{github_user}{GitHub username or organisation.} - -\item{github_repo}{Repository name.} -} -\value{ -A character string with the version tag (e.g. "1.2.0"), or NULL on -failure. -} -\description{ -Fetch the latest release version from a GitHub repository -} diff --git a/man/dot-has_internet.Rd b/man/dot-has_internet.Rd deleted file mode 100644 index 0b23d4fd..00000000 --- a/man/dot-has_internet.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/version_check.R -\name{.has_internet} -\alias{.has_internet} -\title{Check internet connectivity} -\usage{ -.has_internet() -} -\value{ -Logical; TRUE if an internet connection is available. -} -\description{ -Check internet connectivity -} diff --git a/man/dot-resolve_app_version.Rd b/man/dot-resolve_app_version.Rd deleted file mode 100644 index f16837a6..00000000 --- a/man/dot-resolve_app_version.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/version_check.R -\name{.resolve_app_version} -\alias{.resolve_app_version} -\title{Resolve the current app version} -\usage{ -.resolve_app_version(package_name, app_version = NULL) -} -\arguments{ -\item{package_name}{Name of the package / repository.} - -\item{app_version}{Optional fallback version string.} -} -\value{ -A character string with the version (e.g. "1.1.0"), or NULL if -neither strategy succeeds. -} -\description{ -Tries two strategies in order: -\enumerate{ -\item \code{utils::packageVersion(package_name)} -- works when the package -is installed locally (development, local \code{runApp()}). -\item \code{app_version} argument -- an explicit version string supplied by -the caller, e.g. from an \code{app_version()} function bundled with the -app. Used on shinyapps.io where the package is not installed. -} -} diff --git a/man/launch_FreesearchR.Rd b/man/launch_FreesearchR.Rd index 5410af8a..2ab6c607 100644 --- a/man/launch_FreesearchR.Rd +++ b/man/launch_FreesearchR.Rd @@ -9,7 +9,6 @@ launch_FreesearchR( data_limit_default = 1000, data_limit_upper = 1e+05, data_limit_lower = 1, - check_app_version = FALSE, ... ) } @@ -23,9 +22,6 @@ when loading data} \item{data_limit_lower}{data set observations lower limit} -\item{check_app_version}{always attempt to check app version against latest -release on GitHub. Default is FALSE} - \item{...}{passed on to \code{shiny::runApp()}} } \value{