mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-23 13:50:21 +01:00
Compare commits
No commits in common. "f09439493380518de4fd737025baeb95dbd94ff8" and "69e1520affafb620a93defcc97955224c16eb4ea" have entirely different histories.
f094394933
...
69e1520aff
13
DESCRIPTION
13
DESCRIPTION
@ -29,11 +29,16 @@ Suggests:
|
||||
Hmisc,
|
||||
knitr,
|
||||
rmarkdown,
|
||||
gt,
|
||||
ggplot2,
|
||||
here,
|
||||
styler,
|
||||
devtools,
|
||||
roxygen2,
|
||||
spelling,
|
||||
rhub
|
||||
glue,
|
||||
rhub,
|
||||
bslib
|
||||
License: GPL (>= 3)
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
@ -56,11 +61,7 @@ Imports:
|
||||
openxlsx2,
|
||||
readODS,
|
||||
forcats,
|
||||
vctrs,
|
||||
gt,
|
||||
bslib,
|
||||
here,
|
||||
glue
|
||||
rlang
|
||||
Collate:
|
||||
'REDCapCAST-package.R'
|
||||
'utils.r'
|
||||
|
@ -1,7 +1,6 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
S3method(as_factor,character)
|
||||
S3method(as_factor,factor)
|
||||
S3method(as_factor,haven_labelled)
|
||||
S3method(as_factor,labelled)
|
||||
S3method(as_factor,logical)
|
||||
@ -13,8 +12,6 @@ S3method(process_user_input,response)
|
||||
export(REDCap_split)
|
||||
export(as_factor)
|
||||
export(case_match_regex_list)
|
||||
export(cast_data_overview)
|
||||
export(cast_meta_overview)
|
||||
export(char2choice)
|
||||
export(char2cond)
|
||||
export(clean_redcap_name)
|
||||
@ -39,7 +36,6 @@ export(html_tag_wrap)
|
||||
export(is_repeated_longitudinal)
|
||||
export(match_fields_to_form)
|
||||
export(named_levels)
|
||||
export(nav_bar_page)
|
||||
export(numchar2fct)
|
||||
export(parse_data)
|
||||
export(process_user_input)
|
||||
@ -63,5 +59,6 @@ importFrom(keyring,key_set)
|
||||
importFrom(openxlsx2,read_xlsx)
|
||||
importFrom(purrr,reduce)
|
||||
importFrom(readr,parse_time)
|
||||
importFrom(rlang,check_dots_used)
|
||||
importFrom(tidyr,pivot_wider)
|
||||
importFrom(tidyselect,all_of)
|
||||
|
227
R/as_factor.R
227
R/as_factor.R
@ -5,173 +5,87 @@
|
||||
#' ta loss in case of rich formatted and labelled data.
|
||||
#'
|
||||
#' Please refer to parent functions for extended documentation.
|
||||
#' To avoid redundancy calls and errors, functions are copy-pasted here
|
||||
#'
|
||||
#' @param x Object to coerce to a factor.
|
||||
#' @param ... Other arguments passed down to method.
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # will preserve all attributes
|
||||
#' # will preserve all attributes but class
|
||||
#' c(1, 4, 3, "A", 7, 8, 1) |> as_factor()
|
||||
#' structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' labels = c(Unknown = 9, Refused = 10)
|
||||
#' ) |>
|
||||
#' as_factor() |> dput()
|
||||
#' as_factor()
|
||||
#'
|
||||
#' structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' labels = c(Unknown = 9, Refused = 10),
|
||||
#' class = "haven_labelled"
|
||||
#' ) |>
|
||||
#' as_factor()
|
||||
#'
|
||||
#' @importFrom forcats as_factor
|
||||
#' @importFrom rlang check_dots_used
|
||||
#' @export
|
||||
#' @name as_factor
|
||||
as_factor <- function(x, ...) {
|
||||
rlang::check_dots_used()
|
||||
UseMethod("as_factor")
|
||||
}
|
||||
|
||||
#' @rdname as_factor
|
||||
#' @export
|
||||
as_factor.factor <- function(x, ...) {
|
||||
x
|
||||
}
|
||||
|
||||
#' @rdname as_factor
|
||||
#' @export
|
||||
as_factor.logical <- function(x, ...) {
|
||||
labels <- get_attr(x)
|
||||
x <- factor(x, levels = c("FALSE", "TRUE"))
|
||||
set_attr(x, labels, overwrite = FALSE)
|
||||
x <- forcats::as_factor(x, ...)
|
||||
set_attr(x, labels[-match("class", names(labels))])
|
||||
}
|
||||
|
||||
#' @rdname as_factor
|
||||
#' @export
|
||||
as_factor.numeric <- function(x, ...) {
|
||||
labels <- get_attr(x)
|
||||
x <- factor(x)
|
||||
set_attr(x, labels, overwrite = FALSE)
|
||||
x <- forcats::as_factor(x, ...)
|
||||
set_attr(x, labels[-match("class", names(labels))])
|
||||
}
|
||||
|
||||
#' @rdname as_factor
|
||||
#' @export
|
||||
as_factor.character <- function(x, ...) {
|
||||
labels <- get_attr(x)
|
||||
if (is.roman(x)){
|
||||
x <- factor(x)
|
||||
} else {
|
||||
x <- structure(
|
||||
forcats::fct_inorder(x),
|
||||
label = attr(x, "label", exact = TRUE)
|
||||
)}
|
||||
set_attr(x, labels, overwrite = FALSE)
|
||||
x <- forcats::as_factor(x, ...)
|
||||
set_attr(x, labels[-match("class", names(labels))])
|
||||
}
|
||||
|
||||
#' @param ordered If `TRUE` create an ordered (ordinal) factor, if
|
||||
#' `FALSE` (the default) create a regular (nominal) factor.
|
||||
#' @param levels How to create the levels of the generated factor:
|
||||
#'
|
||||
#' * "default": uses labels where available, otherwise the values.
|
||||
#' Labels are sorted by value.
|
||||
#' * "both": like "default", but pastes together the level and value
|
||||
#' * "label": use only the labels; unlabelled values become `NA`
|
||||
#' * "values": use only the values
|
||||
#' @rdname as_factor
|
||||
#' @export
|
||||
as_factor.haven_labelled <- function(x, levels = c("default", "labels", "values", "both"),
|
||||
ordered = FALSE, ...) {
|
||||
labels_all <- get_attr(x)
|
||||
|
||||
levels <- match.arg(levels)
|
||||
label <- attr(x, "label", exact = TRUE)
|
||||
labels <- attr(x, "labels")
|
||||
|
||||
if (levels %in% c("default", "both")) {
|
||||
if (levels == "both") {
|
||||
names(labels) <- paste0("[", labels, "] ", names(labels))
|
||||
}
|
||||
|
||||
# Replace each value with its label
|
||||
vals <- unique(vctrs::vec_data(x))
|
||||
levs <- replace_with(vals, unname(labels), names(labels))
|
||||
# Ensure all labels are preserved
|
||||
levs <- sort(c(stats::setNames(vals, levs), labels), na.last = TRUE)
|
||||
levs <- unique(names(levs))
|
||||
|
||||
x <- replace_with(vctrs::vec_data(x), unname(labels), names(labels))
|
||||
|
||||
x <- factor(x, levels = levs, ordered = ordered)
|
||||
} else if (levels == "labels") {
|
||||
levs <- unname(labels)
|
||||
labs <- names(labels)
|
||||
x <- replace_with(vctrs::vec_data(x), levs, labs)
|
||||
x <- factor(x, unique(labs), ordered = ordered)
|
||||
} else if (levels == "values") {
|
||||
if (all(x %in% labels)) {
|
||||
levels <- unname(labels)
|
||||
} else {
|
||||
levels <- sort(unique(vctrs::vec_data(x)))
|
||||
}
|
||||
x <- factor(vctrs::vec_data(x), levels, ordered = ordered)
|
||||
}
|
||||
|
||||
x <- structure(x, label = label)
|
||||
|
||||
set_attr(x, labels_all, overwrite = FALSE)
|
||||
as_factor.haven_labelled <- function(x, ...) {
|
||||
labels <- get_attr(x)
|
||||
x <- haven::as_factor(x, ...)
|
||||
set_attr(x, labels[-match("class", names(labels))])
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @rdname as_factor
|
||||
as_factor.labelled <- as_factor.haven_labelled
|
||||
|
||||
replace_with <- function(x, from, to) {
|
||||
stopifnot(length(from) == length(to))
|
||||
|
||||
out <- x
|
||||
# First replace regular values
|
||||
matches <- match(x, from, incomparables = NA)
|
||||
if (anyNA(matches)) {
|
||||
out[!is.na(matches)] <- to[matches[!is.na(matches)]]
|
||||
} else {
|
||||
out <- to[matches]
|
||||
}
|
||||
|
||||
# Then tagged missing values
|
||||
tagged <- haven::is_tagged_na(x)
|
||||
if (!any(tagged)) {
|
||||
return(out)
|
||||
}
|
||||
|
||||
matches <- match(haven::na_tag(x), haven::na_tag(from), incomparables = NA)
|
||||
|
||||
# Could possibly be faster to use anyNA(matches)
|
||||
out[!is.na(matches)] <- to[matches[!is.na(matches)]]
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Get named vector of factor levels and values
|
||||
#'
|
||||
#' @param data factor
|
||||
#' @param label character string of attribute with named vector of factor labels
|
||||
#' @param na.label character string to refactor NA values. Default is NULL.
|
||||
#' @param na.value new value for NA strings. Ignored if na.label is NULL.
|
||||
#' Default is 99.
|
||||
#'
|
||||
#' @return named vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' labels = c(Unknown = 9, Refused = 10),
|
||||
#' class = "haven_labelled"
|
||||
#' ) |>
|
||||
#' as_factor() |>
|
||||
#' named_levels()
|
||||
#' }
|
||||
named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99) {
|
||||
#' ) |> as_factor() |> named_levels()
|
||||
named_levels <- function(data, label = "labels",na.label=NULL, na.value=99) {
|
||||
stopifnot(is.factor(data))
|
||||
if (!is.null(na.label)) {
|
||||
if (!is.null(na.label)){
|
||||
attrs <- attributes(data)
|
||||
lvls <- as.character(data)
|
||||
lvls[is.na(lvls)] <- na.label
|
||||
@ -181,24 +95,17 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
|
||||
lbls <- data.frame(
|
||||
name = lvls,
|
||||
value = vals
|
||||
) |>
|
||||
unique() |>
|
||||
) |> unique() |>
|
||||
(\(d){
|
||||
stats::setNames(d$value, d$name)
|
||||
})() |>
|
||||
sort()
|
||||
|
||||
data <- do.call(
|
||||
structure,
|
||||
c(
|
||||
list(.Data = match(vals, lbls)),
|
||||
data <- do.call(structure,
|
||||
c(list(.Data=match(vals,lbls)),
|
||||
attrs[-match("levels", names(attrs))],
|
||||
list(
|
||||
levels = names(lbls),
|
||||
labels = lbls
|
||||
)
|
||||
)
|
||||
)
|
||||
list(levels=names(lbls),
|
||||
labels=lbls)))
|
||||
}
|
||||
|
||||
d <- data.frame(
|
||||
@ -210,27 +117,21 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
|
||||
## Applying labels
|
||||
attr_l <- attr(x = data, which = label, exact = TRUE)
|
||||
if (length(attr_l) != 0) {
|
||||
if (all(names(attr_l) %in% d$name)){
|
||||
d$value[match(names(attr_l), d$name)] <- unname(attr_l)
|
||||
}else {
|
||||
d$name[match(attr_l, d$name)] <- names(attr_l)
|
||||
d$value[match(names(attr_l), d$name)] <- unname(attr_l)
|
||||
}
|
||||
}
|
||||
|
||||
out <- stats::setNames(d$value, d$name)
|
||||
## Sort if levels are numeric
|
||||
## Else, they appear in order of appearance
|
||||
if (possibly_numeric(levels(data))) {
|
||||
if (identical(
|
||||
levels(data),
|
||||
suppressWarnings(as.character(as.numeric(levels(data))))
|
||||
)) {
|
||||
out <- out |> sort()
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
is.roman <- function(data){
|
||||
identical(data,as.character(utils::as.roman(data)))
|
||||
}
|
||||
|
||||
|
||||
#' Allows conversion of factor to numeric values preserving original levels
|
||||
#'
|
||||
@ -241,8 +142,7 @@ is.roman <- function(data){
|
||||
#'
|
||||
#' @examples
|
||||
#' c(1, 4, 3, "A", 7, 8, 1) |>
|
||||
#' as_factor() |>
|
||||
#' fct2num()
|
||||
#' as_factor() |> fct2num()
|
||||
#'
|
||||
#' structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' labels = c(Unknown = 9, Refused = 10),
|
||||
@ -252,44 +152,13 @@ is.roman <- function(data){
|
||||
#' fct2num()
|
||||
#'
|
||||
#' structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' labels = c(Unknown = 9, Refused = 10),
|
||||
#' class = "labelled"
|
||||
#' labels = c(Unknown = 9, Refused = 10)
|
||||
#' ) |>
|
||||
#' as_factor() |>
|
||||
#' fct2num()
|
||||
#'
|
||||
#' # Outlier with labels, but no class of origin, handled like numeric vector
|
||||
#' # structure(c(1, 2, 3, 2, 10, 9),
|
||||
#' # labels = c(Unknown = 9, Refused = 10)
|
||||
#' # ) |>
|
||||
#' # as_factor() |>
|
||||
#' # fct2num()
|
||||
#'
|
||||
#' v <- sample(6:19,20,TRUE) |> factor()
|
||||
#' dput(v)
|
||||
#' named_levels(v)
|
||||
#' fct2num(v)
|
||||
fct2num <- function(data) {
|
||||
stopifnot(is.factor(data))
|
||||
if (is.character(named_levels(data))){
|
||||
values <- as.numeric(named_levels(data))
|
||||
} else {
|
||||
values <- named_levels(data)
|
||||
}
|
||||
|
||||
out <- values[match(data, names(named_levels(data)))]
|
||||
|
||||
## If no NA on numeric coercion, of original names, then return
|
||||
## original numeric names, else values
|
||||
if (possibly_numeric(out)) {
|
||||
out <- as.numeric(names(out))
|
||||
}
|
||||
unname(out)
|
||||
}
|
||||
|
||||
possibly_numeric <- function(data){
|
||||
length(stats::na.omit(suppressWarnings(as.numeric(names(data))))) ==
|
||||
length(data)
|
||||
as.numeric(named_levels(data))[match(data, names(named_levels(data)))]
|
||||
}
|
||||
|
||||
#' Extract attribute. Returns NA if none
|
||||
@ -302,12 +171,11 @@ possibly_numeric <- function(data){
|
||||
#'
|
||||
#' @examples
|
||||
#' attr(mtcars$mpg, "label") <- "testing"
|
||||
#' do.call(c, sapply(mtcars, get_attr))
|
||||
#' \dontrun{
|
||||
#' sapply(mtcars, get_attr)
|
||||
#' lapply(mtcars, \(.x)get_attr(.x, NULL))
|
||||
#' mtcars |>
|
||||
#' numchar2fct(numeric.threshold = 6) |>
|
||||
#' ds2dd_detailed()
|
||||
#' }
|
||||
get_attr <- function(data, attr = NULL) {
|
||||
if (is.null(attr)) {
|
||||
attributes(data)
|
||||
@ -327,27 +195,17 @@ get_attr <- function(data, attr = NULL) {
|
||||
#' @param data vector
|
||||
#' @param label label
|
||||
#' @param attr attribute name
|
||||
#' @param overwrite overwrite existing attributes. Default is FALSE.
|
||||
#'
|
||||
#' @return vector with attribute
|
||||
#' @export
|
||||
#'
|
||||
set_attr <- function(data, label, attr = NULL, overwrite = FALSE) {
|
||||
# browser()
|
||||
set_attr <- function(data, label, attr = NULL) {
|
||||
if (is.null(attr)) {
|
||||
## Has to be a named list
|
||||
## Will not fail, but just return original data
|
||||
if (!is.list(label) | length(label) != length(names(label))) {
|
||||
return(data)
|
||||
}
|
||||
## Only include named labels
|
||||
label <- label[!is.na(names(label))]
|
||||
|
||||
if (!overwrite) {
|
||||
label <- label[!names(label) %in% names(attributes(data))]
|
||||
}
|
||||
attributes(data) <- c(attributes(data), label)
|
||||
|
||||
## Has to be list...
|
||||
stopifnot(is.list(label))
|
||||
## ... with names
|
||||
stopifnot(length(label)==length(names(label)))
|
||||
attributes(data) <- c(attributes(data),label)
|
||||
} else {
|
||||
attr(data, attr) <- label
|
||||
}
|
||||
@ -380,3 +238,12 @@ haven_all_levels <- function(data) {
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
# readr::read_rds("/Users/au301842/PAaSO/labelled_test.rds") |> ds2dd_detailed()
|
||||
#' sample(c(TRUE,FALSE,NA),20,TRUE) |> set_attr("hidden","status") |> trial_fct() |> named_levels(na.label = "Missing") |> sort()
|
||||
# trial_fct <- function(x){
|
||||
# labels <- get_attr(x)
|
||||
# x <- factor(x, levels = c("FALSE", "TRUE"))
|
||||
# set_attr(x, labels[-match("class", names(labels))])
|
||||
# }
|
||||
|
||||
|
@ -141,7 +141,6 @@ hms2character <- function(data) {
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data <- REDCapCAST::redcapcast_data
|
||||
#' data |> ds2dd_detailed()
|
||||
#' iris |> ds2dd_detailed(add.auto.id = TRUE)
|
||||
@ -158,7 +157,6 @@ hms2character <- function(data) {
|
||||
#' names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
|
||||
#' replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
|
||||
#' data |> ds2dd_detailed(form.sep = "__")
|
||||
#' }
|
||||
ds2dd_detailed <- function(data,
|
||||
add.auto.id = FALSE,
|
||||
date.format = "dmy",
|
||||
@ -197,8 +195,6 @@ ds2dd_detailed <- function(data,
|
||||
record_id = seq_len(nrow(data)),
|
||||
data
|
||||
)
|
||||
# set_attr(data$record_id,label="ID",attr="label")
|
||||
|
||||
message("A default id column has been added")
|
||||
}
|
||||
|
||||
@ -339,15 +335,12 @@ ds2dd_detailed <- function(data,
|
||||
)
|
||||
)
|
||||
|
||||
out <- list(
|
||||
list(
|
||||
data = data |>
|
||||
hms2character() |>
|
||||
stats::setNames(dd$field_name),
|
||||
meta = dd
|
||||
)
|
||||
|
||||
class(out) <- c("REDCapCAST",class(out))
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
@ -423,11 +416,9 @@ mark_complete <- function(upload, ls) {
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' mtcars |>
|
||||
#' parse_data() |>
|
||||
#' str()
|
||||
#' }
|
||||
parse_data <- function(data,
|
||||
guess_type = TRUE,
|
||||
col_types = NULL,
|
||||
@ -443,7 +434,7 @@ parse_data <- function(data,
|
||||
## Parses haven data by applying labels as factors in case of any
|
||||
if (do.call(c, lapply(data, (\(x)inherits(x, "haven_labelled")))) |> any()) {
|
||||
data <- data |>
|
||||
as_factor()
|
||||
haven::as_factor()
|
||||
}
|
||||
|
||||
## Applying readr cols
|
||||
@ -483,7 +474,6 @@ parse_data <- function(data,
|
||||
#' @importFrom forcats as_factor
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' sample(seq_len(4), 20, TRUE) |>
|
||||
#' var2fct(6) |>
|
||||
#' summary()
|
||||
@ -491,10 +481,9 @@ parse_data <- function(data,
|
||||
#' var2fct(6) |>
|
||||
#' summary()
|
||||
#' sample(letters[1:4], 20, TRUE) |> var2fct(6)
|
||||
#' }
|
||||
var2fct <- function(data, unique.n) {
|
||||
if (length(unique(data)) <= unique.n) {
|
||||
as_factor(data)
|
||||
forcats::as_factor(data)
|
||||
} else {
|
||||
data
|
||||
}
|
||||
@ -516,11 +505,9 @@ var2fct <- function(data, unique.n) {
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> str()
|
||||
#' \dontrun{
|
||||
#' mtcars |>
|
||||
#' numchar2fct(numeric.threshold = 6) |>
|
||||
#' str()
|
||||
#' }
|
||||
numchar2fct <- function(data, numeric.threshold = 6, character.throshold = 6) {
|
||||
data |>
|
||||
dplyr::mutate(
|
||||
|
213
R/shiny_cast.R
213
R/shiny_cast.R
@ -78,216 +78,3 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||
|
||||
df
|
||||
}
|
||||
|
||||
#' Overview of REDCapCAST data for shiny
|
||||
#'
|
||||
#' @param data list with class 'REDCapCAST'
|
||||
#'
|
||||
#' @return gt object
|
||||
#' @export
|
||||
cast_data_overview <- function(data){
|
||||
stopifnot("REDCapCAST" %in% class(data))
|
||||
data |>
|
||||
purrr::pluck("data") |>
|
||||
utils::head(20) |>
|
||||
# dplyr::tibble() |>
|
||||
gt::gt() |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_text(weight = "bold"),
|
||||
locations = gt::cells_column_labels(dplyr::everything())
|
||||
) |>
|
||||
gt::tab_header(
|
||||
title = "Imported data preview",
|
||||
subtitle = "The first 20 subjects of the supplied dataset for reference."
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' Overview of REDCapCAST meta data for shiny
|
||||
#'
|
||||
#' @param data list with class 'REDCapCAST'
|
||||
#'
|
||||
#' @return gt object
|
||||
#' @export
|
||||
cast_meta_overview <- function(data){
|
||||
stopifnot("REDCapCAST" %in% class(data))
|
||||
data |>
|
||||
purrr::pluck("meta") |>
|
||||
# dplyr::tibble() |>
|
||||
dplyr::mutate(
|
||||
dplyr::across(
|
||||
dplyr::everything(),
|
||||
\(.x) {
|
||||
.x[is.na(.x)] <- ""
|
||||
return(.x)
|
||||
}
|
||||
)
|
||||
) |>
|
||||
dplyr::select(1:8) |>
|
||||
gt::gt() |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_text(weight = "bold"),
|
||||
locations = gt::cells_column_labels(dplyr::everything())
|
||||
) |>
|
||||
gt::tab_header(
|
||||
title = "Generated metadata",
|
||||
subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything."
|
||||
) |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_borders(
|
||||
sides = c("left", "right"),
|
||||
color = "grey80",
|
||||
weight = gt::px(1)
|
||||
),
|
||||
locations = gt::cells_body(
|
||||
columns = dplyr::everything()
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' Nav_bar defining function for shiny ui
|
||||
#'
|
||||
#' @return shiny object
|
||||
#' @export
|
||||
#'
|
||||
nav_bar_page <- function(){
|
||||
bslib::page_navbar(
|
||||
title = "Easy REDCap database creation",
|
||||
sidebar = bslib::sidebar(
|
||||
width = 300,
|
||||
shiny::h5("Metadata casting"),
|
||||
shiny::fileInput(
|
||||
inputId = "ds",
|
||||
label = "Upload spreadsheet",
|
||||
multiple = FALSE,
|
||||
accept = c(
|
||||
".csv",
|
||||
".xls",
|
||||
".xlsx",
|
||||
".dta",
|
||||
".rds",
|
||||
".ods"
|
||||
)
|
||||
),
|
||||
# shiny::actionButton(
|
||||
# inputId = "load_data",
|
||||
# label = "Load data",
|
||||
# icon = shiny::icon("circle-down")
|
||||
# ),
|
||||
shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
|
||||
# For some odd reason this only unfolds when the preview panel is shown..
|
||||
# This has been solved by adding an arbitrary button to load data - which was abandoned again
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.uploaded=='yes'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_id",
|
||||
label = "Add ID, or use first column?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"First column" = "no",
|
||||
"Add ID" = "yes",
|
||||
"No ID" = "none"
|
||||
)
|
||||
),
|
||||
shiny::radioButtons(
|
||||
inputId = "specify_factors",
|
||||
label = "Specify categorical variables?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.specify_factors=='yes'",
|
||||
shiny::uiOutput("factor_vars")
|
||||
),
|
||||
# condition = "input.load_data",
|
||||
# shiny::helpText("Below you can download the dataset formatted for upload and the
|
||||
# corresponding data dictionary for a new data base, if you want to upload manually."),
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
|
||||
|
||||
# Horizontal line ----
|
||||
shiny::tags$hr(),
|
||||
shiny::radioButtons(
|
||||
inputId = "upload_redcap",
|
||||
label = "Upload directly to REDCap server?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.upload_redcap=='yes'",
|
||||
shiny::h4("2) Data base upload"),
|
||||
shiny::helpText("This tool is usable for now. Detailed instructions are coming."),
|
||||
shiny::textInput(
|
||||
inputId = "uri",
|
||||
label = "URI",
|
||||
value = "https://redcap.your.institution/api/"
|
||||
),
|
||||
shiny::textInput(
|
||||
inputId = "api",
|
||||
label = "API key",
|
||||
value = ""
|
||||
),
|
||||
shiny::helpText("An API key is an access key to the REDCap database. Please", shiny::a("see here for directions", href = "https://www.iths.org/news/redcap-tip/redcap-api-101/"), " to obtain an API key for your project."),
|
||||
shiny::actionButton(
|
||||
inputId = "upload.meta",
|
||||
label = "Upload datadictionary", icon = shiny::icon("book-bookmark")
|
||||
),
|
||||
shiny::helpText("Please note, that before uploading any real data, put your project
|
||||
into production mode."),
|
||||
shiny::actionButton(
|
||||
inputId = "upload.data",
|
||||
label = "Upload data", icon = shiny::icon("upload")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::p(
|
||||
"License: ", shiny::a("GPL-3+", href = "https://agdamsbo.github.io/REDCapCAST/LICENSE.html")
|
||||
),
|
||||
shiny::p(
|
||||
shiny::a("Package documentation", href = "https://agdamsbo.github.io/REDCapCAST")
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Intro",
|
||||
shiny::markdown(readLines("www/SHINYCAST.md")),
|
||||
shiny::br()
|
||||
),
|
||||
# bslib::nav_spacer(),
|
||||
bslib::nav_panel(
|
||||
title = "Data preview",
|
||||
gt::gt_output(outputId = "data.tbl")
|
||||
# shiny::htmlOutput(outputId = "data.tbl", container = shiny::span)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Dictionary overview",
|
||||
gt::gt_output(outputId = "meta.tbl")
|
||||
# shiny::htmlOutput(outputId = "meta.tbl", container = shiny::span)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Upload",
|
||||
shiny::h3("Meta upload overview"),
|
||||
shiny::textOutput(outputId = "upload.meta.print"),
|
||||
shiny::h3("Data upload overview"),
|
||||
shiny::textOutput(outputId = "upload.data.print")
|
||||
)
|
||||
)
|
||||
}
|
||||
|
@ -5,6 +5,6 @@ account: agdamsbo
|
||||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 11351429
|
||||
bundleId: 9392320
|
||||
bundleId:
|
||||
url: https://agdamsbo.shinyapps.io/redcapcast/
|
||||
version: 1
|
||||
|
@ -5,6 +5,7 @@ library(haven)
|
||||
library(readODS)
|
||||
library(readr)
|
||||
library(dplyr)
|
||||
library(here)
|
||||
library(devtools)
|
||||
if (!requireNamespace("REDCapCAST")) {
|
||||
devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never")
|
||||
@ -102,12 +103,53 @@ server <- function(input, output, session) {
|
||||
|
||||
output$data.tbl <- gt::render_gt(
|
||||
dd() |>
|
||||
cast_data_overview()
|
||||
purrr::pluck("data") |>
|
||||
head(20) |>
|
||||
# dplyr::tibble() |>
|
||||
gt::gt() |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_text(weight = "bold"),
|
||||
locations = gt::cells_column_labels(dplyr::everything())
|
||||
) |>
|
||||
gt::tab_header(
|
||||
title = "Imported data preview",
|
||||
subtitle = "The first 20 subjects of the supplied dataset for reference."
|
||||
)
|
||||
)
|
||||
|
||||
output$meta.tbl <- gt::render_gt(
|
||||
dd() |>
|
||||
cast_meta_overview()
|
||||
purrr::pluck("meta") |>
|
||||
# dplyr::tibble() |>
|
||||
dplyr::mutate(
|
||||
dplyr::across(
|
||||
dplyr::everything(),
|
||||
\(.x) {
|
||||
.x[is.na(.x)] <- ""
|
||||
return(.x)
|
||||
}
|
||||
)
|
||||
) |>
|
||||
dplyr::select(1:8) |>
|
||||
gt::gt() |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_text(weight = "bold"),
|
||||
locations = gt::cells_column_labels(dplyr::everything())
|
||||
) |>
|
||||
gt::tab_header(
|
||||
title = "Generated metadata",
|
||||
subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything."
|
||||
) |>
|
||||
gt::tab_style(
|
||||
style = gt::cell_borders(
|
||||
sides = c("left", "right"),
|
||||
color = "grey80",
|
||||
weight = gt::px(1)
|
||||
),
|
||||
locations = gt::cells_body(
|
||||
columns = dplyr::everything()
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# Downloadable csv of dataset ----
|
||||
|
@ -2,6 +2,143 @@ ui <-
|
||||
bslib::page(
|
||||
theme = bslib::bs_theme(preset = "united"),
|
||||
title = "REDCap database creator",
|
||||
nav_bar_page()
|
||||
bslib::page_navbar(
|
||||
title = "Easy REDCap database creation",
|
||||
sidebar = bslib::sidebar(
|
||||
width = 300,
|
||||
shiny::h5("Metadata casting"),
|
||||
shiny::fileInput(
|
||||
inputId = "ds",
|
||||
label = "Upload spreadsheet",
|
||||
multiple = FALSE,
|
||||
accept = c(
|
||||
".csv",
|
||||
".xls",
|
||||
".xlsx",
|
||||
".dta",
|
||||
".rds",
|
||||
".ods"
|
||||
)
|
||||
),
|
||||
# shiny::actionButton(
|
||||
# inputId = "load_data",
|
||||
# label = "Load data",
|
||||
# icon = shiny::icon("circle-down")
|
||||
# ),
|
||||
shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
|
||||
# For some odd reason this only unfolds when the preview panel is shown..
|
||||
# This has been solved by adding an arbitrary button to load data - which was abandoned again
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.uploaded=='yes'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_id",
|
||||
label = "Add ID, or use first column?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"First column" = "no",
|
||||
"Add ID" = "yes",
|
||||
"No ID" = "none"
|
||||
)
|
||||
),
|
||||
shiny::radioButtons(
|
||||
inputId = "specify_factors",
|
||||
label = "Specify categorical variables?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.specify_factors=='yes'",
|
||||
uiOutput("factor_vars")
|
||||
),
|
||||
# condition = "input.load_data",
|
||||
# shiny::helpText("Below you can download the dataset formatted for upload and the
|
||||
# corresponding data dictionary for a new data base, if you want to upload manually."),
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
|
||||
|
||||
# Button
|
||||
shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
|
||||
|
||||
# Horizontal line ----
|
||||
shiny::tags$hr(),
|
||||
shiny::radioButtons(
|
||||
inputId = "upload_redcap",
|
||||
label = "Upload directly to REDCap server?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.upload_redcap=='yes'",
|
||||
shiny::h4("2) Data base upload"),
|
||||
shiny::helpText("This tool is usable for now. Detailed instructions are coming."),
|
||||
shiny::textInput(
|
||||
inputId = "uri",
|
||||
label = "URI",
|
||||
value = "https://redcap.your.institution/api/"
|
||||
),
|
||||
shiny::textInput(
|
||||
inputId = "api",
|
||||
label = "API key",
|
||||
value = ""
|
||||
),
|
||||
shiny::helpText("An API key is an access key to the REDCap database. Please", shiny::a("see here for directions", href = "https://www.iths.org/news/redcap-tip/redcap-api-101/"), " to obtain an API key for your project."),
|
||||
shiny::actionButton(
|
||||
inputId = "upload.meta",
|
||||
label = "Upload datadictionary", icon = shiny::icon("book-bookmark")
|
||||
),
|
||||
shiny::helpText("Please note, that before uploading any real data, put your project
|
||||
into production mode."),
|
||||
shiny::actionButton(
|
||||
inputId = "upload.data",
|
||||
label = "Upload data", icon = shiny::icon("upload")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::p(
|
||||
"License: ", shiny::a("GPL-3+", href = "https://agdamsbo.github.io/REDCapCAST/LICENSE.html")
|
||||
),
|
||||
shiny::p(
|
||||
shiny::a("Package documentation", href = "https://agdamsbo.github.io/REDCapCAST")
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Intro",
|
||||
shiny::markdown(readLines("www/SHINYCAST.md")),
|
||||
shiny::br()
|
||||
),
|
||||
# bslib::nav_spacer(),
|
||||
bslib::nav_panel(
|
||||
title = "Data preview",
|
||||
gt::gt_output(outputId = "data.tbl")
|
||||
# shiny::htmlOutput(outputId = "data.tbl", container = shiny::span)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Dictionary overview",
|
||||
gt::gt_output(outputId = "meta.tbl")
|
||||
# shiny::htmlOutput(outputId = "meta.tbl", container = shiny::span)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Upload",
|
||||
shiny::h3("Meta upload overview"),
|
||||
shiny::textOutput(outputId = "upload.meta.print"),
|
||||
shiny::h3("Data upload overview"),
|
||||
shiny::textOutput(outputId = "upload.data.print")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
@ -2,7 +2,6 @@
|
||||
% Please edit documentation in R/as_factor.R
|
||||
\name{as_factor}
|
||||
\alias{as_factor}
|
||||
\alias{as_factor.factor}
|
||||
\alias{as_factor.logical}
|
||||
\alias{as_factor.numeric}
|
||||
\alias{as_factor.character}
|
||||
@ -12,43 +11,20 @@
|
||||
\usage{
|
||||
as_factor(x, ...)
|
||||
|
||||
\method{as_factor}{factor}(x, ...)
|
||||
|
||||
\method{as_factor}{logical}(x, ...)
|
||||
|
||||
\method{as_factor}{numeric}(x, ...)
|
||||
|
||||
\method{as_factor}{character}(x, ...)
|
||||
|
||||
\method{as_factor}{haven_labelled}(
|
||||
x,
|
||||
levels = c("default", "labels", "values", "both"),
|
||||
ordered = FALSE,
|
||||
...
|
||||
)
|
||||
\method{as_factor}{haven_labelled}(x, ...)
|
||||
|
||||
\method{as_factor}{labelled}(
|
||||
x,
|
||||
levels = c("default", "labels", "values", "both"),
|
||||
ordered = FALSE,
|
||||
...
|
||||
)
|
||||
\method{as_factor}{labelled}(x, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{x}{Object to coerce to a factor.}
|
||||
|
||||
\item{...}{Other arguments passed down to method.}
|
||||
|
||||
\item{levels}{How to create the levels of the generated factor:
|
||||
|
||||
* "default": uses labels where available, otherwise the values.
|
||||
Labels are sorted by value.
|
||||
* "both": like "default", but pastes together the level and value
|
||||
* "label": use only the labels; unlabelled values become `NA`
|
||||
* "values": use only the values}
|
||||
|
||||
\item{ordered}{If `TRUE` create an ordered (ordinal) factor, if
|
||||
`FALSE` (the default) create a regular (nominal) factor.}
|
||||
}
|
||||
\description{
|
||||
This extends [forcats::as_factor()] as well as [haven::as_factor()], by appending
|
||||
@ -57,19 +33,19 @@ ta loss in case of rich formatted and labelled data.
|
||||
}
|
||||
\details{
|
||||
Please refer to parent functions for extended documentation.
|
||||
To avoid redundancy calls and errors, functions are copy-pasted here
|
||||
}
|
||||
\examples{
|
||||
# will preserve all attributes
|
||||
# will preserve all attributes but class
|
||||
c(1, 4, 3, "A", 7, 8, 1) |> as_factor()
|
||||
structure(c(1, 2, 3, 2, 10, 9),
|
||||
labels = c(Unknown = 9, Refused = 10)
|
||||
) |>
|
||||
as_factor() |> dput()
|
||||
as_factor()
|
||||
|
||||
structure(c(1, 2, 3, 2, 10, 9),
|
||||
labels = c(Unknown = 9, Refused = 10),
|
||||
class = "haven_labelled"
|
||||
) |>
|
||||
as_factor()
|
||||
|
||||
}
|
||||
|
@ -1,17 +0,0 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/shiny_cast.R
|
||||
\name{cast_data_overview}
|
||||
\alias{cast_data_overview}
|
||||
\title{Overview of REDCapCAST data for shiny}
|
||||
\usage{
|
||||
cast_data_overview(data)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{list with class 'REDCapCAST'}
|
||||
}
|
||||
\value{
|
||||
gt object
|
||||
}
|
||||
\description{
|
||||
Overview of REDCapCAST data for shiny
|
||||
}
|
@ -1,17 +0,0 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/shiny_cast.R
|
||||
\name{cast_meta_overview}
|
||||
\alias{cast_meta_overview}
|
||||
\title{Overview of REDCapCAST meta data for shiny}
|
||||
\usage{
|
||||
cast_meta_overview(data)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{list with class 'REDCapCAST'}
|
||||
}
|
||||
\value{
|
||||
gt object
|
||||
}
|
||||
\description{
|
||||
Overview of REDCapCAST meta data for shiny
|
||||
}
|
@ -75,7 +75,6 @@ Ensure, that the data set is formatted with as much information as possible.
|
||||
`field.type` can be supplied
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
data <- REDCapCAST::redcapcast_data
|
||||
data |> ds2dd_detailed()
|
||||
iris |> ds2dd_detailed(add.auto.id = TRUE)
|
||||
@ -93,4 +92,3 @@ names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
|
||||
replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
|
||||
data |> ds2dd_detailed(form.sep = "__")
|
||||
}
|
||||
}
|
||||
|
@ -17,8 +17,7 @@ Allows conversion of factor to numeric values preserving original levels
|
||||
}
|
||||
\examples{
|
||||
c(1, 4, 3, "A", 7, 8, 1) |>
|
||||
as_factor() |>
|
||||
fct2num()
|
||||
as_factor() |> fct2num()
|
||||
|
||||
structure(c(1, 2, 3, 2, 10, 9),
|
||||
labels = c(Unknown = 9, Refused = 10),
|
||||
@ -28,21 +27,8 @@ structure(c(1, 2, 3, 2, 10, 9),
|
||||
fct2num()
|
||||
|
||||
structure(c(1, 2, 3, 2, 10, 9),
|
||||
labels = c(Unknown = 9, Refused = 10),
|
||||
class = "labelled"
|
||||
labels = c(Unknown = 9, Refused = 10)
|
||||
) |>
|
||||
as_factor() |>
|
||||
fct2num()
|
||||
|
||||
# Outlier with labels, but no class of origin, handled like numeric vector
|
||||
# structure(c(1, 2, 3, 2, 10, 9),
|
||||
# labels = c(Unknown = 9, Refused = 10)
|
||||
# ) |>
|
||||
# as_factor() |>
|
||||
# fct2num()
|
||||
|
||||
v <- sample(6:19,20,TRUE) |> factor()
|
||||
dput(v)
|
||||
named_levels(v)
|
||||
fct2num(v)
|
||||
}
|
||||
|
@ -19,10 +19,9 @@ Extract attribute. Returns NA if none
|
||||
}
|
||||
\examples{
|
||||
attr(mtcars$mpg, "label") <- "testing"
|
||||
do.call(c, sapply(mtcars, get_attr))
|
||||
\dontrun{
|
||||
sapply(mtcars, get_attr)
|
||||
lapply(mtcars, \(.x)get_attr(.x, NULL))
|
||||
mtcars |>
|
||||
numchar2fct(numeric.threshold = 6) |>
|
||||
ds2dd_detailed()
|
||||
}
|
||||
}
|
||||
|
@ -10,11 +10,6 @@ named_levels(data, label = "labels", na.label = NULL, na.value = 99)
|
||||
\item{data}{factor}
|
||||
|
||||
\item{label}{character string of attribute with named vector of factor labels}
|
||||
|
||||
\item{na.label}{character string to refactor NA values. Default is NULL.}
|
||||
|
||||
\item{na.value}{new value for NA strings. Ignored if na.label is NULL.
|
||||
Default is 99.}
|
||||
}
|
||||
\value{
|
||||
named vector
|
||||
@ -23,12 +18,8 @@ named vector
|
||||
Get named vector of factor levels and values
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
structure(c(1, 2, 3, 2, 10, 9),
|
||||
labels = c(Unknown = 9, Refused = 10),
|
||||
class = "haven_labelled"
|
||||
) |>
|
||||
as_factor() |>
|
||||
named_levels()
|
||||
}
|
||||
) |> as_factor() |> named_levels()
|
||||
}
|
||||
|
@ -1,14 +0,0 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/shiny_cast.R
|
||||
\name{nav_bar_page}
|
||||
\alias{nav_bar_page}
|
||||
\title{Nav_bar defining function for shiny ui}
|
||||
\usage{
|
||||
nav_bar_page()
|
||||
}
|
||||
\value{
|
||||
shiny object
|
||||
}
|
||||
\description{
|
||||
Nav_bar defining function for shiny ui
|
||||
}
|
@ -23,9 +23,7 @@ Individual thresholds for character and numeric columns
|
||||
}
|
||||
\examples{
|
||||
mtcars |> str()
|
||||
\dontrun{
|
||||
mtcars |>
|
||||
numchar2fct(numeric.threshold = 6) |>
|
||||
str()
|
||||
}
|
||||
}
|
||||
|
@ -33,9 +33,7 @@ data.frame or tibble
|
||||
Helper to auto-parse un-formatted data with haven and readr
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
mtcars |>
|
||||
parse_data() |>
|
||||
str()
|
||||
}
|
||||
}
|
||||
|
@ -4,7 +4,7 @@
|
||||
\alias{set_attr}
|
||||
\title{Set attributes for named attribute. Appends if attr is NULL}
|
||||
\usage{
|
||||
set_attr(data, label, attr = NULL, overwrite = FALSE)
|
||||
set_attr(data, label, attr = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{vector}
|
||||
@ -12,8 +12,6 @@ set_attr(data, label, attr = NULL, overwrite = FALSE)
|
||||
\item{label}{label}
|
||||
|
||||
\item{attr}{attribute name}
|
||||
|
||||
\item{overwrite}{overwrite existing attributes. Default is FALSE.}
|
||||
}
|
||||
\value{
|
||||
vector with attribute
|
||||
|
@ -19,7 +19,6 @@ This is a wrapper of forcats::as_factor, which sorts numeric vectors before
|
||||
factoring, but levels character vectors in order of appearance.
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
sample(seq_len(4), 20, TRUE) |>
|
||||
var2fct(6) |>
|
||||
summary()
|
||||
@ -28,4 +27,3 @@ sample(letters, 20) |>
|
||||
summary()
|
||||
sample(letters[1:4], 20, TRUE) |> var2fct(6)
|
||||
}
|
||||
}
|
||||
|
@ -69,6 +69,11 @@ redcapcast_data |>
|
||||
```
|
||||
|
||||
|
||||
```{r}
|
||||
|
||||
```
|
||||
|
||||
|
||||
Column classes can be passed to `parse_data()`.
|
||||
|
||||
Making a few crude assumption for factorising data, `numchar2fct()` factorises numerical and character vectors based on a set threshold for unique values:
|
||||
|
Loading…
Reference in New Issue
Block a user