With sync_mean to average synchrones: bad idea, will be removed
[epclust.git] / epclust / tests / testthat / test.clustering.R
1 context("clustering")
2
3 test_that("computeSynchrones behave as expected",
4 {
5 n = 300
6 x = seq(0,9.5,0.1)
7 L = length(x) #96 1/4h
8 K = 3
9 s1 = cos(x)
10 s2 = sin(x)
11 s3 = c( s1[1:(L%/%2)] , s2[(L%/%2+1):L] )
12 #sum((s1-s2)^2) == 96
13 #sum((s1-s3)^2) == 58
14 #sum((s2-s3)^2) == 38
15 s = list(s1, s2, s3)
16 series = matrix(nrow=L, ncol=n)
17 for (i in seq_len(n))
18 series[,i] = s[[I(i,K)]] + rnorm(L,sd=0.01)
19 getRefSeries = function(indices) {
20 indices = indices[indices <= n]
21 if (length(indices)>0) series[,indices] else NULL
22 }
23 synchrones = computeSynchrones(bigmemory::as.big.matrix(cbind(s1,s2,s3)), getRefSeries,
24 n, 100, sync_mean=TRUE, verbose=TRUE, parll=FALSE)
25
26 expect_equal(dim(synchrones), c(L,K))
27 for (i in 1:K)
28 expect_equal(synchrones[,i], s[[i]], tolerance=0.01)
29 })
30
31 # Helper function to divide indices into balanced sets
32 test_that("Helper function to spread indices work properly",
33 {
34 indices <- 1:400
35
36 # bigger nb_per_set than length(indices)
37 expect_equal(epclust:::.spreadIndices(indices,500), list(indices))
38
39 # nb_per_set == length(indices)
40 expect_equal(epclust:::.spreadIndices(indices,400), list(indices))
41
42 # length(indices) %% nb_per_set == 0
43 expect_equal(epclust:::.spreadIndices(indices,200),
44 c( list(indices[1:200]), list(indices[201:400]) ))
45 expect_equal(epclust:::.spreadIndices(indices,100),
46 c( list(indices[1:100]), list(indices[101:200]),
47 list(indices[201:300]), list(indices[301:400]) ))
48
49 # length(indices) / nb_per_set == 1, length(indices) %% nb_per_set == 100
50 expect_equal(epclust:::.spreadIndices(indices,300), list(indices))
51 # length(indices) / nb_per_set == 2, length(indices) %% nb_per_set == 42
52 repartition <- epclust:::.spreadIndices(indices,179)
53 expect_equal(length(repartition), 2)
54 expect_equal(length(repartition[[1]]), 179 + 21)
55 expect_equal(length(repartition[[1]]), 179 + 21)
56 })
57
58 test_that("clusteringTask1 behave as expected",
59 {
60 n = 900
61 x = seq(0,9.5,0.1)
62 L = length(x) #96 1/4h
63 K1 = 60
64 s = lapply( seq_len(K1), function(i) x^(1+i/30)*cos(x+i) )
65 series = matrix(nrow=L, ncol=n)
66 for (i in seq_len(n))
67 series[,i] = s[[I(i,K1)]] + rnorm(L,sd=0.01)
68 getSeries = function(indices) {
69 indices = indices[indices <= n]
70 if (length(indices)>0) series[,indices] else NULL
71 }
72 wf = "haar"
73 ctype = "absolute"
74 getContribs = function(indices) curvesToContribs(series[,indices],wf,ctype)
75 require("cluster", quietly=TRUE)
76 algoClust1 = function(contribs,K) cluster::pam(t(contribs),K,diss=FALSE)$id.med
77 indices1 = clusteringTask1(1:n, getContribs, K1, algoClust1, 75, verbose=TRUE, parll=FALSE)
78 medoids_K1 = getSeries(indices1)
79
80 expect_equal(dim(medoids_K1), c(L,K1))
81 # Not easy to evaluate result: at least we expect it to be better than random selection of
82 # medoids within initial series
83 distorGood = computeDistortion(series, medoids_K1)
84 for (i in 1:3)
85 expect_lte( distorGood, computeDistortion(series,series[,sample(1:n, K1)]) )
86 })
87
88 test_that("clusteringTask2 behave as expected",
89 {
90 n = 900
91 x = seq(0,9.5,0.1)
92 L = length(x) #96 1/4h
93 K1 = 60
94 K2 = 3
95 #for (i in 1:60) {plot(x^(1+i/30)*cos(x+i),type="l",col=i,ylim=c(-50,50)); par(new=TRUE)}
96 s = lapply( seq_len(K1), function(i) x^(1+i/30)*cos(x+i) )
97 series = matrix(nrow=L, ncol=n)
98 for (i in seq_len(n))
99 series[,i] = s[[I(i,K1)]] + rnorm(L,sd=0.01)
100 getRefSeries = function(indices) {
101 indices = indices[indices <= n]
102 if (length(indices)>0) series[,indices] else NULL
103 }
104 # Artificially simulate 60 medoids - perfect situation, all equal to one of the refs
105 medoids_K1 = bigmemory::as.big.matrix( sapply( 1:K1, function(i) s[[I(i,K1)]] ) )
106 algoClust2 = function(dists,K) cluster::pam(dists,K,diss=TRUE)$id.med
107 medoids_K2 = clusteringTask2(medoids_K1, K2, algoClust2, getRefSeries,
108 n, 75, sync_mean=TRUE, verbose=TRUE, parll=FALSE)
109
110 expect_equal(dim(medoids_K2), c(L,K2))
111 # Not easy to evaluate result: at least we expect it to be better than random selection of
112 # medoids within 1...K1 (among references)
113 distorGood = computeDistortion(series, medoids_K2)
114 for (i in 1:3)
115 expect_lte( distorGood, computeDistortion(series,medoids_K1[,sample(1:K1, K2)]) )
116 })