# tests/testthat/test_knnStats.R In benja0x40/QuickShift: QuickShift

```# > knn_density ================================================================
context("knn_density")

# + density 1D -----------------------------------------------------------------
test_that("density 1D", {

n1 <- 10000
n2 <- 20000
g <- c(rep(1, n1), rep(2, n2))
x <- c(rnorm(n1, 0, 1), rnorm(n2, 0, 5))

o <- order(x)
x <- x[o]
g <- g[o]

dt <- knn_density(x, k = 50)
d1 <- knn_density(x, xref = x[g == 1], k = 50)
d2 <- knn_density(x, xref = x[g == 2], k = 50)

n <- length(x)
expect_identical(length(dt), n)
expect_identical(length(d1), n)
expect_identical(length(d2), n)

expect_true(all(dt >= 0))
expect_true(all(d1 >= 0))
expect_true(all(d2 >= 0))

expect_true(mean(abs(d1 + d2 - dt)) < 1E-2)

p <- dnorm(x[g == 1], 0, 1)
chk <- sum(abs(p - 3 * d1[g == 1])) / n1
# plot(x[g == 1], 3 * d1[g == 1], col = "red")
# points(x[g == 1], p)
expect_true(chk < 0.05)

p <- dnorm(x[g == 2], 0, 5)
chk <- sum(abs(p - 3/2 * d2[g == 2])) / n2
# plot(x[g == 2], 3/2 * d2[g == 2], col = "red")
# points(x[g == 2], p)
expect_true(chk < 0.05)

})

# + density 2D -----------------------------------------------------------------
test_that("density 2D", {

n1 <- 10000
n2 <- 40000
g <- c(rep(1, n1), rep(2, n2))
V <- cbind(
c(rnorm(n1, 0, 1), rnorm(n2, 0, 5)),
c(rnorm(n1, 0, 1), rnorm(n2, 0, 5))
)

dt <- knn_density(V, k = 50)
d1 <- knn_density(V, xref = V[g == 1, ], k = 50)
d2 <- knn_density(V, xref = V[g == 2, ], k = 50)

n <- dim(V)
expect_identical(length(dt), n[1])
expect_identical(length(d1), n[1])
expect_identical(length(d2), n[1])

expect_true(all(dt >= 0))
expect_true(all(d1 >= 0))
expect_true(all(d2 >= 0))

expect_true(mean(abs(d1 + d2 - dt)) < 1E-2)

})

# > knn_stats ==================================================================
context("knn_stats")

n <- 1000

mu    <- c(-30, -10, 10, 30)
sigma <- c(2, 1, 1, 2)

u <- cbind(mu, mu)
v <- cbind(sigma, sigma)

x <- rnorm(n, mean = mu, sd = sigma)
y <- rnorm(n, mean = mu, sd = sigma)

M <- cbind(x, y)

plot(M, col = grey(0, 0.1))
points(u, pch = 20, col = "red")

# + knn_musigma2 ---------------------------------------------------------------
test_that("knn_musigma2", {

r <- knn_musigma2(M, k = 100)

chk <- matrix(u, nrow = nrow(M), ncol = ncol(M))
chk <- sum(abs(chk - r\$mu)) / length(chk)
expect_true(all(chk < 1.0))

chk <- matrix(v, nrow = nrow(M), ncol = ncol(M))
chk <- sum(abs(chk - sqrt(r\$sigma2))) / length(chk)
expect_true(all(chk < 1.0))

i <- seq(1, nrow(M), 2)
r <- knn_musigma2(M[i, ], xref = M, k = 100, smoothing = TRUE)

chk <- matrix(u, nrow = nrow(M), ncol = ncol(M))[i, ]
chk <- sum(abs(chk - r\$mu)) / length(chk)
expect_true(all(chk < 1.0))

chk <- matrix(v, nrow = nrow(M), ncol = ncol(M))[i, ]
chk <- sum(abs(chk - sqrt(r\$sigma2))) / length(chk)
expect_true(all(chk < 1.0))
})

# + knn_mean -------------------------------------------------------------------
test_that("knn_mean", {
r <- knn_mean(M, k = 100)

chk <- matrix(u, nrow = nrow(M), ncol = ncol(M))
chk <- sum(abs(chk - r)) / length(chk)
expect_true(all(chk < 1.0))

i <- seq(1, nrow(M), 2)
r <- knn_mean(M[i, ], xref = M, k = 100)

chk <- matrix(u, nrow = nrow(M), ncol = ncol(M))[i, ]
chk <- sum(abs(chk - r)) / length(chk)
expect_true(all(chk < 1.0))
})
```
benja0x40/QuickShift documentation built on Jan. 22, 2021, 7:43 p.m.