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