mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
Compare commits
4 commits
507982c51b
...
2d062e0ac5
| Author | SHA1 | Date | |
|---|---|---|---|
|
2d062e0ac5 |
|||
|
b0ecce8c54 |
|||
|
cfbee14dcb |
|||
|
c23570ca54 |
20 changed files with 1440 additions and 219 deletions
|
|
@ -141,5 +141,6 @@ Collate:
|
|||
'update-variables-ext.R'
|
||||
'utils-labels.R'
|
||||
'validation.R'
|
||||
'version_check.R'
|
||||
'visual_summary.R'
|
||||
'wide2long.R'
|
||||
|
|
|
|||
2
NEWS.md
2
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
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v26.3.4-260312'
|
||||
hosted_version <- function()'v26.3.4-260323'
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
107
R/plot_sankey.R
107
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)] |>
|
||||
|
||||
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){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) {
|
||||
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 {
|
||||
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 +
|
||||
|
|
@ -182,8 +230,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
width = 1 / 3.4)
|
||||
} else {
|
||||
p <- p +
|
||||
ggalluvial::geom_alluvium(
|
||||
|
|
@ -197,8 +244,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
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() +
|
||||
|
|
|
|||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
|
|
@ -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(
|
||||
|
|
|
|||
|
|
@ -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("<b>", label, "</b>")
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
|
||||
shiny::observeEvent(
|
||||
data_r(),
|
||||
{
|
||||
|
|
|
|||
325
R/version_check.R
Normal file
325
R/version_check.R
Normal file
|
|
@ -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
|
||||
}
|
||||
}
|
||||
23
README.md
23
README.md
|
|
@ -1,10 +1,9 @@
|
|||
# FreesearchR <a href="https://agdamsbo.github.io/FreesearchR/"><img src="man/figures/logo.png" align="right" height="70" alt="FreesearchR website" /></a>
|
||||
# FreesearchR <a href="https://agdamsbo.github.io/FreesearchR/"><img src="man/figures/logo.png" alt="FreesearchR website" align="right" height="70"/></a>
|
||||
|
||||
<!-- badges: start -->
|
||||
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
|
||||
[](https://doi.org/10.5281/zenodo.14527429)
|
||||
[](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml)
|
||||
[](https://agdamsbo.shinyapps.io/FreesearchR/)
|
||||
|
||||
[](https://lifecycle.r-lib.org/articles/stages.html#experimental) [](https://doi.org/10.5281/zenodo.14527429) [](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) [](https://agdamsbo.shinyapps.io/FreesearchR/)
|
||||
|
||||
<!-- badges: end -->
|
||||
|
||||
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.
|
||||
|
|
@ -21,9 +20,9 @@ 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 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,15 +34,15 @@ 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` |
|
||||
|
||||
### Run from R (or RStudio)
|
||||
|
||||
|
|
@ -53,13 +52,13 @@ If you're working with data in R, **FreesearchR** is a quick and easy tool for e
|
|||
|
||||
2. Open the **R console** and run the following code to install the `{FreesearchR}` package and launch the app:
|
||||
|
||||
```r
|
||||
``` 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)
|
||||
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
|
||||
|
|
|
|||
18
SESSION.md
18
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) |
|
||||
|
|
|
|||
462
app_docker/app.R
462
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()
|
||||
|
||||
|
|
@ -7203,8 +7244,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
width = 1 / 3.4)
|
||||
} else {
|
||||
p <- p +
|
||||
ggalluvial::geom_alluvium(
|
||||
|
|
@ -7218,8 +7258,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
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("<b>", label, "</b>")
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
|
||||
|
|
@ -7203,8 +7244,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
width = 1 / 3.4)
|
||||
} else {
|
||||
p <- p +
|
||||
ggalluvial::geom_alluvium(
|
||||
|
|
@ -7218,8 +7258,7 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
curve_type = "sigmoid"
|
||||
) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)),
|
||||
size = 2,
|
||||
width = 1 / 3.4
|
||||
)
|
||||
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("<b>", label, "</b>")
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
|
||||
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
|
||||
|
|
|
|||
72
man/check_app_version.Rd
Normal file
72
man/check_app_version.Rd
Normal file
|
|
@ -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
|
||||
)
|
||||
}
|
||||
}
|
||||
|
|
@ -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")
|
||||
}
|
||||
|
|
|
|||
32
man/dot-build_version_alert.Rd
Normal file
32
man/dot-build_version_alert.Rd
Normal file
|
|
@ -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
|
||||
}
|
||||
20
man/dot-get_latest_github_version.Rd
Normal file
20
man/dot-get_latest_github_version.Rd
Normal file
|
|
@ -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
|
||||
}
|
||||
14
man/dot-has_internet.Rd
Normal file
14
man/dot-has_internet.Rd
Normal file
|
|
@ -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
|
||||
}
|
||||
27
man/dot-resolve_app_version.Rd
Normal file
27
man/dot-resolve_app_version.Rd
Normal file
|
|
@ -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.
|
||||
}
|
||||
}
|
||||
|
|
@ -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{
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue