J'essaie de comprendre comment détecter le nombre de syllabes dans un corpus d'enregistrements audio. Je pense qu'un bon proxy pourrait être des pics dans le fichier wave.

Voici ce que j'ai essayé avec un fichier de moi parlant en anglais (mon cas d'utilisation réel est en kiswahili). La transcription de cet exemple d'enregistrement est: "C'est moi qui essaie d'utiliser la fonction de minuterie. Je regarde des pauses, des vocalisations." Il y a un total de 22 syllabes dans ce passage.

fichier wav: https://www.dropbox.com/s/koqyfeaqge8t9iw/test.wav?dl=0

Le seewavepackage en R est génial et il existe plusieurs fonctions potentielles. Tout d'abord, importez le fichier Wave.

library(seewave)
library(tuneR)
w <- readWave("YOURPATHHERE/test.wav")  
w
# Wave Object
# Number of Samples:      278528
# Duration (seconds):     6.32
# Samplingrate (Hertz):   44100
# Channels (Mono/Stereo): Stereo
# PCM (integer format):   TRUE
# Bit (8/16/24/32/64):    16

La première chose que j'ai essayée était la timer()fonction. Il renvoie notamment la durée de chaque vocalisation. Cette fonction identifie 7 vocalisations, ce qui est bien en deçà de 22 syllabes. Un rapide coup d'œil à l'intrigue suggère que les vocalisations ne sont pas égales aux syllabes.

t <- timer(w, threshold=2, msmooth=c(400,90), dmin=0.1)
length(t$s)
# [1] 7

J'ai également essayé la fonction fpeaks sans fixer de seuil. Il a renvoyé 54 pics.

ms <- meanspec(w)
peaks <- fpeaks(ms)

Cela trace l'amplitude en fréquence plutôt qu'en temps. L'ajout d'un paramètre de seuil égal à 0,005 filtre le bruit et réduit le nombre à 23 crêtes, ce qui est assez proche du nombre réel de syllabes (22).

Je ne suis pas sûr que ce soit la meilleure approche. Le résultat sera sensible à la valeur du paramètre de seuil, et je dois traiter un gros lot de fichiers. Avez-vous de meilleures idées sur la façon de coder cela pour détecter les pics qui représentent les syllabes?

Je ne pense pas que ce qui suit soit la meilleure solution, mais @ eipi10 a eu une bonne suggestion pour vérifier cette réponse sur CrossValidated . Alors je l'ai fait.

Une approche générale consiste à lisser les données, puis à trouver des pics en comparant un filtre maximum local au lissé.

La première étape consiste à créer la argmaxfonction:

argmax <- function(x, y, w=1, ...) {
  require(zoo)
  n <- length(y)
  y.smooth <- loess(y ~ x, ...)$fitted
  y.max <- rollapply(zoo(y.smooth), 2*w+1, max, align="center")
  delta <- y.max - y.smooth[-c(1:w, n+1-1:w)]
  i.max <- which(delta <= 0) + w
  list(x=x[i.max], i=i.max, y.hat=y.smooth)
}

Sa valeur de retour inclut les arguments des maxima locaux (x) - qui répondent à la question - et les index dans les tableaux x et y où ces maxima locaux se produisent (i).

J'ai apporté des modifications mineures à la testfonction de traçage: (a) pour définir explicitement x et y et (b) pour montrer le nombre de pics:

test <- function(x, y, w, span) {
  peaks <- argmax(x, y, w=w, span=span)

  plot(x, y, cex=0.75, col="Gray", main=paste("w = ", w, ", span = ", 
                                              span, ", peaks = ", 
                                              length(peaks$x), sep=""))
  lines(x, peaks$y.hat,  lwd=2) #$
  y.min <- min(y)
  sapply(peaks$i, function(i) lines(c(x[i],x[i]), c(y.min, peaks$y.hat[i]),
                                    col="Red", lty=2))
  points(x[peaks$i], peaks$y.hat[peaks$i], col="Red", pch=19, cex=1.25)
}

Comme l' fpeaksapproche que j'ai mentionnée dans ma question initiale, cette approche nécessite également beaucoup de réglages. Je ne connais pas la «bonne» réponse (c.-à-d. Le nombre de syllabes / pics) qui va dans ce cas, donc je ne sais pas comment définir une règle de décision.

par(mfrow=c(3,1))
test(ms[,1], ms[,2], 2, 0.01)
test(ms[,1], ms[,2], 2, 0.045)
test(ms[,1], ms[,2], 2, 0.05)

À ce stade, cela fpeaksme semble un peu moins compliqué, mais toujours pas satisfaisant.

J'ai eu des problèmes similaires pour analyser les profils d'électrophorèse des protéines. Je les ai résolus en appliquant certaines des fonctions du package msprocess R sur les dérivées secondes des profils (voir https://fr.wikipedia.org/wiki/D%C3%A9pouillement_d 'une_courbe # Position_et_hauteur_du_pic). Ceci a été publié ici: http://onlinelibrary.wiley.com/doi/10.1111/1755-0998.12389/abstract;jsessionid=8EE0B64238728C0979FF71C576884771.f02t03

Je n'ai aucune idée si une solution similaire peut fonctionner pour vous. Bonne chance

Voici une bibliothèque en Python que j'ai utilisée plus tôt en essayant d'estimer la périodicité en trouvant des pics dans la fonction d'autocorrélation.

Il utilise des différences / dérivées discrètes de premier ordre pour la détection des pics et prend en charge les paramètres de seuil et de distance minimale (entre pics consécutifs). On peut également améliorer la résolution de crête en utilisant l'estimation et l'interpolation de la densité gaussienne (voir lien).

Cela a très bien fonctionné pour moi sans beaucoup de réglages, même pour les données bruyantes. Essaie.

Je voudrais suggérer une solution utilisant le changepointpackage. L'exemple simpliste ci-dessous tente d'identifier les pics, définis ici comme des points de changement en regardant un canal à partir des données disponibles.

Exemple

Sourcing de données

# Libs
library(seewave)
library(tuneR)

# Download
tmpWav <- tempfile(fileext = ".wav")
download.file(url = "https://www.dropbox.com/s/koqyfeaqge8t9iw/test.wav?dl=0",
              destfile = tmpWav)

# Read
w <- readWave(filename = tmpWav)

Préparation des données

# Libs
require(changepoint)

# Create time series data for one channel as an example
leftTS <- ts(data = w@left)

## Preview
plot.ts(leftTS)

Graphique généré via l' plot.tsappel:

Analyse des points de changement

Le changepointpackage fournit un certain nombre d'options pour identifier les changements / pics dans les données. Le code ci-dessous ne fournit qu'un exemple simple de recherche de 3 pics à l'aide de la méthode BinSeg :

# BinSeg method (example)
leftTSpelt <- cpt.var(data = leftTS, method = "BinSeg", penalty = "BIC", Q = 3)
## Preview
plot(leftTSpelt, cpt.width = 3)

Graphique obtenu: Il est également possible d'obtenir des valeurs:

cpts(leftTSpelt)
[1]  89582 165572 181053

Notes annexes

L'exemple fourni vise principalement à illustrer comment l'analyse du point de changement peut être appliquée aux données fournies; il faut être prudent en ce qui concerne les paramètres transmis à la cp.varfonction. Une explication détaillée du package et des fonctionnalités disponibles est donnée dans le document suivant:

Killick, Rebecca et Eckley, Idris (2014) changepoint: un package R pour l'analyse des points de changement. Journal of Statistical Software, 58 (3). pp. 1-19.

ecp

ecp, est un autre mérite de mentionner le package R. Le ecpfacilite la réalisation d'une analyse multivariée non paramétrique des points de changement, qui peut être utile si l'on souhaite identifier les points de changement se produisant sur plusieurs canaux.