Perl Weekly Challenge: Week 79

Challenge 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.

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`.

In Raku this is straightforward; I could even have made it a one-liner but given that $total is used twice it is actually shorter this way. The first step is to take the range of numbers from 1 to $N and then use .map() to convert them to binary and get the number of 1's in each via a regex. Then the [+] operator is used to sum them up into $total.

my $total = [+] (1 .. $N).map({ sprintf("%b", $_) ~~ m:g/ 1 /; });

The second line outputs $total in the required format.

say "$total % 1000000007 = $total";

(Full code on Github.)

In Perl we don't have [+] so I added to $total inside the map() block instead. And I used tr() instead of matching to get the count of 1's.

my $total = 0;
map { $total += sprintf("%b", $_) =~ tr/1/1/; } 1 .. $N;

say "$total % 1000000007 = $total";

(Full code on Github.)

Challenge 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. Similary it can trap 5 units of rain water betweem 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

My first attempt at a solution (in Raku) was hideously overcomplicated with loops within loops etc. And while it did work, it dawned on me that the task can be made a lot simpler.

First we set up a variable to hold the running total of units of rainwater. my $rainwater = 0;

And this was my key insight. We only need to keep track of the current tallest column. Initially it is set to the first column.

my $tallest = @N[0];

Then we go through $N element by element.

for 0 ..^ @N.elems -> $i {

If the size of the column is smaller than $tallest, we can add (size of the column) - $tallest units of rainwater...

    if (@N[$i] < $tallest) {
        $rainwater += ($tallest - @N[$i]);
    } else {

...otherwise the size of the column becomes the new value of $tallest.

        $tallest = @N[$i];
    }
}

All that remains once $N has been fully traversed, is to print out the results. The spec is a little ambiguous but it seem to suggest we should print the histogram too.

histogram(@N);
say $rainwater;

As you can see I made a seperate function for the histogram. It is shown below.

sub histogram(@N) {

The .max() method gives the largest value in an array. We need this to determine the maximum height of the histogram. Then we range backwards from the maximum height to 1 to form the y-axis of the graph.

    for @N.max ... 1 -> $y {

The value of Y is printed and then @N is traversed element by element. if the value of the current element is less than the current value of $y a space is returned or if not, a hash symbol. These are all joined together into a string and printed.

        say "$y ",
            (0 ..^ @N.elems).map({ @N[$_] < $y ?? q{ } !! q{#}; }).join(q{});
    }

To make things a little more legible, a row of dashes is printed.

    say '-' x @N.elems + 2;

Finally, the values of @N are printed.

    say q{  }, @N.join(q{});
}

(Full code on Github.)

The Raku code for the main algorithm can be translated into perl straightforwardly.

my $rainwater = 0;
my $tallest = $N[0];

for my $i (0 .. scalar @N - 1) {

    if ($N[$i] < $tallest) {
        $rainwater += ($tallest - $N[$i]);
    } else {
        $tallest = $N[$i];
    }
}

histogram(@N);
say $rainwater;

Translating histogram() is slightly trickier. For one thing, we don't have .max() (unless we use CPAN modules which I would in a real life situation but tend not to in these challenges.) This is a quick replacement.

sub max {
    my (@N) = @_;
    my $maximum = 0;

    for my $i (@N) {
        if ($i > $maximum) {
            $maximum = $i;
        }
    }

    return $maximum;
}

In histogram() itself, we can't do reverse ranges with the handy ... so you have to explicitly use reverse() instead.

sub histogram {
    my (@N) = @_;

    for my $y (reverse 1 .. max(@N)) {
        say "$y ",
            (join q{}, map { $N[$_] < $y ? q{ } : q{#}; } (0 .. scalar @N - 1));
    }
    say '-' x scalar @N + 2;
    say q{  }, (join q{}, @N);
}

(Full code on Github.)