From 4e5d2e48aa6987769b10e16b98e15bf11acec98d Mon Sep 17 00:00:00 2001 From: Michel Crucifix <michel.crucifix@uclouvain.be> Date: Wed, 9 Oct 2024 18:23:33 +0200 Subject: [PATCH] add mfft plot labels --- NAMESPACE | 3 +++ R/mfft_support.R | 9 ++++++++- R/toneCombinations.R | 42 ++++++++++++++++++------------------------ 3 files changed, 29 insertions(+), 25 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 64c9449..bf1e8a4 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 b830019..733ce53 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 afcdab1..8bbbd9f 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) -- GitLab