'update'
[epclust.git] / pkg / R / computeSynchrones.R
CommitLineData
b7cd987d
BA
1#' computeSynchrones
2#'
3#' Compute the synchrones curves (sums of clusters elements) from a matrix of medoids,
4#' using euclidian distance.
5#'
6#' @param medoids matrix of K medoids curves in columns
7#' @param nb_curves How many series? (this is known, at this stage)
8#' @inheritParams claws
9#' @inheritParams computeWerDists
10#'
11#' @return A matrix of K synchrones in columns (same length as the series)
12#'
13#' @export
14computeSynchrones <- function(medoids, getSeries, nb_curves,
15 nb_series_per_chunk, ncores=3, verbose=FALSE)
16{
17 # Synchrones computation is embarassingly parallel: compute it by chunks of series
18 computeSynchronesChunk <- function(indices)
19 {
20 # Obtain a chunk of reference series
21 series_chunk <- getSeries(indices)
22 nb_series_chunk <- ncol(series_chunk)
23
24 # Get medoids indices for this chunk of series
25 mi <- assignMedoids(series_chunk, medoids[,])
26
27 # Update synchrones using mi above, grouping it by values of mi (in 1...K)
28 # to avoid too many lock/unlock
29 for (i in seq_len(K))
30 {
31 # lock / unlock required because several writes at the same time
32 if (parll)
33 synchronicity::lock(m)
34 synchrones[,i] <- synchrones[,i] + rowSums(as.matrix(series_chunk[,mi==i]))
35 if (parll)
36 synchronicity::unlock(m)
37 }
38 NULL
39 }
40
41 K <- ncol(medoids)
42 L <- nrow(medoids)
43 # Use bigmemory (shared==TRUE by default) + synchronicity to fill synchrones in //
44 synchrones <- bigmemory::big.matrix(nrow=L, ncol=K, type="double", init=0.)
45 # NOTE: synchronicity is only for Linux & MacOS; on Windows: run sequentially
46 parll <- (ncores > 1 && requireNamespace("synchronicity",quietly=TRUE)
47 && Sys.info()['sysname'] != "Windows")
48
49 if (parll)
50 m <- synchronicity::boost.mutex() #for lock/unlock, see computeSynchronesChunk
51
52 if (verbose)
53 cat(paste("--- Compute ",K," synchrones with ",nb_curves," series\n", sep=""))
54
55 # Balance tasks by splitting 1:nb_curves into groups of size <= nb_series_per_chunk
56 indices_workers <- .splitIndices(seq_len(nb_curves), nb_series_per_chunk)
57 ignored <-
58 if (parll)
59 {
60 parallel::mclapply(indices_workers,
61 function(inds) computeSynchronesChunk(inds), mc.cores=ncores)
62 }
63 else
64 lapply(indices_workers, computeSynchronesChunk)
65
66 return (synchrones[,])
67}