XProfan

WindowTitle upper$("HAMMING-GEWICHTUNG a.k.a. PopCount( ) der ´1´-bits")
// (D) Demo only, übersetzt 2018-08 by P.Specht, 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
print "\n TESTWERTE: "
// Limitations test vars:
var x0&=%11111111111111111111111111111111
var x1&=%00000000000000000000000000000000
// Types and constants used in the functions below.
// uint64_t is an unsigned 64-bit integer variable type (in 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
print "\n ";NaivePopCount(x0&),NaivePopCount(x1&),NaivePopCount(x2&)
print "\n ";popcount32a(x0&),popcount32a(x1&),popcount32a(x2&)
print "\n ";popcount32b(x0&),popcount32b(x1&),popcount32b(x2&)
print "\n ";popcount32c(x0&),popcount32c(x1&),popcount32c(x2&)
print "\n ";popcount_d(x0&),popcount_d(x1&),popcount_d(x2&)
print "\n Initializing 65536 Elements of Lookup Table ... (Just a moment, please!)"
Declare Wordbits&[65535]
popcount32e_init
sound 2000,40:locate %csrlin-1,1
print "                 OK.                                                      "
print "\n ";popcount32e(x0&),popcount32e(x1&),popcount32e(x2&)
print "\n\n --- ENDE ---"
waitinput 20000
END//

Proc NaivePopCount :parameters x&

    var n&=x& & 1

    whileloop 31

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

    endwhile

    return n&

endproc

Proc popcount32a :parameters 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
    return x&

EndProc

Proc popcount32b :parameters 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; case 64-bit
    return x& & $7f

EndProc

Proc popcount32c :parameters 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
    return (x&*&h01)>>56//returns left 8 bits of x + (x<<8) + (x<<16) + (x<<24) + ...

EndProc

'Die obigen Implementierungen haben das beste Worst-Case-Verhalten aller bekannten Algorithmen.
'Wenn jedoch erwartet wird, dass ein Wert wenige Bits ungleich Null hat, kann es stattdessen
'effizienter sein Algorithmen zu verwenden, die diese Bits einzeln zählen. Wie Wegner [1960]
'beschreibt, unterscheidet sich das bitweise UND von x mit x-1 von x nur durch das Nullsetzen
'des niederwertigsten Bits - Subtrahieren von 1 ändert den rechten String von 0s zu 1s und
'den rechten String von 1 zu 0. Wenn x ursprünglich n Bits hatte, die 1 waren, wird x nach
'nur n Iterationen dieser Operation auf Null reduziert. <Übersetzt mit www.DeepL.com/Translator>

Proc popcount_d :parameters x&//This is better when most bits in x are 0.

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

    While x&

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

    endwhile

    return count&

Endproc

'Wenn uns mehr Speicherplatz zur Verfügung steht, können wir das Hamming-Gewicht schneller
'berechnen als die oben genannten Methoden. Mit unbegrenztem Speicher könnten wir einfach
'eine grande Lookup-Tabelle mit dem Hamming-Gewicht jeder 64-Bit-Ganzzahl erstellen.
'Wenn wir eine Lookup-Tabelle der Hamming-Funktion jeder 16-Bit Ganzzahl speichern können,
'können wir folgendes tun, um das Hamming-Gewicht jeder 32-Bit-Ganzzahl zu berechnen:
//Declare 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 :parameters x&

    //This algorithm uses 3 arithmetic operations and 2 memory reads only
    return 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).