ready for new release

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"))

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
 

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250305_1101'
+app_version <- function()'250306_0759'

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()