Nothing
#context("2D check by hand")
# Check that RANN is available
got_RANN <- requireNamespace("RANN", quietly = TRUE)
# Consider cases where method 1 (on its own) gives the wrong nearest neighbours
# because an observation, or pair of observations, contribute more than once.
# Check that an additional call using method 2 inside nnt() corrects this.
if (got_RANN) {
x1 <- c(5, 5)
x2 <- c(9, 3)
x3 <- c(8, 9)
x4 <- c(0, 2)
x5 <- c(1, 10)
x <- rbind(x1, x2, x3, x4, x5)
# plot(x, xlim = c(0, 10), ylim = c(0, 10))
dfn <- function(x, y) sqrt(sum((x - y) ^ 2))
# Only wrap on variable 1
n1d <- n1n <- matrix(NA, 5, 5)
temp <- apply(cbind(x1, x2, x3, x4, x5), 2, dfn, y = x1)
n1d[1, ] <- sort(temp)
n1n[1, ] <- order(temp)
x4d <- c(10, 2)
x5d <- c(11, 10)
temp <- apply(cbind(x1, x2, x3, x4d, x5d), 2, dfn, y = x2)
n1d[2, ] <- sort(temp)
n1n[2, ] <- order(temp)
temp <- apply(cbind(x1, x2, x3, x4d, x5d), 2, dfn, y = x3)
n1d[3, ] <- sort(temp)
n1n[3, ] <- order(temp)
x2d <- c(-1, 3)
x3d <- c(-2, 9)
temp <- apply(cbind(x1, x2d, x3d, x4, x5), 2, dfn, y = x4)
n1d[4, ] <- sort(temp)
n1n[4, ] <- order(temp)
temp <- apply(cbind(x1, x2d, x3d, x4, x5), 2, dfn, y = x5)
n1d[5, ] <- sort(temp)
n1n[5, ] <- order(temp)
res1 <- nnt(x, x, torus = 1, ranges = c(0, 10), method = 1)
res2 <- nnt(x, x, torus = 1, ranges = c(0, 10), method = 2)
test_that("Wrap on variable 1: indices vs method 1", {
testthat::expect_equal(res1$nn.idx, n1n)
})
test_that("Wrap on variable 1: indices vs method 2", {
testthat::expect_equal(res2$nn.idx, n1n)
})
test_that("Wrap on variable 1: distances vs method 1", {
testthat::expect_equal(res1$nn.dists, n1d)
})
test_that("Wrap on variable 1: distances vs method 2", {
testthat::expect_equal(res2$nn.dists, n1d)
})
# Only wrap on variable 2
n2d <- n2n <- matrix(NA, 5, 5)
temp <- apply(cbind(x1, x2, x3, x4, x5), 2, dfn, y = x1)
n2d[1, ] <- sort(temp)
n2n[1, ] <- order(temp)
x3d <- c(8, -1)
x5d <- c(1, 0)
temp <- apply(cbind(x1, x2, x3d, x4, x5d), 2, dfn, y = x2)
n2d[2, ] <- sort(temp)
n2n[2, ] <- order(temp)
x2d <- c(9, 13)
x4d <- c(0, 12)
temp <- apply(cbind(x1, x2d, x3, x4d, x5), 2, dfn, y = x3)
n2d[3, ] <- sort(temp)
n2n[3, ] <- order(temp)
x3d <- c(8, -1)
x5d <- c(1, 0)
temp <- apply(cbind(x1, x2, x3d, x4, x5d), 2, dfn, y = x4)
n2d[4, ] <- sort(temp)
n2n[4, ] <- order(temp)
temp <- apply(cbind(x1, x2d, x3, x4d, x5), 2, dfn, y = x5)
n2d[5, ] <- sort(temp)
n2n[5, ] <- order(temp)
res1 <- nnt(x, x, torus = 2, ranges = c(0, 10), method = 1)
res2 <- nnt(x, x, torus = 2, ranges = c(0, 10), method = 2)
test_that("Wrap on variable 2: indices vs method 1", {
testthat::expect_equal(res1$nn.idx, n2n)
})
test_that("Wrap on variable 2: indices vs method 2", {
testthat::expect_equal(res2$nn.idx, n2n)
})
test_that("Wrap on variable 2: distances vs method 1", {
testthat::expect_equal(res1$nn.dists, n2d)
})
test_that("Wrap on variable 2: distances vs method 2", {
testthat::expect_equal(res2$nn.dists, n2d)
})
# Wrap on variables 1 and 2
n2d <- n2n <- matrix(NA, 5, 5)
temp <- apply(cbind(x1, x2, x3, x4, x5), 2, dfn, y = x1)
n2d[1, ] <- sort(temp)
n2n[1, ] <- order(temp)
x3d <- c(8, -1)
x4d <- c(10, 2)
x5d <- c(11, 0)
temp <- apply(cbind(x1, x2, x3d, x4d, x5d), 2, dfn, y = x2)
n2d[2, ] <- sort(temp)
n2n[2, ] <- order(temp)
x2d <- c(9, 13)
x4d <- c(10, 12)
x5d <- c(11, 10)
temp <- apply(cbind(x1, x2d, x3, x4d, x5d), 2, dfn, y = x3)
n2d[3, ] <- sort(temp)
n2n[3, ] <- order(temp)
x2d <- c(-1, 3)
x3d <- c(-2, -1)
x5d <- c(1, 0)
temp <- apply(cbind(x1, x2d, x3d, x4, x5d), 2, dfn, y = x4)
n2d[4, ] <- sort(temp)
n2n[4, ] <- order(temp)
x2d <- c(-1, 13)
x3d <- c(-2, 9)
x4d <- c(0, 12)
temp <- apply(cbind(x1, x2d, x3d, x4d, x5), 2, dfn, y = x5)
n2d[5, ] <- sort(temp)
n2n[5, ] <- order(temp)
ranges <- rbind(c(0, 10), c(0, 10))
res1 <- nnt(x, x, torus = 1:2, ranges = ranges, method = 1)
res2 <- nnt(x, x, torus = 1:2, ranges = ranges, method = 2)
test_that("Wrap on variable 2: indices vs method 1", {
testthat::expect_equal(res1$nn.idx, n2n)
})
test_that("Wrap on variable 2: indices vs method 2", {
testthat::expect_equal(res2$nn.idx, n2n)
})
test_that("Wrap on variable 2: distances vs method 1", {
testthat::expect_equal(res1$nn.dists, n2d)
})
test_that("Wrap on variable 2: distances vs method 2", {
testthat::expect_equal(res2$nn.dists, n2d)
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.