Perl Weekly Challenge 79: Count Set Bits and Trapped Rain Water

These are some answers to the Week 79 of the Perl Weekly Challenge organized by Mohammad S. Anwar

Spoiler Alert: This weekly challenge deadline is due in a couple of days (September 27, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Count Set Bits

You are given a positive number $N.

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

Example 1:

Input: $N = 4

Explanation: First find out the set bit counts of all numbers i.e. 1, 2, 3 and 4.

    Decimal: 1
    Binary: 001
    Set Bit Counts: 1

    Decimal: 2
    Binary: 010
    Set Bit Counts: 1

    Decimal: 3
    Binary: 011
    Set Bit Counts: 2

    Decimal: 4
    Binary: 100
    Set Bit Counts: 1

    Total set bit count: 1 + 1 + 2 + 1 = 5

Output: Your script should print `5` as `5 % 1000000007 = 5`.

Example 2:

Input: $N = 3

Explanation: First find out the set bit counts of all numbers i.e. 1, 2 and 3.

    Decimal: 1
    Binary: 01
    Set Bit Count: 1

    Decimal: 2
    Binary: 10
    Set Bit Count: 1

    Decimal: 3
    Binary: 11
    Set Bit Count: 2

    Total set bit count: 1 + 1 + 2 = 4

Output: Your script should print `4` as `4 % 1000000007 = 4`.

Count Set Bits in Raku

This is a problem where the data flow (or pipeline) programming model can make things fairly simple: get the numbers in the range, convert each of them to binary, sum the binary digits, sum each sum, and finally get the modulo. In Raku, there are several ways to implement such a data flow: functional programming model, chained method invocations, ==> feed operator, etc. Here, we will use a combination of functional programming and chained method invocations. In fact, it makes it so simple that we can use a Raku one-liner:

$ raku -e 'say ([+] map { .fmt("%b").comb.sum }, 1..@*ARGS[0]) % 1000000007' 4
5

$ raku -e 'say ([+] map { .fmt("%b").comb.sum }, 1..@*ARGS[0]) % 1000000007' 5
7

Count Set Bits in Perl

Perl doesn’t have a sum built-in. There are core modules offering that, but, as I have explained often before, I’m not very keen on using off-the-shelf modules for programming challenges. We could easily write a sum subroutine, but the task is so simple that I prefer to use an accumulator in nested loops:

use strict;
use warnings;
use feature "say";

my $n = shift;
my $sum;
for my $num (1..$n) {
    $sum += $_ for split '', sprintf "%b", $num;
}
say $sum % 1000000007;

This duly prints the expected results:

$ perl set_bit_count.pl 4
5

$ perl set_bit_count.pl 5
7

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.

Example 1:

Input: @N = (2, 1, 4, 1, 2, 5)
The histogram representation of the given array is as below.

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

Looking at the above histogram, we can see, it can trap 1 unit of rain water between 1st and 3rd column. Similarly, it can trap 5 units of rain water between 3rd and last column.

Therefore, your script should print 6.

Example 2:

Input: @N = (3, 1, 3, 1, 1, 5)
The histogram representation of the given array is as below.

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

Looking at the above histogram, we can see, it can trap 2 units of rain water between 1st and 3rd column. Also it can trap 4 units of rain water between 3rd and last column.

Therefore, your script should print 6.

Trapped Rain Water in Raku

For drawing the histogram, we just reuse (with some minor changes) the draw-histo subroutine of PWC # 75. It first searches the largest ordinate and then loops down on values between the largest ordinate and 0 and, for each line, prints “#” in the relevant column if the input value is greater than or equal to the current ordinate.

The capacity subroutine computes the trapped rain water. It basically looks at every column and looks for the largest values to the left and to the right. The column capacity is then the smallest of these two values minus the input array for that column. The total capacity is the sum of these column capacities.

use v6;

my @a = @*ARGS.elems > 1 ?? @*ARGS !! (2, 1, 4, 1, 2, 5);
draw-histo(@a);
say "Rain capacity is: ", capacity(@a);


sub draw-histo (@in) {
    my $max-val = @in.max;
    say "";
    for (1..$max-val).reverse -> $ordinate {
        print $ordinate;
        for 0..@in.end -> $i {
            print @in[$i] >= $ordinate ?? " # " !! "   ";
        }
        say "";
    }
    say "  =" x @in.elems;
    say "  ", join "  ", @in, "\n";
}

sub capacity (@in) {
    my $left-max = @in[0];
    my $total = 0;
    for 1..@in.end-1 -> $i {
        $left-max = @in[$i] and next if @in[$i] > $left-max;
        my $right-max = max @in[$i+1..@in.end];
        my $col = min($left-max, $right-max) - @in[$i];
        $total += $col if $col > 0;
    }
    return $total
}

These are displayed for the default input array and for two input list of values passed to the program:

$ raku rain-water.raku

5                #
4       #        #
3       #        #
2 #     #     #  #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  2  1  4  1  2  5

Rain capacity is: 6

$ raku rain-water.raku 3 1 3 1 1 5

5                #
4                #
3 #     #        #
2 #     #        #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  3  1  3  1  1  5

Rain capacity is: 6

$ raku rain-water.raku 2  1  4  1  3  2

4       #
3       #     #
2 #     #     #  #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  2  1  4  1  3  2

Rain capacity is: 3

Trapped Rain Water in Perl

For drawing the histogram, the draw_histo subroutine first searches the largest ordinate and then loops down on values between the largest ordinate and 0 and, for each line, prints “#” in the relevant column if the input value is greater than or equal to the current ordinate.

The capacity subroutine computes the trapped rain water. It basically looks at every column and looks for the largest values to the left and to the right. The column capacity is then the smallest of these two values minus the input array for that column.

In addition, since Perl doesn’t have built-ins to find the maximum and minimum values of a list of values, we have two helper subroutines, maxand min2, whose purpose should be obvious. Such functions exist in list utility modules, but, as mentioned above, I prefer to avoid using off-the-shelf packages in a coding challenge

use strict;
use warnings;
use feature "say";

my @a = @ARGV > 1 ? @ARGV : ( 2, 1, 4, 5, 3, 7);
draw_histo(@a);
say "Rain capacity is: ", capacity(@a);

sub max {
    my @vals = @_;
    my $max = shift @vals;
    for my $val (@vals) {
        $max = $val if $val > $max;
    }
    return $max;
}

sub min2 {
    $_[0] < $_[1] ? $_[0] : $_[1];
}

sub draw_histo {
    my @in = @_;
    my $max_val = max @in;
    say "";
    for my $ordinate (reverse 1..$max_val) {
        print $ordinate;
        for my $i (0..$#in) {
            print $in[$i] >= $ordinate ? " # " : "   ";
        }
        say "";
    }
    say "  =" x scalar @in;
    say "  ", join "  ", @in;
    say "";
}

sub capacity {
    my @in = @_;
    my $left_max = $in[0];
    my $total = 0;
    for my $i (1..$#in-1) {
        $left_max = $in[$i] and next if $in[$i] > $left_max;
        my $right_max = max @in[$i+1..$#in];
        my $col = min2($left_max, $right_max) - $in[$i];
        next if $col < 0;
        $total += $col;
    }
    return $total
}

This is the displayed output for the default input array and for two input list of values:

$ perl rain-water.pl

7                #
6                #
5          #     #
4       #  #     #
3       #  #  #  #
2 #     #  #  #  #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  2  1  4  5  3  7

Rain capacity is: 3


$ perl rain-water.pl 3 1 3 1 1 5

5                #
4                #
3 #     #        #
2 #     #        #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  3  1  3  1  1  5

Rain capacity is: 6


$ perl rain-water.pl 2  1  4  1  3  2

4       #
3       #     #
2 #     #     #  #
1 #  #  #  #  #  #
  =  =  =  =  =  =
  2  1  4  1  3  2

Rain capacity is: 3

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, October 4, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.