Skip to content
Extraits de code Groupes Projets
Valider 4e5d2e48 rédigé par Michel Crucifix's avatar Michel Crucifix
Parcourir les fichiers

add mfft plot labels

parent 184d8c45
Aucune branche associée trouvée
Aucune étiquette associée trouvée
Aucune requête de fusion associée trouvée
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
0% Chargement en cours ou .
You are about to add 0 people to the discussion. Proceed with caution.
Terminez d'abord l'édition de ce message.
Veuillez vous inscrire ou vous pour commenter