Estou tentando descobrir como detectar o número de sílabas em um corpus de gravações de áudio. Eu acho que um bom proxy pode ter picos no arquivo wave.

Aqui está o que eu tentei com um arquivo meu falando em inglês (meu caso de uso real é em kiswahili). A transcrição deste exemplo de gravação é: "Sou eu tentando usar a função timer. Estou olhando para pausas, vocalizações". Há um total de 22 sílabas nesta passagem.

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

O seewavepacote em R é ótimo e existem várias funções em potencial. Primeiramente, importe o arquivo 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

A primeira coisa que tentei foi a timer()função. Uma das coisas que retorna é a duração de cada vocalização. Esta função identifica 7 vocalizações, o que está muito aquém de 22 sílabas. Uma rápida olhada na trama sugere que as vocalizações não são iguais às sílabas.

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

Eu também tentei a função fpeaks sem definir um limite. Ele retornou 54 picos.

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

Isso representa a amplitude por frequência e não por tempo. A adição de um parâmetro de limite igual a 0,005 filtra o ruído e reduz a contagem para 23 picos, o que é bem próximo do número real de sílabas (22).

Não sei se essa é a melhor abordagem. O resultado será sensível ao valor do parâmetro threshold, e eu tenho que processar um grande lote de arquivos. Alguma idéia melhor sobre como codificar isso para detectar picos que representam sílabas?

Eu não acho que o que se segue é a melhor solução, mas o @ eipi10 teve uma boa sugestão para verificar esta resposta no CrossValidated . Então eu fiz.

Uma abordagem geral é suavizar os dados e encontrar picos comparando um filtro máximo local com o suave.

O primeiro passo é criar a argmaxfunção:

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

Seu valor de retorno inclui os argumentos dos máximos locais (x) - que respondem à pergunta - e os índices nas matrizes x e y onde esses máximos locais ocorrem (i).

Fiz pequenas modificações na testfunção de plotagem: (a) para definir explicitamente x e y e (b) para mostrar o número de picos:

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

Como a fpeaksabordagem que mencionei na minha pergunta original, essa abordagem também requer uma boa dose de ajuste. Não saberei a resposta "certa" (isto é, o número de sílabas / picos) entrando nisso, por isso não tenho certeza de como definir uma regra de decisão.

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)

Neste ponto, fpeaksparece um pouco menos complicado para mim, mas ainda não é satisfatório.

Eu tive problemas semelhantes para analisar perfis de eletroforese de proteínas. Eu os resolvi aplicando algumas das funções do pacote msprocess R nos segundos derivados dos perfis (consulte https://fr.wikipedia.org/wiki/D%C3%A9pouillement_d 'une_courbe # Position_et_hauteur_du_pic). Isto foi publicado aqui: http://onlinelibrary.wiley.com/doi/10.1111/1755-0998.12389/abstract;jsessionid=8EE0B64238728C0979FF71C576884771.f02t03

Não tenho idéia se uma solução semelhante pode funcionar para você. Boa sorte

Aqui está uma biblioteca em Python que usei anteriormente ao tentar estimar a periodicidade encontrando picos na função de autocorrelação.

Ele usa diferenças de primeira ordem / derivadas discretas para detecção de pico e suporta o ajuste por parâmetros de limite e distância mínima (entre picos consecutivos). Pode-se também aprimorar a resolução de pico usando a estimativa e interpolação da densidade gaussiana (ver link).

Funcionou muito bem para mim, sem muitos ajustes, mesmo para dados barulhentos. De uma chance.

Gostaria de sugerir uma solução utilizando o changepointpacote. O exemplo simplista abaixo tenta identificar picos, definidos aqui como pontos de mudança , observando um canal a partir dos dados disponíveis.

Exemplo

Fonte de dados

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

Preparação de dados

# Libs
require(changepoint)

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

## Preview
plot.ts(leftTS)

Gráfico gerado pela plot.tschamada:

Análise de ponto de mudança

O changepointpacote fornece várias opções para identificar alterações / picos nos dados. O código abaixo fornece apenas um exemplo simples de localização de 3 picos usando o método BinSeg :

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

Gráfico obtido: Também é possível obter valores:

cpts(leftTSpelt)
[1]  89582 165572 181053

Notas laterais

O exemplo fornecido se preocupa principalmente em ilustrar como a análise do ponto de mudança pode ser aplicada aos dados fornecidos; deve-se ter cuidado com relação aos parâmetros passados ​​para a cp.varfunção. Uma explicação detalhada do pacote e das funcionalidades disponíveis é fornecida no seguinte documento:

Killick, Rebecca e Eckley, Idris (2014) changepoint: um pacote R para análise de changepoint. Journal of Statistical Software, 58 (3). 1-19.

ecp

ecp, é outro vale a pena mencionar o pacote R. A ecpanálise de ponto de mudança facilita compromisso não paramétrico multivariada, o que pode ser útil se a um gostaria de identificar pontos de mudança que ocorrem em vários canais.