mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
Compare commits
No commits in common. "2249ba06db3e192963d214cd48fc412d9b99269f" and "2065c9c8005792cd472dc0095406805bf3473993" have entirely different histories.
2249ba06db
...
2065c9c800
20 changed files with 136 additions and 356 deletions
|
|
@ -61,7 +61,6 @@ 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)
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'Version: 25.4.3.250422'
|
||||
app_version <- function()'Version: 25.4.3.250415_1627'
|
||||
|
|
|
|||
|
|
@ -155,8 +155,8 @@ overview_vars <- function(data) {
|
|||
data <- as.data.frame(data)
|
||||
|
||||
dplyr::tibble(
|
||||
icon = get_classes(data),
|
||||
class = icon,
|
||||
icon = data_type(data),
|
||||
type = icon,
|
||||
name = names(data),
|
||||
n_missing = unname(colSums(is.na(data))),
|
||||
p_complete = 1 - n_missing / nrow(data),
|
||||
|
|
@ -189,7 +189,6 @@ create_overview_datagrid <- function(data,...) {
|
|||
std_names <- c(
|
||||
"Name" = "name",
|
||||
"Icon" = "icon",
|
||||
"Class" = "class",
|
||||
"Type" = "type",
|
||||
"Missings" = "n_missing",
|
||||
"Complete" = "p_complete",
|
||||
|
|
@ -236,7 +235,7 @@ create_overview_datagrid <- function(data,...) {
|
|||
grid <- add_class_icon(
|
||||
grid = grid,
|
||||
column = "icon",
|
||||
fun = class_icons
|
||||
fun = type_icons
|
||||
)
|
||||
|
||||
grid <- toastui::grid_format(
|
||||
|
|
|
|||
|
|
@ -408,7 +408,7 @@ all_but <- function(data, ...) {
|
|||
#'
|
||||
#' @examples
|
||||
#' default_parsing(mtcars) |> subset_types("ordinal")
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = "none",
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
tertiary.type = c("dichotomous", "ordinal", "categorical")
|
||||
),
|
||||
# plot_ridge = list(
|
||||
# descr = "Ridge plot",
|
||||
# note = "An alternative option to visualise data distribution",
|
||||
# primary.type = "continuous",
|
||||
# secondary.type = c("dichotomous" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous" ,"categorical"),
|
||||
# secondary.type = c("dichotomous", "ordinal" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous", "ordinal" ,"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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.extra = NULL
|
||||
)
|
||||
)
|
||||
|
|
|
|||
56
R/helpers.R
56
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,27 +258,21 @@ 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
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -393,7 +387,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% names(data_types())))
|
||||
assertthat::assert_that(all(type %in% data_types()))
|
||||
|
||||
if (!is.null(type)) {
|
||||
out <- data[data_type(data) %in% type]
|
||||
|
|
@ -622,33 +616,3 @@ 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))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -39,7 +39,6 @@ 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)
|
||||
|
|
|
|||
|
|
@ -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,16 +310,7 @@ data_type <- function(data) {
|
|||
#' @examples
|
||||
#' data_types()
|
||||
data_types <- function() {
|
||||
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")
|
||||
)
|
||||
c("dichotomous", "ordinal", "categorical", "datatime", "continuous", "text", "empty", "monotone", "unknown")
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -360,7 +351,7 @@ supported_functions <- function() {
|
|||
polr = list(
|
||||
descr = "Ordinal logistic regression model",
|
||||
design = "cross-sectional",
|
||||
out.type = c("categorical"),
|
||||
out.type = c("ordinal", "categorical"),
|
||||
fun = "MASS::polr",
|
||||
args.list = list(
|
||||
Hess = TRUE,
|
||||
|
|
|
|||
10
README.md
10
README.md
|
|
@ -38,13 +38,3 @@ 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/).
|
||||
|
|
|
|||
72
ROADMAP.md
72
ROADMAP.md
|
|
@ -1,47 +1,55 @@
|
|||
# Project roadmap
|
||||
|
||||
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.
|
||||
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.
|
||||
|
||||
Below are some (the actual list is quite long and growing) of the planned new features and improvements:
|
||||
Below are some (the actual list is quite long and growing) of the planned features and improvements:
|
||||
|
||||
### Implementation in real world clinical studies and projects
|
||||
- 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):
|
||||
|
||||
This really is the main goal of the whole project.
|
||||
- [x] Cross-sectional data analyses
|
||||
|
||||
### New features:
|
||||
- [ ] Longitudinal data analyses
|
||||
|
||||
- [ ] 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
|
||||
- [ ] Survival analysis
|
||||
|
||||
- [ ] Mixed models of repeated measures
|
||||
- [ ] Stratified analyses
|
||||
|
||||
- More detailed variable browser
|
||||
|
||||
- [x] Add histograms for data distribution. 2025-01-16
|
||||
|
||||
- [x] Option to edit labels. 2025-01-16
|
||||
|
||||
- [ ] Cox regression analyses
|
||||
- More output controls
|
||||
|
||||
Data handling
|
||||
- [x] ~~Theming output tables~~ The "JAMA" theme is the new standard.
|
||||
|
||||
- [ ] Transforming data (transpose and pivoting)
|
||||
- [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.
|
||||
|
||||
### Improved documentation:
|
||||
- [x] Export modified data. 2025-01-16
|
||||
|
||||
- [ ] Video walk-through of central functions
|
||||
- [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...*)
|
||||
|
|
|
|||
|
|
@ -13,8 +13,8 @@ template:
|
|||
navbar:
|
||||
bg: primary
|
||||
structure:
|
||||
left: [intro, reference, articles, roadmap, q_a, news]
|
||||
right: [search, github, lightswitch]
|
||||
left: [intro, reference, roadmap, q_a, news]
|
||||
right: [search, github]
|
||||
components:
|
||||
roadmap:
|
||||
text: Roadmap
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'Version: 25.4.3.250422'
|
||||
app_version <- function()'Version: 25.4.3.250415_1627'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -1514,7 +1514,7 @@ all_but <- function(data, ...) {
|
|||
#'
|
||||
#' @examples
|
||||
#' default_parsing(mtcars) |> subset_types("ordinal")
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = "none",
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
tertiary.type = c("dichotomous", "ordinal", "categorical")
|
||||
),
|
||||
# plot_ridge = list(
|
||||
# descr = "Ridge plot",
|
||||
# note = "An alternative option to visualise data distribution",
|
||||
# primary.type = "continuous",
|
||||
# secondary.type = c("dichotomous" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous" ,"categorical"),
|
||||
# secondary.type = c("dichotomous", "ordinal" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous", "ordinal" ,"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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
|
||||
secondary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "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", "categorical"),
|
||||
tertiary.type = c("dichotomous", "ordinal", "categorical"),
|
||||
secondary.extra = NULL
|
||||
)
|
||||
)
|
||||
|
|
@ -2197,8 +2197,8 @@ overview_vars <- function(data) {
|
|||
data <- as.data.frame(data)
|
||||
|
||||
dplyr::tibble(
|
||||
icon = get_classes(data),
|
||||
class = icon,
|
||||
icon = data_type(data),
|
||||
type = icon,
|
||||
name = names(data),
|
||||
n_missing = unname(colSums(is.na(data))),
|
||||
p_complete = 1 - n_missing / nrow(data),
|
||||
|
|
@ -2231,7 +2231,6 @@ create_overview_datagrid <- function(data,...) {
|
|||
std_names <- c(
|
||||
"Name" = "name",
|
||||
"Icon" = "icon",
|
||||
"Class" = "class",
|
||||
"Type" = "type",
|
||||
"Missings" = "n_missing",
|
||||
"Complete" = "p_complete",
|
||||
|
|
@ -2278,7 +2277,7 @@ create_overview_datagrid <- function(data,...) {
|
|||
grid <- add_class_icon(
|
||||
grid = grid,
|
||||
column = "icon",
|
||||
fun = class_icons
|
||||
fun = type_icons
|
||||
)
|
||||
|
||||
grid <- toastui::grid_format(
|
||||
|
|
@ -2340,15 +2339,15 @@ add_class_icon <- function(grid, column = "class", fun=class_icons) {
|
|||
#'
|
||||
#' @param x character vector of data classes
|
||||
#'
|
||||
#' @returns list
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' "numeric" |> class_icons()|> str()
|
||||
#' mtcars |> sapply(class) |> class_icons() |> str()
|
||||
#' "numeric" |> class_icons()
|
||||
#' default_parsing(mtcars) |> sapply(class) |> class_icons()
|
||||
class_icons <- function(x) {
|
||||
if (length(x)>1){
|
||||
lapply(x,class_icons)
|
||||
sapply(x,class_icons)
|
||||
} else {
|
||||
if (identical(x, "numeric")) {
|
||||
shiny::icon("calculator")
|
||||
|
|
@ -2373,7 +2372,7 @@ class_icons <- function(x) {
|
|||
#'
|
||||
#' @param x character vector of data classes
|
||||
#'
|
||||
#' @returns list
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
|
|
@ -2381,7 +2380,7 @@ class_icons <- function(x) {
|
|||
#' default_parsing(mtcars) |> sapply(data_type) |> type_icons()
|
||||
type_icons <- function(x) {
|
||||
if (length(x)>1){
|
||||
lapply(x,class_icons)
|
||||
sapply(x,class_icons)
|
||||
} else {
|
||||
if (identical(x, "continuous")) {
|
||||
shiny::icon("calculator")
|
||||
|
|
@ -2539,7 +2538,7 @@ argsstring2list <- function(string) {
|
|||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' factorize(mtcars, names(mtcars))
|
||||
#' factorize(mtcars,names(mtcars))
|
||||
factorize <- function(data, vars) {
|
||||
if (!is.null(vars)) {
|
||||
data |>
|
||||
|
|
@ -2668,27 +2667,21 @@ 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
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -2803,7 +2796,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% names(data_types())))
|
||||
assertthat::assert_that(all(type %in% data_types()))
|
||||
|
||||
if (!is.null(type)) {
|
||||
out <- data[data_type(data) %in% type]
|
||||
|
|
@ -3034,36 +3027,6 @@ 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
|
||||
########
|
||||
|
|
@ -5354,11 +5317,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"
|
||||
|
|
@ -5385,16 +5348,7 @@ data_type <- function(data) {
|
|||
#' @examples
|
||||
#' data_types()
|
||||
data_types <- function() {
|
||||
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")
|
||||
)
|
||||
c("dichotomous", "ordinal", "categorical", "datatime", "continuous", "text", "empty", "monotone", "unknown")
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -5435,7 +5389,7 @@ supported_functions <- function() {
|
|||
polr = list(
|
||||
descr = "Ordinal logistic regression model",
|
||||
design = "cross-sectional",
|
||||
out.type = c("categorical"),
|
||||
out.type = c("ordinal", "categorical"),
|
||||
fun = "MASS::polr",
|
||||
args.list = list(
|
||||
Hess = TRUE,
|
||||
|
|
@ -8237,8 +8191,6 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
|
|||
|
||||
# ns <- NS(id)
|
||||
|
||||
|
||||
|
||||
ui_elements <- list(
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -8397,12 +8349,7 @@ ui_elements <- list(
|
|||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = "column_filter"),
|
||||
shiny::helpText("Variable ", tags$a(
|
||||
"data type",
|
||||
href = "https://agdamsbo.github.io/FreesearchR/articles/FreesearchR.html",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
), " filtering."),
|
||||
shiny::helpText("Variable data type filtering."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
IDEAFilter::IDEAFilter_ui("data_filter"),
|
||||
|
|
@ -8517,7 +8464,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,
|
||||
|
|
@ -9272,13 +9219,7 @@ server <- function(input, output, session) {
|
|||
output$code_data <- shiny::renderUI({
|
||||
shiny::req(rv$code$modify)
|
||||
# browser()
|
||||
## 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)]
|
||||
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- ls |>
|
||||
lapply(expression_string) |>
|
||||
pipe_string() |>
|
||||
|
|
|
|||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 10156735
|
||||
bundleId: 10119038
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -481,13 +481,7 @@ server <- function(input, output, session) {
|
|||
output$code_data <- shiny::renderUI({
|
||||
shiny::req(rv$code$modify)
|
||||
# browser()
|
||||
## 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)]
|
||||
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- ls |>
|
||||
lapply(expression_string) |>
|
||||
pipe_string() |>
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
# ns <- NS(id)
|
||||
|
||||
|
||||
|
||||
ui_elements <- list(
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -160,12 +158,7 @@ ui_elements <- list(
|
|||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = "column_filter"),
|
||||
shiny::helpText("Variable ", tags$a(
|
||||
"data type",
|
||||
href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
), " filtering."),
|
||||
shiny::helpText("Variable data type filtering."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
IDEAFilter::IDEAFilter_ui("data_filter"),
|
||||
|
|
@ -280,7 +273,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,
|
||||
|
|
|
|||
|
|
@ -18,5 +18,5 @@ data.frame
|
|||
Factorize variables in data.frame
|
||||
}
|
||||
\examples{
|
||||
factorize(mtcars, names(mtcars))
|
||||
factorize(mtcars,names(mtcars))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,24 +0,0 @@
|
|||
% 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()
|
||||
}
|
||||
|
|
@ -16,15 +16,11 @@ 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()
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,6 +21,6 @@ Easily subset by data type function
|
|||
}
|
||||
\examples{
|
||||
default_parsing(mtcars) |> subset_types("ordinal")
|
||||
default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
|
||||
default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
|
||||
#' default_parsing(mtcars) |> subset_types("factor",class)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -61,22 +61,6 @@ 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.
|
||||
|
|
@ -96,7 +80,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", "categorical") |>
|
||||
c("continuous", "dichotomous", "ordinal", "categorical") |>
|
||||
lapply(\(.x){
|
||||
dplyr::bind_cols(
|
||||
dplyr::tibble("Data type"=.x),
|
||||
|
|
@ -122,27 +106,6 @@ 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.
|
||||
|
|
|
|||
|
|
@ -1,33 +0,0 @@
|
|||
---
|
||||
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.
|
||||
Loading…
Add table
Reference in a new issue