From aa6f678f77fa78a816b9d7c48fa23b37c98c24c8 Mon Sep 17 00:00:00 2001 From: Bill Denney 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")) + ) +})