tests/testthat/test_Rtsne.R

In Rtsne: T-Distributed Stochastic Neighbor Embedding using a Barnes-Hut Implementation

context("Rtsne main function")

# Prepare iris dataset
iris_unique <- unique(iris) # Remove duplicates
Xscale<-normalize_input(as.matrix(iris_unique[,1:4]))
distmat <- as.matrix(dist(Xscale))

# Run models to compare to
iter_equal <- 500

test_that("Scaling gives the expected result", {
  Xscale2 <- scale(as.matrix(iris_unique[,1:4]), 
                  center = TRUE, scale=FALSE)
  Xscale2 <- scale(Xscale,
                  center=FALSE, 
                  scale=rep(max(abs(Xscale)),4))
  expect_equivalent(Xscale,Xscale2)
})

test_that("Manual distance calculation equals C++ distance calculation", {
  
  # Does not work on 32 bit windows
  skip_on_cran()
  
  # Exact
  set.seed(50)
  tsne_matrix <- Rtsne(as.matrix(iris_unique[,1:4]),verbose=FALSE, 
                       is_distance = FALSE,theta=0.0,max_iter=iter_equal,
                       pca=FALSE, normalize=TRUE)
  set.seed(50)
  tsne_dist <- Rtsne(distmat, verbose=FALSE, is_distance = TRUE,
                     theta = 0.0, max_iter=iter_equal)
  expect_equal(tsne_matrix$Y,tsne_dist$Y)
  
  # Inexact
  set.seed(50)
  tsne_matrix <- Rtsne(as.matrix(iris_unique[,1:4]),verbose=FALSE, is_distance = FALSE,
                       theta=0.1,max_iter=iter_equal,pca=FALSE)
  set.seed(50)
  tsne_dist <- Rtsne(distmat, verbose=FALSE, is_distance = TRUE, theta = 0.1, max_iter=iter_equal,
                     pca=FALSE)
  expect_equal(tsne_matrix$Y,tsne_dist$Y)
})

test_that("Accepts dist", {
  
  # Exact
  set.seed(50)
  tsne_out_dist_matrix <- Rtsne(distmat, is_distance = TRUE, theta=0.0, max_iter=iter_equal)
  set.seed(50)
  tsne_out_dist <- Rtsne(dist(Xscale),theta=0.0,max_iter=iter_equal)
  expect_equal(tsne_out_dist$Y,tsne_out_dist_matrix$Y)
  
  # Inexact
  set.seed(50)
  tsne_out_dist_matrix <- Rtsne(distmat, is_distance = TRUE, theta=0.1, max_iter=iter_equal)
  set.seed(50)
  tsne_out_dist <- Rtsne(dist(Xscale), theta=0.1, max_iter=iter_equal)
  expect_equal(tsne_out_dist$Y,tsne_out_dist_matrix$Y)
})

test_that("Accepts data.frame", {
  
  # Exact
  set.seed(50)
  tsne_out_matrix <- Rtsne(as.matrix(iris_unique[,1:4]),dims=1,verbose=FALSE, is_distance = FALSE,theta=0.0,max_iter=iter_equal,pca=FALSE)
  set.seed(50)
  tsne_out_df <- Rtsne(iris_unique[,1:4],dims=1,verbose=FALSE, is_distance = FALSE,theta=0.0,pca=FALSE,max_iter=iter_equal,num_threads=1)
  expect_equal(tsne_out_matrix$Y,tsne_out_df$Y)
  
  # Inexact
  set.seed(50)
  tsne_out_matrix_bh <- Rtsne(as.matrix(iris_unique[,1:4]),verbose=FALSE, is_distance = FALSE,theta=0.1,pca=FALSE,max_iter=iter_equal)
  set.seed(50)
  tsne_out_df <- Rtsne(iris_unique[,1:4],verbose=FALSE, is_distance = FALSE,theta=0.1,pca=FALSE,max_iter=iter_equal,num_threads=1)
  expect_equal(tsne_out_matrix_bh$Y,tsne_out_df$Y)
})

test_that("OpenMP with different threads returns same result",{
  
  # Does not work on windows
  skip_on_cran()
  skip_on_ci()
  
  set.seed(50)
  tsne_out_df1 <- Rtsne(iris_unique[,1:4],dims=3,verbose=FALSE, is_distance = FALSE,
                       theta=0.1,pca=FALSE,max_iter=iter_equal,num_threads=1)
  set.seed(50)
  tsne_out_df2 <- Rtsne(iris_unique[,1:4],dims=3,verbose=FALSE, is_distance = FALSE,
                       theta=0.1,pca=FALSE,max_iter=iter_equal,num_threads=2)
  set.seed(50)
  tsne_out_df3 <- Rtsne(iris_unique[,1:4],dims=3,verbose=FALSE, is_distance = FALSE,
                       theta=0.1,pca=FALSE,max_iter=iter_equal,num_threads=3)
  expect_equal(tsne_out_df1$Y,tsne_out_df2$Y)
  expect_equal(tsne_out_df2$Y,tsne_out_df3$Y)
})

test_that("Continuing from initialization gives approximately the same result as direct run", {

  # Does not work exactly due to resetting of "gains".
  iter_equal <- 1000
  extra_iter <- 200
  
  #Exact
  set.seed(50)
  tsne_out_full <- Rtsne(iris_unique[,1:4],
                         perplexity=3,theta=0.0,pca=FALSE,
                         max_iter=iter_equal,final_momentum = 0)
  set.seed(50)
  tsne_out_part1 <- Rtsne(iris_unique[,1:4],
                          perplexity=3,theta=0.0,pca=FALSE,
                          max_iter=iter_equal-extra_iter,final_momentum = 0)
  tsne_out_part2 <- Rtsne(iris_unique[,1:4],
                          perplexity=3,theta=0.0,pca=FALSE,
                          max_iter=extra_iter,Y_init=tsne_out_part1$Y,final_momentum = 0)
  expect_equivalent(dist(tsne_out_full$Y),dist(tsne_out_part2$Y),tolerance=0.01)

  #Inexact
  set.seed(50)
  tsne_out_full <- Rtsne(iris_unique[,1:4],final_momentum=0,theta=0.1,pca=FALSE,max_iter=iter_equal)
  set.seed(50)
  tsne_out_part1 <- Rtsne(iris_unique[,1:4],final_momentum=0,theta=0.1,pca=FALSE,max_iter=iter_equal-extra_iter)
  set.seed(50)
  tsne_out_part2 <- Rtsne(iris_unique[,1:4],final_momentum=0,theta=0.1,pca=FALSE,max_iter=extra_iter,Y_init=tsne_out_part1$Y)
  expect_equivalent(dist(tsne_out_full$Y),dist(tsne_out_part2$Y),tolerance=0.01)
})

test_that("partial_pca FALSE and TRUE give similar results", {
  
  # Only first few iterations
  iter_equal <- 5
  
  set.seed(42)
  fat_data <- rbind(sapply(runif(200,-1,1), function(x) rnorm(200,x)),
                    sapply(runif(200,-1,1), function(x) rnorm(200,x)))
  
  set.seed(42)
  tsne_out_prcomp <- Rtsne(fat_data, max_iter = iter_equal)
  
  set.seed(42)
  tsne_out_irlba <- Rtsne(fat_data, partial_pca = T, max_iter = iter_equal)

  # Sign of principal components are arbitrary so even with same seed tSNE coordinates are not the same
  expect_equal(tsne_out_prcomp$costs, tsne_out_irlba$costs, tolerance = .01, scale = 1)
})

test_that("Error conditions", {
  expect_error(Rtsne("test", matrix(0, 50, 10), Y_init=Y_in, perplexity=10), "matrix")
  expect_error(Rtsne(distmat,is_distance = 3),"logical")
  expect_error(Rtsne(matrix(0,2,3),is_distance = TRUE),"Input")
  expect_error(Rtsne(matrix(0,100,3)),"duplicates")
  expect_error(Rtsne(matrix(0,2,3),pca_center = 2),"TRUE")
  expect_error(Rtsne(matrix(0,2,3),initial_dims=1.3),"dimensionality")
  expect_error(Rtsne(matrix(0,2,3),dims=4),"dims")
  expect_error(Rtsne(matrix(0,2,3),max_iter=1.5),"should")
  
  expect_error(Rtsne(matrix(0,2,3),Y_init=matrix(0,2,1)),"incorrect format")
  expect_error(Rtsne(matrix(0,2,3),perplexity = 0),"positive")
  expect_error(Rtsne(matrix(0,2,3),theta = -0.1),"lie")
  expect_error(Rtsne(matrix(0,2,3),theta = 1.001),"lie")
  expect_error(Rtsne(matrix(0,2,3),stop_lying_iter = -1),"positive")
  expect_error(Rtsne(matrix(0,2,3),mom_switch_iter = -1),"positive")
  expect_error(Rtsne(matrix(0,2,3),momentum = -0.1),"positive")
  expect_error(Rtsne(matrix(0,2,3),final_momentum = -0.1),"positive")
  expect_error(Rtsne(matrix(0,2,3),eta = 0.0),"positive")
  expect_error(Rtsne(matrix(0,2,3),exaggeration_factor = 0.0),"positive")
  expect_error(Rtsne(matrix(0,2,3)),"perplexity is too large")
})

test_that("Verbose option", {
  expect_output(Rtsne(iris_unique[,1:4],pca=TRUE,verbose=TRUE,max_iter=150),"Fitting performed")
})