Retry CFA test

.github/workflows/test-coverage.yaml.bkp

@@ -0,0 +1,62 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+          extra-repositories: "https://inla.r-inla-download.org/R/testing"                    
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          covr::to_cobertura(cov)
+        shell: Rscript {0}
+
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

R/20-rgeneric.R

@@ -131,6 +131,7 @@ inla_sem <- function(
       front <- Lambda %*% solve(IminB)
     }
     Sigma <- front %*% tcrossprod(Psi, front) + Theta
+    Sigma <- Sigma + diag(1e-10, nrow(Sigma))  # for stability
     solve(Sigma)
   }
 

tests/testthat/test-models.R

@@ -1,77 +1,77 @@
-test_that("Fake test", {
-  require(INLA)
-
-  rgeneric.test = function(
-    cmd = c("graph", "Q", "mu", "initial", "log.norm.const", "log.prior", "quit"),
-    theta = NULL)
-  {
-    envir = parent.env(environment())
-
-    graph = function() {
-      return(matrix(1, n, n))
-    }
-
-    Q = function() {
-      R <- matrix(sin(1:n^2), n, n)
-      R <- R %*% t(R)
-      diag(R) <- diag(R)+1
-      Q <- exp(theta[1]) * R
-      return(Q)
-    }
-
-    mu = function() { return(numeric(0)) }
-
-    log.norm.const = function() { return(numeric(0)) }
-
-    log.prior = function() {
-      return (dgamma(exp(theta[1]), shape = 1, rate = 1, log=TRUE) + theta[1])
-    }
-
-    initial = function() { return(4) }
-
-    if (!length(theta)) theta = initial()
-    val = do.call(match.arg(cmd), args = list())
-    return (val)
-  }
+# test_that("Fake test", {
+#   require(INLA)
+#
+#   rgeneric.test = function(
+#     cmd = c("graph", "Q", "mu", "initial", "log.norm.const", "log.prior", "quit"),
+#     theta = NULL)
+#   {
+#     envir = parent.env(environment())
+#
+#     graph = function() {
+#       return(matrix(1, n, n))
+#     }
+#
+#     Q = function() {
+#       R <- matrix(sin(1:n^2), n, n)
+#       R <- R %*% t(R)
+#       diag(R) <- diag(R)+1
+#       Q <- exp(theta[1]) * R
+#       return(Q)
+#     }
+#
+#     mu = function() { return(numeric(0)) }
+#
+#     log.norm.const = function() { return(numeric(0)) }
+#
+#     log.prior = function() {
+#       return (dgamma(exp(theta[1]), shape = 1, rate = 1, log=TRUE) + theta[1])
+#     }
+#
+#     initial = function() { return(4) }
+#
+#     if (!length(theta)) theta = initial()
+#     val = do.call(match.arg(cmd), args = list())
+#     return (val)
+#   }
+#
+#   n = 100
+#   s = .1
+#   Q <- rgeneric.test("Q", theta = 0)
+#   library(mvtnorm)
+#   S <- solve(as.matrix(Q))
+#   S <- (S + t(S))/2
+#   x <- drop(rmvnorm(1, sigma = S))
+#   y <- x + rnorm(n, sd = s)
+#   cont.family = list(hyper = list(prec = list(initial=log(1/s^2), fixed=TRUE)))
+#   model2 = inla.rgeneric.define(rgeneric.test, n=n, optimize = FALSE)
+#
+#   expect_no_error({
+#     r2 = inla(y ~ -1 + f(idx, model=model2),
+#               data = data.frame(y = y, idx = 1:n), control.family = cont.family)
+#   })
+#
+#
+# })
 
-  n = 100
-  s = .1
-  Q <- rgeneric.test("Q", theta = 0)
-  library(mvtnorm)
-  S <- solve(as.matrix(Q))
-  S <- (S + t(S))/2
-  x <- drop(rmvnorm(1, sigma = S))
-  y <- x + rnorm(n, sd = s)
-  cont.family = list(hyper = list(prec = list(initial=log(1/s^2), fixed=TRUE)))
-  model2 = inla.rgeneric.define(rgeneric.test, n=n, optimize = FALSE)
+test_that("CFA", {
+  # INLA::inla.setOption(num.threads = "1:1")
 
+  mod <- "
+    eta1 =~ y1 + y2 + y3
+    eta2 =~ y4 + y5 + y6
+  "
+  dat <- lavaan::simulateData(mod, sample.nobs = 100)
   expect_no_error({
-    r2 = inla(y ~ -1 + f(idx, model=model2),
-              data = data.frame(y = y, idx = 1:n), control.family = cont.family)
+    fit <- icfa(
+      model = mod,
+      data = dat,
+      meanstructure = FALSE,
+      verbose = FALSE,
+      npost = 10
+    )
   })
-
-
 })
 
-# test_that("CFA", {
-#   INLA::inla.setOption(num.threads = "1:1")
-#
-#   mod <- "
-#     eta1 =~ y1 + y2 + y3
-#     eta2 =~ y4 + y5 + y6
-#   "
-#   dat <- lavaan::simulateData(mod, sample.nobs = 100)
-#   expect_no_error({
-#     fit <- icfa(
-#       model = mod,
-#       data = dat,
-#       meanstructure = FALSE,
-#       verbose = FALSE,
-#       npost = 10
-#     )
-#   })
-# })
-#
 # test_that("SEM", {
 #   INLA::inla.setOption(num.threads = "1:1")
 #