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_error(
isobands(1:4, 1:4, m, c(0.5, 1.5, 2.5), c(0.5, 1.5)),
"must be of equal length or of length 1"
)
expect_error(
isobands(1:4, 1:4, m, c(0.5, 1.5), c(0.5, 1.5, 2.5)),
"must be of equal length or of length 1"
)
})
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. 28, 2022, 2:38 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_error(
isobands(1:4, 1:4, m, c(0.5, 1.5, 2.5), c(0.5, 1.5)),
"must be of equal length or of length 1"
)
expect_error(
isobands(1:4, 1:4, m, c(0.5, 1.5), c(0.5, 1.5, 2.5)),
"must be of equal length or of length 1"
)
})
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.