Merge pull request #253 from VEuPathDB/bins-closed-left

switch bins to closed on left
VEuPathDB · Mar 18, 2024 · 30a495d · 30a495d
2 parents 9ff9502 + 0c924a4
commit 30a495d
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 4 deletions.
diff --git a/R/utils-bin.R b/R/utils-bin.R
@@ -29,11 +29,11 @@ bin.numeric <- function(x, binWidth = NULL, viewport, stringsAsFactors = c(FALSE
       bins <- xVP
       if (stringsAsFactors) bins <- as.factor(bins)
     } else {
-      bins <- veupathUtils::cut_width(xVP, binWidth, boundary = min(xVP))
+      bins <- veupathUtils::cut_width(xVP, binWidth, boundary = min(xVP), closed = "left")
     }
   } else {
     numBins <- findNumBins(xVP)
-    bins <- veupathUtils::cut_interval(xVP, numBins)
+    bins <- veupathUtils::cut_interval(xVP, numBins, right=FALSE)
   }
 
   bins <- pruneViewportAdjustmentFromBins(bins, xVP, x, viewport)

diff --git a/tests/testthat/test-histogram.R b/tests/testthat/test-histogram.R
@@ -144,7 +144,7 @@ test_that("histogram.dt() returns requested numBins/ binWidth", {
   expect_equal(as.numeric(binSpec(dt)$value), 5) # ensure we get the correct number of bins
   expect_true(max(as.numeric(unlist(dt$binEnd)) - as.numeric(unlist(dt$binStart)) - binWidth) < 0.1) # Tolerance 0.1
   numericLabelsStart <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[")[[1]][2])))
-  numericLabelsEnd <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[")[[1]][3])))
+  numericLabelsEnd <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[|\\)")[[1]][3])))
   expect_true(max(numericLabelsEnd - numericLabelsStart) - binWidth < 0.1) # Label tolerance
 
   binReportValue <- 'numBins'
@@ -153,7 +153,7 @@ test_that("histogram.dt() returns requested numBins/ binWidth", {
   expect_equal(as.numeric(binSpec(dt)$value), 15) # ensure we get the correct number of bins
   expect_true(max(as.numeric(unlist(dt$binEnd)) - as.numeric(unlist(dt$binStart)) - binWidth) < 0.1) # Tolerance 0.1
   numericLabelsStart <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[")[[1]][2])))
-  numericLabelsEnd <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[")[[1]][3])))
+  numericLabelsEnd <- unlist(lapply(unlist(dt$binLabel), function(x) as.numeric(stringi::stri_split_regex(x, ",|]|\\(|\\[|\\)")[[1]][3])))
   expect_true(max(numericLabelsEnd - numericLabelsStart) - binWidth < 0.1) # Label tolerance
 })
 
@@ -1175,3 +1175,34 @@ test_that("histogram.dt does not produce corrupted bins when given TAC data from
   expect_equal(sum(is.na(as.numeric(unlist(dt$binStart)))), 0)
   expect_equal(sum(is.na(as.numeric(unlist(dt$binEnd)))), 0)
 })
+
+test_that("our bins are always left closed/ inclusive", {
+  variables <- new("VariableMetadataList", SimpleList(
+    new("VariableMetadata",
+      variableClass = new("VariableClass", value = 'native'),
+      variableSpec = new("VariableSpec", variableId = 'cat3', entityId = 'entity'),
+      plotReference = new("PlotReference", value = 'facet2'),
+      dataType = new("DataType", value = 'STRING'),
+      dataShape = new("DataShape", value = 'CATEGORICAL')),
+    new("VariableMetadata",
+      variableClass = new("VariableClass", value = 'native'),
+      variableSpec = new("VariableSpec", variableId = 'cat4', entityId = 'entity'),
+      plotReference = new("PlotReference", value = 'facet1'),
+      dataType = new("DataType", value = 'STRING'),
+      dataShape = new("DataShape", value = 'CATEGORICAL')),
+    new("VariableMetadata",
+      variableClass = new("VariableClass", value = 'native'),
+      variableSpec = new("VariableSpec", variableId = 'contA', entityId = 'entity'),
+      plotReference = new("PlotReference", value = 'xAxis'),
+      dataType = new("DataType", value = 'NUMBER'),
+      dataShape = new("DataShape", value = 'CONTINUOUS'))
+  ))
+
+  df <- as.data.frame(testDF)
+  viewport <- list('xMin'=min(df$entity.contA), 'xMax'=max(df$entity.contA))
+  binReportValue <- 'binWidth'
+
+  dt <- histogram.dt(df, variables, binWidth = .3, value='count', barmode = 'overlay', binReportValue, viewport)
+
+  expect_equal(all(unlist(lapply(dt$binLabel,substr,1,1)) == '['), TRUE)
+})