tests/testthat/test-lotriSep.R

In lotri: A Simple Way to Specify Symmetric, Block Diagonal Matrices

test_that("lotriSep", {
  
  omega9 <- lotri(
    lotri(
      eta.Cl ~ 0.1,
      eta.Ka ~ 0.1
    ) | id,
    lotri(
      eye.Cl ~ 0.05,
      eye.Ka ~ 0.05
    ) | eye,
    lotri(
      iov.Cl ~ 0.01,
      iov.Ka ~ 0.01
    ) | occ,
    lotri(
      inv.Cl ~ 0.02,
      inv.Ka ~ 0.02
    ) | inv
  )
  omega <- lotri(
    lotri(
      eta.Cl ~ 0.1,
      eta.Ka ~ 0.1
    ) | id(nu = 100),
    lotri(
      eye.Cl ~ 0.05,
      eye.Ka ~ 0.05
    ) | eye(nu = 50),
    lotri(
      iov.Cl ~ 0.01,
      iov.Ka ~ 0.01
    ) | occ(nu = 200),
    lotri(
      inv.Cl ~ 0.02,
      inv.Ka ~ 0.02
    ) | inv(nu = 10)
  )
  
  sep0 <- lotriSep(omega9, above = c(inv = 10L), below = c(eye = 2L, occ = 4L))
  
  attr(sep0$below, "format") <- "ETA[%d]"
  attr(sep0$below, "start") <- 1L
  
  attr(sep0$above, "format") <- "THETA[%d]"
  attr(sep0$above, "start") <- 1L
  
  
  sepA <- lotriSep(omega, above = c(inv = 10L), below = c(eye = 2L, occ = 4L))
  
  sepB <- list(
    above = lotri(lotri(
      inv.Cl ~ 0.02,
      inv.Ka ~ 0.02
    ) |
      inv(nu = 100, same = 10L)),
    below = lotri(
      lotri(
        eta.Cl ~ 0.1,
        eta.Ka ~ 0.1
      ) | id(nu = 100),
      lotri(
        eye.Cl ~ 0.05,
        eye.Ka ~ 0.05
      ) | eye(nu = 50, same = 2L),
      lotri(
        iov.Cl ~ 0.01,
        iov.Ka ~ 0.01
      ) | occ(nu = 200, same = 4L)
    )
  )
  
  attr(sepB$below, "format") <- "ETA[%d]"
  attr(sepB$below, "start") <- 1L
  
  attr(sepB$above, "format") <- "THETA[%d]"
  attr(sepB$above, "start") <- 1L
  
  expect_equal(sepA, sepB)
  
  expect_equal(
    dimnames(lotriMat(sepA$above))[[1]],
    sprintf("THETA[%d]", 1:20)
  )
  expect_equal(
    dimnames(lotriMat(sepA$below))[[1]],
    c("eta.Cl", "eta.Ka", sprintf("ETA[%d]", 1:12))
  )
  
  above1 <- attr(sepA$above, "lotri")
  above1$inv$same <- "matt"
  above <- sepA$above
  attr(above, "lotri") <- above1
  
  expect_equal(dimnames(lotriMat(above))[[1]], c("inv.Cl", "inv.Ka"))
  
  expect_error(lotriSep(omega, above = c(inv = 10L), below = c(eye = 2L, occ = 4L), aboveStart = 1:2))
  
  expect_error(lotriSep(omega, above = c(inv = 10), below = c(eye = 2L, occ = 4L)))
  
  expect_error(lotriSep(omega, above = c(inv = 10L), below = c(eye = 2, occ = 4)))
  
  expect_error(lotriSep(omega, above = 10L, below = c(eye = 2L, occ = 4L)))
  
  expect_error(lotriSep(omega, above = c(inv = 10L), below = c(2L, 4L)))
  
  expect_error(lotriSep(omega, above = c(inv = 10L), below = c(eye = 2L, matt = 4L), aboveStart = 2L))
  
  omega0 <- lotri(
    lotri(
      eye.Cl ~ 0.05,
      eye.Ka ~ 0.05
    ) | eye(nu = 50),
    lotri(
      iov.Cl ~ 0.01,
      iov.Ka ~ 0.01
    ) | occ(nu = 200),
    lotri(
      inv.Cl ~ 0.02,
      inv.Ka ~ 0.02
    ) | inv(nu = 10)
  )
  
  expect_error(lotriSep(omega0, above = c(inv = 10L), below = c(eye = 2L, occ = 4L), aboveStart = 2L))
  
  sepA <- lotriSep(omega, above = NULL, below = c(eye = 2L, occ = 4L))
  
  expect_equal(sepA$above, NULL)
  
  sepA <- lotriSep(omega, above = NULL, below = c(eye = 2L, occ = 4L))
  
  expect_equal(sepA$above, NULL)
  
  ## Bad Lotri matrix
  
  omega1 <- structure(list(id = structure(c(0.1, 0, 0, 0.1), .Dim = c(
    2L,
    2L
  ), .Dimnames = list(c("eta.Cl", "eta.Ka"), c("eta.Cl", "eta.Ka"))), eye = structure(c(0.05, 0, 0, 0.05), .Dim = c(2L, 2L), .Dimnames = list(
    c("eye.Cl", "eye.Ka"), c("eye.Cl", "eye.Ka")
  )), occ = structure(c(
    0.01,
    0, 0, 0.01
  ), .Dim = c(2L, 2L), .Dimnames = list(c("iov.Cl", "iov.Ka"), c("iov.Cl", "iov.Ka"))), inv = structure(c(0.02, 0, 0, 0.02), .Dim = c(2L, 2L), .Dimnames = list(
    c("inv.Cl", "inv.Ka"),
    c("inv.Cl", "inv.Ka")
  ))), lotri = list(
    id = list(nu = 100),
    eye = list(nu = 50), inv = list(nu = 10)
  ), class = "lotri")
  
  expect_error(lotriSep(omega1, above = NULL, below = c(eye = 2L, occ = 4L)))
  
})