Подсчет кол-ва битов в слове

AlexF

Необходимо подсчитать кол-во единичных бит (т.е установленных в единицу) в битовом массиве ( addr г ). Например, в байте 00110000 два единичных бита.
Разбил на две части:
- подсчет кол-ва бит в байте;
- перебор всех байтов в массиве с одновременным подсчетом.

Подсчет бит реализовал как

Код:

: countBits ( i cell -- i ) 
  SWAP OVER   1 AND IF 1+ THEN
       OVER   2 AND IF 1+ THEN
       OVER   4 AND IF 1+ THEN
       OVER   8 AND IF 1+ THEN
       OVER  16 AND IF 1+ THEN
       OVER  32 AND IF 1+ THEN
       OVER  64 AND IF 1+ THEN
       OVER 128 AND IF 1+ THEN
\      . . . .
  NIP 
;

полагаю, это не самое быстрое решение. Может кто подскажет другое решение?

Дополнено. В инете нашел несколько ссылок по теме
- http://graphics.stanford.edu/~seander/bithacks.html
- http://infolab.stanford.edu/~manku/bitcount/bitcount.html
по результатм сравнения нескольких алгоритмов, атор получил, что самый быстрый это прекомпилированный, т.е заранее вычисленные кол-ва бит для всех их комбинаций в байте.

Еще советуют книжку по этой теме: Генри С. Уоррен, мл.: Алгоритмические трюки для программистов.
________
Алексей

chess

AlexF писал(а):

полагаю, это не самое оптимально решение. Может кто подскажет другое решение?

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

AlexF

поправился -- нужен быстрый вариант, т.к объемы большие, а операция частая.

chess

\ Сначала набиваем таблицу из 256 значений - каждое значение количество бит в байте
CREATE [N-BIT]
\ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
0 C, 1 C, 1 C, 2 C, 1 C, 2 C, 2 C, 3 C, 2 C, 3 C, 3 C, 4 C,
\ ..........................
\ ..........................
\ 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
5 C, 6 C, 6 C, 7 C, 6 C, 7 C, 7 C, 8 C,
0 VALUE CT-BIT
: N-BIT \ А-НАЧ КОЛ-ВО БАЙТ --
OVER + SWAP DO I C@ [N-BIT] + C@ CT-BIT + TO CT-BIT LOOP ;
\ В CT-BIT - КОЛ-ВО БИТ
Таблицу [N-BIT] можно сгенерить, а не набивать, можно эту таблицу сделать не на 256 байтов,
а на 64Кбайт и т.д. Можно также завести счетчик 2-ой разрядности и т.д. - это все зависит от требований задачи.

Mihail

: NBITS
DUP 0x55555555 AND SWAP 0xAAAAAAAA AND 1 RSHIFT +
DUP 0x33333333 AND SWAP 0xCCCCCCCC AND 2 RSHIFT +
DUP 0x0F0F0F0F AND SWAP 0xF0F0F0F0 AND 4 RSHIFT +
DUP 0x00FF00FF AND SWAP 0xFF00FF00 AND 8 RSHIFT +
DUP 0x0000FFFF AND SWAP 0xFFFF0000 AND 16 RSHIFT +
;

WingLion

А

Код:

: nBITs (Addr n -- N) SWAP DROP 2* 2* 2* ;

чем не подходит?
Или я условие задачи не понял?

chess

Вариант с предварительной генерацией таблицы "байт-количество бит в нем".

Код:

: BITS-BYTE \ byte -- i
DUP 0x55 AND SWAP 0xAA AND 1 RSHIFT +
DUP 0x33 AND SWAP 0xCC AND 2 RSHIFT +
DUP 0x0F AND SWAP 0xF0 AND 4 RSHIFT +
;

CREATE [BITS-BYTE] 256 ALLOT

: GEN-TBL-BYTE
[BITS-BYTE] 256 + [BITS-BYTE]
DO
  I [BITS-BYTE] - BITS-BYTE I C!
LOOP
;

GEN-TBL-BYTE

0 VALUE CT-BITS

: BITS-ARRAY \ А-НАЧ  ДЛИНА_В_БАЙТАХ -->
OVER + SWAP
DO
  I C@ [BITS-BYTE] + C@ CT-BITS + TO CT-BITS \ в CT-BITS - количество бит в массиве
LOOP
;

chess

WingLion писал(а):

Или я условие задачи не понял?

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

WingLion

chess писал(а):

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

А чем отличаются значащие биты, которые равны 1-це, от незначащих битов, равных 1-це?
Или я опять дурак?

AlexF

WingLion писал(а):

... Или я условие задачи не понял?

Сорри, откорректирвоал постановку. Нужно определить кол-во единичных битов.

Hishnik

Или я сильно ошибаюсь, или в ассемблере 386+ есть подобная команда? Даже если нет, можно покрутить регистр через бит переноса и поделать adc с нулевым регистром 32 раза.

WingLion

такой вот экспромт:

Код:

\ таблица для полубайта

CREATE BIT_TAB/2  
0 C, 1 C, 1 C, 2 C, 
1 C, 2 C, 2 C, 3 C,
1 C, 2 C, 2 C, 3 C,
2 C, 3 C, 3 C, 4 C,


: nBITS_in_BYTE (b -- N) DUP 0F AND BIT_TAB/2 + C@ SWAP
  SWAP 2/ 2/ 2/ 2/ 0F AND BIT_TAB/2  + ;

: C@+ ( вообще-то, полезное слово, определить лучше сразу на ассемблере, т.к. оно же есть COUNT ) ( addr -- addr+1,b )
DUP 1+ SWAP C@ ;

: nBITS_in_MASS ( addr,n -- N )
0  \ начальное значение - ноль
SWAP 0 DO  \ цикл по массиву 
 C@+ \  взять байт из массива, и адрес увеличить на 1
 nBITS_in_BYTE \ посчитать для байта
SWAP + SWAP \ добавить
 LOOP 
\ ох забыл адрес дропнуть!
DROP 
;

на реальном Форте не проверял, т.к. комп сейчас сильно тормозит из-за Касперского

AlexF

Хищник писал(а):

Или я сильно ошибаюсь, или в ассемблере 386+ есть подобная команда? Даже если нет, можно покрутить регистр через бит переноса и поделать adc с нулевым регистром 32 раза.

Возможно.... А какая? Если не сложно, можно работающий код?

AlexF

Результаты забега

Сравнивались уже четыре варианта:
- мой, так как я реализовал ;
- вариант Михаила;
- вариант chess;
- вариант forther.
Тестирование проводилось на 100МБ массиве. Рассчитанное количество бит совпало у всех (первая колонка цифр), поэтому можем принять что все реализации работают корректно. Важны не цифры, важно соотношение:

Код:

419430400 Elapsed time: 00:00:02:187
419430400 Elapsed time: 00:00:00:390
419430400 Elapsed time: 00:00:00:485
419430400 Elapsed time: 00:00:02:280

Вариант Михаила получился быстрее. Думаю, из-за того, что в нем оперирование производится словами, а не байтами. Ниже код, который тестировал:

Код:

\ Тестирвоание на про-сть различных вариантов реализации
\ подсчета кол-ва единичных бит в битовом массиве

: countBitsInBytes ( i byte -- i )
  SWAP OVER     1 AND IF 1+ THEN
       OVER     2 AND IF 1+ THEN
       OVER     4 AND IF 1+ THEN
       OVER     8 AND IF 1+ THEN
       OVER    16 AND IF 1+ THEN
       OVER    32 AND IF 1+ THEN
       OVER    64 AND IF 1+ THEN
       OVER   128 AND IF 1+ THEN
  NIP
;

\ Case2 --------------------------------------------------
: countBitsInCell ( i cell -- i )
   DUP 0x55555555 AND SWAP 0xAAAAAAAA AND 1 RSHIFT +
   DUP 0x33333333 AND SWAP 0xCCCCCCCC AND 2 RSHIFT +
   DUP 0x0F0F0F0F AND SWAP 0xF0F0F0F0 AND 4 RSHIFT +
   DUP 0x00FF00FF AND SWAP 0xFF00FF00 AND 8 RSHIFT +
   DUP 0x0000FFFF AND SWAP 0xFFFF0000 AND 16 RSHIFT +
 +
;

\ Case3 --------------------------------------------------
: BITS-BYTE \ byte -- i
DUP 0x55 AND SWAP 0xAA AND 1 RSHIFT +
DUP 0x33 AND SWAP 0xCC AND 2 RSHIFT +
DUP 0x0F AND SWAP 0xF0 AND 4 RSHIFT +
;

CREATE [BITS-BYTE] 256 ALLOT

: GEN-TBL-BYTE
[BITS-BYTE] 256 + [BITS-BYTE]
DO
  I [BITS-BYTE] - BITS-BYTE I C!
LOOP
;

GEN-TBL-BYTE

: BitsInByte ( i byte -- i )
   [BITS-BYTE] + C@
   +
;

\ Case4 --------------------------------------------------
: bc ( i cell -- i )
    -1 0 DO
        ?DUP 0= IF I UNLOOP + EXIT THEN
        DUP 1- AND
    LOOP
  +
; 

\ ----- Testing ------
    1024 CONSTANT KB
 KB KB * CONSTANT MB

100 MB * CONSTANT BytesInArray

\ Выделние тестового масиива
USER Array
  BytesInArray ALLOCATE THROW Array !

\ Заполнение массива
: FillArray
  BytesInArray 0 DO
    I 256 MOD I Array @ + C!
  LOOP
; FillArray

\ Гоняем на тестовом массиве первый метод
: Case1
  0
  BytesInArray 0 DO
     Array @ I + C@ countBitsInBytes
  LOOP
;

\ Гоняем на тестовом массиве второй метод
: Case2
  0
  BytesInArray 4 / 0 DO
     Array @ I + @ countBitsInCell
  LOOP
;

\ Гоняем на тестовом массиве третий метод
: Case3
  0
  BytesInArray 0 DO
     Array @ I + C@  BitsInByte
  LOOP
;

\ Гоняем на тестовом массиве четвертый метод
: Case4
  0
  BytesInArray 4 / 0 DO
     Array @ I + @ bc
  LOOP
;

\ Засекаем на время, что быстрее
REQUIRE time-reset d:/spf/devel/~af/lib/elapse.f
REQUIRE .elapsed   d:/spf/devel/~af/lib/elapse.f

 time-reset Case1 . .elapsed CR
 time-reset Case2 . .elapsed CR
 time-reset Case3 . .elapsed CR
 time-reset Case4 . .elapsed CR 

forther

Попробуйте вот это. Его скорострельность пропорциональна числу
единичек в слове.

Код:

: bc ( n -- c )
    -1 0 do
        ?dup 0= if i unloop exit then
        dup 1- and 
    loop
;

Подсчет кол-ва битов в слове

Кто сейчас на конференции