This is my response to the Perl Weekly Challenge #079.
$N.
1 to $N and return
$total_count_set_bit % 1000000007.
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`
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`.
This can be done with a minimum amount of code:
File: count-set-bits
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0); # [1]
say (1..$N).map({ $_.fmt('%b') })>>.comb.flat.sum % 1000000007;
#### 2 #### # 3 ################ # 4 ### # 5 # 6 # 7 #######
[1] The challenge says that $N is a «positive number», but I have chosen
to restrict it to a «positive integer». The expression «all numbers from 1
to $N does not make sense otherwise.
[2] For all the integers from 1 to $N,
[3] • convert the number to binary,
[4] • split all the binary numbers into single characters,
[5] • and get the sum of all of them - which is the number of 1s.
[6] • apply flat to get a single list (one dimentional) of binary digits.
[7] • and apply the %. The say at the front of the line
takes care of printing the result
Do you wonder why the flat in [6] is required?
> (1,2,3,4,5,6,7,8,9,10).sum
55
> ((1,2,3,4,5),(6,7,8,9,10)).sum
10
> ((1,2,3,4),(5,6,7,8,9,10,11)).sum
11
> ((1,2,3,4),(5,6,7,8,9,10,11,12)).sum
12
> ((1,1,0,0,0),(1,0,0,0,0)).sum
10
> ((1,1,0,0,0),(1,0,0,0,0)).flat.sum
3
sum is counting the number of elements when we apply it on a list of lists,
which obviously is not what we want as it includes the zeroes in the count.
Running it:
$ ./count-set-bits 1
1
$ ./count-set-bits 2
3
$ ./count-set-bits 3
5
$ ./count-set-bits 4
8
$ ./count-set-bits 5
11
$ ./count-set-bits 6
14
$ ./count-set-bits 7
17
#! /usr/bin/env perl
use feature 'say';
use List::Util qw/sum/;
my $N = $ARGV[0] // die 'Missing value for $N';
die '$N must be a positive integer' unless $N > 0 && int($N) == $N;
say sum(split("", join("", map { sprintf('%b', $_) } 1 .. $N))) % 1000000007;
The result is the same, but it gets there in not-quite-the-same-way as the Raku version.
Perl does not have comb, but split on an empty string is close
enough. The join is there to merge the individual values in the list into a
long string. (I could have done that in Raku as well.)
The Perl code is much harder to follow.
$ ./count-set-bits 199
732
$ ./count-set-bits-perl 199
732
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
say cbs($N) % 1000000007;
multi sub cbs (Int $N)
{
return $N.fmt('%b')>>.comb.flat.sum + cbs($N-1);
}
multi sub cbs (1)
{
return 1;
}
gather/take):
File: count-set-bits-sequence
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
my $csb := gather
{
take ""; # [1]
take 1;
state $sum = 1;
state $count = 1;
loop
{
$sum += (++$count).fmt('%b')>>.comb.flat.sum;
take $sum;
}
}
say $csb[$N] % 1000000007;
[1] This takes care of people trying to access $csb[0], which clearly is
not a thing.
We can easily add an «upto» mode:
File: count-set-bits-sequence-upto
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :u(:$upto));
my $csb := gather
{
take "";
take 1;
state $sum = 1;
state $count = 1;
loop
{
$sum += (++$count).fmt('%b')>>.comb.flat.sum;
take $sum;
}
}
$upto
?? ( say "$_ (binary { $_.fmt('%b') }): { $csb[$_] % 1000000007 }"
for 1 .. $N )
!! say $csb[$N];
Running it in «upto» mode:
$ ./count-set-bits-sequence-upto -u 10
1 (binary 1): 1
2 (binary 10): 2
3 (binary 11): 4
4 (binary 100): 5
5 (binary 101): 7
6 (binary 110): 9
7 (binary 111): 12
8 (binary 1000): 13
9 (binary 1001): 15
10 (binary 1010): 17
11 (binary 1011): 20
12 (binary 1100): 22
13 (binary 1101): 25
14 (binary 1110): 28
15 (binary 1111): 32
16 (binary 10000): 33
17 (binary 10001): 35
18 (binary 10010): 37
19 (binary 10011): 40
20 (binary 10100): 42
I have added the binary version of the number to the output, so that you easily can verify that the program got it right.
@N.
5 #
4 # #
3 # #
2 # # # #
1 # # # # # #
_ _ _ _ _ _ _
2 1 4 1 2
1 unit of rain water
between 1st and 3rd column. Similary it can trap 5 units of rain water betweem
3rd and last column.
6.
5 #
4 #
3 # # #
2 # # #
1 # # # # # #
_ _ _ _ _ _ _
3 1 3 1 1 5
Input:
@A = (7 4 2 6 3)
@B = (1 3 4)
2 units of rain water
between 1st and 3rd column. Also it can trap 4 units of rain water between 3rd
and last column.
6.
The number of units we can trap can be deducted by inspecting the changes in the values in the array, after we have filled it.
Let us consider the second example:
Before After
5 # 5 #
4 # 4 #
3 # # # 3 # * # * * #
2 # # # 2 # * # * * #
1 # # # # # # 1 # # # # # #
_ _ _ _ _ _ _ _ _ _ _ _ _ _
3 1 3 1 1 5 3 3 3 3 3 5
We filled in 6 units. We can get that number by adding together the values from the «After» array (20) and subtract the sum of values from the «Before» array (14), giving 6.
We fill in the gaps (with water) by applying a sliding window. Not the actual Sliding window protocol, but in more literal sense.
We set a left and right limit, and move them along so that we get all the possible combinations, as long as the minimum size is 3, as we cannot fill something without a space in the middle (2 walls, 1 empty room). We do this for all the possible sliding windows, and the result is a fully filled up histogram.
If we start out with a list with size 5, we get the following windows:
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
For each window, we take the leftmost and rightmost values as the outer edges. The lowest edge is the limit for how much we can pour in, and we do just that in the cells between the edges.
The challenge doesn't actually state that we should show the histogram, but I will do so anyway. And I will use colour to accentuate what is going on.
The ANSI Control Sequences can be used to set and unset the colours when we print to the terminal (shell). See my Raku Gather, I Take or The Email Queen with Raku articles for examples.
The ANSI codes do not work with HTML pages, but we can fix that by using Bootstrap colours instead. My The Email Queen with Raku article did just that.
The following program works best for single digit values. You will get indentation issues if you use higher values. Also note that it includes a lot of extra code to support the extra bells and whistles (which you can enable with command line options), making it more complex than strictly necessary.
File: trapped-rain-water (partial)
#! /usr/bin/env raku
unit sub MAIN
(
*@N where @N.elems > 0 && all(@N) ~~ Int && all(@N) > 0, # [1]
:v(:$verbose), # [2]
:s(:$show), # [3]
:h(:$html) # [3a]
);
if @N.elems == 1|2 # [4]
{
say 0; # [4]
exit; # [4]
}
my $col-blue = "\e[44m"; # [5]
my $col-green = "\e[42m";
my $col-red = "\e[101m";
my $col-stop = "\e[0m";
if ($html) # [6]
{
$col-blue = '<span class="text-primary">';
$col-green = '<span class="text-success">';
$col-red = '<span class="text-danger">';
$col-stop = '</span>';
}
my $old-sum = @N.sum; # [7]
my $elems = @N.elems; # [8]
my @N-new = @N; # [9]
say ": Old sum: $old-sum" if $verbose;
[1] At least one element, integers only and values higher than zero.
[2] Verbose mode.
[3] Show the histogram with this comamnd line option, in teminal [3] or HTML [3a] mode.
[4] We need at least three values to be able to fill
the middle cell. Bail out if the number is 1 or 2, set up with |
to give a Junction.
[5] Set up the ANSI colour sequences. Note that we do not need all of them, so they are here for completeness.
[6] Use this markup instead of the ANSI sequences, in HTML mode.
[7] Get the sum of the array.
[8] The length of the array.
[9] A copy of the array. We need this later on, when we compare the old and new values.
See docs.raku.org/type/Junction for more information about Junctions.
File: trapped-rain-water (partial)
for 0 .. $elems -3 -> $left # [10]
{
for $elems -1 ... $left +2 -> $right # [10a]
{
show-sliding-window($left, $right, $col-green, "Before filling", @N-new)
if $verbose; # [11]
my @old = @N-new; # [11a]
my $L = @N-new[$left]; # [12]
my $R = @N-new[$right]; # [12a]
my @A = @N-new[$left+1 .. $right-1]; # [12b]
my $min = min($L, $R); # [13]
if $min > any (@A) # [14]
{
for $left+1 .. $right-1 -> $index # [14a]
{
@N-new[$index] = $min if @N-new[$index] < $min;
} # [14b]
}
show-sliding-window($left, $right, $col-blue, "After filling ", @old)
if $verbose; # [11b]
}
}
my $new-sum = @N-new.sum; # [15]
say ": New sum: $new-sum" if $verbose;
show-histogram if $show; # [16]
say $new-sum - $old-sum; # [17]
[10] For all the sliding windows (by iterating the left [10] and right [10a] side,
[11] • show the original sliding window. Then we save the values [11a], so that we can show the sliding window again [11b] after possibibly changing the content. Giving a before and an after line.
[12] Get the left border [12], the righ border [12a] and the values between them [12b].
[13] The height of the border (the lowest value; i.e. before it spills over).
[14] Can we fill in anything, using an any Junction [14]. If so, iterate over
the cells inside the sliding window [14a], and fill in when possible [14b].
[15] Get the new sum.
[16] Show the histogram, if requested.
[17] Print the answer.
Running the program on the examples given in the challenge gives the same result:
$ ./trapped-rain-water 2 1 4 1 2 5
6
./trapped-rain-water 3 1 3 1 1 5
6
Let us take a look at the sliding windows. First the additional code, then the output.
File: trapped-rain-water (show-sliding-window)
sub show-sliding-window($left, $right, $col, $label, @old) # [18]
{
print ": $label: ";
for ^@N -> $index
{
if $index < $left || $index > $right # [19]
{
print @N-new[$index] ~ " ";
}
elsif @N-new[$index] == @old[$index] # [20]
{
print $col ~ @N-new[$index] ~ " " ~ $col-stop;
}
else
{
print $col-red ~ @N-new[$index] ~ " " ~ $col-stop; # [21]
}
}
print "\n";
}
[18] The last argument is an array with values to compare with.
[19] Show values outside of the sliding window without colour.
[20] Inside: Show values that has not changed with the specified colour.
[21] Inside: Show values that has changed with red.
Verbose mode («-v», «--v», «-verbose» or «--verbose») shows the sliding windows, and the changes in the values they are responsible for as we go along:
The part of the array that we look at as a sliding window is highlighted, with green in the «before» line, and blue in the «after» line. Ant values that have changed (in this iteration) are marked with red.
$ ./trapped-rain-water -v 2 1 4 1 2 5
: Old sum: 15
: Before filling: 2 1 4 1 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 2 2 5
: Before filling: 2 2 4 2 2 5
: After filling : 2 2 4 4 4 5
: Before filling: 2 2 4 4 4 5
: After filling : 2 2 4 4 4 5
: Before filling: 2 2 4 4 4 5
: After filling : 2 2 4 4 4 5
: New sum: 21
6
$ ./trapped-rain-water -v 3 1 3 1 1 5
: Old sum: 14
: Before filling: 3 1 3 1 1 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: Before filling: 3 3 3 3 3 5
: After filling : 3 3 3 3 3 5
: New sum: 20
6
Then we can take a look at the histogram. Anything filled in duiring the sliding window
part (present in @N-new and not @N) is shown in red.
sub show-histogram
{
my $rows = @N.max; # [22]
my $cols = @N.elems; # [23]
for $rows ... 1 -> $row
{
print ": $row ";
for 1 .. $cols -> $col
{
if @N[$col-1] >= $row
{
print "# "; # [24]
}
elsif @N-new[$col-1] >= $row
{
print $col-red ~ "#" ~ $col-stop ~ " "; # [25]
}
else
{
print " ";
}
}
print "\n";
}
say ": " ~ "-" x $cols + $cols + 2;
say ": ", @N.join(" "), " (before)";
say ": ", @N-new.join(" "), " (after)";
}
[22] The height of the histogram (=number of rows).
[23] The width (=number of values).
[24] A value present in the original arary.
[25] A value added in the sliding window phase; shown in red.
The colour coded histogram makes it easy to verify the result:
$ ./trapped-rain-water -s 2 1 4 1 2 5
: 5 #
: 4 # # # #
: 3 # # # #
: 2 # # # # # #
: 1 # # # # # #
: --------------
: 2 1 4 1 2 5 (before)
: 2 2 4 4 4 5 (after)
6
$ ./trapped-rain-water -s 3 1 3 1 1 5
: 5 #
: 4 #
: 3 # # # # # #
: 2 # # # # # #
: 1 # # # # # #
: --------------
: 3 1 3 1 1 5 (before)
: 3 3 3 3 3 5 (after)
6
Another one, with verbose mode and the histogram:
$ ./trapped-rain-water -v -s -h 5 1 6 1 1 2
: Old sum: 16
: Before filling: 5 1 6 1 1 2
: After filling : 5 2 6 2 2 2
: Before filling: 5 2 6 2 2 2
: After filling : 5 2 6 2 2 2
: Before filling: 5 2 6 2 2 2
: After filling : 5 2 6 2 2 2
: Before filling: 5 2 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: Before filling: 5 5 6 2 2 2
: After filling : 5 5 6 2 2 2
: New sum: 22
: 6 #
: 5 # # #
: 4 # # #
: 3 # # #
: 2 # # # # # #
: 1 # # # # # #
: --------------
: 5 1 6 1 1 2 (before)
: 5 5 6 2 2 2 (after)
6
Don't like bells and whistles? The zip file has a file «trapped-rain-water-plain» where I have removed them.
No Perl version of this one. I have run out of time.
And that's it.