tests/testthat/test-Gtuneup.R

In ASRgenomics: Complementary Genomic Functions

# Get data ----------------------------------------------------------------------------------------------

G <- G.matrix(M = geno.apple[1:20, 1:50], method = "VanRaden", na.string="NA")$G

# Dummy G.
dummymat <-
  matrix(c(1,0,0,
           0,1,.25,
           0,.25,1),
         byrow = TRUE, nrow = 3,
         dimnames = list(1:3, 1:3))

# Dummy A.
A <- diag(nrow = nrow(dummymat))
A[lower.tri(A)] <- A[upper.tri(A)] <- runif(3, min = 0, max = .5)
rownames(A) <- colnames(A) <- rownames(dummymat)

# Run simple tests --------------------------------------------------------------------------------------

test_that("tuneup works", {

  Gb <- G.tuneup(G = dummymat, blend = TRUE, pblend = .1)$Gb

  expect_equal(

    Gb,

    (dummymat * .9) + diag(3) * .1

    )

  # Check if rcn increased with blending.
  Gb <- G.tuneup(G = G, bend = TRUE)

  expect_gt(Gb$rcnb, Gb$rcn0)

  # See if alignment changed the matrix.
  Gb <- G.tuneup(G = dummymat, A = A, align = TRUE)$Gb

  expect_false(identical(Gb, dummymat))

  # See if alignment changed the matrix.
  Gb <- G.tuneup(G = dummymat, A = A, blend = TRUE)$Gb

  expect_false(identical(Gb, dummymat))

  # Check sparseform.
  Gb <- G.tuneup(G = dummymat, A = A, blend = TRUE, sparseform = TRUE)$Gb.sparse

  expect_equal(ncol(Gb), 3)

})

test_that("traps work", {

  # Missing A.
  expect_error(
    G.tuneup(G = dummymat, align = TRUE)$Gb
    )

  # Wrong A (align).
  expect_warning(
    G.tuneup(G = dummymat, A = A[1:2, 1:2], align = TRUE)$Gb
  )

  # Wrong A (blend).
  expect_error(
    suppressWarnings(
      G.tuneup(G = dummymat, A = A[1:2, 1:2], blend = TRUE)$Gb
      )
  )

  expect_error(
      G.tuneup(G = dummymat, pblend = -1)$Gb
  )

  # Det for large matrices (det null).
  largemat <- diag(1501, nrow = 1501)
  dimnames(largemat) <- list(1:1501, 1:1501)
  Gb <- G.tuneup(G = largemat, blend = TRUE, determinant = F)

  expect_null(Gb$det0)

  # Det for large matrices (det non-null).
  Gb <- G.tuneup(G = largemat, blend = TRUE, determinant = T)

  expect_false(is.null(Gb$det0))

  # Non-square A.
  expect_error(
      G.tuneup(G = dummymat, A = A[1:2, ], align = TRUE)$Gb
  )

  # Missing names in A.
  Awr <- A
  colnames(Awr) <- c()
  expect_error(
      G.tuneup(G = dummymat, A = Awr, align = TRUE)$Gb
  )

  # Missing names in A.
  Awr <- A
  rownames(Awr) <- c()
  expect_error(
      G.tuneup(G = dummymat, A = Awr, align = TRUE)$Gb
  )

  # Missing names in A.
  expect_error(
      G.tuneup(G = dummymat, A = as.data.frame(A), align = TRUE)$Gb
  )

  # Non-square G.
  expect_error(
      G.tuneup(G = dummymat[1:2,], blend = TRUE)$Gb
  )

  # No tuneup requested.
  expect_error(
      G.tuneup(G = dummymat)$Gb
  )

  # Too many tuneup requested.
  # TODO check that this is what we want.
  expect_error(
      G.tuneup(G = dummymat, blend = TRUE, bend = TRUE, align = TRUE)$Gb
  )

  # Wrong eign.tol.
  expect_error(
      G.tuneup(G = dummymat, blend = TRUE, eig.tol = -1)$Gb
  )

  # Wrong pblend.
  expect_error(
      G.tuneup(G = dummymat, blend = TRUE, pblend = -1)$Gb
  )

  # Non-matching names.
  expect_error(
      G.tuneup(G = dummymat[1:2,], blend = TRUE)$Gb
  )

  # No names.
  dummymatwr <- dummymat
  colnames(dummymatwr) <- c()
  expect_error(
      G.tuneup(G = dummymatwr, blend = TRUE)$Gb
  )

  dummymatwr <- dummymat
  rownames(dummymatwr) <- c()
  expect_error(
      G.tuneup(G = dummymatwr, blend = TRUE)$Gb
  )

  # Wrong G class.
  expect_error(
      G.tuneup(G = as.data.frame(dummymat), blend = TRUE)$Gb
  )

  # Unmatching names G and A.
  Awr <- A
  colnames(Awr) <- rownames(Awr) <- 4:6
  expect_error(
      suppressWarnings(G.tuneup(G = dummymat, A = Awr, blend = TRUE)$Gb)
  )

})