tests/testthat/test-lotriMat.R

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

skip_on_cran()
test_that("lotriMat", {
  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
  )

  .cls <- c("lotriFix", class(matrix(0)))

  tmp <- lotriMat(omega9)

  expect_error(lotriMatInv(omega9))

  tmp2 <- lotriMatInv(tmp)

  expect_equal(
    dimnames(tmp)[[1]],
    c(
      "eta.Cl", "eta.Ka", "eye.Cl", "eye.Ka", "iov.Cl",
      "iov.Ka", "inv.Cl", "inv.Ka"
    )
  )

  fix1 <- lotri({
    a <- c(0, 1); backTransform("exp"); label("a label")
    b <- c(0, 1, 2)
    c <- fix(1)
    d <- fix(0, 1, 2)
    e <- c(0, 1, 2, fixed)
    f+g ~ fix(1,
              0.5, 1)
  })

  unfix1 <- lotri({
    a <- c(0, 1); backTransform("exp"); label("a label")
    b <- c(0, 1, 2)
    c <- fix(1)
    d <- fix(0, 1, 2)
    e <- c(0, 1, 2, fixed)
    f+g ~ unfix(1,
                0.5, 1)
  })


  fix2 <- lotri({
    h <- c(0, 1); backTransform("expit"); label("b label")
    i <- c(0, 1, 2)
    j <- fix(1)
    k <- fix(0, 1, 2)
    l <- c(0, 1, 2, fixed)
    m+n ~ c(1,
            0.5, 1)
  })

  expect_equal(lotriMatInv(lotriEst(lotriMat(list(fix1, fix2)), drop=TRUE)),
               list(structure(c(1, 0.5, 0.5, 1), .Dim = c(2L, 2L),
                              .Dimnames = list(c("f", "g"), c("f", "g")),
                              lotriFix = structure(c(TRUE, TRUE, TRUE, TRUE),
                                                   .Dim = c(2L, 2L),
                                                   .Dimnames = list(c("f", "g"), c("f", "g"))),
                              class = .cls),
                    structure(c(1, 0.5, 0.5, 1), .Dim = c(2L, 2L),
                              .Dimnames = list(c("m", "n"), c("m", "n")),
                              lotriFix = structure(c(FALSE, FALSE, FALSE, FALSE),
                                                   .Dim = c(2L, 2L),
                                                   .Dimnames = list(c("m", "n"), c("m", "n"))),
                              class = .cls)))

  expect_equal(vapply(seq_along(tmp2), function(i) {
    dimnames(tmp2[[i]])[[1]]
  }, character(1)), c(
    "eta.Cl", "eta.Ka", "eye.Cl", "eye.Ka", "iov.Cl",
    "iov.Ka", "inv.Cl", "inv.Ka"
  ))



  expect_error(.Call(.lotri$`_asLotriMat`, "a", list(nu = 3), "id", PACKAGE = "lotri"))

  expect_error(.Call(.lotri$`_asLotriMat`, matrix(1), list(nu = 3), "id", PACKAGE = "lotri"))
  expect_error(.Call(.lotri$`_asLotriMat`, structure(1, .Dim = c(1L, 1L), dimnames = list(NULL, "a")),
                     list(nu = 3), "id",
                     PACKAGE = "lotri"
  ))
  expect_error(.Call(.lotri$`_asLotriMat`, structure(1, .Dim = c(1L, 1L), dimnames = list("a", NULL)),
                     list(nu = 3), "id",
                     PACKAGE = "lotri"
  ))

  expect_error(.Call(.lotri$`_asLotriMat`, lotri(et1 + et2 ~ c(0.1, 0.01, 1)),
                     "a", "id",
                     PACKAGE = "lotri"
  ))

  expect_error(as.lotri(lotri(et1 + et2 ~ c(0.1, 0.01, 1)), upper = 1L, default = c("id", "id2")))
  expect_error(as.lotri(lotri(et1 + et2 ~ c(0.1, 0.01, 1)), upper = 1L, default = 3))

  expect_error(as.lotri(lotri(et1 + et2 ~ c(0.1, 0.01, 1)), lower = 4))

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    lotri(et5 ~ 6),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2)
  )

  expect_equal(lotriMat(testList),
               structure(c(
                 40, 0.1, 0.1, 0, 0, 0, 0, 0, 0.1, 20, 0.1, 0, 0,
                 0, 0, 0, 0.1, 0.1, 30, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0,
                 0, 0, 0, 0, 0.1, 0.01, 0, 0, 0, 0, 0, 0, 0.01, 1, 0, 0, 0, 0,
                 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1
               ), .Dim = c(8L, 8L)))

  testList <- list(
    matrix(c(1L, 0L, 0L, 1L), 2, 2),
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    lotri(et5 ~ 6),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1))
  )

  expect_equal(lotriMat(testList),
               structure(c(1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
                           0, 40, 0.1, 0.1, 0, 0, 0, 0, 0, 0.1, 20, 0.1, 0, 0, 0, 0, 0,
                           0.1, 0.1, 30, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0,
                           0, 0.1, 0.01, 0, 0, 0, 0, 0, 0, 0.01, 1), .Dim = c(8L, 8L)))

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    lotri(et5 ~ 6),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )

  expect_equal(
    lotriMat(testList),
    structure(c(
      40, 0.1, 0.1, 0, 0, 0, 0, 0, 0.1, 20, 0.1, 0, 0,
      0, 0, 0, 0.1, 0.1, 30, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0,
      0, 0, 0, 0, 0.1, 0.01, 0, 0, 0, 0, 0, 0, 0.01, 1, 0, 0, 0, 0,
      0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1
    ), .Dim = c(8L, 8L), .Dimnames = list(
      c("et2", "et3", "et4", "et5", "et1", "et6", "et7", "et8"),
      c("et2", "et3", "et4", "et5", "et1", "et6", "et7", "et8")
    ))
  )

  expect_error(lotriMat(list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    "A"
  )))

  expect_error(lotriMat(3))

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    list(lotri(et5 ~ 6), 3),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )

  testList1 <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    list(lotri(et5 ~ 6), 3L),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )

  expect_equal(lotriMat(testList), lotriMat(testList1))

  expect_error(lotriMat(testList, 4))
  expect_error(lotriMat(testList, "eta[%d]", "a"))

  expect_equal(
    dimnames(lotriMat(testList, "ETA[%d]", start = 3))[[1]],
    c(
      "et2", "et3", "et4", "ETA[3]", "ETA[4]", "ETA[5]",
      "et1", "et6", "et7", "et8"
    )
  )

  expect_equal(
    dimnames(lotriMat(testList, "ETA[%d]"))[[1]],
    c(
      "et2", "et3", "et4", "ETA[1]", "ETA[2]", "ETA[3]",
      "et1", "et6", "et7", "et8"
    )
  )

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    list(lotri(et5 ~ 6), 3, 4),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )
  expect_error(lotriMat(testList))

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    list(lotri(et5 ~ 6), 0),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )
  expect_error(lotriMat(testList))

  testList <- list(
    lotri({
      et2 + et3 + et4 ~ c(
        40,
        0.1, 20,
        0.1, 0.1, 30
      )
    }),
    list(lotri(et5 ~ 6), 1:3),
    lotri(et1 + et6 ~ c(0.1, 0.01, 1)),
    matrix(c(1L, 0L, 0L, 1L), 2, 2,
           dimnames = list(
             c("et7", "et8"),
             c("et7", "et8")
           )
    )
  )

  expect_error(lotriMat(testList))

  mat1 <- lotri({
    et2 + et3 + et4 ~ c(
      40,
      0.1, 20,
      0.1, 0.1, 30
    )
  })

  expect_equal(mat1, lotriMat(mat1))

  mat1 <- list(mat1, 3)

  expect_equal(lotriMat(mat1), lotriMat(list(mat1)))
  expect_equal(lotriMat(mat1, "ETA[%d]"), lotriMat(list(mat1), "ETA[%d]"))
  expect_equal(lotriMat(mat1, "ETA[%d]", 4), lotriMat(list(mat1), "ETA[%d]", 4L))

})