Regen docs, ensure checks etc run

NAMESPACE

@@ -4,7 +4,6 @@ S3method("$<-",safeframe)
 S3method("[",safeframe)
 S3method("[<-",safeframe)
 S3method("[[<-",safeframe)
-S3method("names<-",safeframe)
 S3method(print,safeframe)
 export(get_lost_tags_action)
 export(has_tag)

R/restore_tags.R

@@ -24,18 +24,18 @@ restore_tags <- function(x, tags,
   checkmate::assertClass(x, "data.frame")
   checkmate::assertClass(tags, "list")
   lost_action <- match.arg(lost_action)
-  
+
   # Match the remaining variables to the provided tags
   common_vars <- intersect(names(x), tags)
   if (length(common_vars) == 0 && length(names(x)) > 0) {
     stop("No matching tags provided.")
   }
-  
+
   lost_vars <- setdiff(tags, names(x))
-  
+
   if (lost_action != "none" && length(lost_vars) > 0) {
     lost_tags <- names(lost_vars)
-    
+
     lost_msg <- vars_tags(lost_vars, lost_tags)
     msg <- paste(
       "The following tagged variables are lost:\n",
@@ -44,7 +44,6 @@ restore_tags <- function(x, tags,
     if (lost_action == "warning") {
       # nolint next: condition_call_linter.
       warning(warningCondition(msg, class = "safeframe_warning"))
-
     }
     if (lost_action == "error") {
       # nolint next: condition_call_linter.
@@ -55,7 +54,7 @@ restore_tags <- function(x, tags,
   remaining_names <- setdiff(names(tags), names(lost_vars))
   # Subset tags with remaining names
   tags <- tags[remaining_names]
-  
+
   x <- tag_variables(x, tags)
 
   # Ensure class consistency

R/square_bracket.R

@@ -37,7 +37,7 @@
 #'       mph = "speed",
 #'       distance = "dist"
 #'     ) %>%
-#'     mutate(result = if_else(mph > 50, "fast", "slow")) %>%
+#'     mutate(result = if_else(speed > 50, "fast", "slow")) %>%
 #'     set_tags(ticket = "result")
 #'   x
 #'
@@ -48,7 +48,7 @@
 #'   x[[2]] <- NULL
 #'   x
 #'
-#'   x$age <- NULL
+#'   x$speed <- NULL
 #'   x
 #' }
 `[.safeframe` <- function(x, i, j, drop = FALSE) {
@@ -106,7 +106,7 @@
   out <- NextMethod()
   old_tags <- tags(x)
   out <- restore_tags(out, old_tags, lost_action)
-  
+
   out
 }
 
@@ -118,7 +118,7 @@
   lost_action <- get_lost_tags_action()
   old_tags <- tags(x)
   new_tags <- old_tags
-  
+
   lost_tags(old_tags, new_tags, lost_action)
 
   class(x) <- setdiff(class(x), "safeframe")

R/tag_variables.R

@@ -38,27 +38,14 @@ tag_variables <- function(x, tags) {
   })
   checkmate::reportAssertions(tag_errors)
 
-  # Add the tags to the right location
-  # Vectorized approach does not work, so we use a for.. loop instead
-  # for (tag in names(tags)) {
-  #   var <- tags[[tag]]
-  #   if (is.null(var)) {
-  #     # Find the relevant variable for the tag without a variable
-  #     removeVar <- tags(x)[[tag]]
-  #     if (length(removeVar) > 0) {
-  #       # Remove the tag on the var
-  #       x <- remove_tag(x, removeVar[[1]])
-  #     }
-  #   } else {
-  #     attr(x[[var]], "label") <- tag
-  #   }
-  # }
-
   # Split tags into NULL and non-NULL cases
-  if (any(sapply(tags, is.null))) {
-    null_tags <- names(tags)[sapply(tags, is.null)]
-  } else { null_tags <- NULL }
-  non_null_tags <- names(tags)[!sapply(tags, is.null)]
+  nullIndex <- vapply(tags, is.null, FUN.VALUE = logical(1))
+  if (any(nullIndex)) {
+    null_tags <- names(tags)[nullIndex]
+  } else {
+    null_tags <- NULL
+  }
+  non_null_tags <- names(tags)[!nullIndex]
 
   # Handle NULL cases (tag removals)
   if (length(null_tags) > 0) {

R/tags.R

@@ -35,7 +35,9 @@ tags <- function(x, show_null = FALSE) {
   out <- lapply(names(x), FUN = function(var) {
     tmpLabel <- attr(x[[var]], "label")
     if (!is.null(tmpLabel)) {
-      return(setNames(list(var), tmpLabel))
+      tmpVar <- list(var)
+      names(tmpVar) <- tmpLabel
+      return(tmpVar)
     } else {
       return(NULL)
     }

R/type.R

@@ -18,8 +18,8 @@
 #'
 #' validate_types(
 #'   x,
-#'   speed = type("numeric"),
-#'   dist = "numeric"
+#'   mph = type("numeric"),
+#'   distance = "numeric"
 #' )
 #'
 type <- function(x) {

R/validate_safeframe.R

@@ -35,23 +35,23 @@
 #'
 #' ## validation
 #' validate_safeframe(x,
-#'   speed = c("numeric", "factor"),
-#'   dist = "numeric"
+#'   mph = c("numeric", "factor"),
+#'   distance = "numeric"
 #' )
 #'
 #' ## the below issues an error
 #' ## note: tryCatch is only used to avoid a genuine error in the example
 #' tryCatch(validate_safeframe(x,
-#'   speed = c("numeric", "factor"),
-#'   dist = "factor"
+#'   mph = c("numeric", "factor"),
+#'   distance = "factor"
 #' ), error = paste)
 validate_safeframe <- function(x,
                                ...) {
   checkmate::assert_class(x, "safeframe")
   validate_tags(x)
   validate_types(x, ...)
-  
+
   message("'", checkmate::vname(x), "' is a valid safeframe object")
-  
+
   invisible(x)
 }

R/validate_tags.R

@@ -28,8 +28,8 @@
 #'
 #' ## validation requires you to specify the types directly
 #' validate_safeframe(x,
-#'   speed = c("integer", "numeric"),
-#'   dist = "numeric"
+#'   mph = c("integer", "numeric"),
+#'   distance = "numeric"
 #' )
 validate_tags <- function(x) {
   checkmate::assert_class(x, "safeframe")