tests/testthat/test_optonly.R

In jlmelville/uwot: The Uniform Manifold Approximation and Projection (UMAP) Method for Dimensionality Reduction

library(uwot)
context("optimization only")

# this mainly exists to hedge against rhub timing out during tests and to still
# exercise the main umap code even with RSpectra and other dependencies 
# temporarily removed due to excessive compilation times. Filter on
# this in testthat.R:
#
# test_check("uwot", filter = "optonly")
# 
init_coords <- matrix(c(-0.286003508982688, 0.205935933716443, 0.212672369696097, 
  0.318264664390379, -0.290855854751177, -0.84524521577413, 0.10829983500751, 
  -0.163970086771776, 0.611654891362094, 0.12924697210725, 0.0469197151280184, 
  0.226976224751362, -0.0547582725501509, -0.0373386048885834, 
  -0.0879982948022033, -0.0168061906596455, -0.269189585603006, 
  0.0524409053485183, -0.0619916567707883, 0.201745760046477), ncol = 2)

nn <- list(euclidean = 
             list(
               idx = matrix(
                 c(1L, 2L, 3L, 4L, 5L, 6L, 
                   7L, 8L, 9L, 10L, 5L, 10L, 4L, 3L, 1L, 5L, 3L, 1L, 4L, 2L, 8L, 
                   3L, 7L, 9L, 8L, 1L, 4L, 5L, 3L, 3L, 10L, 4L, 2L, 10L, 7L, 8L, 
                   8L, 10L, 2L, 4L),
                 ncol = 4),
               dist = matrix(
                 c(0, 
                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0.141421356237309, 0.173205080756888, 
                   0.244948974278318, 0.244948974278318, 0.141421356237309, 0.616441400296898, 
                   0.264575131106459, 0.173205080756888, 0.3, 0.173205080756888, 
                   0.173205080756888, 0.3, 0.264575131106459, 0.3, 0.223606797749979, 
                   0.616441400296898, 0.33166247903554, 0.223606797749979, 0.435889894354067, 
                   0.316227766016838, 0.469041575982343, 0.331662479035541, 0.3, 
                   0.316227766016839, 0.458257569495584, 0.7, 0.424264068711929, 
                   0.33166247903554, 0.509901951359279, 0.316227766016839),
                 ncol = 4)
               ))

res <- umap(iris10,
            n_neighbors = 4, n_epochs = 2, learning_rate = 0.5, min_dist = 0.001,
            init = init_coords, verbose = FALSE, n_threads = 0, nn_method = nn
)
expect_ok_matrix(res)

first_coords <- c()
test_callback <- function(epochs, n_epochs, coords) {
  first_coords <<- c(first_coords, coords[1, 1])
}
set.seed(42)
res <- umap(iris10,
            n_neighbors = 4, n_epochs = 10, learning_rate = 0.5, min_dist = 0.001,
            init = init_coords, verbose = FALSE, nn_method = nn,
            batch = TRUE,  epoch_callback = test_callback, approx_pow = TRUE,
            n_threads = 2
)
expect_ok_matrix(res)
expect_equal(length(first_coords), 10)