tests/testthat/BDataHistograms.R

In DistributionalDDA: Distributional Data Analysis in Bayes Spaces

# common part of the calculations
set.seed(234723)
x = runif(1000)
xh = hist(x, plot = FALSE)
xbdh = as.BDataFrequencyHistograms(list(x), basis = B2Unif01Basis20)
xbdd = as.BDataDensityHistograms(list(x), basis = B2Unif01Basis20)


y = runif(200)
xybdh = as.BDataFrequencyHistograms(list(x,y), basis = B2Unif01Basis20, breaks = xh$breaks)

test_that("creator returns right outcomes", {
  expect_s3_class(xbdh, "BDataFrequencyHistograms")
  expect_s3_class(xbdh, "BDataHistograms")
  expect_s3_class(xbdh, "BData")
  expect_equal(attr(xbdh, "breaks"), xh$breaks, info="testing breaks")
  expect_equal(c(unclass(xbdh)), xh$counts, info="testing counts" )
})


test_that("selectors work as expected", {
  expect_equal(xbdh, xybdh[1])
})


test_that("closure and converters to BDataDensityHistogram work as expected", {
  cxybdh = clo(xybdh)
  expect_s3_class(cxybdh, "BDataDensityHistograms")
  expect_equal(xbdd, cxybdh[1])
})



test_that("internal accessory functions work as expected", {
  expect_equal(getBreaks(xybdh), xh$breaks, info="getBreaks correct")
  expect_equal(getBayesSpace(xybdh), B2Unif01)
  expect_equal(getBayesSpaceBasis(xybdh), B2Unif01Basis20)
})





test_that("converters work", {
  xybds = BDataSamples(list(x,y), basis = B2Unif01Basis20)  # note: uses the file-wide variable `x`
  expect_equal(as.BDataFrequencyHistograms(xybds), xybdh)
  expect_equal(as.BDataDensityHistograms(xbdh), xbdd, tolerance = 1e-10)

})




test_that("addFrequency--same breaks---works as expected for BDFH=BDataFrequencyHistograms", {
  z = runif(500)
  zh = hist(z, plot=FALSE)
  zbdh = as.BDataFrequencyHistograms(list(z), basis = B2Unif01Basis20)
  xypz = addFrequency(xybdh, zbdh)
  expect_equal(getBreaks(xypz), xh$breaks, info="addFrequency.BDFH.BDFH treats equal breaks correctly")
  expect_equal(c(unclass(xypz[1])), xh$counts + zh$counts, info="addFrequency.BDFH.BDFH sums correct")
})


test_that("addFrequency--different breaks---works as expected", {
  z = runif(100)
  zh = hist(z, plot=FALSE, breaks=(0:4)/4)
  zh$counts = c(20,30,30,20)
  zh$density = zh$counts/25
  zbdh = as.BDataFrequencyHistograms(list(zh), basis = B2Unif01Basis20)
  x = runif(300)    # note: this is defined within this block and does not overwrite the file-wide variable `x`
  xh = hist(x, plot=FALSE)
  xh$counts = c(10,20,30,40,50, 50,40,30,20,10)
  xh$density = xh$counts/30
  xbdh = as.BDataFrequencyHistograms(list(xh), basis = B2Unif01Basis20)


  xpz = suppressWarnings(addFrequency(xbdh, zbdh))
  expect_equal(
    getBreaks(xpz), sort(unique(c(xh$breaks, zh$breaks))),
    info="addFrequency treats different breaks correctly"
  )
  expect_equal(
    c(unclass(xpz)), c(8,8,4,6,12,12, 12,12,6,4,8,8) + c(10,20,15,15,40,50,50,40,15,15,20,10),
    info="addFrequency sums correct", tolerance = 1e-12
  )
})





test_that("Add--same breaks---works as expected for BDDH=BDataDensityHistograms", {
  z = runif(500)
  zh = hist(z, plot=FALSE)
  zbdd = as.BDataDensityHistograms(list(z), basis = B2Unif01Basis20)
  xypz = xbdd + zbdd
  expect_equal(getBreaks(xypz), xh$breaks, info="Add.BDDH.BDDH treats equal breaks correctly")
  expect_equal(alr(c(xypz)), alr(xh$counts * zh$counts), info="Add.BDDH.BDDH correct", tolerance = 1e-10)
  expect_equal(c(xypz) %*% diff(getBreaks(xypz)), matrix(1,1,1), info="Add.BDDH.BDDH integral is one", tolerance = 1e-10)
})





test_that("Add--different breaks---works as expected for BDDH=BDataDensityHistograms", {
  z = runif(100)
  zh = hist(z, plot=FALSE, breaks=(0:4)/4)
  zh$counts = c(20,30,30,20)
  zh$density = zh$counts/25
  zbdh = as.BDataDensityHistograms(list(zh), basis = B2Unif01Basis20)
  x = runif(300)    # note: this is defined within this block and does not overwrite the file-wide variable `x`
  xh = hist(x, plot=FALSE)
  xh$counts = c(10,20,30,40,50, 50,40,30,20,10)
  xh$density = xh$counts/30
  xbdh = as.BDataDensityHistograms(list(xh), basis = B2Unif01Basis20)


  xpz = suppressWarnings(xbdh + zbdh)
  expect_equal(
    getBreaks(xpz), sort(unique(c(xh$breaks, zh$breaks))),
    info="Add.BDDH.BDDH treats different breaks correctly"
  )
  expect_equal(c(xpz) %*% diff(getBreaks(xpz)), matrix(1,1,1), info="Add.BDDH.BDDH integral is one", tolerance = 1e-10)

  expect_equal(
    c(xpz), (xh$density[sort(c(1:10,3,8))] * rep(zh$density, each=3)) %>% {./sum(.)} %>% {./diff(getBreaks(xpz))} ,
    info="Add.BDDH.BDDH operates correct", tolerance = 1e-12
  )
})