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_add_ui($bits,$bits,Rmpz_popcount(Math::GMPz->new($n)));
Rmpz_mod($bits,$bits,$m);
Rmpz_add_ui($n,$n,1);
}
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.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.