diff --git a/NAMESPACE b/NAMESPACE index 64c9449fab41f390b41ccbd8e09e9ec5a539bde9..bf1e8a4ec4fea27995efec3caf11a52ed4066509 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ S3method(plot,wavelet) S3method(print,mfft_deco) export(approx_ts) export(arspec) +export(attributeTones) export(cwt_morlet) export(hilbert_extension) export(mem) @@ -21,6 +22,8 @@ export(powerspectrum.wavelet) export(reconstruct_mfft) export(reconstruct_morlet) export(ssa) +export(toneCombinations) +importFrom(RcppAlgos,comboGeneral) importFrom(Rdpack,reprompt) importFrom(cmna,goldsectmax) importFrom(graphics,axis) diff --git a/R/mfft_support.R b/R/mfft_support.R index b830019d1309d8e00dd43f086a42ea13ff2a4d2e..733ce535da78c1519795768c2d28f8e4e1e184d2 100644 --- a/R/mfft_support.R +++ b/R/mfft_support.R @@ -43,8 +43,11 @@ as.data.frame.mfft_deco <- function(x) {data.frame(Freq=x$Freq, Amp=x$Amp, Phase #' @rdname mfft_deco +#' @param a `mfft_deco` object, typically the output of a `mfft` call. +#' @param labels to be set above the frequency peaks. Can be the output of `attributeTone` +#' @param periods if TRUE will add a lower axis with period labels #' @export -plot.mfft_deco <- function (M,periods=FALSE,...){ +plot.mfft_deco <- function (M,periods=FALSE,labels=NULL,...){ # O <- order(M$Freq) plot(abs(M$Freq), abs(M$Amp),'h',ylab="Amplitudes", xlab="", ...) if (periods) { @@ -58,6 +61,10 @@ plot.mfft_deco <- function (M,periods=FALSE,...){ mtext("Rate", 1, 3) } points(abs(M$Freq), abs(M$Amp),'p',...) + if (!is.null(labels)) { + yshift <- 0.2*range(M$Amp) + text(M$Freq, M$Amp + yshift, labels) + } } #' @rdname mfft_deco diff --git a/R/toneCombinations.R b/R/toneCombinations.R index afcdab14d5c522c9d32f28532745e5e631eecf90..8bbbd9fda5fe3f150de204fb5f64cabe3f75389b 100644 --- a/R/toneCombinations.R +++ b/R/toneCombinations.R @@ -3,24 +3,17 @@ #' Generates a vector with combinations of an input vector of frequencies, wih #' explicit label names, up to order 3 (this could be made more flexible is the future) #' -#' @importFrom RcppAlgos +#' @importFrom RcppAlgos comboGeneral #' @param omegas: vector of references frequencies, optionally with rownames, #' @param keepPositives : if TRUE, then only keeps positive combinations of frequencies #' @return a vector with combination of tones and explicit rownames, using, if available, the #' rownames provided in the input vector omega #' @author Michel Crucifix +#' @export toneCombinations #' @examples -# omegas <- c( 0.123, 0.14312, 0.33251, 0.554313) -# outamps <- c(1., 2, 0.2 , 0.5, 0.5) -# outfreqs <- c(1., 1.2432, omegas[1]+omegas[3]+0.00000002, omegas[1]-omegas[4]+0.00004, 0.15) -# -# attributions <- attributeTones(outfreqs, omegas) -# -# cbind(outfreqs, attributions) -# -# plot(outfreqs, outamps, type='h') -# text(outfreqs, outamps+0.1, attributions) -# +#' omegas <- c( 0.123, 0.14312, 0.33251, 0.554313) +#' print(toneCombinations(omegas)) + toneCombinations <- function(omegas, keepPositives=TRUE){ twoomegas <- c(-omegas,omegas) indices <- c(-seq(length(omegas)), seq(length(omegas))) @@ -85,20 +78,21 @@ generate_name <- function(invec,char="s", labels = NULL){ #' @param tol1 : acceptable tolerance for being considered as a certain attribution #' (if several frequencies match the criteria, the closest will be taken) #' @param tol2 : acceptable tolerance for being considered as a likely or plausible +#' @export attributeTones #' #' @examples -# omegas <- c( 0.123, 0.14312, 0.33251, 0.554313) -# names(omegas) <- c('g1','g2','s1','s2') -# outamps <- c(1., 2, 0.2 , 0.5, 0.5) -# outfreqs <- c(1., 1.2432, omegas[1]+omegas[3]+0.00000002, omegas[1]-omegas[4]+0.00004, 0.15) -# -# attributions <- attributeTones(outfreqs, omegas) -# -# cbind(outfreqs, attributions) -# -# plot(outfreqs, outamps, type='h') -# text(outfreqs, outamps+0.1, attributions) -# +#' omegas <- c( 0.123, 0.14312, 0.33251, 0.554313) +#' names(omegas) <- c('g1','g2','s1','s2') +#' outamps <- c(1., 2, 0.2 , 0.5, 0.5) +#' outfreqs <- c(1., 1.2432, omegas[1]+omegas[3]+0.00000002, omegas[1]-omegas[4]+0.00004, 0.15) +#' +#' attributions <- attributeTones(outfreqs, omegas) +#' +#' cbind(outfreqs, attributions) +#' +#' plot(outfreqs, outamps, type='h') +#' text(outfreqs, outamps+0.1, attributions) +#' attributeTones <- function(infreq , omegas, tol1 = 1.e-6, tol2 = 1.e-4) { attributions <- rep("", length(infreq)) combis <- toneCombinations(omegas)