tests/testthat/test_kernel.R

In CVEK: Cross-Validated Kernel Ensemble

context("Kernel Generation")

test_that("intercept kernel", {
  point_wise <- function(xp, xq, l, d) 1
  intercept_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
    })
  })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(intercept_kern(Z1, Z2), 5)
  intercept_fun <- generate_kernel("intercept")
  Kmat <- round(intercept_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})

test_that("linear kernel", {
  point_wise <- function(xp, xq, l, d) t(xp) %*% xq
  linear_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(linear_kern(Z1, Z2), 5)
  linear_fun <- generate_kernel("linear")
  Kmat <- round(linear_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})

test_that("polynomial kernel", {
  point_wise <- function(xp, xq, l, d) (t(xp) %*% xq + 1) ^ 3
  polynomial_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(polynomial_kern(Z1, Z2), 5)
  polynomial_fun <- generate_kernel("polynomial", p = 3)
  Kmat <- round(polynomial_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})


test_that("rbf kernel", {
  point_wise <- function(xp, xq, l, d) {
    exp(- sum((xp - xq) ^ 2) / (2 * 1 ^ 2))
    }
  rbf_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(rbf_kern(Z1, Z2), 5)
  rbf_fun <- generate_kernel("rbf", l = 1)
  Kmat <- round(rbf_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})

test_that("matern kernel", {
  point_wise <- function(xp, xq, l, d){
    l <- 1
    d <- 2
    r <- sqrt(sum((xp - xq) ^ 2))
    v <- d + 1 / 2
    s <- 0
    for (i in 0:d) {
      s <- s + factorial(d + i) / (factorial(i) * factorial(d - i)) *
        (sqrt(8 * v) * r / l) ^ (d - i)
    }
    exp(-sqrt(2 * v) * r / l) * gamma(d + 1) / gamma(2 * d + 1) * s
  }
  matern_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(matern_kern(Z1, Z2), 5)
  matern_fun <- generate_kernel("matern", l = 1, p = 2)
  Kmat <- round(matern_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})


test_that("rational kernel", {
  point_wise <- function(xp, xq, l, d) {
    l <- 1
    d <- 2
    r <- sqrt(sum((xp - xq) ^ 2))
    (1 + r ^ 2 / (2 * d * l ^ 2)) ^ (- d)
  }
  rational_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(rational_kern(Z1, Z2), 5)
  rational_fun <- generate_kernel("rational", l = 1, p = 2)
  Kmat <- round(rational_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})


test_that("nn kernel", {
  point_wise <- function(xp, xq, l, d) {
    xp <- c(1, xp)
    xq <- c(1, xq)
    s <- 2 * t(xp)  %*% xq / (sqrt((1 + 2 * t(xp) %*% xp) 
                                   * (1 + 2 * t(xq) %*% xq)))
    2 / pi * asin(s)
  }
  nn_kern <- function(X2, X1) 
    apply(X1, 1, function(xp){ 
      apply(X2, 1, function(xq){ 
        point_wise(xp, xq, l, d)
      })
    })
  set.seed(1118)
  Z1 <- matrix(rnorm(50 * 3), ncol = 3)
  Z2 <- matrix(rnorm(52 * 3), ncol = 3)
  Ktest <- round(nn_kern(Z1, Z2), 5)
  nn_fun <- generate_kernel("nn", sigma = 1)
  Kmat <- round(nn_fun(Z1, Z2), 5)
  expect_identical(Ktest, Kmat)
})