tests/testthat/test-kld-analytical.R

In kldest: Sample-Based Estimation of Kullback-Leibler Divergence

test_that("Discrete KL-D calculation works", {
    # 1D example
    P <- c(1,0)
    Q <- c(exp(-1),1-exp(-1))
    D_KL <- kld_discrete(P,Q)
    expect_equal(D_KL, 1)

    # 2D example
    P2 <- matrix(c(0.5,0,0,0.5),nrow=2)
    Q2 <- matrix(c(0.5*exp(-1),1-exp(-1),0,0.5*exp(-1)),nrow=2)
    D_KL2 <- kld_discrete(P2,Q2)
    expect_equal(D_KL2, 1)

    # Infinite KL-D
    P3 <- c(0.5,0.5)
    Q3 <- c(0,1)
    D_KL3 <- kld_discrete(P3,Q3)
    expect_equal(D_KL3, Inf)

    # Invalid probabilities
    P4 <- c(1.2,-0.2)
    Q4 <- c(0.5,0.5)
    expect_error(kld_discrete(P4,Q4), "Input arrays must be nonnegative.")
    expect_error(kld_discrete(1, Q4), "Inputs must have the same dimensions.")
    expect_error(kld_discrete(1, 2),  "Input arrays must sum up to 1.")

})

test_that("KL-D of independent Gaussians is additive", {

    sigma1 <- matrix(
        c(2,1,0,0,
          1,2,0,0,
          0,0,2,1,
          0,0,1,2),
        nrow=4)
    sigma2 <- diag(4)
    mu <- rep(0,4)

    KL_4D <- kld_gaussian(mu1 = mu, sigma1 = sigma1,
                          mu2 = mu, sigma2 = sigma2)
    KL_2D <- kld_gaussian(mu1 = rep(0,2), sigma1 = constDiagMatrix(dim=2, diag=2,offDiag=1),
                          mu2 = rep(0,2), sigma2 = diag(2))
    expect_equal(KL_4D,2*KL_2D)

})


test_that("KL-D is 0 for identical distribution in analytical formulas", {

    # uniform distribution
    a <- -1
    b <-  2
    KL_num <- kld_uniform(a1=a,b1=b,
                             a2=a,b2=b)
    expect_equal(KL_num, 0)

    # exponential distribution
    lambda <- 2
    KL_num <- kld_exponential(lambda1 = lambda, lambda2 = lambda)
    expect_equal(KL_num, 0)

    # 3D normal distribution
    mu <- 1:3
    sigma <- constDiagMatrix(dim=3, diag = 7, offDiag = 2)

    KL_num <- kld_gaussian(mu1 = mu, sigma1 = sigma,
                           mu2 = mu, sigma2 = sigma)
    expect_equal(KL_num, 0)

})

test_that("KL-D between uniform and Gaussian behaves as expected", {

    # sd scaling
    KL_1 <- kld_uniform_gaussian(a = -1,
                                 b = 1,
                                 mu = 0,
                                 sigma2 = 1)
    KL_10 <- kld_uniform_gaussian(a = -10,
                                 b = 10,
                                 mu = 0,
                                 sigma2 = 100)
    expect_equal(KL_1, KL_10)

    # erroneous input
    expect_error(kld_uniform_gaussian(a = 1))
    expect_error(kld_uniform_gaussian(sigma2 = -1))

})