r-lidar / lidR

Airborne LiDAR data manipulation and visualisation for forestry application
https://CRAN.R-project.org/package=lidR
GNU General Public License v3.0
593 stars 131 forks source link

TEST ERROR: failure: length > 1 in coercion to logical #292

Closed HenrikBengtsson closed 4 years ago

HenrikBengtsson commented 4 years ago

Hi. First, I should start saying that it could be that the actual bugs are upstream, so possibly not a bug in your package but I'd like to let you know because your package tests are affected.

Second, I detected this when running strict reverse package dependency checks on future, which I run with:

_R_CHECK_LENGTH_1_CONDITION_verbose
_R_CHECK_LENGTH_1_LOGIC2_=verbose

This will eventually become the default in R. So, I'm a lidR user per-se but I'm hoping you could help narrow this down and report upstream.

So, the error I'm getting is:

* checking tests ... ERROR
  Running ‘testthat.R’
Running the tests in ‘tests/testthat.R’ failed.
Last 13 lines of output:
  'length(x) = 3 > 1' in coercion to 'logical(1)'
  1: catalog_intersect(ctg, pts) at testthat/test-catalog_intersect.R:86
  2: raster::intersect(spdf, y)
  3: raster::intersect(spdf, y)
  4: x[i, ]
  5: x[i, ]

  ══ testthat results  ═══════════════════════════════════════════════════════════
  [ OK: 598 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 3 ]
  1. Error: catalog_intersect extract the tiles lie in a SpatialPolygons (@test-catalog_intersect.R#72) 
  2. Error: catalog_intersect extracts the tiles that lie in the bbox of a Raster (@test-catalog_intersect.R#79) 
  3. Error: catalog_intersect extracts the tiles that contains the points of a SpatialPoints (@test-catalog_intersec
t.R#86) 

  Error: testthat unit tests failed
  Execution halted

The full test log, testthat.Rout.fail, shows:

R version 3.6.1 Patched (2019-09-12 r77183) -- "Action of the Toes"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> Sys.setenv("R_TESTS" = "")
> 
> library(testthat)
> library(lidR)
Loading required package: raster
Loading required package: sp
> 
> options(lidR.progress = FALSE)
> 
> test_check("lidR")
 ----------- FAILURE REPORT -------------- 
 --- failure: length > 1 in coercion to logical ---
 --- srcref --- 
: 
 --- package (from environment) --- 
sp
 --- call from context --- 
x[subsx, ]
 --- call from argument --- 
is.numeric(i) && i < 0
 --- R stacktrace ---
where 1: x[subsx, ]
where 2: x[subsx, ]
where 3: RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, unaryUnion_if_byid_false, 
    "rgeos_intersection")
where 4: rgeos::gIntersection(x[subsx, ], y[subsy, ], byid = TRUE, drop_lower_td = TRUE)
where 5: raster::intersect(spdf, y)
where 6: raster::intersect(spdf, y)
where 7 at testthat/test-catalog_intersect.R#72: catalog_intersect(ctg, polygon)
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-catalog_intersect.R#70: test_that("catalog_intersect extract the tiles lie in a SpatialPol
ygons", 
    {
        ctg2 <- catalog_intersect(ctg, polygon)
        expect_equal(ctg2$filename, c("abc12", "abc17", "abc18", 
            "abc19", "abc20", "abc21", "abc23"))
    })
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: 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 34: FUN(X[[i]], ...)
where 35: lapply(paths, test_file, env = env, reporter = current_reporter, 
    start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
where 36: force(code)
where 37: 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 38: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
    stop_on_warning = stop_on_warning, wrap = wrap)
where 39: 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 40: 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 41: test_check("lidR")

 --- value of length: 7 type: logical ---
   12    17    18    19    20    21    23 
FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
 --- function from context --- 
Method Definition:

function (x, i, j, ..., drop = TRUE) 
{
    missing.i = missing(i)
    missing.j = missing(j)
    nargs = nargs()
    if (missing.i && missing.j) {
        i = TRUE
        j = TRUE
    }
    else if (missing.j && !missing.i) {
        if (nargs == 2) {
            j = i
            i = TRUE
        }
        else {
            j = TRUE
        }
    }
    else if (missing.i && !missing.j) 
        i = TRUE
    if (is.matrix(i)) 
        stop("matrix argument not supported in SpatialPolygonsDataFrame selection")
    if (is(i, "Spatial")) 
        i = !is.na(over(x, geometry(i)))
    if (any(is.na(i))) 
        stop("NAs not permitted in row index")
    if (is.logical(i)) {
        if (length(i) == 1 && i) 
            i = 1:length(x@polygons)
        else i <- which(i)
    }
    if (is.character(i)) 
        i <- match(i, row.names(x))
    y <- new("SpatialPolygonsDataFrame")
    y@proj4string <- x@proj4string
    y@data = x@data[i, j, ..., drop = FALSE]
    y@polygons = x@polygons[i]
    if (length(i) > 0) {
        y@bbox <- .Call(bboxCalcR_c, y@polygons)
        if (is.numeric(i) && i < 0) {
            y@plotOrder <- .Call(SpatialPolygons_plotOrder_c,
                y@polygons)
        }
        else {
            y@plotOrder = order(match(i, x@plotOrder))
        }
    }
    else y@bbox = x@bbox
    y
}
<bytecode: 0x55c898fabf08>
<environment: namespace:sp>

Signatures:
        x                          i         j        
target  "SpatialPolygonsDataFrame" "logical" "missing"
defined "SpatialPolygonsDataFrame" "ANY"     "ANY"    
 --- function search by body ---
S4 Method [:base defined in namespace sp with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame#ANY#ANY has this body.
 ----------- END OF FAILURE REPORT -------------- 
── 1. Error: catalog_intersect extract the tiles lie in a SpatialPolygons (@test
'length(x) = 7 > 1' in coercion to 'logical(1)'
1: catalog_intersect(ctg, polygon) at testthat/test-catalog_intersect.R:72
2: raster::intersect(spdf, y)
3: raster::intersect(spdf, y)
4: rgeos::gIntersection(x[subsx, ], y[subsy, ], byid = TRUE, drop_lower_td = TRUE)
5: RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, unaryUnion_if_byid_false, 
       "rgeos_intersection")
6: x[subsx, ]
7: x[subsx, ]

 ----------- FAILURE REPORT -------------- 
 --- failure: length > 1 in coercion to logical ---
 --- srcref --- 
: 
 --- package (from environment) --- 
sp
 --- call from context --- 
x[subsx, ]
 --- call from argument --- 
is.numeric(i) && i < 0
 --- R stacktrace ---
where 1: x[subsx, ]
where 2: x[subsx, ]
where 3: RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, unaryUnion_if_byid_false, 
    "rgeos_intersection")
where 4: rgeos::gIntersection(x[subsx, ], y[subsy, ], byid = TRUE, drop_lower_td = TRUE)
where 5: intersect(x, y)
where 6: intersect(x, y)
where 7: raster::intersect(spdf, y)
where 8: raster::intersect(spdf, y)
where 9: catalog_intersect(ctg, r)
where 10: withCallingHandlers(expr, warning = function(w) invokeRestart("muffleWarning"))
where 11 at testthat/test-catalog_intersect.R#79: suppressWarnings(catalog_intersect(ctg, r))
where 12: eval(code, test_env)
where 13: eval(code, test_env)
where 14: 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 15: doTryCatch(return(expr), name, parentenv, handler)
where 16: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 17: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 18: doTryCatch(return(expr), name, parentenv, handler)
where 19: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 20: tryCatchList(expr, classes, parentenv, handlers)
where 21: 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 22: test_code(desc, code, env = parent.frame())
where 23 at testthat/test-catalog_intersect.R#77: test_that("catalog_intersect extracts the tiles that lie in the bb
ox of a Raster", 
    {
        ctg2 <- suppressWarnings(catalog_intersect(ctg, r))
        expect_equal(ctg2$filename, c("abc11", "abc12", "abc15", 
            "abc17", "abc18", "abc19", "abc20", "abc21", "abc23"))
    })
where 24: eval(code, test_env)
where 25: eval(code, test_env)
where 26: 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 27: doTryCatch(return(expr), name, parentenv, handler)
where 28: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 29: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 30: doTryCatch(return(expr), name, parentenv, handler)
where 31: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 32: tryCatchList(expr, classes, parentenv, handlers)
where 33: 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 34: test_code(NULL, exprs, env)
where 35: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
where 36: force(code)
where 37: 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 38: FUN(X[[i]], ...)
where 39: lapply(paths, test_file, env = env, reporter = current_reporter, 
    start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
where 40: force(code)
where 41: 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 42: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
    stop_on_warning = stop_on_warning, wrap = wrap)
where 43: 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 44: 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 45: test_check("lidR")

 --- value of length: 9 type: logical ---
   11    12    15    17    18    19    20    21    23 
FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
 --- function from context --- 
Method Definition:

function (x, i, j, ..., drop = TRUE)
    missing.i = missing(i)
    missing.j = missing(j)
    nargs = nargs()
    if (missing.i && missing.j) {
        i = TRUE
        j = TRUE
    }
    else if (missing.j && !missing.i) {
        if (nargs == 2) {
            j = i
            i = TRUE
        }
        else {
            j = TRUE
        }
    }
    else if (missing.i && !missing.j) 
        i = TRUE
    if (is.matrix(i)) 
        stop("matrix argument not supported in SpatialPolygonsDataFrame selection")
    if (is(i, "Spatial")) 
        i = !is.na(over(x, geometry(i)))
    if (any(is.na(i))) 
        stop("NAs not permitted in row index")
    if (is.logical(i)) {
        if (length(i) == 1 && i) 
            i = 1:length(x@polygons)
        else i <- which(i)
    }
    if (is.character(i)) 
        i <- match(i, row.names(x))
    y <- new("SpatialPolygonsDataFrame")
    y@proj4string <- x@proj4string
    y@data = x@data[i, j, ..., drop = FALSE]
    y@polygons = x@polygons[i]
    if (length(i) > 0) {
        y@bbox <- .Call(bboxCalcR_c, y@polygons)
        if (is.numeric(i) && i < 0) {
            y@plotOrder <- .Call(SpatialPolygons_plotOrder_c, 
                y@polygons)
        }
        else {
            y@plotOrder = order(match(i, x@plotOrder))
        }
    }
    else y@bbox = x@bbox
    y
}
<bytecode: 0x55c898fabf08>
<environment: namespace:sp>

Signatures:
        x                          i         j        
target  "SpatialPolygonsDataFrame" "logical" "missing"
defined "SpatialPolygonsDataFrame" "ANY"     "ANY"    
 --- function search by body ---
S4 Method [:base defined in namespace sp with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame#ANY#ANY has this body.
 ----------- END OF FAILURE REPORT -------------- 
── 2. Error: catalog_intersect extracts the tiles that lie in the bbox of a Rast
'length(x) = 9 > 1' in coercion to 'logical(1)'
1: suppressWarnings(catalog_intersect(ctg, r)) at testthat/test-catalog_intersect.R:79
2: withCallingHandlers(expr, warning = function(w) invokeRestart("muffleWarning"))
3: catalog_intersect(ctg, r)
4: raster::intersect(spdf, y)
5: raster::intersect(spdf, y)
6: intersect(x, y)
7: intersect(x, y)
8: rgeos::gIntersection(x[subsx, ], y[subsy, ], byid = TRUE, drop_lower_td = TRUE)
9: RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, unaryUnion_if_byid_false, 
       "rgeos_intersection")
10: x[subsx, ]
11: x[subsx, ]

 ----------- FAILURE REPORT -------------- 
 --- failure: length > 1 in coercion to logical ---
 --- srcref --- 
: 
 --- package (from environment) --- 
sp
 --- call from context --- 
x[i, ]
 --- call from argument --- 
is.numeric(i) && i < 0
 --- R stacktrace ---
where 1: x[i, ]
where 2: x[i, ]
where 3: raster::intersect(spdf, y)
where 4: raster::intersect(spdf, y)
where 5 at testthat/test-catalog_intersect.R#86: catalog_intersect(ctg, pts)
where 6: eval(code, test_env)
where 7: eval(code, test_env)
where 8: 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 9: doTryCatch(return(expr), name, parentenv, handler)
where 10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 11: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 12: doTryCatch(return(expr), name, parentenv, handler)
where 13: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 14: tryCatchList(expr, classes, parentenv, handlers)
where 15: 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 16: test_code(desc, code, env = parent.frame())
where 17 at testthat/test-catalog_intersect.R#84: test_that("catalog_intersect extracts the tiles that contains the 
points of a SpatialPoints", 
    {
        ctg2 <- catalog_intersect(ctg, pts)
        expect_equal(ctg2$filename, c("abc12", "abc17", "abc21"))
    })
where 18: eval(code, test_env)
where 19: eval(code, test_env)
where 20: 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 21: doTryCatch(return(expr), name, parentenv, handler)
where 22: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 23: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 24: doTryCatch(return(expr), name, parentenv, handler)
where 25: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 26: tryCatchList(expr, classes, parentenv, handlers)
where 27: 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 28: test_code(NULL, exprs, env)
where 29: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
where 30: force(code)
where 31: 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 32: FUN(X[[i]], ...)
where 33: lapply(paths, test_file, env = env, reporter = current_reporter, 
    start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
where 34: force(code)
where 35: 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 36: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
    stop_on_warning = stop_on_warning, wrap = wrap)
where 37: 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 38: 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 39: test_check("lidR")

 --- value of length: 3 type: logical ---
   12    17    21 
FALSE FALSE FALSE 
 --- function from context --- 
Method Definition:

function (x, i, j, ..., drop = TRUE) 
{
    missing.i = missing(i)
    missing.j = missing(j)
    nargs = nargs()
    if (missing.i && missing.j) {
        i = TRUE
        j = TRUE
    }
    else if (missing.j && !missing.i) {
        if (nargs == 2) {
            j = i
            i = TRUE
        }
        else {
            j = TRUE
        }
    }
    else if (missing.i && !missing.j) 
        i = TRUE
    if (is.matrix(i)) 
        stop("matrix argument not supported in SpatialPolygonsDataFrame selection")
    if (is(i, "Spatial")) 
        i = !is.na(over(x, geometry(i)))
    if (any(is.na(i))) 
        stop("NAs not permitted in row index")
    if (is.logical(i)) {
        if (length(i) == 1 && i) 
            i = 1:length(x@polygons)
        else i <- which(i)
    }
    if (is.character(i)) 
        i <- match(i, row.names(x))
    y <- new("SpatialPolygonsDataFrame")
    y@proj4string <- x@proj4string
    y@data = x@data[i, j, ..., drop = FALSE]
    y@polygons = x@polygons[i]
    if (length(i) > 0) {
        y@bbox <- .Call(bboxCalcR_c, y@polygons)
        if (is.numeric(i) && i < 0) {
            y@plotOrder <- .Call(SpatialPolygons_plotOrder_c, 
                y@polygons)
        }
        else {
            y@plotOrder = order(match(i, x@plotOrder))
        }
    }
    else y@bbox = x@bbox
    y
}
<bytecode: 0x55c898fabf08>
<environment: namespace:sp>

Signatures:
        x                          i         j        
target  "SpatialPolygonsDataFrame" "integer" "missing"
defined "SpatialPolygonsDataFrame" "ANY"     "ANY" 
<bytecode: 0x55c898fabf08>
<environment: namespace:sp>

Signatures:
        x                          i         j        
target  "SpatialPolygonsDataFrame" "integer" "missing"
defined "SpatialPolygonsDataFrame" "ANY"     "ANY"    
 --- function search by body ---
S4 Method [:base defined in namespace sp with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame has this body.
S4 Method [:base defined in namespace methods with signature SpatialPolygonsDataFrame#ANY#ANY has this body.
 ----------- END OF FAILURE REPORT -------------- 
── 3. Error: catalog_intersect extracts the tiles that contains the points of a 
'length(x) = 3 > 1' in coercion to 'logical(1)'
1: catalog_intersect(ctg, pts) at testthat/test-catalog_intersect.R:86
2: raster::intersect(spdf, y)
3: raster::intersect(spdf, y)
4: x[i, ]
5: x[i, ]

══ testthat results  ═══════════════════════════════════════════════════════════
[ OK: 598 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 3 ]
1. Error: catalog_intersect extract the tiles lie in a SpatialPolygons (@test-catalog_intersect.R#72) 
2. Error: catalog_intersect extracts the tiles that lie in the bbox of a Raster (@test-catalog_intersect.R#79) 
3. Error: catalog_intersect extracts the tiles that contains the points of a SpatialPoints (@test-catalog_intersect.
R#86) 

Error: testthat unit tests failed
Execution halted
Jean-Romain commented 4 years ago

Thank you for reporting. I spotted the issue, it comes from the package raster. Un-factorisinng the code an running _R_CHECK_LENGTH_1_LOGIC2_=true R --vanilla --quiet it gives:

library(lidR)

# Build objects to reproduce
# ---------------------------------
data <- data.table::data.table(
  Max.X   = c(885228.88, 886993.96, 885260.93, 887025.96, 885292.94, 887056.88,
              892199.94, 893265.54, 892229.99, 893295.15, 888759.96, 890524.95,
              892259.98, 894025.98, 892289.96, 894055.93, 888790.91, 890554.98,
              888820.95, 890585.99, 892319.96, 894084.97, 892349.89, 894114.29,
              895250.23, 895094.78, 895044.96, 895053.55, 885323.96, 887087.95),
  Min.X   = c(885022.37, 885204.73, 885027.52, 885229.03, 885040.86, 885261.03,
              891503.09, 892198.69, 891501.42, 892200.07, 886970.07, 888735.55,
              891499.96, 892230.05, 890521.99, 892260.01, 886994.05, 888760.09,
              887026.07, 888791.01, 890525.05, 892290.04, 890555.01, 892320.12,
              894002.98, 894026.02, 894056.02, 894085.03, 885051.45, 885293.03),
  Max.Y   = c(630219.48, 630214.96, 631609.95, 631604.97, 633001.65, 632995.99,
              625898.35, 625882.94, 627289.82, 627273.89, 630174.88, 630134.94,
              628681.66, 628664.99, 630094.95, 630057.95, 631564.98, 631524.94,
              632955.82, 632915.99, 631486.90, 631447.96, 632876.93, 632838.96,
              628627.89, 630019.93, 631410.97, 631740.88, 634393.05, 634386.96),
  Min.Y   = c(629157.18, 629099.31, 630215.04, 630175.05, 631605.02, 631565.05,
              625816.52, 625793.60, 625883.01, 625860.81, 629036.82, 629017.72,
              627274.01, 627251.36, 628665.04, 628628.01, 630135.08, 630095.02,
              631525.01, 631487.19, 630058.02, 630020.05, 631448.08, 631411.03,
              627506.32, 628612.41, 629999.84, 631390.38, 632996.06, 632956.04),
  filename = paste0("abc", 1:30)
)

pgeom <- lapply(1:nrow(data), function(i)
{
  mtx <- matrix(c(data$Min.X[i], data$Max.X[i], data$Min.Y[i], data$Max.Y[i])[c(1, 1, 2, 2, 1, 3, 4, 4, 3, 3)], ncol = 2)
  sp::Polygons(list(sp::Polygon(mtx)),as.character(i))
})

Sr <- sp::SpatialPolygons(pgeom, proj4string = sp::CRS("+init=epsg:26917"))

ctg             <- new("LAScatalog")
ctg@bbox        <- Sr@bbox
ctg@proj4string <- Sr@proj4string
ctg@plotOrder   <- Sr@plotOrder
ctg@data        <- data
ctg@polygons    <- Sr@polygons

pts <- structure(
  c(888653.5, 890731.2, 891261.4, 889667.4,
    887754.0, 888653.5, 633572.9,  633244.7,
    630634.9, 629678.5, 631162.7, 633572.9),
  .Dim = c(6L, 2L))

pts <- sp::SpatialPoints(pts, proj4string = ctg@proj4string)

plot(ctg)
plot(pts, add = T)

# Reproduce the issue
# ---------------------------
spdf <- as.spatial(ctg)
spdf$PolygonID <- 1:nrow(spdf@data)
projection(spdf) <- sp::CRS()
projection(pts) <- sp::CRS()
i <- raster::intersect(spdf, pts)$PolygonID
#> Error in is.numeric(i) && i < 0 : 
#>  'length(x) = 3 > 1' in coercion to 'logical(1)'
ctg2 <- ctg[i,]
#> Error in ctg[i, ] : objet 'i' introuvable
HenrikBengtsson commented 4 years ago

Thanks for tracking this down. FYI, using verbose as in:

_R_CHECK_LENGTH_1_CONDITION_=verbose
_R_CHECK_LENGTH_1_LOGIC2_=verbose

is like true but with full "traceback" output as well.

FYI, the bug is triggered also for R CMD check raster_3.0-7.tar.gz. I've reported upstream, cf. https://github.com/rspatial/raster/issues/75