tests/testthat/test_vclMatrix_cov.R

In gpuR: GPU Functions for R Objects

library(gpuR)
context("vclMatrix Correlations")

if(detectGPUs() >= 1){
    current_context <- set_device_context("gpu")    
}else{
    current_context <- currentContext()
}

# set seed
set.seed(123)

ORDER_X <- 4
ORDER_Y <- 5

# Base R objects
A <- matrix(rnorm(ORDER_X*ORDER_Y), nrow=ORDER_X, ncol=ORDER_Y)

C <- cov(A)


test_that("vclMatrix Single Precision Pearson Covariance",
{
    has_gpu_skip()
    
    fgpuX <- vclMatrix(A, type="float")
    
    gpuC <- cov(fgpuX)
    gpuCp <- cov(fgpuX, method = "pearson")
    
    expect_is(gpuC, "fvclMatrix")
    expect_equal(gpuC[], C, tolerance=1e-06, 
                 info="float covariance values not equivalent")  
    expect_equal(gpuCp[], C, tolerance=1e-06, 
                 info="float covariance values not equivalent")  
    expect_error(cov(fgpuX, method = "unimplemented"), 
                 info = "no error thrown for unknown method")
})

test_that("vclMatrix Double Precision Pearson Covariance", 
{
    
    has_gpu_skip()
    has_double_skip()
    
    dgpuX <- vclMatrix(A, type="double")
    
    gpuC <- cov(dgpuX)
    
    expect_is(gpuC, "dvclMatrix")
    expect_equal(gpuC[], C, tolerance=.Machine$double.eps ^ 0.5, 
                 info="double colSums not equivalent")  
})

setContext(current_context)