freepascal.ru

Есть IP-камера, выдающая картинку в разрешение 640x480 в JPEG. Задача определить - произошло ли какое-то движение в кадре, для того, чтобы начать запись. Вот мой вариант:

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

Var
    bBitmap: TBitmap;
    bPicture: TPicture;
    bMemoryStream: TMemoryStream;
    bBuffer: TBitmap;

Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  aPixel, aBufferedPixel: TFPColor;
  i, j, aDiff: Integer;
Begin
   aDiff := 0;
   bMemoryStream.Clear;
   HttpGetBinary('http://admin:123456@192.168.0.243/snapshot.cgi', bMemoryStream);
   bMemoryStream.Seek(0, soFromBeginning);
   bPicture.Clear;
   bBitmap.Clear;
   bPicture.LoadFromStream(bMemoryStream);
   bBitmap.SetSize(20, 20);
   bBitmap.Canvas.StretchDraw(Rect(0, 0, 20, 20) , bPicture.Bitmap);
   If bBuffer = nil Then
     Begin
       bBuffer := TBitmap.Create;
       bBuffer.Assign(bBitmap);
       Exit;
     End;
   For i := 0 To bBitmap.Width - 1 Do
     For j := 0 To bBitmap.Height - 1 Do
       Begin
         aPixel := TColorToFPColor(bBitmap.Canvas.Pixels[i, j]);
         aBufferedPixel := TColorToFPColor(bBuffer.Canvas.Pixels[i, j]);
         If Abs(aPixel.blue - aBufferedPixel.blue) +
           Abs(aPixel.red - aBufferedPixel.red) +
           Abs(aPixel.green - aBufferedPixel.green) > 5000 Then
           Inc(aDiff);
       End;
  Memo1.Lines.Insert(0, IntToStr(aDiff));
  bBuffer.Assign(bBitmap);
End;


Всё работает, на движение реагирует адекватно, но слишком уж ресурсоёмко. С графикой дела никогда не имел, так что сделано всё довольно топорно и "на глазок". Буду очень рад советам опытных коллег ^_^

Тут есть как минимум два тормоза:

1) Куча вычислений в цикле. Если я правильно понял, преобразование к TfpColor и обратно делается для удобного разложения цвета на составляющие. Я бы посоветовал обойтись без преобразования, и сравнивать два TColor напрямую. Алгоритм разложения TColor на составляющие с помощью битовых масок можно подсмотреть в TColorToFPColor (строчки вида "(c and <маска>)"). Сравнение полученных составляющих напрямую позволит сэкономить на изменении порядка байт с BGR (TColor) на RGBA (TfpColor). Поскольку сравнение пикселов в данном алгоритме выполняется многократно, даже небольшая оптимизация сравнения скажется на общей производительности.

2) StretchDraw - не самая быстрая операция. Может быть можно избавиться от неё вообще?

Если смотреть дальше:

3) Насколько я знаю, попиксельный доступ к канве - тоже не самая быстрая операция. С альтернативами я плохо знаком, поэтому сходу ничего не предложу, но возможно стоит поискать способы быстрого доступа к пикселам, типа Scanline.

4) В качестве ненадёжного альтернативного способа сравнения, можно посмотреть вариант предварительного сравнения изображений на уровне байт в файле. Это позволит сэкономить на чтении графического формата. Для выполнения такого сравнения нужно понять, насколько сильно различаются файлы с примерно одинаковым содержанием на уровне байтов формата хранения. Если не сильно - можно использовать это как предварительный этап сравнения. Целесообразность такого способа лучше проверять экспериментально. Он зависит формата получаемых изображений, и при частых изменениях картинки может, наоборот, замедлить общий процесс сравнения.

P.S. Как обычно, сначала написал, потом присмотрелся к коду Похоже что StretchDraw - основной тормоз, потому что 400 итераций для пикселей не так много. Понял, что StretchDraw используется как часть установки порога срабатывания. А что если:
* Убрать StretchDraw и просто рассчитывать число пикселей, значение цвета которых изменилось свыше установленного порога?
* Суммировать разницу значений по всем пикселам, и в случае выхода значения суммы за определённый общий порог, считать что картинка изменилась?
И вообще, наверняка есть какая-то литература по этой теме, там должны быть описаны нужные алгоритмы

Если убрать StretchDraw - будет пробегаться не по 400 пикселям, а по 307200. Да и картинки сами по себе получаются довольно различными и без движения - шумы и т.п. Литература-то есть, но она предусматривает какой-то уровень начальной подготовки, а я до сей поры кроме как сквозь VCL/LCL с графикой-то и не работал... Полагаю, что нужно уйти от попиксельного сравнения в сторону какого-нибудь Scanline, и, соответственно, от тяжёлых расчётов в цикле (преобразование типов/вычисление модуля).

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

Brainenjii писал(а):Если убрать StretchDraw - будет пробегаться не по 400 пикселям, а по 307200.

Верно, но ведь сама StretchDraw работает не "в обход процессора" Она тоже пробегается по всем 307200 пикселям, и ещё усредняет их цвета для получения более мелкой картинки. Может быть, эта функция хорошо оптимизирована, может быть нет.

Думаю, имеет смысл померить и сравнить затраты времени на обход 400 пикселей и на StretchDraw. И уже по результатам решить, стоит ли прорабатывать вариант со Scanline. Я сам пока не написал предыдущий пост, не обратил внимание что цикл всего 20х20. Даже если сильно его ускорить, даст ли это заметный прирост скорости по сравнению с отказом от (или заменой на более быстрый вариант) StretchDraw, в которой крутиться цикл 640х480?

Поиск шума - это очень серьёзно. Я бы копал в сторону поиска минимальной разности между самими jpeg-файлами.

Может быть, пригодится http://ru.wikipedia.org/wiki/OpenCV

А если сравнивать две картинки преобразованные в 256 цветов? При конвертировании часть лишних данных автоматически отсеется. Должен быть способ повесить преобразование на opengl

Попробовал:

• без scanline'а:
  

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

  Function TForm1.BruteCompare(Const aHTTP: String;
  Var aBuffer: TPicture): Integer;
Var
  i, j: Integer;
  aPicture: TPicture;
  aStream: TMemoryStream;
  aPixel, aBufferedPixel: TFPColor;
Begin
  Result := -1;
  aStream := TMemoryStream.Create;;
  HttpGetBinary(aHTTP, aStream);
  aStream.Seek(0, soFromBeginning);
  aPicture := TPicture.Create;
  aPicture.LoadFromStream(aStream);
  If aBuffer = nil Then
    Begin
      aBuffer := aPicture;
      Exit;
    End;
  Result := 0;
  For i := 0 To aPicture.Height - 1 Do
    For j := 0 To aPicture.Width - 1 Do
      Begin
        aPixel := TColorToFPColor(aPicture.Bitmap.Canvas.Pixels[j, i]);
        aBufferedPixel :=
TColorToFPColor(aBuffer.Bitmap.Canvas.Pixels[j, i]);
        Result := Abs(aPixel.red - aBufferedPixel.Red) +
          Abs(aPixel.green - aBufferedPixel.green) +
          Abs(aPixel.blue - aBufferedPixel.blue);
      End;
  aBuffer.Free;
  aBuffer := aPicture;
End;


  
  

  atop 10 писал(а):project1: 94% // UPD: было 24%
  

• со scanline'ом:
  

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

  Function TForm1.NonStretchompare(Const aHTTP: String;
  Var aBuffer: TLazIntfImage): Integer;
Var
  i, j: Integer;
  aPicture: TPicture;
  aImage: TLazIntfImage;
  aStream: TMemoryStream;
  aRow, aBufferedRow: pBruteArray;
Begin
  Result := -1;
  aStream := TMemoryStream.Create;;
  HttpGetBinary(aHTTP, aStream);
  aStream.Seek(0, soFromBeginning);
  aPicture := TPicture.Create;
  aPicture.LoadFromStream(aStream);
  aImage := aPicture.Bitmap.CreateIntfImage;
  aPicture.Free;
  If aBuffer = nil Then
    Begin
      aBuffer := aImage;
      Exit;
    End;
  Result := 0;
  For i := 0 To aImage.Height - 1 Do
    Begin
      aRow := aImage.GetDataLineStart(i);
      aBufferedRow := aBuffer.GetDataLineStart(i);
      For j := 0 To aImage.Width - 1 Do
        Begin
          Result += Abs(aRow^[j].rgbtBlue - aBufferedRow^[j].rgbtBlue) +
            Abs(aRow^[j].rgbtGreen - aBufferedRow^[j].rgbtGreen) +
            Abs(aRow^[j].rgbtRed - aBufferedRow^[j].rgbtRed);
        End;
    End;
  aBuffer.Free;
  aBuffer := aImage;
End;


  
  

  atop 10 писал(а):project1: 23%
  

  
  
• и stretch:
  

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

  Function TForm1.CycleCompare(Const aHTTP: String;
  Var aBuffer: TLazIntfImage): Integer;
Var
  i, j: Integer;
  aBitmap: TBitmap;
  aPicture: TPicture;
  aImage: TLazIntfImage;
  aStream: TMemoryStream;
  aRow, aBufferedRow: pRGBArray;
Begin
  Result := -1;
  aStream := TMemoryStream.Create;;
  HttpGetBinary(aHTTP, aStream);
  aStream.Seek(0, soFromBeginning);
  aPicture := TPicture.Create;
  aPicture.LoadFromStream(aStream);
  aStream.Free;
  aBitmap := TBitmap.Create;
  aBitmap.SetSize(20, 20);
  aBitmap.Canvas.StretchDraw(Rect(0, 0, 20, 20) , aPicture.Bitmap);
  aPicture.Free;
  aImage := aBitmap.CreateIntfImage;
  aBitmap.Free;
  If aBuffer = nil Then
    Begin
      aBuffer := aImage;
      Exit;
    End;
  Result := 0;
  For i := 0 To aImage.Height - 1 Do
    Begin
      aRow := aImage.GetDataLineStart(i);
      aBufferedRow := aBuffer.GetDataLineStart(i);
      For j := 0 To aImage.Width - 1 Do
        Begin
          Result += Abs(aRow^[j].rgbtBlue - aBufferedRow^[j].rgbtBlue) +
            Abs(aRow^[j].rgbtGreen - aBufferedRow^[j].rgbtGreen) +
            Abs(aRow^[j].rgbtRed - aBufferedRow^[j].rgbtRed);
        End;
    End;
  aBuffer.Free;
  aBuffer := aImage;
End;


  
  

  atop 10 писал(а):project1: 19%
  

Странно, мне казалось что разница будет больше. К сожалению, не овладел valgrind'ом - где-нибудь есть хороший мануал - как разбираться в выводе valgrind/kcachevalgrind, применительно к FPC?

P.S. упс, запустил тест для первого случая с кодом второго - поэтому изначально для первых двух вариантов вышло 24% и 23% соответственно. Теперь разница существенней ^_^

P.P.S. Блин, надо овладевать valgrind'ом. Проблема оказалась не там где искал:

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


Function TForm1.CycleCompare(Const aHTTP: String;
  Var aBuffer: TLazIntfImage): Integer;
Var
  i, j: Integer;
  aBitmap: TBitmap;
  aPicture: TPicture;
  aImage: TLazIntfImage;
  aStream: TMemoryStream;
  aRow, aBufferedRow: pRGBArray;
Begin
  Result := -1;
  aStream := TMemoryStream.Create;;
  HttpGetBinary(aHTTP, aStream);
  aStream.Seek(0, soFromBeginning);
  aPicture := TPicture.Create;
  aPicture.LoadFromStream(aStream);
  aStream.Free;
  aPicture.Free;
End;


atop 10 писал(а):project1: 19%

!!! Просто загрузка файла в Stream - 2%. Как можно кошерней перевести поток в LazIntfImage? ^_^

"Некропост ..." вечера искал готовое решение но как говорится "хочешь что-бы было хорошо делай сам ..."
Наверное самый простой (и по идее быстрый ) способ сравнения двух изображений вот такой :

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

Function CompareBMP (B1,B2:TBitmap):Bool;
begin
Result:=False; If (B1<> Nil) and (B2<> Nil) then
if (B1.RawImage.DataSize>0) and (B1.RawImage.DataSize=B2.RawImage.DataSize) then
Result:= CompareByte(B1.RawImage.Data^,b2.RawImage.Data^,b1.RawImage.DataSize) = 0;
end;


Может кому-то пригодится ...

Самое простое: перевести картинку RGB в Gray и каждый пиксел двух картинок сравнивать на их разницу значение (diff) [+/-]..
Если во всем массиве diff не было abs(x)>некого порогового значения - значит картинки равны.

olegy123, вот не Художник ты. Иначе бы знал, что перевод в полутон может сильно исказить изображение. Иногда вплоть до неузнаваемости. Да и оттенки иногда важны. Если реально сравнивать, то по световым плоскостям. Да, намного труднее, но качество лучше. В твоём же алгоритме один маленький нюанс. Если постараться, то можно так, допустим, изменить изображение, что оно будет сильно непохоже не себя же, но до обработки. Допустим, притенить.

olegy123 писал(а):Самое простое: перевести картинку RGB в Gray и каждый пиксел двух картинок сравнивать на их разницу значение (diff) [+/-]..
Если во всем массиве diff не было abs(x)>некого порогового значения - значит картинки равны.

Упс ...
1 RGB в Gray...
2 каждый пиксел двух картинок сравнивать ...

Да в "глубокой сирости и убогости" объем данных будет меньше.
но по "суме технологий" ... сложнее и медленней. ( да и не точно)

А у меня на все про все по сути одна строчка(и с точностью нет проблем ):

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

Result:= CompareByte(B1.RawImage.Data^,b2.RawImage.Data^,b1.RawImage.DataSize) = 0;

Alex2013, а ты подними исходный код CompareByte, так, чисто для справки. Это либо цикл сравнивающий побайтно, либо его ассемблерный эквивалент. В крайнем случае сравниваться будут 2, 4 или 8 байт.

Фокус не в CompareByte(можно и без него обойтись) который просто под руку подвернулся ... (Хотя штуковина удобная и не такая уж простая как может показаться) Суть в доступе через RawImage.Data^ который позволяет его применить. Глянь на "наливочки из кода" (хорошо что не "простыни" ) вначале темы . (Я уж молчу про скорость доступа через Canvas.Pixels...)
Зы
Есть впечатление, что очень многие пользователи Лазаруса (включая меня) многие годы ходили "под заклятием отвода глаз" не замечая возможность использования RawImage . (Да там есть хитрость с BeginUpdate но ничего особо страшного в ней нет)