From 07e94f4401330ac3da2dff7b9bf76cdf826c8415 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 22 Apr 2025 09:58:18 +0200 Subject: [PATCH 1/4] new docs --- ROADMAP.md | 72 +++++++++++++++++---------------------- vignettes/FreesearchR.Rmd | 33 +++++++++++++++++- vignettes/data-types.Rmd | 33 ++++++++++++++++++ 3 files changed, 97 insertions(+), 41 deletions(-) create mode 100644 vignettes/data-types.Rmd diff --git a/ROADMAP.md b/ROADMAP.md index 0e3be81c..8bad3ea0 100644 --- a/ROADMAP.md +++ b/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) + +- [ ] 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 + +- [ ] Longitudinal data analyses + +- [ ] Survival analysis + +Other regression models + +- [ ] Stratified analyses - - [ ] Stratified analyses - -- More detailed variable browser - - - [x] Add histograms for data distribution. 2025-01-16 - - - [x] Option to edit labels. 2025-01-16 +- [ ] Mixed models of repeated measures -- More output controls +- [ ] Cox regression analyses - - [x] ~~Theming output tables~~ The "JAMA" theme is the new standard. +Data handling - - [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. +- [ ] Transforming data (transpose and pivoting) -- [x] Export modified data. 2025-01-16 +### Improved documentation: -- [x] Include reproducible code for all steps (maybe not all, but most steps, and the final dataset can be exported) 2025-04-10 +- [ ] Video walk-through of central functions -- [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...*) diff --git a/vignettes/FreesearchR.Rmd b/vignettes/FreesearchR.Rmd index 29d07d80..21ff9f0b 100644 --- a/vignettes/FreesearchR.Rmd +++ b/vignettes/FreesearchR.Rmd @@ -61,6 +61,16 @@ 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 + +### Modify + + + ## Evaluate This panel allows for basic data evaluation. @@ -80,7 +90,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 +116,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. diff --git a/vignettes/data-types.Rmd b/vignettes/data-types.Rmd new file mode 100644 index 00000000..c7852cfc --- /dev/null +++ b/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. From aaceb55fe80b9310824ad4df9eb5f8549ea34c27 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 22 Apr 2025 09:58:34 +0200 Subject: [PATCH 2/4] revised data types --- R/app_version.R | 2 +- R/data-summary.R | 7 +++--- R/data_plots.R | 36 ++++++++++++++-------------- R/helpers.R | 56 ++++++++++++++++++++++++++++++++++++-------- R/regression_model.R | 21 ++++++++++++----- 5 files changed, 84 insertions(+), 38 deletions(-) diff --git a/R/app_version.R b/R/app_version.R index e562fc16..d49df0c2 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'Version: 25.4.3.250415_1627' +app_version <- function()'Version: 25.4.3.250422' diff --git a/R/data-summary.R b/R/data-summary.R index e70eb507..f0e6be3f 100644 --- a/R/data-summary.R +++ b/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( diff --git a/R/data_plots.R b/R/data_plots.R index 783a8d4c..55856ca4 100644 --- a/R/data_plots.R +++ b/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 ) ) diff --git a/R/helpers.R b/R/helpers.R index d906c766..aed6b820 100644 --- a/R/helpers.R +++ b/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,21 +258,27 @@ 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() - } else if (is.list(data)){ + if (is.data.frame(data)) { + data |> + lapply(remove_empty_attr) |> + dplyr::bind_cols() + } else if (is.list(data)) { data |> lapply(remove_empty_attr) - }else{ - attributes(data)[is.na(attributes(data))] <- NULL - data + } 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)) +} diff --git a/R/regression_model.R b/R/regression_model.R index 4ad0d599..252cbf16 100644 --- a/R/regression_model.R +++ b/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, From b1c44a75efc8ddf7968e0e19c340be967835b6d5 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 22 Apr 2025 10:02:12 +0200 Subject: [PATCH 3/4] updated ui --- inst/apps/FreesearchR/app.R | 153 +++++++++++++++++++++++---------- inst/apps/FreesearchR/server.R | 8 +- inst/apps/FreesearchR/ui.R | 11 ++- 3 files changed, 122 insertions(+), 50 deletions(-) diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 79bc3f7b..293ccdc1 100644 --- a/inst/apps/FreesearchR/app.R +++ b/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") @@ -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,21 +2668,27 @@ 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() - } else if (is.list(data)){ + if (is.data.frame(data)) { + data |> + lapply(remove_empty_attr) |> + dplyr::bind_cols() + } else if (is.list(data)) { data |> lapply(remove_empty_attr) - }else{ - attributes(data)[is.na(attributes(data))] <- NULL - data + } 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)) { - 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"), @@ -8464,7 +8517,7 @@ ui_elements <- list( bslib::navset_bar( title = "", sidebar = bslib::sidebar( - shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE), + shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE), bslib::accordion( open = "acc_chars", multiple = FALSE, @@ -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() |> diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index 40a5f51c..9403d69b 100644 --- a/inst/apps/FreesearchR/server.R +++ b/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() |> diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 617688fc..2b74c8fb 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/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/FreesearchR.html", + target = "_blank", + rel = "noopener noreferrer" + ), " filtering."), shiny::tags$br(), shiny::tags$br(), IDEAFilter::IDEAFilter_ui("data_filter"), @@ -273,7 +280,7 @@ ui_elements <- list( bslib::navset_bar( title = "", sidebar = bslib::sidebar( - shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE), + shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE), bslib::accordion( open = "acc_chars", multiple = FALSE, From 2249ba06db3e192963d214cd48fc412d9b99269f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 22 Apr 2025 13:57:59 +0200 Subject: [PATCH 4/4] more docs --- NAMESPACE | 1 + R/plot_box.R | 1 + README.md | 10 ++++++++ _pkgdown.yml | 4 ++-- .../shinyapps.io/agdamsbo/freesearcheR.dcf | 2 +- inst/apps/FreesearchR/ui.R | 2 +- man/factorize.Rd | 2 +- man/is_identical_to_previous.Rd | 24 +++++++++++++++++++ man/remove_empty_attr.Rd | 8 +++++-- man/subset_types.Rd | 2 +- vignettes/FreesearchR.Rmd | 6 +++++ 11 files changed, 54 insertions(+), 8 deletions(-) create mode 100644 man/is_identical_to_previous.Rd diff --git a/NAMESPACE b/NAMESPACE index 26d42927..f644c440 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/plot_box.R b/R/plot_box.R index 45b48860..5a830d14 100644 --- a/R/plot_box.R +++ b/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) diff --git a/README.md b/README.md index ffa716b3..1711fb3e 100644 --- a/README.md +++ b/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/). diff --git a/_pkgdown.yml b/_pkgdown.yml index bc78e979..2f3350af 100644 --- a/_pkgdown.yml +++ b/_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 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index 464b7ee6..7ea291b9 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/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 diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 2b74c8fb..6fb9b0da 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -162,7 +162,7 @@ ui_elements <- list( shiny::uiOutput(outputId = "column_filter"), shiny::helpText("Variable ", tags$a( "data type", - href = "https://agdamsbo.github.io/FreesearchR/articles/FreesearchR.html", + href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html", target = "_blank", rel = "noopener noreferrer" ), " filtering."), diff --git a/man/factorize.Rd b/man/factorize.Rd index 1ad79ca3..e09eb700 100644 --- a/man/factorize.Rd +++ b/man/factorize.Rd @@ -18,5 +18,5 @@ data.frame Factorize variables in data.frame } \examples{ -factorize(mtcars,names(mtcars)) +factorize(mtcars, names(mtcars)) } diff --git a/man/is_identical_to_previous.Rd b/man/is_identical_to_previous.Rd new file mode 100644 index 00000000..73e4bdf8 --- /dev/null +++ b/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() +} diff --git a/man/remove_empty_attr.Rd b/man/remove_empty_attr.Rd index 68155680..412c36d8 100644 --- a/man/remove_empty_attr.Rd +++ b/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() } diff --git a/man/subset_types.Rd b/man/subset_types.Rd index c1a7ef9a..61fced5e 100644 --- a/man/subset_types.Rd +++ b/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) } diff --git a/vignettes/FreesearchR.Rmd b/vignettes/FreesearchR.Rmd index 21ff9f0b..80ee9fd2 100644 --- a/vignettes/FreesearchR.Rmd +++ b/vignettes/FreesearchR.Rmd @@ -67,6 +67,12 @@ This is the panel to get a good overview of your data, check data is classed and ### 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