3 #shorthand: map 1->1, 2->2, 3->3, 4->1, ..., 149->2, 150->3, ... (is base==3)
7 test_that("computeClusters1&2 behave as expected",
9 require("MASS", quietly=TRUE)
10 if (!require("clue", quietly=TRUE))
11 skip("'clue' package not available")
13 # 3 gaussian clusters, 300 items; and then 7 gaussian clusters, 490 items
17 for (ndK in list( c(300,5,3), c(490,10,7) ))
19 n = ndK[1] ; d = ndK[2] ; K = ndK[3]
20 cs = n/K #cluster size
22 coefs = sapply(1:K, function(i) MASS::mvrnorm(cs, c(rep(0,(i-1)),5,rep(0,d-i)), Id))
23 indices_medoids1 = computeClusters1(coefs, K, verbose=TRUE)
24 indices_medoids2 = computeClusters2(dist(coefs), K, verbose=TRUE)
25 # Get coefs assignments (to medoids)
26 assignment1 = sapply(seq_len(n), function(i)
27 which.min( colSums( sweep(coefs[,indices_medoids1],1,coefs[,i],'-')^2 ) ) )
28 assignment2 = sapply(seq_len(n), function(i)
29 which.min( colSums( sweep(coefs[,indices_medoids2],1,coefs[,i],'-')^2 ) ) )
32 expect_equal(sum(assignment1==i), cs, tolerance=5)
33 expect_equal(sum(assignment2==i), cs, tolerance=5)
36 costs_matrix1 = matrix(nrow=K,ncol=K)
37 costs_matrix2 = matrix(nrow=K,ncol=K)
42 # assign i (in result) to j (order 1,2,3)
43 costs_matrix1[i,j] = abs( mean(assignment1[((i-1)*cs+1):(i*cs)]) - j )
44 costs_matrix2[i,j] = abs( mean(assignment2[((i-1)*cs+1):(i*cs)]) - j )
47 permutation1 = as.integer( clue::solve_LSAP(costs_matrix1) )
48 permutation2 = as.integer( clue::solve_LSAP(costs_matrix2) )
52 mean(assignment1[((i-1)*cs+1):(i*cs)]), permutation1[i], tolerance=0.05)
54 mean(assignment2[((i-1)*cs+1):(i*cs)]), permutation2[i], tolerance=0.05)
59 test_that("computeSynchrones behave as expected",
63 L = length(x) #96 1/4h
67 s3 = c( s1[1:(L%/%2)] , s2[(L%/%2+1):L] )
72 series = matrix(nrow=L, ncol=n)
74 series[,i] = s[[I(i,K)]] + rnorm(L,sd=0.01)
75 getRefSeries = function(indices) {
76 indices = indices[indices <= n]
77 if (length(indices)>0) series[,indices] else NULL
79 synchrones = computeSynchrones(bigmemory::as.big.matrix(cbind(s1,s2,s3)), getRefSeries,
80 n, 100, verbose=TRUE, parll=FALSE)
82 expect_equal(dim(synchrones), c(L,K))
84 expect_equal(synchrones[,i], s[[i]], tolerance=0.01)
87 # NOTE: medoids can be a big.matrix
88 computeDistortion = function(series, medoids)
90 n = nrow(series) ; L = ncol(series)
92 if (bigmemory::is.big.matrix(medoids))
95 distortion = distortion + min( colSums( sweep(medoids,1,series[,i],'-')^2 ) / L )
99 test_that("clusteringTask1 behave as expected",
103 L = length(x) #96 1/4h
105 s = lapply( seq_len(K1), function(i) x^(1+i/30)*cos(x+i) )
106 series = matrix(nrow=n, ncol=L)
107 for (i in seq_len(n))
108 series[,i] = s[[I(i,K1)]] + rnorm(L,sd=0.01)
109 getSeries = function(indices) {
110 indices = indices[indices <= n]
111 if (length(indices)>0) series[,indices] else NULL
115 getContribs = function(indices) curvesToContribs(series[,indices],wf,ctype)
116 indices1 = clusteringTask1(1:n, getContribs, K1, 75, verbose=TRUE, parll=FALSE)
117 medoids_K1 = getSeries(indices1)
119 expect_equal(dim(medoids_K1), c(L,K1))
120 # Not easy to evaluate result: at least we expect it to be better than random selection of
121 # medoids within initial series
122 distorGood = computeDistortion(series, medoids_K1)
124 expect_lte( distorGood, computeDistortion(series,series[,sample(1:n, K1)]) )
127 test_that("clusteringTask2 behave as expected",
131 L = length(x) #96 1/4h
134 #for (i in 1:60) {plot(x^(1+i/30)*cos(x+i),type="l",col=i,ylim=c(-50,50)); par(new=TRUE)}
135 s = lapply( seq_len(K1), function(i) x^(1+i/30)*cos(x+i) )
136 series = matrix(nrow=n, ncol=L)
137 for (i in seq_len(n))
138 series[i,] = s[[I(i,K1)]] + rnorm(L,sd=0.01)
139 getRefSeries = function(indices) {
140 indices = indices[indices <= n]
141 if (length(indices)>0) series[,indices] else NULL
143 # Artificially simulate 60 medoids - perfect situation, all equal to one of the refs
144 medoids_K1 = bigmemory::as.big.matrix( sapply( 1:K1, function(i) s[[I(i,K1)]] ) )
145 medoids_K2 = clusteringTask2(medoids_K1, K2, getRefSeries, n, 75, verbose=TRUE, parll=FALSE)
147 expect_equal(dim(medoids_K2), c(L,K2))
148 # Not easy to evaluate result: at least we expect it to be better than random selection of
149 # medoids within 1...K1 (among references)
150 distorGood = computeDistortion(series, medoids_K2)
152 expect_lte( distorGood, computeDistortion(series,medoids_K1[,sample(1:K1, K2)]) )
155 #NOTE: rather redundant test
156 #test_that("clusteringTask1 + clusteringTask2 behave as expected",
160 # L = length(x) #96 1/4h
163 # s = lapply( seq_len(K1), function(i) x^(1+i/30)*cos(x+i) )
164 # series = matrix(nrow=n, ncol=L)
165 # for (i in seq_len(n))
166 # series[i,] = s[[I(i,K1)]] + rnorm(L,sd=0.01)
167 # getSeries = function(indices) {
168 # indices = indices[indices <= n]
169 # if (length(indices)>0) series[indices,] else NULL
173 # getContribs = function(indices) curvesToContribs(series[indices,],wf,ctype)
174 # require("bigmemory", quietly=TRUE)
175 # indices1 = clusteringTask1(1:n, getContribs, K1, 75, verbose=TRUE, parll=FALSE)
176 # medoids_K1 = bigmemory::as.big.matrix( getSeries(indices1) )
177 # medoids_K2 = clusteringTask2(medoids_K1, K2, getSeries, n, 120, verbose=TRUE, parll=FALSE)
179 # expect_equal(dim(medoids_K1), c(K1,L))
180 # expect_equal(dim(medoids_K2), c(K2,L))
181 # # Not easy to evaluate result: at least we expect it to be better than random selection of
182 # # medoids within 1...K1 (among references)
183 # distorGood = computeDistortion(series, medoids_K2)
185 # expect_lte( distorGood, computeDistortion(series,medoids_K1[sample(1:K1, K2),]) )