Extraction/Replacement Method

DESCRIPTION

@@ -1,24 +1,24 @@
-Package: labelVector
-Title: Label Attributes for Atomic Vectors
-Version: 0.0.1
-Authors@R: person("Benjamin", "Nutter", , "benjamin.nutter@gmail.com", role = c("aut", "cre"))
-Description: Labels are a common construct in statistical software providing a 
-  human readable description of a variable. While variable names are succinct,
-  quick to type, and follow a language's naming conventions, labels may 
-  be more illustrative and may use plain text and spaces. R does not provide
-  native support for labels. Some packages, however, have made this feature
-  available.  Most notably, the Hmisc package provides labelling methods
-  for a number of different object. Due to design decisions, these methods
-  are not all exported, and so are unavailable for use in package development.
-  The labelVector package supports labels for atomic vectors in a light-weight
-  design that is suitable for use in other packages.
-Depends:
-  R (>= 2.0.0)
-Suggests:
-  Hmisc,
-  knitr,
-  testthat
-License: MIT + file LICENSE
-LazyData: true
-RoxygenNote: 6.0.1
-VignetteBuilder: knitr
+Package: labelVector
+Title: Label Attributes for Atomic Vectors
+Version: 0.0.1
+Authors@R: person("Benjamin", "Nutter", , "benjamin.nutter@gmail.com", role = c("aut", "cre"))
+Description: Labels are a common construct in statistical software providing a 
+  human readable description of a variable. While variable names are succinct,
+  quick to type, and follow a language's naming conventions, labels may 
+  be more illustrative and may use plain text and spaces. R does not provide
+  native support for labels. Some packages, however, have made this feature
+  available.  Most notably, the 'Hmisc' package provides labelling methods
+  for a number of different object. Due to design decisions, these methods
+  are not all exported, and so are unavailable for use in package development.
+  The 'labelVector' package supports labels for atomic vectors in a light-weight
+  design that is suitable for use in other packages.
+Depends:
+  R (>= 2.0.0)
+Suggests:
+  Hmisc,
+  knitr,
+  testthat
+License: MIT + file LICENSE
+LazyData: true
+RoxygenNote: 6.0.1
+VignetteBuilder: knitr

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("[",labelled)
+S3method("[<-",labelled)
 S3method(get_label,data.frame)
 S3method(get_label,default)
 S3method(print,labelled)

R/extract_labelled.R

@@ -0,0 +1,42 @@
+#' @name extract_labelled
+#' @title Extract or Replace Parts of Labelled Vectors
+#' 
+#' @description Extraction and replacement methods for labelled vectors.
+#' 
+#' @param x An atomic vector inheriting the \code{labelled} class.
+#' @param i The elements to extract.
+#' @param value typically a vector of similar class of length \code{i}
+#' 
+#' @seealso \code{\link{Extract}}
+#' 
+#' @examples 
+#' 
+#' x <- set_label(1:10, "Integers")
+#' x[1:3]
+#' 
+#' x[3] <- pi
+#' x
+#' 
+#' @export
+
+`[.labelled` <- function(x, i){
+  structure(
+    unclass(x)[i],
+    label = attr(x, "label"),
+    class = class(x)
+  )
+}
+
+#' @rdname extract_labelled
+#' @export
+
+`[<-.labelled` <- function(x, i, value){
+  x_new <- x
+  class(x_new) <- class(x_new)[!class(x_new) %in% "labelled"]
+  x_new[i] <- value
+  structure(
+    x_new,
+    label = attr(x, "label"),
+    class = c("labelled", class(x_new))
+  )
+}

R/set_label.R

@@ -1,99 +1,99 @@
-#' @name set_label
-#' @title Set the label of an atomic vector
-#'
-#' @description Variable labels are a common construct in statistical
-#'   software, giving users the ability to provide plain text descriptions
-#'   for variables.  These descriptions can be more informative of the
-#'   variable's purpose, since they need not be restricted to the naming
-#'   conventions imposed on variable names.
-#'
-#' @param x An atomic vector
-#' @param label \code{character(1)}, A character string denoting the label
-#'   to assign to the variable.
-#' @param ... For the default method, arguments to pass to other methods.
-#'   For the \code{data.frame} method, key-pairs of the pattern
-#'   \code{variable = 'label'}.
-#'
-#' @seealso \code{\link{get_label}}
-#'
-#' @source
-#' Frank E Harrell Jr, with contributions from Charles Dupont and many
-#' others. (2017). Hmisc: Harrell Miscellaneous. R package version 4.0-3.
-#' https://CRAN.R-project.org/package=Hmisc
-#'
-#' @examples
-#' x <- 1:10
-#' x <- set_label(x, "Integers")
-#' x
-#'
-#' # Set labels for variables in a data frame
-#'
-#' mtcars2 <-
-#'   set_label(mtcars,
-#'             am = "Automatic / Manual",
-#'             mpg = "Miles per Gallon",
-#'             gear = "Number of gears")
-#'
-#' get_label(mtcars2)
-#'
-#' @export
-
-set_label <- function(x, ...){
-  UseMethod("set_label")
-}
-
-#' @rdname set_label
-#' @export
-
-set_label.default <- function(x, label, ...){
-  if (!is.atomic(x)){
-    stop("`x` must be an atomic vector")
-  }
-
-  if (!is.character(label) | length(label) != 1){
-    stop("`label` must be a length 1 character string")
-  }
-
-  structure(x,
-            label = label,
-            class = c("labelled", class(x)))
-}
-
-#' @rdname set_label
-#' @export
-
-set_label.data.frame <- function(x, ...){
-
-  if (!inherits(x, "data.frame")){
-    stop("`x` must inherit class 'data.frame'")
-  }
-
-  lbl <- list(...)
-
-  vars <- names(lbl)
-
-  not_in_data <- vars[!vars %in% names(x)]
-
-  if (length(not_in_data)){
-    stop("The following are not variables in `x`: ",
-         paste0(not_in_data, collapse = ", "))
-  }
-
-  is_atomic <-
-    vapply(x[vars],
-           is.atomic,
-           logical(1))
-
-  if (any(!is_atomic)){
-    stop("The following variables in `x` are not atomic: ",
-         paste0(vars[!is_atomic], collapse = ", "))
-  }
-
-  x[vars] <-
-    mapply(function(v, lbl) set_label.default(x[[v]], lbl),
-           v = vars,
-           lbl = lbl,
-           SIMPLIFY = FALSE)
-
-  x
-}
+#' @name set_label
+#' @title Set the label of an atomic vector
+#'
+#' @description Variable labels are a common construct in statistical
+#'   software, giving users the ability to provide plain text descriptions
+#'   for variables.  These descriptions can be more informative of the
+#'   variable's purpose, since they need not be restricted to the naming
+#'   conventions imposed on variable names.
+#'
+#' @param x An atomic vector
+#' @param label \code{character(1)}, A character string denoting the label
+#'   to assign to the variable.
+#' @param ... For the default method, arguments to pass to other methods.
+#'   For the \code{data.frame} method, key-pairs of the pattern
+#'   \code{variable = 'label'}.
+#'
+#' @seealso \code{\link{get_label}}
+#'
+#' @source
+#' Frank E Harrell Jr, with contributions from Charles Dupont and many
+#' others. (2017). Hmisc: Harrell Miscellaneous. R package version 4.0-3.
+#' https://CRAN.R-project.org/package=Hmisc
+#'
+#' @examples
+#' x <- 1:10
+#' x <- set_label(x, "Integers")
+#' x
+#'
+#' # Set labels for variables in a data frame
+#'
+#' mtcars2 <-
+#'   set_label(mtcars,
+#'             am = "Automatic / Manual",
+#'             mpg = "Miles per Gallon",
+#'             gear = "Number of gears")
+#'
+#' get_label(mtcars2)
+#'
+#' @export
+
+set_label <- function(x, ...){
+  UseMethod("set_label")
+}
+
+#' @rdname set_label
+#' @export
+
+set_label.default <- function(x, label, ...){
+  if (!is.atomic(x)){
+    stop("`x` must be an atomic vector")
+  }
+
+  if (!is.character(label) | length(label) != 1){
+    stop("`label` must be a length 1 character string")
+  }
+
+  structure(x,
+            label = label,
+            class = c("labelled", class(x)[!class(x) %in% "labelled"]))
+}
+
+#' @rdname set_label
+#' @export
+
+set_label.data.frame <- function(x, ...){
+
+  if (!inherits(x, "data.frame")){
+    stop("`x` must inherit class 'data.frame'")
+  }
+
+  lbl <- list(...)
+
+  vars <- names(lbl)
+
+  not_in_data <- vars[!vars %in% names(x)]
+
+  if (length(not_in_data)){
+    stop("The following are not variables in `x`: ",
+         paste0(not_in_data, collapse = ", "))
+  }
+
+  is_atomic <-
+    vapply(x[vars],
+           is.atomic,
+           logical(1))
+
+  if (any(!is_atomic)){
+    stop("The following variables in `x` are not atomic: ",
+         paste0(vars[!is_atomic], collapse = ", "))
+  }
+
+  x[vars] <-
+    mapply(function(v, lbl) set_label.default(x[[v]], lbl),
+           v = vars,
+           lbl = lbl,
+           SIMPLIFY = FALSE)
+
+  x
+}

cran-comments.md

@@ -4,6 +4,10 @@
 * win-builder devel (2017-09-12 r73242)
 
 ## R CMD check results
+Thank you for providing such a useful review.  I have quoted the package names in 
+the description. I have also added extraction and replacement methods for the 
+labelled class, as well as additional tests to ensure the desired behavior.
+
 This is the initial release of a new package.  This package is necessitated by recent
 changes to the 'Hmisc' package, which no longer exports methods I have been using 
 in the 'redcapAPI' and 'lazyWeave' packages.  I will update those two packages using 

tests/testthat/test-extract_labelled.R

@@ -0,0 +1,38 @@
+context("Extract and Replace labelled vectors")
+
+test_that(
+  "subsets retain the label attribute",
+  {
+    for (av in c("logical", "integer", "numeric", "complex", "character", "raw")){
+      x <- set_label(vector(av, 10), av)
+      y <- x[1:3]
+      expect_equal(get_label(y),
+                   get_label(x))
+    }
+  }
+)
+
+
+test_that(
+  "reassignments retain the label attribute",
+  {
+    for (av in c("logical", "integer", "numeric", "complex", "character", "raw")){
+      x <- set_label(vector(av, 10), av)
+      y <- x
+      y[4] <- vector(av, 1)
+      expect_equal(get_label(y),
+                   get_label(x))
+    }
+  }
+)
+
+
+test_that(
+  "reassignments allow for changing classes",
+  {
+    x <- set_label(1:10, "integers")
+    x[3] <- pi
+    expect_equivalent(unclass(x[3]),
+                      pi)
+  }
+)