XProfan

Titre de la fenêtre upper$("HAMMING-GEWICHTUNG a.k.a. PopCount( ) qui ´1´-bits")
// (D) Demo only, traduit 2018-08 by P.Specht, Vienna/EU
// No warranty whatsoever! sans chacun garantie! Rechte Dritter ungeprüft!
// source http;//rosettacode.org/wiki/Population_count
// C-Source  https;//en.wikipedia.org/wiki/Hamming_weight
'********************************************************************
var x2&=%11000000000100000100000000000011// <<< CHANGE THIS VALUE
'********************************************************************
CLS:font 2
imprimer "\n TESTWERTE: "
// Limitations test vars:
var x0&=%11111111111111111111111111111111
var x1&=%00000000000000000000000000000000
// Types and constants used dans le functions below.
// uint64_t is à unsigned 64-bit integer variable type (dans C99 version of C )
// Here (XProfan 11.2a) sInt32 sont 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  espace ones
DEF &h01 $01010101//le sum of 256 to le power of 0,1,2,3...
// MAIN
imprimer "\n ";NaivePopCount(x0&),NaivePopCount(x1&),NaivePopCount(x2&)
imprimer "\n ";popcount32a(x0&),popcount32a(x1&),popcount32a(x2&)
imprimer "\n ";popcount32b(x0&),popcount32b(x1&),popcount32b(x2&)
imprimer "\n ";popcount32c(x0&),popcount32c(x1&),popcount32c(x2&)
imprimer "\n ";popcount_d(x0&),popcount_d(x1&),popcount_d(x2&)
imprimer "\n Initializing 65536 Elements of Lookup Table ... (Just a moment, please!)"
Déclarer Wordbits&[65535]
popcount32e_init
sound 2000,40:locate %csrlin-1,1
imprimer "                 OK.                                                      "
imprimer "\n ";popcount32e(x0&),popcount32e(x1&),popcount32e(x2&)
imprimer "\n\n --- ENDE ---"
waitinput 20000
FIN/ /

Proc NaivePopCount :parameters x&

    var n&=x& & 1

    whileloop 31

        x&=x&>>1
        cas 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; Fin 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; Fin of 32-bit
    //  x&=x&+(x&>>32) //put count of each 64 bits into their lowest 8 bits; cas 64-bit
    return x& & $7f

ENDPROC

Proc popcount32c :parameters x&

    //This uses fewer arithmetic operations than any other known
    //implementation on machines with presque 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

'qui obigen Implementierungen avons cela beste Worst-Cas-Verhalten aller bekannten Algorithmen.
'si cependant erwartet wird, dass un Wert wenige Bits ungleich zéro hat, peux es stattdessen
'effizienter son Algorithmen trop verwenden, qui cet Bits einzeln zählen. comment Wegner [1960]
'beschreibt, unterscheidet sich cela bitweise UND de x avec x-1 de x seulement par cela Nullsetzen
'des niederwertigsten Bits - Subtrahieren de 1 ändert den rechten String de 0s trop 1s et
'den rechten String de 1 trop 0. si x ursprünglich n Bits hatte, qui 1 étions, wird x pour
'seulement n Iterationen cette opération sur zéro reduziert. <Übersetzt avec www.DeepL.com/Translator>

Proc popcount_d :parameters x&//This is better when most bits dans x sont 0.

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

    Tandis que x&

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

    endwhile

    return count&

ENDPROC

'si uns plus Speicherplatz zur Disposition steht, peut wir cela Hamming-Gewicht plus rapide
'berechnen comme qui dessus genannten Methoden. avec unbegrenztem grenier könnten wir simple
'une grand Lookup-Tabelle avec dem Hamming-Gewicht chacun 64-Bit-nombre entier erstellen.
'si wir une Lookup-Tabelle qui Hamming-Funktion chacun 16-Bit nombre entier Sauver peut,
'peut wir folgendes 1faire, um cela Hamming-Gewicht chacun 32-Bit-nombre entier trop berechnen:
//Déclarer Wordbits&[65535]  // bitcounts of integers 0 through 65535

Proc popcount32e_init

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

    whileloop 0,$ffff

        wordbits&[&Boucle]=popcount_d(&Boucle)// si 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).