| | 1 | #' Two-stage clustering, within one task (see \code{claws()}) |
| | 2 | #' |
| | 3 | #' \code{clusteringTask1()} runs one full stage-1 task, which consists in iterated |
| | 4 | #' clustering on nb_curves / ntasks energy contributions, computed through |
| | 5 | #' discrete wavelets coefficients. |
| | 6 | #' \code{clusteringTask2()} runs a full stage-2 task, which consists in WER distances |
| | 7 | #' computations between medoids (indices) output from stage 1, before applying |
| | 8 | #' the second clustering algorithm on the distances matrix. |
| | 9 | #' |
| | 10 | #' @param getContribs Function to retrieve contributions from initial series indices: |
| | 11 | #' \code{getContribs(indices)} outputs a contributions matrix, in columns |
| | 12 | #' @inheritParams claws |
| | 13 | #' @inheritParams computeSynchrones |
| | 14 | #' @inheritParams computeWerDists |
| | 15 | #' |
| | 16 | #' @return The indices of the computed (resp. K1 and K2) medoids. |
| | 17 | #' |
| | 18 | #' @name clustering |
| | 19 | #' @rdname clustering |
| | 20 | #' @aliases clusteringTask1 clusteringTask2 |
| | 21 | NULL |
| | 22 | |
| | 23 | #' @rdname clustering |
| | 24 | #' @export |
| | 25 | clusteringTask1 <- function(indices, getContribs, K1, algoClust1, nb_items_clust, |
| | 26 | ncores_clust=3, verbose=FALSE, parll=TRUE) |
| | 27 | { |
| | 28 | if (verbose) |
| | 29 | cat(paste("*** Clustering task 1 on ",length(indices)," series [start]\n", sep="")) |
| | 30 | |
| | 31 | if (length(indices) <= K1) |
| | 32 | return (indices) |
| | 33 | |
| | 34 | if (parll) |
| | 35 | { |
| | 36 | # outfile=="" to see stderr/stdout on terminal |
| | 37 | cl <- |
| | 38 | if (verbose) |
| | 39 | parallel::makeCluster(ncores_clust, outfile = "") |
| | 40 | else |
| | 41 | parallel::makeCluster(ncores_clust) |
| | 42 | parallel::clusterExport(cl, c("getContribs","K1","verbose"), envir=environment()) |
| | 43 | } |
| | 44 | # Iterate clustering algorithm 1 until K1 medoids are found |
| | 45 | while (length(indices) > K1) |
| | 46 | { |
| | 47 | # Balance tasks by splitting the indices set - as evenly as possible |
| | 48 | indices_workers <- .splitIndices(indices, nb_items_clust, min_size=K1+1) |
| | 49 | indices <- |
| | 50 | if (parll) |
| | 51 | { |
| | 52 | unlist( parallel::parLapply(cl, indices_workers, function(inds) { |
| | 53 | require("epclust", quietly=TRUE) |
| | 54 | inds[ algoClust1(getContribs(inds), K1) ] |
| | 55 | }) ) |
| | 56 | } |
| | 57 | else |
| | 58 | { |
| | 59 | unlist( lapply(indices_workers, function(inds) |
| | 60 | inds[ algoClust1(getContribs(inds), K1) ] |
| | 61 | ) ) |
| | 62 | } |
| | 63 | if (verbose) |
| | 64 | { |
| | 65 | cat(paste("*** Clustering task 1 on ",length(indices)," medoids [iter]\n", sep="")) |
| | 66 | } |
| | 67 | } |
| | 68 | if (parll) |
| | 69 | parallel::stopCluster(cl) |
| | 70 | |
| | 71 | indices #medoids |
| | 72 | } |
| | 73 | |
| | 74 | #' @rdname clustering |
| | 75 | #' @export |
| | 76 | clusteringTask2 <- function(indices, getSeries, K2, algoClust2, nb_series_per_chunk, |
| | 77 | smooth_lvl, nvoice, nbytes, endian, ncores_clust=3, verbose=FALSE, parll=TRUE) |
| | 78 | { |
| | 79 | if (verbose) |
| | 80 | cat(paste("*** Clustering task 2 on ",length(indices)," medoids\n", sep="")) |
| | 81 | |
| | 82 | if (length(indices) <= K2) |
| | 83 | return (indices) |
| | 84 | |
| | 85 | # A) Compute the WER distances (Wavelets Extended coefficient of deteRmination) |
| | 86 | distances <- computeWerDists(indices, getSeries, nb_series_per_chunk, |
| | 87 | smooth_lvl, nvoice, nbytes, endian, ncores_clust, verbose, parll) |
| | 88 | |
| | 89 | # B) Apply clustering algorithm 2 on the WER distances matrix |
| | 90 | if (verbose) |
| | 91 | cat(paste("*** algoClust2() on ",nrow(distances)," items\n", sep="")) |
| | 92 | indices[ algoClust2(distances,K2) ] |
| | 93 | } |
projects / epclust.git / blame_incremental