CRAN packages with 'length > 1 in coercion to logical' reports

[kaz-yos]

Message from the CRAN maintainer:

NEWS for R-devel has

• Calling && or || with either argument of length greater than one
now gives a warning (which it is intended will become an error).

and checks with this made into a fatal error can be seen at

https://www.stats.ox.ac.uk/pub/bdr/LENGTH1/

with reproduction instructions in the 00README.txt file. (As this was made a fatal error, only the first error will be shown so please do run those instructions before re-submission.)

The problems are occurring in a different package and there is a table of which in that 00README.txt, In some cases, this is from misuse but you may need to contact the maintainer of the other package -- packages

kableExtra pracma tidygraph

have already been contacted but ignored us.

Please correct before 2022-04-04 to safely retain your package on CRAN.

[kaz-yos]

Failure report

   ----------- FAILURE REPORT -------------- 
   --- failure: length > 1 in coercion to logical ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  survey
   --- call from context --- 
  svyCprod(estfun %*% Ainv, design$strata, design$cluster[[1]], 
      design$fpc, design$nPSU, design$certainty, design$postStrata)
   --- call from argument --- 
  this.n == 1 && !this.certain
   --- R stacktrace ---
  where 1: svyCprod(estfun %*% Ainv, design$strata, design$cluster[[1]], 
      design$fpc, design$nPSU, design$certainty, design$postStrata)
  where 2: svy.varcoef(m, design)
  where 3: multiranktest(formula, design, test, ...)
  where 4: svyranktest.svyrep.design(formula = as.formula(formulaString), 
      design = design)
  where 5: svyranktest(formula = as.formula(formulaString), design = design)
  where 6: (function (formulaString, design) 
  {
      svyranktest(formula = as.formula(formulaString), design = design)
  })("alive ~ ..strataVar..", design = list(type = "BRR", scale = 0.25, 
      rscales = c(1, 1, 1, 1), rho = NULL, call = svrepdesign.default(data = scd, 
          type = "BRR", repweights = repweights, combined.weights = FALSE), 
      combined.weights = FALSE, variables = list(ESA = c(1L, 1L, 
      2L, 2L, 3L, 3L), ambulance = c(1L, 2L, 1L, 2L, 1L, 2L), arrests = c(120, 
      78, 185, 228, 670, 530), alive = c(25, 24, 30, 49, 80, 70
      ), ..strataVar.. = c(1L, 1L, 2L, 2L, 3L, 3L)), pweights = c(1, 
      1, 1, 1, 1, 1), repweights = c(2, 0, 2, 0, 2, 0, 2, 0, 0, 
      2, 0, 2, 0, 2, 2, 0, 0, 2, 0, 2, 0, 2, 2, 0), degf = 3, mse = FALSE))
  where 7: do.call(testFunction, args = c(list(obj), testArgs))
  where 8: doTryCatch(return(expr), name, parentenv, handler)
  where 9: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 10: tryCatchList(expr, classes, parentenv, handlers)
  where 11: tryCatch(expr, error = function(e) e)
  where 12: withCallingHandlers(tryCatch(expr, error = function(e) e), warning = w.handler)
  where 13: ModuleTryCatchWE(do.call(testFunction, args = c(list(obj), testArgs))$p.value)
  where 14: ModuleTestSafe(formulaString, testNonNormal, c(list(design = data), 
      argsNonNormal))
  where 15: data.frame(pNormal = ModuleTestSafe(formulaString, testNormal, 
      c(list(design = data, test.terms = "..strataVar.."), argsNormal)), 
      pNonNormal = ModuleTestSafe(formulaString, testNonNormal, 
          c(list(design = data), argsNonNormal)))
  where 16: FUN(X[[i]], ...)
  where 17: lapply(X = X, FUN = FUN, ...)
  where 18: sapply(X = vars, FUN = function(var) {
      formulaString <- paste0(var, " ~ ..strataVar..")
      data.frame(pNormal = ModuleTestSafe(formulaString, testNormal, 
          c(list(design = data, test.terms = "..strataVar.."), 
              argsNormal)), pNonNormal = ModuleTestSafe(formulaString, 
          testNonNormal, c(list(design = data), argsNonNormal)))
  }, simplify = FALSE)
  where 19: (function (vars, strata, data, test = TRUE, testNormal = svyTestNormal, 
      argsNormal = list(method = "Wald"), testNonNormal = svyTestNonNormal, 
      argsNonNormal = NULL, smd = TRUE, addOverall = FALSE) 
  {
      StopIfNotSurveyDesign(data)
      vars <- ModuleReturnVarsExist(vars, data$variables)
      ModuleStopIfNoVarsLeft(vars)
      percentMissing <- ModulePercentMissing(data$variables[vars])
      test <- ModuleReturnFalseIfNoStrata(strata, test)
      smd <- ModuleReturnFalseIfNoStrata(strata, smd)
      strata <- ModuleReturnStrata(strata, data$variables)
      data$variables$..strataVar.. <- interaction(strata, sep = ":")
      strataVarLevels <- levels(data$variables$..strataVar..)
      ..strataVar.. <- NULL
      if (any(!sapply(data$variables[vars], is.numeric))) {
          vars <- vars[sapply(data$variables[vars], is.numeric)]
          warning("Non-numeric variables dropped")
      }
      if (!all(sapply(data$variables[vars], is.numeric))) {
          stop("Can only be run on numeric variables")
      }
      result <- sapply(strataVarLevels, function(level) {
          svyContSummary(vars, subset(data, ..strataVar.. %in% 
              level))
      }, simplify = FALSE)
      class(result) <- "by"
      if (length(result) > 1) {
          strataVarName <- paste0(names(strata), collapse = ":")
          attributes(result) <- c(attributes(result), list(strataVarName = strataVarName))
      }
      pValues <- NULL
      if (test) {
          pValues <- sapply(X = vars, FUN = function(var) {
              formulaString <- paste0(var, " ~ ..strataVar..")
              data.frame(pNormal = ModuleTestSafe(formulaString, 
                  testNormal, c(list(design = data, test.terms = "..strataVar.."), 
                    argsNormal)), pNonNormal = ModuleTestSafe(formulaString, 
                  testNonNormal, c(list(design = data), argsNonNormal)))
          }, simplify = FALSE)
          pValues <- do.call(rbind, pValues)
      }
      smds <- NULL
      if (smd) {
          smds <- sapply(vars, function(var) {
              svyStdDiff(varName = var, groupName = "..strataVar..", 
                  design = data)
          }, simplify = FALSE)
          smds <- FormatLstSmds(smds, nStrata = length(result))
      }
      if (isTRUE(addOverall) & is.list(strata)) {
          result <- c(ModuleCreateOverallColumn(match.call()), 
              result)
          attributes(result)$names <- c(attributes(result)$names[1], 
              strataVarLevels)
          attributes(result) <- c(attributes(result), list(strataVarName = strataVarName))
      }
      class(result) <- c("svyContTable", "ContTable", class(result))
      attributes(result) <- c(attributes(result), list(pValues = pValues), 
          list(smd = smds), list(percentMissing = percentMissing))
      return(result)
  })(vars = "alive", strata = "ESA", data = list(type = "BRR", 
      scale = 0.25, rscales = c(1, 1, 1, 1), rho = NULL, call = svrepdesign.default(data = scd, 
          type = "BRR", repweights = repweights, combined.weights = FALSE), 
      combined.weights = FALSE, variables = list(ESA = c(1L, 1L, 
      2L, 2L, 3L, 3L), ambulance = c(1L, 2L, 1L, 2L, 1L, 2L), arrests = c(120, 
      78, 185, 228, 670, 530), alive = c(25, 24, 30, 49, 80, 70
      )), pweights = c(1, 1, 1, 1, 1, 1), repweights = c(2, 0, 
      2, 0, 2, 0, 2, 0, 0, 2, 0, 2, 0, 2, 2, 0, 0, 2, 0, 2, 0, 
      2, 2, 0), degf = 3, mse = FALSE), test = TRUE, testNormal = function (formulaString, 
      design, test.terms, method = "Wald") 
  {
      out <- svyGlmTermTest(formula = as.formula(formulaString), 
          design = design, test.terms = test.terms, method = method)
      list(p.value = out$p[1, 1])
  }, argsNormal = list(method = "Wald"), testNonNormal = function (formulaString, 
      design) 
  {
      svyranktest(formula = as.formula(formulaString), design = design)
  }, argsNonNormal = NULL, smd = TRUE, addOverall = FALSE)
  where 20: do.call(svyCreateContTable, args = c(list(vars = varNumerics), 
      argsCreateContTable))
  where 21 at test-svyCreateTableOne.R#753: svyCreateTableOne(vars = c("alive", "ambulance"), strata = c("ESA"), 
      factorVars = "ambulance", data = scdrep)
  where 22: eval(code, test_env)
  where 23: eval(code, test_env)
  where 24: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 25: doTryCatch(return(expr), name, parentenv, handler)
  where 26: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 27: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 28: doTryCatch(return(expr), name, parentenv, handler)
  where 29: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 30: tryCatchList(expr, classes, parentenv, handlers)
  where 31: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 32: test_code(desc, code, env = parent.frame(), reporter = reporter)
  where 33 at test-svyCreateTableOne.R#727: test_that("svyrep.design is allowed", {
      data(scd)
      scd
      repweights <- 2 * cbind(c(1, 0, 1, 0, 1, 0), c(1, 0, 0, 1, 
          0, 1), c(0, 1, 1, 0, 0, 1), c(0, 1, 0, 1, 1, 0))
      scdrep <- suppressWarnings(svrepdesign(data = scd, type = "BRR", 
          repweights = repweights, combined.weights = FALSE))
      ans_means <- svyby(formula = ~alive, by = ~ESA, design = scdrep, 
          FUN = svymean)[, 2]
      ans_sds <- sqrt(svyby(formula = ~alive, by = ~ESA, design = scdrep, 
          FUN = svyvar)[, 2])
      ans_props <- svyby(formula = ~I(ambulance - 1), by = ~ESA, 
          design = scdrep, FUN = svymean)[, 2]
      tab1 <- svyCreateTableOne(vars = c("alive", "ambulance"), 
          strata = c("ESA"), factorVars = "ambulance", data = scdrep)
      tab1_print <- print(tab1, format = "p")
      expect_equal(as.character(tab1_print[2, 1:3]), sprintf("%.2f (%.2f)", 
          ans_means, ans_sds))
      expect_equal(as.character(gsub(" ", "", tab1_print[3, 1:3])), 
          sprintf("%.1f", ans_props * 100))
  })
  where 34: eval(code, test_env)
  where 35: eval(code, test_env)
  where 36: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 37: doTryCatch(return(expr), name, parentenv, handler)
  where 38: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 39: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 40: doTryCatch(return(expr), name, parentenv, handler)
  where 41: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 42: tryCatchList(expr, classes, parentenv, handlers)
  where 43: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 44: test_code(NULL, exprs, env)
  where 45: source_file(path, child_env(env), wrap = wrap)
  where 46: FUN(X[[i]], ...)
  where 47: lapply(test_paths, test_one_file, env = env, wrap = wrap)
  where 48: doTryCatch(return(expr), name, parentenv, handler)
  where 49: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 50: tryCatchList(expr, classes, parentenv, handlers)
  where 51: tryCatch(code, testthat_abort_reporter = function(cnd) {
      cat(conditionMessage(cnd), "\n")
      NULL
  })
  where 52: with_reporter(reporters$multi, lapply(test_paths, test_one_file, 
      env = env, wrap = wrap))
  where 53: test_files(test_dir = test_dir, test_package = test_package, 
      test_paths = test_paths, load_helpers = load_helpers, reporter = reporter, 
      env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap, load_package = load_package)
  where 54: test_files(test_dir = path, test_paths = test_paths, test_package = package, 
      reporter = reporter, load_helpers = load_helpers, env = env, 
      stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap, load_package = load_package, parallel = parallel)
  where 55: test_dir("testthat", package = package, reporter = reporter, 
      ..., load_package = "installed")
  where 56: test_check("tableone")
  
   --- value of length: 6 type: logical ---
     1    1    1    1    1    1 
  TRUE TRUE TRUE TRUE TRUE TRUE 
   --- function from context --- 
  function (x, strata, psu, fpc, nPSU, certainty = NULL, postStrata = NULL, 
      lonely.psu = getOption("survey.lonely.psu")) 
  {
      x <- as.matrix(x)
      n <- NROW(x)
      if (!is.null(postStrata)) {
          for (psvar in postStrata) {
              if (inherits(psvar, "greg_calibration") || inherits(psvar, 
                  "raking")) 
                  stop("rake() and calibrate() not supported for old-style design objects")
              psw <- attr(psvar, "weights")
              psmeans <- rowsum(x/psw, psvar, reorder = TRUE)/as.vector(table(factor(psvar)))
              x <- x - psmeans[match(psvar, sort(unique(psvar))), 
                  ] * psw
          }
      }
      if (is.null(strata)) {
          strata <- rep("1", n)
          if (!is.null(nPSU)) 
              names(nPSU) <- "1"
      }
      else strata <- as.character(strata)
      if (is.null(certainty)) {
          certainty <- rep(FALSE, length(strata))
          names(certainty) <- strata
      }
      if (!is.null(psu)) {
          x <- rowsum(x, psu, reorder = FALSE)
          strata <- strata[!duplicated(psu)]
          n <- NROW(x)
      }
      if (!is.null(nPSU)) {
          obsn <- table(strata)
          dropped <- nPSU[match(names(obsn), names(nPSU))] - obsn
          if (sum(dropped)) {
              xtra <- matrix(0, ncol = NCOL(x), nrow = sum(dropped))
              strata <- c(strata, rep(names(dropped), dropped))
              if (is.matrix(x)) 
                  x <- rbind(x, xtra)
              else x <- c(x, xtra)
              n <- NROW(x)
          }
      }
      else obsn <- table(strata)
      if (is.null(strata)) {
          x <- t(t(x) - colMeans(x))
      }
      else {
          strata.means <- drop(rowsum(x, strata, reorder = FALSE))/drop(rowsum(rep(1, 
              n), strata, reorder = FALSE))
          if (!is.matrix(strata.means)) 
              strata.means <- matrix(strata.means, ncol = NCOL(x))
          x <- x - strata.means[match(strata, unique(strata)), 
              , drop = FALSE]
      }
      p <- NCOL(x)
      v <- matrix(0, p, p)
      ss <- unique(strata)
      for (s in ss) {
          this.stratum <- strata %in% s
          this.n <- nPSU[match(s, names(nPSU))]
          this.df <- this.n/(this.n - 1)
          if (is.null(fpc)) 
              this.fpc <- 1
          else {
              this.fpc <- fpc[, 2][fpc[, 1] == as.character(s)]
              this.fpc <- (this.fpc - this.n)/this.fpc
          }
          xs <- x[this.stratum, , drop = FALSE]
          this.certain <- certainty[names(certainty) %in% s]
          lonely.psu <- match.arg(lonely.psu, c("remove", "adjust", 
              "fail", "certainty", "average"))
          if (this.n == 1 && !this.certain) {
              this.df <- 1
              if (lonely.psu == "fail") 
                  stop("Stratum ", s, " has only one sampling unit.")
              else if (lonely.psu != "certainty") 
                  warning("Stratum ", s, " has only one sampling unit.")
              if (lonely.psu == "adjust") 
                  xs <- strata.means[match(s, ss), , drop = FALSE]
          }
          else if (obsn[match(s, names(obsn))] == 1 && !this.certain) {
              warning("Stratum ", s, " has only one PSU in this subset.")
              if (lonely.psu == "adjust") 
                  xs <- strata.means[match(s, ss), , drop = FALSE]
          }
          if (!this.certain) 
              v <- v + crossprod(xs) * this.df * this.fpc
      }
      if (lonely.psu == "average") {
          v <- v/(1 - mean(obsn == 1 & !certainty))
      }
      v
  }
  <bytecode: 0xdc482a8>
  <environment: namespace:survey>
   --- function search by body ---
  Function svyCprod in namespace survey has this body.
   ----------- END OF FAILURE REPORT -------------- 

[kaz-yos]

_R_CHECK_LENGTH_1_LOGIC2_="abort,verbose"; export _R_CHECK_LENGTH_1_LOGIC2_ ; make check # cran-check

R CMD check --as-cran ./tableone_0.13.2.tar.gz | tee cran-check.txt
* using log directory ‘/Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/tableone.Rcheck’
* using R version 4.2.0 beta (2022-04-10 r82135)
* using platform: x86_64-apple-darwin17.0 (64-bit)
* using session charset: UTF-8
* using option ‘--as-cran’
...
* checking tests ...
  Running ‘test-all.R’ [52s/58s]
 ERROR
Running the tests in ‘tests/test-all.R’ failed.
Last 13 lines of output:
          }
          if (!this.certain) 
              v <- v + crossprod(xs) * this.df * this.fpc
      }
      if (lonely.psu == "average") {
          v <- v/(1 - mean(obsn == 1 & !certainty))
      }
      v
  }
  <bytecode: 0x7fedb7e82880>
  <environment: namespace:survey>
   --- function search by body ---
  Function svyCprod in namespace survey has this body.
   ----------- END OF FAILURE REPORT -------------- 

[kaz-yos]

_R_CHECK_LENGTH_1_LOGIC2_="abort,verbose"; export _R_CHECK_LENGTH_1_LOGIC2_ ; make test

...
Unit tests for svy* user functions                                                                      : svyCprod(estfun %*% Ainv, design$strata, design$cluster[[1]], 
    design$fpc, design$nPSU, design$certainty, design$postStrata)
where 2: svy.varcoef(m, design)
where 3: multiranktest(formula, design, test, ...)
where 4: svyranktest.svyrep.design(formula = as.formula(formulaString), 
    design = design)
where 5 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/modules-svy.R#231: svyranktest(formula = as.formula(formulaString), design = design)
where 6: (function(formulaString, design) {

    ## This returns an htest object that has a scalar $p.value element
    svyranktest(formula = as.formula(formulaString), design = design)
})("alive ~ ..strataVar..", design = list(type = "BRR", scale = 0.25, 
    rscales = c(1, 1, 1, 1), rho = NULL, call = svrepdesign.default(data = scd, 
        type = "BRR", repweights = repweights, combined.weights = FALSE), 
    combined.weights = FALSE, variables = list(ESA = c(1L, 1L, 
    2L, 2L, 3L, 3L), ambulance = c(1L, 2L, 1L, 2L, 1L, 2L), arrests = c(120, 
    78, 185, 228, 670, 530), alive = c(25, 24, 30, 49, 80, 70
    ), ..strataVar.. = c(1L, 1L, 2L, 2L, 3L, 3L)), pweights = c(1, 
    1, 1, 1, 1, 1), repweights = c(2, 0, 2, 0, 2, 0, 2, 0, 0, 
    2, 0, 2, 0, 2, 2, 0, 0, 2, 0, 2, 0, 2, 2, 0), degf = 3, mse = FALSE))
where 7: do.call(testFunction, args = c(list(obj), testArgs))
where 8: doTryCatch(return(expr), name, parentenv, handler)
where 9: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 10: tryCatchList(expr, classes, parentenv, handlers)
where 11: tryCatch(expr, error = function(e) e)
where 12 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/modules-constructors.R#255: withCallingHandlers(tryCatch(expr, error = function(e) e), warning = w.handler)
where 13 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/modules-constructors.R#264: ModuleTryCatchWE(do.call(testFunction, args = c(list(obj), testArgs))$p.value)
where 14 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/svyCreateContTable.R#127: ModuleTestSafe(formulaString, testNonNormal, c(list(design = data), 
    argsNonNormal))
where 15 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/svyCreateContTable.R#127: data.frame(pNormal = ModuleTestSafe(formulaString, testNormal, 
    c(list(design = data, test.terms = "..strataVar.."), argsNormal)), 
    pNonNormal = ModuleTestSafe(formulaString, testNonNormal, 
        c(list(design = data), argsNonNormal)))
where 16: FUN(X[[i]], ...)
where 17: lapply(X = X, FUN = FUN, ...)
where 18 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/svyCreateContTable.R#118: sapply(X = vars, FUN = function(var) {
    formulaString <- paste0(var, " ~ ..strataVar..")
    data.frame(pNormal = ModuleTestSafe(formulaString, testNormal, 
        c(list(design = data, test.terms = "..strataVar.."), 
            argsNormal)), pNonNormal = ModuleTestSafe(formulaString, 
        testNonNormal, c(list(design = data), argsNonNormal)))
}, simplify = FALSE)
where 19: (function(vars,                                  # character vector of variable names
         strata,                                # character vector of variable names
         data,                                  # survey design data
         test          = TRUE,                  # Whether to include p-values
         testNormal    = svyTestNormal,         # test for normally distributed variables
         argsNormal    = list(method = "Wald"), # arguments passed to testNormal
         testNonNormal = svyTestNonNormal,      # test for nonnormally distributed variables
         argsNonNormal = NULL,                  # arguments passed to testNonNormal
         smd           = TRUE,                  # whether to include standardize mean differences
         addOverall    = FALSE
         ) {

### Data check
    ## Check if the data given is a survey design object
    StopIfNotSurveyDesign(data)

    ## Check if variables exist. Drop them if not.
    ## survey.design$variables holds original data frame
    vars <- ModuleReturnVarsExist(vars, data$variables)

    ## Abort if no variables exist at this point
    ModuleStopIfNoVarsLeft(vars)

    ## Get the missing percentage for each variable (no strata).
    percentMissing <- ModulePercentMissing(data$variables[vars])

    ## Toggle test FALSE if no strata
    test <- ModuleReturnFalseIfNoStrata(strata, test)
    smd  <- ModuleReturnFalseIfNoStrata(strata, smd)

    ## Create strata data frame (data frame with only strata variables)
    ## FIXME: This changes type of strata; not a good practice
    strata <- ModuleReturnStrata(strata, data$variables)

    ## Create a single stratification variable
    ## Keeps non-existing levels
    data$variables$..strataVar.. <- interaction(strata, sep = ":")
    strataVarLevels <- levels(data$variables$..strataVar..)
    ## Dummy and dumb object to avoid CRAN check "no visible binding for global variable"
    ..strataVar.. <- NULL

    ## Handle non-numeric elements (intergers give TRUE, and pass)
    if(any(!sapply(data$variables[vars], is.numeric))){

        ## If there is any non-numeric variables
        vars <- vars[sapply(data$variables[vars], is.numeric)]
        warning("Non-numeric variables dropped")
    }

    ## Check if all the variables are continuous, and stop if not
    if(!all(sapply(data$variables[vars], is.numeric))) {
        stop("Can only be run on numeric variables")
    }


### Actual descriptive statistics are calculated here.

    ## To implement
    ## Create a single grouping variable from strata variables
    ## Create a list of subgroup data by the grouping variable
    ## Loop over each stratum with matrix forming function

    result <- sapply(strataVarLevels, function(level) {

        ## Create a matrix including vars X c(n,miss,...) matrix
        svyContSummary(vars, subset(data, ..strataVar.. %in% level))

    }, simplify = FALSE)

    ## Make it a by object
    class(result) <- "by"


    ## Add stratification variable information as an attribute
    if (length(result) > 1) {
        ## strataVarName from dimension headers
        strataVarName <- paste0(names(strata), collapse = ":")
        ## Add an attribute for the stratifying variable name
        attributes(result) <- c(attributes(result),
                                list(strataVarName = strataVarName))
    }


### Perform tests when necessary
    ## Initialize to avoid error when it does not exist at the attribute assignment
    pValues <- NULL


    ## Only when test is asked FOR
    if (test) {

        ## Loop over variables in dat, and obtain p values for two tests
        ## DF = 6 when there are 8 levels (one empty), i.e., empty strata dropped by oneway.test/kruskal.test
        pValues <-
        sapply(X = vars,
               FUN = function(var) {

                   ## Create a formula as a string
                   formulaString <- paste0(var, " ~ ..strataVar..")

                   ## Perform tests and return the result as 1x2 DF
                   ## The test functions should take a formula string as their first argument.
                   data.frame(pNormal    = ModuleTestSafe(formulaString, testNormal,
                                                          c(list(design = data, test.terms = "..strataVar.."),
                                                            argsNormal)),
                              pNonNormal = ModuleTestSafe(formulaString, testNonNormal,
                                                          c(list(design = data), argsNonNormal)))
               },
               simplify = FALSE)

        ## Create a single data frame (n x 2 (normal,nonormal))
        pValues <- do.call(rbind, pValues)
    } # Conditional for test == TRUE ends here.


### Perform SMD when requested
    smds <- NULL

    ## Only when SMD is asked for
    if (smd) {
        ## list of smds
        smds <- sapply(vars, function(var) {
            svyStdDiff(varName = var, groupName = "..strataVar..", design = data)
        }, simplify = FALSE)
        ## Give name and add mean column
        smds <- FormatLstSmds(smds, nStrata = length(result))
    }

    if (isTRUE(addOverall) & is.list(strata)) {
        ## Get Overall Table
        result <- c(ModuleCreateOverallColumn(match.call()), result)
        ## Fix attributes
        attributes(result)$names <- c(attributes(result)$names[1], strataVarLevels)
        attributes(result) <- c(attributes(result), list(strataVarName = strataVarName))
    }

    ## Return object
    ## Give an S3 class
    class(result) <- c("svyContTable", "ContTable", class(result))

    ## Give additional attributes
    attributes(result) <- c(attributes(result),
                            list(pValues = pValues),
                            list(smd     = smds),
                            list(percentMissing = percentMissing))

    ## Return
    return(result)
})(vars = "alive", strata = "ESA", data = list(type = "BRR", 
    scale = 0.25, rscales = c(1, 1, 1, 1), rho = NULL, call = svrepdesign.default(data = scd, 
        type = "BRR", repweights = repweights, combined.weights = FALSE), 
    combined.weights = FALSE, variables = list(ESA = c(1L, 1L, 
    2L, 2L, 3L, 3L), ambulance = c(1L, 2L, 1L, 2L, 1L, 2L), arrests = c(120, 
    78, 185, 228, 670, 530), alive = c(25, 24, 30, 49, 80, 70
    )), pweights = c(1, 1, 1, 1, 1, 1), repweights = c(2, 0, 
    2, 0, 2, 0, 2, 0, 0, 2, 0, 2, 0, 2, 2, 0, 0, 2, 0, 2, 0, 
    2, 2, 0), degf = 3, mse = FALSE), test = TRUE, testNormal = function(formulaString, design, test.terms, method = "Wald") {

    out <- svyGlmTermTest(formula = as.formula(formulaString), design = design,
                          test.terms = test.terms, method = method)
    ## Give an appropriate name for consistent extraction
    list(p.value = out$p[1,1])
}, argsNormal = list(method = "Wald"), testNonNormal = function(formulaString, design) {

    ## This returns an htest object that has a scalar $p.value element
    svyranktest(formula = as.formula(formulaString), design = design)
}, argsNonNormal = NULL, smd = TRUE, addOverall = FALSE)
where 20 at /Users/kazuki/Dropbox (Personal)/documents/programming/r/tableone/R/svyCreateTableOne.R#202: do.call(svyCreateContTable, args = c(list(vars = varNumerics), 
    argsCreateContTable))
where 21 at test-svyCreateTableOne.R#753: svyCreateTableOne(vars = c("alive", "ambulance"), strata = c("ESA"), 
    factorVars = "ambulance", data = scdrep)
where 22: eval(code, test_env)
where 23: eval(code, test_env)
where 24: withCallingHandlers({
    eval(code, test_env)
    if (!handled && !is.null(test)) {
        skip_empty()
    }
}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
    message = handle_message, error = handle_error)
where 25: doTryCatch(return(expr), name, parentenv, handler)
where 26: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 27: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 28: doTryCatch(return(expr), name, parentenv, handler)
where 29: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 30: tryCatchList(expr, classes, parentenv, handlers)
where 31: tryCatch(withCallingHandlers({
    eval(code, test_env)
    if (!handled && !is.null(test)) {
        skip_empty()
    }
}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
    message = handle_message, error = handle_error), error = handle_fatal, 
    skip = function(e) {
    })
where 32: test_code(desc, code, env = parent.frame(), reporter = reporter)
where 33 at test-svyCreateTableOne.R#727: test_that("svyrep.design is allowed", {
    data(scd)
    scd
    repweights <- 2 * cbind(c(1, 0, 1, 0, 1, 0), c(1, 0, 0, 1, 
        0, 1), c(0, 1, 1, 0, 0, 1), c(0, 1, 0, 1, 1, 0))
    scdrep <- suppressWarnings(svrepdesign(data = scd, type = "BRR", 
        repweights = repweights, combined.weights = FALSE))
    ans_means <- svyby(formula = ~alive, by = ~ESA, design = scdrep, 
        FUN = svymean)[, 2]
    ans_sds <- sqrt(svyby(formula = ~alive, by = ~ESA, design = scdrep, 
        FUN = svyvar)[, 2])
    ans_props <- svyby(formula = ~I(ambulance - 1), by = ~ESA, 
        design = scdrep, FUN = svymean)[, 2]
    tab1 <- svyCreateTableOne(vars = c("alive", "ambulance"), 
        strata = c("ESA"), factorVars = "ambulance", data = scdrep)
    tab1_print <- print(tab1, format = "p")
    expect_equal(as.character(tab1_print[2, 1:3]), sprintf("%.2f (%.2f)", 
        ans_means, ans_sds))
    expect_equal(as.character(gsub(" ", "", tab1_print[3, 1:3])), 
        sprintf("%.1f", ans_props * 100))
})
where 34: eval(code, test_env)
where 35: eval(code, test_env)
where 36: withCallingHandlers({
    eval(code, test_env)
    if (!handled && !is.null(test)) {
        skip_empty()
    }
}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
    message = handle_message, error = handle_error)
where 37: doTryCatch(return(expr), name, parentenv, handler)
where 38: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 39: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 40: doTryCatch(return(expr), name, parentenv, handler)
where 41: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 42: tryCatchList(expr, classes, parentenv, handlers)
where 43: tryCatch(withCallingHandlers({
    eval(code, test_env)
    if (!handled && !is.null(test)) {
        skip_empty()
    }
}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
    message = handle_message, error = handle_error), error = handle_fatal, 
    skip = function(e) {
    })
where 44: test_code(NULL, exprs, env)
where 45: source_file(path, child_env(env), wrap = wrap)
where 46: FUN(X[[i]], ...)
where 47: lapply(test_paths, test_one_file, env = env, wrap = wrap)
where 48: doTryCatch(return(expr), name, parentenv, handler)
where 49: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 50: tryCatchList(expr, classes, parentenv, handlers)
where 51: tryCatch(code, testthat_abort_reporter = function(cnd) {
    cat(conditionMessage(cnd), "\n")
    NULL
})
where 52: with_reporter(reporters$multi, lapply(test_paths, test_one_file, 
    env = env, wrap = wrap))
where 53: test_files(test_dir = test_dir, test_package = test_package, 
    test_paths = test_paths, load_helpers = load_helpers, reporter = reporter, 
    env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package)
where 54: test_files(test_dir = path, test_paths = test_paths, test_package = package, 
    reporter = reporter, load_helpers = load_helpers, env = env, 
    stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package, parallel = parallel)
where 55: test_dir(test_path, package = package, reporter = reporter, ..., 
    load_package = if (package != "testthat") "source" else "none")
where 56: testthat::test_local(pkg$path, filter = filter, stop_on_failure = stop_on_failure, 
    ...)
where 57: devtools::test()

 --- value of length: 6 type: logical ---
   1    1    1    1    1    1 
TRUE TRUE TRUE TRUE TRUE TRUE 
 --- function from context --- 
function (x, strata, psu, fpc, nPSU, certainty = NULL, postStrata = NULL, 
    lonely.psu = getOption("survey.lonely.psu")) 
{
    x <- as.matrix(x)
    n <- NROW(x)
    if (!is.null(postStrata)) {
        for (psvar in postStrata) {
            if (inherits(psvar, "greg_calibration") || inherits(psvar, 
                "raking")) 
                stop("rake() and calibrate() not supported for old-style design objects")
            psw <- attr(psvar, "weights")
            psmeans <- rowsum(x/psw, psvar, reorder = TRUE)/as.vector(table(factor(psvar)))
            x <- x - psmeans[match(psvar, sort(unique(psvar))), 
                ] * psw
        }
    }
    if (is.null(strata)) {
        strata <- rep("1", n)
        if (!is.null(nPSU)) 
            names(nPSU) <- "1"
    }
    else strata <- as.character(strata)
    if (is.null(certainty)) {
        certainty <- rep(FALSE, length(strata))
        names(certainty) <- strata
    }
    if (!is.null(psu)) {
        x <- rowsum(x, psu, reorder = FALSE)
        strata <- strata[!duplicated(psu)]
        n <- NROW(x)
    }
    if (!is.null(nPSU)) {
        obsn <- table(strata)
        dropped <- nPSU[match(names(obsn), names(nPSU))] - obsn
        if (sum(dropped)) {
            xtra <- matrix(0, ncol = NCOL(x), nrow = sum(dropped))
            strata <- c(strata, rep(names(dropped), dropped))
            if (is.matrix(x)) 
                x <- rbind(x, xtra)
            else x <- c(x, xtra)
            n <- NROW(x)
        }
    }
    else obsn <- table(strata)
    if (is.null(strata)) {
        x <- t(t(x) - colMeans(x))
    }
    else {
        strata.means <- drop(rowsum(x, strata, reorder = FALSE))/drop(rowsum(rep(1, 
            n), strata, reorder = FALSE))
        if (!is.matrix(strata.means)) 
            strata.means <- matrix(strata.means, ncol = NCOL(x))
        x <- x - strata.means[match(strata, unique(strata)), 
            , drop = FALSE]
    }
    p <- NCOL(x)
    v <- matrix(0, p, p)
    ss <- unique(strata)
    for (s in ss) {
        this.stratum <- strata %in% s
        this.n <- nPSU[match(s, names(nPSU))]
        this.df <- this.n/(this.n - 1)
        if (is.null(fpc)) 
            this.fpc <- 1
        else {
            this.fpc <- fpc[, 2][fpc[, 1] == as.character(s)]
            this.fpc <- (this.fpc - this.n)/this.fpc
        }
        xs <- x[this.stratum, , drop = FALSE]
        this.certain <- certainty[names(certainty) %in% s]
        lonely.psu <- match.arg(lonely.psu, c("remove", "adjust", 
            "fail", "certainty", "average"))
        if (this.n == 1 && !this.certain) {
            this.df <- 1
            if (lonely.psu == "fail") 
                stop("Stratum ", s, " has only one sampling unit.")
            else if (lonely.psu != "certainty") 
                warning("Stratum ", s, " has only one sampling unit.")
            if (lonely.psu == "adjust") 
                xs <- strata.means[match(s, ss), , drop = FALSE]
        }
        else if (obsn[match(s, names(obsn))] == 1 && !this.certain) {
            warning("Stratum ", s, " has only one PSU in this subset.")
            if (lonely.psu == "adjust") 
                xs <- strata.means[match(s, ss), , drop = FALSE]
        }
        if (!this.certain) 
            v <- v + crossprod(xs) * this.df * this.fpc
    }
    if (lonely.psu == "average") {
        v <- v/(1 - mean(obsn == 1 & !certainty))
    }
    v
}
<bytecode: 0x7ff446b3ed80>
<environment: namespace:survey>
 --- function search by body ---
Function svyCprod in namespace survey has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: length > 1 in coercion to logical

[kaz-yos]

Skipping the following two test files avoids the issue.

test-modules-svy.R
test-svyCreateTableOne.R

[kaz-yos]

Will proceed with the above temporary solution (disabling tests that call survey) for now.

[mm0hgw]

What is one supposed to do if one actually want to to perform these operations on logical vectors?

This issue trips on some of my input validation. I'm subsetting an object into chunks, by index numbers. (i < 1) provides a vector which is true for all indices too low, while (i >n) provides a vector which is true for all indices too high.

What should I use instead of || since I wish to logically OR these vectors together, in order to report all the bad index numbers at once?

EDIT: found the answer in help('||') having come from C, I'm used to | being bitwise rather than logical OR.