From f3cbd2f62dc2b7ff6b656bdef94106a406e3494e Mon Sep 17 00:00:00 2001 From: mahaalbashir Date: Fri, 7 Aug 2026 15:07:32 +0100 Subject: [PATCH] making_acro_hist_similar_to_R_hist --- R/acro_tables.R | 7 ++- R/utils.R | 15 +++++++ inst/WORDLIST | 3 +- man/acro_hist.Rd | 2 +- man/acro_summarise.Rd | 4 +- tests/testthat/test-acro_hist.R | 76 +++++++++++++++++++++++++++++++++ 6 files changed, 100 insertions(+), 7 deletions(-) diff --git a/R/acro_tables.R b/R/acro_tables.R index 63b7da1..3c0cbb6 100644 --- a/R/acro_tables.R +++ b/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) diff --git a/R/utils.R b/R/utils.R index 956b4e1..a50a21c 100644 --- a/R/utils.R +++ b/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) +} diff --git a/inst/WORDLIST b/inst/WORDLIST index 8382203..069b542 100644 --- a/inst/WORDLIST +++ b/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 diff --git a/man/acro_hist.Rd b/man/acro_hist.Rd index 499f031..a4b8ada 100644 --- a/man/acro_hist.Rd +++ b/man/acro_hist.Rd @@ -7,7 +7,7 @@ acro_hist( data, column, - breaks = 10, + breaks = "sturges", freq = TRUE, col = NULL, filename = "histogram.png" diff --git a/man/acro_summarise.Rd b/man/acro_summarise.Rd index 1989945..6b519ed 100644 --- a/man/acro_summarise.Rd +++ b/man/acro_summarise.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/acro_tables.R \name{acro_summarise} \alias{acro_summarise} -\title{Title} +\title{Creates a new data frame. It returns one row for each combination of grouping variables; if there are no grouping variables, the output will have a single row summarising all observations in the input} \usage{ acro_summarise(.data, ..., .groups = NULL, .by = NULL) } @@ -19,5 +19,5 @@ acro_summarise(.data, ..., .groups = NULL, .by = NULL) Summary of the data } \description{ -Title +Creates a new data frame. It returns one row for each combination of grouping variables; if there are no grouping variables, the output will have a single row summarising all observations in the input } diff --git a/tests/testthat/test-acro_hist.R b/tests/testthat/test-acro_hist.R index 0b38260..7c09e6a 100644 --- a/tests/testthat/test-acro_hist.R +++ b/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)) +})