# Check integer arguments with functional conditions .toInteger <- function(x, condition) { errWarn <- function(ignored) paste("Cannot convert argument' ",substitute(x),"' to integer", sep="") if (!is.integer(x)) tryCatch({x = as.integer(x)[1]; if (is.na(x)) stop()}, warning = errWarn, error = errWarn) if (!condition(x)) { stop(paste("Argument '",substitute(x), "' does not verify condition ",body(condition), sep="")) } x } # Check logical arguments .toLogical <- function(x) { errWarn <- function(ignored) paste("Cannot convert argument' ",substitute(x),"' to logical", sep="") if (!is.logical(x)) tryCatch({x = as.logical(x)[1]; if (is.na(x)) stop()}, warning = errWarn, error = errWarn) x } #' curvesToContribs #' #' Compute the discrete wavelet coefficients for each series, and aggregate them in #' energy contribution across scales as described in https://arxiv.org/abs/1101.4744v2 #' #' @param series [big.]matrix of series (in columns), of size L x n #' @inheritParams claws #' #' @return A matrix of size log(L) x n containing contributions in columns #' #' @export curvesToContribs = function(series, wav_filt, contrib_type, coin=FALSE) { L = nrow(series) D = ceiling( log2(L) ) # Series are interpolated to all have length 2^D nb_sample_points = 2^D apply(series, 2, function(x) { interpolated_curve = spline(1:L, x, n=nb_sample_points)$y W = wavelets::dwt(interpolated_curve, filter=wav_filt, D)@W # Compute the sum of squared discrete wavelet coefficients, for each scale nrj = rev( sapply( W, function(v) ( sqrt( sum(v^2) ) ) ) ) if (contrib_type!="absolute") nrj = nrj / sum(nrj) if (contrib_type=="logit") nrj = - log(1 - nrj) nrj }) } # Helper function to divide indices into balanced sets # If max == TRUE, sets sizes cannot exceed nb_per_set .splitIndices = function(indices, nb_per_set, max=FALSE) { L = length(indices) nb_workers = floor( L / nb_per_set ) rem = L %% nb_per_set if (nb_workers == 0 || (nb_workers==1 && rem==0)) { # L <= nb_per_set, simple case indices_workers = list(indices) } else { indices_workers = lapply( seq_len(nb_workers), function(i) indices[(nb_per_set*(i-1)+1):(nb_per_set*i)] ) if (max) { # Sets are not so well balanced, but size is supposed to be critical return ( c( indices_workers, if (rem>0) list((L-rem+1):L) else NULL ) ) } # Spread the remaining load among the workers rem = L %% nb_per_set while (rem > 0) { index = rem%%nb_workers + 1 indices_workers[[index]] = c(indices_workers[[index]], indices[L-rem+1]) rem = rem - 1 } } indices_workers } #' filterMA #' #' Filter [time-]series by replacing all values by the moving average of values #' centered around current one. Border values are averaged with available data. #' #' @param M_ A real matrix of size LxD #' @param w_ The (odd) number of values to average #' #' @return The filtered matrix, of same size as the input #' @export filterMA = function(M_, w_) .Call("filterMA", M_, w_, PACKAGE="epclust") #' cleanBin #' #' Remove binary files to re-generate them at next run of \code{claws()}. #' Note: run it in the folder where the computations occurred (or no effect). #' #' @export cleanBin <- function() { bin_files = list.files(pattern = "*.epclust.bin", all.files=TRUE) for (file in bin_files) unlink(file) }