Forgot the test-examples. Modified to work with default method PELT.

rkillick · Oct 13, 2024 · e81735f · e81735f
1 parent e05e5c4
commit e81735f
Showing 1 changed file with 16 additions and 14 deletions.
diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R
@@ -32,7 +32,7 @@ x=c(rnorm(100,0,1),rnorm(100,10,1))
 test_that('mean2',expect_equivalent(cpt.mean(x,penalty="SIC",method="AMOC",class=FALSE),c(100,1)))
 ans=cpt.mean(x,penalty="Asymptotic",pen.value=0.01,method="AMOC")
 test_that('mean3',expect_equal(cpts(ans),100))
-ans=cpt.mean(x,penalty="Manual",pen.value=0.8,method="AMOC",test.stat="CUSUM")
+ans=suppressWarnings(cpt.mean(x,penalty="Manual",pen.value=0.8,method="AMOC",test.stat="CUSUM"))
 test_that('mean4',expect_equivalent(cpts(ans),101))
 
 # Example of multiple changes in mean at 50,100,150 in simulated normal data
@@ -57,8 +57,8 @@ set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,5,1),rnorm(50,10,1),rnorm(50,3,1))
 y=rnorm(200,0,1)
 z=rbind(x,y)
-test_that('mean6',expect_equal(cpt.mean(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE),list(c(50,100,150,200),200)))
-ans=cpt.mean(z,penalty="Asymptotic",pen.value=0.01,method="PELT")
+test_that('mean6',expect_equal(suppressWarnings(cpt.mean(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE)),list(c(50,100,150,200),200)))
+ans=suppressWarnings(cpt.mean(z,penalty="Asymptotic",pen.value=0.01,method="PELT"))
 test_that('mean7',expect_equal(cpts(ans[[1]]),c(50,100,150)))
 test_that('mean8',expect_equal(cpts(ans[[2]]),numeric()))
 
@@ -98,8 +98,8 @@ set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,5,3),rnorm(50,10,1),rnorm(50,3,10))
 y=rnorm(200,0,1)
 z=rbind(x,y)
-test_that('meanvar5',expect_equivalent(cpt.meanvar(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE),list(c(50,100,150,200),200)))
-ans=cpt.meanvar(z,penalty="Asymptotic",pen.value=0.01,method="PELT")
+test_that('meanvar5',expect_equivalent(suppressWarnings(cpt.meanvar(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE)),list(c(50,100,150,200),200)))
+ans=suppressWarnings(cpt.meanvar(z,penalty="Asymptotic",pen.value=0.01,method="PELT"))
 test_that('meanvar6',expect_equivalent(cpts(ans[[1]]),c(50,100,150)))
 test_that('meanvar7',expect_equivalent(cpts(ans[[2]]),numeric()))
 
@@ -120,7 +120,7 @@ test_that('class2',expect_equivalent(cpts(x),c(10,50,100)))
 set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,0,10),rnorm(50,0,5),rnorm(50,0,1))
 out=cpt.var(x,pen.value=c(log(length(x)),10*log(length(x))),penalty="CROPS",method="PELT")
-test_that('class3',expect_equivalent(logLik(out,ncpts=3),c(925.8085, 947.0578))) # raw likelihood of the data with changepoints, second value is likelihood + penalty
+test_that('class3',expect_equivalent(suppressWarnings(logLik(out,ncpts=3)),c(925.8085, 947.0578))) # raw likelihood of the data with changepoints, second value is likelihood + penalty
 
 
 
@@ -138,7 +138,7 @@ beta1 <- rep(c(1,-1,0,0.25),each=50)
 y <- beta0 + beta1*x + rnorm(200)
 data <- cbind(y,1,x)
 
-out <- cpt.reg(data, method="PELT", minseglen=5, penalty="MBIC", dist="Normal")
+out <- cpt.reg(data, method="PELT", minseglen=5, penalty="MBIC", test.stat="Normal")
 test_that('reg1',expect_equivalent(cpts(out),c(49,100,150)))
 test_that('reg2',expect_equivalent(param.est(out)$beta[,2],c(0.99733936, -1.00644514, -0.01908214,  0.24806270)))
 
@@ -148,11 +148,12 @@ indicator=rep(1,n)
 trend=1:n
 seasonal=cos(2*pi*(1:n -6)/12) # yearly, peak in summer
 cpt.s = c(rep(0,floor(n/4)), rep(2, floor(n/4)), rep(1, floor(n/4)),rep(0,n-3*floor(n/4))) ##3 Alternating Cpts
+set.seed(1)
 y=0.1*cpt.s*1:n+cos(2*pi*(1:n -6)/12)+rnorm(n)
 data=cbind(y,indicator,trend,seasonal)
 out=cpt.reg(data, minseglen=12)
 test_that('reg3',expect_equivalent(cpts(out),c(25,50,75)))
-test_that('reg4',expect_equivalent(param.est(out)$beta[,2],c(-0.020344840,  0.196045790,  0.079573915, -0.005274402)))
+test_that('reg4',expect_equivalent(param.est(out)$beta[,2],c(0.010887760,  0.231984788,  0.070686805, -0.002967858)))
 
 
 
@@ -184,8 +185,8 @@ test_that('var3',expect_equivalent(cpts(ans),100))
 # Example of multiple changes in variance at 50,100,150 in simulated data
 set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,0,10),rnorm(50,0,5),rnorm(50,0,1))
-out=cpt.var(x,penalty="Manual",pen.value="log(2*log(n))",method="BinSeg",test.stat="CSS",Q=5,
-            class=FALSE)
+out=suppressWarnings(cpt.var(x,penalty="Manual",pen.value="log(2*log(n))",method="BinSeg",test.stat="CSS",Q=5,
+            class=FALSE))
 truth=list();truth$cps=matrix(c(99,53,150,50,140,3.156304,3.156304,3.156304,3.074743,1.254542),byrow=T,nrow=2)
 truth$cpts=c(50,53,99,150,200);truth$op.cpts=4;truth$pen=2.360536
 test_that('var4',expect_equal(out,truth,tolerance=0.00001))
@@ -207,8 +208,8 @@ x=c(rnorm(50,0,1),rnorm(50,0,10),rnorm(50,0,5),rnorm(50,0,1))
 y=rnorm(200,0,1)
 z=rbind(x,y)
 truth=list();truth[[1]]=c(50,100,149,200);truth[[2]]=200
-test_that('var7',expect_equivalent(cpt.var(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE),truth))
-ans=cpt.var(z,penalty="Asymptotic",pen.value=0.01,method="PELT")
+test_that('var7',expect_equivalent(suppressWarnings(cpt.var(z,penalty="Asymptotic",pen.value=0.01,method="SegNeigh",Q=5,class=FALSE)),truth))
+ans=suppressWarnings(cpt.var(z,penalty="Asymptotic",pen.value=0.01,method="PELT"))
 test_that('var8',expect_equivalent(cpts(ans[[1]]),c(50,100,149)))
 test_that('var9',expect_equivalent(cpts(ans[[2]]),numeric()))
 
@@ -334,7 +335,7 @@ test_that('class23',expect_equivalent(distribution(x),"normal"))
 set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,0,10),rnorm(50,0,5),rnorm(50,0,1))
 out=cpt.var(x,penalty="Manual",pen.value="2*log(n)",method="BinSeg",Q=5)
-test_that('logLik1',expect_equivalent(likelihood(out),c(925.8085, 957.5984)))
+test_that('logLik1',expect_equivalent(suppressWarnings(likelihood(out)),c(925.8085, 957.5984)))
 
 
 
@@ -344,7 +345,7 @@ test_that('logLik1',expect_equivalent(likelihood(out),c(925.8085, 957.5984)))
 set.seed(1)
 x=c(rnorm(50,0,1),rnorm(50,0,10),rnorm(50,0,5),rnorm(50,0,1))
 out=cpt.var(x,penalty="Manual",pen.value="2*log(n)",method="BinSeg",Q=5)
-test_that('logLik1',expect_equivalent(logLik(out),c(925.8085, 957.5984)))
+test_that('logLik1',expect_equivalent(suppressWarnings(logLik(out)),c(925.8085, 957.5984)))
 
 
 
@@ -516,3 +517,4 @@ test_that('class42',expect_equivalent(test.stat(x),character()))
 x=new("cpt") # new cpt object
 test.stat(x)<-"normal" # replaces the current test.stat slot of x with "normal"
 test_that('class43',expect_equivalent(test.stat(x),"normal"))
+