XProfan

Título de la ventana upper$("HAMMING-GEWICHTUNG a.k.a. PopCount( ) el ´1´-bits")
// (D) Demo only, traducido 2018-08 by P.Pájaro carpintero, Vienna/EU
// No warranty whatsoever! Ohne jede Garantie! Rechte Dritter ungeprüft!
// Quelle http;//rosettacode.org/wiki/Population_count
// C-Source  https;//en.wikipedia.org/wiki/Hamming_weight
'********************************************************************
var x2&=%11000000000100000100000000000011// <<< CHANGE THIS VALUE
'********************************************************************
CLS:font 2
imprimir "\n TESTWERTE: "
// Limitations test vars:
var x0&=%11111111111111111111111111111111
var x1&=%00000000000000000000000000000000
// Types and constants used en the functions below.
// uint64_t is a unsigned 64-bit integer variable type (en C99 version of C )
// Here (XProfan 11.2a) sInt32 are treated as uInt32
DEF &m1 $55555555//binary 0101...
DEF &m2 $33333333//binary 00110011..
DEF &m4 $0f0f0f0f//binary  4 zeros,  4 ones ...
DEF &m8 $00ff00ff//binary  8 zeros,  8 ones ...
DEF &m16 $0000ffff//binary 16 zeros, 16 ones ...
DEF &m32 $00000000//binary 32 zeros, 32 ones
DEF &hff $ffffffff//binary  all ones
DEF &h01 $01010101//the sum of 256 to the power of 0,1,2,3...
// MAIN
imprimir "\n ";NaivePopCount(x0&),NaivePopCount(x1&),NaivePopCount(x2&)
imprimir "\n ";popcount32a(x0&),popcount32a(x1&),popcount32a(x2&)
imprimir "\n ";popcount32b(x0&),popcount32b(x1&),popcount32b(x2&)
imprimir "\n ";popcount32c(x0&),popcount32c(x1&),popcount32c(x2&)
imprimir "\n ";popcount_d(x0&),popcount_d(x1&),popcount_d(x2&)
imprimir "\n Initializing 65536 Elements of Lookup Table ... (Just a moment, please!)"
Declarar Wordbits&[65535]
popcount32e_init
sound 2000,40:locate %csrlin-1,1
imprimir "                 OK.                                                      "
imprimir "\n ";popcount32e(x0&),popcount32e(x1&),popcount32e(x2&)
imprimir "\n\n --- ENDE ---"
waitinput 20000
FIN/ /

Proc NaivePopCount :parámetros x&

    var n&=x& & 1

    whileloop 31

        x&=x&>>1
        caso x& & 1:inc n&

    endwhile

    volver n&

ENDPROC

Proc popcount32a :parámetros x&

    // Simple implementation, uses 24 arithmetic operations (shift, add, and).
    x&=(x& & &m1)+((x&>>1) & &m1)//put count of each  2 bits into those  2 bits
    x&=(x& & &m2)+((x&>>2) & &m2)//put count of each  4 bits into those  4 bits
    x&=(x& & &m4)+((x&>>4) & &m4)//put count of each  8 bits into those  8 bits
    x&=(x& & &m8)+((x&>>8) & &m8)//put count of each 16 bits into those 16 bits
    x&=(x& & &m16)+((x&>>16) & &m16)//put count of each 32 bits into those 32 bits; End for 32-bit
    'x&=(x& & &m32)+((x&>>32) & &m32) //put count of each 64 bits into those 64 bits
    volver x&

ENDPROC

Proc popcount32b :parámetros x&

    //This uses fewer arithmetic operations than any other known
    //implementation on machines with slow multiplication.
    //Algorithm uses 17 arithmetic operations.
    x&=x&-((x&>>1) & &m1)//put count of each 2 bits into those 2 bits
    x&=(x& & &m2)+((x&>>2) & &m2)//put count of each 4 bits into those 4 bits
    x&=(x&+(x&>>4)) & &m4//put count of each 8 bits into those 8 bits
    x&=x&+(x&>>8)//put count of each 16 bits into their lowest 8 bits
    x&=x&+(x&>>16)//put count of each 32 bits into their lowest 8 bits; End of 32-bit
    //  x&=x&+(x&>>32) //put count of each 64 bits into their lowest 8 bits; caso 64-bit
    volver x& & $7f

ENDPROC

Proc popcount32c :parámetros x&

    //This uses fewer arithmetic operations than any other known
    //implementation on machines with fast multiplication.
    //&his algorithm uses 12 arithmetic operations, one of which is a multiply.
    x&=x&-((x&>>1) & &m1)//put count of each 2 bits into those 2 bits
    x&=(x& & &m2)+((x&>>2) & &m2)//put count of each 4 bits into those 4 bits
    x&=(x&+(x&>>4)) & &m4//put count of each 8 bits into those 8 bits
    volver (x&*&h01)>>56//returns left 8 bits of x + (x<<8) + (x<<16) + (x<<24) + ...

ENDPROC

'El obigen Implementierungen haben el beste Worst-Case-Comportamiento aller bekannten Algorithmen.
'Wenn sin embargo esperado se, que un Valor wenige Bits ungleich Null ha, kann lo stattdessen
'effizienter ser Algorithmen utilizarse, el esta Bits einzeln zählen. Como Wegner [1960]
'beschreibt, unterscheidet se el bitweise UND de x con x-1 de x sólo por el Nullsetzen
'des niederwertigsten Bits - Subtrahieren de 1 ändert el rechten String de 0s a 1s y
'el rechten String de 1 a 0. Wenn x ursprünglich n Bits hatte, el 1 waren, se x después de
'sólo n Iterationen dieser Operation en Null reduziert. <Übersetzt con www.DeepL.com/Translator>

Proc popcount_d :parámetros x&//This is better when most bits en x are 0.

    //This is algorithm works the SAME FOR ALL DATA SIZES.
    //It uses 3 arithmetic operations and 1 comparison/branch por %1 en x.
    var count&=0

    Mientras que x&

        inc count&
        x&=x& & (x&-1)

    endwhile

    volver count&

ENDPROC

'Wenn uns mehr Speicherplatz disponible es, puede wir el Hamming-Gewicht más rápido
'berechnen como el oben genannten Métodos. Mit unbegrenztem Speicher könnten wir simplemente
'una große Lookup-Tabla con el Hamming-Gewicht cada 64-Bit-Ganzzahl redactar.
'Wenn wir una Lookup-Tabla el Hamming-Función cada 16-Bit Ganzzahl speichern puede,
'puede wir folgendes tun, en el Hamming-Gewicht cada 32-Bit-Ganzzahl a berechnen:
//Declarar Wordbits&[65535]  // bitcounts of integers 0 through 65535

Proc popcount32e_init

    // For filling the wordbits[] table, use the fastest function for your system.

    whileloop 0,$ffff

        wordbits&[&Loop]=popcount_d(&Loop)// if fastest

    Endwhile

ENDPROC

// Now we simply can do a lookup 2 times

Proc popcount32e :parámetros x&

    //This algorithm uses 3 arithmetic operations and 2 memory reads only
    volver int(wordbits&[x& & $ffff]+wordbits&[x&>>16])

ENDPROC

// HINT
// Mula et al. [11] have shown that a vectorized version of popcount64b can run
// faster than dedicated instructions (e.g., popcnt on ×64 processors).