executing examples with as_factor() errors. I think due to redundancy. Will investigate.

R/as_factor.R

@@ -11,6 +11,7 @@
 #' @export
 #' @examples
 #' # will preserve all attributes but class
+#' \dontrun{
 #' c(1, 4, 3, "A", 7, 8, 1) |> as_factor()
 #' structure(c(1, 2, 3, 2, 10, 9),
 #'   labels = c(Unknown = 9, Refused = 10)
@@ -22,7 +23,7 @@
 #'   class = "haven_labelled"
 #' ) |>
 #'   as_factor()
-#'
+#' }
 #' @importFrom forcats as_factor
 #' @importFrom rlang check_dots_used
 #' @export
@@ -74,15 +75,20 @@ as_factor.labelled <- as_factor.haven_labelled
 #'
 #' @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) {
   stopifnot(is.factor(data))
   if (!is.null(na.label)){
@@ -141,6 +147,7 @@ named_levels <- function(data, label = "labels",na.label=NULL, na.value=99) {
 #' @export
 #'
 #' @examples
+#' \dontrun{
 #' c(1, 4, 3, "A", 7, 8, 1) |>
 #' as_factor() |> fct2num()
 #'
@@ -156,6 +163,7 @@ named_levels <- function(data, label = "labels",na.label=NULL, na.value=99) {
 #' ) |>
 #'   as_factor() |>
 #'   fct2num()
+#'   }
 fct2num <- function(data) {
   stopifnot(is.factor(data))
   as.numeric(named_levels(data))[match(data, names(named_levels(data)))]
@@ -171,11 +179,12 @@ fct2num <- function(data) {
 #'
 #' @examples
 #' attr(mtcars$mpg, "label") <- "testing"
-#' sapply(mtcars, get_attr)
-#' lapply(mtcars, \(.x)get_attr(.x, NULL))
+#' do.call(c,sapply(mtcars, get_attr))
+#' \dontrun{
 #' mtcars |>
 #'   numchar2fct(numeric.threshold = 6) |>
 #'   ds2dd_detailed()
+#' }
 get_attr <- function(data, attr = NULL) {
   if (is.null(attr)) {
     attributes(data)
@@ -195,16 +204,20 @@ 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) {
+set_attr <- function(data, label, attr = NULL, overwrite=FALSE) {
   if (is.null(attr)) {
     ## Has to be list...
     stopifnot(is.list(label))
     ## ... with names
     stopifnot(length(label)==length(names(label)))
+    if (!overwrite){
+      label <- label[!names(label) %in% names(attributes(data))]
+    }
     attributes(data) <- c(attributes(data),label)
   } else {
     attr(data, attr) <- label
@@ -239,11 +252,3 @@ 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))])
-# }
-

R/ds2dd_detailed.R

@@ -141,6 +141,7 @@ hms2character <- function(data) {
 #' @export
 #'
 #' @examples
+#' \dontrun{
 #' data <- REDCapCAST::redcapcast_data
 #' data |> ds2dd_detailed()
 #' iris |> ds2dd_detailed(add.auto.id = TRUE)
@@ -157,6 +158,7 @@ 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",
@@ -416,9 +418,11 @@ mark_complete <- function(upload, ls) {
 #' @export
 #'
 #' @examples
+#' \dontrun{
 #' mtcars |>
 #'   parse_data() |>
 #'   str()
+#' }
 parse_data <- function(data,
                        guess_type = TRUE,
                        col_types = NULL,
@@ -434,7 +438,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 |>
-      haven::as_factor()
+      as_factor()
   }
 
   ## Applying readr cols
@@ -474,6 +478,7 @@ parse_data <- function(data,
 #' @importFrom forcats as_factor
 #'
 #' @examples
+#' \dontrun{
 #' sample(seq_len(4), 20, TRUE) |>
 #'   var2fct(6) |>
 #'   summary()
@@ -481,9 +486,10 @@ 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) {
-    forcats::as_factor(data)
+    as_factor(data)
   } else {
     data
   }
@@ -505,9 +511,11 @@ 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(