Benchmark script for comparing sort(unique()) and unique(sort())

sort_unique_benchmark.R

library(bench)
library(dplyr)
library(tidyr)

run_benchmark_pair <- function(N, type, uniqueness, na_ratio = 0, nan_ratio = 0) {
  cat(sprintf("Running: N=%d, type=%s, uniqueness=%s, na=%f, nan=%f\n", N, type, uniqueness, na_ratio, nan_ratio))
  
  # Generate data
  if (uniqueness == "high") {
    num_unique <- N
  } else {
    num_unique <- max(2, as.integer(N / 100))
  }
  
  if (type == "integer") {
    x <- sample(1:num_unique, N, replace = TRUE)
  } else if (type == "double") {
    x <- sample(seq(0, 1, length.out = num_unique), N, replace = TRUE)
  } else if (type == "character") {
    pool <- replicate(num_unique, paste(sample(letters, 5, replace = TRUE), collapse = ""))
    x <- sample(pool, N, replace = TRUE)
  }
  
  if (na_ratio > 0) {
    na_idx <- sample(1:N, as.integer(N * na_ratio))
    x[na_idx] <- NA
  }
  
  if (type == "double" && nan_ratio > 0) {
    remaining_idx <- which(!is.na(x))
    if (length(remaining_idx) > 0) {
      nan_idx <- sample(remaining_idx, min(length(remaining_idx), as.integer(N * nan_ratio)))
      x[nan_idx] <- NaN
    }
  }
  
  # Benchmark Group 1: Default (na.last = NA)
  res_default <- bench::mark(
    sort_unique = sort(unique(x)),
    unique_sort = unique(sort(x)),
    check = TRUE,
    iterations = 10
  )
  res_default$na_last <- "default_NA"
  
  # Benchmark Group 2: na.last = TRUE
  res_na_last <- bench::mark(
    sort_unique = sort(unique(x), na.last = TRUE),
    unique_sort = unique(sort(x, na.last = TRUE)),
    check = TRUE,
    iterations = 10
  )
  res_na_last$na_last <- "TRUE"
  
  res <- bind_rows(res_default, res_na_last)
  
  res$N <- N
  res$type <- type
  res$uniqueness <- uniqueness
  res$na_ratio <- na_ratio
  res$nan_ratio <- nan_ratio
  
  return(res)
}

# Run combinations
sizes <- c(1e3, 1e4, 1e5, 1e6)
types <- c("integer", "double", "character")
uniqueness_levels <- c("high", "low")
na_ratios <- c(0, 0.05)

results <- list()
counter <- 1

for (N in sizes) {
  for (type in types) {
    for (uniq in uniqueness_levels) {
      for (na in na_ratios) {
        nan_ratios <- if (type == "double" && na > 0) c(0, 0.05) else c(0)
        for (nan in nan_ratios) {
          tryCatch({
            res <- run_benchmark_pair(N, type, uniq, na, nan)
            results[[counter]] <- res
            counter <- counter + 1
          }, error = function(e) {
            cat(sprintf("ERROR for N=%d, type=%s, uniqueness=%s, na=%f, nan=%f: %s\n", 
                        N, type, uniq, na, nan, e$message))
          })
        }
      }
    }
  }
}

# Combine results
all_res <- bind_rows(lapply(results, function(r) {
  if (is.null(r)) return(NULL)
  as_tibble(r) %>%
    select(expression, na_last, min, median, `itr/sec`, mem_alloc, N, type, uniqueness, na_ratio, nan_ratio)
}))

# Save results
saveRDS(all_res, "benchmark_results.rds")
write.csv(all_res, "benchmark_results.csv", row.names = FALSE)
cat("Done!\n")