making_acro_hist_similar_to_R_hist

R/acro_tables.R

@@ -341,11 +341,14 @@ acro_pivot_table <- function(data, values = NULL, index = NULL, columns = NULL,
 #' @return The histogram.
 #' @export
 
-acro_hist <- function(data, column, breaks = 10, freq = TRUE, col = NULL, filename = "histogram.png") {
+acro_hist <- function(data, column, breaks = "sturges", freq = TRUE, col = NULL, filename = "histogram.png") {
   if (is.null(acroEnv$ac)) {
     stop("ACRO has not been initialised. Please first call acro_init()")
   }
-  py_histogram <- acroEnv$ac$hist(data = data, column = column, bins = as.integer(breaks), density = !freq, color = col, filename = filename)
+  # Get the offset breaks
+  breaks <- get_offset_hist_breaks(data, column, breaks) # nocov
+
+  py_histogram <- acroEnv$ac$hist(data = data, column = column, bins = breaks, density = !freq, color = col, filename = filename)
   histogram <- reticulate::py_to_r(py_histogram)
   # Load the saved histogram
   image <- png::readPNG(histogram)

R/utils.R

@@ -116,3 +116,18 @@ parse_summary_expression <- function(quo) {
     agg_funcs = py_agg_funcs
   )
 }
+
+get_offset_hist_breaks <- function(data, column, breaks = "sturges") {
+  # Extract the column from the data
+  r_column <- data[[column]]
+  # Extract the  R's break boundaries
+  hist_parameters <- graphics::hist(r_column, breaks = breaks, plot = FALSE)
+  breaks <- hist_parameters$breaks
+  # 3. Add a small offset to the upper bounds (everything except the first break)
+  # This forces pandas hist() half-open intervals to capture boundary values like R does
+  if (length(breaks) > 1) {
+    offset <- 1e-7
+    breaks[-1] <- breaks[-1] + offset
+  }
+  return(breaks)
+}

inst/WORDLIST

@@ -16,12 +16,10 @@ TREs
 TREvolution
 Transformative
 Xplore
-YAML
 analytics
 auditable
 codecov
 conda
-config
 crosstab
 disclosive
 github
@@ -33,6 +31,7 @@ openml
 pre
 programme
 scipy
+summarising
 www
 xlsx
 yaml

tests/testthat/test-acro_hist.R

@@ -12,3 +12,79 @@ test_that("acro_hist works", {
 
 # Delete the acro_artifacts folder
 unlink("acro_artifacts", recursive = TRUE)
+
+test_that("Python and R counts mismatch when using raw breaks (proving why the offset is needed)", {
+  # Define test data containing exact boundary values
+  test_df <- data.frame(hours = c(0, 5, 10, 10, 15, 20, 20, 25, 30, 40))
+
+  # R histograms
+  r_hist <- hist(test_df$hours, breaks = 5, plot = FALSE)
+  r_counts <- r_hist$counts
+  r_breaks <- r_hist$breaks
+
+  # Run NumPy histogram using the r breaks
+  np <- reticulate::import("numpy")
+  py_hist <- np$histogram(test_df$hours, bins = r_breaks)
+  py_counts <- py_hist[[1]]
+
+  # Assert that without the offset, the NumPy histogram counts and R counts don't match
+  expect_false(identical(as.numeric(py_counts), as.numeric(r_counts)))
+})
+
+test_that("NumPy histogram counts match R counts when using the offset breaks", {
+  # Define test data containing exact boundary values
+  test_df <- data.frame(hours = c(0, 5, 10, 10, 15, 20, 20, 25, 30, 40))
+
+  # R histogram
+  r_hist <- hist(test_df$hours, breaks = 5, plot = FALSE)
+  R_counts <- r_hist$counts
+  R_breaks <- r_hist$breaks
+
+  # Create the offset breaks and use it in numpy histogram to get the counts and bins
+  offest_breaks <- get_offset_hist_breaks(test_df, "hours", breaks = 5)
+
+  np <- reticulate::import("numpy")
+  py_result <- np$histogram(test_df$hours, bins = offest_breaks)
+  py_counts <- py_result[[1]]
+
+  # Assert that Python's counts match Base R's counts
+  expect_equal(as.numeric(py_counts), as.numeric(R_counts))
+})
+
+test_that("NumPy histogram counts match R counts with offset breaks using float data", {
+  # Define a test data frame with floating-point values, including exact boundaries
+  test_df <- data.frame(hours = c(1.5, 5.2, 10.0, 12.4, 15.8, 20.0, 22.1, 27.5, 30.0, 38.6))
+
+  # R histogram
+  r_hist <- hist(test_df$hours, breaks = 4, plot = FALSE)
+  r_counts <- r_hist$counts
+
+  # Create the offset breaks and use it in numpy histogram to get the counts and bins
+  offset_breaks <- get_offset_hist_breaks(test_df, "hours", breaks = 4)
+
+  np <- reticulate::import("numpy")
+  py_result <- np$histogram(test_df$hours, bins = offset_breaks)
+  py_counts <- py_result[[1]]
+
+  # Assert that Python's counts match R's counts
+  expect_equal(as.numeric(py_counts), as.numeric(r_counts))
+})
+
+test_that("NumPy histogram counts match R counts with offset breaks when breaks are the default (sturges)", {
+  # Define a test data frame with floating-point values, including exact boundaries
+  test_df <- data.frame(hours = c(1.5, 5.2, 10.0, 12.4, 15.8, 20.0, 22.1, 27.5, 30.0, 38.6))
+
+  # R histogram
+  r_hist <- hist(test_df$hours, plot = FALSE)
+  r_counts <- r_hist$counts
+
+  # Create the offset breaks and use it in numpy histogram to get the counts and bins
+  offset_breaks <- get_offset_hist_breaks(test_df, "hours")
+
+  np <- reticulate::import("numpy")
+  py_result <- np$histogram(test_df$hours, bins = offset_breaks)
+  py_counts <- py_result[[1]]
+
+  # Assert that Python's counts match R's counts
+  expect_equal(as.numeric(py_counts), as.numeric(r_counts))
+})