Ich versuche herauszufinden, wie man die Anzahl der Silben in einem Korpus von Audioaufnahmen erkennt. Ich denke, ein guter Proxy könnte Peaks in der Wave-Datei sein.

Hier ist, was ich mit einer Datei versucht habe, in der ich Englisch spreche (mein aktueller Anwendungsfall ist Kiswahili). Das Protokoll dieser Beispielaufnahme lautet: "Ich versuche, die Timer-Funktion zu verwenden. Ich betrachte Pausen und Vokalisationen." Es gibt insgesamt 22 Silben in dieser Passage.

WAV-Datei: https://www.dropbox.com/s/koqyfeaqge8t9iw/test.wav?dl=0

Das seewavePaket in R ist großartig und es gibt mehrere mögliche Funktionen. Importieren Sie zuerst die Wave-Datei.

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

Das erste, was ich ausprobiert habe, war die timer()Funktion. Eines der Dinge, die es zurückgibt, ist die Dauer jeder Vokalisierung. Diese Funktion identifiziert 7 Vokalisationen, was 22 Silben bei weitem nicht entspricht. Ein kurzer Blick auf die Handlung deutet darauf hin, dass Lautäußerungen nicht gleich Silben sind.

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

Ich habe auch die fpeaks-Funktion ausprobiert, ohne einen Schwellenwert festzulegen. Es gab 54 Spitzen zurück.

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

Dies zeichnet die Amplitude eher nach der Frequenz als nach der Zeit. Durch Hinzufügen eines Schwellenwertparameters von 0,005 wird das Rauschen herausgefiltert und die Anzahl auf 23 Peaks reduziert, was der tatsächlichen Anzahl von Silben (22) ziemlich nahe kommt.

Ich bin mir nicht sicher, ob dies der beste Ansatz ist. Das Ergebnis ist abhängig vom Wert des Schwellenwertparameters, und ich muss einen großen Stapel von Dateien verarbeiten. Gibt es bessere Ideen, wie dies codiert werden kann, um Spitzen zu erkennen, die Silben darstellen?

Ich denke nicht, dass das Folgende die beste Lösung ist, aber @ eipi10 hatte einen guten Vorschlag, diese Antwort auf CrossValidated zu überprüfen . So tat ich.

Ein allgemeiner Ansatz besteht darin, die Daten zu glätten und dann Peaks zu finden, indem ein lokaler Maximalfilter mit dem Glättungsfilter verglichen wird.

Der erste Schritt besteht darin, die argmaxFunktion zu erstellen :

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)
}

Sein Rückgabewert enthält die Argumente der lokalen Maxima (x) - die die Frage beantworten - und die Indizes in den x- und y-Arrays, in denen diese lokalen Maxima auftreten (i).

Ich habe die testZeichenfunktion geringfügig geändert: (a) um x und y explizit zu definieren und (b) um die Anzahl der Peaks anzuzeigen:

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)
}

Wie der fpeaksAnsatz, den ich in meiner ursprünglichen Frage erwähnt habe, erfordert auch dieser Ansatz eine Menge Abstimmung. Ich kenne die "richtige" Antwort (dh die Anzahl der Silben / Peaks) nicht, daher bin ich mir nicht sicher, wie ich eine Entscheidungsregel definieren soll.

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)

An dieser Stelle fpeakserscheint mir das etwas unkomplizierter, aber immer noch nicht befriedigend.

Ich hatte ähnliche Probleme bei der Analyse von Proteinelektrophoreseprofilen. Ich habe sie gelöst, indem ich einige der Funktionen des msprocess R-Pakets auf die zweiten Ableitungen der Profile angewendet habe (siehe https://fr.wikipedia.org/wiki/D%C3%A9pouillement_d 'une_courbe # Position_et_hauteur_du_pic). Dies wurde hier veröffentlicht: http://onlinelibrary.wiley.com/doi/10.1111/1755-0998.12389/abstract;jsessionid=8EE0B64238728C0979FF71C576884771.f02t03

Ich habe keine Ahnung, ob eine ähnliche Lösung für Sie funktionieren kann. Viel Glück

Hier ist eine Bibliothek in Python, die ich früher verwendet habe, als ich versuchte, die Periodizität durch Auffinden von Peaks in der Autokorrelationsfunktion abzuschätzen.

Es verwendet Differenzen erster Ordnung / diskrete Ableitungen für die Peakerkennung und unterstützt die Abstimmung nach Schwellen- und Mindestabstandsparametern (zwischen aufeinanderfolgenden Peaks). Man kann die Spitzenauflösung auch durch Schätzen und Interpolieren der Gaußschen Dichte verbessern (siehe Link).

Bei mir hat es ohne große Anpassungen auch bei verrauschten Daten ganz gut geklappt. Versuche es.

Ich würde gerne eine Lösung vorschlagen, die das nutzt changepoint Paket . Das folgende vereinfachte Beispiel versucht, Spitzen zu identifizieren, die hier als Änderungspunkte definiert sind , indem ein Kanal aus den verfügbaren Daten betrachtet wird.

Beispiel

Datenbeschaffung

# 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)

Datenaufbereitung

# Libs
require(changepoint)

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

## Preview
plot.ts(leftTS)

Diagramm generiert über die plot.ts Aufruf:

Change-Point-Analyse

Das changepointPaket bietet eine Reihe von Optionen zum Identifizieren von Änderungen / Spitzenwerten in den Daten. Der folgende Code bietet nur ein einfaches Beispiel für das Auffinden von 3 Peaks mit der BinSeg- Methode:

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

Erhaltenes Diagramm: Es ist auch möglich, Werte zu erhalten:

cpts(leftTSpelt)
[1]  89582 165572 181053

Randnotizen

Das bereitgestellte Beispiel befasst sich hauptsächlich mit der Veranschaulichung, wie die Änderungspunktanalyse auf die bereitgestellten Daten angewendet werden kann. Vorsicht ist geboten in Bezug auf Parameter, die an die cp.varFunktion übergeben werden. Eine ausführliche Erläuterung des Pakets und der verfügbaren Funktionen finden Sie in folgendem Dokument:

Killick, Rebecca und Eckley, Idris (2014) changepoint: ein R-Paket für die Changepoint-Analyse. Journal of Statistical Software, 58 (3). S. 1-19.

ecp

ecpist ein weiteres erwähnenswertes R- Paket. Dies ecperleichtert die Durchführung einer nicht-parametrischen multivariaten Änderungspunktanalyse, die nützlich sein kann, wenn Änderungspunkte identifiziert werden sollen, die über mehrere Kanäle hinweg auftreten.