From aa6f678f77fa78a816b9d7c48fa23b37c98c24c8 Mon Sep 17 00:00:00 2001
From: Bill Denney <wdenney@humanpredictions.com>
Date: Fri, 26 May 2023 10:54:44 -0400
Subject: [PATCH] `get_one_to_one()` no longer errors with near-equal values
 that become identical factor levels (fix #543)

---
 NEWS.md                              |  2 ++
 R/get_one_to_one.R                   | 15 +++------------
 tests/testthat/test-get_one_to_one.R | 23 +++++++++++++++++++++++
 3 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index bde7d0a0..496d9d80 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -10,6 +10,8 @@
 
 * `make_clean_names()` no longer accepts a data.frame or tibble as input, use `clean_names()` for that (fix #532, **@billdenney**).
 
+* `get_one_to_one()` no longer errors with near-equal values that become identical factor levels (fix #543, thanks to @olivroy for reporting)
+
 # janitor 2.2.0 (2023-02-02)
 
 ## Breaking changes
diff --git a/R/get_one_to_one.R b/R/get_one_to_one.R
index fce0e678..561abf9e 100644
--- a/R/get_one_to_one.R
+++ b/R/get_one_to_one.R
@@ -43,17 +43,8 @@ get_one_to_one <- function(dat) {
 }
 
 get_one_to_one_value_order <- function(x) {
-  if (any(is.na(x))) {
-    new_value <- as.integer(factor(x))
-    # Factor ordering starts at 1, so assign -1 to be a unique value for NA
-    new_value[is.na(new_value)] <- -1L
-    # redo the conversion so that NA values are in the same order as other
-    # values
-    ulevels <- unique(new_value)
-    new_value <- as.integer(factor(new_value, levels = ulevels))
-  } else {
-    ulevels <- unique(x)
-    new_value <- as.integer(factor(x, levels = ulevels))
-  }
+  # Convert the value to a factor so that any subtly different values become integers
+  uvalues <- match(x, unique(x))
+  new_value <- as.integer(factor(uvalues, levels = unique(uvalues)))
   new_value
 }
diff --git a/tests/testthat/test-get_one_to_one.R b/tests/testthat/test-get_one_to_one.R
index 93eb0ef7..19933d5b 100644
--- a/tests/testthat/test-get_one_to_one.R
+++ b/tests/testthat/test-get_one_to_one.R
@@ -59,3 +59,26 @@ test_that("get_one_to_one: columns are only described once", {
     regexp = "No columns in `mtcars` map to each other"
   )
 })
+
+test_that("nearly duplicated dates (second decimal place differs) to not cause failure (#543)", {
+  dates <- tibble::tibble(
+    modification_time =
+      structure(
+        c(1684261364.85967, 1684274880.48328, 1684261364.85967, 1684418379.74664, 1685105253.21695, 1684418379.76668, 1684279133.50118, 1684161951.81434, 1684281651.93175, 1678483898.72893, 1685103626.03424),
+        class = c("POSIXct", "POSIXt")
+      ),
+    access_time =
+      structure(
+        c(1685040222.34459, 1685041485.59089, 1685105067.68569, 1685040222.51569, 1685105253.21795, 1685105067.73877, 1685105253.66953, 1685106417.48391, 1685105253.66853, 1685041485.59089, 1685103652.82275),
+        class = c("POSIXct", "POSIXt")
+      ),
+    change_time = structure(
+      c(1684261364.85967, 1684274880.48328, 1684261364.85967, 1684418379.74664, 1685105253.21695, 1684418379.76668, 1684279133.50118, 1684161951.81434, 1684281651.93175, 1678483898.72893, 1685103626.03424),
+      class = c("POSIXct", "POSIXt")
+    )
+  )
+  expect_equal(
+    janitor::get_one_to_one(dates),
+    list(c("modification_time", "change_time"))
+  )
+})