tests/testthat/test-interpolate.R

# TEST INTERPOLATION - INVERSE DISTANCE SQUARED
# Generate topography with sin functions
get_elev <- function(x, y) 500*sin(x / 750) + 500*sin(y / 1000) + 1000
# Generate random precipitation observations
set.seed(100)
N_obs<- 10
precip_df <- data.frame(precip = rnorm(N_obs, 750, 100),
                        x = runif(N_obs, 0, 5000),
                        y = runif(N_obs, 0, 5000))
precip_df$elev <- get_elev(precip_df$x, precip_df$y)

out_xy <- expand.grid(x = seq(0, 5000, length.out = 9),
                      y = seq(0, 5000, length.out = 9))
out_xy$elev <-

# Interpolate precipitation
out_1_expected <- tibble::tibble(x=c(0, 0, 0, 0, 0, 0, 0, 0, 0, 625, 625, 625, 625, 625, 625, 625, 625, 625, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 5000, 5000, 5000, 5000, 5000, 5000, 5000, 5000, 5000),
                        y=c(0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000),
                        precip=c(729, 729, 733, 738, 745, 752, 761, 767, 765, 724, 722, 727, 735, 743, 752, 765, 779, 771, 720, 714, 723, 733, 741, 751, 760, 772, 763, 722, 719, 727, 731, 734, 753, 757, 747, 734, 724, 726, 734, 737, 706, 743, 753, 728, 684, 720, 716, 726, 733, 722, 745, 758, 756, 727, 714, 697, 703, 733, 756, 778, 777, 787, 813, 717, 707, 714, 744, 784, 821, 795, 789, 793, 726, 724, 733, 753, 780, 799, 790, 782, 780))
out_1_expected$interp <- interpolate_IDS(precip_df, out_1_expected, elev_gradient = 0) %>% round(0)

out_2_expected <- data.frame(x=c(0, 0, 0, 0, 0, 0, 0, 0, 0, 625, 625, 625, 625, 625, 625, 625, 625, 625, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 1875, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 2500, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3125, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 3750, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 4375, 5000, 5000, 5000, 5000, 5000, 5000, 5000, 5000, 5000),
                 y=c(0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000, 0, 625, 1250, 1875, 2500, 3125, 3750, 4375, 5000),
                 precip=c(712, 741, 769, 785, 783, 766, 748, 735, 736, 731, 753, 788, 815, 817, 804, 788, 778, 776, 730, 737, 785, 824, 827, 814, 798, 789, 788, 721, 738, 783, 805, 799, 795, 772, 764, 766, 705, 735, 762, 764, 730, 748, 738, 730, 705, 682, 710, 732, 734, 716, 724, 733, 743, 717, 678, 697, 719, 745, 755, 759, 752, 778, 804, 710, 732, 757, 787, 813, 820, 783, 789, 799, 760, 790, 817, 840, 853, 844, 817, 808, 813))
out_2_expected$elev <- get_elev(out_2_expected$x, out_2_expected$y)
out_2_expected$interp <- interpolate_IDS(precip_df, out_2_expected, elev_gradient = 0.1) %>% round(0)

test_that("interpolate_IDS works without elevation gradient", {
  expect_equal(out_1_expected$interp, out_1_expected$precip)
})

test_that("interpolate_IDS works with elevation gradient", {
  expect_equal(out_2_expected$interp, out_2_expected$precip)
})
gopalpenny/gohydro documentation built on Dec. 20, 2021, 12:43 p.m.