################################################################################

# https://github.com/hadley/testthat/issues/567
Sys.unsetenv("R_TESTS")

################################################################################

library(testthat)
library(bigstatsr)
library(bigparallelr)

################################################################################

opt.save <- options(bigstatsr.downcast.warning = FALSE,
                    bigstatsr.block.sizeGB = 1e-5,
                    bigstatsr.check.parallel.blas = FALSE)

################################################################################

not_cran <- identical(Sys.getenv("BIGSTATSR_CRAN"), "false")

test_cores <- function() {
  `if`(not_cran && (parallel::detectCores() > 2) &&
         identical(Sys.getenv("_R_CHECK_LIMIT_CORES_"), "false"),
       sample(2, size = 1), 1)
}

################################################################################

TEST.TYPES <- c("raw", "unsigned short", "integer", "float", "double")

asFBMcode <- function(x, same_code = FALSE) {
  x <- round(x)
  if (same_code) {
    tmp <- unique(as.vector(x))
    code <- rep(NA_real_, 256)
    code[tmp + 1] <- tmp
  } else {
    code <- rnorm(256)
  }
  storage.mode(x) <- "raw"
  add_code256(big_copy(x, type = "raw"), code)
}

################################################################################

# function for comparing PCs
diffPCs <- function(test, rot) {
  k <- ncol(test)
  diff1 <- 2 * abs(test - rot[, 1:k]) / (abs(test) + abs(rot[, 1:k]))
  diff2 <- 2 * abs(test + rot[, 1:k]) / (abs(test) + abs(rot[, 1:k]))
  diff <- pmin(diff1, diff2)
  mean(diff)
}

################################################################################

custom_scaling <- function(X, ind.row = rows_along(X),
                           ind.col = cols_along(X), ncores = 1) {
  stats <- big_colstats(X, ind.row, ind.col, ncores = ncores)
  data.frame(center = stats$sum / length(ind.row), scale = sqrt(stats$var))
}

################################################################################

set.seed(NULL)
if (not_cran) {
  # Seeds that won't work (because of bad luck)
  # 3544 -> spLinReg & spLogReg
  # 4475, 6649 -> spLinReg
  do_not_use <- c(3544, 4475, 6649)
  while ((SEED <- round(runif(1, 1, 9999))) %in% do_not_use) NULL
} else {
  SEED <- 1
}
cat("========== SEED:", SEED, "==========\n")

################################################################################