diff --git a/R/init.R b/R/init.R index f1a069db..340e069b 100644 --- a/R/init.R +++ b/R/init.R @@ -178,14 +178,19 @@ irlba_tsvd_normalized_laplacian_init <- function(A, ndim = 2, verbose = FALSE) { } irlba_spectral_tsvd <- function(L, n, iters = 1000) { - suppressWarnings(res <- irlba::irlba(L, nv = n, nu = 0, maxit = iters)) + suppressWarnings(res <- tryCatch( + irlba::irlba(L, nv = n, nu = 0, maxit = iters), + error = function(c) { + irlba::irlba(L, nv = n, nu = 0, maxit = iters, fastpath = FALSE) + } + )) list(vectors = res$v, values = 2.0 - res$d, converged = res$iter != iters) } irlba_eigs_asym <- function(L, ndim) { suppressWarnings(res <- tryCatch( { - res <- irlba::partial_eigen( + irlba::partial_eigen( L, n = ndim + 1, symmetric = FALSE, @@ -194,19 +199,34 @@ irlba_eigs_asym <- function(L, ndim) { maxit = 1000, verbose = TRUE ) - res$values <- sqrt(res$values) - res }, error = function(c) { - NULL + tryCatch( + irlba::partial_eigen( + L, + n = ndim + 1, + symmetric = FALSE, + smallest = TRUE, + tol = 1e-3, + maxit = 1000, + verbose = TRUE, + fastpath = FALSE + ), + error = function(c) { + NULL + } + ) } )) + if (!is.null(res)) { + res$values <- sqrt(res$values) + } res } irlba_eigs_sym <- function(L, ndim, smallest = TRUE) { suppressWarnings(res <- tryCatch( - res <- irlba::partial_eigen( + irlba::partial_eigen( L, n = ndim + 1, symmetric = TRUE, @@ -216,7 +236,21 @@ irlba_eigs_sym <- function(L, ndim, smallest = TRUE) { verbose = FALSE ), error = function(c) { - NULL + tryCatch( + irlba::partial_eigen( + L, + n = ndim + 1, + symmetric = TRUE, + smallest = smallest, + tol = 1e-3, + maxit = 1000, + verbose = FALSE, + fastpath = FALSE + ), + error = function(c) { + NULL + } + ) } )) res @@ -439,8 +473,7 @@ irlba_scores <- function(X, ncol, center = TRUE, ret_extra = FALSE, verbose = FA X <- X * 1 } res <- irlba::prcomp_irlba(X, - n = ncol, retx = TRUE, center = center, - scale = FALSE + n = ncol, retx = TRUE, center = center, scale = FALSE ) report_varex(res, verbose) if (ret_extra) { diff --git a/tests/testthat/test_normlaplacian.R b/tests/testthat/test_normlaplacian.R index 8ccdc811..b3bfc539 100644 --- a/tests/testthat/test_normlaplacian.R +++ b/tests/testthat/test_normlaplacian.R @@ -7,38 +7,46 @@ context("normalized laplacian") # with sanitizers and valgrind (probably the extended compilation time with # eigen causes a preperror) -test_that("normalized laplacian", { - # These numbers come from running UMAP Python code: - # spectral_layout(pairwise_distances(iris.data[0:10, :])) - # NB: - # 1. iris data in scikit-learn is currently from UCI repo, which has errors - # (although this doesn't affect the first ten entries) - # 2. eigenvector calculation is not that converged and specifies a starting - # vector that we can't supply with either RSpectra or eigen. - # 3. The eigenvectors are only identical up to a sign, so we take the absolute - # values. - abs_expected_norm_lap <- - abs( - c2y( - 0.7477, -0.1292, -0.03001, 0.02127, -0.563, -0.01149, 0.1402, - -0.2725, -0.01241, 0.1084, -0.106, -0.5723, 0.2024, -0.3082, - 0.1642, -5.549e-05, -0.04843, -0.1747, 0.1684, 0.6611 - ) +# These numbers come from running UMAP Python code: +# spectral_layout(pairwise_distances(iris.data[0:10, :])) +# NB: +# 1. iris data in scikit-learn is currently from UCI repo, which has errors +# (although this doesn't affect the first ten entries) +# 2. eigenvector calculation is not that converged and specifies a starting +# vector that we can't supply with either RSpectra or eigen. +# 3. The eigenvectors are only identical up to a sign, so we take the absolute +# values. +abs_expected_norm_lap <- + abs( + c2y( + 0.7477, -0.1292, -0.03001, 0.02127, -0.563, -0.01149, 0.1402, + -0.2725, -0.01241, 0.1084, -0.106, -0.5723, 0.2024, -0.3082, + 0.1642, -5.549e-05, -0.04843, -0.1747, 0.1684, 0.6611 ) + ) +sparse_m <- Matrix::drop0(x2d(iris[1:10, ])) - sparse_m <- Matrix::drop0(x2d(iris[1:10, ])) +test_that("normalized laplacian", { res <- normalized_laplacian_init(sparse_m) expect_equal(abs(res), abs_expected_norm_lap, tolerance = 0.2) +}) +test_that("irlba tsvd normalized", { # 115: ensure irlba code path gets tested if we can avoid Matrix ABI issue - if (exists("Matrix.Version", envir = asNamespace("Matrix")) && - Matrix::Matrix.Version()$package >= "1.7.0") { + # if (exists("Matrix.Version", envir = asNamespace("Matrix")) && + # Matrix::Matrix.Version()$package >= "1.7.0") { res <- irlba_tsvd_normalized_laplacian_init(sparse_m) expect_equal(abs(res), abs_expected_norm_lap, tolerance = 0.2) + # } +}) +test_that("irlba normalized", { + # 115: ensure irlba code path gets tested if we can avoid Matrix ABI issue + # if (exists("Matrix.Version", envir = asNamespace("Matrix")) && + # Matrix::Matrix.Version()$package >= "1.7.0") { res <- irlba_normalized_laplacian_init(sparse_m) expect_equal(abs(res), abs_expected_norm_lap, tolerance = 0.2) - } + # } }) test_that("laplacian eigenmap", { diff --git a/tests/testthat/test_output.R b/tests/testthat/test_output.R index 96c133d5..8e17f1e9 100644 --- a/tests/testthat/test_output.R +++ b/tests/testthat/test_output.R @@ -310,14 +310,14 @@ expect_ok_matrix(res, nc = 1) # enforce irlba for spectral initialization even if RSpectra is present # 115: ensure irlba code path gets tested if we can avoid Matrix ABI issue -if (exists("Matrix.Version", envir = asNamespace("Matrix")) && - Matrix::Matrix.Version()$package >= "1.7.0") { +# if (exists("Matrix.Version", envir = asNamespace("Matrix")) && +# Matrix::Matrix.Version()$package >= "1.7.0") { res <- umap(iris10, n_components = 1, n_neighbors = 4, n_epochs = 2, n_threads = 1, verbose = FALSE, init = "irlba_spectral" ) expect_ok_matrix(res, nc = 1) -} +# } # Supervised set.seed(1337)