Issue in tests

[zalbanob]

══ Failed ═══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════
── 1. Failure (test-PROPD-theta.R:72:3): active theta_e matches calculation using theta_d ───────────────────────────────────────────────────────────────────────────────────────────────────────
setActive(pd_w, what = "theta_e")@results$theta (`actual`) not equal to 1 - pd_w@results$theta + ... (`expected`).

  `actual`: 1.0 1.0 1.0 1.0 1.0 1.0
`expected`: NaN NaN NaN NaN NaN NaN

── 2. Failure (test-PROPD-theta.R:85:3): active theta_f matches calculation using theta_e ───────────────────────────────────────────────────────────────────────────────────────────────────────
setActive(pd_w, what = "theta_f")@results$theta (`actual`) not equal to 1 - setActive(pd_w, what = "theta_e")@results$theta (`expected`).

  `actual`: 1.0 1.0 1.0 1.0 1.0 1.0
`expected`: 0.0 0.0 0.0 0.0 0.0 0.0

── 3. Failure (test-PROPD-updateF.R:84:3): updateF correctly calculates F-statistics with moderation and weighted ───────────────────────────────────────────────────────────────────────────────
digest(round(pr_f_mod@results$theta_mod, 4)) (`actual`) not equal to "b89a1343290661cfab2249d506742d1e" (`expected`).

`actual`:   "05471a00f688146bdab0cfd8021dc4af"
`expected`: "b89a1343290661cfab2249d506742d1e"

── 4. Failure (test-PROPD-weight.R:134:5): test that weights are properly incorporated to theta ─────────────────────────────────────────────────────────────────────────────────────────────────
`theta_w` (`actual`) not equal to `theta_e` (`expected`).

  `actual`: 1.0 1.0 1.0 1.0 1.0 1.0
`expected`: NaN NaN NaN NaN NaN NaN

[zalbanob]

in the implementation of calculate_theta

propr/R/2a-propd-backend.R

Line 150 in 60bd9da

lrv0 <-

we do the following

  # Replace NaN thetas (from VLR = 0 or VLR = NaN) with 1
    lrv0 <-
      Reduce("|", lapply(lrvs, is.na)) |
      is.na(lrv) | (lrv == 0) # aVLR triggers NaN
    replaceNaNs <- any(lrv0)
    if (replaceNaNs) {
      if (firstpass)
        message("Alert: Replacing NaN theta values with 1.")
    }


/// then later... 

if (only == "all" | only == "theta_d") {
      theta <- Reduce(`+`, SS) / (p * lrv)
      if (replaceNaNs)
        theta[lrv0] <- 1
      if (only == "theta_d")
        return(theta)
    }

but in the test we donot do the same where we replace the NaNs or 0's by 1

@@ -127,6 +127,10 @@ test_that("test that weights are properly incorporated to theta", {
 
             # calculate theta
             theta <- (omega1 * lrv1 + omega2 * lrv2) / (omega * lrv)
+            bad <- is.na(lrv1) || is.na(lrv2) || is.na(lrv) || (lrv == 0)
+            if (bad || !is.finite(theta)) {
+                theta <- 1
+            }
             theta_e <- c(theta_e, theta)
         }
     }

issue also here:

propr/tests/testthat/test-PROPD-theta.R

Line 48 in 60bd9da

expect_equal(

@@ -45,9 +45,17 @@ test_that("active theta_e matches calculation using theta_d", {
   n1 <- 50
   n2 <- 50
 
+  theta_e_expected <- 1 -
+    pd@results$theta +
+    pmin(
+      (n1 - 1) * pd@results$lrv1,
+      (n2 - 1) * pd@results$lrv2
+    ) / ((n1 + n2 - 1) * pd@results$lrv)
+
+  theta_e_expected[!is.finite(theta_e_expected)] <- 1
   expect_equal(
     setActive(pd, what = "theta_e")@results$theta,
-    1 - pd@results$theta + pmin((n1-1) * pd@results$lrv1, (n2-1) * pd@results$lrv2) / ((n1+n2-1) * pd@results$lrv)
+    theta_e_expected
   )
 

and here

propr/tests/testthat/test-PROPD-theta.R

Line 73 in 60bd9da

setActive(pd_w, what = "theta_e")@results$theta,

@@ -69,9 +77,17 @@ test_that("active theta_e matches calculation using theta_d", {
   ps <- lapply(groups, function(g) propr:::omega(W[g,]))
   names(ps) <- paste0("p", 1:ngrp)
   p <- propr:::omega(W)
+  theta_e_expected_w <- 1 -
+    pd_w@results$theta +
+    pmin(
+      ps[[1]] * pd_w@results$lrv1,
+      ps[[2]] * pd_w@results$lrv2
+    ) / (p * pd_w@results$lrv)
+
+  theta_e_expected_w[!is.finite(theta_e_expected_w)] <- 1
   expect_equal(
     setActive(pd_w, what = "theta_e")@results$theta,
-    1 - pd_w@results$theta + pmin(ps[[1]] * pd_w@results$lrv1, ps[[2]] * pd_w@results$lrv2) / (p * pd_w@results$lrv)
+    theta_e_expected_w
   )
 })

Also would this relationship still hold if we replace the 0s or nan's with 1?

propr/tests/testthat/test-PROPD-theta.R

Lines 79 to 88 in 60bd9da

	expect_equal(
	setActive(pd, what = "theta_f")@results$theta,
	1 - setActive(pd, what = "theta_e")@results$theta
	)
	expect_equal(
	setActive(pd_w, what = "theta_f")@results$theta,
	1 - setActive(pd_w, what = "theta_e")@results$theta
	)

[suzannejin]

Hi @zalbanob, thank you for the work!
If I understood well, the first three issues are related to having some lrv = 0, right? Are you having these issues with the original test data? Or are you adding new test datasets?