test_that("LSCV works for least-squares cross-validation", { set.seed(1) n.uniq <- 100 n <- 400 inds <- sort(ceiling(runif(n, 0, n.uniq))) x.uniq <- sort(rnorm(n.uniq)) y.uniq <- 1 + 0.1*x.uniq + sin(x.uniq) + rnorm(n.uniq) x <- x.uniq[inds] y <- y.uniq[inds] w <- 1 + runif(n, 0, 2) # Relative importance bw.grid <- seq(0.1, 1.3, 0.2) CV2 <- LSCV(x, y = y, bw = bw.grid, weights = w) expect_true(all(is.finite(CV2))) }) test_that("LSCV handles multivariate inputs with unique and distinct bws, finding an improvement", { y <- c(2111.9, 2165.8, 1677.4, 3140.2, 1641.1, 1679.2, 1650.5, 1653.2, 4029.4, 1653.7, 1653.7, 1653.2, 1942.9, 1658.5, 1750.1, 1643.1, 1683.6, 1641.2, 3263, 1702.2, 1666.5, 1693.6, 1656.2, 1684.8, 4353.6, 4282.8, 4372, 4281.7, 4272.6, 4261, 4285.1, 303.3, 89.8, 0.2, 48, 18.9, 48, 50.4, 2.1, 954.7, 5009.9, 792.8, 171.1, 7.9, 27.4, 1.5, 206.5, 647.7, 77.7, 32.5, 3.9, 28.6, 4.8, 20.5, 20.3, 41, 18.6, 4488.2, 1.6, 4517.3, 4528.1, 4553.6, 4526.5, 4505.2, 4511.5, 4516.3, 4506.2, 4524.9, 4511.4, 4512.8, 4505.8, 4615.9, 4505.2, 4505.2, 4511.9, 4505.7, 4505.9, 4505.8, 4538.8, 4512.1, 4524.1, 4511.5, 4534.2, 4601.4, 4506.6, 4339.1, 4342.4, 4339.4, 4442.4, 4432.6, 4341.6, 4343.9, 4339.8, 4405.4, 4339.2, 4361.2, 4347.1, 4409.1, 4352, 4338.8, 4350.4, 4419.8, 4372.3, 4338.7, 4515.4, 4079.9, 4080.3, 4084.5, 4083.6, 4078.9, 4103, 4097.3, 4085.1, 4144.2, 4098, 4078.9, 4080.9, 4142.9, 4079.1, 4082.7, 5263.3, 4078.8, 4104.6, 4080.5, 4081.4, 4664.8, 4085, 4101.6, 4080.9, 4093.9, 4090.2, 4127.7, 4078.8, 4078.8, 4085.4, 4109.7, 4080.7, 4156, 4079.4, 4079, 4083.7, 4079.5, 4532.9, 4517.3, 4503.2, 4516.9, 4519, 4545.2, 4504.3, 4502.4, 4502.9, 4516.2, 4501.9, 4517.2, 4503.1, 4574.2, 4532.1, 4519.7, 4507.9, 4616.8, 4539.4, 4503.8, 4506.8, 4506.7, 4502.1, 4507.2, 4503.2, 4506.8, 4556.6, 4503) x <- c(2.86, 67.02, 100, 59.96, 45.99, 50, 63.49, 78.57, 77.6, 100, 100, 78.57, 52.91, 61.67, 67.02, 1.67, 49.38, 45.86, 0, 0.71, 49.38, 4.19, 3.74, 35, 7.41, 4, 2, 27.27, 11, 13.5, 7.5, 30, 3.96, 0, 0, 0, 10.58, 31.75, 0, 30, 0, 31.75, 0, 11.11, 0, 21.35, 1.02, 0.8, 50, 25, 10.24, 11.1, 11.11, 0, 8.82, 0, 19.19, 52.91, 35.27, 8.33, 21.18, 14.75, 5.88, 8.24, 5, 7.06, 2.22, 1.18, 8, 10, 35, 10.59, 16.47, 21.84, 15.29, 25, 8.24, 11.31, 10.59, 7, 12, 23.81, 14.58, 15.22, 10, 3.08, 23.68, 3.28, 16.22, 21.16, 31.75, 0.82, 13.01, 36.97, 10, 20.87, 28.22, 28.22, 29.4, 28.6, 4.44, 35.27, 4.17, 21.16, 35.29, 0, 0, 0.76, 0, 0, 0.66, 0.65, 0.59, 0, 0, 0, 0, 1.3, 0, 0, 22.22, 0, 2.45, 0, 0, 15.38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.76, 0.49, 0, 0, 0, 0.5, 0, 0, 17.34, 0.65, 0, 0.41, 0.88, 0, 1.47, 0.69, 0, 0.5, 0.37, 0.69, 0.69, 1.07, 0, 0.67, 33.33, 0, 0.81, 0.48, 0, 0.74, 0, 0, 0, 0, 0, 8.57, 14.11, 0, 10.58, 15.33, 25, 14.11, 0, 7.05, 0, 0, 0, 21.16, 14.17, 7.05, 10, 21.16, 24.69, 11.11, 3.57, 21.16, 9.47, 8.37, 5, 7.41, 4, 1, 7.39, 8.5, 8.7, 12.5, 5, 8.15, 0, 1.67, 3.53, 3.53, 7.05, 0, 10, 0, 7.05, 0, 6.67, 0, 4.1, 6.12, 9.6, 31.25, 4.17, 3.69, 6.15, 2.22, 0, 7.84, 0, 5.41, 10.58, 3.53, 30.56, 23.53, 27.87, 28.24, 27.06, 29.29, 18.82, 17.04, 24.71, 29, 34, 25, 23.53, 21.18, 27.59, 20, 12.5, 28.24, 23.53, 24.71, 29, 28, 31.75, 35.42, 13.04, 12, 3.52, 21.05, 3.28, 2.7, 21.16, 42.33, 3.27, 11.38, 2.1, 2.7, 3.04, 21.16, 28.22, 8.66, 7.1, 12.44, 7.05, 7.5, 14.11, 23.53, 2.5, 1.04, 1.53, 1.75, 2.88, 2.65, 2.58, 4.71, 1.43, 1.43, 0.85, 2.48, 3.9, 1.79, 1.25, 0, 1.39, 9.2, 0, 0, 0, 1.35, 2.22, 0.81, 0, 0.64, 1.95, 1, 0, 3.33, 3.82, 0.98, 0, 2, 2, 8, 3.16, 0.94, 2.31, 0.65, 0.76, 0.62, 0.88, 0, 1.47, 0.69, 0.83, 0.5, 0.75, 0.69, 3.45, 3.21, 1.32, 0.67, 2.22, 1.72, 0.81, 0.48, 1.19, 0.74, 1.15, 1.52, 2.41, 2.04, 0, 51.43, 14.11, 0, 17.64, 32.85, 12.5, 14.11, 0, 14.11, 0, 0, 0, 21.16, 18.33, 17.64, 55, 17.64, 17.64, 11.11, 22.86, 24.69, 46.92, 48.02, 50, 29.63, 3, 3, 16.48, 20, 23.3, 32.5, 55, 52.64, 70, 14.17, 81.13, 77.6, 56.44, 98.77, 60, 66.67, 56.44, 91.71, 44.44, 80.95, 50.46, 79.59, 74.4, 18.75, 64.58, 37.74, 23.41, 38.1, 99.5, 54.25, 76.19, 28.56, 28.22, 56.44, 0, 0, 0, 0, 8.24, 0, 0, 0.74, 1.18, 0, 1, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 2.17, 2, 4.85, 0, 4.51, 21.62, 3.53, 3.53, 4.9, 2.85, 2.94, 4.4, 4.35, 3.53, 3.53, 28.6, 3.5, 2.67, 3.53, 2.5, 3.53, 0, 10, 6.25, 3.05, 24.56, 5.77, 5.3, 8.39, 12.35, 4.29, 5.71, 4.24, 25.25, 24.68, 3.57, 7.5, 0, 9.72, 27.61, 3.57, 1.54, 0, 5.41, 8.89, 4.07, 5.56, 5.13, 24.39, 7, 2.5, 5, 18.7, 8.78, 10, 5, 4, 19, 5.26, 11.32, 6.94, 12.26, 11.45, 7.26, 23.68, 18, 16.18, 13.79, 8.33, 15, 8.24, 12.5, 79.31, 65.24, 14.47, 6.71, 15.56, 8.62, 11.38, 16.91, 10.71, 11.76, 11.49, 13.64, 73.49, 63.27, 15.22) x <- matrix(x, ncol = 3) system.time(expect_true(all(is.finite(suppressWarnings( b1 <- bw.CV(x = x, y = y, kernel = "epanechnikov", degree = 1, PIT = TRUE, tol = 1e-3, try.grid = FALSE, same = TRUE)))))) system.time(expect_true(all(is.finite(suppressWarnings( b2 <- bw.CV(x = x, y = y, kernel = "epanechnikov", degree = 1, PIT = TRUE, tol = 1e-2, try.grid = FALSE, start.bw = rep(b1, 3))))))) expect_gt(LSCV(x = x, y = y, kernel = "epanechnikov", degree = 1, PIT = TRUE, bw = b1), LSCV(x = x, y = y, kernel = "epanechnikov", degree = 1, PIT = TRUE, bw = b2)) }) test_that("bw.CV de-duplicates correctly and minimises the CV criterion", { set.seed(1) n.uniq <- 100 n <- 500 inds <- sort(ceiling(runif(n, 0, n.uniq))) x.uniq <- sort(rnorm(n.uniq, sd = 2)) y.uniq <- 1 + 0.1*x.uniq + sin(x.uniq) + rnorm(n.uniq) x <- x.uniq[inds] y <- y.uniq[inds] w <- 1 + runif(n, 0, 2) bw.grid <- seq(0.2, 1.3, 0.1) CV <- LSCV(x, y, bw.grid, weights = w) min.ind <- which.min(CV) bw.opt <- bw.CV(x, y, w) bw.opt2 <- bw.CV(x, y, w, no.dedup = TRUE) expect_equal(bw.opt, bw.opt2) # The optimal bandwidth must be close to the grid minimum expect_gt(bw.opt, bw.grid[min.ind-1]) expect_lt(bw.opt, bw.grid[min.ind+1]) })