Arguments include.non.labelled and include.values in `get_labels(…

…)` are renamed to shorter versions `non.labelled` and `values`. `include.non.labelled` and `include.values` will become softly deprecated.
strengejacke · Aug 6, 2018 · 03b0c43 · 03b0c43
1 parent e50fa92
commit 03b0c43
Show file tree

Hide file tree

Showing 19 changed files with 140 additions and 108 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -7,6 +7,8 @@
 ## Changes to functions
 
 * `copy_labels()` now also copy labels even if columns in subsetted and original data frame do not completely match.
+* Arguments `include.non.labelled` and `include.values` in `get_labels()` are renamed to shorter versions `non.labelled` and `values`. `include.non.labelled` and `include.values` will become softly deprecated.
+
 
 ## Bug fixes
 

diff --git a/R/add_labels.R b/R/add_labels.R
@@ -39,9 +39,8 @@
 #'          \code{replace_labels()} is an alias for \code{add_labels()}.
 #'
 #' @examples
-#' # ----------------------
 #' # add_labels()
-#' # ----------------------
+
 #' data(efc)
 #' get_labels(efc$e42dep)
 #'
@@ -58,14 +57,14 @@
 #' get_labels(x)
 #'
 #' x <- add_labels(efc$e42dep, labels = c(`nothing` = 5, `zero value` = 0))
-#' get_labels(x, include.values = "p")
+#' get_labels(x, values = "p")
 #'
 #' # replace old value labels
 #' x <- add_labels(
 #'   efc$e42dep,
 #'   labels = c(`not so dependent` = 4, `lorem ipsum` = 5)
 #' )
-#' get_labels(x, include.values = "p")
+#' get_labels(x, values = "p")
 #'
 #' # replace specific missing value (tagged NA)
 #' library(haven)
@@ -79,14 +78,13 @@
 #' replace_labels(x, labels = c("Second" = tagged_na("c")))
 #'
 #'
-#' # ----------------------
 #' # remove_labels()
-#' # ----------------------
+#'
 #' x <- remove_labels(efc$e42dep, labels = 2)
-#' get_labels(x, include.values = "p")
+#' get_labels(x, values = "p")
 #'
 #' x <- remove_labels(efc$e42dep, labels = "independent")
-#' get_labels(x, include.values = "p")
+#' get_labels(x, values = "p")
 #'
 #' library(haven)
 #' x <- labelled(c(1:3, tagged_na("a", "c", "z"), 4:1),
@@ -128,8 +126,8 @@ add_labels_helper <- function(x, value) {
   current.labels <- get_labels(
     x,
     attr.only = T,
-    include.values = "n",
-    include.non.labelled = F,
+    values = "n",
+    non.labelled = F,
     drop.na = TRUE
   )
 

diff --git a/R/as_factor.R b/R/as_factor.R
@@ -56,11 +56,11 @@
 #'
 #' # only copy existing value labels
 #' as_factor(x)
-#' get_labels(as_factor(x), include.values = "p")
+#' get_labels(as_factor(x), values = "p")
 #'
 #' # also add labels to non-labelled values
 #' as_factor(x, add.non.labelled = TRUE)
-#' get_labels(as_factor(x, add.non.labelled = TRUE), include.values = "p")
+#' get_labels(as_factor(x, add.non.labelled = TRUE), values = "p")
 #'
 #'
 #' # easily coerce specific variables in a data frame to factor
@@ -102,12 +102,12 @@ to_fac_helper <- function(x, add.non.labelled) {
     get_labels(
       x,
       attr.only = TRUE,
-      include.values = "n",
-      include.non.labelled = add.non.labelled
+      values = "n",
+      non.labelled = add.non.labelled
     )
 
   # retrieve variable labels
-  varlab <- get_label(x)
+  varlab <- attr(x, "label", exact = T)
 
   # switch value and names attribute, since get_labels
   # returns the values as names, and the value labels
@@ -138,7 +138,7 @@ to_fac_helper <- function(x, add.non.labelled) {
     )
 
   # set back variable labels
-  x <- set_label(x, label = varlab)
+  attr(x, "label") <- varlab
 
   x
 }
diff --git a/R/fill_labels.R b/R/fill_labels.R
@@ -20,12 +20,12 @@ fill_labels <- function(x, ...) {
 
 fill_labels_helper <- function(x) {
   # get current labels
-  current.values <- get_labels(x, attr.only = T, include.non.labelled = F)
+  current.values <- get_labels(x, attr.only = T, non.labelled = F)
   # get all labels, including non-labelled values
   all.values <- get_labels(x,
                            attr.only = T,
-                           include.values = "n",
-                           include.non.labelled = T)
+                           values = "n",
+                           non.labelled = T)
   # have any values?
   if (!is.null(all.values)) {
     # set back all labels, if amount of all labels differ

diff --git a/R/get_labels.R b/R/get_labels.R
@@ -15,17 +15,17 @@
 #'          (vector) with value label attributes; or a \code{list} of variables
 #'          with values label attributes. If \code{x} has no label attributes,
 #'          factor levels are returned. See 'Examples'.
-#' @param include.values String, indicating whether the values associated with the
-#'          value labels are returned as well. If \code{include.values = "as.name"}
-#'          (or \code{include.values = "n"}), values are set as \code{names}
-#'          attribute of the returned object. If \code{include.values = "as.prefix"}
-#'          (or \code{include.values = "p"}), values are included as prefix
+#' @param values,include.values String, indicating whether the values associated with the
+#'          value labels are returned as well. If \code{values = "as.name"}
+#'          (or \code{values = "n"}), values are set as \code{names}
+#'          attribute of the returned object. If \code{values = "as.prefix"}
+#'          (or \code{values = "p"}), values are included as prefix
 #'          to each label. See 'Examples'.
 #' @param attr.only Logical, if \code{TRUE}, labels are only searched for
 #'          in the the vector's \code{attributes}; else, if \code{attr.only = FALSE}
 #'          and \code{x} has no label attributes, factor levels or string values
 #'          are returned. See 'Examples'.
-#' @param include.non.labelled Logical, if \code{TRUE}, values without labels will
+#' @param non.labelled,include.non.labelled Logical, if \code{TRUE}, values without labels will
 #'          also be included in the returned labels (see \code{\link{fill_labels}}).
 #' @param drop.na Logical, whether labels of tagged NA values (see \code{\link[haven]{tagged_na}})
 #'          should be included in the return value or not. By default, labelled
@@ -59,10 +59,10 @@
 #'         main = get_label(efc$e42dep))
 #'
 #' # include associated values
-#' get_labels(efc$e42dep, include.values = "as.name")
+#' get_labels(efc$e42dep, values = "as.name")
 #'
 #' # include associated values
-#' get_labels(efc$e42dep, include.values = "as.prefix")
+#' get_labels(efc$e42dep, values = "as.prefix")
 #'
 #' # get labels from multiple variables
 #' get_labels(list(efc$e42dep, efc$e16sex, efc$e15relat))
@@ -90,7 +90,7 @@
 #' # get labels for labelled values only
 #' get_labels(x)
 #' # get labels for all values
-#' get_labels(x, include.non.labelled = TRUE)
+#' get_labels(x, non.labelled = TRUE)
 #'
 #'
 #' # get labels, including tagged NA values
@@ -100,7 +100,7 @@
 #'                 "Refused" = tagged_na("a"), "Not home" = tagged_na("z")))
 #' # get current NA values
 #' x
-#' get_labels(x, include.values = "n", drop.na = FALSE)
+#' get_labels(x, values = "n", drop.na = FALSE)
 #'
 #'
 #' # create vector with unused labels
@@ -111,35 +111,57 @@
 #' )
 #' get_labels(efc$e42dep)
 #' get_labels(efc$e42dep, drop.unused = TRUE)
-#' get_labels(efc$e42dep, include.non.labelled = TRUE, drop.unused = TRUE)
+#' get_labels(efc$e42dep, non.labelled = TRUE, drop.unused = TRUE)
 #'
 #' @export
-get_labels <- function(x, attr.only = FALSE, include.values = NULL,
-                       include.non.labelled = FALSE, drop.na = TRUE, drop.unused = FALSE) {
+get_labels <- function(x, attr.only = FALSE, values = NULL,
+                       non.labelled = FALSE, drop.na = TRUE, drop.unused = FALSE, include.values = NULL, include.non.labelled = NULL) {
   UseMethod("get_labels")
 }
 
 #' @export
-get_labels.data.frame <- function(x, attr.only = FALSE, include.values = NULL,
-                                  include.non.labelled = FALSE, drop.na = TRUE,
-                                  drop.unused = FALSE) {
-  lapply(x, FUN = get_labels_helper, attr.only = attr.only, include.values = include.values,
-         include.non.labelled = include.non.labelled, drop.na = drop.na, drop.unused = drop.unused)
+get_labels.data.frame <- function(x, attr.only = FALSE, values = NULL,
+                                  non.labelled = FALSE, drop.na = TRUE,
+                                  drop.unused = FALSE,
+                                  include.values = NULL, include.non.labelled = NULL) {
+
+  ## TODO remove later
+
+  if (!missing(include.values)) values <- include.values
+  if (!missing(include.non.labelled)) non.labelled <- include.non.labelled
+
+  lapply(x, FUN = get_labels_helper, attr.only = attr.only, include.values = values,
+         include.non.labelled = non.labelled, drop.na = drop.na, drop.unused = drop.unused)
 }
 
 #' @export
-get_labels.list <- function(x, attr.only = FALSE, include.values = NULL,
-                            include.non.labelled = FALSE, drop.na = TRUE, drop.unused = FALSE) {
-  lapply(x, FUN = get_labels_helper, attr.only = attr.only, include.values = include.values,
-         include.non.labelled = include.non.labelled, drop.na = drop.na, drop.unused = drop.unused)
+get_labels.list <- function(x, attr.only = FALSE, values = NULL,
+                            non.labelled = FALSE, drop.na = TRUE,
+                            drop.unused = FALSE,
+                            include.values = NULL, include.non.labelled = NULL) {
+
+  ## TODO remove later
+
+  if (!missing(include.values)) values <- include.values
+  if (!missing(include.non.labelled)) non.labelled <- include.non.labelled
+
+  lapply(x, FUN = get_labels_helper, attr.only = attr.only, include.values = values,
+         include.non.labelled = non.labelled, drop.na = drop.na, drop.unused = drop.unused)
 }
 
 #' @export
-get_labels.default <- function(x, attr.only = FALSE, include.values = NULL,
-                               include.non.labelled = FALSE, drop.na = TRUE,
-                               drop.unused = FALSE) {
-  get_labels_helper(x, attr.only = attr.only, include.values = include.values,
-                    include.non.labelled = include.non.labelled, drop.na = drop.na,
+get_labels.default <- function(x, attr.only = FALSE, values = NULL,
+                               non.labelled = FALSE, drop.na = TRUE,
+                               drop.unused = FALSE,
+                               include.values = NULL, include.non.labelled = NULL) {
+
+  ## TODO remove later
+
+  if (!missing(include.values)) values <- include.values
+  if (!missing(include.non.labelled)) non.labelled <- include.non.labelled
+
+  get_labels_helper(x, attr.only = attr.only, include.values = values,
+                    include.non.labelled = non.labelled, drop.na = drop.na,
                     drop.unused = drop.unused)
 }
 

diff --git a/R/remove_labels.R b/R/remove_labels.R
@@ -29,8 +29,8 @@ remove_labels_helper <- function(x, labels) {
   # get current labels of `x`
   current.labels <- get_labels(x,
                                attr.only = T,
-                               include.values = "n",
-                               include.non.labelled = F)
+                               values = "n",
+                               non.labelled = F)
 
   # get current NA values
   current.na <- get_na(x)

diff --git a/R/set_label.R b/R/set_label.R
@@ -45,9 +45,11 @@
 #'
 #'
 #' # Set variable labels for data frame
-#' dummy <- data.frame(a = sample(1:4, 10, replace = TRUE),
-#'                     b = sample(1:4, 10, replace = TRUE),
-#'                     c = sample(1:4, 10, replace = TRUE))
+#' dummy <- data.frame(
+#'   a = sample(1:4, 10, replace = TRUE),
+#'   b = sample(1:4, 10, replace = TRUE),
+#'   c = sample(1:4, 10, replace = TRUE)
+#' )
 #' dummy <- set_label(dummy, c("Variable A", "Variable B", "Variable C"))
 #' str(dummy)
 #'
@@ -73,9 +75,11 @@
 #' # use 'var_labels()' to set labels within a pipe-workflow, and
 #' # when you need "tidyverse-consistent" api.
 #' # Set variable labels for data frame
-#' dummy <- data.frame(a = sample(1:4, 10, replace = TRUE),
-#'                     b = sample(1:4, 10, replace = TRUE),
-#'                     c = sample(1:4, 10, replace = TRUE))
+#' dummy <- data.frame(
+#'   a = sample(1:4, 10, replace = TRUE),
+#'   b = sample(1:4, 10, replace = TRUE),
+#'   c = sample(1:4, 10, replace = TRUE)
+#' )
 #'
 #' dummy %>%
 #'   var_labels(a = "First variable", c = "third variable") %>%

diff --git a/R/set_labels.R b/R/set_labels.R
@@ -95,9 +95,11 @@
 #'
 #'
 #' library(haven)
-#' x <- labelled(c(1:3, tagged_na("a", "c", "z"), 4:1),
-#'               c("Agreement" = 1, "Disagreement" = 4, "First" = tagged_na("c"),
-#'                 "Refused" = tagged_na("a"), "Not home" = tagged_na("z")))
+#' x <- labelled(
+#'   c(1:3, tagged_na("a", "c", "z"), 4:1),
+#'   c("Agreement" = 1, "Disagreement" = 4, "First" = tagged_na("c"),
+#'     "Refused" = tagged_na("a"), "Not home" = tagged_na("z"))
+#' )
 #' # get current NA values
 #' x
 #' get_na(x)
@@ -118,8 +120,8 @@
 #'              `severe dependency` = 2,
 #'              `missing value` = 9)
 #'   )
-#' get_labels(x, include.values = "p")
-#' get_labels(x, include.values = "p", include.non.labelled = TRUE)
+#' get_labels(x, values = "p")
+#' get_labels(x, values = "p", non.labelled = TRUE)
 #'
 #' # labels can also be set for tagged NA value
 #' # create numeric vector

diff --git a/R/tidy_labels.R b/R/tidy_labels.R
@@ -62,7 +62,7 @@ tidy_labels_helper <- function(x, sep, remove) {
     get_labels(
       x,
       attr.only = TRUE,
-      include.values = FALSE,
+      values = FALSE,
       drop.unused = TRUE,
       drop.na = TRUE
     )

diff --git a/R/to_label.R b/R/to_label.R
@@ -176,16 +176,16 @@ as_label_helper <- function(x, add.non.labelled, prefix, var.label, drop.na, dro
   }
 
   # get value labels
-  vl <- get_labels(x, attr.only = TRUE, include.values = iv,
-                   include.non.labelled = add.non.labelled,
+  vl <- get_labels(x, attr.only = TRUE, values = iv,
+                   non.labelled = add.non.labelled,
                    drop.na = drop.na)
 
   # check if we have any labels, else
   # return variable "as is"
   if (!is.null(vl)) {
     # get associated values for value labels
-    vnn <- get_labels(x, attr.only = TRUE, include.values = "n",
-                      include.non.labelled = add.non.labelled,
+    vnn <- get_labels(x, attr.only = TRUE, values = "n",
+                      non.labelled = add.non.labelled,
                       drop.na = drop.na)
 
     # convert to numeric

diff --git a/R/to_value.R b/R/to_value.R
@@ -111,7 +111,7 @@ as_numeric_helper <- function(x, start.at, keep.labels, use.labels) {
   varlab <- get_label(x)
 
   # get labels
-  labels <- get_labels(x, attr.only = T, include.values = "n")
+  labels <- get_labels(x, attr.only = T, values = "n")
 
   # get values, if these should be used after converting
   values <- get_values(x)

diff --git a/R/zap_labels.R b/R/zap_labels.R
@@ -111,7 +111,7 @@
 #' fill_labels(x)
 #' get_labels(fill_labels(x))
 #' # same as
-#' get_labels(x, include.non.labelled = TRUE)
+#' get_labels(x, non.labelled = TRUE)
 #'
 #' @importFrom stats na.omit
 #' @export