# RogerBW's Blog

Perl Weekly Challenge 79: cumulative bit count and water capacity 23 September 2020

I’ve been doing the Perl Weekly Challenges. The latest involved more bit counts and an innovative use of histograms.

# TASK #1 › Count Set Bits

You are given a positive number `\$N`.

Write a script to count the total numbrer of set bits of the binary representations of all numbers from `1` to `\$N` and return `\$total_count_set_bit % 1000000007`.

The number of set bits (aka population count or Hamming weight) is a standard CS problem, and it's one that's come up before in PWC. In fact the result of this particular challenge is OEIS #A000788. But I'll write my own code here.

In Perl I want to be unconstrained by `MAXINT`, and so I'll use `Math::GMPz` which is unreasonably shiny. (There are other ways to use GMP from Perl which are less close to the sharp moving blades of the underlying C library, `Math::GMP` and even `Math::BigInt::GMP`, but I want the dangerous functions exposed so that I can use some of them.) I could move the modulus operation out of the loop but let's pretend it's important.

``````sub csb {
my \$tot=shift;
my \$n=Math::GMPz->new(1);
my \$bits=Math::GMPz->new(0);
my \$m=Math::GMPz->new(1000000007);
while (\$n <= \$tot) {
Rmpz_mod(\$bits,\$bits,\$m);
}
return Rmpz_get_str(\$bits,10);
}
``````

For Raku I want to optimise for speed, so I do a straightforward bit comparison. (`+&` is bitwise and, while `+>` is bitwise shift right.)

``````sub csb(\$tot) {
my \$bits=0;
my \$m=1000000007;
for 1..\$tot -> \$n {
my \$k=\$n;
while (\$k > 0) {
\$bits += \$k +& 1;
\$k +>= 1;
}
\$bits %= \$m;
}
return \$bits;
}
``````

For Python I'm taking a stringified binary representation and counting the "1" digits.

def csb(tot): bits=0 m=1000000007; for n in range(1,tot+1): bits += bin(n).count("1") bits %= m return bits

The latter two would work in each other's languages, and in Perl, too; I just felt like taking some different approaches.

# TASK #2 › Trapped Rain Water

You are given an array of positive numbers `@N`.

Write a script to represent it as Histogram Chart and find out how much water it can trap.

The examples make this slightly clearer: if you drop water from +Y onto the chart, how much will remain rather than running off? Well, really, this is two separate problems, and the challenging one isn't the graphical bit.

I came up with a raster-based algorithm: for each row on the chart, make a list of the column numbers which reach at least as high as this row. For any pair, if they're not immediately adjacent, that's a trapped bit of water, so add it to the overall capacity.

``````sub capacity {
my @n=@{shift @_};
my \$cap=0;
foreach my \$r (min(@n)..max(@n)) {
my @b=grep {\$n[\$_]>=\$r} (0..\$#n);
if (scalar @b > 1) {
foreach my \$i (0..\$#b-1) {
\$cap += \$b[\$i+1]-\$b[\$i]-1;
}
}
}
return \$cap;
}
``````

Raku is basically the same:

``````sub capacity(@n) {
my \$cap=0;
for (min(@n)..max(@n)) -> \$r {
my @b=grep {@n[\$_] >= \$r}, (0..@n.end);
if (@b.elems > 1) {
for (0..@b.end-1) -> \$i {
\$cap += @b[\$i+1]-@b[\$i]-1;
}
}
}
return \$cap;
}
``````

And Python (though I use a list comprehension rather than a `grep`):`

``````def capacity(n):
cap=0
for r in range(min(n),max(n)+1):
b=[i for i in range(0,len(n)) if n[i] >= r]
if(len(b)>1):
for i in range(0,len(b)-1):
cap += b[i+1]-b[i]-1
return cap
``````

The histogram plotter is broadly the same code that I wrote for fun as the verbose solution to #75. It's very Perlish with `?:` and `x` operators.

``````sub histo {
my @n=@{shift @_};
my \$mx=max(@n);
my \$cw=int(log(\$mx+1)/log(10)+.9999);
for (my \$r=\$mx;\$r>0;\$r--) {
my @row=(sprintf('%'.\$cw.'d',\$r));
push @row,map {(\$n[\$_]>=\$r?'#' x \$cw:' ' x \$cw)} (0..\$#n);
print join(' ',@row),"\n";
}
print join(' ',('-' x \$cw) x (1+scalar @n)),"\n";
print join(' ',map {sprintf('%'.\$cw.'s',\$_)} ('',@n)),"\n";
}
``````

So it's a little bit of work to Raku-ify it (`x` is the string extender, `xx` is the array extender):

``````sub histo(@n) {
my \$mx=max(@n);
my \$cw=floor(log(\$mx+1)/log(10)+.9999);
loop (my \$r=\$mx;\$r>0;\$r--) {
my @row=(sprintf('%' ~ \$cw ~ 'd',\$r));
push @row,map {(@n[\$_]>=\$r ?? '#' x \$cw !! ' ' x \$cw)}, (0..@n.end);
say join(' ',@row);
}
say join(' ',('-' x \$cw) xx (1+@n.elems));
say join(' ',map {sprintf('%' ~ \$cw ~ 's',\$_)}, ('',@n).flat);
}
``````

And rather more to Python-ify it, starting with no standard access to `sprintf` (the built-in `format` is all right but has its own special language). I unrolled the `map`s from the Perl version for ease of comprehension. Turns out that `*` is the equivalent of Perl's `x` in string-lengthening mode; not sure what the single-operator equivalent in array-lengthening mode is yet, though since a string is a special case of a list it may be the same thing.

``````def histo(n):
mx=max(n)
cw=int(log10(mx+1)+.9999);
for r in reversed(range(1,mx+1)):
row=list()
row.append(format(r,str(cw)))
for i in range(0,len(n)):
s = ' '
if(n[i] >= r):
s = '#'
s *= cw
row.append(s)
print(' '.join(row))
s='-' * cw;
print(' '.join([s for i in range(0,len(n)+1)]))
row=list()
row.append(' ' * cw)
for i in n:
row.append(format(i,str(cw)))
print(' '.join(row))
``````

Full code on github.

1. Posted by RogerBW at 12:52pm on 28 September 2020

For part 1, most other entrants seem to have used the string representation (the one I used in Python) though there was some direct binary furkling and Flavio Poletti came up with a fascinating recursive approach.

In part 2, RabbitFarm came up with a pleasingly baroque way of detecting buckets, while Arne Sommer and several others used a sliding-window approach.