tests/testthat/test-sliding_window.R

In DominikMueller64/LDtools: Tools for Linkage Disequilibrium Analysis

library('LDtools')
context("sliding_window")

set.seed(123L)

# Test realistic data.
df <- sliding_window(arima.sim(n = 1000L, list(ar = 0.99)), sort(runif(1000L)),
                     start = 0.0, width = 0.02, advance = 0.01, "mean")

stat_exp <- c(-3.10865565816086, -5.30746514300881, -7.21447560797312, -7.7223778507363,
              -6.07090253640482, -3.10989320976359, -4.24925938450756, -7.71498357853412,
              -9.22709678999973, -10.2442677267986, -10.9954742870194, -9.18178114484292,
              -6.73766631630712, -0.997641666152565, 3.91791156601563, 5.589896654845,
              5.90075934144984, 3.30739635666938, 2.04446841456067, 3.24523714863221,
              3.07979944171967, -0.356492846305141, -1.8859198766385, -1.69780375879608,
              1.43729695161967, 2.62054927194524, 4.36224678252744, 7.62127440275708,
              8.59528176938329, 8.88775082852602, 9.96107688115, 11.8926901525294,
              12.5656176088125, 10.5365594167917, 8.48573320886916, 6.71073469008773,
              4.50551127902416, -0.0317912207740027, -0.211230724069077, -0.0808345054391941,
              -0.121199211404999, 2.76395353527937, 5.81717597219312, 7.19296106412626,
              6.67011046077008, 6.1656109226993, 7.93053082523742, 8.31757568568148,
              6.60101703021695, 5.51377890235889, 5.0440469747541, 4.5817176404565,
              5.20975360857023, 4.46872726455451, 3.8246004608987, 3.38373532372466,
              2.12702541366593, 0.770893957124229, -0.116138891699937, 1.11382345407477,
              0.68837101752808, -4.90350866532132, -6.77265207687185, -5.71234104261821,
              -3.17355428844043, -0.68527414566452, 1.79570139893894, 3.74756739811639,
              2.44857482531542, 0.40937425929806, 0.383045719413422, -0.682617216701494,
              0.428347333352642, 0.703659011670356, -1.84997406394048, -5.11648775707093,
              -5.0924765118683, -3.09349452630284, -1.80861459923333, -2.75530089951076,
              -3.16458018353927, -2.55223527975129, -0.769743583418926, 2.0196569204583,
              1.25213940010116, 0.903210735704702, 2.89904548255982, 1.69152746339936,
              -0.00324677010833373, 2.20506055728431, 4.88729515650619, 7.26660388019719,
              7.97287198845552, 9.52409698796134, 11.5890678896099, 10.6594124064494,
              8.29078022058805, 6.78536588643474)

test_that("output statistic is correct for realistic data", {
  expect_equal(object = nrow(df), expected = length(stat_exp))
  expect_true(all(abs(df$stat - stat_exp) < sqrt(.Machine$double.eps), na.rm = TRUE))
})


# Test if sparse data are properly treated
df <- sliding_window(x = 1:7, pos = c(0.1, 0.33, 0.4, 0.5, 0.66, 0.7, 0.77),
               start = -1, width = 0.07, advance = 0.05, "mean")

stat_exp <- c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
              NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, 2, 3, NA, 4, NA, NA,
              5, 5.5)

test_that("output statistic is correct for spart data and early start", {
  expect_equal(object = nrow(df), expected = length(stat_exp))
  expect_true(all(abs(df$stat - stat_exp) < sqrt(.Machine$double.eps), na.rm = TRUE))
})