XProfan

Window Title upper$("HAMMING-GEWICHTUNG a.k.a. PopCount( ) the ´1´-bits")
// (D) demonstration only, Translated 2018-08 by P.woodpecker, Vienna/EU
// No warranty whatsoever! without each warranty! rights Third ungeprüft!
// fountain 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 on unsigned 64-bit integer variable type (in C99 Version of C )
// hier (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 momentum, 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&

    //Diese 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&

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

'The obigen Implementierungen having the best Worst-Case-behaviour all known Algorithms.
'If however expects becomes, that one worth little Bits mismatched zero has, can it instead
'effizienter his Algorithms To use, The these Bits particular count. How Wegner [1960]
'describe, distinguish itself the bitweise UND of x with x-1 of x only by the Nullsetzen
'the niederwertigsten Bits - Subtrahieren of 1 changes whom rechten String of 0s To 1s and
'whom rechten String of 1 To 0. If x original n Bits having, The 1 were, becomes x to
'only n Iterationen this operation on zero minimizes. <Übersetzt with www.DeepL.com/Translator>

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

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

    While x&

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

    endwhile

    return count&

Endproc

'If us More Speicherplatz available standing, can we the Hamming-weight faster
'to charge as The supra named modes. with unbegrenztem memory could we simply
'a large Lookup-scheduler with the Hamming-weight eachone 64-bit-Ganzzahl create.
'we're a Lookup-scheduler the Hamming-function eachone 16-bit Ganzzahl Save can,
'can we the following do, around the Hamming-weight eachone 32-bit-Ganzzahl To to charge:
//Declare Wordbits&[65535]  // bitcounts of integers 0 through 65535

Proc popcount32e_init

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

    whileloop 0,$ffff

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

    Endwhile

Endproc

// Now we simply can do a lookup 2 times

Proc popcount32e :parameters x&

    //Diese 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).