Saya mencoba mencari cara untuk mendeteksi jumlah suku kata dalam korpus rekaman audio. Saya pikir proxy yang baik mungkin adalah puncak dalam file wave.

Inilah yang saya coba dengan file saya berbicara dalam bahasa Inggris (kasus penggunaan saya yang sebenarnya adalah dalam Kiswahili). Transkrip rekaman contoh ini adalah: "Ini saya mencoba menggunakan fungsi timer. Saya sedang melihat jeda, vokalisasi." Ada total 22 suku kata dalam bagian ini.

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

The seewavepaket di R besar, dan ada beberapa fungsi yang potensial. Pertama-tama, impor file 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

Hal pertama yang saya coba adalah timer()fungsinya. Salah satu hal yang dikembalikan adalah durasi setiap vokalisasi. Fungsi ini mengidentifikasi 7 vokalisasi, yang jauh dari 22 suku kata. Melihat sekilas plot menunjukkan bahwa vokalisasi tidak sama dengan suku kata.

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

Saya juga mencoba fungsi fpeaks tanpa menetapkan ambang batas. Ini mengembalikan 54 puncak.

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

Ini plot amplitudo oleh frekuensi daripada waktu. Menambahkan parameter ambang sama dengan 0,005 menyaring kebisingan dan mengurangi jumlah hingga 23 puncak, yang cukup dekat dengan jumlah suku kata yang sebenarnya (22).

Saya tidak yakin ini adalah pendekatan terbaik. Hasilnya akan peka terhadap nilai parameter ambang, dan saya harus memproses banyak file. Adakah ide yang lebih baik tentang cara membuat kode ini untuk mendeteksi puncak yang mewakili suku kata?

Saya tidak berpikir apa yang berikut ini adalah solusi terbaik, tetapi @ eipi10 punya saran bagus untuk memeriksa jawaban ini di CrossValidated . Jadi saya lakukan.

Pendekatan umum adalah memuluskan data dan kemudian menemukan puncak dengan membandingkan filter maksimum lokal dengan smooth.

Langkah pertama adalah membuat argmaxfungsi:

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

Nilai kembalinya mencakup argumen maxima lokal (x) - yang menjawab pertanyaan - dan indeks ke dalam array x dan y di mana maxima lokal tersebut terjadi (i).

Saya membuat sedikit modifikasi pada testfungsi plot: (a) untuk secara eksplisit mendefinisikan x dan y dan (b) untuk menunjukkan jumlah puncak:

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

Seperti fpeakspendekatan yang saya sebutkan dalam pertanyaan awal saya, pendekatan ini juga membutuhkan banyak penyesuaian. Saya tidak akan tahu jawaban "benar" (yaitu, jumlah suku kata / puncak) yang masuk ke ini, jadi saya tidak yakin bagaimana mendefinisikan aturan keputusan.

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)

Pada titik ini fpeakstampaknya sedikit kurang rumit bagi saya, tetapi masih belum memuaskan.

Saya memiliki masalah serupa untuk menganalisis profil elektroforesis protein. Saya memecahkannya dengan menerapkan beberapa fungsi dari paket msprocess R pada turunan kedua dari profil (lihat https://fr.wikipedia.org/wiki/D%C3%A9pouillement_d 'une_courbe # Position_et_hauteur_du_pic). Ini telah diterbitkan di sini: http://onlinelibrary.wiley.com/doi/10.1111/1755-0998.12389/abstract;jsessionid=8EE0B64238728C0979FF71C576884771.f02t03

Saya tidak tahu apakah solusi serupa dapat bekerja untuk Anda. Semoga berhasil

Berikut ini adalah perpustakaan di Python yang saya gunakan sebelumnya ketika mencoba memperkirakan periodisitas dengan menemukan puncak dalam fungsi autokorelasi.

Ini menggunakan orde pertama perbedaan / turunan diskrit untuk deteksi puncak dan mendukung penyetelan oleh ambang dan jarak minimum (antara puncak berurutan) parameter. Seseorang juga dapat meningkatkan resolusi puncak menggunakan estimasi kepadatan Gaussian dan interpolasi (lihat tautan).

Ini bekerja sangat baik di luar kotak bagi saya tanpa banyak mengutak-atik, bahkan untuk data yang berisik. Cobalah.

Saya ingin menyarankan solusi memanfaatkan changepointpaket. Contoh sederhana di bawah ini berupaya mengidentifikasi puncak, yang didefinisikan di sini sebagai titik perubahan dengan melihat satu saluran dari data yang tersedia.

Contoh

Sumber data

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

Persiapan data

# Libs
require(changepoint)

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

## Preview
plot.ts(leftTS)

Bagan yang dihasilkan melalui plot.tspanggilan:

Analisis titik perubahan

The changepointpaket menyediakan sejumlah pilihan untuk mengidentifikasi perubahan / puncak dalam data. Kode di bawah ini hanya memberikan contoh sederhana untuk menemukan 3 puncak menggunakan metode BinSeg :

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

Bagan yang diperoleh: Dimungkinkan juga untuk mendapatkan nilai:

cpts(leftTSpelt)
[1]  89582 165572 181053

Catatan samping

Contoh yang diberikan sebagian besar berkaitan dengan menggambarkan bagaimana analisis titik perubahan dapat diterapkan pada data yang disediakan; hati-hati harus dilakukan sehubungan dengan parameter yang diteruskan ke cp.varfungsi. Penjelasan rinci tentang paket dan fungsionalitas yang tersedia diberikan dalam makalah berikut:

Killepoint Killick, Rebecca and Eckley, Idris (2014) : paket R untuk analisis changepoint. Jurnal Perangkat Lunak Statistik, 58 (3). hlm. 1-19.

ecp

ecp, Adalah paket R yang layak disebut . Fasilitas ecpmemfasilitasi melakukan analisis titik perubahan multivariat non-parametrik, yang mungkin berguna jika orang ingin mengidentifikasi titik perubahan yang terjadi di berbagai saluran.