|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Преобладающие цвета в изображении
Приветствую, необходима помощь в перечислении уникальных цветов в изображении, подсчет количества пикселей определенных цветов и выражение в % соотношении 15 превалирующих... С подсчетом вроде как проблем нет, но решил объединить с подсчетом пикселей, в итоге получилось следующее, но выкидывает ошибку, сильно не вдавался, но, видимо сказывается мое полное нубство в массивах, и вообще по работе с пикселами:
Код:
procedure TForm1.Button9Click(Sender: TObject); type TColorInfo = record Color: TColor; count: integer; end; var i: integer; col: TColor; // multiArray: Array [0 .. 1000000] of TColorInfo; procedure AddValue(aCol: TColor); var i: integer; curr: TColorInfo; begin for i := Low(multiArray) to High(multiArray) do begin curr := multiArray[i]; if curr.Color = aCol then begin inc(curr.count); BREAK; end; Application.ProcessMessages; end; // multiArray[i + 1].Color := aCol; multiArray[i + 1].count := 1; end; begin for i := 0 to Image1.Height - 1 do begin for j := 0 to Image1.Width - 1 do begin col := Image1.Canvas.Pixels[j, i]; AddValue(col); Application.ProcessMessages; end; Application.ProcessMessages; end; // end; До кучи чужой оптимизированный алго подсчета уникальных цветов: Код:
procedure TForm1.Button1Click(Sender: TObject); const len = 2097152; // 2^24 div 8 var x, y, adr, abyte, count: integer; cbyte, bit: byte; scan: pByteArray; cnt: array of byte; begin SetLength(cnt, len); count := 0; FillChar(cnt[0], len, #0); with TBitmap.Create do begin Assign(Image1.Picture.Graphic); PixelFormat := pf24bit; for y := 0 to Height - 1 do begin scan := ScanLine[y]; for x := 0 to Width - 1 do begin adr := scan[x * 3 + 0] shl 16 + scan[x * 3 + 1] shl 8 + scan[x * 3 + 2]; abyte := adr div 8; bit := 1 shl (adr mod 8); cbyte := cnt[abyte]; if cbyte and bit = 0 then begin cnt[abyte] := cbyte or bit; inc(count); end; end; end; Free; end; Label1.caption := 'Количество цветов: ' + IntToStr(count); end; |
#2
|
||||
|
||||
Я бы так сделал:
Код:
var colorCount: array[TColor] of integer; ... for x... for y... inc(colorCount[bitmap.canvas.pixels[x, y]]); Правда едрить сколько памяти оно сожрет. — Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию Последний раз редактировалось M.A.D.M.A.N., 02.05.2013 в 08:23. |
#3
|
||||
|
||||
Цитата:
Памяти у меня много)) так что пока без оптимизации можно обойтись, главное, чтобы работало. А вообще, итоговый результат состоит в том, чтобы получить соотношение "цвета" кожи человека на изображении к другим цветам или количество пикселей "коричневого цвета" (с цветом кожи - это диапозон оттенков) к остальной сумме пикселей, вроде как то так |
#4
|
|||
|
|||
Есть другой подход (реализация, правда, на MatLab'е):
what-color-is-green two-dimensional-histograms freehand-segmentation-in-the-a-b-plane more-on-segmenting-in-a-b-space Сначала пространство RGB перевести в Lab. Яркость L не нужна. По ab строим двумерные гистограммы. Автор (Steve Eddins) приводит алгоритмы ручного и автоматического распознавания зелёных шариков. Последний раз редактировалось AlexSku, 06.05.2013 в 11:45. |
#5
|
||||
|
||||
Спасибо конечно, но реализаций на Матлабе и ПХП полно, а вот на Дельфине нет(
|
#6
|
|||
|
|||
Я же разбил задачу на кусочки. Вы хотите сказать, что на Delphi нельзя перевести RGB в Lab? Гистограмма это вообще элементарно, Ватсон: количество элементов в каждом интервале. и т.д.
|
#7
|
||||
|
||||
Цитата:
Я хочу сказать, что для меня это дремучий лес не в плане знаний предмета, а в плане реализации... И с гистограммой проблем нет, нужно тока научиться их сравнивать, а вообще задача, как я уже говорил, ну сейчас уточню, сводится к поиску объекта определенной формы на изображении, т.е. просто есть он там или нет (и сколько раз встречается), при том само изображение может быть и черно-белым и зашумленным, а объект на нем может быть в другом ракурсе, повернут, сжат, удлинен, частично обрезан и т.п., т.е. это усложняет анализ, пытался обучить нейросеть для этого, но найденный пример оказался непригоден для использования с новым РАД Студио, да и библиотек соответствующих не оказалось... Найденный пример получения гистограммы: Код:
// Histogram const RedCanal = 0; GreenCanal = 1; BlueCanal = 2; GrayCanal = 3; type TRGB24 = array [0 .. 2] of Byte; ARGB24 = array [0 .. 0] of TRGB24; PRGB24 = ^ARGB24; TTypeCanal = Byte; PHistogram = ^THistogram; THistogram = object m_Count: LongWord; m_MaxColor: Byte; m_Color: Array [0 .. 255] of LongWord; Procedure GetData(BitMap: TBitmap; rc: TRect; tcnl: TTypeCanal); end; var Hist: THistogram; canal: TTypeCanal = RedCanal; // end Histogram // Histogram Procedure DrawHistogram(canvas: TCanvas; Histogram: PHistogram; rc: TRect); var x, dx, dy: Real; y: LongWord; i: Byte; begin canvas.Brush.Color := clBlack; canvas.Pen.Color := canvas.Brush.Color; canvas.Pen.Style := psSolid; canvas.Rectangle(rc); dx := (rc.Right - rc.Left) / 256.0; // dy := (rc.Bottom-rc.Top) / Histogram.m_Color[Histogram.m_MaxColor]; // ето правельно dy := (rc.Right - rc.Left) / (Histogram.m_Count) * 30; // но чтоби увидеть что гистограма одинаковая x := rc.Left; if (canal = GrayCanal) then canvas.Brush.Color := clGray else canvas.Brush.Color := $FF shl (canal * 8); canvas.Pen.Style := psClear; for i := 0 to 255 do begin y := rc.Bottom - Round(Histogram.m_Color[i] * dy); canvas.Rectangle(Round(x), y, Round(x + dx) + 1, rc.Bottom + 1); x := x + dx; end end; Procedure THistogram.GetData(BitMap: TBitmap; rc: TRect; tcnl: TTypeCanal); var x0, y0, rWidth, rHeight: LongInt; i, x, y, Mx, My: LongInt; LinePict: PRGB24; Color: TRGB24; colorI: Byte; begin x0 := rc.Left; y0 := rc.top; rWidth := rc.Right - rc.Left - 1; rHeight := rc.Bottom - rc.top - 1; m_Count := rWidth * rHeight; for i := 0 to 255 do m_Color[i] := 0; m_MaxColor := 0; Mx := x0 + rWidth; My := y0 + rHeight; for y := y0 to My do begin LinePict := BitMap.ScanLine[y]; for x := x0 to Mx do begin Color := LinePict[x]; if (canal = GrayCanal) then colorI := (Color[0] + Color[1] + Color[2]) div 3 else colorI := Color[canal]; Inc(m_Color[colorI]); if (m_Color[colorI] > m_Color[m_MaxColor]) then m_MaxColor := colorI; end; end; end; // Histogram End //Using procedure TForm1.Button12Click(Sender: TObject); var BitMap: TBitmap; rc, rcDraw: TRect; begin BitMap := TBitmap.Create; try BitMap.Width := Image1.Picture.Width; BitMap.Height := Image1.Picture.Height; BitMap.canvas.Draw(0, 0, Image1.Picture.Graphic); // BitMap.PixelFormat := pf24bit; rc := Rect(0, 0, BitMap.Width, BitMap.Height); Hist.GetData(BitMap, rc, canal); rcDraw := Rect(0, 0, Image3.Width, Image3.Height); DrawHistogram(Image3.canvas, @Hist, rcDraw); finally BitMap.Free; end; end; |
#8
|
||||
|
||||
Дак персепртон тогда нужен, если образы отыскивать надо.
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#9
|
||||
|
||||
Цитата:
ээээ чегось сказал?))) а это разве не нейросеть, по-русски)? ЗЫ Отошли от темы немного, пока есть следующие ссылки, в которых реализовано то что мне нужно, только на ПХП: http://xdan.ru/Kak-opredelit-preobla...obrajenii.html http://xdan.ru/examples/colorator.php (то что нужно перевести на Делфи по данной теме) http://www.delphisources.ru/forum/sh...d.php?p=112794 (почти то что нужно, но не все преобладающие цвета) http://habrahabr.ru/post/117040/ (что хочу сделать в итоге) Последний раз редактировалось Vayrus, 07.05.2013 в 15:14. |
#10
|
|||
|
|||
Цитата:
|
#11
|
||||
|
||||
Цитата:
пока нужно то что по первой ссылке... |
#12
|
|||
|
|||
А там очень простой алгоритм: подсчёт с дискретизацией. Во-первых, координаты берутся по сетке, напр., 5 пикселей (видимо, алгоритм медленный), во-вторых, цвет делится на h33 (51), округляется, затем умножается на h33, т.е. выбирается шаг для гистограммы.
|
#13
|
||||
|
||||
Вот все что есть на данный момент:
https://dl.dropboxusercontent.com/u/...porndetect.rar Реализовано: 1. Определение уникальных цветов 2. Бинаризация, фильтры 3. Гистограммы (3 варианта) Что осталось (самое важное): 1. Определение соотношения "цвета кожи" к остальным цветам в % 2. Поиск объекта (в данном случае груди или какой-нибудь стилизованной формы груди) на любом изображении обнаженной натуры, т.е. необходимо количество совпадений с шаблоном и процент похожести на каждое совпадение. |