# Trapped Bits: Perl Weekly Challenge #79

Last week, I was gently notified that my solutions are insufficiently epic, so this time, I’m going further into my explanation in hopes that I identify further epicness as I proceed.

### TASK #1 › Count Set Bits

Submitted by: Mohammad S Anwar

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

1to$Nand return$total_count_set_bit % 1000000007.

There is a phrase I’ve taken from listicle journalism: *Oddly Specific*. Modulus on 1,000,000,007 is oddly specific. However, since I only do the Perl Weekly Challenge, I didn’t know that it’s a common thing among programming competitions.

As I write this up, I’m running the first challenge with **$N = 1000000007** , to get a sense of the time and if I need to rewrite it. If not…

It seems fairly simple. For every number between **0** and **$N**, get the binary representation with sprintf. (I start with 0 instead of 1, kinda because it felt right, but really, there’s 0 **1**s in `00000000`

.) Starting with **3**, that converts to `011`

, which we arrayify to `[0,1,1]`

, and we use `sum`

from List::Util to get 2. We keep a running **@total**, from which we modulus 1000000007.

Hrm.

I then save **$t** as a modulus of **$total**, rather than `$total = ( $total + $c ) % 1000000007`

. I’m not sure that’s the Right Thing at this point, but it is what I have written, so I’ll stick with that.

```
sub count_set_bits( $n ) {
my $total = 0;
my $t = 0;
for my $i ( 0 .. $n ) {
my $b = sprintf '%b', $i;
my $c = sum split m{|}, $b;
$total += $c;
$t = $total % 1000000007;
}
return $t;
}
```

I’ll switch over and add on should ` time ./ch-1.pl -n 1000000007` prove to be horrible.

…

Checking back. I’ve written all of the next one, and there’s no sign that my challenge 1 test will return. I think I just chose a stupid big **$N**. As such, I’ll proceed as if this is good.

### The Code

```
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say signatures state };
no warnings qw{ experimental };
use Carp;
use List::Util qw{ sum };
use Getopt::Long;
my $n = 4;
GetOptions( 'n=i' => \$n, );
croak 'Non-positive number' if $n < 0;
my $total = count_set_bits($n);
say $total;
sub count_set_bits( $n ) {
my $total = 0;
my $t = 0;
for my $i ( 0 .. $n ) {
my $b = sprintf '%b', $i;
my $c = sum split m{|}, $b;
$total += $c;
$t = $total % 1000000007;
}
return $t;
}
```

```
$ time ./ch-1.pl -n 1000000007
846928146
real 189m44.515s
user 189m42.880s
sys 0m1.484s
```

So it takes three hours to get to a billion and 7. I honestly don’t know if that’s to be expected or I lack clever.

### TASK #2 › Trapped Rain Water

Submitted by: Mohammad S Anwar

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.

One thing that made my last one sub-awesome was the fact that I had forgotten about **array slices**. Given the array `[2, 1, 4, 1, 2, 5]`

, if we’re looking a the fourth element, **$N[3] == 1**, we can slice the array into `[2, 1, 4]`

and `[2, 5]`

. We can go back to List::Util to use `max`

on both splices, getting `4`

and `5`

respectively, so we can tell that there will be trapped rain in the fourth column, but at this point, we can’t see how much.

I count down from the maximum value in **@N** and go down from there, but it’s just as doable to start with the smallest positive number, **1**. The histogram for Example 1 looks like this:

```
5 #
4 # #
3 # #
2 # # # #
1 # # # # # #
_ _ _ _ _ _ _
2 1 4 1 2 5
```

Looking conceptually like a dual-dimensional array, we start with index **0,0**, which is is when we’re looking at **2** in comparison with the lowest value, **5**.

*Look at self:*There is no`#`

in that position. It is not a peak or trap.*Look to right:*There is one value greater or equal to the array’s highest value, so there is a peak to the right.*Look to the left:*There are no values greater or equal to the array’s highest value to the left. There’s*nothing*to the left, actually.

So there is no trapped water here.

We move on to **0,5**.

*Look at self:*There is a`#`

in that position. It is a peak.

We’ll jump ahead to **2,4**. This is deep into the second **1** column.

*Look at self:*There is no`#`

in that position. It is not a peak or trap.*Look to right:*There two values greater or equal to the current value of**2**(**2**and**5**), so there is a peak to the right.*Look to the left:*There is one value greater or equal to the array’s current value of**2**(simply**2**), so there’s a peak to the left.

I keep and return a count, but I also create a filled histogram, to double-check my work.

```
$ ./ch-2.pl
5 #
4 # . . #
3 # . . #
2 # . # . # #
1 # # # # # #
2 1 4 1 2 5
6 units trapped
```

#### The Code

```
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say signatures state };
no warnings qw{ experimental };
use Getopt::Long;
use List::Util qw{ max sum0 };
my @n = grep { $_ >= 1 } @ARGV;
@n = ( 2, 1, 4, 1, 2, 5 ) unless scalar @n;
# make_histogram(@n);
my $trapped = trap_rain_water(@n);
my $units = $trapped == 1 ? 'unit' : 'units';
say qq{$trapped $units trapped};
sub make_histogram ( @n ) {
my $max = max @n;
say '';
for my $i ( reverse 1 .. $max ) {
my @h = map { $i <= $_ ? '#' : ' ' } @n;
say join ' ', $i, @h;
}
say join '-', ' ', map { '-' } @n;
say join ' ', ' ', @n;
say '';
}
sub trap_rain_water ( @n ) {
my $max = max @n;
my $s = scalar @n;
my $c = 0;
my @hist;
for my $i ( reverse 1 .. $max ) {
my $z = sum0 map { $i <= $_ ? 1 : 0 } @n;
my @h;
my $hh = [];
push $hh->@*, $i, '';
for my $j ( 0 .. $s - 1 ) {
my $e = $n[$j]; # equals
my $p = $e >= $i ? 1 : 0; # is peak
my @lt = @n[ 0 .. $j - 1 ];
my @gt = @n[ $j + 1 .. $s - 1 ];
my $lt = scalar grep { $_ >= $i } @lt; # is peak to left
my $gt = scalar grep { $_ >= $i } @gt; # is peak to right
my $t = $p != 1 && $lt > 0 && $gt > 0 ? 1 : 0; # has trapped
$c += $t;
push @h, $e >= $i ? '#' : $t;
my $v = ' ';
$v = '#' if $p;
$v = '.' if $t;
push $hh->@*, $v;
}
push @hist, $hh;
}
say join "\n", map { join ' ', $_->@* } @hist, [], [ ' ', '', @n ];
say '';
return $c;
}
```