Fix package, ok for R CMD check - ongoing debug for main function
[epclust.git] / epclust / R / main.R
CommitLineData
8702eb86 1#' CLAWS: CLustering with wAvelets and Wer distanceS
7f0781b7 2#'
56857861 3#' Groups electricity power curves (or any series of similar nature) by applying PAM
8702eb86
BA
4#' algorithm in parallel to chunks of size \code{nb_series_per_chunk}. Input series
5#' must be sampled on the same time grid, no missing values.
7f0781b7 6#'
8702eb86
BA
7#' @param getSeries Access to the (time-)series, which can be of one of the three
8#' following types:
9#' \itemize{
10#' \item matrix: each line contains all the values for one time-serie, ordered by time
11#' \item connection: any R connection object (e.g. a file) providing lines as described above
12#' \item function: a custom way to retrieve the curves; it has only one argument:
13#' the indices of the series to be retrieved. See examples
14#' }
4bcfdbee 15#' @inheritParams clustering
1c6f223e
BA
16#' @param K1 Number of super-consumers to be found after stage 1 (K1 << N)
17#' @param K2 Number of clusters to be found after stage 2 (K2 << K1)
4bcfdbee
BA
18#' @param wf Wavelet transform filter; see ?wavelets::wt.filter
19#' @param ctype Type of contribution: "relative" or "absolute" (or any prefix)
8702eb86
BA
20#' @param WER "end" to apply stage 2 after stage 1 has fully iterated, or "mix" to apply stage 2
21#' at the end of each task
4bcfdbee 22#' @param random TRUE (default) for random chunks repartition
1c6f223e
BA
23#' @param ntasks Number of tasks (parallel iterations to obtain K1 medoids); default: 1.
24#' Note: ntasks << N, so that N is "roughly divisible" by N (number of series)
5c652979
BA
25#' @param ncores_tasks "MPI" number of parallel tasks (1 to disable: sequential tasks)
26#' @param ncores_clust "OpenMP" number of parallel clusterings in one task
8702eb86
BA
27#' @param nb_series_per_chunk (~Maximum) number of series in each group, inside a task
28#' @param min_series_per_chunk Minimum number of series in each group
4bcfdbee 29#' @param sep Separator in CSV input file (if any provided)
8702eb86
BA
30#' @param nbytes Number of bytes to serialize a floating-point number; 4 or 8
31#' @param endian Endianness to use for (de)serialization. Use "little" or "big" for portability
4bcfdbee 32#' @param verbose Level of verbosity (0/FALSE for nothing or 1/TRUE for all; devel stage)
7f0781b7 33#'
4efef8cc 34#' @return A matrix of the final medoids curves (K2) in rows
1c6f223e
BA
35#'
36#' @examples
4efef8cc
BA
37#' \dontrun{
38#' # WER distances computations are a bit too long for CRAN (for now)
39#'
40#' # Random series around cos(x,2x,3x)/sin(x,2x,3x)
41#' x = seq(0,500,0.05)
42#' L = length(x) #10001
43#' ref_series = matrix( c(cos(x), cos(2*x), cos(3*x), sin(x), sin(2*x), sin(3*x)),
4bcfdbee 44#' byrow=TRUE, ncol=L )
4efef8cc
BA
45#' library(wmtsa)
46#' series = do.call( rbind, lapply( 1:6, function(i)
47#' do.call(rbind, wmtsa::wavBootstrap(ref_series[i,], n.realization=400)) ) )
48#' #dim(series) #c(2400,10001)
4bcfdbee 49#' medoids_ascii = claws(series, K1=60, K2=6, "d8", "rel", nb_series_per_chunk=500)
4efef8cc
BA
50#'
51#' # Same example, from CSV file
52#' csv_file = "/tmp/epclust_series.csv"
53#' write.table(series, csv_file, sep=",", row.names=FALSE, col.names=FALSE)
4bcfdbee 54#' medoids_csv = claws(csv_file, K1=60, K2=6, "d8", "rel", nb_series_per_chunk=500)
4efef8cc
BA
55#'
56#' # Same example, from binary file
57#' bin_file = "/tmp/epclust_series.bin"
58#' nbytes = 8
59#' endian = "little"
4bcfdbee 60#' epclust::binarize(csv_file, bin_file, 500, nbytes, endian)
4efef8cc 61#' getSeries = function(indices) getDataInFile(indices, bin_file, nbytes, endian)
4bcfdbee 62#' medoids_bin = claws(getSeries, K1=60, K2=6, "d8", "rel", nb_series_per_chunk=500)
4efef8cc
BA
63#' unlink(csv_file)
64#' unlink(bin_file)
65#'
66#' # Same example, from SQLite database
67#' library(DBI)
68#' series_db <- dbConnect(RSQLite::SQLite(), "file::memory:")
69#' # Prepare data.frame in DB-format
70#' n = nrow(series)
4bcfdbee
BA
71#' time_values = data.frame(
72#' id = rep(1:n,each=L),
73#' time = rep( as.POSIXct(1800*(0:n),"GMT",origin="2001-01-01"), L ),
74#' value = as.double(t(series)) )
4efef8cc 75#' dbWriteTable(series_db, "times_values", times_values)
4bcfdbee
BA
76#' # Fill associative array, map index to identifier
77#' indexToID_inDB <- as.character(
78#' dbGetQuery(series_db, 'SELECT DISTINCT id FROM time_values')[,"id"] )
4efef8cc 79#' getSeries = function(indices) {
4bcfdbee
BA
80#' request = "SELECT id,value FROM times_values WHERE id in ("
81#' for (i in indices)
82#' request = paste(request, i, ",", sep="")
83#' request = paste(request, ")", sep="")
84#' df_series = dbGetQuery(series_db, request)
85#' # Assume that all series share same length at this stage
86#' ts_length = sum(df_series[,"id"] == df_series[1,"id"])
87#' t( as.matrix(df_series[,"value"], nrow=ts_length) )
4efef8cc 88#' }
4bcfdbee
BA
89#' medoids_db = claws(getSeries, K1=60, K2=6, "d8", "rel", nb_series_per_chunk=500)
90#' dbDisconnect(series_db)
91#'
92#' # All computed medoids should be the same:
93#' digest::sha1(medoids_ascii)
94#' digest::sha1(medoids_csv)
95#' digest::sha1(medoids_bin)
96#' digest::sha1(medoids_db)
1c6f223e 97#' }
1c6f223e 98#' @export
56857861 99claws = function(getSeries, K1, K2,
4bcfdbee 100 wf,ctype, #stage 1
56857861 101 WER="end", #stage 2
4bcfdbee 102 random=TRUE, #randomize series order?
56857861
BA
103 ntasks=1, ncores_tasks=1, ncores_clust=4, #control parallelism
104 nb_series_per_chunk=50*K1, min_series_per_chunk=5*K1, #chunk size
105 sep=",", #ASCII input separator
4bcfdbee
BA
106 nbytes=4, endian=.Platform$endian, #serialization (write,read)
107 verbose=FALSE)
ac1d4231 108{
0e2dce80 109 # Check/transform arguments
56857861 110 if (!is.matrix(getSeries) && !is.function(getSeries) &&
4bcfdbee 111 !methods::is(getSeries, "connection" && !is.character(getSeries)))
0e2dce80 112 {
56857861 113 stop("'getSeries': matrix, function, file or valid connection (no NA)")
5c652979 114 }
56857861
BA
115 K1 = .toInteger(K1, function(x) x>=2)
116 K2 = .toInteger(K2, function(x) x>=2)
117 if (!is.logical(random))
118 stop("'random': logical")
119 tryCatch(
4bcfdbee 120 {ignored <- wavelets::wt.filter(wf)},
56857861 121 error = function(e) stop("Invalid wavelet filter; see ?wavelets::wt.filter"))
7f0781b7
BA
122 if (WER!="end" && WER!="mix")
123 stop("WER takes values in {'end','mix'}")
56857861
BA
124 ntasks = .toInteger(ntasks, function(x) x>=1)
125 ncores_tasks = .toInteger(ncores_tasks, function(x) x>=1)
126 ncores_clust = .toInteger(ncores_clust, function(x) x>=1)
127 nb_series_per_chunk = .toInteger(nb_series_per_chunk, function(x) x>=K1)
128 min_series_per_chunk = .toInteger(K1, function(x) x>=K1 && x<=nb_series_per_chunk)
129 if (!is.character(sep))
130 stop("'sep': character")
131 nbytes = .toInteger(nbytes, function(x) x==4 || x==8)
132
133 # Serialize series if required, to always use a function
4bcfdbee 134 bin_dir = ".epclust.bin/"
56857861
BA
135 dir.create(bin_dir, showWarnings=FALSE, mode="0755")
136 if (!is.function(getSeries))
137 {
4bcfdbee
BA
138 if (verbose)
139 cat("...Serialize time-series\n")
56857861 140 series_file = paste(bin_dir,"data",sep="") ; unlink(series_file)
4bcfdbee
BA
141 binarize(getSeries, series_file, nb_series_per_chunk, sep, nbytes, endian)
142 getSeries = function(inds) getDataInFile(inds, series_file, nbytes, endian)
56857861 143 }
ac1d4231 144
4bcfdbee
BA
145 # Serialize all computed wavelets contributions onto a file
146 contribs_file = paste(bin_dir,"contribs",sep="") ; unlink(contribs_file)
7f0781b7 147 index = 1
cea14f3a 148 nb_curves = 0
4bcfdbee
BA
149 if (verbose)
150 cat("...Compute contributions and serialize them\n")
6ecf5c2d 151 repeat
ac1d4231 152 {
0e2dce80
BA
153 series = getSeries((index-1)+seq_len(nb_series_per_chunk))
154 if (is.null(series))
cea14f3a 155 break
4bcfdbee
BA
156 contribs_chunk = curvesToContribs(series, wf, ctype)
157 binarize(contribs_chunk, contribs_file, nb_series_per_chunk, sep, nbytes, endian)
cea14f3a 158 index = index + nb_series_per_chunk
4bcfdbee 159 nb_curves = nb_curves + nrow(contribs_chunk)
8e6accca 160 }
4bcfdbee 161 getContribs = function(indices) getDataInFile(indices, contribs_file, nbytes, endian)
8e6accca 162
5c652979
BA
163 if (nb_curves < min_series_per_chunk)
164 stop("Not enough data: less rows than min_series_per_chunk!")
165 nb_series_per_task = round(nb_curves / ntasks)
166 if (nb_series_per_task < min_series_per_chunk)
167 stop("Too many tasks: less series in one task than min_series_per_chunk!")
ac1d4231 168
4bcfdbee 169 # Cluster contributions in parallel (by nb_series_per_chunk)
56857861 170 indices_all = if (random) sample(nb_curves) else seq_len(nb_curves)
48108c39 171 indices_tasks = lapply(seq_len(ntasks), function(i) {
5c652979 172 upper_bound = ifelse( i<ntasks, min(nb_series_per_task*i,nb_curves), nb_curves )
56857861 173 indices_all[((i-1)*nb_series_per_task+1):upper_bound]
48108c39 174 })
4bcfdbee
BA
175 if (verbose)
176 cat(paste("...Run ",ntasks," x stage 1 in parallel\n",sep=""))
177# cl = parallel::makeCluster(ncores_tasks)
178# parallel::clusterExport(cl, varlist=c("getSeries","getContribs","K1","K2",
179# "nb_series_per_chunk","ncores_clust","synchrones_file","sep","nbytes","endian"),
180# envir = environment())
56857861 181 # 1000*K1 indices [if WER=="end"], or empty vector [if WER=="mix"] --> series on file
4bcfdbee
BA
182# indices = unlist( parallel::parLapply(cl, indices_tasks, function(inds) {
183 indices = unlist( lapply(indices_tasks, function(inds) {
184# require("epclust", quietly=TRUE)
185
186 browser() #TODO: CONTINUE DEBUG HERE
187
188 indices_medoids = clusteringTask(inds,getContribs,K1,nb_series_per_chunk,ncores_clust)
56857861
BA
189 if (WER=="mix")
190 {
191 medoids2 = computeClusters2(
192 getSeries(indices_medoids), K2, getSeries, nb_series_per_chunk)
4bcfdbee 193 binarize(medoids2, synchrones_file, nb_series_per_chunk, sep, nbytes, endian)
56857861
BA
194 return (vector("integer",0))
195 }
196 indices_medoids
e205f218 197 }) )
4bcfdbee 198# parallel::stopCluster(cl)
3465b246 199
8702eb86 200 getRefSeries = getSeries
56857861 201 synchrones_file = paste(bin_dir,"synchrones",sep="") ; unlink(synchrones_file)
e205f218
BA
202 if (WER=="mix")
203 {
204 indices = seq_len(ntasks*K2)
205 #Now series must be retrieved from synchrones_file
56857861 206 getSeries = function(inds) getDataInFile(inds, synchrones_file, nbytes, endian)
4bcfdbee
BA
207 #Contributions must be re-computed
208 unlink(contribs_file)
e205f218 209 index = 1
4bcfdbee
BA
210 if (verbose)
211 cat("...Serialize contributions computed on synchrones\n")
e205f218
BA
212 repeat
213 {
214 series = getSeries((index-1)+seq_len(nb_series_per_chunk))
215 if (is.null(series))
216 break
4bcfdbee
BA
217 contribs_chunk = curvesToContribs(series, wf, ctype)
218 binarize(contribs_chunk, contribs_file, nb_series_per_chunk, sep, nbytes, endian)
e205f218
BA
219 index = index + nb_series_per_chunk
220 }
221 }
0e2dce80
BA
222
223 # Run step2 on resulting indices or series (from file)
4bcfdbee
BA
224 if (verbose)
225 cat("...Run final // stage 1 + stage 2\n")
56857861 226 indices_medoids = clusteringTask(
4bcfdbee
BA
227 indices, getContribs, K1, nb_series_per_chunk, ncores_tasks*ncores_clust)
228 medoids = computeClusters2(getSeries(indices_medoids),K2,getRefSeries,nb_series_per_chunk)
229
230 # Cleanup
231 unlink(bin_dir, recursive=TRUE)
232
233 medoids
56857861
BA
234}
235
4bcfdbee
BA
236#' curvesToContribs
237#'
238#' Compute the discrete wavelet coefficients for each series, and aggregate them in
239#' energy contribution across scales as described in https://arxiv.org/abs/1101.4744v2
240#'
241#' @param series Matrix of series (in rows), of size n x L
242#' @inheritParams claws
243#'
244#' @return A matrix of size n x log(L) containing contributions in rows
245#'
246#' @export
247curvesToContribs = function(series, wf, ctype)
56857861
BA
248{
249 L = length(series[1,])
250 D = ceiling( log2(L) )
251 nb_sample_points = 2^D
4bcfdbee
BA
252 cont_types = c("relative","absolute")
253 ctype = cont_types[ pmatch(ctype,cont_types) ]
8702eb86 254 t( apply(series, 1, function(x) {
56857861
BA
255 interpolated_curve = spline(1:L, x, n=nb_sample_points)$y
256 W = wavelets::dwt(interpolated_curve, filter=wf, D)@W
4bcfdbee
BA
257 nrj = rev( sapply( W, function(v) ( sqrt( sum(v^2) ) ) ) )
258 if (ctype=="relative") nrj / sum(nrj) else nrj
8702eb86 259 }) )
56857861
BA
260}
261
4bcfdbee 262# Helper for main function: check integer arguments with functiional conditions
56857861
BA
263.toInteger <- function(x, condition)
264{
265 if (!is.integer(x))
266 tryCatch(
267 {x = as.integer(x)[1]},
268 error = function(e) paste("Cannot convert argument",substitute(x),"to integer")
269 )
270 if (!condition(x))
271 stop(paste("Argument",substitute(x),"does not verify condition",body(condition)))
272 x
cea14f3a 273}