cleans up sort_names(); resolves #26

NEWS.md

@@ -20,6 +20,7 @@
 * adds `tableNA()` to make a table from `NA` values
 * `round_by()` gains an additional argument `include0` which if `FALSE` will replace `0` values with `by`
 * `assign_labels.data.frame()` gains an additional argument `.missing` to set how to control for missing labels: you can now use a `warning` for a missing label (instead of an error) or silently ignore any missing labels
+* `sort_names()` gains a new argument `numeric` to try to sort names of `x` by their numeric value
 
 # mark 0.1.4
 

R/names.R

@@ -7,17 +7,19 @@ is_named <- function(x) {
 #'
 #' Sort a vector by it's name
 #'
-#' @param x A vector
-#' @return `x`. sorted by its `names()`
+#' @param x A named vector of values
+#' @param numeric If `TRUE` will try to coerce to numeric
+#' @return `x` sorted by its `names()`
 #' @export
-sort_names <- function(x) {
+sort_names <- function(x, numeric = FALSE) {
   check_is_vector(x)
+  nm <- names(x) %||% stop("x must be a named vector", call. = FALSE)
 
-  if (!is_named(x)) {
-    stop("x must be a named vector", call. = FALSE)
+  if (numeric) {
+    nm <- as.numeric(nm)
   }
 
-  x[sort(names(x))]
+  sort_by(x, nm)
 }
 
 #' Set names
@@ -45,9 +47,6 @@ remove_names <- function(x) {
 #' @rdname set_names0
 #' @export
 names_switch <- function(x) {
-  if (!is_named(x)) {
-    stop("x must be named", call. = FALSE)
-  }
-
-  set_names0(names(x), as.vector(x, "character"))
+  nm <- names(x) %||% stop("x must be named", call. = FALSE)
+  set_names0(nm, as.vector(x, "character"))
 }

tests/testthat/test-names.R

@@ -11,3 +11,19 @@ test_that("names_switch() works", {
   )
 })
 
+test_that("names_sort() works", {
+  x <- set_names0(rep(NA, 3), c(-1, 10, 2))
+
+  expect_equal(
+    sort_names(x),
+    set_names0(rep(NA, 3), c(-1, 10, 2))
+  )
+
+  expect_equal(
+    sort_names(x, numeric = TRUE),
+    set_names0(rep(NA, 3), c(-1, 2, 10))
+  )
+
+  expect_error(sort_names(list(a = 1)))
+  expect_error(sort_names(NA))
+})