diff --git a/DESCRIPTION b/DESCRIPTION index 3e2cc6ab..5a9d85b9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -141,5 +141,6 @@ 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 f08ae0b2..3cfed098 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # 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 f0c656d1..17135440 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v26.3.4-260312' +hosted_version <- function()'v26.3.4-260323' diff --git a/R/launch_FreesearchR.R b/R/launch_FreesearchR.R index a789f185..92d09a51 100644 --- a/R/launch_FreesearchR.R +++ b/R/launch_FreesearchR.R @@ -8,6 +8,8 @@ #' @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 @@ -22,12 +24,14 @@ 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 + DATA_LIMIT_LOWER = data_limit_lower, + CHECK_APP_VERSION = check_app_version ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") diff --git a/R/plot_sankey.R b/R/plot_sankey.R index b3aa1b55..4fd879b8 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -33,15 +33,17 @@ 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]])) { @@ -83,20 +85,39 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { +#' +#' # 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") { 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". @@ -123,41 +144,66 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' 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)] <- 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)}) - ) + + 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 <- data |> sankey_ready(pri = pri, sec = sec, ...) + ## Aggregate data + data_aggr <- 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_orig[[sec]]))] + main.colors <- main.colors[match(levels(data[[sec]]), levels(data[[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]]))) + 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]]))) ## Only keep colors for included levels - main.colors <- main.colors[match(levels(data[[pri]]), levels(data_orig[[pri]]))] + main.colors <- main.colors[match(levels(data[[pri]]), levels(data[[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) } @@ -166,7 +212,9 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co sapply(line_break) |> unname() - p <- ggplot2::ggplot(data, ggplot2::aes(y = n, axis1 = lx, axis2 = ly)) + # browser() + + p <- ggplot2::ggplot(data_aggr, ggplot2::aes(y = n, axis1 = lx, axis2 = ly)) if (color.group == "sec") { p <- p + @@ -181,9 +229,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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( @@ -196,9 +243,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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. @@ -208,13 +254,10 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 8, + size = 6, 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 f8b0df59..efea72cf 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 cac844a0..96175376 100644 --- a/R/ui_elements.R +++ b/R/ui_elements.R @@ -25,6 +25,7 @@ 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 2ea65d76..8d6847b4 100644 --- a/R/validation.R +++ b/R/validation.R @@ -65,33 +65,6 @@ 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 new file mode 100644 index 00000000..4f6932e4 --- /dev/null +++ b/R/version_check.R @@ -0,0 +1,325 @@ +# 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 344b8649..b6444c6d 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,9 @@ -# 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. @@ -19,11 +18,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 -1. help learners get a good start analysing data and coding in *R* +2. help learners get a good start analysing data and coding in *R* -1. ease quick data overview and basic visualisations for any clinical researcher +3. 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: @@ -35,32 +34,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` | +| 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` | ### 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) - ``` + ``` 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) + ``` 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. @@ -70,7 +69,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 @@ -86,9 +85,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 1bd978b0..44778018 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-12 | +|date |2026-03-23 | |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.260312 | +|FreesearchR |26.3.4.260323 | -------------------------------------------------------------------------------- @@ -33,6 +33,7 @@ |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) | @@ -43,6 +44,7 @@ |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) | @@ -52,6 +54,7 @@ |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) | @@ -66,7 +69,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.2 |2026-03-05 |CRAN (R 4.5.2) | +|emmeans |2.0.1 |2025-12-16 |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) | @@ -74,6 +77,7 @@ |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) | @@ -109,9 +113,11 @@ |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) | @@ -123,7 +129,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-5 |2026-03-11 |CRAN (R 4.5.2) | +|mvtnorm |1.3-2 |2024-11-04 |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) | @@ -156,6 +162,7 @@ |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) | @@ -197,6 +204,7 @@ |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) | @@ -208,7 +216,9 @@ |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 1355da88..7d30c295 100644 --- a/app_docker/app.R +++ b/app_docker/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpZZ6Yua/file58174f49b1bf.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprPVhaz/file70562aff8e9e.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-260312' +hosted_version <- function()'v26.3.4-260323' ######## @@ -5964,6 +5964,8 @@ 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 @@ -5978,12 +5980,14 @@ 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 + DATA_LIMIT_LOWER = data_limit_lower, + CHECK_APP_VERSION = check_app_version ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") @@ -7054,15 +7058,17 @@ 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]])) { @@ -7104,20 +7110,38 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { +#' +#' # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") +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". @@ -7144,19 +7168,31 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' 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" @@ -7169,21 +7205,26 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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, pri), get_label(data, sec)) |> + group_labels <- c(get_label(data_orig, pri), get_label(data_orig, sec)) |> sapply(line_break) |> unname() @@ -7202,9 +7243,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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( @@ -7217,9 +7257,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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. @@ -7229,13 +7268,10 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 8, + size = 6, 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() + @@ -10772,6 +10808,7 @@ 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( @@ -12832,33 +12869,6 @@ 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(), { @@ -13242,6 +13252,337 @@ 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 ######## @@ -13714,6 +14055,7 @@ 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: ## @@ -13726,6 +14068,10 @@ DATA_LIMIT_LOWER <- get_config("DATA_LIMIT_LOWER", default = 1) ## 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 2ee84131..68fad36f 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//RtmpmhqokQ/file1a147dcf977e.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprPVhaz/file70565b30c8af.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.3' +app_version <- function()'26.3.4' ######## @@ -4514,7 +4514,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.3-260312' +hosted_version <- function()'v26.3.4-260323' ######## @@ -5964,6 +5964,8 @@ 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 @@ -5978,12 +5980,14 @@ 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 + DATA_LIMIT_LOWER = data_limit_lower, + CHECK_APP_VERSION = check_app_version ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") @@ -7054,15 +7058,17 @@ 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]])) { @@ -7104,20 +7110,38 @@ str_remove_last <- function(data, pattern = "\n") { #' mtcars |> #' default_parsing() |> #' plot_sankey("cyl", "gear", "vs", color.group = "pri") -plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors = NULL,missing.level="Missing") { +#' +#' # stRoke::trial |> plot_sankey("mrs_1", "mrs_6") +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". @@ -7144,19 +7168,31 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' 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" @@ -7169,21 +7205,26 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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, pri), get_label(data, sec)) |> + group_labels <- c(get_label(data_orig, pri), get_label(data_orig, sec)) |> sapply(line_break) |> unname() @@ -7202,9 +7243,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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( @@ -7217,9 +7257,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co 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. @@ -7229,13 +7268,10 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co stat = "stratum", ggplot2::aes(label = after_stat(stratum)), colour = label.colors, - size = 8, + size = 6, 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() + @@ -10772,6 +10808,7 @@ 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( @@ -12832,33 +12869,6 @@ 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(), { @@ -13242,6 +13252,337 @@ 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 ######## @@ -13714,6 +14055,7 @@ 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: ## @@ -13726,6 +14068,10 @@ DATA_LIMIT_LOWER <- get_config("DATA_LIMIT_LOWER", default = 1) ## 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 new file mode 100644 index 00000000..749901e7 --- /dev/null +++ b/man/check_app_version.Rd @@ -0,0 +1,72 @@ +% 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 e5f94f58..cd9efdfd 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -170,6 +170,8 @@ 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 new file mode 100644 index 00000000..d9998740 --- /dev/null +++ b/man/dot-build_version_alert.Rd @@ -0,0 +1,32 @@ +% 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 new file mode 100644 index 00000000..30b16a66 --- /dev/null +++ b/man/dot-get_latest_github_version.Rd @@ -0,0 +1,20 @@ +% 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 new file mode 100644 index 00000000..0b23d4fd --- /dev/null +++ b/man/dot-has_internet.Rd @@ -0,0 +1,14 @@ +% 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 new file mode 100644 index 00000000..f16837a6 --- /dev/null +++ b/man/dot-resolve_app_version.Rd @@ -0,0 +1,27 @@ +% 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 2ab6c607..5410af8a 100644 --- a/man/launch_FreesearchR.Rd +++ b/man/launch_FreesearchR.Rd @@ -9,6 +9,7 @@ launch_FreesearchR( data_limit_default = 1000, data_limit_upper = 1e+05, data_limit_lower = 1, + check_app_version = FALSE, ... ) } @@ -22,6 +23,9 @@ 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{