Nothing
test_that("workwell", {
X <- cbind(c(1,0,1),c(0,1,0))
B <- cbind(c(1,0),c(0,1),c(1,1))
Y <- X %*% B
res <- nmfkc::nmfkc(Y,rank=2,epsilon=1e-12,maxit=50000,print.dims = FALSE)
tolerance <- 1e-3
expect_equal(Y,res$XB, tolerance = tolerance)
})
test_that("X.init = kmeans++ works and is reproducible", {
Y <- t(iris[, -5])
r1 <- nmfkc(Y, rank = 3, X.init = "kmeans++", seed = 1, verbose = FALSE, print.dims = FALSE)
r2 <- nmfkc(Y, rank = 3, X.init = "kmeans++", seed = 1, verbose = FALSE, print.dims = FALSE)
expect_true(r1$r.squared > 0.9)
expect_equal(r1$XB, r2$XB) # reproducible with fixed seed
expect_true(all(r1$X >= 0)) # basis stays non-negative
# alias
r3 <- nmfkc(Y, rank = 3, X.init = "kmeanspp", seed = 1, verbose = FALSE, print.dims = FALSE)
expect_equal(r1$XB, r3$XB)
})
test_that(".kmeanspp.seed returns k distinct-ish centres of right shape", {
set.seed(1)
pts <- matrix(rnorm(200), nrow = 40, ncol = 5) # 40 points in R^5
s <- nmfkc:::.kmeanspp.seed(pts, 4)
expect_equal(dim(s), c(4L, 5L))
expect_true(all(is.finite(s)))
})
test_that("X.L2.smooth is off by default, smooths rows, and stays monotone", {
set.seed(1)
P <- 24; N <- 30; Q <- 2
Xt <- matrix(abs(rnorm(P * Q)), P, Q)
B <- matrix(abs(rnorm(Q * N)), Q, N)
Y <- Xt %*% B + matrix(abs(rnorm(P * N, 0, 0.1)), P, N)
rough <- function(X) sum((X[-1, ] - X[-nrow(X), ])^2) / sum(X^2)
r0 <- nmfkc(Y, rank = Q, seed = 1, verbose = FALSE, print.dims = FALSE)
r0b <- nmfkc(Y, rank = Q, seed = 1, X.L2.smooth = 0, verbose = FALSE, print.dims = FALSE)
rS <- nmfkc(Y, rank = Q, seed = 1, X.L2.smooth = 1000, verbose = FALSE, print.dims = FALSE)
expect_equal(r0$X, r0b$X) # default == explicit 0
expect_lt(rough(rS$X), rough(r0$X)) # smoothing reduces roughness
o <- rS$objfunc.iter; o <- o[is.finite(o)]
expect_true(all(diff(o) <= 1e-6)) # MU stays monotone
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.