X-Git-Url: https://git.auder.net/game/%22%20%20%20data.gameInfo.gameId%20%20%20%22?a=blobdiff_plain;f=epclust%2FR%2Fclustering.R;h=87a5f914e137cb3f509443b58a1e59b80505b011;hb=3eef8d3df59ded9a281cff51f79fe824198a7427;hp=6090517c6b6464d4c253ba52b8efdf29cb56c823;hpb=0e2dce80a3fddaca50c96c6c27a8b32468095d6c;p=epclust.git diff --git a/epclust/R/clustering.R b/epclust/R/clustering.R index 6090517..87a5f91 100644 --- a/epclust/R/clustering.R +++ b/epclust/R/clustering.R @@ -1,57 +1,76 @@ # Cluster one full task (nb_curves / ntasks series) -clusteringTask = function(indices, ncores) +clusteringTask = function(indices,getSeries,getSeriesForSynchrones,synchrones_file, + getCoefs,K1,K2,nb_series_per_chunk,ncores,to_file,ftype) { cl = parallel::makeCluster(ncores) - parallel::clusterExport(cl, - varlist=c("K1","getCoefs"), - envir=environment()) repeat { - nb_workers = max( 1, round( length(indices_clust) / nb_series_per_chunk ) ) + nb_workers = max( 1, round( length(indices) / nb_series_per_chunk ) ) indices_workers = lapply(seq_len(nb_workers), function(i) { upper_bound = ifelse( i 0) + curves = computeSynchrones(indices, getSeries, getSeriesForSynchrones, nb_series_per_chunk) + dists = computeWerDists(curves) + medoids = cluster::pam(dists, K2, diss=TRUE)$medoids + if (to_file) { - curves = computeSynchrones(indices) - dists = computeWerDists(curves) - indices = computeClusters(dists, K2, diss=TRUE) + serialize(medoids, synchrones_file, ftype, nb_series_per_chunk) + return (NULL) } - if (to_file) - #write results to file (JUST series ; no possible ID here) + medoids } # Compute the synchrones curves (sum of clusters elements) from a clustering result -computeSynchrones = function(inds) - sapply(seq_along(inds), colMeans(getSeries(inds[[i]]$indices,inds[[i]]$ids))) +computeSynchrones = function(indices, getSeries, getSeriesForSynchrones, nb_series_per_chunk) +{ + #les getSeries(indices) sont les medoides --> init vect nul pour chacun, puis incr avec les + #courbes (getSeriesForSynchrones) les plus proches... --> au sens de la norme L2 ? + medoids = getSeries(indices) + K = nrow(medoids) + synchrones = matrix(0, nrow=K, ncol=ncol(medoids)) + counts = rep(0,K) + index = 1 + repeat + { + series = getSeriesForSynchrones((index-1)+seq_len(nb_series_per_chunk)) + if (is.null(series)) + break + #get medoids indices for this chunk of series + index = which.min( rowSums( sweep(medoids, 2, series[i,], '-')^2 ) ) + synchrones[index,] = synchrones[index,] + series[i,] + counts[index] = counts[index] + 1 + } + #NOTE: odds for some clusters to be empty? (when series already come from stage 2) + synchrones = sweep(synchrones, 1, counts, '/') +} -# Compute the WER distance between the synchrones curves (in columns) +# Compute the WER distance between the synchrones curves (in rows) computeWerDist = function(curves) { if (!require("Rwave", quietly=TRUE)) @@ -74,7 +93,7 @@ computeWerDist = function(curves) # (normalized) observations node with CWT Xcwt4 <- lapply(seq_len(n), function(i) { - ts <- scale(ts(curves[,i]), center=TRUE, scale=scaled) + ts <- scale(ts(curves[i,]), center=TRUE, scale=scaled) totts.cwt = Rwave::cwt(ts,totnoct,nvoice,w0,plot=0) ts.cwt = totts.cwt[,s0log:(s0log+noctave*nvoice)] #Normalization