fix typo, add some TODO
[epclust.git] / epclust / R / clustering.R
index 0d37c24..7e06c43 100644 (file)
@@ -123,23 +123,32 @@ computeSynchrones = function(medoids, getRefSeries,
        {
                ref_series = getRefSeries(indices)
                nb_series = nrow(ref_series)
-               #get medoids indices for this chunk of series
 
-               #TODO: debug this (address is OK but values are garbage: why?)
-#               mi = .Call("computeMedoidsIndices", medoids@address, ref_series, PACKAGE="epclust")
+               if (parll)
+               {
+                       require("bigmemory", quietly=TRUE)
+                       require("synchronicity", quietly=TRUE)
+                       require("epclust", quietly=TRUE)
+                       synchrones <- bigmemory::attach.big.matrix(synchrones_desc)
+                       medoids <- bigmemory::attach.big.matrix(medoids_desc)
+                       m <- synchronicity::attach.mutex(m_desc)
+               }
 
-               #R-equivalent, requiring a matrix (thus potentially breaking "fit-in-memory" hope)
-               mat_meds = medoids[,]
-               mi = rep(NA,nb_series)
-               for (i in 1:nb_series)
-                       mi[i] <- which.min( rowSums( sweep(mat_meds, 2, ref_series[i,], '-')^2 ) )
-               rm(mat_meds); gc()
+               #get medoids indices for this chunk of series
+               mi = computeMedoidsIndices(medoids@address, ref_series)
+#              #R-equivalent, requiring a matrix (thus potentially breaking "fit-in-memory" hope)
+#              mat_meds = medoids[,]
+#              mi = rep(NA,nb_series)
+#              for (i in 1:nb_series)
+#                      mi[i] <- which.min( rowSums( sweep(mat_meds, 2, ref_series[i,], '-')^2 ) )
+#              rm(mat_meds); gc()
 
                for (i in seq_len(nb_series))
                {
                        if (parll)
                                synchronicity::lock(m)
                        synchrones[mi[i],] = synchrones[mi[i],] + ref_series[i,]
+#TODO: remove counts
                        counts[mi[i],1] = counts[mi[i],1] + 1
                        if (parll)
                                synchronicity::unlock(m)
@@ -155,18 +164,19 @@ computeSynchrones = function(medoids, getRefSeries,
        parll = (requireNamespace("synchronicity",quietly=TRUE)
                && parll && Sys.info()['sysname'] != "Windows")
        if (parll)
+       {
                m <- synchronicity::boost.mutex()
+               m_desc <- synchronicity::describe(m)
+               synchrones_desc = bigmemory::describe(synchrones)
+               medoids_desc = bigmemory::describe(medoids)
 
-       if (parll)
-       {
                cl = parallel::makeCluster(ncores_clust)
                parallel::clusterExport(cl,
-                       varlist=c("synchrones","counts","verbose","medoids","getRefSeries"),
+                       varlist=c("synchrones_desc","counts","verbose","m_desc","medoids_desc","getRefSeries"),
                        envir=environment())
        }
 
        indices_workers = .spreadIndices(seq_len(nb_ref_curves), nb_series_per_chunk)
-#browser()
        ignored <-
                if (parll)
                        parallel::parLapply(cl, indices_workers, computeSynchronesChunk)
@@ -233,42 +243,55 @@ computeWerDists = function(synchrones, ncores_clust=1,verbose=FALSE,parll=TRUE)
                pairs = c(pairs, lapply(V, function(v) c(i,v)))
        }
 
-       computeCWT = function(i)
-       {
-               ts <- scale(ts(synchrones[i,]), center=TRUE, scale=scaled)
-               totts.cwt = Rwave::cwt(ts, totnoct, nvoice, w0, plot=FALSE)
-               ts.cwt = totts.cwt[,s0log:(s0log+noctave*nvoice)]
-               #Normalization
-               sqs <- sqrt(2^(0:(noctave*nvoice)/nvoice)*s0)
-               sqres <- sweep(ts.cwt,2,sqs,'*')
-               sqres / max(Mod(sqres))
-       }
-
        # Distance between rows i and j
        computeDistancesIJ = function(pair)
        {
+               if (parll)
+               {
+                       require("bigmemory", quietly=TRUE)
+                       require("epclust", quietly=TRUE)
+                       synchrones <- bigmemory::attach.big.matrix(synchrones_desc)
+                       Xwer_dist <- bigmemory::attach.big.matrix(Xwer_dist_desc)
+               }
+
+               computeCWT = function(index)
+               {
+                       ts <- scale(ts(synchrones[index,]), center=TRUE, scale=scaled)
+                       totts.cwt = Rwave::cwt(ts, totnoct, nvoice, w0, plot=FALSE)
+                       ts.cwt = totts.cwt[,s0log:(s0log+noctave*nvoice)]
+                       #Normalization
+                       sqs <- sqrt(2^(0:(noctave*nvoice)/nvoice)*s0)
+                       sqres <- sweep(ts.cwt,2,sqs,'*')
+                       sqres / max(Mod(sqres))
+               }
+#browser()
                i = pair[1] ; j = pair[2]
                if (verbose && j==i+1)
                        cat(paste("   Distances (",i,",",j,"), (",i,",",j+1,") ...\n", sep=""))
-               cwt_i = computeCWT(i)
-               cwt_j = computeCWT(j)
-               num <- .Call("filter", Mod(cwt_i * Conj(cwt_j)), PACKAGE="epclust")
-               WX  <- .Call("filter", Mod(cwt_i * Conj(cwt_i)), PACKAGE="epclust")
-               WY  <- .Call("filter", Mod(cwt_j * Conj(cwt_j)), PACKAGE="epclust")
+print(system.time( {           cwt_i <- computeCWT(i)
+               cwt_j <- computeCWT(j) } ))
+
+print(system.time( {
+               num <- epclustFilter(Mod(cwt_i * Conj(cwt_j)))
+               WX  <- epclustFilter(Mod(cwt_i * Conj(cwt_i)))
+               WY  <- epclustFilter(Mod(cwt_j * Conj(cwt_j)))
                wer2 <- sum(colSums(num)^2) / sum(colSums(WX) * colSums(WY))
-               Xwer_dist[i,j] <- sqrt(delta * ncol(cwt_i) * (1 - wer2))
+               Xwer_dist[i,j] <- sqrt(delta * ncol(cwt_i) * max(1 - wer2, 0.)) #FIXME: wer2 should be < 1
                Xwer_dist[j,i] <- Xwer_dist[i,j]
+} ) )
                Xwer_dist[i,i] = 0.
        }
 
        if (parll)
        {
                cl = parallel::makeCluster(ncores_clust)
-               parallel::clusterExport(cl,
-                       varlist=c("synchrones","totnoct","nvoice","w0","s0log","noctave","s0","verbose"),
-                       envir=environment())
-       }
+               synchrones_desc <- bigmemory::describe(synchrones)
+               Xwer_dist_desc <- bigmemory::describe(Xwer_dist)
 
+               parallel::clusterExport(cl, varlist=c("synchrones_desc","Xwer_dist_desc","totnoct",
+                       "nvoice","w0","s0log","noctave","s0","verbose"), envir=environment())
+       }
+browser()
        ignored <-
                if (parll)
                        parallel::parLapply(cl, pairs, computeDistancesIJ)
@@ -277,7 +300,7 @@ computeWerDists = function(synchrones, ncores_clust=1,verbose=FALSE,parll=TRUE)
 
        if (parll)
                parallel::stopCluster(cl)
-
+#browser()
        Xwer_dist[n,n] = 0.
        distances <- Xwer_dist[,]
        rm(Xwer_dist) ; gc()