set.seed(123) # not testing convex b/c of how janky it is set.seed(123) cgnp_pair <- sample_correlated_gnp_pair(n = 5, corr = 0.5, p = 0.5) g1 <- cgnp_pair$graph1 g2 <- cgnp_pair$graph2 hs <- 1:5 <= 2 ss <- t(matrix(c(3, 4))) suppressWarnings( res <- init_start(start = "convex", nns = 3, ns=2, soft_seeds = ss, A = g1[], B = g2[], seeds = hs) ) ## initialize start matrix without soft seeds set.seed(123) test_that("bari start w/o soft seeds", { expected <- splr(Matrix(0,2,2), a = Matrix(c(1,1),2), b = Matrix(c(.5,.5),2)) s <- init_start(start = "bari", nns = 2) expect_equal(as.matrix(s@x), as.matrix(expected@x), ignore_attr = TRUE) expect_equal(as.matrix(s@a), as.matrix(expected@a), ignore_attr = TRUE) expect_equal(as.matrix(s@b), as.matrix(expected@b), ignore_attr = TRUE) }) set.seed(123) test_that("random doubly stochastic start w/o soft seeds", { expect_snapshot_output( init_start(start = "rds", nns = 2) ) }) set.seed(123) test_that("doubly stochastic matrix start w/o soft seeds", { expect_snapshot_output( as.matrix(init_start(start = "rds_perm_bari", nns = 2)) ) } ) # initialize start matrix with soft seeds ss<-t(matrix(c(3,4))) set.seed(123) test_that("bari start w. soft seeds", { start <- init_start(start = "bari", nns = 3,ns=2,soft_seeds=ss) expect_snapshot_output(start) expect_s4_class(start, "splrMatrix") }) set.seed(123) test_that("random doubly stochastic start w. soft seeds", { start <- init_start(start = "rds", nns = 3,ns=2,soft_seeds=ss) expect_snapshot_output(start) }) set.seed(123) test_that("doubly stochastic matrix start w. soft seeds", { expect_snapshot_output( init_start(start = "rds_perm_bari", nns = 3,ns=2,soft_seeds=ss) ) } ) # not testing convex b/c of how janky it is set.seed(123) cgnp_pair <- sample_correlated_gnp_pair(n = 5, corr = 0.5, p = 0.5) g1 <- cgnp_pair$graph1 g2 <- cgnp_pair$graph2 hs <- 1:5 <= 2 ss <- t(matrix(c(3, 4))) suppressWarnings( res <- init_start(start = "convex", nns = 3, ns=2, soft_seeds = ss, A = g1[], B = g2[], seeds = hs) ) expected <- structure( c(0.786, 0.053, 0.081, 0.161, 0.786, 0.053, 0.053, 0.161, 0.786), .Dim = c(3L, 3L), .Dimnames = list(NULL, NULL)) test_that("convex start w. soft seeds", { expect_snapshot_output(res) }) test_that( "Error on overspecified soft seeds", { expect_error( { init_start(matrix(1, 4, 4), 4, soft_seeds = c(1,3)) }, "You are trying to use soft seeds but .*" ) } ) f <- function(nns,ns, soft_seeds) { matrix(0, nns, nns) } test_that( "Function as start",{ expect_snapshot_output( init_start(f, 10) ) } ) f <- function(){} test_that( "Function as start wrong args", { expect_error( init_start(f, 10), ".*functions passed to init_start must have at least the arguments nns, ns, and softs_seeds" ) } ) f <- function(nns, ns, soft_seeds) { n <- nns - nrow(check_seeds(soft_seeds, nns + ns)$seeds) matrix(runif((n - 1) ^ 2), n - 1) } test_that( "Function as start wrong size", { expect_error( init_start(f, 10), ".*must return a square matrix-like object with dimension" ) } ) test_that( "Invalid string", { expect_error( init_start("string", 10), "start must be either a matrix, function, or one of.*" ) } ) test_that( "RDS from sim start", { sim <- matrix(runif(9), 3) m <- init_start(start = "rds_from_sim", nns = 3, sim = sim) expect_snapshot_output(print(round(m, 4))) sim <- Matrix::rsparsematrix(10, 10, .4, rand.x = function(n) rep(1,n)) m <- init_start(start = "rds_from_sim", nns = 3, sim = sim) expect_snapshot_output(print(round(m, 4))) expect_error( init_start(start = "rds_from_sim", nns = 3, sim = "asdf"), "Error: sim must be a matrix-like object.*" ) } ) test_that( "soft seeds with non-initial seeds", { seeds <- c(1, 4) soft_seeds <- c(2, 3) s <- init_start("bari", nns = 5, seeds = seeds, soft_seeds = soft_seeds) expect_equal(diag(s@x), c(1, 1, 0, 0, 0)) } )