Подсчет частых значений в массиве?

[Mihail_vb6]

Здравствуйте, подскажите пожалуйста - есть Long массив видео-данных (640x480px) нужно подсчитать наиболее часто встречающиеся цвета пикселов (допустим составить топ-10 наиболее частых цветовых оттенков в указанном кадре), как это можно сделать (желательно средствами VB) чтобы все 307200 пикселов обрабатывались хотя бы в пределах нескольких секунд?

Заранее спасибо за ответы!

[alibek]

Какова должна быть дискретность цвета?
R100G100B100 и R101G100B100 — это разные цвета или одинаковые?

[Qwertiy]

Т. е. есть кадр в виде массива цветов уже есть?

[Mihail_vb6]

информация о цвете записана одним числом, т.е. просто массив длинных чисел вида "123456789"

[Qwertiy]

Что именно ты пытаешься сделать-то?

[Mihail_vb6]

нужно составить список наиболее часто встречающихся цветов, для начала подойдет "топ-10", примерно в таком виде "цвет 123456789 встречается в 153600 из 307200 пикселов"

подобный подход используется например в некоторых веб-сервисах, когда загружаешь картинку на сервер, скрипт ее анализирует и выдает палитру на основе наиболее частых цветов, как-то так
https://kuler.adobe.com/explore/most-popular/

[Qwertiy]

и выдает палитру на основе наиболее частых цветов

Тогда цвета надо округлять, а не считать для всех 16 млн цветов. Например, делить каждую компоненту на 16 и округлять до целого. Тогда число цветов всего 4096, заводим массив такой длины и проходя по всем пикселям увеличиваем счётчик в массиве. Потом оттуда выбираем максимумы в нужном количестве.

https://kuler.adobe.com/explore/most-popular/

Как это открыть в Опере?

[Mihail_vb6]

а можно ли сделать пока без округления? я хотел бы сначала получить точное количество цветов, а уже потом их округлять - но сравнивая каждый пиксел со всеми остальными пикселами массива получается долго, может я не знаю функции сортировки в VB (или вообще эффективные варианты сортировки типа "пузырьком" и т.д.), либо можно использовать WinAPI вроде copymemory либо еще варианты.. пожалуйста

p.s. в опере 15 открывается нормально

[Qwertiy]

а можно ли сделать пока без округления?

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

или вообще эффективные варианты сортировки типа "пузырьком" и т.д.

Сортировка пузырьком эффективная?
О встроенных в VB6 алгоритмах сортировки (и их наличии) мне ничего не известно.

p.s. в опере 15 открывается нормально

Опера 15 - не опера
И вообще, эта штука даже в Хроме отвратно показывается.

[Mikle]

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

Тебе предлагают округление не потому, что так быстрее, а потому, что без округления статистика ничего не даст.
640*480 - это 307200 пикселей, а возможных цветов - 16777216, это почти в 55 раз больше, то есть может выйти даже, что ни один цвет не повторяется более одного раза, а большая часть вообще не встречается. Ты получишь 307200 цветов, которые встречаются по 1 разу. Какой из них первый? Что даст такая статистика?

[alibek]

Используй хеш-таблицу (самодельную или стороннюю).

[Qwertiy]

Ну и зачем тут хэш-таблица, когда вполне хватает массивов?

[alex77755]

А зачем создавать массив из всех возможных цветов? Просто по картинке попиксельно определить цвет и впихнуть в словарь если впервые встретился или прибавить 1 к итему если повторнно

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

Private Sub Analiz_Click()
Set oDict = CreateObject("Scripting.Dictionary")
Dim R, C, Z

For R = 1 To 480
Caption = "Обработка строки " & R
For C = 1 To 640
    Z = Picture1.Point(R, C)
    If Z >= 0 Then
        If oDict.Exists(Z) Then
            oDict.Item(Z) = oDict.Item(Z) + 1
        Else
            oDict.Add Z, 1
        End If
    End If
Next C, R
T = oDict.keys
ReDim M(UBound(T), 1)

For R = 0 To UBound(T)
    M(R, 0) = T(R): M(R, 1) = oDict.Item(T(R))
Next R
S = M
Caption = "Сортировка"
QuickSortNonRecursive S, 1, 1
Caption = "Готово"
End Sub

потом отсортировать

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

Private Function QuickSortNonRecursive(SortArray(), Stolb, Optional Ubiv)
Dim i As Double, j As Double, lb As Double, ub As Double, N
Dim stack() As QuickStack, stackpos As Double, ppos As Double, pivot As Variant, swp, maxstack&
N = Stolb
Dim St As Integer
    On Error GoTo er
    ReDim stack(1 To 16)
    stackpos = 1

    stack(1).Low = LBound(SortArray)
    stack(1).High = UBound(SortArray)
    Do
        'Взять границы lb и ub текущего массива из стека.
        lb = stack(stackpos).Low
        ub = stack(stackpos).High
        stackpos = stackpos - 1
        Do
            'Шаг 1. Разделение по элементу pivot
            ppos = (lb + ub) \ 2
            i = lb: j = ub: pivot = SortArray(ppos, N)
            Do
               
                If IsMissing(Ubiv) Then
                    While SortArray(i, N) < pivot: i = i + 1: Wend
                    While pivot < SortArray(j, N): j = j - 1: Wend
                Else
                    While SortArray(i, N) > pivot: i = i + 1: Wend
                    While pivot > SortArray(j, N): j = j - 1: Wend
                End If
               
                If i > j Then Exit Do
'                If i <> j Then
                    For St = 1 To UBound(SortArray, 2)
                        swp = SortArray(i, St): SortArray(i, St) = SortArray(j, St): SortArray(j, St) = swp
                    Next St
'End If
                i = i + 1
                j = j - 1
'                End If
           Loop While i <= j

            'Сейчас указатель i указывает на начало правого подмассива,
            'j - на конец левого lb ? j ? i ? ub.
            'Возможен случай, когда указатель i или j выходит за границу массива
            'Шаги 2, 3. Отправляем большую часть в стек  и двигаем lb,ub

            If i < ppos Then   'правая часть больше
                If i < ub Then
                    stackpos = stackpos + 1
                    stack(stackpos).Low = i
                    stack(stackpos).High = ub
                End If
                ub = j        'следующая итерация разделения будет работать с левой частью
            Else
                If j > lb Then
                    stackpos = stackpos + 1
                    stack(stackpos).Low = lb
                    stack(stackpos).High = j
                End If
                lb = i
            End If
'            If maxstack < stackpos Then maxstack = stackpos
        Loop While lb < ub
    Loop While stackpos

   
    Exit Function
er: ReDim Preserve stack(1 To UBound(stack) * 2)
    Resume
'    Debug.Print maxstack
End Function

И взять нужное количество

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

Private Sub Spisok_Click()
Dim R, C As Long
Список1.Clear
C = Topf
For R = 1 To C
    Список1.AddItem S(R, 0) & " - " & S(R, 1)
Next R

End Sub

[Qwertiy]

А зачем создавать массив из всех возможных цветов?

Потому что массив эффективнее в плане производительности, проще в плане реализации и не пребует использования дополнительных библиотек. А единственны недостаток - больший расход памяти, но это несущественно, особенно если там всего 4096 элементов, как я предлагал.

[alex77755]

А я полагал, что 307200 пикселей перебрать всё же быстрей, чем 16 777 216 элементов массива цветов.
Ошибаюсь?
Тем более, что всё зависит от картинки. В одной у меня получилось 26700 элементов массива, а в другой вовсе 256.

[Qwertiy]

Ошибаюсь?

Просто пропустил то место, где писали, что цвета в видео надо округлять, иначе получится бессмысленный набор мелких чисел

[alex77755]

Ну почему сразу бессмысленный? ТС спрашивает о ТОП10.
Я сделал анализ нескольких картинок. вполне адекватные результаты:
1) 4290966 - 1629
2) 3633036 - 1491
3) 2909054 - 1280
4) 2777468 - 1153
5) 3106174 - 987
6) 2908795 - 942
7) 3435653 - 938
3896204 - 917
9) 4488599 - 892
10) 4489113 - 658
11) 4160408 - 644
12) 4226201 - 608
13) 4226716 - 554
14) 3963544 - 538
15) 4357788 - 516
16) 4291995 - 510
17) 4226202 - 491
18) 4488604 - 468
19) 4619676 - 446
20) 4751517 - 418
21) 4751771 - 412
22) 4685724 - 407
23) 4619931 - 401
24) 4685978 - 394
25) 4554906 - 382
26) 4423320 - 380
27) 4357527 - 366
28) 4291734 - 357
29) 4225941 - 350
30) 4160148 - 348
31) 4094355 - 343
32) 4028562 - 343
33) 3896208 - 335
34) 3499909 - 332
35) 3036533 - 319
36) 2639204 - 314
37) 2504791 - 313
38) 2569294 - 313
39) 1845051 - 309
40) 529699 - 307

[alex77755]

Я не пропустил место, где предлагалось:

что цвета в видео надо округлять

Я даже не пропустил место, где автору это не надо!!:

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

[alex77755]

А точное количество цветов в моём варианте как раз и будет Count словаря или Ubound массива.
Единственное с чем не могу помочь в данном случае: получить в массив сразу массив цветов пикселей.
Не сталкивался с этим, но знаю, что есть АПИ функция, позволяющее сделать такое.

[Qwertiy]

Я сделал анализ нескольких картинок. вполне адекватные результаты:

А что было на этих картинках и в каком формате? А что если взять кадр из какого-нибудь фильма? И ещё не забыть про то, что видео-кодеки создают артефакты сжатия, которые уже исказят результаты.

[Qwertiy]

Единственное с чем не могу помочь в данном случае: получить в массив сразу массив цветов пикселей.

Это не требуется, массив цветов уже есть:

информация о цвете записана одним числом, т.е. просто массив длинных чисел вида "123456789"

[alex77755]

Я сделал анализ нескольких картинок. вполне адекватные результаты:

А что было на этих картинках и в каком формате? А что если взять кадр из какого-нибудь фильма? И ещё не забыть про то, что видео-кодеки создают артефакты сжатия, которые уже исказят результаты.

На одной из картинок была девочка на фоне мерса. формат jpg.
Размер урезан до требуемых 640*480.
А на счёт если чего-нибудь откуда-нибудь взять и при этом не забыть про кодеки, то я привык отвечать на вопросы, а не гадать.
А в вопросе указано чётко:

Long массив (640x480px) нужно подсчитать наиболее часто встречающиеся цвета пикселов

и уточнено:

я хотел бы сначала получить точное количество цветов

И для чего автору это нужно я не вникаю. Нужно значит нужно.

[Qwertiy]

И для чего автору это нужно я не вникаю.

Вот это и не правильно, тем более, он написал для чего.

PS: И вообще, хотелось бы увидеть что-нибудь от автора...

[Хакер]

А что было на этих картинках и в каком формате? А что если взять кадр из какого-нибудь фильма? И ещё не забыть про то, что видео-кодеки создают артефакты сжатия, которые уже исказят результаты.

Надо брать gif с жестким dithering-ом. Вот тогда-то он прочувствует всю соль.

[alex77755]

Конвертнул ту же картинку в gif
Цветов, конечно, осталось 256.
Но ТОП10 Всё-равно адекватны:
256
1) 3762318 - 15913
2) 3891326 - 9203
3) 4089982 - 8631
4) 4485759 - 7617
5) 4420495 - 7192
6) 3964071 - 7035
7) 4819629 - 6437
5736607 - 6157
9) 1856620 - 5962
10) 2375538 - 5568

[Qwertiy]

Цветов, конечно, осталось 256.

Класс. Я предлагаю оставить 4096 цветов, а ты оставил 256 (т. е. в 16 раз меньше) и говоришь при этом об адекватности результатов без уменьшения числа цветов??

[Qwertiy]

Но ТОП10 Всё-равно адекватны:

Кстати, а ты заметил, что результаты принципиально изменились?

[alex77755]

Видимо ты читаешь через одно сообщение и пропустил, что предложил Хакер

Надо брать gif

Там, по крайней мере стандартные цвета хоть и мало
А что такое 4096 цветов? как называется формат? есть ли стандартный?
Или просто по 16 оттенков в каждом RGB цвете?

[Mikle]

Там, по крайней мере стандартные цвета хоть и мало

Палитра в GIF может быть какой угодно.

А что такое 4096 цветов? как называется формат? есть ли стандартный?
Или просто по 16 оттенков в каждом RGB цвете?

Да, простое округление до ближайшего. При таком, РАВНОМЕРНОМ, распределении гораздо проще искать ближайший цвет.

[alex77755]

При конвертировании XNView максимальновозможное цветное 256 цветов.
Ниже есть полноцветное, но оно не активно
А Вики говорит, что "Число цветов палитры - от 2 до 256."
"Стандарт разрабатывался для поддержки 256-цветовой палитры."
Т.е. палитра может быть какой угодно?, но всего цветов не более 256.
В таком случае интересно:
1. при конвертировании емеется стандартная палитра?
2. возможно ли просмотр-редактирование палитры?