tests/testthat/test_dfSearch-get_param_evolution.R

In adwolfer/santaR: Short Asynchronous Time-Series Analysis

context('get_param_evolution()')

## set seed and reset on exit
set.seed(seed=42)
on.exit(set.seed(seed=NULL)) 


## Input and expected data
# 7 measurements, 3 subjects, 4 unique time-points, 2 variables
input_inputData <- matrix(c(1,2,3,4,5,6,7,8,9 ,10,11,12,13,14,15,16,17,18), ncol=2)
input_ind       <- c('ind_1','ind_1','ind_1','ind_2','ind_2','ind_2','ind_3','ind_3','ind_3')
input_time      <- c(0,5,10,0,10,15,5,10,15)

# input_eigen
input_eigen <- evaluate_promise(get_eigen_spline(inputData=input_inputData, ind=input_ind, time=input_time, nPC=NA, scaling="scaling_UV", method="nipals", verbose=FALSE, centering=TRUE, ncores=0))$result

# expected param evolution
tmp_1           <- matrix(data=c(0.02528994, 0.02528995, 0.02528997, 0.02528993, 0.02528993, 0.02528993, 0.02528991, 0.02528992, 0.02528994, 0.02528994, 0.02757335, 0.03019652, 0.03321573, 0.03672339, 0.04082194, 0.04557424, 0.05108704, 0.05744108, 0.06466766, 7.271213e-02, 0.08156415, 0.09103253, 0.1009591, 0.11100506, 0.12110663, 0.13109478, 0.1407538, 0.1500375, 0.1589423, 0.1723930,
                                 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03431543, 0.03715235, 0.04028631, 0.04372748, 0.04750687, 0.05163848, 0.05607166, 0.06077828, 0.06569014, 0.07070131, 7.567185e-02, 0.08052626, 0.08513084, 0.0894221, 0.09330387, 0.09681802, 0.09996983, 0.1027575, 0.1052285, 0.1074308, 0.1336797,
                                 4.06864127, 4.06864135, 4.06864137, 4.06864129, 4.06864124, 4.06864130, 4.06864116, 4.06864116, 4.06864127, 4.06864138, 4.26717696, 4.46549731, 4.66295445, 4.86050363, 5.05855999, 5.25544477, 5.45182753, 5.64783091, 5.84324565, 6.037355e+00, 6.23213951, 6.42679860, 6.6222843, 6.81631260, 7.01165310, 7.20839426, 7.4048679, 7.6019120, 7.8006868, 8.0000000,
                                 2.84122996, 2.84123002, 2.84123003, 2.84122998, 2.84122994, 2.84122998, 2.84122989, 2.84122989, 2.84122996, 2.84123003, 2.97836090, 3.11527327, 3.25150778, 3.38770960, 3.52414882, 3.65965382, 3.79467362, 3.92928575, 4.06334983, 4.196392e+00, 4.32980352, 4.46308193, 4.5969371, 4.72986596, 4.86382487, 4.99892995, 5.1340812, 5.2698904, 5.4071887, 5.5451774,
                                 16.06864239, 16.06864342, 16.06864357, 16.06864272, 16.06864209, 16.06864284, 16.06864116, 16.06864116, 16.06864245, 16.06864372, 18.73538425, 22.06964167, 26.34282964, 32.05002154, 40.08109751, 52.09315952, 72.11600030, 112.21309092, 232.62870585, 9.540383e+04, -248.56125871, -128.11111300, -87.9265837, -68.02049628, -56.01003059, -47.97854280, -42.2750410, -38.0015474, -34.6639026, -32.0000003), ncol=30, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)), byrow=TRUE)
colnames(tmp_1) <- c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)
tmp_2           <- matrix(data=c(3.305850, 3.305850, 3.305850, 3.305849, 3.305849, 3.305849, 3.305849, 3.305849, 3.305849, 3.305850, 3.178434, 3.043886, 2.902303, 2.752797, 2.595047, 2.430911, 2.2610587, 2.087384, 1.9129409, 1.741909e+00, 1.576356, 1.4205197, 1.2764088, 1.1472033, 1.031482, 0.9290299, 0.8397819, 0.7620269, 0.6940457, 0.5958256,
                                 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 2.016974, 1.858635, 1.697838, 1.536404, 1.375235, 1.216111, 1.062880, 0.9177331, 0.783334, 0.6622258, 5.564155e-01, 0.465509, 0.3896283, 0.3272547, 0.2772759, 0.236980, 0.2046235, 0.1788472, 0.1581386, 0.1413176, 0.1560017,
                                 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 8.057032, 7.575791, 7.169413, 6.837274, 6.575540, 6.381553, 6.253412, 6.1857182, 6.172828, 6.2081229, 6.283790e+00, 6.393005, 6.5282168, 6.6836352, 6.8518859, 7.031038, 7.2181102, 7.4092215, 7.6035457, 7.8011219, 8.0000000,
                                 6.829621, 6.829620, 6.829621, 6.829620, 6.829621, 6.829620, 6.829620, 6.829621, 6.829621, 6.829620, 6.286975, 5.819189, 5.425827, 5.102746, 4.847142, 4.657621, 4.5285643, 4.454283, 4.4282271, 4.442828e+00, 4.490669, 4.5645001, 4.6582879, 4.7654393, 4.883210, 5.0086459, 5.1384348, 5.2715240, 5.4076237, 5.5451774,
                                 20.057033, 20.057034, 20.057034, 20.057033, 20.057033, 20.057033, 20.057032, 20.057032, 20.057033, 20.057034, 22.043998, 24.773557, 28.517149, 33.765058, 41.404091, 53.091127, 72.8498910, 112.738088, 232.9935831, 9.540407e+04, -248.400393, -128.0096948, -87.8652328, -67.9849230, -55.990646, -47.9688268, -42.2706874, -37.9999138, -34.6634676, -32.0000003), ncol=30, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)), byrow=TRUE)
colnames(tmp_2) <- c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)
tmp_3           <- matrix(data=c(0.2682609, 0.2682609, 0.2682609, 0.2682608, 0.2682608, 0.2682609, 0.2682608, 0.2682608, 0.2682609, 0.2682609, 0.2924528, 0.3202452, 0.3522343, 0.3893999, 0.4328273, 0.4831830, 0.5415986, 0.6089296, 0.6855082, 7.707553e-01, 0.8645617, 0.9649012, 1.0700981, 1.1765603, 1.283613, 1.389465, 1.491830, 1.590217, 1.684590, 1.827646,
                                 0.3638287, 0.3638288, 0.3638288, 0.3638287, 0.3638287, 0.3638287, 0.3638287, 0.3638287, 0.3638287, 0.3638288, 0.3938848, 0.4270889, 0.4635489, 0.5035936, 0.5473712, 0.5943456, 0.6442185, 0.6962674, 0.7493697, 8.020425e-01, 0.8534855, 0.9022817, 0.9477581, 0.9888955, 1.026137, 1.059539, 1.089083, 1.115270, 1.138609, 1.416808,
                                 4.7275231, 4.7275231, 4.7275232, 4.7275231, 4.7275230, 4.7275231, 4.7275229, 4.7275229, 4.7275231, 4.7275232, 4.9109092, 5.0919169, 5.2695779, 5.4443175, 5.6159972, 5.7826882, 5.9445878, 6.1015842, 6.2536133, 6.400685e+00, 6.5453292, 6.6884129, 6.8324410, 6.9776374, 7.127914, 7.285074, 7.449210, 7.622129, 7.805833, 8.000000,
                                 3.5001117, 3.5001118, 3.5001118, 3.5001118, 3.5001117, 3.5001118, 3.5001117, 3.5001117, 3.5001117, 3.5001118, 3.6220932, 3.7416928, 3.8581312, 3.9715235, 4.0815860, 4.1868972, 4.2874339, 4.3830391, 4.4737174, 4.559723e+00, 4.6429933, 4.7246962, 4.8070937, 4.8911908, 4.980085, 5.075609, 5.178423, 5.290107, 5.412335, 5.545177,
                                 16.7275242, 16.7275252, 16.7275254, 16.7275245, 16.7275239, 16.7275246, 16.7275229, 16.7275229, 16.7275242, 16.7275255, 19.3791165, 22.6960612, 26.9494531, 32.6338354, 40.6385347, 52.6204029, 72.6087606, 112.6668442, 233.0390735, 9.540419e+04, -248.2480690, -127.8494987, -87.7164270, -67.8591715, -55.893770, -47.901863, -42.230699, -37.981331, -34.658756, -32.000000), ncol=30, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)), byrow=TRUE)
colnames(tmp_3) <- c(1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, 3.8, 3.9, 4)
expected_paramEvo  <- list(tmp_1, tmp_2, tmp_3)


test_that('default values', {
  # reset seed
  set.seed(seed=42)
  on.exit(set.seed(seed=NULL))
  
  # results (output, warnings and messages)
  result_paramEvo  <- evaluate_promise(get_param_evolution(input_eigen))
  
  # Check results
  expect_equal(result_paramEvo$result, expected_paramEvo, tolerance=1e-4)
  
  # Check result messages (time taken)
  expect_equal(length(result_paramEvo$messages), 0)
  expect_equal(length(result_paramEvo$output), 1)
  expect_equal(result_paramEvo$output, "")
})

test_that('change step size', {
  # reset seed
  set.seed(seed=42)
  on.exit(set.seed(seed=NULL))
  
  # expected value
  tmp_step_1            <- matrix(data=c(0.02528994, 7.271213e-02, 0.1723930,
                                         0.03431543, 7.567185e-02, 0.1336797,
                                         4.06864138, 6.037355e+00, 8.0000000,
                                         2.84123003, 4.196392e+00, 5.5451774,
                                         16.06864372, 9.540383e+04, -32.0000003), ncol=3, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(2,3,4)), byrow=TRUE)
  colnames(tmp_step_1)  <- c(2,3,4)
  tmp_step_2            <- matrix(data=c(3.305850, 1.741909e+00, 0.5958256,
                                         2.016974, 5.564155e-01, 0.1560017,
                                         8.057032, 6.283790e+00, 8.0000000,
                                         6.829620, 4.442828e+00, 5.5451774,
                                         20.057034, 9.540407e+04, -32.0000003), ncol=3, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(2,3,4)), byrow=TRUE)
  colnames(tmp_step_2)  <- c(2,3,4)
  tmp_step_3            <- matrix(data=c(0.2682609, 7.707553e-01, 1.827646,
                                         0.3638288, 8.020425e-01, 1.416808,
                                         4.7275232, 6.400685e+00, 8.000000,
                                         3.5001118, 4.559723e+00, 5.545177,
                                         16.7275255, 9.540419e+04, -32.000000), ncol=3, nrow=5, dimnames=list(c('Penalised_residuals(CV)','Penalised_residuals(GCV)','AIC','BIC','AICc'), c(2,3,4)), byrow=TRUE)
  colnames(tmp_step_3)  <- c(2,3,4)
  expected_paramEvoStep <- list(tmp_step_1, tmp_step_2, tmp_step_3)
  
  # results (output, warnings and messages)
  result_paramEvo  <- evaluate_promise(get_param_evolution(input_eigen, step=1))
  
  # Check results
  expect_equal(result_paramEvo$result, expected_paramEvoStep, tolerance=1e-4)
  
  # Check result messages (time taken)
  expect_equal(length(result_paramEvo$messages), 0)
  expect_equal(length(result_paramEvo$output), 1)
  expect_equal(result_paramEvo$output, "")
})