From 469c7b01ad35c8fba45a2cd4ecf6d015d81e2231 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 6 Mar 2025 08:08:04 +0100 Subject: [PATCH] ready for new release --- DESCRIPTION | 2 +- NEWS.md | 18 +++++++++++++++--- R/app_version.R | 2 +- inst/apps/freesearcheR/app.R | 29 ++++++++++++++++++++++------- 4 files changed, 39 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 469406f..f6a6825 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: freesearcheR Title: Browser Based Data Analysis -Version: 25.2.1 +Version: 25.3.1 Authors@R: person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")) diff --git a/NEWS.md b/NEWS.md index 38c8584..0f4e523 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# freesearcheR 25.2.1 +# freesearcheR 25.3.1 First steps towards a more focused and simplified interface. @@ -8,13 +8,25 @@ Inspired by the Stroke Center implementation guidelines of the WSO, we will appl Teal dependencies removed. The teal framework really seems very powerful and promising, but it will also mean less control and more clutter. May come up again later. -All main components have been implemented. +All main components have been implemented: + +- Data import from different sources + +- Data management (variable creation, re-classing, naming, labelling and more) + +- Basic data comparisons and descriptive analyses + +- Basic data visualisations with a select set of plot types great for publication purposes + +- Regression analysis of basic clinical cross-sectional data (mixed models of repeated measures and survival analyses is on the table) + +- Export of outputs (descriptive analyses and regression) as well as modified dataset (code is also showed, but not working as it should) Next steps are: - Polished code export -- Improved workflow and thorough step-wise guide/documentation +- Improved workflow and descriptive text as well as thorough step-wise guide/documentation (possibly with small videos) - Implement in clinical projects diff --git a/R/app_version.R b/R/app_version.R index 81d6d18..be55055 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250305_1101' +app_version <- function()'250306_0759' diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R index 7316be2..0a85dab 100644 --- a/inst/apps/freesearcheR/app.R +++ b/inst/apps/freesearcheR/app.R @@ -10,7 +10,7 @@ #### Current file: R//app_version.R ######## -app_version <- function()'250305_1101' +app_version <- function()'250306_0759' ######## @@ -1650,7 +1650,6 @@ sankey_ready <- function(data, x, y, z = NULL, numbers = "count") { dplyr::mutate(gy.sum = sum(n)) |> dplyr::ungroup() - if (numbers == "count") { out <- out |> dplyr::mutate( lx = factor(paste0(!!dplyr::sym(x), "\n(n=", gx.sum, ")")), @@ -1662,9 +1661,26 @@ sankey_ready <- function(data, x, y, z = NULL, numbers = "count") { ly = factor(paste0(!!dplyr::sym(y), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)")) ) } + + if (is.factor(data[[x]])){ + index <- match(levels(data[[x]]),str_remove_last(levels(out$lx),"\n")) + out$lx <- factor(out$lx,levels=levels(out$lx)[index]) + } + + if (is.factor(data[[y]])){ + index <- match(levels(data[[y]]),str_remove_last(levels(out$ly),"\n")) + out$ly <- factor(out$ly,levels=levels(out$ly)[index]) + } + out } +str_remove_last <- function(data,pattern="\n"){ + strsplit(data,split = pattern) |> + lapply(\(.x)paste(unlist(.x[[-length(.x)]]),collapse=pattern)) |> + unlist() +} + #' Line breaking at given number of characters for nicely plotting labels #' #' @param data @@ -1714,6 +1730,7 @@ default_theme <- function() { #' #' @param color.group #' @param colors +#' @param ... passed to sankey_ready() #' #' @returns ggplot2 object #' @export @@ -1722,9 +1739,9 @@ default_theme <- function() { #' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE))) #' ds |> plot_sankey_single("first", "last") #' ds |> plot_sankey_single("first", "last", color.group = "y") -plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL){ - data <- data |> sankey_ready(x = x, y = y) - +plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL,...){ + data <- data |> sankey_ready(x = x, y = y,...) +# browser() library(ggalluvial) na.color <- "#2986cc" @@ -1745,8 +1762,6 @@ plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL){ label.colors <- contrast_text(colors) } - - group_labels <- c(get_label(data, x), get_label(data, y)) |> sapply(line_break) |> unname()