feat: release 0.3.0 on CRAN (#13)

* Add examples to all exported functions
* Update README with install directions
* Change license to MIT
* Update lifecycle badge

.Rbuildignore

@@ -8,3 +8,4 @@
 ^pkgdown$
 ^cran-comments\.md$
 ^CRAN-RELEASE$
+^CRAN-SUBMISSION$

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 0.3.0
+Date: 2023-10-05 16:22:23 UTC
+SHA: f643a2445897e69e156e1de7d57b450564967b96

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rcoder
 Type: Package
 Title: Lightweight Data Structure for Recoding Categorical Data without Factors
-Version: 0.2.3
+Version: 0.3.0
 Authors@R: 
     c(person(
             given = "Patrick", 
@@ -15,7 +15,7 @@ Authors@R:
             comment = "https://steinhardt.nyu.edu/ihdsc/global-ties"))
 Description: A data structure and toolkit for documenting and recoding
     categorical data that can be shared in other statistical software.
-License: GPL-3
+License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Depends:
@@ -29,3 +29,5 @@ Suggests:
     tidyfast,
     magrittr
 RoxygenNote: 7.2.1
+URL: https://github.com/nyuglobalties/rcoder
+BugReports: https://github.com/nyuglobalties/rcoder/issues

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2023
+COPYRIGHT HOLDER: rcoder authors

NAMESPACE

@@ -18,6 +18,7 @@ export(link_codings)
 export(make_recode_query)
 export(matches_coding)
 export(missing_codes)
+export(odk_to_coding)
 export(recode_vec)
 export(verify_matches_coding)
 importFrom(glue,glue)

NEWS.md

@@ -1,3 +1,7 @@
+# rcoder 0.3.0
+* Fill out examples for all exported functions
+* Adds `odk_to_coding()` as a complement to `coding_to_odk()`
+
 # rcoder 0.2.3
 * Fixes issue where coding deparsing could result in multi-length character vector
 

R/checking.R

@@ -9,8 +9,14 @@
 #' @return TRUE/FALSE
 #'
 #' @export
+#' @examples
+#' vec1 <- sample(1:2, 10, replace = TRUE)
+#' vec2 <- sample(0:1, 10, replace = TRUE)
+#' cdng <- coding(code("Yes", 1), code("No", 0))
+#' matches_coding(vec1, cdng)
+#' matches_coding(vec2, cdng)
 matches_coding <- function(vec, coding, ignore_empty = TRUE) {
-  rc_assert(is.coding(coding), "{ui_value(substitute(coding))} is not a coding object.")
+  rc_assert(is_coding(coding), "{ui_value(substitute(coding))} is not a coding object.")
 
   if (!is.vector(vec)) {
     return(FALSE)

R/code.R

@@ -12,8 +12,18 @@
 #'   for recoding purposes.
 #' @param missing Whether this `code` represents a missing response
 #' @param ... Any extra metadata
+#' @return A `code` object that contains the key-value map of label to value
 #'
 #' @export
+#' @examples
+#' code("Yes", 1)
+#' code("No", 0)
+#' code(
+#'   "No response", -88,
+#'   description = "Participant ignored question when prompted",
+#'   missing = TRUE
+#' )
+#' code("Missing", NA, links_from = c("Refused", "Absent"))
 code <- function(label,
                  value,
                  description = label,
@@ -107,4 +117,5 @@ as.data.frame.code <- function(x, ...) {
   }
 
   as.data.frame(dplyr::as_tibble(c(x)))
-}
+}
+

R/coding.R

@@ -9,8 +9,12 @@
 #'
 #' @param ... A collection of `code` objects
 #' @param .label A label for this coding, available for interoperability
+#' @return A `coding` object that contains each `code` input
 #'
 #' @export
+#' @examples
+#' coding(code("Yes", 1), code("No", 0), code("Not applicable", NA))
+#' empty_coding()
 coding <- function(..., .label = NULL) {
   if (missing(..1)) {
     return(empty_coding())
@@ -22,7 +26,10 @@ coding <- function(..., .label = NULL) {
     rc_err("coding() only accepts code objects as arguments.")
   }
 
-  loc_labels <- lapply(seq_along(codes), function(i) list(index = i, label = codes[[i]]$label))
+  loc_labels <- lapply(
+    seq_along(codes),
+    function(i) list(index = i, label = codes[[i]]$label)
+  )
   labels <- vcapply(loc_labels, function(x) x$label)
 
   if (any(duplicated(labels))) {
@@ -70,16 +77,20 @@ empty_coding <- function() {
 #' @param x An object
 #' @return TRUE/FALSE if the object is identical to `empty_coding()`
 #' @export
+#' @examples
+#' is_empty_coding(empty_coding())
+#' is_empty_coding(coding())
+#' is_empty_coding(coding(code("Yes", 1), code("No", 0)))
 is_empty_coding <- function(x) {
   identical(x, empty_coding())
 }
 
-is.coding <- function(x) inherits(x, "coding")
+is_coding <- function(x) inherits(x, "coding")
 
 labels.coding <- function(x, ...) attr(x, "labels", exact = TRUE)
 
 select_codes_if <- function(.coding, .p, ...) {
-  rc_assert(is.coding(.coding) && is.function(.p))
+  rc_assert(is_coding(.coding) && is.function(.p))
 
   matching_codes <- vlapply(.coding, function(.x) .p(.x, ...))
 
@@ -98,7 +109,7 @@ select_codes_by_label <- function(.coding, .labels) {
 }
 
 coding_values <- function(coding) {
-  stopifnot(is.coding(coding))
+  stopifnot(is_coding(coding))
 
   if (is_empty_coding(coding)) {
     return(logical())
@@ -120,7 +131,7 @@ coding_values <- function(coding) {
 #' missing_codes(coding(code("Yes", 1), code("No", 0), code("Missing", NA)))
 #' missing_codes(coding(code("Yes", 1), code("No", 0)))
 missing_codes <- function(coding) {
-  rc_assert(is.coding(coding))
+  rc_assert(is_coding(coding))
 
   if (is_empty_coding(coding)) {
     return(coding)
@@ -154,15 +165,19 @@ coding_label <- function(coding) {
 
 #' @export
 as.data.frame.coding <- function(x,
-                                 row.names = NULL,
+                                 row.names = NULL, # nolint
                                  optional = NULL,
                                  suffix = NULL,
                                  ...) {
   out <- coding_contents(x)
 
   if (!is.null(suffix)) {
     stopifnot(is.character(suffix) || is_positive_integer(suffix))
-    names(out) <- ifelse(names(out) == "link", names(out), paste0(names(out), "_", suffix))
+    names(out) <- ifelse(
+      names(out) == "link",
+      names(out),
+      paste0(names(out), "_", suffix)
+    )
   }
 
   out
@@ -233,6 +248,8 @@ as.character.coding <- function(x, include_links_from = FALSE, ...) {
 #' @param expr An expression
 #' @return An evaluated `coding` object
 #' @export
+#' @examples
+#' eval_coding('coding(code("Yes", 1), code("No", 0))')
 eval_coding <- function(expr) {
   rc_assert(rlang::is_expression(expr))
 

R/interop.R

@@ -10,9 +10,13 @@
 #' @param coding A coding object
 #' @return A data.frame or tibble that can be included in an XLSForm 'choices'
 #'         sheet
+#' @seealso [odk_to_coding()]
 #' @export
+#' @examples
+#' cdng <- coding(code("Yes", 1), code("No", 0), .label = "yesno")
+#' coding_to_odk(cdng)
 coding_to_odk <- function(coding) {
-  rc_assert(is.coding(coding))
+  rc_assert(is_coding(coding))
 
   if (is_empty_coding(coding)) {
     return(NULL)
@@ -35,6 +39,56 @@ coding_to_odk <- function(coding) {
   )
 }
 
+#' Convert ODK choices to a coding
+#'
+#' ODK XLSForms link the categorical codings to a variable type name in the
+#' 'survey' sheet. The codings are specified in the 'choices' sheet which has
+#' a `list_name` column that holds the variable type names. Each row that has
+#' that name will be associated with that categorical type coding. This function
+#' converts subsets of the choices sheet into individual 'coding' objects.
+#'
+#' @param choice_table A data.frame slice of the "choices" table from an
+#'   XLSForm
+#' @return A `coding` object that corresponds to the choices' slice
+#' @seealso [coding_to_odk()]
+#' @export
+#' @examples
+#' choice_excerpt <- data.frame(
+#'   list_name = rep("yesno", 2),
+#'   name = c("Yes", "No"),
+#'   label = c(1, 0)
+#' )
+#'
+#' odk_to_coding(choice_excerpt)
+odk_to_coding <- function(choice_table) {
+  ct_sym <- deparse1(substitute(choice_table)) # nolint
+
+  rc_assert(
+    is.data.frame(choice_table),
+    msg = "{ui_value(ct_sym)} must be a data.frame"
+  )
+
+  expected_cols <- c("list_name", "name", "label")
+
+  for (ec in expected_cols) {
+    if (!ec %in% names(choice_table)) {
+      rc_err("Expected column `{ec}` not found in {ui_value(ct_sym)}")
+    }
+  }
+
+  rc_assert(
+    length(unique(choice_table[["list_name"]])) == 1,
+    msg = "`{ui_value(ct_sym)}` has multiple `list_name` values"
+  )
+
+  choice_table <- unique(choice_table)
+  codes <- lapply(seq_len(nrow(choice_table)), function(i) {
+    code(label = choice_table[["name"]][i], value = choice_table[["label"]][i])
+  })
+
+  do.call(coding, codes)
+}
+
 #' Convert coding to `haven`-compatible labels
 #'
 #' Converts a `coding` object into a named vector to be used in the `labels`
@@ -43,8 +97,11 @@ coding_to_odk <- function(coding) {
 #' @param coding A coding object
 #' @return A named vector representation of the coding
 #' @export
+#' @examples
+#' cdng <- coding(code("Yes", 1), code("No", 0))
+#' coding_to_haven_labels(cdng)
 coding_to_haven_labels <- function(coding) {
-  rc_assert(is.coding(coding))
+  rc_assert(is_coding(coding))
 
   if (is_empty_coding(coding)) {
     return(NULL)

R/linking.R

@@ -6,34 +6,54 @@
 #'
 #' @param to A coding to be linked to
 #' @param ... Codings to be linked from
-#' @param .to_suffix A suffix signifying which columns in the output `data.frame`
-#'   came from `to`
+#' @param .to_suffix A suffix signifying which columns in the output
+#'   `data.frame` came from `to`
 #' @param .drop_unused Logical flag to drop any codes in `...` that have no
 #'   counterparts in `to`
 #' @return A `linked_coding_df` with all necessary information for a recoding
 #'   query
 #'
 #' @export
+#' @examples
+#' wave1 <- coding(
+#'   code("Yes", 1),
+#'   code("No", 2),
+#'   code("Refused", -88, missing = TRUE)
+#' )
+#' wave2 <- coding(
+#'   code("Yes", "y"),
+#'   code("No", "n"),
+#'   code("Missing", ".", missing = TRUE)
+#' )
+#' link_codings(
+#'   to = coding(
+#'     code("Yes", 1),
+#'     code("No", 0),
+#'     code("Missing", NA, links_from = c("Refused", "Missing"))
+#'   ),
+#'   wave1,
+#'   wave2
+#' )
 link_codings <- function(to, ..., .to_suffix = "to", .drop_unused = FALSE) {
-  rc_assert(is.coding(to))
+  rc_assert(is_coding(to))
 
   from <- rlang::dots_list(...)
 
   if (length(from) == 1) {
     from <- from[[1]]
   }
 
-  if (!is.coding(from)) {
+  if (!is_coding(from)) {
     if (!is.list(from)) {
       rc_err("`...` must be a coding or codings.")
     }
 
-    if (!all(vlapply(from, is.coding))) {
+    if (!all(vlapply(from, is_coding))) {
       rc_err("Not all of `...` is a coding object.")
     }
   }
 
-  if (!is.coding(from)) {
+  if (!is_coding(from)) {
     from_dat <- coding_list_to_df(from)
   } else {
     from_dat <- as.data.frame(from, suffix = 1)
@@ -86,7 +106,7 @@ coding_list_to_df <- function(coding_list) {
     # Assumed to be the wave tags
     names(coding_list)
   } else {
-    1:length(coding_list)
+    seq_along(coding_list)
   }
 
   mapped <- Map(
@@ -107,4 +127,4 @@ drop_unused_links <- function(to_dat, from_dat) {
   to_links <- to_dat$link
 
   from_links[from_links %in% to_links, ]
-}
+}