tests/testthat/test-bootstrap-dea.R

In Riksrevisjonen/pioneeR: Productivity and Efficiency Analysis using DEA

# Frontier 4.1
frontier41 <- readRDS('../testdata/frontier41.RDS')

mod_vrs_in <- compute_dea(frontier41, id = 'firm', input = c('labour', 'capital'), output = 'output', rts = 'vrs', orientation = 'in')
mod_vrs_out <- compute_dea(frontier41, id = 'firm',input = c('labour', 'capital'), output = 'output', rts = 'vrs', orientation = 'out')
mod_crs_in <- compute_dea(frontier41, id = 'firm', input = c('labour', 'capital'), output ='output', rts = 'crs', orientation = 'in')
mod_crs_out <- compute_dea(frontier41, id = 'firm', input = c('labour', 'capital'), output = 'output', rts = 'crs', orientation = 'out')
mod_irs_in <- compute_dea(frontier41, id = 'firm', input = c('labour', 'capital'), output = 'output', rts = 'irs', orientation = 'in')

test_that('bootstrap_dea() returns error as expected', {
  expect_error(bootstrap_dea(data.frame(x = 1:10)))
  expect_error(bootstrap_dea(mod_irs))
  expect_error(bootstrap_dea(mod_vrs, bw_rule = 'abc'))
})

test_that('bootstrap_dea() will perform a bootstrap for all supported technologies', {
  boot_vrs_in <- bootstrap_dea(mod_vrs_in, iterations = 2)
  boot_vrs_out <- bootstrap_dea(mod_vrs_out, iterations = 2)
  boot_crs_in <- bootstrap_dea(mod_crs_in, iterations = 2)
  boot_crs_out <- bootstrap_dea(mod_crs_out, iterations = 2)
  expect_equal(class(boot_vrs_in), 'pioneer_bootstrap')
  expect_equal(attr(boot_vrs_in$bootstrap, 'rts'), 'vrs')
  expect_equal(attr(boot_vrs_in$bootstrap, 'orientation'), 'in')
  expect_equal(class(boot_vrs_out), 'pioneer_bootstrap')
  expect_equal(attr(boot_vrs_out$bootstrap, 'rts'), 'vrs')
  expect_equal(attr(boot_vrs_out$bootstrap, 'orientation'), 'out')
  expect_equal(class(boot_crs_in), 'pioneer_bootstrap')
  expect_equal(attr(boot_crs_in$bootstrap, 'rts'), 'crs')
  expect_equal(attr(boot_crs_in$bootstrap, 'orientation'), 'in')
  expect_equal(class(boot_crs_out), 'pioneer_bootstrap')
  expect_equal(attr(boot_crs_out$bootstrap, 'rts'), 'crs')
  expect_equal(attr(boot_crs_out$bootstrap, 'orientation'), 'out')
})

test_that('bootstrap_sample() returns a vector in the interval [0, 1]', {
  # We create a vector of random floats in the interval [0, 1]
  # We do not set a seed, as we do not want (fully) deterministic values
  rand_eff <- runif(20)
  h <- bw_rule(rand_eff)
  b_sample <- bootstrap_sample(rand_eff, h)
  expect_equal(class(b_sample), 'numeric')
  expect_equal(typeof(b_sample), 'double')
  expect_true(max(b_sample) <= 1)
  expect_true(min(b_sample) >= 0)
  # Output oriented scores should still produce sample values [0, 1]
  b_sample <- bootstrap_sample(1/rand_eff, h)
  expect_true(max(b_sample) <= 1)
  expect_true(min(b_sample) >= 0)
})

test_that('bw_rule can be set as expected', {
  boot_ucv <- bootstrap_dea(mod_vrs_in, bw_rule = 'ucv', iterations = 2)
  expect_equal(attr(boot_ucv$bootstrap, 'bandwidth')$bw_rule, 'ucv')
  boot_silverman <- bootstrap_dea(mod_vrs_in, bw_rule = 'silverman', iterations = 2)
  expect_equal(attr(boot_silverman$bootstrap, 'bandwidth')$bw_rule, 'silverman')
  boot_scott <- bootstrap_dea(mod_vrs_in, bw_rule = 'scott', iterations = 2)
  expect_equal(attr(boot_scott$bootstrap, 'bandwidth')$bw_rule, 'scott')
  boot_sw <- bootstrap_dea(mod_vrs_in, bw_rule = 0.014, iterations = 2)
  expect_equal(attr(boot_sw$bootstrap, 'bandwidth')$h, 0.014)
  boot_null <- bootstrap_dea(mod_vrs_in, bw_rule = NULL, iterations = 2)
  expect_true(attr(boot_sw$bootstrap, 'bandwidth')$h > 0)
})