corrected bug in reformat_sex

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: poputils
 Type: Package
 Title: Miscellaneous Functions for Demographic Analysis
-Version: 0.1.0
+Version: 0.1.1
 Authors@R: 
     c(person(given = "John",
              family = "Bryant",
@@ -13,7 +13,7 @@ Description: Miscellaneous functions for demographic
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Depends:
     R (>= 4.3.0)
 LinkingTo: 

R/sexgender.R

@@ -41,42 +41,43 @@
 #'              factor = FALSE)
 #' @export
 reformat_sex <- function(x, except = NULL, factor = TRUE) {
-    synonyms_female <- c("females", "female", "fem", "fe", "f", "women", "girls")
-    synonyms_male <- c("males", "male", "ma", "m", "men", "boys")
-    has_except <- !is.null(except)
-    if (has_except && !is.vector(except) && !is.factor(except))
-        cli::cli_abort(c("{.arg except} is not a vector or a factor.",
-                         i = "{.arg except} has class {.cls {class(except)}}."))
-    except <- unique(except)
-    check_flag(factor)
-    is_na <- is.na(x)
-    x_new <- gsub("\\s", "", x)
-    x_new <- tolower(x_new)
-    is_female <- x_new %in% synonyms_female
-    is_male <- x_new %in% synonyms_male
-    is_valid <- is_na | is_female | is_male
-    if (has_except) {
-        is_except <- x %in% except
-        is_valid <- is_valid | is_except
-    }
-    i_invalid <- match(FALSE, is_valid, nomatch = 0L)
-    if (i_invalid > 0L)
-        cli::cli_abort("Can't parse label {.val {x[[i_invalid]]}}.")
-    x[is_female] <- "Female"
-    x[is_male] <- "Male"
-    x[is_na] <- NA
-    if (factor) {
-        levels <- c("Female", "Male")
-        if (any(is_na))
-            levels <- c(levels, NA)
-        if (has_except)
-            levels <- c(levels, except)
-        factor(x,
-               levels = levels,
-               exclude = character())
-    }
-    else
-        x
+  synonyms_female <- c("females", "female", "fem", "fe", "f", "women", "girls")
+  synonyms_male <- c("males", "male", "ma", "m", "men", "boys")
+  has_except <- !is.null(except)
+  if (has_except && !is.vector(except) && !is.factor(except))
+    cli::cli_abort(c("{.arg except} is not a vector or a factor.",
+                     i = "{.arg except} has class {.cls {class(except)}}."))
+  except <- unique(except)
+  check_flag(factor)
+  is_na <- is.na(x)
+  x_new <- gsub("\\s", "", x)
+  x_new <- tolower(x_new)
+  is_female <- x_new %in% synonyms_female
+  is_male <- x_new %in% synonyms_male
+  is_valid <- is_na | is_female | is_male
+  if (has_except) {
+    is_except <- x %in% except
+    is_valid <- is_valid | is_except
+  }
+  i_invalid <- match(FALSE, is_valid, nomatch = 0L)
+  if (i_invalid > 0L)
+    cli::cli_abort("Can't parse label {.val {x[[i_invalid]]}}.")
+  x <- as.character(x)
+  x[is_female] <- "Female"
+  x[is_male] <- "Male"
+  x[is_na] <- NA
+  if (factor) {
+    levels <- c("Female", "Male")
+    if (any(is_na))
+      levels <- c(levels, NA)
+    if (has_except)
+      levels <- c(levels, except)
+    factor(x,
+           levels = levels,
+           exclude = character())
+  }
+  else
+    x
 }    
 
 

tests/testthat/test-sexgender.R

@@ -47,6 +47,13 @@ test_that("'reformat_sex' works with factor except", {
     expect_identical(ans_obtained, ans_expected)
 })
 
+test_that("'reformat_sex' works x is factor", {
+    x <- factor(c("F", "M", NA))
+    ans_obtained <- reformat_sex(x)
+    ans_expected <- factor(c("Female", "Male", NA), exclude = NULL)
+    expect_identical(ans_obtained, ans_expected)
+})
+
 test_that("'reformat_sex' throws correct error with invalid except", {
     expect_error(reformat_sex("M", except = lm),
                  "`except` is not a vector or a factor.")