Running ‘testthat.R’ [65s/89s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(dynwrap)
  > 
  > test_check("dynwrap")
  ── 1. Error: Test get_dimred (@test-wrap_add_dimred.R#278)  ────────────────────
  missing value where TRUE/FALSE needed
  1: get_dimred(wr_withdimred, dimred = dyndimred::dimred_pca) at testthat/test-wrap_add_dimred.R:278
  2: dimred(expression)
  3: irlba::prcomp_irlba(x, n = ndim)
  4: do.call(irlba, args = args)
  5: (function (A, nv = 5, nu = nv, maxit = 1000, work = nv + 7, reorth = TRUE, tol = 1e-05, 
         v = NULL, right_only = FALSE, verbose = FALSE, scale = NULL, center = NULL, shift = NULL, 
         mult = NULL, fastpath = TRUE, svtol = tol, smallest = FALSE, ...) 
     {
         ropts <- options(warn = 1)
         mflag <- new.env()
         mflag$flag <- FALSE
         on.exit(options(ropts))
         interchange <- FALSE
         eps <- .Machine$double.eps
         mcall <- as.list(match.call())
         random <- eval(mcall[["rng"]])
         if (is.null(random)) 
             random <- rnorm
         maxritz <- eval(mcall[["maxritz"]])
         if (is.null(maxritz)) 
             maxritz <- 3
         eps2 <- eval(mcall[["invariant_subspace_tolerance"]])
         if (is.null(eps2)) 
             eps2 <- eps^(4/5)
         du <- eval(mcall[["du"]])
         dv <- eval(mcall[["dv"]])
         ds <- eval(mcall[["ds"]])
         deflate <- is.null(du) + is.null(ds) + is.null(dv)
         if (is.logical(scale) && !scale) 
             scale <- NULL
         if (is.logical(shift) && !shift) 
             shift <- NULL
         if (is.logical(center) && !center) 
             center <- NULL
         if (smallest) 
             fastpath <- FALSE
         if (any(dim(A) > 2^32 - 1)) 
             fastpath <- FALSE
         if (deflate == 3) {
             deflate <- FALSE
         }
         else if (deflate == 0) {
             deflate <- TRUE
             warning("The deflation options have been deprecated. Please modify your code to not use them.")
             if (length(ds) > 1) 
                 stop("deflation limited to one dimension")
             if (!is.null(dim(du))) 
                 du <- du[, 1]
             if (!is.null(dim(dv))) 
                 dv <- dv[, 1]
         }
         else stop("all three du ds dv parameters must be specified for deflation")
         if (!is.null(center)) {
             if (is.logical(center) && center) 
                 center <- colMeans(A)
             if (deflate) 
                 stop("the center parameter can't be specified together with deflation parameters")
             if (length(center) != ncol(A)) 
                 stop("center must be a vector of length ncol(A)")
             if (fastpath && !right_only) 
                 du <- NULL
             else du <- 1
             ds <- 1
             dv <- center
             deflate <- TRUE
         }
         if ("integer" == typeof(A)) 
             A <- A + 0
         iscomplex <- is.complex(A)
         m <- nrow(A)
         n <- ncol(A)
         if (is.null(nu)) 
             nu <- nv
         if (!is.null(mult) && deflate) 
             stop("the mult parameter can't be specified together with deflation parameters")
         missingmult <- FALSE
         if (is.null(mult)) {
             missingmult <- TRUE
             mult <- `%*%`
         }
         k <- max(nu, nv)
         if (k <= 0) 
             stop("max(nu, nv) must be positive")
         if (k > min(m - 1, n - 1)) 
             stop("max(nu, nv) must be strictly less than min(nrow(A), ncol(A))")
         if (k >= 0.5 * min(m, n)) {
             warning("You're computing too large a percentage of total singular values, use a standard svd instead.")
         }
         if (work <= 1) 
             stop("work must be greater than 1")
         if (tol < 0) 
             stop("tol must be non-negative")
         if (maxit <= 0) 
             stop("maxit must be positive")
         if (work <= k && !right_only) 
             work <- k + 1
         if (work >= min(n, m)) {
             work <- min(n, m)
             if (work <= k) {
                 k <- work - 1
                 warning("Requested subspace dimension too large! Reduced to ", k)
             }
         }
         k_org <- k
         w_dim <- work
         if (right_only) {
             w_dim <- 1
             fastpath <- FALSE
         }
         if (n > m && smallest) {
             interchange <- TRUE
             temp <- m
             m <- n
             n <- temp
         }
         if (verbose) {
             message("Working dimension size ", work)
         }
         if (min(m, n) < 6) {
             A <- as.matrix(A)
             if (verbose) 
                 message("Tiny problem detected, using standard `svd` function.")
             if (!is.null(scale)) {
                 A <- sweep(A, 2, scale, "/")
                 dv <- dv/scale
             }
             if (!is.null(shift)) 
                 A <- A + diag(shift, nrow(A), ncol(A))
             if (deflate) {
                 if (is.null(du)) 
                     du <- rep(1, nrow(A))
                 A <- A - (ds * du) %*% t(dv)
             }
             s <- svd(A)
             if (smallest) {
                 return(list(d = tail(s$d, k), u = s$u[, tail(seq(ncol(s$u)), k), drop = FALSE], 
                     v = s$v[, tail(seq(ncol(s$v), k)), drop = FALSE], iter = 0, mprod = 0))
             }
             return(list(d = s$d[1:k], u = s$u[, 1:nu, drop = FALSE], v = s$v[, 1:nv, 
                 drop = FALSE], iter = 0, mprod = 0))
         }
         if (deflate) 
             fastpath <- fastpath && is.null(du)
         fastpath <- fastpath && (("Matrix" %in% attributes(class(A)) && ("dgCMatrix" %in% 
             class(A))) || "matrix" %in% class(A))
         if (fastpath && missingmult && !iscomplex && !right_only) {
             RESTART <- 0L
             RV <- RW <- RS <- NULL
             if (is.null(v)) {
                 v <- random(n)
                 if (verbose) 
                     message("Initializing starting vector v with samples from standard normal distribution.\nUse `set.seed` first for reproducibility.")
             }
             else if (is.list(v)) {
                 if (is.null(v$v) || is.null(v$d) || is.null(v$u)) 
                     stop("restart requires left and right singular vectors")
                 if (max(nu, nv) <= min(ncol(v$u), ncol(v$v))) 
                     return(v)
                 RESTART <- as.integer(length(v$d))
                 RND <- random(n)
                 RND <- orthog(RND, v$v)
                 RV <- cbind(v$v, RND/norm2(RND))
                 RW <- v$u
                 RS <- v$d
                 v <- NULL
             }
             SP <- ifelse(is.matrix(A), 0L, 1L)
             if (verbose) 
                 message("irlba: using fast C implementation")
             SCALE <- NULL
             SHIFT <- NULL
             CENTER <- NULL
             if (!is.null(scale)) {
                 if (length(scale) != ncol(A)) 
                     stop("scale length must match number of matrix columns")
                 SCALE <- as.double(scale)
             }
             if (!is.null(shift)) {
                 if (length(shift) != 1) 
                     stop("shift length must be 1")
                 SHIFT <- as.double(shift)
             }
             if (deflate) {
                 if (length(center) != ncol(A)) 
                     stop("the centering vector length must match the number of matrix columns")
                 CENTER <- as.double(center)
             }
             ans <- .Call(C_IRLB, A, as.integer(k), as.double(v), as.integer(work), as.integer(maxit), 
                 as.double(tol), as.double(eps2), as.integer(SP), as.integer(RESTART), 
                 RV, RW, RS, SCALE, SHIFT, CENTER, as.double(svtol))
             if (ans[[6]] == 0 || ans[[6]] == -2) {
                 names(ans) <- c("d", "u", "v", "iter", "mprod", "err")
                 ans$u <- matrix(head(ans$u, m * nu), nrow = m, ncol = nu)
                 ans$v <- matrix(head(ans$v, n * nv), nrow = n, ncol = nv)
                 if (tol * ans$d[1] < eps) 
                     warning("convergence criterion below machine epsilon")
                 if (ans[[6]] == -2) 
                     warning("did not converge--results might be invalid!; try increasing work or maxit")
                 return(ans[-6])
             }
             errors <- c("invalid dimensions", "didn't converge", "out of memory", "starting vector near the null space", 
                 "linear dependency encountered")
             erridx <- abs(ans[[6]])
             if (erridx > 1) 
                 warning("fast code path error ", errors[erridx], "; re-trying with fastpath=FALSE.", 
                     immediate. = TRUE)
         }
         W <- matrix(0, m, w_dim)
         F <- matrix(0, n, 1)
         restart <- FALSE
         if (is.list(v)) {
             if (is.null(v$v) || is.null(v$d) || is.null(v$u)) 
                 stop("restart requires left and right singular vectors")
             if (max(nu, nv) <= min(ncol(v$u), ncol(v$v))) 
                 return(v)
             right_only <- FALSE
             W[, 1:ncol(v$u)] <- v$u
             d <- v$d
             V <- matrix(0, n, work)
             V[, 1:ncol(v$v)] <- v$v
             restart <- TRUE
         }
         else if (is.null(v)) {
             V <- matrix(0, n, work)
             V[, 1] <- random(n)
         }
         else {
             V <- matrix(0, n, work)
             V[1:length(v)] <- v
         }
         B <- NULL
         Bsz <- NULL
         eps23 <- eps^(2/3)
         iter <- 1
         mprod <- 0
         R_F <- NULL
         sqrteps <- sqrt(eps)
         Smax <- 1
         Smin <- NULL
         lastsv <- c()
         if (restart) {
             B <- cbind(diag(d), 0)
             k <- length(d)
             F <- random(n)
             F <- orthog(F, V[, 1:k])
             V[, k + 1] <- F/norm2(F)
         }
         if (deflate && is.null(du)) 
             du <- 1
         while (iter <= maxit) {
             j <- 1
             if (iter == 1 && !restart) {
                 V[, 1] <- V[, 1]/norm2(V[, 1])
             }
             else j <- k + 1
             j_w <- ifelse(w_dim > 1, j, 1)
             VJ <- V[, j]
             if (!is.null(scale)) {
                 VJ <- VJ/scale
             }
             if (interchange) 
                 avj <- mult(VJ, A)
             else avj <- mult(A, VJ)
             W[, j_w] <- as.vector(avj)
             mprod <- mprod + 1
             if (!is.null(shift)) {
                 W[, j_w] <- W[, j_w] + shift * VJ
             }
             if (deflate) {
                 W[, j_w] <- W[, j_w] - ds * drop(cross(dv, VJ)) * du
             }
             if (iter != 1 && w_dim > 1 && reorth) {
                 W[, j] <- orthog(W[, j, drop = FALSE], W[, 1:(j - 1), drop = FALSE])
             }
             S <- norm2(W[, j_w, drop = FALSE])
             if (is.na(S) || S < eps2 && j == 1) 
                 stop("starting vector near the null space")
             if (is.na(S) || S < eps2) {
                 if (verbose) 
                     message_once("invariant subspace found", flag = mflag)
                 W[, j_w] <- random(nrow(W))
                 if (w_dim > 1) 
                     W[, j] <- orthog(W[, j], W[, 1:(j - 1)])
                 W[, j_w] <- W[, j_w]/norm2(W[, j_w])
                 S <- 0
             }
             else W[, j_w] <- W[, j_w]/S
             while (j <= work) {
                 j_w <- ifelse(w_dim > 1, j, 1)
                 if (iscomplex) {
                     if (interchange) 
                       F <- Conj(t(drop(mult(A, Conj(drop(W[, j_w]))))))
                     else F <- Conj(t(drop(mult(Conj(drop(W[, j_w])), A))))
                 }
                 else {
                     if (interchange) 
                       F <- t(drop(mult(A, drop(W[, j_w]))))
                     else F <- t(drop(mult(drop(W[, j_w]), A)))
                 }
                 if (!is.null(shift)) 
                     F <- F + shift * W[, j_w]
                 if (!is.null(scale)) 
                     F <- F/scale
                 if (deflate) {
                     sub <- sum(W[, j_w]) * dv
                     if (!is.null(scale)) 
                       sub <- sub/scale
                     F <- F - sub
                 }
                 mprod <- mprod + 1
                 F <- drop(F - S * V[, j])
                 F <- orthog(F, V[, 1:j, drop = FALSE])
                 if (j + 1 <= work) {
                     R <- norm2(F)
                     if (R < eps2) {
                       if (verbose) 
                         message_once("invariant subspace found", flag = mflag)
                       F <- matrix(random(dim(V)[1]), dim(V)[1], 1)
                       F <- orthog(F, V[, 1:j, drop = FALSE])
                       V[, j + 1] <- F/norm2(F)
                       R <- 0
                     }
                     else V[, j + 1] <- F/R
                     if (is.null(B)) 
                       B <- cbind(S, R)
                     else B <- rbind(cbind(B, 0), c(rep(0, ncol(B) - 1), S, R))
                     jp1_w <- ifelse(w_dim > 1, j + 1, 1)
                     w_old <- W[, j_w]
                     VJP1 <- V[, j + 1]
                     if (!is.null(scale)) {
                       VJP1 <- VJP1/scale
                     }
                     if (interchange) 
                       W[, jp1_w] <- drop(mult(drop(VJP1), A))
                     else W[, jp1_w] <- drop(mult(A, drop(VJP1)))
                     mprod <- mprod + 1
                     if (!is.null(shift)) {
                       W[, jp1_w] <- W[, jp1_w] + shift * VJP1
                     }
                     if (deflate) {
                       W[, jp1_w] <- W[, jp1_w] - ds * drop(cross(dv, VJP1)) * du
                     }
                     W[, jp1_w] <- W[, jp1_w] - R * w_old
                     if (reorth && w_dim > 1) 
                       W[, j + 1] <- orthog(W[, j + 1], W[, 1:j])
                     S <- norm2(W[, jp1_w])
                     if (S < eps2) {
                       if (verbose) 
                         message_once("invariant subspace found", flag = mflag)
                       W[, jp1_w] <- random(nrow(W))
                       if (w_dim > 1) 
                         W[, j + 1] <- orthog(W[, j + 1], W[, 1:j])
                       W[, jp1_w] <- W[, jp1_w]/norm2(W[, jp1_w])
                       S <- 0
                     }
                     else W[, jp1_w] <- W[, jp1_w]/S
                 }
                 else {
                     B <- rbind(B, c(rep(0, j - 1), S))
                 }
                 j <- j + 1
             }
             Bsz <- nrow(B)
             R_F <- norm2(F)
             F <- F/R_F
             Bsvd <- svd(B)
             if (iter == 1) {
                 Smax <- Bsvd$d[1]
                 Smin <- Bsvd$d[Bsz]
             }
             else {
                 Smax <- max(Smax, Bsvd$d[1])
                 Smin <- min(Smin, Bsvd$d[Bsz])
             }
             Smax <- max(eps23, Smax)
             if (!reorth && Smin/Smax < sqrteps) {
                 warning("The matrix is ill-conditioned. Basis will be reorthogonalized.")
                 reorth <- TRUE
             }
             if (smallest) {
                 jj <- seq(ncol(Bsvd$u), 1, by = -1)
                 Bsvd$u <- Bsvd$u[, jj]
                 Bsvd$d <- Bsvd$d[jj]
                 Bsvd$v <- Bsvd$v[, jj]
             }
             R <- R_F * Bsvd$u[Bsz, , drop = FALSE]
             ct <- convtests(Bsz, tol, k_org, Bsvd, abs(R), k, Smax, lastsv, svtol, maxritz, 
                 work, S)
             if (verbose) {
                 message("iter= ", iter, ", mprod= ", mprod, ", sv[", k_org, "]=", sprintf("%.2e", 
                     Bsvd$d[k_org]), ", %change=", sprintf("%.2e", (Bsvd$d[k_org] - lastsv[k_org])/Bsvd$d[k_org]), 
                     ", k=", ct$k)
             }
             lastsv <- Bsvd$d
             k <- ct$k
             if (ct$converged) 
                 break
             if (iter >= maxit) 
                 break
             if (smallest && (Smin/Smax > sqrteps)) {
                 Bsvd2.d <- Bsvd$d
                 Bsvd2.d <- diag(Bsvd2.d, nrow = length(Bsvd2.d))
                 Bsvd2 <- svd(cbind(Bsvd2.d, t(R)))
                 jj <- seq(ncol(Bsvd2$u), 1, by = -1)
                 Bsvd2$u <- Bsvd2$u[, jj]
                 Bsvd2$d <- Bsvd2$d[jj]
                 Bsvd2$v <- Bsvd2$v[, jj]
                 Bsvd$d <- Bsvd2$d
                 Bsvd$u <- Bsvd$u %*% Bsvd2$u
                 Bsvd$v <- cbind(rbind(Bsvd$v, rep(0, Bsz)), c(rep(0, Bsz), 1)) %*% Bsvd2$v
                 V_B_last <- Bsvd$v[Bsz + 1, 1:k]
                 s <- R_F * solve(B, cbind(c(rep(0, Bsz - 1), 1)))
                 Bsvd$v <- Bsvd$v[1:Bsz, , drop = FALSE] + s %*% Bsvd$v[Bsz + 1, ]
                 qrv <- qr(cbind(rbind(Bsvd$v[, 1:k], 0), rbind(-s, 1)))
                 Bsvd$v <- qr.Q(qrv)
                 R <- qr.R(qrv)
                 V[, 1:(k + 1)] <- cbind(V, F) %*% Bsvd$v
                 UT <- t(R[1:(k + 1), 1:k] + R[, k + 1] %*% rbind(V_B_last))
                 B <- diag(Bsvd$d[1:k], nrow = k) %*% (UT * upper.tri(UT, diag = TRUE))[1:k, 
                     1:(k + 1)]
             }
             else {
                 V[, 1:(k + dim(F)[2])] <- cbind(V[, 1:(dim(Bsvd$v)[1]), drop = FALSE] %*% 
                     Bsvd$v[, 1:k], F)
                 B <- cbind(diag(Bsvd$d[1:k], nrow = k), R[1:k])
             }
             if (w_dim > 1) {
                 W[, 1:k] <- W[, 1:(dim(Bsvd$u)[1]), drop = FALSE] %*% Bsvd$u[, 1:k]
             }
             iter <- iter + 1
         }
         if (!ct$converged) 
             warning("did not converge--results might be invalid!; try increasing maxit or work")
         d <- Bsvd$d[1:k_org]
         if (!right_only) {
             u <- W[, 1:(dim(Bsvd$u)[1]), drop = FALSE] %*% Bsvd$u[, 1:k_org, drop = FALSE]
         }
         v <- V[, 1:(dim(Bsvd$v)[1]), drop = FALSE] %*% Bsvd$v[, 1:k_org, drop = FALSE]
         if (smallest) {
             reverse <- seq(length(d), 1)
             d <- d[reverse]
             if (!right_only) 
                 u <- u[, reverse]
             v <- v[, reverse]
         }
         if (tol * d[1] < eps) 
             warning("convergence criterion below machine epsilon")
         if (right_only) 
             return(list(d = d, v = v[, 1:nv, drop = FALSE], iter = iter, mprod = mprod))
         return(list(d = d, u = u[, 1:nu, drop = FALSE], v = v[, 1:nv, drop = FALSE], 
             iter = iter, mprod = mprod))
     })(A = new("dgCMatrix", i = c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 
     1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 
     4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 
     1L, 2L, 3L, 4L, 5L), p = c(0L, 6L, 12L, 18L, 24L, 30L, 36L, 42L, 48L, 54L, 60L), 
         Dim = c(6L, 10L), Dimnames = list(c("truth", "universally", "acknowledged", "that", 
         "a", "single"), c("G1", "G2", "G3", "G4", "G5", "G6", "G7", "G8", "G9", "G10"
         )), x = c(6.4594316186373, 6.89481776330794, 6.61470984411521, 6.62935662007961, 
         6.82017896241519, 6.64385618977472, 6.84549005094437, 6.56985560833095, 6.61470984411521, 
         6.85798099512757, 6.64385618977472, 6.58496250072116, 6.33985000288462, 6.70043971814109, 
         6.61470984411521, 6.7279204545632, 6.58496250072116, 6.79441586635011, 6.59991284218713, 
         6.59991284218713, 6.6724253419715, 6.55458885167764, 6.83289001416474, 6.39231742277876, 
         6.78135971352466, 6.64385618977472, 6.61470984411521, 6.64385618977472, 6.83289001416474, 
         6.61470984411521, 6.64385618977472, 6.7279204545632, 6.4262647547021, 6.61470984411521, 
         6.39231742277876, 6.59991284218713, 6.64385618977472, 6.6724253419715, 6.7279204545632, 
         6.75488750216347, 6.61470984411521, 6.84549005094437, 6.58496250072116, 6.55458885167764, 
         6.68650052718322, 6.56985560833095, 6.5077946401987, 6.4262647547021, 6.55458885167764, 
         6.61470984411521, 6.53915881110803, 6.76818432477693, 6.65821148275179, 6.53915881110803, 
         6.4262647547021, 6.61470984411521, 6.65821148275179, 6.49185309632967, 6.89481776330794, 
         6.65821148275179), factors = list()), nv = 2, center = c(G1 = 6.67705849972166, 
     G2 = 6.68614253150233, G3 = 6.62704973112923, G4 = 6.60867455249448, G5 = 6.68856363257821, 
     G6 = 6.56749691802019, G7 = 6.70988156392208, G8 = 6.55499448046896, G9 = 6.61233535425627, 
     G10 = 6.62401140399309))
  
  ══ testthat results  ═══════════════════════════════════════════════════════════
  [ OK: 1253 | SKIPPED: 1 | WARNINGS: 0 | FAILED: 1 ]
  1. Error: Test get_dimred (@test-wrap_add_dimred.R#278) 
  
  Error: testthat unit tests failed
  Execution halted