Running ‘runTestSuite.R’ [39s/55s]
Running the tests in ‘tests/runTestSuite.R’ failed.
Complete output:
  > # unit testing
  > if (require(RUnit, quietly = TRUE)) {
  + 
  +     # load package
  +     library(spcosa)
  + 
  +     # define the test suite
  +     testSuite <- defineTestSuite(
  +         name = "spcosa",
  +         dirs = file.path(getwd(), "unitTests"),
  +         testFileRegexp = "^runit_",
  +         testFuncRegexp = "^test_"
  +     )
  +     
  +     # run test suite
  +     testResult <- runTestSuite(testSuite)
  +     
  +     # print HTML version to a file
  +     printHTMLProtocol(testResult, fileName = "unitTesting.html")
  + }
  Loading required package: rJava
  
  
  Executing test function test_estimate  ... Loading required package: sp
   done successfully.
  
  
  
  Executing test function test_stratify  ... Loading required package: rgdal
  rgdal: version: 1.4-7, (SVN revision 845)
   Geospatial Data Abstraction Library extensions to R successfully loaded
   Loaded GDAL runtime: GDAL 2.4.3, released 2019/10/28
   Path to GDAL shared files: /usr/share/gdal
   GDAL binary built with GEOS: TRUE 
   Loaded PROJ.4 runtime: Rel. 6.2.1, November 1st, 2019, [PJ_VERSION: 621]
   Path to PROJ.4 shared files: (autodetected)
   Linking to sp version: 1.3-2 
  OGR data source with driver: ESRI Shapefile 
  Source: "/home/hornik/tmp/R.check/r-devel-gcc/Work/build/Packages/spcosa/maps", layer: "farmsum"
  with 1 features
  It has 4 fields
  Error : 'object' has insufficient grid cells
  In addition: There were 50 or more warnings (use warnings() to see the first 50)
  Error : 'nStrata' should be an integer vector of length 1 (i.e., a scalar)
  Error : 'nStrata' should be a strictly positive integer
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  spcosa
   --- call from context --- 
  .local(object, ...)
   --- call from argument --- 
  if (class(priorPoints) != "SpatialPoints") {
      stop("'priorPoints' has to be an instance of class \"SpatialPoints\"", 
          call. = FALSE)
  }
   --- R stacktrace ---
  where 1: .local(object, ...)
  where 2: stratify(object = object, nStrata = nStrata, priorPoints = priorPoints, 
      maxIterations = maxIterations, nTry = nTry, equalArea = equalArea, 
      verbose = verbose)
  where 3: stratify(object = object, nStrata = nStrata, priorPoints = priorPoints, 
      maxIterations = maxIterations, nTry = nTry, equalArea = equalArea, 
      verbose = verbose)
  where 4: .local(object, ...)
  where 5: stratify(object = map, nStrata = 10, priorPoints = matrix(runif(10), 
      nrow = 5, ncol = 2), maxIterations = 1000, nTry = 1, nGridCells = 10000, 
      equalArea = FALSE)
  where 6: stratify(object = map, nStrata = 10, priorPoints = matrix(runif(10), 
      nrow = 5, ncol = 2), maxIterations = 1000, nTry = 1, nGridCells = 10000, 
      equalArea = FALSE)
  where 7: eval(expr, envir = parent.frame())
  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) {
      call <- conditionCall(e)
      if (!is.null(call)) {
          if (identical(call[[1L]], quote(doTryCatch))) 
              call <- sys.call(-4L)
          dcall <- deparse(call)[1L]
          prefix <- paste("Error in", dcall, ": ")
          LONG <- 75L
          sm <- strsplit(conditionMessage(e), "\n")[[1L]]
          w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")
          if (is.na(w)) 
              w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], 
                  type = "b")
          if (w > LONG) 
              prefix <- paste0(prefix, "\n  ")
      }
      else prefix <- "Error : "
      msg <- paste0(prefix, conditionMessage(e), "\n")
      .Internal(seterrmessage(msg[1L]))
      if (!silent && isTRUE(getOption("show.error.messages"))) {
          cat(msg, file = outFile)
          .Internal(printDeferredWarnings())
      }
      invisible(structure(msg, class = "try-error", condition = e))
  })
  where 12: try(eval(expr, envir = parent.frame()), silent = silent)
  where 13: checkException(stratify(object = map, nStrata = 10, priorPoints = matrix(runif(10), 
      nrow = 5, ncol = 2), maxIterations = 1000, nTry = 1, nGridCells = 10000, 
      equalArea = FALSE))
  where 14: func()
  where 15: system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest)
  where 16: doTryCatch(return(expr), name, parentenv, handler)
  where 17: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 18: tryCatchList(expr, classes, parentenv, handlers)
  where 19: tryCatch(expr, error = function(e) {
      call <- conditionCall(e)
      if (!is.null(call)) {
          if (identical(call[[1L]], quote(doTryCatch))) 
              call <- sys.call(-4L)
          dcall <- deparse(call)[1L]
          prefix <- paste("Error in", dcall, ": ")
          LONG <- 75L
          sm <- strsplit(conditionMessage(e), "\n")[[1L]]
          w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")
          if (is.na(w)) 
              w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], 
                  type = "b")
          if (w > LONG) 
              prefix <- paste0(prefix, "\n  ")
      }
      else prefix <- "Error : "
      msg <- paste0(prefix, conditionMessage(e), "\n")
      .Internal(seterrmessage(msg[1L]))
      if (!silent && isTRUE(getOption("show.error.messages"))) {
          cat(msg, file = outFile)
          .Internal(printDeferredWarnings())
      }
      invisible(structure(msg, class = "try-error", condition = e))
  })
  where 20: try(system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest))
  where 21: .executeTestCase(funcName, envir = sandbox, setUpFunc = .setUp, 
      tearDownFunc = .tearDown)
  where 22: .sourceTestFile(testFile, testSuite$testFuncRegexp)
  where 23: runTestSuite(testSuite)
  
   --- value of length: 2 type: logical ---
  [1] TRUE TRUE
   --- function from context --- 
  function (object, nStrata, priorPoints = NULL, maxIterations = 1000L, 
      nTry = 1L, equalArea = FALSE, verbose = getOption("verbose")) 
  {
      if (length(nStrata) != 1L) {
          stop("'nStrata' should be an integer vector of length 1 (i.e., a scalar)", 
              call. = FALSE)
      }
      if (nStrata < 1L) {
          stop("'nStrata' should be a strictly positive integer", 
              call. = FALSE)
      }
      hasPriorPoints <- !is(priorPoints, "NULL")
      if (hasPriorPoints) {
          if (class(priorPoints) != "SpatialPoints") {
              stop("'priorPoints' has to be an instance of class \"SpatialPoints\"", 
                  call. = FALSE)
          }
          if (nrow(coordinates(priorPoints)) == 0L) {
              stop("'priorPoints' does not contain coordinates", 
                  call. = FALSE)
          }
      }
      externalProjection <- proj4string(object)
      hasProjection <- !is.na(externalProjection)
      if (hasProjection) {
          if (equalArea) {
              stop("strata of equal area in combination with map\nprojections are currently not supported ", 
                  call. = FALSE)
          }
          if (suppressWarnings(require(rgdal))) {
              internalProjection <- CRS("+proj=longlat +ellps=WGS84")
              object <- spTransform(object, internalProjection)
              suppressWarnings(gridded(object) <- TRUE)
          }
          else {
              stop("You need package 'rgdal' to handle projection attributes\nPlease install this package first", 
                  call. = FALSE)
          }
      }
      sObject <- coordinates(object)
      nCells <- nrow(sObject)
      if (nCells < nStrata) {
          stop("'object' has insufficient grid cells", call. = FALSE)
      }
      if (!equalArea) {
          cellSelectionProbability <- rep(x = 1, times = nCells)
      }
      if (hasPriorPoints) {
          if (equalArea) {
              stop("'equalAreas' should be FALSE in case of prior points", 
                  call. = FALSE)
          }
          if (hasProjection) {
              if (!identical(externalProjection, proj4string(priorPoints))) {
                  stop("projections of 'object' and 'priorPoints' don't match", 
                    call. = FALSE)
              }
              priorPoints <- spTransform(priorPoints, CRS("+proj=longlat +ellps=WGS84"))
          }
          cellIdPriorPoint <- priorPoints %over% geometry(object)
          isInTargetUniverse <- !is.na(cellIdPriorPoint)
          isCoinciding <- duplicated(cellIdPriorPoint)
          keep <- isInTargetUniverse & !isCoinciding
          priorPoints <- priorPoints[keep, , drop = FALSE]
          cellIdPriorPoint <- cellIdPriorPoint[keep]
          if (any(!keep)) {
              if (any(!isInTargetUniverse)) {
                  warning(sum(!isInTargetUniverse), " location(s) outside the target universe ", 
                    "(as defined by 'object') have been found\n", 
                    "These locations have been removed. ", sum(isInTargetUniverse), 
                    " location(s) have been retained", call. = FALSE)
              }
              if (any(isCoinciding)) {
                  warning("(Nearly) coinciding points have been removed. ", 
                    call. = FALSE)
              }
          }
          cellSelectionProbability[cellIdPriorPoint] <- 0
          sPriorPoints <- coordinates(priorPoints)
          nPriorPoints <- nrow(sPriorPoints)
          if (nStrata < nPriorPoints) {
              stop("'nStrata' should be greater than or equal to ", 
                  "the number of 'priorPoints'", call. = FALSE)
          }
      }
      else {
          nPriorPoints <- 0L
          sPriorPoints <- NULL
      }
      nFreePoints <- nStrata - nPriorPoints
      cellCenters <- J(class = "partition/LocationFactory", method = ifelse(hasProjection, 
          "getLatLongInstance", "getEastingNorthingInstance"), 
          .jarray(as(sObject[, 1], "double")), .jarray(as(sObject[, 
              2], "double")))
      minimumObjectiveFunctionValue <- Inf
      for (i in seq_len(nTry)) {
          if (verbose) {
              cat(format(Sys.time()), "| optimizing configuration", 
                  i, "\n")
          }
          if (equalArea) {
              p <- new(J("partition/CompactSpatialPartitionSwop"), 
                  cellCenters, .jarray(as(sample(x = rep(x = 0:(nStrata - 
                    1), length = nCells)), "integer")))
          }
          else {
              cellId <- sample(x = seq_len(nCells), size = nFreePoints, 
                  replace = FALSE, prob = cellSelectionProbability)
              sClusterCenters <- rbind(sPriorPoints, sObject[cellId, 
                  ])
              clusterCenters <- J(class = "partition/LocationFactory", 
                  method = ifelse(hasProjection, "getLatLongInstance", 
                    "getEastingNorthingInstance"), .jarray(as(sClusterCenters[, 
                    1], "double")), .jarray(as(sClusterCenters[, 
                    2], "double")))
              p <- new(J("partition/CompactSpatialPartitionTransfer"), 
                  cellCenters, clusterCenters, .jarray(rep(x = c(TRUE, 
                    FALSE), times = c(nPriorPoints, nFreePoints))))
          }
          p$setMaximumNumberOfIterations(as(maxIterations, "integer"))
          p$optimize()
          objectiveFunctionValue <- p$getObjectiveFunctionValue()
          if (objectiveFunctionValue < minimumObjectiveFunctionValue) {
              hasConverged <- p$hasConverged()
              minimumObjectiveFunctionValue <- objectiveFunctionValue
              clusterId <- as(p$getClusterId(), "integer")
              centroids <- p$getCentroids()
              if (hasProjection) {
                  sCentroids <- data.frame(s1 = sapply(X = centroids, 
                    FUN = function(x) {
                      x$getLongitude()
                    }), s2 = sapply(X = centroids, FUN = function(x) {
                    x$getLatitude()
                  }))
              }
              else {
                  sCentroids <- data.frame(s1 = sapply(X = centroids, 
                    FUN = function(x) {
                      x$getEasting()
                    }), s2 = sapply(X = centroids, FUN = function(x) {
                    x$getNorthing()
                  }))
              }
          }
          if (verbose) {
              cat(format(Sys.time()), "|    current objective function value:", 
                  objectiveFunctionValue, "\n")
              cat(format(Sys.time()), "|    minimum objective function value:", 
                  minimumObjectiveFunctionValue, "\n")
          }
      }
      if (!hasConverged) {
          warning("Convergence has not been reached after ", maxIterations, 
              " interations and ", nTry, " attempts", call. = FALSE)
      }
      colnames(sCentroids) <- colnames(sObject)
      coordinates(sCentroids) <- colnames(sCentroids)
      centroids <- sCentroids
      if (hasProjection) {
          object <- spTransform(object, CRS(externalProjection))
          suppressWarnings(gridded(object) <- TRUE)
          proj4string(centroids) <- internalProjection
          centroids <- spTransform(centroids, CRS(externalProjection))
          if (hasPriorPoints) {
              priorPoints <- spTransform(priorPoints, CRS(externalProjection))
          }
      }
      if (equalArea) {
          stratification <- new(Class = "CompactStratificationEqualArea", 
              cells = object, stratumId = clusterId, centroids = centroids, 
              mssd = minimumObjectiveFunctionValue)
      }
      else {
          if (hasPriorPoints) {
              stratification <- new(Class = "CompactStratificationPriorPoints", 
                  cells = object, stratumId = clusterId, centroids = centroids, 
                  priorPoints = priorPoints, mssd = minimumObjectiveFunctionValue)
          }
          else {
              stratification <- new(Class = "CompactStratification", 
                  cells = object, stratumId = clusterId, centroids = centroids, 
                  mssd = minimumObjectiveFunctionValue)
          }
      }
      stratification
  }
  <bytecode: 0x55f583642228>
  <environment: namespace:spcosa>
   --- function search by body ---
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1