Метод Виолы—Джонса

[Sergey89]

Натолкните на правильную мысль! Есть изображение, представленное в интегральном виде. Также есть признак - квадрат, разделенный на две части - темную и светлую. Каким образом можно определить, при прохождении сканирующего окна по изображению, область, зарываемую темными и светлыми участками признака. Способ должен подходить не только для прямоугольных областей признака, а и для темных участков в виде нескольких прямоугольников и т.п.
У простых прямоугольных признаков просто находил начало и конец темной зоны. Но это не подходит для нескольких прямоугольников в признаке. Тем более таких:

[Qwertiy]

Рамка вокруг квадрата есть? Если да, то сначала ищем квадрат и поворачиваем картинку, затем ищем закрашенную область. Это если надо число получаемых вершин минимизировать и прямоугольники параллельны квадрату.

[Sergey89]

Здесь дело не в повороте прямоугольника. Нужна помощь в реализации подсчета яркости интегрального изображения под признаком в светлых и темных областях.

[Qwertiy]

Нужна помощь в реализации подсчета яркости интегрального изображения под признаком в светлых и темных областях.

Не понял.

[Debugger]

Подключаюсь. Задача вроде интересная, но вопроса я тоже не понял.
Чем перебор всех пикселей маски и всех пикселей изображения не подошел?

Если надо быстро - можно применить преобразование Фурье к маске и изображению, тогда свертка (перемножение маски на изображение и сложение) сведется к простому перемножению. А это происходит быстро и годится для реалтаймового выполнения.

[Qwertiy]

Debugger, а под какой вопрос ты предлагаешь решение?

[Debugger]

Debugger, а под какой вопрос ты предлагаешь решение?

Если надо быстро

Предположил, что автор не смог его запрограммировать так, чтобы он работал достаточно быстро.

[Sergey89]

А почему именно преобразование Фурье?

[Debugger]

Если вкратце - оно преобразует амплитуду сигнала в частотный спектр. В частотах некоторые операции выполняются проще, чем в амплитудах.

Если у тебя написанный перебором алгоритм будет работать за
O(W*H*w*h), где W и H - размеры исходного изображения, w и h - размеры окна
то с использованием Фурье оно будет работать за
O((W+H)*log(W+H)) - так как маску достаточно преобразовать один раз (форумчане, поправьте, если я не прав)

Вообще, без знания матана тяжело написать эту штуку должным образом. Хотя, если ты знаешь метод Виолы—Джонса, то должен разобраться : )

Почитай:
https://ru.wikipedia.org/wiki/%D0%9F%D1 ... 1%8C%D0%B5
https://ru.wikipedia.org/wiki/%D0%A1%D0 ... 8%D0%B7%29
(посмотри на связь с Фурье)

[Sergey89]

Спасибо! Буду разбираться!

[Sergey89]

Нашел вот такой код преобразования Фурье, но результат, по моему, не похож на преобразование Фурье Подскажите, пожалуйста, что не так?

Код: Выделить всё

Public Sub FF(Ar(), nm)
Dim rex(1050) As Double
Dim Imx(1056) As Double
Dim a(1050) As Double
Dim n As Integer
Dim i As Integer
Dim j As Double
Dim C(1050) As Double

Const Pi = 3.1415926
n = nm
'For j = 0 To N / 2
mm:
rex(j) = 0
Imx(j) = 0
   For i = 1 To n Step 1
     j = j + 1 / n
      rex(j) = rex(j) + Ar(i) * Cos(2 * Pi * i * (j / n))
      Imx(j) = Imx(j) - Ar(i) * Sin(2 * Pi * i * (j / n))
      DoEvents

      a(j) = Sqr(Imx(j) ^ 2 + rex(j) ^ 2)
         
      P3.Line (i, a(j))-(i, a(j-1)), vbBlack
    Next
   If j < n / 2 Then GoTo mm
End Sub


[Sergey89]

Подскажите, где найти пример правильной работы преобразования Фурье.

[Sergey89]

Разобрался. Вот это работает:

Код: Выделить всё

Private Sub Command1_Click()

Dim Pi As Double
Pi = 3.14159265
loaddata 
Dim N As Integer
N = C
ReDim REX(C / 2)
ReDim IMX(C / 2)
ReDim Frekans(C / 2)

For K = 1 To N / 2
For i = 1 To N - 1

REX(K) = REX(K) + XX(i) * Cos(2 * Pi * K * i / N) 'reel
IMX(K) = IMX(K) - XX(i) * Sin(2 * Pi * K * i / N) 'Imaginary
Next i

Frekans(K) = Sqr(REX(K) ^ 2 + IMX(K) ^ 2) '
Next K

For K = 1 To N / 2
'Text1.Text = Text1.Text & Frekans(K) & vbCrLf
Picture2.PSet (K, Picture2.ScaleHeight - Frekans(K) / Picture2.ScaleHeight), vbRed
Picture2.Line (K, Picture2.ScaleHeight - Frekans(K) / Picture2.ScaleHeight)-(K, Picture2.ScaleHeight - Frekans(K - 1) / Picture2.ScaleHeight), vbRed
Next K

Close

End Sub

Подскажите, почему так долго обрабатывает изображение? Мое, размером 1170х116, ч/б, обрабатывает 16 секунд.

[Debugger]

Во-первых, PSet и Line в принципе работают медленно.
Во-вторых, изображение немаленькое, всё-таки.
Во-третьих, это какой-то огрызок. Приложи код полностью. Отсюда не понятно, какое C. Но даже при больших C код не должен столько выполняться - вангую, что солидный кусок времени грохается на действия вне этого фрагмента кода.

[Sergey89]

Там выше опечатка. Изображение размером 76х116. С - выполняется быстро. Даже когда убираю отрисовку, все равно выполняется такое же время. Получается, дело в циклах?!
А вот сам код:

Код: Выделить всё

Option Explicit
Dim XX() As Double
Dim REX() As Double
Dim IMX() As Double
Dim K As Double
Dim i As Integer
Dim C As Integer
Dim Frekans() As Double
Dim b() As Double
Dim Value() As Currency

Private Sub Command1_Click()
       Dim t1, t2
       Dim Pi As Double
       Dim N As Integer
                t1 = Time

loaddata

    Pi = 3.14159265
    N = C
                         ReDim REX(C / 2)
                         ReDim IMX(C / 2)
                         ReDim Frekans(C / 2)


For K = 1 To N / 2
      For i = 1 To N - 1
                            REX(K) = REX(K) + XX(i) * Cos(2 * Pi * K * i / N) 'reel
                            IMX(K) = IMX(K) - XX(i) * Sin(2 * Pi * K * i / N) 'Imaginary
      Next i
              Frekans(K) = Sqr(REX(K) ^ 2 + IMX(K) ^ 2) '
Next K

     For K = 1 To N / 2
Picture2.PSet (K, Picture2.ScaleHeight - (Frekans(K) / Picture2.ScaleHeight)), vbRed
Picture2.Line (K, Picture2.ScaleHeight - (Frekans(K) / Picture2.ScaleHeight))-(K, Picture2.ScaleHeight - (Frekans(K - 1) / Picture2.ScaleHeight)), vbRed
     Next K

     t2 = Time
Caption = Abs(DateDiff("s", t1, t2))
     Close

End Sub

Sub loaddata()
         Dim z As Integer, w As Integer, h As Integer
         Dim y As Integer

w = Picture1.ScaleWidth
h = Picture1.ScaleHeight
      C = w * h

      ReDim Preserve XX(C)

For z = 0 To C
      y = Int(z / w)
                                 XX(z) = Picture1.Point(z - (y * w), (z - (z - (y * w) / w))) Mod 256
          If XX(z) <= 0 Then XX(z) = 1
          If XX(z) > 255 Then XX(z) = 255
Next z
       
Close

End Sub






[The trick]

Что у тебя с отступами?
Что за код вообще?
Используй БПФ.
Вот было как-то.
А вообще задача непонятна, каким образом должна определяться область (в каком виде получать решение)? И БПФ, я думаю, здесь неуместен, пока неясен вопрос.

[Sergey89]

Может у кого-то есть кусок кода с БВФ? Скиньте пожалуйста!

[Sergey89]

нашел такой вот код БПФ:

Код: Выделить всё

Function FFT2(a() As Double, nn As Integer, InverseFFT As Boolean)

Dim Jj As Integer, N As Integer, Mmax As Integer, m As Integer, j As Integer, istep As Integer, I As Integer, isign As Integer
Dim wtemp As Double, wr As Double, wpr As Double, wpi As Double, wi As Double, theta As Double, tempr As Double, tempi As Double

List2.Clear

   If InverseFFT Then
        isign = -1
   Else
        isign = 1
   End If

   N = 2 * nn

   j = 1

   ii = 1

    Do While ii <= nn
        I = 2 * ii - 1
            If j > I Then
               tempr = a(j - 1)
               tempi = a(j)
               a(j - 1) = a(I - 1)
               a(j) = a(I)
               a(I - 1) = tempr
               a(I) = tempi
            End If
         m = N \ 2

                Do While (m >= 2) And (j > m)
                   j = j - m
                   m = m \ 2
                Loop
      j = j + m
      ii = ii + 1
   Loop

   Mmax = 2

  Do While N > Mmax

      istep = 2 * Mmax
      theta = 2 * PI / (isign * Mmax)
      wpr = -2# * Sin(0.5 * theta)
      wpi = Sin(theta)
      wr = 1#
      wi = 0#
      ii = 1

        Do While ii <= Mmax \ 2
             m = 2 * ii - 1
             Jj = 0
             Do While Jj <= (N - m) \ istep
                     I = m + Jj * istep
                     j = I + Mmax
                     tempr = wr * a(j - 1) - wi * a(j)
                     tempi = wr * a(j) + wi * a(j - 1)
                     a(j - 1) = a(I - 1) - tempr
                     a(j) = a(I) - tempi
                     a(I - 1) = a(I - 1) + tempr
                     a(I) = a(I) + tempi
                 Jj = Jj + 1
             Loop

         wtemp = wr
         wr = wr * wpr - wi * wpi + wr
         wi = wi * wpr + wtemp * wpi + wi

         ii = ii + 1

      Loop
    Mmax = istep
   Loop

   If InverseFFT Then
      For I = 1 To nn - 1
         a(I - 1) = a(I - 1) / nn
      Next I
   End If

Picture2.Cls
Dim Am() As Double
         ReDim Am(N) As Double
            For I = 1 To N - 1
              'List2.AddItem a(I) / nn
              Am(I) = Sqr(a(I) * a(I) + a(I + 1) * a(I + 1)) / nn
               Picture2.Line (I, Picture2.ScaleHeight - Am(I))-(I, Picture2.ScaleHeight - Am(I - 1)), vbRed
            Next I

End Function


Выдает мне вот такой результат. Посмотрите, пожалуйста, приведенный код! Подскажите, как проверить правильность результатов?

[Sergey89]

Вот результат БПФ для изображения и маски. Подскажите, как определить согласно результатов, может ли признак принадлежать данному изображению. Я считаю, что их нужно просто разделить и проверить на соответствие какому-то коэффициенту.?