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),
-    type = icon,
+    icon = get_classes(data),
+    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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "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"),
-    #   tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   secondary.type = c("dichotomous" ,"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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "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

@@ -258,16 +258,22 @@ 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)) {
-    data |> lapply(remove_empty_attr) |> dplyr::bind_cols()
+    data |>
+      lapply(remove_empty_attr) |>
+      dplyr::bind_cols()
   } else if (is.list(data)) {
     data |> lapply(remove_empty_attr)
   } else {
@@ -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)) {
-          out <- "ordinal"
-        } else {
+        # if (is.ordered(data)) {
+        #   out <- "ordinal"
+        # } 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,10 +1,26 @@
 # 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
+
+This really is the main goal of the whole project.
+
+### New features:
+
+-   [ ] 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)
+
+-   [ ] Additional plot types (bar plots, *others...*)
+
+-   [ ] Missingness analysis panel
+
+### Expanded options for regression models:
+
+Expansion of the regression analysis functionality have been put on hold for now to focus on the more basic use-cases):
+
+More study designs
 
 -   [x] Cross-sectional data analyses
 
@@ -12,44 +28,20 @@ Below are some (the actual list is quite long and growing) of the planned featur
 
 -   [ ] Survival analysis
 
+Other regression models
+
 -   [ ] Stratified analyses
     
--   More detailed variable browser
+-   [ ] Mixed models of repeated measures
     
-    -   [x] Add histograms for data distribution. 2025-01-16
+-   [ ] Cox regression analyses
 
-    -   [x] Option to edit labels. 2025-01-16
+Data handling
 
--   More output controls
+-   [ ] Transforming data (transpose and pivoting)
 
-    -   [x] ~~Theming output tables~~ The "JAMA" theme is the new standard.
+### Improved documentation:
 
-    -   [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.
+-   [ ] Video walk-through of central functions
 
--   [x] Export modified data. 2025-01-16
 
--   [x] Include reproducible code for all steps (maybe not all, but most steps, and the final dataset can be exported) 2025-04-10
-
--   [x] ~~Modify factor levels~~ Factor level modifications is possible through converting factors to numeric > cutting numeric with desired fixed values. 2024-12-12
-
--   [x] More options for date/datetime/time grouping/factoring. Included weekday and month-only options. 2024-12-12
-
--   Graphs and plots
-
-    - [x] Correlation matrix plot for data exploration 2025-2-20
-    
-    - [x] Grotta bars for ordianl outcomes (and sankey) 2025-3-17
-    
-    - [x] Coefficient plotting for regression analyses (forest plot) 2025-2-20
-
-Documentation:
-
--   [ ] 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]
-    right: [search, github]
+    left:  [intro, reference, articles, roadmap, q_a, news]
+    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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "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"),
-    #   tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
+    #   secondary.type = c("dichotomous" ,"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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "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"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime", "continuous", "dichotomous", "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),
-    type = icon,
+    icon = get_classes(data),
+    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()
-#' default_parsing(mtcars) |> sapply(class) |> class_icons()
+#' "numeric" |> class_icons()|> str()
+#' 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")
@@ -2667,16 +2668,22 @@ 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)) {
-    data |> lapply(remove_empty_attr) |> dplyr::bind_cols()
+    data |>
+      lapply(remove_empty_attr) |>
+      dplyr::bind_cols()
   } else if (is.list(data)) {
     data |> lapply(remove_empty_attr)
   } else {
@@ -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)) {
-          out <- "ordinal"
-        } else {
+        # if (is.ordered(data)) {
+        #   out <- "ordinal"
+        # } 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/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.