updated docs + boxplot

.Rbuildignore

@@ -1,6 +1,6 @@
 ^renv$
 ^renv\.lock$
-^freesearcheR\.Rproj$
+^FreesearchR\.Rproj$
 ^\.Rproj\.user$
 ^LICENSE\.md$
 ^dev$

DESCRIPTION

@@ -80,6 +80,6 @@ Suggests:
     rsconnect,
     knitr,
     rmarkdown
-URL: https://github.com/agdamsbo/freesearcheR, https://agdamsbo.github.io/freesearcheR/
+URL: https://github.com/agdamsbo/FreesearchR, https://agdamsbo.github.io/FreesearchR/
-BugReports: https://github.com/agdamsbo/freesearcheR/issues
+BugReports: https://github.com/agdamsbo/FreesearchR/issues
 VignetteBuilder: knitr

NAMESPACE

@@ -5,6 +5,8 @@ S3method(plot,tbl_regression)
 export(add_class_icon)
 export(add_sparkline)
 export(all_but)
+export(allign_axes)
+export(append_list)
 export(argsstring2list)
 export(baseline_table)
 export(clean_date)
@@ -49,6 +51,7 @@ export(is_datetime)
 export(is_valid_redcap_url)
 export(is_valid_token)
 export(launch_FreesearchR)
+export(limit_log)
 export(line_break)
 export(m_datafileUI)
 export(m_redcap_readServer)
@@ -85,6 +88,7 @@ export(specify_qmd_format)
 export(subset_types)
 export(supported_functions)
 export(supported_plots)
+export(symmetrical_scale_x_log10)
 export(tbl_merge)
 export(update_factor_server)
 export(update_factor_ui)
@@ -95,6 +99,7 @@ export(vertical_stacked_bars)
 export(wide2long)
 export(winbox_cut_variable)
 export(winbox_update_factor)
+export(wrap_plot_list)
 export(write_quarto)
 importFrom(classInt,classIntervals)
 importFrom(data.table,as.data.table)

NEWS.md

@@ -1,8 +1,8 @@
-# freesearcheR 25.3.2
+# FreesearchR 25.3.2
 
 Focus is on polish and improved ui/ux.
 
-First steps towards an updated name (will be FreesearchR), with renamed repository. This may introduce some breaking chances for others calling or installing the package. No future changes are planned. A complete transition is planned before attending and presenting a poster at the European Stroke Organisation COnference 2025 in May.
+Updating name (will be FreesearchR), with renamed repository and some graphics are comng. This may introduce some breaking chances for others calling or installing the package. No future changes are planned. A complete transition is planned before attending and presenting a poster at the European Stroke Organisation Conference 2025 in May.
 
 Testing file upload conducted and improved.
 

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250318_0827'
+app_version <- function()'250319_1306'

R/cut-variable-dates.R

@@ -102,13 +102,16 @@ library(shiny)
 #' f <- d_t |> cut(2)
 #' readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA)) |> cut(breaks = lubridate::as_datetime(c(hms::as_hms(levels(f)), hms::as_hms(max(d_t, na.rm = TRUE) + 1))), right = FALSE)
 cut.hms <- function(x, breaks, ...) {
+  ## as_hms keeps returning warnings on tz(); ignored
+  suppressWarnings({
   if (hms::is_hms(breaks)) {
-    breaks <- lubridate::as_datetime(breaks, tz = "UTC")
+    breaks <- lubridate::as_datetime(breaks)
   }
-  x <- lubridate::as_datetime(x, tz = "UTC")
+  x <- lubridate::as_datetime(x)
   out <- cut.POSIXt(x, breaks = breaks, ...)
   attr(out, which = "brks") <- hms::as_hms(lubridate::as_datetime(attr(out, which = "brks")))
   attr(out, which = "levels") <- as.character(hms::as_hms(lubridate::as_datetime(attr(out, which = "levels"))))
+  })
   out
 }
 

R/data-import.R

@@ -59,27 +59,7 @@ data_import_server <- function(id) {
       id = ns("file_import"),
       show_data_in = "popup",
       trigger_return = "change",
-      return_class = "data.frame",
+      return_class = "data.frame"
-      read_fns = list(
-        ods = import_ods,
-        dta = function(file) {
-          haven::read_dta(
-            file = file,
-            .name_repair = "unique_quiet"
-          )
-        },
-        csv = import_delim,
-        tsv = import_delim,
-        txt = import_delim,
-        xls = import_xls,
-        xlsx = import_xls,
-        rds = function(file) {
-          readr::read_rds(
-            file = file,
-            name_repair = "unique_quiet"
-          )
-        }
-      )
     )
 
     shiny::observeEvent(data_file$data(), {

R/data_plots.R

@@ -112,6 +112,99 @@ data_visuals_server <- function(id,
         plot = NULL
       )
 
+      # ## --- New attempt
+      #
+      # rv$plot.params <- shiny::reactive({
+      #   get_plot_options(input$type) |> purrr::pluck(1)
+      # })
+      #
+      # c(output,
+      #            list(shiny::renderUI({
+      #   columnSelectInput(
+      #     inputId = ns("primary"),
+      #     data = data,
+      #     placeholder = "Select variable",
+      #     label = "Response variable",
+      #     multiple = FALSE
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$primary)
+      #   # browser()
+      #
+      #   if (!input$primary %in% names(data())) {
+      #     plot_data <- data()[1]
+      #   } else {
+      #     plot_data <- data()[input$primary]
+      #   }
+      #
+      #   plots <- possible_plots(
+      #     data = plot_data
+      #   )
+      #
+      #   plots_named <- get_plot_options(plots) |>
+      #     lapply(\(.x){
+      #       stats::setNames(.x$descr, .x$note)
+      #     })
+      #
+      #   vectorSelectInput(
+      #     inputId = ns("type"),
+      #     selected = NULL,
+      #     label = shiny::h4("Plot type"),
+      #     choices = Reduce(c, plots_named),
+      #     multiple = FALSE
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$type)
+      #
+      #   cols <- c(
+      #     rv$plot.params()[["secondary.extra"]],
+      #     all_but(
+      #       colnames(subset_types(
+      #         data(),
+      #         rv$plot.params()[["secondary.type"]]
+      #       )),
+      #       input$primary
+      #     )
+      #   )
+      #
+      #   columnSelectInput(
+      #     inputId = ns("secondary"),
+      #     data = data,
+      #     selected = cols[1],
+      #     placeholder = "Please select",
+      #     label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
+      #     multiple = rv$plot.params()[["secondary.multi"]],
+      #     maxItems = rv$plot.params()[["secondary.max"]],
+      #     col_subset = cols,
+      #     none_label = "No variable"
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$type)
+      #   columnSelectInput(
+      #     inputId = ns("tertiary"),
+      #     data = data,
+      #     placeholder = "Please select",
+      #     label = "Grouping variable",
+      #     multiple = FALSE,
+      #     col_subset = c(
+      #       "none",
+      #       all_but(
+      #         colnames(subset_types(
+      #           data(),
+      #           rv$plot.params()[["tertiary.type"]]
+      #         )),
+      #         input$primary,
+      #         input$secondary
+      #       )
+      #     ),
+      #     none_label = "No stratification"
+      #   )
+      # })
+      # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE)
+
       output$primary <- shiny::renderUI({
         columnSelectInput(
           inputId = ns("primary"),
@@ -364,6 +457,16 @@ supported_plots <- function() {
       tertiary.type = c("dichotomous", "ordinal"),
       secondary.extra = NULL
     ),
+    plot_box = list(
+      fun = "plot_box",
+      descr = "Box plot",
+      note = "A classic way to plot data distribution by groups",
+      primary.type = c("continuous", "dichotomous", "ordinal"),
+      secondary.type = c("dichotomous", "ordinal"),
+      secondary.multi = FALSE,
+      tertiary.type = c("dichotomous", "ordinal"),
+      secondary.extra = "none"
+    ),
     plot_euler = list(
       fun = "plot_euler",
       descr = "Euler diagram",
@@ -535,18 +638,49 @@ line_break <- function(data, lineLength = 20, fixed = FALSE) {
 }
 
 
-wrap_plot_list <- function(data) {
+#' Wrapping
-  if (length(data) > 1) {
+#'
-    out <- data |>
+#' @param data list of ggplot2 objects
-      allign_axes() |>
+#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
-      patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
+#'
+#' @returns list of ggplot2 objects
+#' @export
+#'
+wrap_plot_list <- function(data, tag_levels = NULL) {
+  if (ggplot2::is.ggplot(data[[1]])) {
+    if (length(data) > 1) {
+      out <- data |>
+        (\(.x){
+          if (rlang::is_named(.x)) {
+            purrr::imap(.x, \(.y, .i){
+              .y + ggplot2::ggtitle(.i)
+            })
+          } else {
+            .x
+          }
+        })() |>
+        allign_axes() |>
+        patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
+      if (!is.null(tag_levels)) {
+        out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
+      }
+    } else {
+      out <- data
+    }
   } else {
-    out <- data
+    cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
   }
   out
 }
 
 
+#' Alligns axes between plots
+#'
+#' @param ... ggplot2 objects or list of ggplot2 objects
+#'
+#' @returns list of ggplot2 objects
+#' @export
+#'
 allign_axes <- function(...) {
   # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
   # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
@@ -558,16 +692,30 @@ allign_axes <- function(...) {
     cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
   }
 
-  # browser()
+  yr <- clean_common_axis(p, "y")
-  yr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$y$get_limits()) |>
-    unlist() |>
-    range() |>
-    unique()
 
-  xr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$x$get_limits()) |>
+  xr <- clean_common_axis(p, "x")
-    unlist() |>
-    range() |>
-    unique()
 
   p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
 }
+
+#' Extract and clean axis ranges
+#'
+#' @param p plot
+#' @param axis axis. x or y.
+#'
+#' @returns vector
+#' @export
+#'
+clean_common_axis <- function(p, axis) {
+  purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
+    unlist() |>
+    (\(.x){
+      if (is.numeric(.x)) {
+        range(.x)
+      } else {
+        .x
+      }
+    })() |>
+    unique()
+}

R/helpers.R

@@ -215,7 +215,9 @@ default_parsing <- function(data) {
   out <- data |>
     REDCapCAST::parse_data() |>
     REDCapCAST::as_factor() |>
-    REDCapCAST::numchar2fct()
+    REDCapCAST::numchar2fct(numeric.threshold = 8,character.throshold = 10) |>
+    REDCapCAST::as_logical() |>
+    REDCapCAST::fct_drop()
 
   purrr::map2(out,name_labels,\(.x,.l){
     if (!(is.na(.l) | .l=="")) {
@@ -275,6 +277,7 @@ remove_empty_cols <- function(data,cutoff=.7){
 #' @param index index name
 #'
 #' @returns list
+#' @export
 #'
 #' @examples
 #' ls_d <- list(test=c(1:20))

R/plot_box.R

@@ -0,0 +1,80 @@
+#' Beautiful box plot(s)
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
+#' mtcars |>
+#'   default_parsing() |>
+#'   plot_box(x = "mpg", y = "cyl", z = "gear")
+plot_box <- function(data, x, y, z = NULL) {
+  if (!is.null(z)) {
+    ds <- split(data, data[z])
+  } else {
+    ds <- list(data)
+  }
+
+  out <- lapply(ds, \(.ds){
+    plot_box_single(
+      data = .ds,
+      x = x,
+      y = y
+    )
+  })
+
+  wrap_plot_list(out)
+  # patchwork::wrap_plots(out,guides = "collect")
+}
+
+
+
+
+#' Create nice box-plots
+#'
+#' @name data-plots
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' mtcars |> plot_box_single("mpg","cyl")
+plot_box_single <- function(data, x, y=NULL, seed = 2103) {
+  set.seed(seed)
+
+  if (is.null(y)) {
+    y <- "All"
+    data[[y]] <- y
+  }
+
+  discrete <- !outcome_type(data[[y]]) %in% "continuous"
+
+  data |>
+    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
+    ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
+    ## THis could be optional in future
+    ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9) +
+    ggplot2::coord_flip() +
+    viridis::scale_fill_viridis(discrete = discrete, option = "D") +
+    # ggplot2::theme_void() +
+    ggplot2::theme_bw(base_size = 24) +
+    ggplot2::theme(
+      legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = element_blank(),
+      # axis.title.y = element_blank(),
+      # text = ggplot2::element_text(size = 20),
+      # axis.text = ggplot2::element_blank(),
+      # plot.title = element_blank(),
+      panel.background = ggplot2::element_rect(fill = "white"),
+      plot.background = ggplot2::element_rect(fill = "white"),
+      panel.border = ggplot2::element_blank(),
+      panel.grid.major = ggplot2::element_blank(),
+      panel.grid.minor = ggplot2::element_blank(),
+      axis.line = ggplot2::element_line(colour = "black"),
+      axis.ticks = ggplot2::element_line(colour = "black")
+    )
+}

R/plot_euler.R

@@ -78,9 +78,6 @@ ggeulerr <- function(
 #' mtcars |> plot_euler("vs", "am", seed = 1)
 plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
   set.seed(seed = seed)
-
-  # data <- data[c(...,z)]
-
   if (!is.null(z)) {
     ds <- split(data, data[z])
   } else {
@@ -93,6 +90,7 @@ plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
       plot_euler_single()
   })
 
+# names(out)
   wrap_plot_list(out)
   # patchwork::wrap_plots(out, guides = "collect")
 }
@@ -116,7 +114,7 @@ plot_euler_single <- function(data) {
     ggeulerr(shape = "circle") +
     ggplot2::theme_void() +
     ggplot2::theme(
-      legend.position = "right",
+      legend.position = "none",
       # panel.grid.major = element_blank(),
       # panel.grid.minor = element_blank(),
       # axis.text.y = element_blank(),

R/regression_plot.R

@@ -33,7 +33,7 @@ plot.tbl_regression <- function(x,
   # gtsummary:::check_scalar_logical(remove_reference_rows)
 
   df_coefs <- x$table_body
-  browser()
+
   if (isTRUE(remove_header_rows)) {
     df_coefs <- df_coefs |> dplyr::filter(!header_row %in% TRUE)
   }
@@ -48,22 +48,16 @@ plot.tbl_regression <- function(x,
   if (plot_ref == TRUE){
   df_coefs[df_coefs$var_type == "categorical" & is.na(df_coefs$reference_row),"estimate"] <- if (x$inputs$exponentiate) 1 else 0}
 
-  df_coefs |>
+  p <- df_coefs |>
     ggstats::ggcoef_plot(exponentiate = x$inputs$exponentiate, ...)
+
+  if (x$inputs$exponentiate){
+    p <- symmetrical_scale_x_log10(p)
+  }
+  p
 }
 
 
-# default_parsing(mtcars) |> lapply(class)
-#
-# purrr::imap(mtcars,\(.x,.i){
-#   if (.i %in% c("vs","am","gear","carb")){
-#     as.factor(.x)
-#   } else .x
-#   }) |> dplyr::bind_cols()
-#
-#
-
-
 #' Wrapper to pivot gtsummary table data to long for plotting
 #'
 #' @param list a custom regression models list
@@ -103,3 +97,47 @@ merge_long <- function(list, model.names) {
 
   l_merged
 }
+
+
+#' Easily round log scale limits for nice plots
+#'
+#' @param data data
+#' @param fun rounding function (floor/ceiling)
+#' @param ... ignored
+#'
+#' @returns numeric vector
+#' @export
+#'
+#' @examples
+#' limit_log(-.1,floor)
+#' limit_log(.1,ceiling)
+#' limit_log(-2.1,ceiling)
+#' limit_log(2.1,ceiling)
+limit_log <- function(data,fun,...){
+  fun(10^-floor(data)*10^data)/10^-floor(data)
+}
+
+#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
+#'
+#' @param plot ggplot2 plot
+#' @param breaks breaks used and mirrored
+#' @param ... ignored
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+symmetrical_scale_x_log10 <- function(plot,breaks=c(1,2,3,5,10),...){
+  rx <- ggplot2::layer_scales(plot)$x$get_limits()
+
+  x_min <- floor(10*rx[1])/10
+  x_max <- ceiling(10*rx[2])/10
+
+  rx_min <- limit_log(rx[1],floor)
+  rx_max <- limit_log(rx[2],ceiling)
+
+  max_abs_x <- max(abs(c(x_min,x_max)))
+
+  ticks <- log10(breaks)+(ceiling(max_abs_x)-1)
+  browser()
+  plot + ggplot2::scale_x_log10(limits=c(rx_min,rx_max),breaks=create_log_tics(10^ticks[ticks<=max_abs_x]))
+}

_pkgdown.yml

@@ -1,4 +1,4 @@
-url: https://agdamsbo.github.io/freesearcheR/
+url: https://agdamsbo.github.io/FreesearchR/
 template:
   bslib:
     version: 5

inst/apps/FreesearchR/app.R

@@ -1,20 +1,20 @@
 
 
 ########
-#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/functions.R
+#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/functions.R 
 ########
 
 
 
 ########
-#### Current file: R//app_version.R
+#### Current file: R//app_version.R 
 ########
 
-app_version <- function()'250318_0827'
+app_version <- function()'250319_1306'
 
 
 ########
-#### Current file: R//baseline_table.R
+#### Current file: R//baseline_table.R 
 ########
 
 #' Print a flexible baseline characteristics table
@@ -42,7 +42,7 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 
 
 ########
-#### Current file: R//contrast_text.R
+#### Current file: R//contrast_text.R 
 ########
 
 #' @title Contrast Text Color
@@ -99,7 +99,7 @@ contrast_text <- function(background,
 
 
 ########
-#### Current file: R//correlations-module.R
+#### Current file: R//correlations-module.R 
 ########
 
 #' Data correlations evaluation module
@@ -260,7 +260,7 @@ cor_demo_app()
 
 
 ########
-#### Current file: R//custom_SelectInput.R
+#### Current file: R//custom_SelectInput.R 
 ########
 
 #' A selectizeInput customized for data frames with column labels
@@ -447,7 +447,7 @@ vectorSelectInput <- function(inputId,
 
 
 ########
-#### Current file: R//cut-variable-dates.R
+#### Current file: R//cut-variable-dates.R 
 ########
 
 library(datamods)
@@ -554,13 +554,16 @@ library(shiny)
 #' f <- d_t |> cut(2)
 #' readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA)) |> cut(breaks = lubridate::as_datetime(c(hms::as_hms(levels(f)), hms::as_hms(max(d_t, na.rm = TRUE) + 1))), right = FALSE)
 cut.hms <- function(x, breaks, ...) {
+  ## as_hms keeps returning warnings on tz(); ignored
+  suppressWarnings({
   if (hms::is_hms(breaks)) {
-    breaks <- lubridate::as_datetime(breaks, tz = "UTC")
+    breaks <- lubridate::as_datetime(breaks)
   }
-  x <- lubridate::as_datetime(x, tz = "UTC")
+  x <- lubridate::as_datetime(x)
   out <- cut.POSIXt(x, breaks = breaks, ...)
   attr(out, which = "brks") <- hms::as_hms(lubridate::as_datetime(attr(out, which = "brks")))
   attr(out, which = "levels") <- as.character(hms::as_hms(lubridate::as_datetime(attr(out, which = "levels"))))
+  })
   out
 }
 
@@ -1089,7 +1092,7 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
 
 
 ########
-#### Current file: R//data_plots.R
+#### Current file: R//data_plots.R 
 ########
 
 # source(here::here("functions.R"))
@@ -1206,6 +1209,99 @@ data_visuals_server <- function(id,
         plot = NULL
       )
 
+      # ## --- New attempt
+      #
+      # rv$plot.params <- shiny::reactive({
+      #   get_plot_options(input$type) |> purrr::pluck(1)
+      # })
+      #
+      # c(output,
+      #            list(shiny::renderUI({
+      #   columnSelectInput(
+      #     inputId = ns("primary"),
+      #     data = data,
+      #     placeholder = "Select variable",
+      #     label = "Response variable",
+      #     multiple = FALSE
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$primary)
+      #   # browser()
+      #
+      #   if (!input$primary %in% names(data())) {
+      #     plot_data <- data()[1]
+      #   } else {
+      #     plot_data <- data()[input$primary]
+      #   }
+      #
+      #   plots <- possible_plots(
+      #     data = plot_data
+      #   )
+      #
+      #   plots_named <- get_plot_options(plots) |>
+      #     lapply(\(.x){
+      #       stats::setNames(.x$descr, .x$note)
+      #     })
+      #
+      #   vectorSelectInput(
+      #     inputId = ns("type"),
+      #     selected = NULL,
+      #     label = shiny::h4("Plot type"),
+      #     choices = Reduce(c, plots_named),
+      #     multiple = FALSE
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$type)
+      #
+      #   cols <- c(
+      #     rv$plot.params()[["secondary.extra"]],
+      #     all_but(
+      #       colnames(subset_types(
+      #         data(),
+      #         rv$plot.params()[["secondary.type"]]
+      #       )),
+      #       input$primary
+      #     )
+      #   )
+      #
+      #   columnSelectInput(
+      #     inputId = ns("secondary"),
+      #     data = data,
+      #     selected = cols[1],
+      #     placeholder = "Please select",
+      #     label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
+      #     multiple = rv$plot.params()[["secondary.multi"]],
+      #     maxItems = rv$plot.params()[["secondary.max"]],
+      #     col_subset = cols,
+      #     none_label = "No variable"
+      #   )
+      # }),
+      # shiny::renderUI({
+      #   shiny::req(input$type)
+      #   columnSelectInput(
+      #     inputId = ns("tertiary"),
+      #     data = data,
+      #     placeholder = "Please select",
+      #     label = "Grouping variable",
+      #     multiple = FALSE,
+      #     col_subset = c(
+      #       "none",
+      #       all_but(
+      #         colnames(subset_types(
+      #           data(),
+      #           rv$plot.params()[["tertiary.type"]]
+      #         )),
+      #         input$primary,
+      #         input$secondary
+      #       )
+      #     ),
+      #     none_label = "No stratification"
+      #   )
+      # })
+      # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE)
+
       output$primary <- shiny::renderUI({
         columnSelectInput(
           inputId = ns("primary"),
@@ -1458,6 +1554,16 @@ supported_plots <- function() {
       tertiary.type = c("dichotomous", "ordinal"),
       secondary.extra = NULL
     ),
+    plot_box = list(
+      fun = "plot_box",
+      descr = "Box plot",
+      note = "A classic way to plot data distribution by groups",
+      primary.type = c("continuous", "dichotomous", "ordinal"),
+      secondary.type = c("dichotomous", "ordinal"),
+      secondary.multi = FALSE,
+      tertiary.type = c("dichotomous", "ordinal"),
+      secondary.extra = "none"
+    ),
     plot_euler = list(
       fun = "plot_euler",
       descr = "Euler diagram",
@@ -1629,18 +1735,49 @@ line_break <- function(data, lineLength = 20, fixed = FALSE) {
 }
 
 
-wrap_plot_list <- function(data) {
+#' Wrapping
-  if (length(data) > 1) {
+#'
-    out <- data |>
+#' @param data list of ggplot2 objects
-      allign_axes() |>
+#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
-      patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
+#'
+#' @returns list of ggplot2 objects
+#' @export
+#'
+wrap_plot_list <- function(data, tag_levels = NULL) {
+  if (ggplot2::is.ggplot(data[[1]])) {
+    if (length(data) > 1) {
+      out <- data |>
+        (\(.x){
+          if (rlang::is_named(.x)) {
+            purrr::imap(.x, \(.y, .i){
+              .y + ggplot2::ggtitle(.i)
+            })
+          } else {
+            .x
+          }
+        })() |>
+        allign_axes() |>
+        patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
+      if (!is.null(tag_levels)) {
+        out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
+      }
+    } else {
+      out <- data
+    }
   } else {
-    out <- data
+    cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
   }
   out
 }
 
 
+#' Alligns axes between plots
+#'
+#' @param ... ggplot2 objects or list of ggplot2 objects
+#'
+#' @returns list of ggplot2 objects
+#' @export
+#'
 allign_axes <- function(...) {
   # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
   # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
@@ -1652,23 +1789,37 @@ allign_axes <- function(...) {
     cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
   }
 
-  # browser()
+  yr <- clean_common_axis(p, "y")
-  yr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$y$get_limits()) |>
-    unlist() |>
-    range() |>
-    unique()
 
-  xr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$x$get_limits()) |>
+  xr <- clean_common_axis(p, "x")
-    unlist() |>
-    range() |>
-    unique()
 
   p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
 }
 
+#' Extract and clean axis ranges
+#'
+#' @param p plot
+#' @param axis axis. x or y.
+#'
+#' @returns vector
+#' @export
+#'
+clean_common_axis <- function(p, axis) {
+  purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
+    unlist() |>
+    (\(.x){
+      if (is.numeric(.x)) {
+        range(.x)
+      } else {
+        .x
+      }
+    })() |>
+    unique()
+}
+
 
 ########
-#### Current file: R//data-import.R
+#### Current file: R//data-import.R 
 ########
 
 data_import_ui <- function(id) {
@@ -1732,27 +1883,7 @@ data_import_server <- function(id) {
       id = ns("file_import"),
       show_data_in = "popup",
       trigger_return = "change",
-      return_class = "data.frame",
+      return_class = "data.frame"
-      read_fns = list(
-        ods = import_ods,
-        dta = function(file) {
-          haven::read_dta(
-            file = file,
-            .name_repair = "unique_quiet"
-          )
-        },
-        csv = import_delim,
-        tsv = import_delim,
-        txt = import_delim,
-        xls = import_xls,
-        xlsx = import_xls,
-        rds = function(file) {
-          readr::read_rds(
-            file = file,
-            name_repair = "unique_quiet"
-          )
-        }
-      )
     )
 
     shiny::observeEvent(data_file$data(), {
@@ -1845,7 +1976,7 @@ data_import_demo_app <- function() {
 
 
 ########
-#### Current file: R//data-summary.R
+#### Current file: R//data-summary.R 
 ########
 
 #' Data summary module
@@ -2154,7 +2285,7 @@ add_class_icon <- function(grid, column = "class") {
 
 
 ########
-#### Current file: R//file-import-module.R
+#### Current file: R//file-import-module.R 
 ########
 
 #' Shiny UI module to load a data file
@@ -2285,7 +2416,7 @@ file_app()
 
 
 ########
-#### Current file: R//helpers.R
+#### Current file: R//helpers.R 
 ########
 
 #' Wrapper function to get function from character vector referring to function from namespace. Passed to 'do.call()'
@@ -2505,7 +2636,9 @@ default_parsing <- function(data) {
   out <- data |>
     REDCapCAST::parse_data() |>
     REDCapCAST::as_factor() |>
-    REDCapCAST::numchar2fct()
+    REDCapCAST::numchar2fct(numeric.threshold = 8,character.throshold = 10) |>
+    REDCapCAST::as_logical() |>
+    REDCapCAST::fct_drop()
 
   purrr::map2(out,name_labels,\(.x,.l){
     if (!(is.na(.l) | .l=="")) {
@@ -2565,6 +2698,7 @@ remove_empty_cols <- function(data,cutoff=.7){
 #' @param index index name
 #'
 #' @returns list
+#' @export
 #'
 #' @examples
 #' ls_d <- list(test=c(1:20))
@@ -2599,7 +2733,7 @@ missing_fraction <- function(data){
 
 
 ########
-#### Current file: R//import-file-ext.R
+#### Current file: R//import-file-ext.R 
 ########
 
 #' @title Import data from a file
@@ -2858,7 +2992,7 @@ import_file_server <- function(id,
         parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))]
         # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
         imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
-        code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR")
+        code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "FreesearchR")
 
         if (inherits(imported, "try-error")) {
           imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
@@ -3174,7 +3308,118 @@ import_file_demo_app <- function() {
 
 
 ########
-#### Current file: R//plot_euler.R
+#### Current file: R//launch_FreesearchR.R 
+########
+
+#' Easily launch the FreesearchR app
+#'
+#' @description
+#' All data.frames in the global environment will be accessible through the app.
+#'
+#' @param ... passed on to `shiny::runApp()`
+#'
+#' @returns shiny app
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' data(mtcars)
+#' shiny_FreesearchR(launch.browser = TRUE)
+#' }
+launch_FreesearchR <- function(...){
+  appDir <- system.file("apps", "FreesearchR", package = "FreesearchR")
+  if (appDir == "") {
+    stop("Could not find the app directory. Try re-installing `FreesearchR`.", call. = FALSE)
+  }
+
+  a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
+  return(invisible(a))
+}
+
+
+########
+#### Current file: R//plot_box.R 
+########
+
+#' Beautiful box plot(s)
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
+#' mtcars |>
+#'   default_parsing() |>
+#'   plot_box(x = "mpg", y = "cyl", z = "gear")
+plot_box <- function(data, x, y, z = NULL) {
+  if (!is.null(z)) {
+    ds <- split(data, data[z])
+  } else {
+    ds <- list(data)
+  }
+
+  out <- lapply(ds, \(.ds){
+    plot_box_single(
+      data = .ds,
+      x = x,
+      y = y
+    )
+  })
+
+  wrap_plot_list(out)
+  # patchwork::wrap_plots(out,guides = "collect")
+}
+
+
+
+
+#' Create nice box-plots
+#'
+#' @name data-plots
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' mtcars |> plot_box_single("mpg","cyl")
+plot_box_single <- function(data, x, y=NULL, seed = 2103) {
+  set.seed(seed)
+
+  if (is.null(y)) {
+    y <- "All"
+    data[[y]] <- y
+  }
+
+  discrete <- !outcome_type(data[[y]]) %in% "continuous"
+
+  data |>
+    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
+    ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
+    ## THis could be optional in future
+    ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9) +
+    ggplot2::coord_flip() +
+    # viridis::scale_fill_viridis(discrete = discrete, option = "C") +
+    # ggplot2::theme_void() +
+    ggplot2::theme(
+      legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = element_blank(),
+      # axis.title.y = element_blank(),
+      text = ggplot2::element_text(size = 20),
+      # axis.text = ggplot2::element_blank(),
+      # plot.title = element_blank(),
+      panel.background = ggplot2::element_rect(fill = "white"),
+      plot.background = ggplot2::element_rect(fill = "white"),
+      panel.border = ggplot2::element_blank()
+    )
+}
+
+
+########
+#### Current file: R//plot_euler.R 
 ########
 
 #' Area proportional venn diagrams
@@ -3257,9 +3502,6 @@ ggeulerr <- function(
 #' mtcars |> plot_euler("vs", "am", seed = 1)
 plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
   set.seed(seed = seed)
-
-  # data <- data[c(...,z)]
-
   if (!is.null(z)) {
     ds <- split(data, data[z])
   } else {
@@ -3272,6 +3514,7 @@ plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
       plot_euler_single()
   })
 
+# names(out)
   wrap_plot_list(out)
   # patchwork::wrap_plots(out, guides = "collect")
 }
@@ -3295,7 +3538,7 @@ plot_euler_single <- function(data) {
     ggeulerr(shape = "circle") +
     ggplot2::theme_void() +
     ggplot2::theme(
-      legend.position = "right",
+      legend.position = "none",
       # panel.grid.major = element_blank(),
       # panel.grid.minor = element_blank(),
       # axis.text.y = element_blank(),
@@ -3311,7 +3554,7 @@ plot_euler_single <- function(data) {
 
 
 ########
-#### Current file: R//plot_hbar.R
+#### Current file: R//plot_hbar.R 
 ########
 
 #' Nice horizontal stacked bars (Grotta bars)
@@ -3412,7 +3655,7 @@ vertical_stacked_bars <- function(data,
 
 
 ########
-#### Current file: R//plot_ridge.R
+#### Current file: R//plot_ridge.R 
 ########
 
 #' Plot nice ridge plot
@@ -3446,7 +3689,7 @@ plot_ridge <- function(data, x, y, z = NULL, ...) {
 
 
 ########
-#### Current file: R//plot_sankey.R
+#### Current file: R//plot_sankey.R 
 ########
 
 #' Readying data for sankey plot
@@ -3652,7 +3895,7 @@ plot_sankey_single <- function(data, x, y, color.group = c("x", "y"), colors = N
 
 
 ########
-#### Current file: R//plot_scatter.R
+#### Current file: R//plot_scatter.R 
 ########
 
 #' Beautiful violin plot
@@ -3683,7 +3926,7 @@ plot_scatter <- function(data, x, y, z = NULL) {
 
 
 ########
-#### Current file: R//plot_violin.R
+#### Current file: R//plot_violin.R 
 ########
 
 #' Beatiful violin plot
@@ -3716,7 +3959,7 @@ plot_violin <- function(data, x, y, z = NULL) {
 
 
 ########
-#### Current file: R//redcap_read_shiny_module.R
+#### Current file: R//redcap_read_shiny_module.R 
 ########
 
 #' Shiny module to browser and export REDCap data
@@ -4303,14 +4546,14 @@ redcap_demo_app <- function() {
 
 
 ########
-#### Current file: R//redcap.R
+#### Current file: R//redcap.R 
 ########
 
 
 
 
 ########
-#### Current file: R//regression_model.R
+#### Current file: R//regression_model.R 
 ########
 
 #' Create a regression model programatically
@@ -4952,7 +5195,7 @@ regression_model_uv_list <- function(data,
 
 
 ########
-#### Current file: R//regression_plot.R
+#### Current file: R//regression_plot.R 
 ########
 
 #' Regression coef plot from gtsummary. Slightly modified to pass on arguments
@@ -4972,15 +5215,16 @@ regression_model_uv_list <- function(data,
 #'
 #' @examples
 #' \dontrun{
-#' mod <- lm(mpg ~ ., mtcars)
+#' mod <- lm(mpg ~ ., default_parsing(mtcars))
 #' p <- mod |>
 #'   gtsummary::tbl_regression() |>
 #'   plot(colour = "variable")
 #' }
 #'
 plot.tbl_regression <- function(x,
-                                # remove_header_rows = TRUE,
+                                plot_ref = TRUE,
-                                # remove_reference_rows = FALSE,
+                                remove_header_rows = TRUE,
+                                remove_reference_rows = FALSE,
                                 ...) {
   # check_dots_empty()
   gtsummary:::check_pkg_installed("ggstats")
@@ -4989,33 +5233,31 @@ plot.tbl_regression <- function(x,
   # gtsummary:::check_scalar_logical(remove_reference_rows)
 
   df_coefs <- x$table_body
-  # if (isTRUE(remove_header_rows)) {
-  #   df_coefs <- df_coefs |> dplyr::filter(!.data$header_row %in% TRUE)
-  # }
-  # if (isTRUE(remove_reference_rows)) {
-  #   df_coefs <- df_coefs |> dplyr::filter(!.data$reference_row %in% TRUE)
-  # }
 
-  # browser()
+  if (isTRUE(remove_header_rows)) {
+    df_coefs <- df_coefs |> dplyr::filter(!header_row %in% TRUE)
+  }
+  if (isTRUE(remove_reference_rows)) {
+    df_coefs <- df_coefs |> dplyr::filter(!reference_row %in% TRUE)
+  }
 
+  # Removes redundant label
   df_coefs$label[df_coefs$row_type == "label"] <- ""
 
-  df_coefs %>%
+  # Add estimate value to reference level
+  if (plot_ref == TRUE){
+  df_coefs[df_coefs$var_type == "categorical" & is.na(df_coefs$reference_row),"estimate"] <- if (x$inputs$exponentiate) 1 else 0}
+
+  p <- df_coefs |>
     ggstats::ggcoef_plot(exponentiate = x$inputs$exponentiate, ...)
+
+  if (x$inputs$exponentiate){
+    p <- symmetrical_scale_x_log10(p)
+  }
+  p
 }
 
 
-# default_parsing(mtcars) |> lapply(class)
-#
-# purrr::imap(mtcars,\(.x,.i){
-#   if (.i %in% c("vs","am","gear","carb")){
-#     as.factor(.x)
-#   } else .x
-#   }) |> dplyr::bind_cols()
-#
-#
-
-
 #' Wrapper to pivot gtsummary table data to long for plotting
 #'
 #' @param list a custom regression models list
@@ -5057,8 +5299,52 @@ merge_long <- function(list, model.names) {
 }
 
 
+#' Easily round log scale limits for nice plots
+#'
+#' @param data data
+#' @param fun rounding function (floor/ceiling)
+#' @param ... ignored
+#'
+#' @returns numeric vector
+#' @export
+#'
+#' @examples
+#' limit_log(-.1,floor)
+#' limit_log(.1,ceiling)
+#' limit_log(-2.1,ceiling)
+#' limit_log(2.1,ceiling)
+limit_log <- function(data,fun,...){
+  fun(10^-floor(data)*10^data)/10^-floor(data)
+}
+
+#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
+#'
+#' @param plot ggplot2 plot
+#' @param breaks breaks used and mirrored
+#' @param ... ignored
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+symmetrical_scale_x_log10 <- function(plot,breaks=c(1,2,3,5,10),...){
+  rx <- ggplot2::layer_scales(plot)$x$get_limits()
+
+  x_min <- floor(10*rx[1])/10
+  x_max <- ceiling(10*rx[2])/10
+
+  rx_min <- limit_log(rx[1],floor)
+  rx_max <- limit_log(rx[2],ceiling)
+
+  max_abs_x <- max(abs(c(x_min,x_max)))
+
+  ticks <- log10(breaks)+(ceiling(max_abs_x)-1)
+  browser()
+  plot + ggplot2::scale_x_log10(limits=c(rx_min,rx_max),breaks=create_log_tics(10^ticks[ticks<=max_abs_x]))
+}
+
+
 ########
-#### Current file: R//regression_table.R
+#### Current file: R//regression_table.R 
 ########
 
 #' Create table of regression model
@@ -5144,7 +5430,7 @@ merge_long <- function(list, model.names) {
 #' #' @export
 #' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
 #'   # Stripping custom class
-#'   class(x) <- class(x)[class(x) != "freesearcher_model"]
+#'   class(x) <- class(x)[class(x) != "freesearchr_model"]
 #'
 #'   if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
 #'     if (!"exponentiate" %in% names(args.list)) {
@@ -5173,7 +5459,7 @@ regression_table <- function(x, ...) {
 
 regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
   # Stripping custom class
-  class(x) <- class(x)[class(x) != "freesearcher_model"]
+  class(x) <- class(x)[class(x) != "freesearchr_model"]
 
   if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
     if (!"exponentiate" %in% names(args.list)) {
@@ -5209,7 +5495,7 @@ tbl_merge <- function(data) {
 
 
 ########
-#### Current file: R//report.R
+#### Current file: R//report.R 
 ########
 
 #' Split vector by an index and embed addition
@@ -5297,50 +5583,7 @@ modify_qmd <- function(file, format) {
 
 
 ########
-#### Current file: R//shiny_freesearcheR.R
+#### Current file: R//theme.R 
-########
-
-#' Launch the freesearcheR tool locally
-#'
-#' @description
-#' All data.frames in the global environment will be accessible through the app.
-#'
-#'
-#' @param ... arguments passed on to `shiny::runApp()`
-#'
-#' @return shiny app
-#' @export
-#'
-#' @examples
-#' \dontrun{
-#' data(mtcars)
-#' shiny_freesearcheR(launch.browser = TRUE)
-#' }
-shiny_freesearcheR <- function(...) {
-  appDir <- system.file("apps", "freesearcheR", package = "freesearcheR")
-  if (appDir == "") {
-    stop("Could not find the app directory. Try re-installing `freesearcheR`.", call. = FALSE)
-  }
-
-  a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
-  return(invisible(a))
-}
-
-
-#' Easily launch the freesearcheR app
-#'
-#' @param ... passed on to `shiny::runApp()`
-#'
-#' @returns shiny app
-#' @export
-#'
-launch_freesearcheR <- function(...){
-  shiny_freesearcheR(...)
-}
-
-
-########
-#### Current file: R//theme.R
 ########
 
 #' Custom theme based on unity
@@ -5422,7 +5665,7 @@ gg_theme_export <- function(){
 
 
 ########
-#### Current file: R//update-factor-ext.R
+#### Current file: R//update-factor-ext.R 
 ########
 
 
@@ -5692,7 +5935,7 @@ modal_update_factor <- function(id,
 #'
 #' @importFrom shinyWidgets WinBox wbOptions wbControls
 #' @importFrom htmltools tagList
-#' @rdname create-column
+#' @rdname update-factor
 winbox_update_factor <- function(id,
                                  title = i18n("Update levels of a factor"),
                                  options = shinyWidgets::wbOptions(),
@@ -5719,7 +5962,7 @@ winbox_update_factor <- function(id,
 
 
 ########
-#### Current file: R//update-variables-ext.R
+#### Current file: R//update-variables-ext.R 
 ########
 
 library(data.table)
@@ -6501,7 +6744,7 @@ clean_date <- function(data){
 
 
 ########
-#### Current file: R//wide2long.R
+#### Current file: R//wide2long.R 
 ########
 
 #' Alternative pivoting method for easily pivoting based on name pattern
@@ -6660,7 +6903,7 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
 
 
 ########
-#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/ui.R
+#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/ui.R 
 ########
 
 # ns <- NS(id)
@@ -6672,7 +6915,7 @@ ui_elements <- list(
   #########
   ##############################################################################
   "home" = bslib::nav_panel(
-    title = "freesearcheR",
+    title = "FreesearchR",
     shiny::fluidRow(
       shiny::column(width = 2),
       shiny::column(
@@ -7263,10 +7506,10 @@ ui <- bslib::page_fixed(
     # add the name of the tab you want to use as title in data-value
     shiny::HTML(
       ".container-fluid > .nav > li >
-                        a[data-value='freesearcheR'] {font-size: 28px}"
+                        a[data-value='FreesearchR'] {font-size: 28px}"
     )
   ),
-  title = "freesearcheR",
+  title = "FreesearchR",
   theme = light,
   shiny::useBusyIndicators(),
   bslib::page_navbar(
@@ -7289,7 +7532,7 @@ ui <- bslib::page_fixed(
       ),
       shiny::p(
         style = "margin: 1; color: #888;",
-        "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
+        "AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
       ),
     )
   )
@@ -7297,7 +7540,7 @@ ui <- bslib::page_fixed(
 
 
 ########
-#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/server.R
+#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/server.R 
 ########
 
 library(readr)
@@ -7328,7 +7571,7 @@ library(IDEAFilter)
 library(shinyWidgets)
 library(DT)
 library(gtsummary)
-# library(freesearcheR)
+# library(FreesearchR)
 
 # source("functions.R")
 
@@ -7476,7 +7719,7 @@ server <- function(input, output, session) {
         paste(collapse = "") |>
         paste("|>
         dplyr::select(", paste(input$import_var, collapse = ","), ") |>
-        freesearcheR::default_parsing()") |>
+        FreesearchR::default_parsing()") |>
         (\(.x){
           paste0("data <- ", .x)
         })()
@@ -8279,7 +8522,7 @@ server <- function(input, output, session) {
 
 
 ########
-#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/launch.R
+#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/launch.R 
 ########
 
 shinyApp(ui, server)

inst/apps/FreesearchR/server.R

@@ -26,7 +26,7 @@ library(IDEAFilter)
 library(shinyWidgets)
 library(DT)
 library(gtsummary)
-# library(freesearcheR)
+# library(FreesearchR)
 
 # source("functions.R")
 
@@ -174,7 +174,7 @@ server <- function(input, output, session) {
         paste(collapse = "") |>
         paste("|>
         dplyr::select(", paste(input$import_var, collapse = ","), ") |>
-        freesearcheR::default_parsing()") |>
+        FreesearchR::default_parsing()") |>
         (\(.x){
           paste0("data <- ", .x)
         })()

inst/apps/FreesearchR/ui.R

@@ -7,7 +7,7 @@ ui_elements <- list(
   #########
   ##############################################################################
   "home" = bslib::nav_panel(
-    title = "freesearcheR",
+    title = "FreesearchR",
     shiny::fluidRow(
       shiny::column(width = 2),
       shiny::column(
@@ -598,10 +598,10 @@ ui <- bslib::page_fixed(
     # add the name of the tab you want to use as title in data-value
     shiny::HTML(
       ".container-fluid > .nav > li >
-                        a[data-value='freesearcheR'] {font-size: 28px}"
+                        a[data-value='FreesearchR'] {font-size: 28px}"
     )
   ),
-  title = "freesearcheR",
+  title = "FreesearchR",
   theme = light,
   shiny::useBusyIndicators(),
   bslib::page_navbar(
@@ -624,7 +624,7 @@ ui <- bslib::page_fixed(
       ),
       shiny::p(
         style = "margin: 1; color: #888;",
-        "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
+        "AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
       ),
     )
   )

inst/apps/FreesearchR/www/intro.md

@@ -1,6 +1,6 @@
 # Welcome
 
-This is the ***freesearcheR*** data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. If you need more advanced tools for regression models or plotting, you'll probably be better off using *R* or similar directly on your own machine.
+This is the ***FreesearchR*** data analysis tool. We intend the ***FreesearchR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. If you need more advanced tools for regression models or plotting, you'll probably be better off using *R* or similar directly on your own machine.
 
 By intention, this tool has been designed to be simple to use with a minimum of mandatory options to keep the workflow streamlined, while also including a few options to go even further.
 
@@ -24,6 +24,6 @@ There are some simple steps to go through (see corresponding tabs in the top):
 
 1.  Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata.
 
-Have a look at the [documentations page](https://agdamsbo.github.io/freesearcheR/) for further project description. If you're interested in the source code, then go on, [have a look](https://github.com/agdamsbo/freesearcheR)!
+The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) for documenting the project, functions, road map and more. If you're interested in the source code, then [everything is open and you are free to read, copy, modify and improve](https://github.com/agdamsbo/FreesearchR), and please let us know if you want to contribute!
 
-If you encounter anything strange or the app doesn't act as expected. Please [report on Github](https://github.com/agdamsbo/freesearcheR/issues).
+Contributions can be reporting issues, suggesting new functionality, improving code or any other feedback. [It all goes here](https://github.com/agdamsbo/FreesearchR/issues).

man/allign_axes.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{allign_axes}
+\alias{allign_axes}
+\title{Alligns axes between plots}
+\usage{
+allign_axes(...)
+}
+\arguments{
+\item{...}{ggplot2 objects or list of ggplot2 objects}
+}
+\value{
+list of ggplot2 objects
+}
+\description{
+Alligns axes between plots
+}

man/limit_log.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/regression_plot.R
+\name{limit_log}
+\alias{limit_log}
+\title{Easily round log scale limits for nice plots}
+\usage{
+limit_log(data, fun, ...)
+}
+\arguments{
+\item{data}{data}
+
+\item{fun}{rounding function (floor/ceiling)}
+
+\item{...}{ignored}
+}
+\value{
+numeric vector
+}
+\description{
+Easily round log scale limits for nice plots
+}
+\examples{
+limit_log(-.1,floor)
+limit_log(.1,ceiling)
+limit_log(-2.1,ceiling)
+limit_log(2.1,ceiling)
+}

man/symmetrical_scale_x_log10.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/regression_plot.R
+\name{symmetrical_scale_x_log10}
+\alias{symmetrical_scale_x_log10}
+\title{Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots}
+\usage{
+symmetrical_scale_x_log10(plot, breaks = c(1, 2, 3, 5, 10), ...)
+}
+\arguments{
+\item{plot}{ggplot2 plot}
+
+\item{breaks}{breaks used and mirrored}
+
+\item{...}{ignored}
+}
+\value{
+ggplot2 object
+}
+\description{
+Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
+}

man/wrap_plot_list.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{wrap_plot_list}
+\alias{wrap_plot_list}
+\title{Wrapping}
+\usage{
+wrap_plot_list(data, tag_levels = NULL)
+}
+\arguments{
+\item{data}{list of ggplot2 objects}
+
+\item{tag_levels}{passed to patchwork::plot_annotation if given. Default is NULL}
+}
+\value{
+list of ggplot2 objects
+}
+\description{
+Wrapping
+}

renv/activate.R

@@ -2,7 +2,7 @@
 local({
 
   # the requested version of renv
-  version <- "1.1.2"
+  version <- "1.1.3"
   attr(version, "sha") <- NULL
 
   # the project directory
@@ -695,11 +695,19 @@ local({
   
   }
   
-  renv_bootstrap_platform_prefix <- function() {
+  renv_bootstrap_platform_prefix_default <- function() {
   
-    # construct version prefix
+    # read version component
-    version <- paste(R.version$major, R.version$minor, sep = ".")
+    version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v")
-    prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-")
+  
+    # expand placeholders
+    placeholders <- list(
+      list("%v", format(getRversion()[1, 1:2])),
+      list("%V", format(getRversion()[1, 1:3]))
+    )
+  
+    for (placeholder in placeholders)
+      version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE)
   
     # include SVN revision for development versions of R
     # (to avoid sharing platform-specific artefacts with released versions of R)
@@ -708,10 +716,19 @@ local({
       identical(R.version[["nickname"]], "Unsuffered Consequences")
   
     if (devel)
-      prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r")
+      version <- paste(version, R.version[["svn rev"]], sep = "-r")
+  
+    version
+  
+  }
+  
+  renv_bootstrap_platform_prefix <- function() {
+  
+    # construct version prefix
+    version <- renv_bootstrap_platform_prefix_default()
   
     # build list of path components
-    components <- c(prefix, R.version$platform)
+    components <- c(version, R.version$platform)
   
     # include prefix if provided by user
     prefix <- renv_bootstrap_platform_prefix_impl()
@@ -950,14 +967,14 @@ local({
   }
   
   renv_bootstrap_validate_version_dev <- function(version, description) {
-    
+  
     expected <- description[["RemoteSha"]]
     if (!is.character(expected))
       return(FALSE)
-    
+  
     pattern <- sprintf("^\\Q%s\\E", version)
     grepl(pattern, expected, perl = TRUE)
-    
+  
   }
   
   renv_bootstrap_validate_version_release <- function(version, description) {
@@ -1198,86 +1215,89 @@ local({
   }
   
   renv_json_read_patterns <- function() {
-    
+  
     list(
-      
+  
       # objects
-      list("{", "\t\n\tobject(\t\n\t"),
+      list("{", "\t\n\tobject(\t\n\t", TRUE),
-      list("}", "\t\n\t)\t\n\t"),
+      list("}", "\t\n\t)\t\n\t",       TRUE),
-      
+  
       # arrays
-      list("[", "\t\n\tarray(\t\n\t"),
+      list("[", "\t\n\tarray(\t\n\t", TRUE),
-      list("]", "\n\t\n)\n\t\n"),
+      list("]", "\n\t\n)\n\t\n",      TRUE),
-      
+  
       # maps
-      list(":", "\t\n\t=\t\n\t")
+      list(":", "\t\n\t=\t\n\t", TRUE),
-      
+  
+      # newlines
+      list("\\u000a", "\n", FALSE)
+  
     )
-    
+  
   }
   
   renv_json_read_envir <- function() {
   
     envir <- new.env(parent = emptyenv())
-    
+  
     envir[["+"]] <- `+`
     envir[["-"]] <- `-`
-    
+  
     envir[["object"]] <- function(...) {
       result <- list(...)
       names(result) <- as.character(names(result))
       result
     }
-    
+  
     envir[["array"]] <- list
-    
+  
     envir[["true"]]  <- TRUE
     envir[["false"]] <- FALSE
     envir[["null"]]  <- NULL
-    
+  
     envir
-    
+  
   }
   
   renv_json_read_remap <- function(object, patterns) {
-    
+  
     # repair names if necessary
     if (!is.null(names(object))) {
-      
+  
       nms <- names(object)
       for (pattern in patterns)
         nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE)
       names(object) <- nms
-      
+  
     }
-    
+  
     # repair strings if necessary
     if (is.character(object)) {
       for (pattern in patterns)
         object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE)
     }
-    
+  
     # recurse for other objects
     if (is.recursive(object))
       for (i in seq_along(object))
         object[i] <- list(renv_json_read_remap(object[[i]], patterns))
-    
+  
     # return remapped object
     object
-    
+  
   }
   
   renv_json_read_default <- function(file = NULL, text = NULL) {
   
     # read json text
     text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
-    
+  
     # convert into something the R parser will understand
     patterns <- renv_json_read_patterns()
     transformed <- text
     for (pattern in patterns)
       transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE)
-    
+  
     # parse it
     rfile <- tempfile("renv-json-", fileext = ".R")
     on.exit(unlink(rfile), add = TRUE)
@@ -1287,9 +1307,10 @@ local({
     # evaluate in safe environment
     result <- eval(json, envir = renv_json_read_envir())
   
-    # fix up strings if necessary
+    # fix up strings if necessary -- do so only with reversible patterns
+    patterns <- Filter(function(pattern) pattern[[3L]], patterns)
     renv_json_read_remap(result, patterns)
-    
+  
   }