Running ‘testthat.R’ [3s/4s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library('testthat')
  > library('Ternary')
  > library('vdiffr')
  > 
  > test_check("Ternary")
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  Ternary
   --- call from context --- 
  TernaryDensity(coordinates, resolution = 10L)
   --- call from argument --- 
  if (class(coordinates) == "list") {
      scaled <- resolution * vapply(coordinates, function(coord) coord/sum(coord), 
          double(3L))
  } else {
      scaled <- resolution * apply(coordinates, 1, function(coord) coord/sum(coord))
  }
   --- R stacktrace ---
  where 1: TernaryDensity(coordinates, resolution = 10L)
  where 2 at testthat/test-Contours.R#61: ColourTernary(TernaryDensity(coordinates, resolution = 10L))
  where 3: p()
  where 4: print_plot.function(plot, title)
  where 5: print_plot(plot, title)
  where 6: writer(fig, testcase, title)
  where 7 at testthat/test-Contours.R#65: expect_doppelganger("density-contours", DensityContours)
  where 8: eval(code, test_env)
  where 9: eval(code, test_env)
  where 10: 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 11: doTryCatch(return(expr), name, parentenv, handler)
  where 12: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 13: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 14: doTryCatch(return(expr), name, parentenv, handler)
  where 15: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 16: tryCatchList(expr, classes, parentenv, handlers)
  where 17: 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 18: test_code(desc, code, env = parent.frame())
  where 19 at testthat/test-Contours.R#24: test_that("Contours are plotted", {
      Contours <- function() {
          par(mar = rep(0, 4), mfrow = c(2, 2))
          FunctionToContour <- function(a, b, c) {
              a - c + (4 * a * b) + (27 * a * b * c)
          }
          TernaryPlot(alab = "a", blab = "b", clab = "c", point = 1L)
          ColourTernary(TernaryPointValues(FunctionToContour, resolution = 6L))
          TernaryContour(FunctionToContour, resolution = 12L)
          TernaryPlot(alab = "a", blab = "b", clab = "c", point = 2L)
          ColourTernary(TernaryPointValues(FunctionToContour, resolution = 6L))
          TernaryContour(FunctionToContour, resolution = 12L)
          TernaryPlot(alab = "a", blab = "b", clab = "c", point = 3L)
          ColourTernary(TernaryPointValues(FunctionToContour, resolution = 6L))
          TernaryContour(FunctionToContour, resolution = 12L)
          TernaryPlot(alab = "a", blab = "b", clab = "c", point = 4L)
          ColourTernary(TernaryPointValues(FunctionToContour, resolution = 6L))
          TernaryContour(FunctionToContour, resolution = 12L)
      }
      expect_doppelganger("Contours", Contours)
      DensityContours <- function() {
          par(mar = rep(0.2, 4))
          TernaryPlot()
          nPoints <- 400L
          set.seed(0)
          coordinates <- cbind(abs(rnorm(nPoints, 2, 3)), abs(rnorm(nPoints, 
              1, 1.5)), abs(rnorm(nPoints, 1, 0.5)))
          ColourTernary(TernaryDensity(coordinates, resolution = 10L))
          TernaryPoints(coordinates, col = "red", pch = ".")
          TernaryDensityContour(coordinates, resolution = 10L)
      }
      expect_doppelganger("density-contours", DensityContours)
      DensityContours2 <- function() {
          par(mar = rep(0.2, 4))
          TernaryPlot(point = 2)
          nPoints <- 400L
          set.seed(0)
          coordinates <- cbind(abs(rnorm(nPoints, 2, 3)), abs(rnorm(nPoints, 
              1, 1.5)), abs(rnorm(nPoints, 1, 0.5)))
          TernaryPoints(coordinates, col = "red", pch = ".")
          TernaryDensityContour(coordinates, resolution = 10L, 
              edgeCorrection = FALSE)
      }
      expect_doppelganger("density-contours-2", DensityContours2)
      DensityContours3 <- function() {
          par(mar = rep(0.2, 4))
          TernaryPlot(point = 3)
          nPoints <- 400L
          set.seed(0)
          coordinates <- cbind(abs(rnorm(nPoints, 2, 3)), abs(rnorm(nPoints, 
              1, 1.5)), abs(rnorm(nPoints, 1, 0.5)))
          TernaryPoints(coordinates, col = "red", pch = ".")
          TernaryDensityContour(coordinates, resolution = 10L)
      }
      expect_doppelganger("density-contours-3", DensityContours3)
      LoResDensCont <- function() {
          coordinates <- list(middle = c(1, 1, 1), top = c(3, 0, 
              0), belowTop = c(2, 1, 1), leftSideSolid = c(9, 2, 
              9), leftSideSolid2 = c(9.5, 2, 8.5), right3way = c(1, 
              2, 0), rightEdge = c(2.5, 0.5, 0), leftBorder = c(1, 
              1, 4), topBorder = c(2, 1, 3), rightBorder = c(1, 
              2, 3))
          par(mfrow = c(2, 2), mar = rep(0.2, 4))
          TernaryPlot(grid.lines = 3, axis.labels = 1:3, point = "up")
          values <- TernaryDensity(coordinates, resolution = 3L)
          ColourTernary(values)
          TernaryPoints(coordinates, col = "red")
          text(values[1, ], values[2, ], paste(values[3, ], "/ 6"), 
              cex = 0.8)
          TernaryPlot(grid.lines = 3, axis.labels = 1:3, point = "right")
          values <- TernaryDensity(coordinates, resolution = 3L)
          ColourTernary(values)
          TernaryPoints(coordinates, col = "red")
          text(values[1, ], values[2, ], paste(values[3, ], "/ 6"), 
              cex = 0.8)
          TernaryPlot(grid.lines = 3, axis.labels = 1:3, point = "down")
          values <- TernaryDensity(coordinates, resolution = 3L)
          ColourTernary(values)
          TernaryPoints(coordinates, col = "red")
          text(values[1, ], values[2, ], paste(values[3, ], "/ 6"), 
              cex = 0.8)
          TernaryPlot(grid.lines = 3, axis.labels = 1:3, point = "left")
          values <- TernaryDensity(coordinates, resolution = 3L)
          ColourTernary(values)
          TernaryPoints(coordinates, col = "red")
          text(values[1, ], values[2, ], paste(values[3, ], "/ 6"), 
              cex = 0.8)
          TernaryDensityContour(t(vapply(coordinates, I, double(3L))), 
              resolution = 12L, tolerance = -0.02, col = "orange")
      }
      expect_doppelganger("lo-res-density-contours", LoResDensCont)
  })
  where 20: eval(code, test_env)
  where 21: eval(code, test_env)
  where 22: 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 23: doTryCatch(return(expr), name, parentenv, handler)
  where 24: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 25: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 26: doTryCatch(return(expr), name, parentenv, handler)
  where 27: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 28: tryCatchList(expr, classes, parentenv, handlers)
  where 29: 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 30: test_code(NULL, exprs, env)
  where 31: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 32: force(code)
  where 33: doWithOneRestart(return(expr), restart)
  where 34: withOneRestart(expr, restarts[[1L]])
  where 35: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 36: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter, 
      {
          reporter$start_file(basename(path))
          lister$start_file(basename(path))
          source_file(path, new.env(parent = env), chdir = TRUE, 
              wrap = wrap)
          reporter$.end_context()
          reporter$end_file()
      })
  where 37: FUN(X[[i]], ...)
  where 38: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 39: force(code)
  where 40: doWithOneRestart(return(expr), restart)
  where 41: withOneRestart(expr, restarts[[1L]])
  where 42: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 43: with_reporter(reporter = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 44: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 45: test_dir(path = test_path, reporter = reporter, env = env, filter = filter, 
      ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap)
  where 46: test_package_dir(package = package, test_path = test_path, filter = filter, 
      reporter = reporter, ..., stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 47: test_check("Ternary")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (coordinates, resolution = 48L, direction = getOption("ternDirection")) 
  {
      if (class(coordinates) == "list") {
          scaled <- resolution * vapply(coordinates, function(coord) coord/sum(coord), 
              double(3L))
      }
      else {
          scaled <- resolution * apply(coordinates, 1, function(coord) coord/sum(coord))
      }
      whichTri <- floor(scaled)
      margins <- scaled%%1 == 0
      onVertex <- apply(margins, 2, all)
      onEdge <- logical(length(onVertex))
      onEdge[!onVertex] <- apply(margins[, !onVertex], 2, any)
      centres <- whichTri[, !onEdge & !onVertex, drop = FALSE]
      edges <- scaled[, onEdge, drop = FALSE]
      floorEdges <- floor(edges)
      vertices <- scaled[, onVertex, drop = FALSE]
      vertexLocation <- apply(vertices == 0, 2, sum)
      vertexInternal <- vertexLocation == 0L
      vertexOnEdge <- vertexLocation == 1L
      vertexOnCorner <- vertexLocation == 2L
      AllEqual <- function(x, y) all(x == y)
      OnUpEdge <- function(abc) {
          onThisEdge <- apply(floorEdges, 2, AllEqual, abc)
          theseEdges <- edges[, onThisEdge, drop = FALSE]
          ncol(theseEdges) + {
              if (abc[1] == 0) 
                  sum(theseEdges[1, ] == 0)
              else 0L
          } + {
              if (abc[2] == 0) 
                  sum(theseEdges[2, ] == 0)
              else 0L
          } + {
              if (abc[3] == 0) 
                  sum(theseEdges[3, ] == 0)
              else 0L
          }
      }
      OnDownEdge <- function(abc) {
          sum(apply(edges, 2, AllEqual, abc + c(0.5, 0.5, 1)), 
              apply(edges, 2, AllEqual, abc + c(0.5, 1, 0.5)), 
              apply(edges, 2, AllEqual, abc + c(1, 0.5, 0.5)))
      }
      OnUpVertex <- function(abc) {
          onThisTriangle <- apply(vertices, 2, AllEqual, abc + 
              c(1L, 0L, 0L)) | apply(vertices, 2, AllEqual, abc + 
              c(0L, 1L, 0L)) | apply(vertices, 2, AllEqual, abc + 
              c(0L, 0L, 1L))
          sum(vertexInternal[onThisTriangle], 2L * vertexOnEdge[onThisTriangle], 
              6L * vertexOnCorner[onThisTriangle])
      }
      OnDownVertex <- function(abc) {
          onThisTriangle <- apply(vertices, 2, AllEqual, abc + 
              c(1L, 1L, 0L)) | apply(vertices, 2, AllEqual, abc + 
              c(1L, 0L, 1L)) | apply(vertices, 2, AllEqual, abc + 
              c(0L, 1L, 1L))
          sum(vertexInternal[onThisTriangle], 2L * vertexOnEdge[onThisTriangle])
      }
      ups <- unlist(lapply(seq_len(resolution) - 1L, function(a) {
          vapply(seq_len(resolution - a) - 1L, function(b) {
              abc <- c(a, b, resolution - a - b - 1L)
              (6 * sum(apply(centres, 2, AllEqual, abc))) + (3 * 
                  sum(OnUpEdge(abc))) + sum(OnUpVertex(abc))
          }, double(1), USE.NAMES = FALSE)
      }))
      downs <- unlist(lapply(seq_len(resolution - 1L) - 1L, function(a) {
          vapply(seq_len(resolution - a - 1L) - 1L, function(b) {
              abc <- c(a, b, resolution - a - b - 2L)
              6 * sum(apply(centres, 2, AllEqual, abc)) + (3 * 
                  sum(OnDownEdge(abc))) + sum(OnDownVertex(abc))
          }, double(1), USE.NAMES = FALSE)
      }))
      centrePoints <- TriangleCentres(resolution, direction)
      triDown <- as.logical(centrePoints["triDown", ])
      ret <- integer(length(ups) + length(downs))
      towardsBase <- if (direction < 3L) 
          triDown
      else !triDown
      ret[towardsBase] <- downs
      ret[!towardsBase] <- ups
      switch(direction, {
          xy <- centrePoints[1:2, ]
      }, {
          xy <- rbind(x = centrePoints[1, ], y = -centrePoints[2, 
              ])
      }, {
          xy <- rbind(x = -centrePoints[1, ], y = centrePoints[2, 
              ])
      }, {
          xy <- centrePoints[1:2, ]
      })
      rbind(xy, z = ret, down = triDown)
  }
  <bytecode: 0x55d75d679758>
  <environment: namespace:Ternary>
   --- function search by body ---
  Function TernaryDensity in namespace Ternary has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1