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)
+#' do.call(c,sapply(mtcars, get_attr))
-#' lapply(mtcars, \(.x)get_attr(.x, NULL))
+#' \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(

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 11351429
-bundleId:
+bundleId: 9391508
 url: https://agdamsbo.shinyapps.io/redcapcast/
 version: 1

inst/shiny-examples/casting/server.R

@@ -24,7 +24,7 @@ server <- function(input, output, session) {
     out <- read_input(input$ds$datapath)
 
     # Saves labels to reapply later
-    # labels <- lapply(out, get_attr)
+    labels <- lapply(out, get_attr)
 
     out <- out |>
       ## Parses data with readr functions
@@ -44,10 +44,10 @@ server <- function(input, output, session) {
     }
 
     # Old attributes are appended
-    # out <- purrr::imap(out,\(.x,.i){
+    out <- purrr::imap(out,\(.x,.i){
-    #   set_attr(.x,labels[[.i]])
+      set_attr(.x,labels[[.i]])
-    # }) |>
+    }) |>
-    #   dplyr::bind_cols()
+      dplyr::bind_cols()
 
     out
   })

man/as_factor.Rd

@@ -36,6 +36,7 @@ Please refer to parent functions for extended documentation.
 }
 \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)
@@ -47,5 +48,5 @@ structure(c(1, 2, 3, 2, 10, 9),
   class = "haven_labelled"
 ) |>
   as_factor()
-
+}
 }

man/ds2dd_detailed.Rd

@@ -75,6 +75,7 @@ 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)
@@ -92,3 +93,4 @@ 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 = "__")
 }
+}

man/fct2num.Rd

@@ -16,6 +16,7 @@ numeric vector
 Allows conversion of factor to numeric values preserving original levels
 }
 \examples{
+\dontrun{
 c(1, 4, 3, "A", 7, 8, 1) |>
 as_factor() |> fct2num()
 
@@ -32,3 +33,4 @@ structure(c(1, 2, 3, 2, 10, 9),
   as_factor() |>
   fct2num()
   }
+}

man/get_attr.Rd

@@ -19,9 +19,10 @@ Extract attribute. Returns NA if none
 }
 \examples{
 attr(mtcars$mpg, "label") <- "testing"
-sapply(mtcars, get_attr)
+do.call(c,sapply(mtcars, get_attr))
-lapply(mtcars, \(.x)get_attr(.x, NULL))
+\dontrun{
 mtcars |>
   numchar2fct(numeric.threshold = 6) |>
   ds2dd_detailed()
 }
+}

man/named_levels.Rd

@@ -10,6 +10,11 @@ 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
@@ -18,8 +23,10 @@ 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()
 }
+}

man/numchar2fct.Rd

@@ -23,7 +23,9 @@ Individual thresholds for character and numeric columns
 }
 \examples{
 mtcars |> str()
+\dontrun{
 mtcars |>
   numchar2fct(numeric.threshold = 6) |>
   str()
 }
+}

man/parse_data.Rd

@@ -33,7 +33,9 @@ data.frame or tibble
 Helper to auto-parse un-formatted data with haven and readr
 }
 \examples{
+\dontrun{
 mtcars |>
   parse_data() |>
   str()
 }
+}

man/set_attr.Rd

@@ -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)
+set_attr(data, label, attr = NULL, overwrite = FALSE)
 }
 \arguments{
 \item{data}{vector}
@@ -12,6 +12,8 @@ set_attr(data, label, attr = NULL)
 \item{label}{label}
 
 \item{attr}{attribute name}
+
+\item{overwrite}{overwrite existing attributes. Default is FALSE.}
 }
 \value{
 vector with attribute

man/var2fct.Rd

@@ -19,6 +19,7 @@ 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()
@@ -27,3 +28,4 @@ sample(letters, 20) |>
   summary()
 sample(letters[1:4], 20, TRUE) |> var2fct(6)
 }
+}