more docs

NAMESPACE

@@ -61,6 +61,7 @@ export(index_embed)
 export(is_any_class)
 export(is_consecutive)
 export(is_datetime)
+export(is_identical_to_previous)
 export(is_valid_redcap_url)
 export(is_valid_token)
 export(launch_FreesearchR)

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'Version: 25.4.3.250415_1627'
+app_version <- function()'Version: 25.4.3.250422'

R/data-summary.R

@@ -155,8 +155,8 @@ overview_vars <- function(data) {
   data <- as.data.frame(data)
 
   dplyr::tibble(
-    icon = data_type(data),
+    icon = get_classes(data),
-    type = icon,
+    class = icon,
     name = names(data),
     n_missing = unname(colSums(is.na(data))),
     p_complete = 1 - n_missing / nrow(data),
@@ -189,6 +189,7 @@ create_overview_datagrid <- function(data,...) {
   std_names <- c(
     "Name" = "name",
     "Icon" = "icon",
+    "Class" = "class",
     "Type" = "type",
     "Missings" = "n_missing",
     "Complete" = "p_complete",
@@ -235,7 +236,7 @@ create_overview_datagrid <- function(data,...) {
   grid <- add_class_icon(
     grid = grid,
     column = "icon",
-    fun = type_icons
+    fun = class_icons
   )
 
   grid <- toastui::grid_format(

R/data_plots.R

@@ -408,7 +408,7 @@ all_but <- function(data, ...) {
 #'
 #' @examples
 #' default_parsing(mtcars) |> subset_types("ordinal")
-#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
 #' #' default_parsing(mtcars) |> subset_types("factor",class)
 subset_types <- function(data, types, type.fun = data_type) {
   data[sapply(data, type.fun) %in% types]
@@ -443,58 +443,58 @@ supported_plots <- function() {
       fun = "plot_hbars",
       descr = "Stacked horizontal bars",
       note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = "none"
     ),
     plot_violin = list(
       fun = "plot_violin",
       descr = "Violin plot",
       note = "A modern alternative to the classic boxplot to visualise data distribution",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
       secondary.extra = "none",
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "categorical")
     ),
     # plot_ridge = list(
     #   descr = "Ridge plot",
     #   note = "An alternative option to visualise data distribution",
     #   primary.type = "continuous",
-    #   secondary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   secondary.type = c("dichotomous" ,"categorical"),
-    #   tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   tertiary.type = c("dichotomous" ,"categorical"),
     #   secondary.extra = NULL
     # ),
     plot_sankey = list(
       fun = "plot_sankey",
       descr = "Sankey plot",
       note = "A way of visualising change between groups",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
       secondary.extra = NULL,
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "categorical")
     ),
     plot_scatter = list(
       fun = "plot_scatter",
       descr = "Scatter plot",
       note = "A classic way of showing the association between to variables",
       primary.type = c("datatime", "continuous"),
-      secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
+      secondary.type = c("datatime", "continuous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       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("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = "none"
     ),
     plot_euler = list(
@@ -505,7 +505,7 @@ supported_plots <- function() {
       secondary.type = "dichotomous",
       secondary.multi = TRUE,
       secondary.max = 4,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = NULL
     )
   )

R/helpers.R

@@ -129,7 +129,7 @@ argsstring2list <- function(string) {
 #' @export
 #'
 #' @examples
-#' factorize(mtcars,names(mtcars))
+#' factorize(mtcars, names(mtcars))
 factorize <- function(data, vars) {
   if (!is.null(vars)) {
     data |>
@@ -258,19 +258,25 @@ default_parsing <- function(data) {
 #' @export
 #'
 #' @examples
-#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> dplyr::bind_cols()
+#' ds <- mtcars |>
+#'   lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+#'   dplyr::bind_cols()
 #' ds |>
 #'   remove_empty_attr() |>
 #'   str()
-#'  mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> remove_empty_attr() |>
+#' mtcars |>
+#'   lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+#'   remove_empty_attr() |>
 #'   str()
 #'
 remove_empty_attr <- function(data) {
-  if (is.data.frame(data)){
+  if (is.data.frame(data)) {
-    data |> lapply(remove_empty_attr) |> dplyr::bind_cols()
+    data |>
-  } else if (is.list(data)){
+      lapply(remove_empty_attr) |>
+      dplyr::bind_cols()
+  } else if (is.list(data)) {
     data |> lapply(remove_empty_attr)
-  }else{
+  } else {
     attributes(data)[is.na(attributes(data))] <- NULL
     data
   }
@@ -387,7 +393,7 @@ data_description <- function(data, data_text = "Data") {
 #' }
 data_type_filter <- function(data, type) {
   ## Please ensure to only provide recognised data types
-  assertthat::assert_that(all(type %in% data_types()))
+  assertthat::assert_that(all(type %in% names(data_types())))
 
   if (!is.null(type)) {
     out <- data[data_type(data) %in% type]
@@ -616,3 +622,33 @@ append_column <- function(data, column, name, index = "right") {
   ) |>
     dplyr::bind_cols()
 }
+
+
+
+#' Test if element is identical to the previous
+#'
+#' @param data data. vector, data.frame or list
+#' @param no.name logical to remove names attribute before testing
+#'
+#' @returns logical vector
+#' @export
+#'
+#' @examples
+#' c(1, 1, 2, 3, 3, 2, 4, 4) |> is_identical_to_previous()
+#' mtcars[c(1, 1, 2, 3, 3, 2, 4, 4)] |> is_identical_to_previous()
+#' list(1, 1, list(2), "A", "a", "a") |> is_identical_to_previous()
+is_identical_to_previous <- function(data, no.name = TRUE) {
+  if (is.data.frame(data)) {
+    lagged <- data.frame(FALSE, data[seq_len(length(data) - 1)])
+  } else {
+    lagged <- c(FALSE, data[seq_len(length(data) - 1)])
+  }
+
+  vapply(seq_len(length(data)), \(.x){
+    if (isTRUE(no.name)) {
+      identical(unname(lagged[.x]), unname(data[.x]))
+    } else {
+      identical(lagged[.x], data[.x])
+    }
+  }, FUN.VALUE = logical(1))
+}

R/plot_box.R

@@ -39,6 +39,7 @@ plot_box <- function(data, pri, sec, ter = NULL) {
 #' @export
 #'
 #' @examples
+#' mtcars |> plot_box_single("mpg")
 #' mtcars |> plot_box_single("mpg","cyl")
 plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
   set.seed(seed)

R/regression_model.R

@@ -279,11 +279,11 @@ data_type <- function(data) {
       if (identical("logical", cl_d) | length(unique(data)) == 2) {
         out <- "dichotomous"
       } else {
-        if (is.ordered(data)) {
+        # if (is.ordered(data)) {
-          out <- "ordinal"
+        #   out <- "ordinal"
-        } else {
+        # } else {
           out <- "categorical"
-        }
+        # }
       }
     } else if (identical(cl_d, "character")) {
       out <- "text"
@@ -310,7 +310,16 @@ data_type <- function(data) {
 #' @examples
 #' data_types()
 data_types <- function() {
-  c("dichotomous", "ordinal", "categorical", "datatime", "continuous", "text", "empty", "monotone", "unknown")
+  list(
+    "empty" = list(descr="Variable of all NAs",classes="Any class"),
+    "monotone" = list(descr="Variable with only one unique value",classes="Any class"),
+    "dichotomous" = list(descr="Variable with only two unique values",classes="Any class"),
+    "categorical"= list(descr="Factor variable",classes="factor (ordered or unordered)"),
+    "text"= list(descr="Character variable",classes="character"),
+    "datetime"= list(descr="Variable of time, date or datetime values",classes="hms, Date, POSIXct and POSIXt"),
+    "continuous"= list(descr="Numeric variable",classes="numeric, integer or double"),
+    "unknown"= list(descr="Anything not falling within the previous",classes="Any other class")
+    )
 }
 
 
@@ -351,7 +360,7 @@ supported_functions <- function() {
     polr = list(
       descr = "Ordinal logistic regression model",
       design = "cross-sectional",
-      out.type = c("ordinal", "categorical"),
+      out.type = c("categorical"),
       fun = "MASS::polr",
       args.list = list(
         Hess = TRUE,

README.md

@@ -38,3 +38,13 @@ launch_FreesearchR()
 ## Code of Conduct
 
 Please note that the ***FreesearchR*** project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms.
+
+## Acknowledgements
+
+Like any other project, this project was never possible without the great work of others. These are some of the sources and packages I have used:
+
+-   The ***FreesearchR*** app is build with [Shiny](https://shiny.posit.co/) and based on (*R*)[https://www.r-project.org/].
+
+-   [gtsummary](https://www.danieldsjoberg.com/gtsummary/): superb and flexible way to create publication-ready analytical and summary tables.
+
+-   [dreamRs](https://github.com/dreamRs): maintainers of a broad selection of great extensions and tools for [Shiny](https://shiny.posit.co/).

ROADMAP.md

@@ -1,55 +1,47 @@
 # Project roadmap
 
-The current state of the app is considered experimental, and a lot of things are still changing. It is, however, in a usable state, with basic functions available to the user.
+The current state of the app is considered experimental, however, from version 25.4.2, the ***FreesearchR*** app is considered functional and can be used for data evaluation and analyses.
 
-Below are some (the actual list is quite long and growing) of the planned features and improvements:
+Below are some (the actual list is quite long and growing) of the planned new features and improvements:
 
--   Additional study designs in regression models (expansion of the regression analysis functionality have been put on hold for now to focus on the more basic use-cases):
+### Implementation in real world clinical studies and projects
 
-    -   [x] Cross-sectional data analyses
+This really is the main goal of the whole project.
 
-    -   [ ] Longitudinal data analyses
+### New features:
 
-    -   [ ] Survival analysis
+-   [ ] Merge data from multiple sources (you can merge sheets from a workbook (xls or ods), but this would allow merging several files and/or REDcap data)
 
-    -   [ ] Stratified analyses
+-   [ ] Additional plot types (bar plots, *others...*)
 
--   More detailed variable browser
+-   [ ] Missingness analysis panel
 
-    -   [x] Add histograms for data distribution. 2025-01-16
+### Expanded options for regression models:
 
-    -   [x] Option to edit labels. 2025-01-16
+Expansion of the regression analysis functionality have been put on hold for now to focus on the more basic use-cases):
 
--   More output controls
+More study designs
 
-    -   [x] ~~Theming output tables~~ The "JAMA" theme is the new standard.
+-   [x] Cross-sectional data analyses
 
-    -   [x] ~~Select analyses to include in report.~~ Includes characteristics table and regression table if present. No other analyses are intended for the report as of now.
+-   [ ] Longitudinal data analyses
 
--   [x] Export modified data. 2025-01-16
+-   [ ] Survival analysis
 
--   [x] Include reproducible code for all steps (maybe not all, but most steps, and the final dataset can be exported) 2025-04-10
+Other regression models
 
--   [x] ~~Modify factor levels~~ Factor level modifications is possible through converting factors to numeric > cutting numeric with desired fixed values. 2024-12-12
+-   [ ] Stratified analyses
     
--   [x] More options for date/datetime/time grouping/factoring. Included weekday and month-only options. 2024-12-12
+-   [ ] Mixed models of repeated measures
     
--   Graphs and plots
+-   [ ] Cox regression analyses
 
-    - [x] Correlation matrix plot for data exploration 2025-2-20
+Data handling
 
-    - [x] Grotta bars for ordianl outcomes (and sankey) 2025-3-17
+-   [ ] Transforming data (transpose and pivoting)
 
-    - [x] Coefficient plotting for regression analyses (forest plot) 2025-2-20
+### Improved documentation:
 
-Documentation:
+-   [ ] Video walk-through of central functions
 
--   [ ] Complete getting started page describing all functionality.
 
--   [ ] Streamlined functions documentation
-
-New features:
-
--   [ ] Merge data from multiple sources (this would in itself be a great feature, but not of highest importance)
-
--   [ ] Additional plot types (missingness, *others...*)

_pkgdown.yml

@@ -13,8 +13,8 @@ template:
 navbar:
   bg: primary
   structure:
-    left:  [intro, reference, roadmap, q_a, news]
+    left:  [intro, reference, articles, roadmap, q_a, news]
-    right: [search, github]
+    right: [search, github, lightswitch]
   components:
     roadmap:
       text: Roadmap

inst/apps/FreesearchR/app.R

@@ -10,7 +10,7 @@
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'Version: 25.4.3.250415_1627'
+app_version <- function()'Version: 25.4.3.250422'
 
 
 ########
@@ -1514,7 +1514,7 @@ all_but <- function(data, ...) {
 #'
 #' @examples
 #' default_parsing(mtcars) |> subset_types("ordinal")
-#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
 #' #' default_parsing(mtcars) |> subset_types("factor",class)
 subset_types <- function(data, types, type.fun = data_type) {
   data[sapply(data, type.fun) %in% types]
@@ -1549,58 +1549,58 @@ supported_plots <- function() {
       fun = "plot_hbars",
       descr = "Stacked horizontal bars",
       note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = "none"
     ),
     plot_violin = list(
       fun = "plot_violin",
       descr = "Violin plot",
       note = "A modern alternative to the classic boxplot to visualise data distribution",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
       secondary.extra = "none",
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "categorical")
     ),
     # plot_ridge = list(
     #   descr = "Ridge plot",
     #   note = "An alternative option to visualise data distribution",
     #   primary.type = "continuous",
-    #   secondary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   secondary.type = c("dichotomous" ,"categorical"),
-    #   tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   tertiary.type = c("dichotomous" ,"categorical"),
     #   secondary.extra = NULL
     # ),
     plot_sankey = list(
       fun = "plot_sankey",
       descr = "Sankey plot",
       note = "A way of visualising change between groups",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
       secondary.extra = NULL,
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "categorical")
     ),
     plot_scatter = list(
       fun = "plot_scatter",
       descr = "Scatter plot",
       note = "A classic way of showing the association between to variables",
       primary.type = c("datatime", "continuous"),
-      secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
+      secondary.type = c("datatime", "continuous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       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("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = "none"
     ),
     plot_euler = list(
@@ -1611,7 +1611,7 @@ supported_plots <- function() {
       secondary.type = "dichotomous",
       secondary.multi = TRUE,
       secondary.max = 4,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "categorical"),
       secondary.extra = NULL
     )
   )
@@ -2197,8 +2197,8 @@ overview_vars <- function(data) {
   data <- as.data.frame(data)
 
   dplyr::tibble(
-    icon = data_type(data),
+    icon = get_classes(data),
-    type = icon,
+    class = icon,
     name = names(data),
     n_missing = unname(colSums(is.na(data))),
     p_complete = 1 - n_missing / nrow(data),
@@ -2231,6 +2231,7 @@ create_overview_datagrid <- function(data,...) {
   std_names <- c(
     "Name" = "name",
     "Icon" = "icon",
+    "Class" = "class",
     "Type" = "type",
     "Missings" = "n_missing",
     "Complete" = "p_complete",
@@ -2277,7 +2278,7 @@ create_overview_datagrid <- function(data,...) {
   grid <- add_class_icon(
     grid = grid,
     column = "icon",
-    fun = type_icons
+    fun = class_icons
   )
 
   grid <- toastui::grid_format(
@@ -2339,15 +2340,15 @@ add_class_icon <- function(grid, column = "class", fun=class_icons) {
 #'
 #' @param x character vector of data classes
 #'
-#' @returns
+#' @returns list
 #' @export
 #'
 #' @examples
-#' "numeric" |> class_icons()
+#' "numeric" |> class_icons()|> str()
-#' default_parsing(mtcars) |> sapply(class) |> class_icons()
+#' mtcars |> sapply(class) |> class_icons() |> str()
 class_icons <- function(x) {
   if (length(x)>1){
-    sapply(x,class_icons)
+    lapply(x,class_icons)
   } else {
   if (identical(x, "numeric")) {
     shiny::icon("calculator")
@@ -2372,7 +2373,7 @@ class_icons <- function(x) {
 #'
 #' @param x character vector of data classes
 #'
-#' @returns
+#' @returns list
 #' @export
 #'
 #' @examples
@@ -2380,7 +2381,7 @@ class_icons <- function(x) {
 #' default_parsing(mtcars) |> sapply(data_type) |> type_icons()
 type_icons <- function(x) {
   if (length(x)>1){
-    sapply(x,class_icons)
+    lapply(x,class_icons)
   } else {
     if (identical(x, "continuous")) {
       shiny::icon("calculator")
@@ -2538,7 +2539,7 @@ argsstring2list <- function(string) {
 #' @export
 #'
 #' @examples
-#' factorize(mtcars,names(mtcars))
+#' factorize(mtcars, names(mtcars))
 factorize <- function(data, vars) {
   if (!is.null(vars)) {
     data |>
@@ -2667,19 +2668,25 @@ default_parsing <- function(data) {
 #' @export
 #'
 #' @examples
-#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> dplyr::bind_cols()
+#' ds <- mtcars |>
+#'   lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+#'   dplyr::bind_cols()
 #' ds |>
 #'   remove_empty_attr() |>
 #'   str()
-#'  mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> remove_empty_attr() |>
+#' mtcars |>
+#'   lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+#'   remove_empty_attr() |>
 #'   str()
 #'
 remove_empty_attr <- function(data) {
-  if (is.data.frame(data)){
+  if (is.data.frame(data)) {
-    data |> lapply(remove_empty_attr) |> dplyr::bind_cols()
+    data |>
-  } else if (is.list(data)){
+      lapply(remove_empty_attr) |>
+      dplyr::bind_cols()
+  } else if (is.list(data)) {
     data |> lapply(remove_empty_attr)
-  }else{
+  } else {
     attributes(data)[is.na(attributes(data))] <- NULL
     data
   }
@@ -2796,7 +2803,7 @@ data_description <- function(data, data_text = "Data") {
 #' }
 data_type_filter <- function(data, type) {
   ## Please ensure to only provide recognised data types
-  assertthat::assert_that(all(type %in% data_types()))
+  assertthat::assert_that(all(type %in% names(data_types())))
 
   if (!is.null(type)) {
     out <- data[data_type(data) %in% type]
@@ -3027,6 +3034,36 @@ append_column <- function(data, column, name, index = "right") {
 }
 
 
+
+#' Test if element is identical to the previous
+#'
+#' @param data data. vector, data.frame or list
+#' @param no.name logical to remove names attribute before testing
+#'
+#' @returns logical vector
+#' @export
+#'
+#' @examples
+#' c(1, 1, 2, 3, 3, 2, 4, 4) |> is_identical_to_previous()
+#' mtcars[c(1, 1, 2, 3, 3, 2, 4, 4)] |> is_identical_to_previous()
+#' list(1, 1, list(2), "A", "a", "a") |> is_identical_to_previous()
+is_identical_to_previous <- function(data, no.name = TRUE) {
+  if (is.data.frame(data)) {
+    lagged <- data.frame(FALSE, data[seq_len(length(data) - 1)])
+  } else {
+    lagged <- c(FALSE, data[seq_len(length(data) - 1)])
+  }
+
+  vapply(seq_len(length(data)), \(.x){
+    if (isTRUE(no.name)) {
+      identical(unname(lagged[.x]), unname(data[.x]))
+    } else {
+      identical(lagged[.x], data[.x])
+    }
+  }, FUN.VALUE = logical(1))
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R 
 ########
@@ -5317,11 +5354,11 @@ data_type <- function(data) {
       if (identical("logical", cl_d) | length(unique(data)) == 2) {
         out <- "dichotomous"
       } else {
-        if (is.ordered(data)) {
+        # if (is.ordered(data)) {
-          out <- "ordinal"
+        #   out <- "ordinal"
-        } else {
+        # } else {
           out <- "categorical"
-        }
+        # }
       }
     } else if (identical(cl_d, "character")) {
       out <- "text"
@@ -5348,7 +5385,16 @@ data_type <- function(data) {
 #' @examples
 #' data_types()
 data_types <- function() {
-  c("dichotomous", "ordinal", "categorical", "datatime", "continuous", "text", "empty", "monotone", "unknown")
+  list(
+    "empty" = list(descr="Variable of all NAs",classes="Any class"),
+    "monotone" = list(descr="Variable with only one unique value",classes="Any class"),
+    "dichotomous" = list(descr="Variable with only two unique values",classes="Any class"),
+    "categorical"= list(descr="Factor variable",classes="factor (ordered or unordered)"),
+    "text"= list(descr="Character variable",classes="character"),
+    "datetime"= list(descr="Variable of time, date or datetime values",classes="hms, Date, POSIXct and POSIXt"),
+    "continuous"= list(descr="Numeric variable",classes="numeric, integer or double"),
+    "unknown"= list(descr="Anything not falling within the previous",classes="Any other class")
+    )
 }
 
 
@@ -5389,7 +5435,7 @@ supported_functions <- function() {
     polr = list(
       descr = "Ordinal logistic regression model",
       design = "cross-sectional",
-      out.type = c("ordinal", "categorical"),
+      out.type = c("categorical"),
       fun = "MASS::polr",
       args.list = list(
         Hess = TRUE,
@@ -8191,6 +8237,8 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
 
 # ns <- NS(id)
 
+
+
 ui_elements <- list(
   ##############################################################################
   #########
@@ -8349,7 +8397,12 @@ ui_elements <- list(
               shiny::tags$br(),
               shiny::tags$br(),
               shiny::uiOutput(outputId = "column_filter"),
-              shiny::helpText("Variable data type filtering."),
+              shiny::helpText("Variable ", tags$a(
+                "data type",
+                href = "https://agdamsbo.github.io/FreesearchR/articles/FreesearchR.html",
+                target = "_blank",
+                rel = "noopener noreferrer"
+              ), " filtering."),
               shiny::tags$br(),
               shiny::tags$br(),
               IDEAFilter::IDEAFilter_ui("data_filter"),
@@ -9219,7 +9272,13 @@ server <- function(input, output, session) {
   output$code_data <- shiny::renderUI({
     shiny::req(rv$code$modify)
     # browser()
-    ls <- rv$code$modify |> unique()
+    ## This will create three lines for each modification
+    # ls <- rv$code$modify
+    ## This will remove all non-unique entries
+    # ls <- rv$code$modify |> unique()
+    ## This will only remove all non-repeating entries
+    ls <- rv$code$modify[!is_identical_to_previous(rv$code$modify)]
+
     out <- ls |>
       lapply(expression_string) |>
       pipe_string() |>

inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 13611288
-bundleId: 10119038
+bundleId: 10156735
 url: https://agdamsbo.shinyapps.io/freesearcheR/
 version: 1

inst/apps/FreesearchR/server.R

@@ -481,7 +481,13 @@ server <- function(input, output, session) {
   output$code_data <- shiny::renderUI({
     shiny::req(rv$code$modify)
     # browser()
-    ls <- rv$code$modify |> unique()
+    ## This will create three lines for each modification
+    # ls <- rv$code$modify
+    ## This will remove all non-unique entries
+    # ls <- rv$code$modify |> unique()
+    ## This will only remove all non-repeating entries
+    ls <- rv$code$modify[!is_identical_to_previous(rv$code$modify)]
+
     out <- ls |>
       lapply(expression_string) |>
       pipe_string() |>

inst/apps/FreesearchR/ui.R

@@ -1,5 +1,7 @@
 # ns <- NS(id)
 
+
+
 ui_elements <- list(
   ##############################################################################
   #########
@@ -158,7 +160,12 @@ ui_elements <- list(
               shiny::tags$br(),
               shiny::tags$br(),
               shiny::uiOutput(outputId = "column_filter"),
-              shiny::helpText("Variable data type filtering."),
+              shiny::helpText("Variable ", tags$a(
+                "data type",
+                href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
+                target = "_blank",
+                rel = "noopener noreferrer"
+              ), " filtering."),
               shiny::tags$br(),
               shiny::tags$br(),
               IDEAFilter::IDEAFilter_ui("data_filter"),

man/factorize.Rd

@@ -18,5 +18,5 @@ data.frame
 Factorize variables in data.frame
 }
 \examples{
-factorize(mtcars,names(mtcars))
+factorize(mtcars, names(mtcars))
 }

man/is_identical_to_previous.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{is_identical_to_previous}
+\alias{is_identical_to_previous}
+\title{Test if element is identical to the previous}
+\usage{
+is_identical_to_previous(data, no.name = TRUE)
+}
+\arguments{
+\item{data}{data. vector, data.frame or list}
+
+\item{no.name}{logical to remove names attribute before testing}
+}
+\value{
+logical vector
+}
+\description{
+Test if element is identical to the previous
+}
+\examples{
+c(1, 1, 2, 3, 3, 2, 4, 4) |> is_identical_to_previous()
+mtcars[c(1, 1, 2, 3, 3, 2, 4, 4)] |> is_identical_to_previous()
+list(1, 1, list(2), "A", "a", "a") |> is_identical_to_previous()
+}

man/remove_empty_attr.Rd

@@ -16,11 +16,15 @@ data of same class as input
 Remove empty/NA attributes
 }
 \examples{
-ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> dplyr::bind_cols()
+ds <- mtcars |>
+  lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+  dplyr::bind_cols()
 ds |>
   remove_empty_attr() |>
   str()
- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> remove_empty_attr() |>
+mtcars |>
+  lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |>
+  remove_empty_attr() |>
   str()
 
 }

man/subset_types.Rd

@@ -21,6 +21,6 @@ Easily subset by data type function
 }
 \examples{
 default_parsing(mtcars) |> subset_types("ordinal")
-default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
 #' default_parsing(mtcars) |> subset_types("factor",class)
 }

vignettes/FreesearchR.Rmd

@@ -61,6 +61,22 @@ This will unfold options to preview your data dictionary (the main database meta
 
 When opening the online hosted app, this is mainly for testing purposes. When running the app locally from *R* on your own computer, you will find all data.frames in the current environment here. This extends the possible uses of this app to allow for quick and easy data insights and code generation for basic plotting to fine tune.
 
+## Data
+
+This is the panel to get a good overview of your data, check data is classed and formatted correctly, perform simple modifications and filter data. 
+
+### Summary
+
+Here, the data variables can be inspected with a simple visualisation and a few key measures. Also, data filtering is available at two levels: 
+
+   - Data type filtering allows to filter by variable [data type]()
+   
+   - Observations level filtering allow to filter data by variable
+
+### Modify
+
+
+
 ## Evaluate
 
 This panel allows for basic data evaluation.
@@ -80,7 +96,7 @@ There are a number of plotting options to visualise different aspects of the dat
 Below are the available plot types listed.
 
 ```{r echo = FALSE, eval = TRUE}
-c("continuous", "dichotomous", "ordinal", "categorical") |> 
+c("continuous", "dichotomous", "categorical") |> 
   lapply(\(.x){
     dplyr::bind_cols(
       dplyr::tibble("Data type"=.x),
@@ -106,6 +122,27 @@ Also copy the code to generate the plot in your own R-environment and fine tune
 
 This section is only intended for very simple explorative analyses and as a proof-of-concept for now. If you are doing complex regression analyses you should probably just write the code yourself.
 
+Below are the available regression types listed.
+
+```{r echo = FALSE, eval = TRUE}
+c("continuous", "dichotomous", "categorical") |> 
+  lapply(\(.x){
+    dplyr::bind_cols(
+      dplyr::tibble("Data type"=.x),
+      supported_functions()|> 
+      lapply(\(.y){
+        if (.x %in% .y$out.type){
+          .y[c("descr","fun","design")]|> dplyr::bind_cols()
+        }
+})|> 
+  dplyr::bind_rows() |> 
+  setNames(c("Regression model","Function","Study design")))
+  }) |> 
+  dplyr::bind_rows() |> 
+  # toastui::datagrid(filters=TRUE,theme="striped") |> 
+  kableExtra::kable()
+```
+
 ### Table
 
 Generate simple regression models and get the results in a nice table. This will also be included in the exported report.

vignettes/data-types.Rmd

@@ -0,0 +1,33 @@
+---
+title: "Data types"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{data-types}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+```{r setup}
+library(FreesearchR)
+```
+
+## A clinical data class
+
+Traditionally in *R*, data is identified by classes, like numeric, integer, double, logical, factor etc. These classes can be a little confusing from a clinical or operational standpoint. In the ***FreesearchR*** app, these classes has been simplified and modified to the following data types, that are assigned on a prioritised order like the following:
+
+```{r echo = FALSE, eval = TRUE}
+data_types() |> purrr::imap(\(.x,.i){
+  dplyr::bind_cols("type"=.i,.x,.name_repair = "unique_quiet")
+  }) |> dplyr::bind_rows() |> 
+  setNames(c("Data type","Description","Data classes included")) |> 
+  kableExtra::kable()
+```
+
+Categorising data in this way makes sense when making choices on how to evaluate and analyse data. This is used throughout the ***FreesearchR*** app to simplify data handling.