Nothing
tests/testthat/test-isobands.R
In isoband: Generate Isolines and Isobands from Regularly Spaced Elevation Grids
test_that("elementary polygons get merged", {
# two connected polygons get merged
z <- matrix(c(0, 0, 1, 1, 1, 1), ncol = 3, nrow = 2, byrow = TRUE)
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 2.0, 2.5, 3.0) +
c(1.0, 1.0, 1.0, 1.5, 1.5, 2.0, 2.0)
)
expect_equal(out[[1]]$id, rep(1, 7))
#
# two unconnected polygons don't get merged
z <- matrix(c(1, 2, 1, 1, 2, 2), ncol = 3, nrow = 2, byrow = TRUE)
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.5, 3.0, 1.0, 1.5, 1.5, 1.0) +
c(1.5, 2.0, 2.0, 2.0, 2.0, 1.0, 1.0)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 7)
# two separate bands get merged in second row
z <- matrix(c(1, 2, 1, 1, 2, 1, 0, 0, 0), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 1.0, 1.5, 1.5, 2.0, 2.5, 2.5, 3.0, 3.0) +
c(1.50, 1.25, 1.50, 2.00, 3.00, 3.00, 2.00, 1.75, 2.00, 3.00, 3.00, 2.00)
)
expect_equal(out[[1]]$id, rep(1, 12))
# circle gets closed
z <- matrix(c(1, 1, 1, 1, 2, 1, 1, 1, 1), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 1.0, 2.0, 3.0, 3.0, 2.0, 2.5, 2.0, 1.5) +
c(1.0, 1.0, 1.0, 2.0, 3.0, 3.0, 3.0, 2.0, 1.5, 2.0, 2.5, 2.0)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 12)
})
test_that("NAs are handled correctly", {
z <- matrix(c(NA, 1, 1, 1, 1, 1, 1, 1, 1), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 * c(3, 2, 1, 1, 2, 2, 3, 3) + c(1, 1, 1, 2, 2, 3, 3, 2)
)
expect_equal(out[[1]]$id, rep(1, 8))
z <- matrix(c(NA, 1, 1, 1, 1, 1, 1, 1, NA), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 * c(1, 1, 2, 2, 2, 2, 3, 3) + c(1, 2, 2, 1, 2, 3, 3, 2)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 8)
})
test_that("All elementary shapes are calculated correctly", {
# a matrix that requires all elementary shapes for isobanding
z <- matrix(
c(
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2
),
ncol = 18,
nrow = 11,
byrow = TRUE
)
out <- isobands(x = 1:18, y = 11:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
16.00,
15.50,
15.50,
16.00,
16.25,
16.00,
15.00,
14.50,
14.75,
14.75,
14.25,
14.25,
14.00,
13.75,
13.75,
13.25,
13.25,
13.50,
13.00,
12.75,
12.00,
11.50,
11.50,
11.00,
10.00,
9.00,
8.50,
8.50,
8.00,
7.50,
7.50,
7.00,
6.50,
6.50,
6.00,
5.75,
5.75,
5.25,
5.25,
5.00,
4.50,
4.50,
4.00,
3.50,
3.50,
3.25,
3.00,
2.50,
2.00,
1.50,
1.00,
1.00,
1.00,
1.25,
1.00,
1.00,
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.50,
2.00,
2.50,
3.00,
3.25,
3.50,
3.50,
4.00,
4.50,
4.50,
5.00,
5.25,
5.25,
5.75,
5.75,
6.00,
6.50,
6.50,
7.00,
7.50,
7.50,
8.00,
8.50,
8.50,
9.00,
10.00,
11.00,
11.50,
11.50,
12.00,
12.75,
13.00,
13.50,
13.25,
13.25,
13.75,
13.75,
14.00,
14.25,
14.25,
14.75,
14.75,
14.50,
15.00,
16.00,
16.25,
16.00,
15.50,
15.50,
16.00,
16.50,
16.50,
17.00,
18.00,
18.00,
17.00,
16.75,
16.50,
17.00,
17.25,
18.00,
18.00,
17.75,
17.50,
18.00,
18.00,
17.00,
16.75,
17.00,
18.00,
18.00,
17.50,
17.75,
18.00,
18.00,
17.25,
17.00,
16.50,
16.75,
17.00,
18.00,
18.00,
17.00,
16.50,
16.50,
12.00,
12.25,
12.00,
11.75,
11.00,
11.25,
12.00,
12.25,
12.50,
12.00,
11.75,
11.00,
10.50,
10.00,
9.50,
9.00,
8.75,
9.00,
9.50,
10.00,
6.00,
6.50,
6.00,
5.50,
4.00,
4.50,
4.00,
3.75,
13.00,
14.00,
15.00,
15.50,
15.00,
14.50,
14.00,
13.50,
13.00,
12.75,
8.00,
8.25,
9.00,
9.50,
9.00,
8.00,
7.00,
6.75,
7.00,
7.75,
7.00,
7.25,
7.00,
6.25,
6.00,
5.00,
4.50,
5.00,
6.00,
6.25,
7.00,
7.25,
7.00,
6.00,
5.50,
5.00,
4.50,
4.00,
3.75,
4.00,
4.50,
5.00,
5.50,
6.00,
2.00,
2.50,
2.25,
2.00,
1.75,
1.50,
11.00,
11.25,
11.00,
10.50,
13.00,
13.50,
13.00,
12.75,
12.00,
12.25,
12.00,
11.75,
11.00,
11.25,
11.00,
10.00,
9.50,
10.00,
9.00,
8.25,
8.00,
7.75,
7.00,
6.75,
7.00,
8.00,
9.00,
9.50,
16.25,
16.00,
15.00,
14.50,
15.00,
16.00,
15.00,
14.00,
13.00,
12.75,
13.00,
13.50,
14.00,
14.50,
15.00,
15.50,
12.00,
12.50,
12.25,
12.00,
11.25,
11.00,
10.00,
9.50,
9.00,
8.75,
9.00,
9.50,
10.00,
10.50,
11.00,
11.75,
11.00,
11.25,
11.00,
10.50,
6.00,
5.50,
6.00,
6.50,
3.00,
2.50,
3.00,
3.25,
3.00,
3.50,
3.00,
2.75,
2.00,
2.25,
2.50,
2.00,
1.50,
1.75,
3.00,
2.75,
3.00,
3.50,
4.00,
3.75,
4.00,
4.50,
12.00,
12.25,
12.00,
11.75,
6.00,
6.50,
6.00,
5.50
) +
c(
1.00,
1.00,
2.00,
2.50,
3.00,
3.50,
3.25,
3.00,
2.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
2.00,
3.00,
3.25,
3.00,
2.25,
2.00,
1.00,
1.00,
1.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
1.00,
2.00,
2.25,
2.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
1.00,
2.00,
3.00,
3.50,
3.00,
2.50,
3.00,
3.50,
4.00,
4.50,
5.00,
5.25,
5.75,
6.00,
6.25,
6.75,
7.00,
7.50,
8.00,
8.50,
9.00,
9.50,
9.00,
8.50,
9.00,
10.00,
11.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
10.00,
9.75,
10.00,
11.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
11.00,
11.00,
11.00,
10.00,
9.75,
9.00,
8.75,
9.00,
10.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
10.00,
9.00,
8.75,
8.50,
9.00,
9.50,
10.00,
11.00,
11.00,
11.00,
10.00,
9.75,
9.75,
9.25,
9.25,
9.00,
8.00,
7.50,
8.00,
8.75,
8.25,
8.00,
7.00,
6.75,
6.25,
6.50,
6.00,
5.50,
5.75,
5.25,
5.00,
4.00,
3.75,
3.25,
4.00,
4.50,
4.00,
3.00,
2.75,
2.75,
2.25,
2.25,
2.00,
1.00,
2.75,
3.00,
3.25,
3.00,
2.50,
3.00,
3.75,
4.00,
5.00,
5.25,
5.00,
4.25,
4.00,
3.50,
4.00,
4.25,
4.00,
3.50,
3.00,
2.50,
2.75,
3.00,
3.25,
3.00,
2.50,
3.00,
3.50,
3.00,
3.75,
3.50,
3.75,
4.00,
4.50,
5.00,
5.50,
5.00,
4.50,
4.00,
3.50,
4.00,
4.75,
5.00,
5.50,
5.50,
5.50,
5.00,
4.75,
4.00,
3.50,
4.00,
4.25,
5.00,
5.25,
5.50,
6.00,
6.50,
6.75,
7.00,
7.75,
8.00,
8.50,
8.25,
8.00,
7.50,
7.00,
6.50,
6.00,
5.50,
5.00,
4.50,
4.00,
3.75,
3.50,
4.00,
5.00,
5.50,
5.00,
4.00,
4.75,
5.00,
5.25,
5.00,
5.50,
6.00,
6.50,
6.00,
5.75,
6.00,
6.25,
6.00,
5.75,
6.00,
6.25,
6.50,
6.00,
5.50,
7.25,
8.00,
8.50,
8.00,
7.25,
7.00,
6.50,
6.50,
6.50,
7.00,
6.00,
6.50,
6.50,
6.00,
5.50,
5.50,
8.25,
8.50,
8.25,
8.00,
7.50,
7.00,
6.50,
7.00,
7.50,
8.00,
6.75,
7.00,
8.00,
8.25,
9.00,
9.50,
9.50,
9.00,
8.50,
8.00,
7.75,
8.00,
8.50,
8.00,
7.75,
7.00,
6.75,
7.00,
7.25,
7.00,
6.25,
6.00,
5.75,
6.00,
6.25,
6.00,
5.75,
6.00,
6.75,
7.00,
7.50,
7.00,
6.50,
7.00,
8.00,
8.50,
8.00,
7.00,
5.25,
5.00,
4.50,
5.00,
9.50,
9.00,
8.50,
9.00,
8.75,
9.00,
9.25,
9.00,
8.75,
9.00,
9.25,
9.00
)
)
expect_setequal(out[[1]]$id, c(1:26))
expect_equal(length(out[[1]]$id), 324)
})
test_that("Six-sided saddles", {
# a matrix that contains all six-sided saddles
z <- matrix(
c(0, 1, 1, 2, 1, 0, 2, 1, 0, 1, 1, 2),
ncol = 4,
nrow = 3,
byrow = TRUE
)
# midpoint outside the band
out <- isobands(x = 1:4, y = 3:1, z, levels_low = 0.6, levels_high = 1.4)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.0,
2.0,
1.6,
2.0,
2.3,
2.0,
1.6,
2.0,
3.0,
3.4,
3.0,
2.7,
3.0,
3.4,
1.0,
1.0,
1.0,
1.4,
4.0,
4.0,
4.0,
3.6
) +
c(
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
3.0,
2.6,
2.0,
1.4,
1.0,
1.6,
2.0,
2.4,
2.0,
2.4,
2.0,
1.6,
2.0
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 22)
# midpoint inside the band
out <- isobands(x = 1:4, y = 3:1, z, levels_low = 0.4, levels_high = 1.6)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.0,
2.0,
1.4,
1.0,
1.0,
1.0,
1.4,
2.0,
3.0,
3.6,
4.0,
4.0,
4.0,
3.6,
3.0,
3.4,
3.0,
2.8,
2.0,
2.2,
2.0,
1.6
) +
c(
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
3.0,
2.6,
2.0,
1.4,
1.0,
1.6,
2.0,
2.4,
2.0,
1.6,
2.0,
2.4,
2.0
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 22)
})
test_that("Seven-sided saddles", {
# a matrix that contains all seven-sided saddles
z <- matrix(
c(0, 1, 0, 1, 2, 1, 2, 0, 2, 2, 0, 2, 0, 1, 0, 1, 2, 1),
ncol = 6,
nrow = 3,
byrow = TRUE
)
# midpoint inside the band
out <- isobands(x = 1:6, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
6.00,
6.00,
5.50,
5.00,
4.50,
4.00,
3.50,
3.00,
2.50,
2.00,
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.50,
2.00,
2.50,
3.00,
3.50,
4.00,
4.50,
5.00,
5.50,
6.00,
6.00,
5.75,
4.00,
4.25,
4.00,
3.00,
2.75,
3.00,
2.00,
2.25,
2.00,
1.75,
5.00,
5.25,
5.00,
4.75
) +
c(
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.25,
1.75,
2.00,
2.25,
2.75,
3.00,
3.00,
3.00,
2.75,
3.00,
3.00,
3.00,
2.75,
3.00,
3.00,
2.50,
2.00,
1.50,
2.00,
2.50,
2.25,
2.00,
1.75,
1.50,
2.00,
2.50,
2.00,
1.75,
2.00,
2.25,
2.00
)
)
expect_setequal(out[[1]]$id, c(1:4))
expect_equal(length(out[[1]]$id), 42)
# midpoint outside the band
out <- isobands(x = 1:6, y = 3:1, z, levels_low = 0.8, levels_high = 1.2)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
6.0,
6.0,
5.8,
5.0,
4.4,
5.0,
5.6,
4.2,
4.0,
3.8,
3.0,
2.4,
3.0,
3.8,
4.0,
4.2,
4.0,
3.0,
2.6,
3.0,
4.0,
2.2,
2.0,
1.8,
2.0,
1.0,
1.4,
1.0,
1.0,
1.6,
1.0,
5.0,
5.4,
5.0,
4.6,
6.0,
5.8,
6.0,
2.2,
2.0,
1.8,
2.0
) +
c(
1.2,
1.0,
1.0,
1.4,
2.0,
2.6,
2.0,
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
2.8,
2.4,
2.0,
1.6,
1.2,
1.0,
1.0,
1.0,
1.2,
1.6,
2.0,
2.4,
2.6,
2.0,
1.4,
1.6,
2.0,
2.4,
2.0,
2.8,
3.0,
3.0,
3.0,
2.8,
3.0,
3.0
)
)
expect_setequal(out[[1]]$id, c(1:8))
expect_equal(length(out[[1]]$id), 42)
})
test_that("Eight-sided saddles", {
# a matrix that contains all eight-sided saddles
z <- matrix(c(0, 2, 0, 2, 0, 2), ncol = 3, nrow = 2, byrow = TRUE)
# midpoint above the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 0.8)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.00,
3.00,
2.60,
2.75,
2.00,
2.40,
2.25,
2.00,
1.75,
1.60,
1.00,
1.00,
1.25,
1.40
) +
c(
1.75,
1.60,
2.00,
2.00,
1.40,
1.00,
1.00,
1.25,
1.00,
1.00,
1.60,
1.75,
2.00,
2.00
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 14)
# midpoint inside the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
2.75,
2.25,
2.00,
1.75,
1.25,
1.00,
1.00,
1.25,
1.75,
2.00,
2.25,
2.75,
3.00,
3.00
) +
c(
1.00,
1.00,
1.25,
1.00,
1.00,
1.25,
1.75,
2.00,
2.00,
1.75,
2.00,
2.00,
1.75,
1.25
)
)
expect_equal(out[[1]]$id, rep(1, 14))
# midpoint below the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 1.2, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.00,
3.00,
2.75,
2.60,
2.40,
2.00,
1.60,
1.75,
2.00,
2.25,
1.40,
1.25,
1.00,
1.00
) +
c(
1.40,
1.25,
1.00,
1.00,
2.00,
1.60,
2.00,
2.00,
1.75,
2.00,
1.00,
1.00,
1.25,
1.40
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 14)
})
test_that("Inconsistent numbers of isoband levels cause an error", {
m <- matrix(
c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0),
4,
4,
byrow = TRUE
)
# single values are recycled
expect_silent(
isobands(1:4, 1:4, m, 0.5, c(0.5, 1.5))
)
expect_silent(
isobands(1:4, 1:4, m, c(0.5, 1.5), 0.5)
)
# error, multiple values are not recycled
expect_snapshot(
isobands(1:4, 1:4, m, c(0.5, 1.5, 2.5), c(0.5, 1.5)),
error = TRUE
)
expect_snapshot(
isobands(1:4, 1:4, m, c(0.5, 1.5), c(0.5, 1.5, 2.5)),
error = TRUE
)
})
test_that("Swap isoband levels if given in the wrong order", {
m <- matrix(
c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0),
4,
4,
byrow = TRUE
)
out1 <- isobands(1:4, 1:4, m, c(-.5, 0.5), c(0.5, 1.5))
out2 <- isobands(1:4, 1:4, m, c(0.5, 1.5), c(-.5, 0.5))
expect_equal(out1, out2)
})
Try the isoband package in your browser
Any scripts or data that you put into this service are public.
isoband documentation built on Dec. 7, 2025, 9:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("elementary polygons get merged", {
# two connected polygons get merged
z <- matrix(c(0, 0, 1, 1, 1, 1), ncol = 3, nrow = 2, byrow = TRUE)
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 2.0, 2.5, 3.0) +
c(1.0, 1.0, 1.0, 1.5, 1.5, 2.0, 2.0)
)
expect_equal(out[[1]]$id, rep(1, 7))
#
# two unconnected polygons don't get merged
z <- matrix(c(1, 2, 1, 1, 2, 2), ncol = 3, nrow = 2, byrow = TRUE)
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.5, 3.0, 1.0, 1.5, 1.5, 1.0) +
c(1.5, 2.0, 2.0, 2.0, 2.0, 1.0, 1.0)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 7)
# two separate bands get merged in second row
z <- matrix(c(1, 2, 1, 1, 2, 1, 0, 0, 0), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 1.0, 1.5, 1.5, 2.0, 2.5, 2.5, 3.0, 3.0) +
c(1.50, 1.25, 1.50, 2.00, 3.00, 3.00, 2.00, 1.75, 2.00, 3.00, 3.00, 2.00)
)
expect_equal(out[[1]]$id, rep(1, 12))
# circle gets closed
z <- matrix(c(1, 1, 1, 1, 2, 1, 1, 1, 1), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(3.0, 2.0, 1.0, 1.0, 1.0, 2.0, 3.0, 3.0, 2.0, 2.5, 2.0, 1.5) +
c(1.0, 1.0, 1.0, 2.0, 3.0, 3.0, 3.0, 2.0, 1.5, 2.0, 2.5, 2.0)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 12)
})
test_that("NAs are handled correctly", {
z <- matrix(c(NA, 1, 1, 1, 1, 1, 1, 1, 1), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 * c(3, 2, 1, 1, 2, 2, 3, 3) + c(1, 1, 1, 2, 2, 3, 3, 2)
)
expect_equal(out[[1]]$id, rep(1, 8))
z <- matrix(c(NA, 1, 1, 1, 1, 1, 1, 1, NA), ncol = 3, nrow = 3, byrow = TRUE)
out <- isobands(x = 1:3, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 * c(1, 1, 2, 2, 2, 2, 3, 3) + c(1, 2, 2, 1, 2, 3, 3, 2)
)
expect_setequal(out[[1]]$id, c(1:2))
expect_equal(length(out[[1]]$id), 8)
})
test_that("All elementary shapes are calculated correctly", {
# a matrix that requires all elementary shapes for isobanding
z <- matrix(
c(
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2,
0,
0,
0,
1,
0,
2,
1,
0,
1,
1,
1,
2,
2,
0,
2,
1,
2,
2
),
ncol = 18,
nrow = 11,
byrow = TRUE
)
out <- isobands(x = 1:18, y = 11:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
16.00,
15.50,
15.50,
16.00,
16.25,
16.00,
15.00,
14.50,
14.75,
14.75,
14.25,
14.25,
14.00,
13.75,
13.75,
13.25,
13.25,
13.50,
13.00,
12.75,
12.00,
11.50,
11.50,
11.00,
10.00,
9.00,
8.50,
8.50,
8.00,
7.50,
7.50,
7.00,
6.50,
6.50,
6.00,
5.75,
5.75,
5.25,
5.25,
5.00,
4.50,
4.50,
4.00,
3.50,
3.50,
3.25,
3.00,
2.50,
2.00,
1.50,
1.00,
1.00,
1.00,
1.25,
1.00,
1.00,
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.50,
2.00,
2.50,
3.00,
3.25,
3.50,
3.50,
4.00,
4.50,
4.50,
5.00,
5.25,
5.25,
5.75,
5.75,
6.00,
6.50,
6.50,
7.00,
7.50,
7.50,
8.00,
8.50,
8.50,
9.00,
10.00,
11.00,
11.50,
11.50,
12.00,
12.75,
13.00,
13.50,
13.25,
13.25,
13.75,
13.75,
14.00,
14.25,
14.25,
14.75,
14.75,
14.50,
15.00,
16.00,
16.25,
16.00,
15.50,
15.50,
16.00,
16.50,
16.50,
17.00,
18.00,
18.00,
17.00,
16.75,
16.50,
17.00,
17.25,
18.00,
18.00,
17.75,
17.50,
18.00,
18.00,
17.00,
16.75,
17.00,
18.00,
18.00,
17.50,
17.75,
18.00,
18.00,
17.25,
17.00,
16.50,
16.75,
17.00,
18.00,
18.00,
17.00,
16.50,
16.50,
12.00,
12.25,
12.00,
11.75,
11.00,
11.25,
12.00,
12.25,
12.50,
12.00,
11.75,
11.00,
10.50,
10.00,
9.50,
9.00,
8.75,
9.00,
9.50,
10.00,
6.00,
6.50,
6.00,
5.50,
4.00,
4.50,
4.00,
3.75,
13.00,
14.00,
15.00,
15.50,
15.00,
14.50,
14.00,
13.50,
13.00,
12.75,
8.00,
8.25,
9.00,
9.50,
9.00,
8.00,
7.00,
6.75,
7.00,
7.75,
7.00,
7.25,
7.00,
6.25,
6.00,
5.00,
4.50,
5.00,
6.00,
6.25,
7.00,
7.25,
7.00,
6.00,
5.50,
5.00,
4.50,
4.00,
3.75,
4.00,
4.50,
5.00,
5.50,
6.00,
2.00,
2.50,
2.25,
2.00,
1.75,
1.50,
11.00,
11.25,
11.00,
10.50,
13.00,
13.50,
13.00,
12.75,
12.00,
12.25,
12.00,
11.75,
11.00,
11.25,
11.00,
10.00,
9.50,
10.00,
9.00,
8.25,
8.00,
7.75,
7.00,
6.75,
7.00,
8.00,
9.00,
9.50,
16.25,
16.00,
15.00,
14.50,
15.00,
16.00,
15.00,
14.00,
13.00,
12.75,
13.00,
13.50,
14.00,
14.50,
15.00,
15.50,
12.00,
12.50,
12.25,
12.00,
11.25,
11.00,
10.00,
9.50,
9.00,
8.75,
9.00,
9.50,
10.00,
10.50,
11.00,
11.75,
11.00,
11.25,
11.00,
10.50,
6.00,
5.50,
6.00,
6.50,
3.00,
2.50,
3.00,
3.25,
3.00,
3.50,
3.00,
2.75,
2.00,
2.25,
2.50,
2.00,
1.50,
1.75,
3.00,
2.75,
3.00,
3.50,
4.00,
3.75,
4.00,
4.50,
12.00,
12.25,
12.00,
11.75,
6.00,
6.50,
6.00,
5.50
) +
c(
1.00,
1.00,
2.00,
2.50,
3.00,
3.50,
3.25,
3.00,
2.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
2.00,
3.00,
3.25,
3.00,
2.25,
2.00,
1.00,
1.00,
1.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
1.00,
2.00,
2.25,
2.00,
1.00,
1.00,
2.00,
2.50,
2.00,
1.00,
1.00,
1.00,
2.00,
3.00,
3.50,
3.00,
2.50,
3.00,
3.50,
4.00,
4.50,
5.00,
5.25,
5.75,
6.00,
6.25,
6.75,
7.00,
7.50,
8.00,
8.50,
9.00,
9.50,
9.00,
8.50,
9.00,
10.00,
11.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
10.00,
9.75,
10.00,
11.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
11.00,
11.00,
11.00,
10.00,
9.75,
9.00,
8.75,
9.00,
10.00,
11.00,
11.00,
10.00,
9.50,
10.00,
11.00,
11.00,
10.00,
9.00,
8.75,
8.50,
9.00,
9.50,
10.00,
11.00,
11.00,
11.00,
10.00,
9.75,
9.75,
9.25,
9.25,
9.00,
8.00,
7.50,
8.00,
8.75,
8.25,
8.00,
7.00,
6.75,
6.25,
6.50,
6.00,
5.50,
5.75,
5.25,
5.00,
4.00,
3.75,
3.25,
4.00,
4.50,
4.00,
3.00,
2.75,
2.75,
2.25,
2.25,
2.00,
1.00,
2.75,
3.00,
3.25,
3.00,
2.50,
3.00,
3.75,
4.00,
5.00,
5.25,
5.00,
4.25,
4.00,
3.50,
4.00,
4.25,
4.00,
3.50,
3.00,
2.50,
2.75,
3.00,
3.25,
3.00,
2.50,
3.00,
3.50,
3.00,
3.75,
3.50,
3.75,
4.00,
4.50,
5.00,
5.50,
5.00,
4.50,
4.00,
3.50,
4.00,
4.75,
5.00,
5.50,
5.50,
5.50,
5.00,
4.75,
4.00,
3.50,
4.00,
4.25,
5.00,
5.25,
5.50,
6.00,
6.50,
6.75,
7.00,
7.75,
8.00,
8.50,
8.25,
8.00,
7.50,
7.00,
6.50,
6.00,
5.50,
5.00,
4.50,
4.00,
3.75,
3.50,
4.00,
5.00,
5.50,
5.00,
4.00,
4.75,
5.00,
5.25,
5.00,
5.50,
6.00,
6.50,
6.00,
5.75,
6.00,
6.25,
6.00,
5.75,
6.00,
6.25,
6.50,
6.00,
5.50,
7.25,
8.00,
8.50,
8.00,
7.25,
7.00,
6.50,
6.50,
6.50,
7.00,
6.00,
6.50,
6.50,
6.00,
5.50,
5.50,
8.25,
8.50,
8.25,
8.00,
7.50,
7.00,
6.50,
7.00,
7.50,
8.00,
6.75,
7.00,
8.00,
8.25,
9.00,
9.50,
9.50,
9.00,
8.50,
8.00,
7.75,
8.00,
8.50,
8.00,
7.75,
7.00,
6.75,
7.00,
7.25,
7.00,
6.25,
6.00,
5.75,
6.00,
6.25,
6.00,
5.75,
6.00,
6.75,
7.00,
7.50,
7.00,
6.50,
7.00,
8.00,
8.50,
8.00,
7.00,
5.25,
5.00,
4.50,
5.00,
9.50,
9.00,
8.50,
9.00,
8.75,
9.00,
9.25,
9.00,
8.75,
9.00,
9.25,
9.00
)
)
expect_setequal(out[[1]]$id, c(1:26))
expect_equal(length(out[[1]]$id), 324)
})
test_that("Six-sided saddles", {
# a matrix that contains all six-sided saddles
z <- matrix(
c(0, 1, 1, 2, 1, 0, 2, 1, 0, 1, 1, 2),
ncol = 4,
nrow = 3,
byrow = TRUE
)
# midpoint outside the band
out <- isobands(x = 1:4, y = 3:1, z, levels_low = 0.6, levels_high = 1.4)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.0,
2.0,
1.6,
2.0,
2.3,
2.0,
1.6,
2.0,
3.0,
3.4,
3.0,
2.7,
3.0,
3.4,
1.0,
1.0,
1.0,
1.4,
4.0,
4.0,
4.0,
3.6
) +
c(
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
3.0,
2.6,
2.0,
1.4,
1.0,
1.6,
2.0,
2.4,
2.0,
2.4,
2.0,
1.6,
2.0
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 22)
# midpoint inside the band
out <- isobands(x = 1:4, y = 3:1, z, levels_low = 0.4, levels_high = 1.6)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.0,
2.0,
1.4,
1.0,
1.0,
1.0,
1.4,
2.0,
3.0,
3.6,
4.0,
4.0,
4.0,
3.6,
3.0,
3.4,
3.0,
2.8,
2.0,
2.2,
2.0,
1.6
) +
c(
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
3.0,
2.6,
2.0,
1.4,
1.0,
1.6,
2.0,
2.4,
2.0,
1.6,
2.0,
2.4,
2.0
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 22)
})
test_that("Seven-sided saddles", {
# a matrix that contains all seven-sided saddles
z <- matrix(
c(0, 1, 0, 1, 2, 1, 2, 0, 2, 2, 0, 2, 0, 1, 0, 1, 2, 1),
ncol = 6,
nrow = 3,
byrow = TRUE
)
# midpoint inside the band
out <- isobands(x = 1:6, y = 3:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
6.00,
6.00,
5.50,
5.00,
4.50,
4.00,
3.50,
3.00,
2.50,
2.00,
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.50,
2.00,
2.50,
3.00,
3.50,
4.00,
4.50,
5.00,
5.50,
6.00,
6.00,
5.75,
4.00,
4.25,
4.00,
3.00,
2.75,
3.00,
2.00,
2.25,
2.00,
1.75,
5.00,
5.25,
5.00,
4.75
) +
c(
1.50,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.25,
1.00,
1.00,
1.00,
1.25,
1.75,
2.00,
2.25,
2.75,
3.00,
3.00,
3.00,
2.75,
3.00,
3.00,
3.00,
2.75,
3.00,
3.00,
2.50,
2.00,
1.50,
2.00,
2.50,
2.25,
2.00,
1.75,
1.50,
2.00,
2.50,
2.00,
1.75,
2.00,
2.25,
2.00
)
)
expect_setequal(out[[1]]$id, c(1:4))
expect_equal(length(out[[1]]$id), 42)
# midpoint outside the band
out <- isobands(x = 1:6, y = 3:1, z, levels_low = 0.8, levels_high = 1.2)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
6.0,
6.0,
5.8,
5.0,
4.4,
5.0,
5.6,
4.2,
4.0,
3.8,
3.0,
2.4,
3.0,
3.8,
4.0,
4.2,
4.0,
3.0,
2.6,
3.0,
4.0,
2.2,
2.0,
1.8,
2.0,
1.0,
1.4,
1.0,
1.0,
1.6,
1.0,
5.0,
5.4,
5.0,
4.6,
6.0,
5.8,
6.0,
2.2,
2.0,
1.8,
2.0
) +
c(
1.2,
1.0,
1.0,
1.4,
2.0,
2.6,
2.0,
1.0,
1.0,
1.0,
1.4,
2.0,
2.6,
3.0,
3.0,
3.0,
2.8,
2.4,
2.0,
1.6,
1.2,
1.0,
1.0,
1.0,
1.2,
1.6,
2.0,
2.4,
2.6,
2.0,
1.4,
1.6,
2.0,
2.4,
2.0,
2.8,
3.0,
3.0,
3.0,
2.8,
3.0,
3.0
)
)
expect_setequal(out[[1]]$id, c(1:8))
expect_equal(length(out[[1]]$id), 42)
})
test_that("Eight-sided saddles", {
# a matrix that contains all eight-sided saddles
z <- matrix(c(0, 2, 0, 2, 0, 2), ncol = 3, nrow = 2, byrow = TRUE)
# midpoint above the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 0.8)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.00,
3.00,
2.60,
2.75,
2.00,
2.40,
2.25,
2.00,
1.75,
1.60,
1.00,
1.00,
1.25,
1.40
) +
c(
1.75,
1.60,
2.00,
2.00,
1.40,
1.00,
1.00,
1.25,
1.00,
1.00,
1.60,
1.75,
2.00,
2.00
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 14)
# midpoint inside the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 0.5, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
2.75,
2.25,
2.00,
1.75,
1.25,
1.00,
1.00,
1.25,
1.75,
2.00,
2.25,
2.75,
3.00,
3.00
) +
c(
1.00,
1.00,
1.25,
1.00,
1.00,
1.25,
1.75,
2.00,
2.00,
1.75,
2.00,
2.00,
1.75,
1.25
)
)
expect_equal(out[[1]]$id, rep(1, 14))
# midpoint below the band
out <- isobands(x = 1:3, y = 2:1, z, levels_low = 1.2, levels_high = 1.5)
expect_setequal(
10000 * out[[1]]$x + out[[1]]$y,
10000 *
c(
3.00,
3.00,
2.75,
2.60,
2.40,
2.00,
1.60,
1.75,
2.00,
2.25,
1.40,
1.25,
1.00,
1.00
) +
c(
1.40,
1.25,
1.00,
1.00,
2.00,
1.60,
2.00,
2.00,
1.75,
2.00,
1.00,
1.00,
1.25,
1.40
)
)
expect_setequal(out[[1]]$id, c(1:3))
expect_equal(length(out[[1]]$id), 14)
})
test_that("Inconsistent numbers of isoband levels cause an error", {
m <- matrix(
c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0),
4,
4,
byrow = TRUE
)
# single values are recycled
expect_silent(
isobands(1:4, 1:4, m, 0.5, c(0.5, 1.5))
)
expect_silent(
isobands(1:4, 1:4, m, c(0.5, 1.5), 0.5)
)
# error, multiple values are not recycled
expect_snapshot(
isobands(1:4, 1:4, m, c(0.5, 1.5, 2.5), c(0.5, 1.5)),
error = TRUE
)
expect_snapshot(
isobands(1:4, 1:4, m, c(0.5, 1.5), c(0.5, 1.5, 2.5)),
error = TRUE
)
})
test_that("Swap isoband levels if given in the wrong order", {
m <- matrix(
c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0),
4,
4,
byrow = TRUE
)
out1 <- isobands(1:4, 1:4, m, c(-.5, 0.5), c(0.5, 1.5))
out2 <- isobands(1:4, 1:4, m, c(0.5, 1.5), c(-.5, 0.5))
expect_equal(out1, out2)
})
Try the isoband package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.