tests/testthat/test-BinarySegmentationTests.R

In diego-urgell/BinSeg: Efficient Binary Segmentation for several distributions

# Title     : Binary Segmentation Tests
# Objective : TODO
# Created by: diego.urgell
# Created on: 24/06/21

# NOTE: The expected answers for some tests were obtained from the changepoint package.

set.seed(2000)
library(BinSeg)

check_cost <- function(object, ncpts=nrow(object@models_summary)){

  dist <- dist(object)
  obj_coef <- coef(object, ncpts)
  data <- object@data

  if (dist == "mean_norm"){ # Cost function per segment.
    cost_func <- function(start, end) 2 * (sum(data[start:end]^2) - (sum(data[start:end])^2)/(end - start + 1))
  }
  else if (dist == "var_norm"){
    mean_full <- mean(data)
    cost_func <- function(start, end){
      N <- (end - start + 1)
      fixed_mean_var <- sum((data[start:end] - mean_full)^2) / N
      seg_cost <- 2 * N * (log(2*pi) + log(fixed_mean_var) + 1)
    }
  }
  else if (dist == "meanvar_norm"){
    cost_func <- function(start, end){
      N <- (end - start + 1)
      var <- sum((data[start:end] - mean(data[start:end]))^2) / N
      seg_cost <- 2 * N * (log(2*pi) + log(var) + 1)
    }
  }
  else if (dist == "poisson"){
    cost_func <- function(start, end){
      lSum <- sum(data[start:end])
      N <- end - start + 1
      seg_cost <- - 2 * (lSum * (log(lSum) - log(N) - 1) - sum(lgamma(data[start:end])))
    }
  }
  else if (dist == "negbin"){
    cost_func <- function(start, end){
      N <- end - start + 1
      mean <- mean(data[start:end])
      var <- sum((data[start:end] - mean)^2) / N
      r_dispersion <- abs(mean^2/(var-mean))
      p_success <- mean/var
      seg_cos <- 2 * (sum(data[start:end])* log(1-p_success) + N * r_dispersion * log(abs(p_success)))
    }
  }
  else if (dist == "exponential"){
    cost_func <- function(start, end){
      N <- end - start + 1
      seg_cost <- - 2 * N * (log(N) - log(sum(data[start:end])) - 1)
    }
  }

  cost <- 0.0
  for(i in 1:ncpts){
    cost <- cost + cost_func(obj_coef[["start"]][i], obj_coef[["end"]][i])
  }

  return(cost)
}


test_that(desc="Binary Segmentation + Change in mean: Test 1 - Single changepoint", {
  data  <-  c(rnorm(10, 100, 10), rnorm(10, 50, 10))
  ans <- BinSeg::BinSegModel(data, "BS", "mean_norm", 1, 1)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(10, 20))
})

test_that(desc="Binary Segmentation + Change in mean: Test 2 - Two changepoints ",{
  data  <-  c(rnorm(10, 100, 10), rnorm(10, 200, 10), rnorm(10, 300, 10))
  ans <- BinSeg::BinSegModel(data, "BS", "mean_norm", 2, 1)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(10, 20, 30))
})

test_that(desc="Binary Segmentation + Change in mean: Test 3 - No change with large vector",{
  data  <-  rnorm(10000, 100, 10)
  ans <- BinSeg::BinSegModel(data, "BS", "mean_norm", 500, 1)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(2,5,11,18,25,66,69,75,78,101,102,104,123,124,129,133,141,143,688,696,699,704,775,782,800,804,806,814,815,818,821,823,827,842,852,1960,1962,2009,2016,2017,2020,2021,2023,2046,2059,2067,2097,2100,2103,2112,2123,2156,2160,2165,2202,2203,2227,2229,2245,2253,2262,2264,2268,2273,2280,2281,2284,2307,2308,2312,2347,2399,2404,2419,2425,2426,2429,2482,2487,2493,2506,2515,2520,2522,2523,2541,2546,2553,2614,2624,2626,2699,2703,2709,2711,2734,2825,2826,2832,2877,2880,2883,2895,2896,2899,2918,2930,2937,2940,2962,2990,2999,3036,3038,3039,3042,3045,3101,3132,3135,3571,3572,3578,3585,3594,3596,3640,3643,3661,3666,3669,3671,3673,3680,3689,3704,3763,3773,3779,3782,3865,3866,3875,3881,3886,3893,3898,3901,3909,3915,4001,4004,4007,4014,4024,4035,4038,4053,4057,4065,4072,4082,4090,4175,4186,4187,4190,4192,4193,4199,4219,4231,4237,4239,4241,4250,4256,4257,4260,4274,4276,4278,4293,4297,4302,4314,4315,4329,4331,4349,4357,4365,4367,4371,4379,4672,4673,4676,4678,4682,4684,4686,4689,4694,4696,4697,4712,4714,4715,4720,4725,4802,4804,4806,4812,4814,4817,4843,4845,4860,4861,4894,4896,4898,4985,4986,4988,4994,5035,5039,5070,5072,5076,5102,5106,5107,5114,5118,5124,5127,5170,5172,5201,5202,5204,5205,5208,5211,5213,5215,5216,5382,5383,5384,5422,5424,5427,5430,5438,5439,5463,5464,5467,5475,5483,5492,5497,5498,5535,5546,5568,5570,5572,5574,5741,5743,5745,5754,5849,5852,5857,5859,5940,5944,5945,5953,5963,5964,5971,5976,5977,5992,5994,6001,6003,6013,6029,6035,6036,6042,6048,6055,6057,6059,6626,6628,6645,6750,6755,6765,6774,6779,6780,6784,6790,6794,6796,7155,7157,7163,7170,7175,7177,7207,7222,7225,7229,7238,7266,7272,7274,7277,7279,7281,7284,7300,7303,7307,7315,7316,7320,7354,7356,7391,7404,7405,7413,7419,7427,7461,7462,7494,7495,7508,7512,7514,7534,7537,7579,7581,7583,7600,7605,7622,7623,7625,7904,7908,7921,7977,7984,7985,8011,8013,8034,8041,8044,8064,8076,8108,8111,8124,8126,8134,8159,8178,8180,8209,8211,8218,8228,8237,8272,8274,8278,8282,8287,8377,8380,8399,8405,8407,8416,8419,8423,8437,8478,8480,8482,8489,8492,8496,8500,8501,8510,8512,8515,8517,8521,8532,8536,8549,8561,8565,8570,8575,8577,8581,8589,8591,8594,8598,8620,8623,8626,8632,8678,8679,8691,8701,8712,8714,8727,8754,8760,8763,8765,8766,8768,8773,8775,8798,8800,8808,8810,8817,8864,8867,8871,8877,8879,8969,8971,8978,8981,8988,8991,8994,9002,9006,9099,9101,9105,9107,9195,9197,9199,9202,9206,9209,9210,9217,9221,9224,9229,9241,9243,9246,9250,9371,9373,9385,9389,9399,9404,9407,9409,9986,9989,9993,10000))
})

test_that(desc="Binary Segmentation + Change in mean: Test 4 - 5 change points with medium vector",{
  data  <-  c(rnorm(100, 100, 10), rnorm(100, 50, 10), rnorm(100, 25, 10),
              rnorm(100, 0, 10), rnorm(100, -50, 10), rnorm(100, -100, 10))
  ans <- BinSeg::BinSegModel(data, "BS", "mean_norm", 5, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(101,207,300,399,500,600))
})

test_that(desc="Binary Segmentation + Change in mean and variace: Test 1 - Single changepoint in mean", {
  data  <-  c(rnorm(10, 100, 10), rnorm(10, 50, 10))
  ans <- BinSeg::BinSegModel(data, "BS", "meanvar_norm", 1, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(10, 20))
})

test_that(desc="Binary Segmentation + Change in mean and variace: Test 2 - Single changepoint in var", {
  data  <-  c(rnorm(10, 100, 200), rnorm(10, 100, 20))
  ans <- BinSeg::BinSegModel(data, "BS", "meanvar_norm", 1, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(10, 20))
})

test_that(desc="Binary Segmentation + Change in mean and variace: Test 3 - Two changepoints in mean and var", {
  data  <-  c(rnorm(10, 100, 100), rnorm(10, 0, 40), rnorm(10, -100, 60))
  ans <- BinSeg::BinSegModel(data, "BS", "meanvar_norm", 2, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(10, 19, 30))
})

test_that(desc="Binary Segmentation + Change in mean and variace: Test 4 - Big vector with no changepoint", {
  data  <-  rnorm(10000, 500, 100)
  ans <- BinSeg::BinSegModel(data, "BS", "meanvar_norm", 500, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(5,9,14,36,43,47,53,105,108,110,116,118,120,132,149,152,158,161,163,166,168,180,182,185,424,427,430,524,1073,1075,1081,1083,1085,1091,1093,1095,1099,1104,1108,1110,1112,1114,1117,1123,1126,1137,1140,1143,1145,1154,1156,1160,1165,1170,1176,1228,1237,1286,4192,4207,4228,4233,4235,4237,4240,4242,4244,4246,4257,4259,4261,4263,4266,4268,4272,4286,4299,4301,4305,4308,4310,4314,4399,4402,4404,4408,4414,4418,4421,4426,4431,4435,4438,4441,4445,4450,4503,4505,4524,4527,4530,4535,4556,4558,4581,4585,4587,4591,4595,4628,4647,4650,4672,4674,4676,4683,5216,5218,5221,5225,5233,5235,5237,5240,5242,5245,5252,5255,5285,5287,5289,5291,5293,5309,5311,5340,5343,5348,5352,5363,5365,5368,5370,5400,5403,5406,5409,5412,5415,5430,5446,5449,5452,5454,5459,5463,5465,5469,5471,5474,5477,5489,5491,5501,5503,5505,5509,5511,5515,5519,5532,5538,5540,5542,5546,5550,5554,5559,5561,5564,5580,5671,5677,5681,5686,5698,5700,5704,5707,5710,5712,5717,5719,5722,5726,5730,5737,5739,5749,5753,5756,5758,5783,5786,5792,5795,5797,5799,5803,5806,5810,5813,5815,5818,5822,5954,5964,5986,6474,6477,6482,6485,6497,6501,6503,6507,6510,6512,6518,6524,6531,6534,6544,6546,6551,6555,6559,6563,6565,6567,6569,6571,6574,6580,6582,6587,6591,6595,6597,6599,6602,6610,6614,6617,6622,6624,6627,6629,6632,6641,6648,6656,6663,6674,6676,6678,6892,6897,6899,6904,6908,6910,6987,6991,6994,6999,7006,7008,7011,7015,7078,7080,7087,7091,7095,7100,7108,7110,7112,7114,7146,7161,7165,7168,7170,7172,7175,7184,7186,7194,7198,7205,7208,7234,7243,7249,7251,7253,7255,7260,7651,7653,7655,7659,7662,7664,7669,7673,7696,7698,7702,7706,7713,7717,7723,7914,7916,7941,7957,7961,7966,7969,8113,8116,8118,8120,8137,8140,8144,8146,8148,8150,8153,8159,8163,8166,8214,8216,8219,8223,8227,8291,8298,8300,8306,8308,8312,8314,8318,8321,8324,8328,8330,8332,8338,8341,8355,8364,8367,8369,8372,8378,8381,8384,8386,8397,8401,8411,8416,8425,8428,8430,8437,8457,8469,8471,8474,8478,8481,8484,8489,8571,8574,8576,8594,8597,8601,8603,8605,8612,8614,8616,8619,8622,8651,8654,8658,8660,8686,8688,8696,8727,8730,8736,8742,8746,8749,8751,8754,8757,8759,8764,8766,8769,8771,8774,9554,9561,9564,9571,9579,9584,9608,9612,9616,9618,9621,9625,9629,9632,9655,9661,9663,9666,9668,9671,9673,9676,9678,9681,9683,9686,9688,9692,9694,9699,9702,9712,9714,9720,9722,9725,9728,9734,9736,9739,9747,9756,9758,9761,9764,9769,9772,9778,9811,9820,9829,9832,9849,9851,9853,9855,9857,9881,9886,9888,9890,9896,9899,9908,9918,9957,9961,9966,9978,9980,9983,9986,9988,9997,10000))
})

test_that(desc="Binary Segmentation + Change in variace: Test 1 - Single Changepoint", {
  data  <-  c(rnorm(100, 100, 100), rnorm(100, 100, 0))
  ans <- BinSeg::BinSegModel(data, "BS", "var_norm", 1, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(99, 200))
})


test_that(desc="Binary Segmentation + Change in variace: Test 2 - Two changepoints in var", {
  data  <-  c(rnorm(100, 100, 100), rnorm(100, 100, 40), rnorm(100, 100, 60))
  ans <- BinSeg::BinSegModel(data, "BS", "var_norm", 2, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(98, 197, 300))
})


test_that(desc="Binary Segmentation + Change in variace: Test 3 - Big vector with no changepoint", {
  data  <-  rnorm(100000, 500, 100)
  ans <- BinSeg::BinSegModel(data, "BS", "var_norm", 500, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(3,15,19,55644,55648,55650,55666,55678,55718,55721,55725,55736,55747,55752,55760,55763,55782,55814,55873,55879,55882,55952,55956,56071,56075,56095,56099,56116,56142,56167,56442,56451,56456,56460,56466,56481,56502,56504,57524,57531,57576,57596,57611,57616,57620,57676,57679,57688,57697,57716,57723,57726,57749,57753,57770,57777,57864,58398,58405,58413,58416,58446,58453,58455,58458,58489,58626,58640,58659,58697,58701,58741,58750,58785,58792,58838,58855,58871,58875,58878,58880,58901,58917,58944,58948,58950,59027,59048,59601,59629,59701,59707,59719,59722,59724,59733,60041,60114,60117,60120,60178,60220,60224,60524,60534,60558,60563,60632,60635,60644,60648,60659,60695,60698,60749,60800,60820,60839,60856,60864,60871,60883,60891,60909,60912,60926,60935,61007,61014,61033,61037,61044,61096,61101,61122,61152,61154,61157,61166,61188,61195,61230,61232,61235,61244,61409,61414,61714,61782,61788,61794,61797,61800,61986,61990,62063,62068,62075,62077,64181,64192,64195,64257,64265,64357,64360,64398,64401,64414,64433,64438,64530,64537,64541,64591,64602,64610,64620,64628,64667,64681,64708,64711,64713,64715,64720,64730,64826,64832,64982,64985,65044,65048,65052,65070,65073,65077,65132,65134,65243,65247,65253,65259,65271,65309,65312,65371,65399,65457,65469,65471,65602,65640,65643,65717,65720,65741,65745,65811,65833,65835,65855,65857,65860,65952,66103,66107,66109,66111,66115,66146,66149,66285,66299,66320,66326,66361,66364,66454,66590,66595,66607,66611,66908,66922,66930,66936,66938,66974,66988,67079,67095,67101,67128,67131,67134,67645,67674,67677,67682,67699,67702,67706,67710,67750,67753,67782,67787,67790,67821,67827,67841,67848,67906,67918,67930,70027,70030,70033,70036,70039,70106,70220,70224,70232,70235,70239,70247,70279,70282,70292,70310,70368,70370,70377,70428,70440,70443,74039,74045,74048,74051,74110,74133,74141,74144,74158,74163,75879,75882,75884,75893,75898,75900,75904,75909,75912,75925,75934,75940,75983,76064,76073,76077,76080,76084,76087,76090,76103,76106,76138,76159,76162,76165,76191,76198,76324,76333,76343,76355,76369,76397,76428,76449,76485,76506,76582,76607,76613,76618,77098,77103,77148,77150,77214,77340,77348,77355,77358,77419,77432,77438,77440,77442,77445,77449,77451,77455,77470,77472,79806,79808,79813,79815,79924,79927,79930,79947,79972,79975,79984,80089,80092,80113,80133,80143,80147,80173,80203,80206,80646,80652,80657,80714,80782,80785,81029,81085,81115,81120,81125,81129,81131,81197,81201,81248,81529,81539,81543,81550,81602,81608,81622,81630,81632,81650,82111,82113,82173,82181,82264,82268,82273,82275,82295,82369,82375,82378,82442,82473,82476,86803,86810,86906,86917,86923,88086,88120,88122,88154,88159,88194,88203,88222,88227,88231,88235,88248,88739,88742,88745,88751,88772,88807,88811,88843,88847,88852,88858,88872,88970,88975,88978,88987,89003,89010,89016,89073,89123,89136,89146,89148,89160,89162,89177,89180,89270,89280,89309,89329,89332,89334,89358,99837,99846,99849,99851,99863,99880,99884,99887,99889,99906,99909,99911,99915,99942,99956,99964,99988,1e+05))
})


test_that(desc="Binary Segmentation + Negbin change in probability of success: Test 1 - Single changepoint", {
  data <- c(rnbinom(200, size = 50, prob=0.2), rnbinom(200, 50, 0.65))
  ans <- BinSeg::BinSegModel(data, "BS", "negbin", 1, 2)
  print(coef(ans))
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(200, 400))
})

test_that(desc="Binary Segmentation + Negbin change in probability of success: Test 2 - Several changepoints", {
  data <- c(rnbinom(250, size = 50, prob=0.2), rnbinom(250, 50, 0.4),
            rnbinom(250, 50, 0.65),  rnbinom(250, 50, 0.9))
  ans <- BinSeg::BinSegModel(data, "BS", "negbin", 3, 2)
  print(coef(ans))
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(250, 500, 750, 1000))
})

test_that(desc="BinarySegmentation + Poisson change in rate: Test 1 - Single changepoint", {
  data <- c(rpois(250, 10), rpois(250, 50))
  ans <- BinSeg::BinSegModel(data, "BS", "poisson", 1, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(250, 500))
})

test_that(desc="BinarySegmentation + Poisson change in rate: Test 2- Several changepoints", {
  data <- c(rpois(100, 10), rpois(130, 5), rpois(150, 15), rpois(130, 50),
            rpois(120, 10), rpois(160, 50), rpois(160, 25), rpois(180, 35))
  ans <- BinSeg::BinSegModel(data, "BS", "poisson", 6, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(230,380,510,630,790,949,1130))
})

test_that(desc="BinarySegmentation + Poisson change in rate: Test 3 - Several changepoints - fewer in input", {
  data <- c(rpois(100, 10), rpois(130, 5), rpois(150, 15), rpois(130, 50),
            rpois(120, 10), rpois(160, 50), rpois(160, 25), rpois(180, 35))
  ans <- BinSeg::BinSegModel(data, "BS", "poisson", 3, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(380,510,630,1130))
})

test_that(desc="BinarySegmentation + Poisson change in rate: Test 4 - No changepoint", {
  data <- rpois(10000, 50)
  ans <- BinSeg::BinSegModel(data, "BS", "poisson", 1000, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(12,18,21,24,27,31,33,55,59,69,75,78,82,92,100,105,112,114,117,122,134,137,156,158,260,262,265,267,270,273,280,284,287,292,296,298,311,317,320,329,331,342,350,352,386,389,391,397,414,417,426,428,432,436,439,448,457,463,472,475,489,492,498,502,505,508,516,519,523,525,552,567,572,588,593,599,601,610,614,617,661,665,679,692,695,699,702,910,915,929,971,979,983,996,1003,1009,1011,1014,1018,1022,1027,1030,1032,1034,1049,1055,1057,1060,1062,1066,1069,1071,1074,1082,1084,1094,1096,1100,1108,1114,1121,1125,1127,1130,1141,1144,1147,1154,1158,1179,1181,1193,1195,1200,1204,1209,1217,1221,1224,1226,1238,1291,1295,1298,1306,1309,1313,1316,1322,1325,1336,1342,1346,1357,1361,1367,1370,1377,1382,1386,1389,1392,1394,1405,1413,1418,1420,1422,1459,1463,1501,1506,1508,1516,1519,1552,1554,1565,1569,1573,1578,1582,1587,1590,1595,1600,1605,2040,2042,2049,2057,2060,2064,2071,2081,2084,2090,2092,2096,2100,2106,2110,2112,2114,2123,2126,2144,2146,2150,2154,2161,2164,2167,2172,2176,2321,2323,2331,2347,2350,2353,2357,2359,2361,2366,2370,2372,2376,2382,2385,2389,2396,2398,2400,2403,2439,2444,2447,2450,2454,2461,2531,2535,2541,2545,2551,2566,2574,2588,2592,2595,2597,2603,2609,2613,2616,2629,2638,2644,2654,2724,2726,2731,2741,2743,2746,2758,2771,2776,2780,2813,2815,2819,2822,2827,2829,2839,2842,2845,2848,2851,2856,2858,2867,2870,2881,2883,2912,2923,2926,2953,2957,2968,2971,2974,2977,2984,2986,2992,2995,3003,3006,3014,3017,3029,3033,3049,3053,3059,3061,3085,3088,3090,3092,3096,3098,3103,3107,3116,3118,3125,3135,3138,3146,3151,3153,3159,3161,3169,3172,3174,3194,3231,3234,3237,3242,3247,3262,3264,3298,3303,3335,3339,3344,3347,3359,3362,3369,3371,3373,3388,3391,3395,3398,3405,3408,3422,3425,3428,3431,3433,3436,3449,3454,3468,3475,3478,3481,3484,3497,3500,3512,3516,3519,3523,3525,3553,3555,3559,3563,3566,3569,3583,3592,3596,3600,3604,3611,3613,3619,3634,3639,3642,3647,3653,3655,3660,3670,3672,3674,3678,3686,3689,3707,3709,3715,3722,3725,3731,3740,3750,3755,3758,3815,3818,3821,3825,3845,3850,3854,3857,3860,3862,3868,3871,3876,3894,3906,3915,3918,3922,3924,3927,3929,3933,3936,3940,3943,3948,3953,3955,4109,4113,4120,4124,4127,4129,4136,4141,4144,4149,4153,4156,4160,4164,4181,4184,4188,4191,4195,4198,4200,4203,4206,4208,4248,4250,4252,4254,4258,4260,4267,4270,4273,4278,4280,4282,4290,4293,4300,4303,4313,4319,4326,4328,4330,4345,4361,4367,4374,4377,4421,4424,4467,4474,4483,4489,4492,4499,4502,4507,4540,4544,4556,4559,4561,4565,4569,4571,4574,4581,4583,4590,4594,4723,4725,4731,4733,4737,4739,4743,4748,4753,4756,4759,4762,4765,4769,4773,4784,4789,4812,4814,4821,4825,4838,4843,4846,4848,4851,4855,4909,4917,4922,4943,4945,4948,4956,4960,4970,4990,4998,5000,5003,5012,5015,5034,5036,5039,5044,5048,5053,5057,5059,5064,5069,5072,5075,5077,5086,5106,5108,5127,5133,5174,5177,5179,5182,5195,5201,5239,5242,5246,5251,5254,5266,5274,5277,5344,5348,5352,5358,5362,5366,5369,5376,5381,5396,5399,5404,5414,5417,5421,5430,5439,5444,5447,5450,5460,5468,5476,5479,5484,5493,5512,5516,5536,5539,5541,5543,5566,5570,5573,5575,5577,5581,5591,5594,5596,5598,5603,5608,5611,5616,5619,5622,5630,5633,5654,5656,5658,5669,5676,5749,5756,5759,5774,5780,5784,5786,5789,5792,5795,5811,5826,5829,5837,5844,5847,5850,5868,5874,5878,5880,5894,5896,5911,5922,5926,5934,5937,5947,5952,5957,5961,5964,5969,5971,6032,6042,6046,6049,6053,6059,6075,6077,6081,6084,6090,6092,6098,6118,6133,6145,6159,6161,6163,6176,6195,6198,6211,6218,6224,6227,6233,6236,6239,6258,6261,6263,6266,6269,6308,6315,6321,6324,6328,6338,6343,6347,6349,6379,6381,6383,6387,6390,6393,6399,6401,6437,6487,6489,6496,6498,6514,7165,7168,7171,7173,7177,7180,7183,7186,7192,7204,7210,7214,7218,7223,7228,7230,7235,7267,7280,7285,7287,7293,7298,7301,7309,7313,7317,7361,7373,7378,7384,7386,7389,7392,7396,7682,7684,7689,7691,7693,7696,7699,7704,7708,7712,7716,7724,7726,7730,7737,7741,7744,7747,7749,7756,7759,7764,7767,7772,7784,7786,7791,7793,7797,7803,7805,7809,7812,7820,7822,7828,7845,7848,7852,7879,7892,7906,7913,7915,7920,7926,7931,7934,7939,7941,7945,7949,7952,7955,7959,7963,7965,7967,7969,7977,7985,7987,7995,7999,8007,8022,8024,8027,8030,8043,8046,8049,8052,8063,8065,8070,8085,8090,8112,8117,8128,8131,8151,8161,8169,8193,8209,8213,8227,8230,8232,8237,8242,8325,8327,8331,8334,8338,8356,8359,8396,8400,8413,8417,8420,8424,8430,8453,8458,8465,8472,8477,8479,8488,8495,8499,8502,8504,8512,8516,8519,8525,8528,8534,8548,8551,8553,8555,8560,8564,8621,8624,8627,8630,8633,8639,8641,8645,8658,8661,8664,8668,8674,8678,8686,8786,8789,8798,8800,8802,8805,8816,8818,8822,8825,8827,8830,8840,8924,8927,8932,8937,8965,8969,8971,8976,8978,8982,8987,9058,9060,9071,9073,9075,9079,9090,9094,9114,9123,9129,9141,9147,9151,9155,9212,9217,9229,9237,9283,9286,9289,9295,9297,9301,9303,9306,9336,9338,9342,9393,9396,9411,9419,9432,9434,9439,9450,9452,9467,9473,9479,9487,9496,9501,9508,9518,9521,9523,9527,9539,9542,9544,9565,9574,9587,9590,9597,9603,9605,9608,10000))
})

test_that(desc="BinarySegmetation + Exponential change in rate: Test 1 - Single changepoint", {
  data <- c(rexp(200, 10), rexp(200, 40))
  ans <- BinSeg::BinSegModel(data, "BS", "exponential", 1, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(200, 400))
})

test_that(desc="BinarySegmentation + Exponential change in rate: Test 2- Several changepoints", {
  data <- c(rexp(100, 10), rexp(130, 5), rexp(150, 15), rexp(130, 50),
            rexp(120, 10), rexp(160, 50), rexp(160, 25), rexp(180, 35))
  ans <- BinSeg::BinSegModel(data, "BS", "exponential", 6, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(104,225,378,523,629,745,1130))
})

test_that(desc="BinarySegmentation + Exponential change in rate: Test 4 - No changepoint", {
  data <- rexp(10000, 50)
  ans <- BinSeg::BinSegModel(data, "BS", "exponential", 1000, 2)
  expect_equal(tail(logLik(ans), 1), check_cost(ans))
  expect_equal(sort(cpts(ans)), c(3,8,19,23,25,30,34,36,80,85,88,93,98,105,109,113,120,127,158,161,163,182,186,199,207,210,246,250,255,399,402,405,412,415,417,430,432,438,449,457,460,655,659,681,693,712,718,723,725,732,737,739,758,762,764,767,788,790,792,802,808,811,814,817,819,829,836,842,844,861,868,871,904,907,911,915,926,930,953,958,961,977,983,985,996,998,1006,1012,1015,1018,1020,1022,1030,1061,1063,1067,1070,1072,1080,1083,1086,1089,1096,1098,1102,1107,1111,1114,1119,1123,1127,1130,1144,1149,1153,1159,1167,1179,1190,1192,1196,1200,1203,1206,1239,1241,1244,1247,1251,1256,1258,1285,1289,1292,1295,1557,1559,1564,1567,1574,1581,1584,1596,1599,1603,1605,1612,1621,1626,1632,1639,1686,1696,1701,1708,1716,1720,1727,1731,1755,1757,1766,1774,1778,1784,1786,1791,1794,1797,1809,1818,1823,1828,1834,1839,1843,1847,1850,1855,1858,1861,1890,1893,1895,1899,1907,1909,1915,1920,1924,1937,1940,1954,1958,1966,1972,1974,1982,1985,1987,1991,1997,2012,2019,2036,2053,2059,2062,2066,2069,2072,2124,2126,2129,2155,2158,2166,2171,2174,2567,2571,2579,2584,2589,2602,2604,2608,2611,2613,2630,2640,2643,2647,2653,2668,2670,2672,2674,2684,2697,2701,2725,2727,2729,2734,2756,2770,2772,2775,2780,2783,2785,2788,2794,2812,2814,2819,2822,2856,2861,2864,2868,2870,2873,2913,2922,2925,2929,2932,2936,2941,2945,2948,2956,2960,2980,2983,2985,2994,3000,3007,3018,3024,3027,3046,3049,3053,3060,3063,3066,3072,3104,3109,3113,3115,3118,3121,3130,3133,3138,3140,3142,3145,3150,3155,3158,3162,3169,3173,3175,3181,3184,3187,3190,3194,3197,3210,3216,3219,3227,3231,3246,3264,3268,3275,3282,3296,3321,3329,3333,3336,3347,3349,3476,3483,3487,3555,3557,3564,3609,3611,3614,3625,3657,3660,3666,3668,3671,3675,3680,3685,3688,3692,3702,3704,3708,3716,3718,3722,3724,3734,3738,3793,3797,3816,3825,3835,3839,3846,3853,3878,3882,3885,3887,3893,3896,3899,3908,3911,3929,3932,3947,3953,3959,3961,3963,4030,4036,4146,4166,4169,4173,4181,4189,4194,4201,4207,4212,4226,4246,4250,4286,4289,4330,4339,4342,4346,4349,4359,4363,4366,4368,4372,4379,4382,4391,4396,4414,4420,4423,4426,4428,4431,4435,4437,4439,4443,4446,4461,4463,4466,4491,4494,4501,4507,4513,4521,4530,4545,4562,4565,4606,4615,4618,4621,4628,4634,4677,4681,4684,4690,4698,4705,4709,4713,4717,4722,4736,4739,4742,4744,4750,4755,4757,4761,4764,4769,4771,4804,4809,4829,4835,4838,4841,4897,4900,4909,4914,4918,4971,4974,4977,4985,4987,4992,4994,4997,5000,5003,5005,5010,5013,5018,5020,5046,5061,5063,5069,5073,5076,5084,5099,5107,5113,5117,5121,5129,5180,5183,5199,5221,5223,5228,5231,5236,5243,5248,5252,5254,5260,5267,5275,5311,5314,5318,5322,5351,5353,5356,5359,5361,5363,5369,5401,5403,5407,5409,5422,5425,5429,5432,5436,5443,5446,5463,5465,5472,5474,5477,5484,5489,5491,5494,5497,5500,5504,5507,5510,5523,5531,5534,5547,5551,5582,5585,5593,5620,5634,5640,5642,5663,5826,5832,5835,5837,5846,5848,5892,5897,5901,5908,5915,5918,5922,5933,5952,5957,5977,5982,5992,5994,6000,6013,6018,6025,6032,6038,6044,6061,6069,6072,6096,6099,6104,6111,6147,6165,6169,6173,6184,6201,6205,6210,6226,6229,6232,6236,6242,6245,6250,6307,6311,6314,6350,6366,6370,6375,6383,6405,6408,6416,6421,6425,6439,6444,6448,6452,6464,6475,6477,6491,6501,6503,6507,6512,6515,6520,6525,6532,6535,6544,6551,6558,6561,6564,6575,6581,6583,6592,6599,6655,6664,6673,6691,6706,6709,6713,6726,6730,6735,6739,6760,6764,6777,6781,6784,6789,6794,6805,6807,6812,6815,6819,6825,6827,6832,6834,6840,6844,6846,6857,6861,6863,6866,6868,6873,6879,6883,6886,6889,6892,6897,6913,6919,6925,6934,6936,6948,6950,7229,7240,7245,7251,7255,7260,7278,7300,7326,7337,7340,7366,7369,7371,7377,7380,7523,7529,7532,7537,7543,7552,7556,7572,7578,7581,7608,7612,7615,7620,7623,7625,7627,7661,7663,7669,7672,7674,7681,7720,7726,7729,7735,7740,7744,7748,7751,7757,7768,7774,7777,7782,7788,7790,7793,7857,7859,7863,7866,7885,7888,7891,7895,7937,7951,7971,7975,7983,7989,8112,8114,8119,8133,8136,8139,8142,8145,8148,8150,8154,8156,8161,8180,8184,8187,8215,8217,8220,8224,8230,8234,8236,8239,8243,8254,8258,8264,8267,8280,8283,8286,8289,8297,8328,8330,8337,8341,8344,8347,8351,8353,8357,8362,8365,8368,8398,8404,8410,8413,8415,8420,8422,8426,8428,8462,8465,8467,8471,8476,8489,8496,8498,8504,8509,8514,8518,8529,8535,8539,8542,8546,8567,8569,8572,8579,8585,8595,8604,8609,8619,8632,8641,8649,8659,8662,8672,8674,8677,8682,8686,8693,8705,8711,8715,8718,8721,8724,8727,8732,8734,8740,8763,8766,8769,8827,8843,8848,8851,8859,8862,8869,8882,8886,8889,8892,8895,8907,8911,8914,8918,8922,8925,8929,8932,8948,8950,8952,8954,8964,8967,8978,8981,8984,9010,9013,9165,9170,9173,9177,9185,9191,9196,9204,9214,9217,9247,9258,9265,9268,9272,9278,9303,9307,9311,9319,9322,9326,9328,9331,9334,9342,9346,9351,9418,9422,9425,9428,9430,9433,9435,9444,9450,9606,9609,9611,9616,9623,9626,9630,9641,9645,9648,9657,9660,9665,9700,9703,9710,9717,9720,9726,9732,9734,9738,9744,9746,9792,9797,9828,9835,9837,9841,9847,9851,9858,9902,9907,9914,9922,9927,9933,9937,9940,9943,9945,9952,9955,9966,9971,9994,9998,10000))
})