tests/testthat/test_ggamma.R

In ggamma: Generalized Gamma Probability Distribution

context("Generalized Gamma distribution");

require(flexsurv);
require(ggamma);

test_that("dggamma integrates to 1", {
	result = integrate(function(x) dggamma(x, 1, 1, 1), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);

	result = integrate(function(x) dggamma(x, 0.8, 0.2, 1), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);

	result = integrate(function(x) dggamma(x, 0.5, 0.5, 0.2), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);

	result = integrate(function(x) dggamma(x, 0.5, 5, 2), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);

	result = integrate(function(x) dggamma(x, 0.5, 1, 2), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);

	result = integrate(function(x) dggamma(x, 5, 1, 0.5), 0, Inf)$value;
	expect_equal(result, 1, tolerance=0.001);
});

test_that("pggamma correctly reflects dggamma", {
	expected = integrate(function(x) dggamma(x, 1, 1, 1), 0, 10)$value;
	result   = pggamma(10, 1, 1, 1);
	expect_equal(result, expected);

	result   = pggamma(1e-10, 1, 1, 1);
	expect_equal(result, 0);

	result   = pggamma(20, 1, 1, 1);
	expect_equal(result, 1);

	expected = integrate(function(x) dggamma(x, 0.8, 0.5, 1), 0, 10)$value;
	result   = pggamma(10, 0.8, 0.5, 1);
	expect_equal(result, expected);

	result   = pggamma(0, 0.8, 0.5, 1);
	expect_equal(result, 0);

	result   = pggamma(1000, 0.8, 0.5, 1);
	expect_equal(result, 1);

	expected = integrate(function(x) dggamma(x, 1.2, 0.5, 1.5), 0, 10)$value;
	result   = pggamma(10, 1.2, 0.5, 1.5);
	expect_equal(result, expected, tolerance=1e-7);

	result   = pggamma(0, 1.2, 0.5, 1.5);
	expect_equal(result, 0);

	result   = pggamma(1000, 1.2, 0.5, 1.5);
	expect_equal(result, 1);
});

test_that("qggamma correctly inverts pggamma", {
	a = 1; b = 1; k = 1;
	expected = c(1, 10);
	expect_equal(qggamma(pggamma(expected, a, b, k), a, b, k), expected);

	a = 0.5; b = 1.5; k = 1.5;
	expected = c(0.5, 1, 3);
	expect_equal(qggamma(pggamma(expected, a, b, k), a, b, k), expected);

	a = 1.5; b = 0.5; k = 3;
	expected = c(0.5, 1, 3);
	expect_equal(qggamma(pggamma(expected, a, b, k), a, b, k), expected);
});

test_that("random number generation", {
	set.seed(72);

	a = 1; b = 1; k = 1;
	r = rggamma(100000, a, b, k);
	e = ecdf(r);
	x = seq(0.001, 10, length=10000);
	maxError = max(abs(e(x) - pggamma(x, a, b, k)));
	expect_lte(maxError, 1e-2);

	a = 0.3; b = 1.5; k = 1.5;
	r = rggamma(100000, a, b, k);
	e = ecdf(r);
	x = seq(0.001, 10, length=10000);
	maxError = max(abs(e(x) - pggamma(x, a, b, k)));
	expect_lte(maxError, 1e-2);

	a = 1.5; b = 5; k = 0.3;
	r = rggamma(100000, a, b, k);
	e = ecdf(r);
	x = seq(0.001, 10, length=10000);
	maxError = max(abs(e(x) - pggamma(x, a, b, k)));
	expect_lte(maxError, 1e-2);

	a = 3; b = 1.8; k = 0.5;
	r = rggamma(100000, a, b, k);
	e = ecdf(r);
	x = seq(0.001, 10, length=10000);
	maxError = max(abs(e(x) - pggamma(x, a, b, k)));
	expect_lte(maxError, 1e-2);

	set.seed(NULL);
});

test_that("ggamma equals gengamma.orig from flexsurv", {
	x = seq(0.001, 10, length=100);
	q = seq(0.001, 0.999, length=10);
	
	a = 1; b = 1; k = 1;
	expect_equal(dgengamma.orig(x, b, a, k), dggamma(x, a, b, k));
	expect_equal(pgengamma.orig(x, b, a, k), pggamma(x, a, b, k));
	expect_equal(qgengamma.orig(q, b, a, k), qggamma(q, a, b, k));

	a = 0.3; b = 1.5; k = 1.5;
	expect_equal(dgengamma.orig(x, b, a, k), dggamma(x, a, b, k));
	expect_equal(pgengamma.orig(x, b, a, k), pggamma(x, a, b, k));
	expect_equal(qgengamma.orig(q, b, a, k), qggamma(q, a, b, k));

	a = 1.5; b = 5; k = 0.3;
	expect_equal(dgengamma.orig(x, b, a, k), dggamma(x, a, b, k));
	expect_equal(pgengamma.orig(x, b, a, k), pggamma(x, a, b, k));
	expect_equal(qgengamma.orig(q, b, a, k), qggamma(q, a, b, k));

	a = 3; b = 1.8; k = 0.5;
	expect_equal(dgengamma.orig(x, b, a, k), dggamma(x, a, b, k));
	expect_equal(pgengamma.orig(x, b, a, k), pggamma(x, a, b, k));
	expect_equal(qgengamma.orig(q, b, a, k), qggamma(q, a, b, k));
});