Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Высота звука Добавлено: 04.01.06 14:55  

Автор вопроса:  SeroVodorod | ICQ: 195555443 
Каким образом определить высоту звука (в герцах) с входящего источника звука? vb 6

Ответить

  Ответы Всего ответов: 7  

Номер ответа: 1
Автор ответа:
 Victor



ICQ: 345743490 

Вопросов: 42
Ответов: 385
  Web-сайт: vt-dbnz.narod.ru
 Профиль | | #1 		Добавлено: 06.01.06 00:12
Считай автокоррелляционную функцию и ищи ее пересечение с нулем.

Ответить

Номер ответа: 2
Автор ответа:
 Victor



ICQ: 345743490 

Вопросов: 42
Ответов: 385
  Web-сайт: vt-dbnz.narod.ru
 Профиль | | #2 		Добавлено: 06.01.06 00:29
Пересечение с нулем кажется даст четверть-период.
Как считать автокоррелляционную функцию? вот как.

Есть массив значений через определенные промежутки времени. Автокоррелляционная функция от аргумента n*(время между элементами) есть сумма произведений Data(i)*Data(i+n)


Можно и вычислять спектральную функцию и искать ее максимум.

Ответить

Номер ответа: 3
Автор ответа:
 SeroVodorod



ICQ: 195555443 

Вопросов: 1
Ответов: 3
  Профиль | | #3 Добавлено: 06.01.06 13:59
Если не тяжело, скажите где можно найти код и т.д.

Ответить

Номер ответа: 4
Автор ответа:
 Victor



ICQ: 345743490 

Вопросов: 42
Ответов: 385
  Web-сайт: vt-dbnz.narod.ru
 Профиль | | #4 		Добавлено: 09.01.06 15:26
Тяжело.
Для начала, как записаны звуковые данные и куда. А затем код легко нарисовать. Вот только метод автокоррелляционной функции будет медленным. Особенно для длинного звукового фрагмента.
Буду считать, что звуковой фрагмент записан в массив integer'ов с частотой дискретизации 44100Hz. Подожди, напишу.

Ответить

Номер ответа: 5
Автор ответа:
 Victor



ICQ: 345743490 

Вопросов: 42
Ответов: 385
  Web-сайт: vt-dbnz.narod.ru
 Профиль | | #5 		Добавлено: 09.01.06 17:39
Вот.
Пробовал прибавлять шумы - немного (совсем чуть-чуть) влияет на точность результата. Пробовал складывать две синусоиды - вроде работает. Лучше видит ту, что большей амплитуды. Когда амплитуды были равны, результат был неверен.

Жутко медленно для маленьких частот (типа 50Hz). Для больших частот (сравнимых с частотой дискретизации, 6KHz например) скорость значительно больше.

Код в форму.
Option Explicit
Const DiscrFreq As Double = 44100 'частота дискретизации
Dim dt As Double 'период дискретизации
Dim Sound() As Integer 'Сигнал

Private Sub Form_Load()
MakeSound Sound, SndFreq:=50, SndLength:=0.5
MsgBox CStr(DetectFreq(Sound, MinFreq:=20))
End Sub

'Генерит сигнал для исследования
Public Sub MakeSound(ByRef Snd() As Integer, _
                     ByVal SndFreq As Double, _
                     ByVal SndLength As Double)
Dim DtxOmega As Double
Dim n As Long 'number of samples
Dim dt As Double
Dim i As Long

dt = 1 / DiscrFreq
DtxOmega = (2 * Pi * SndFreq) * (dt)

n = SndLength / dt
ReDim Snd(0 To n - 1)

For i = 0 To n - 1
    Snd(i) = Sin(i * DtxOmega)
Next i
End Sub

Public Function Pi() As Double
Pi = Atn(1) * 4
End Function

'Определяет частоту. Хреновато, медленновато, но дело делает. Выравнивание сигнала на ноль обязательно (но нигде не реализовано).
Public Function DetectFreq(ByRef Snd() As Integer, _
                           MinFreq As Double) As Double
Dim i As Long
Dim AC As Double, PrevAC As Double
Dim MaxI As Long
Dim dt As Double
Dim ZeroCrossingI As Double
Dim QuarterPeriod As Double
dt = 1 / DiscrFreq
MaxI = (1 / MinFreq) / dt
AC = AutoCorr(Snd, i, MaxI)
Do Until i > MaxI
    PrevAC = AC
    i = i + 1
    AC = AutoCorr(Snd, i, MaxI)
    If AC < 0 Then Exit Do
Loop
If i > MaxI Then
    Err.Raise 123, ";DetectFreq", "Freq is smaller than max specified!"
End If
ZeroCrossingI = PrevAC / (PrevAC - AC) + i - 1#
QuarterPeriod = ZeroCrossingI * dt
DetectFreq = 1# / (4# * QuarterPeriod)
End Function

'Считает автокоррелляционную функцию.
Public Function AutoCorr(ByRef Data() As Integer, _
                         ByVal Offset As Long, _
                         ByVal MaxOffset As Long)
Dim i As Long
Dim Accu As Double
If Offset > MaxOffset Then
    Err.Raise 12321, "AutoCorr", "The offset value should be less or equal MaxOffset!"
End If
For i = MaxOffset To UBound(Data)
    Accu = Accu + Data(i) * Data(i - Offset)
Next i
AutoCorr = Accu
End Function


Можно для коротких звуков использовать целочисленную арифметику. Можно также оптимизировать поиск первого пересечения нуля. Можно считать автокоррелляционную функцию с меньшей точностью, делая шаги по несколько выборок. Ничего из этого я не делал.

Если не нравится, могу заняться разложением в спектр. Но там возни побольше.

Ответить

Номер ответа: 6
Автор ответа:
 SeroVodorod



ICQ: 195555443 

Вопросов: 1
Ответов: 3
  Профиль | | #6 Добавлено: 09.01.06 19:19
Спасибо огромное

Ответить

Номер ответа: 7
Автор ответа:
 SeroVodorod



ICQ: 195555443 

Вопросов: 1
Ответов: 3
  Профиль | | #7 Добавлено: 09.01.06 19:19
Спасибо огромное

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам