[ch-079/jeongoon] Perl and Raku solution added.

6 files changed, 321 insertions, 58 deletions

diff --git a/challenge-079/jeongoon/perl/blog1.txt b/challenge-079/jeongoon/perl/blog1.txt
new file mode 100644
index 0000000000..2ce996bf47
--- /dev/null
+++ b/challenge-079/jeongoon/perl/blog1.txt
@@ -0,0 +1 @@
+https://dev.to/jeongoon/the-perl-weekly-challenge-079-9ij
diff --git a/challenge-079/jeongoon/perl/ch-1.pl b/challenge-079/jeongoon/perl/ch-1.pl
new file mode 100644
index 0000000000..6190e498bc
--- /dev/null
+++ b/challenge-079/jeongoon/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+use strict; use warnings;
+use v5.26;
+use bignum;
+use List::Util qw(sum);
+
+# dec2bin
+# credit: https://www.oreilly.com/library/view/perl-cookbook/1565922433/ch02s05.html
+# but don't need to remove zero(es).
+sub dec2bin { unpack "B32", pack("N", $_[0]); }
+sub TruncNum { 1000000007 } # spec
+sub usage {
+    say "perl ch-1.pl <N> # where N is positive integer";
+}
+
+BEGIN {
+    eval { defined $ARGV[0] and $ARGV[0] > 0 or die "invalid" };
+    $@ and usage(), exit 0;
+}
+
+sub sumSection ($) {  # sum of the counts of bits between 2^(m) .. 2^(m+1)-1
+    state @K = (1, 3);
+    my $m = shift;
+
+    exists $K[$m] ? $K[$m] : ( $K[$m] = sum( 1<<$m, @K[0..$m-1] ) );
+}
+
+sub sumUptoPow2 ($) { # sum of bits between 0 .. 2^pow
+    sum 1, # sumSection doesn't count the last bits of 2^pow
+      map { sumSection $_ } 0 .. $_[0]-1
+}
+
+sub countSetBits ($);
+sub countSetBits ($) {
+    $_[0] <= 2 and return $_[0];
+    my $N = shift;
+
+    my $N1 = $N;
+
+    my ( $sum, $pow );
+    ++$pow while ( $N1 >>= 1 );
+
+    $N1 = $N - (1<<$pow);
+
+    $sum += sumUptoPow2 $pow;
+    $N1 == 0 ? $sum : ( $sum
+                       + $N1 # the number ( 1..$N1 ) always has one set bit
+                       + countSetBits($N1)    # count without first set bit
+                     );
+    # go recursive until meets 0<= N <= 2
+}
+
+say( countSetBits(shift) % TruncNum );
diff --git a/challenge-079/jeongoon/perl/ch-2.pl b/challenge-079/jeongoon/perl/ch-2.pl
new file mode 100644
index 0000000000..f4ed0b662f
--- /dev/null
+++ b/challenge-079/jeongoon/perl/ch-2.pl
@@ -0,0 +1,164 @@
+#!/usr/bin/env perl
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+use utf8;
+use strict; use warnings;
+use v5.26;
+
+use Getopt::Long qw(:config gnu_compat);
+use Pod::Usage;
+use Term::ANSIColor;
+
+use List::Util qw(min max sum);
+use List::MoreUtils qw(all firstidx);
+
+=pod
+
+=head1 NAME
+
+Challenge 79 Task #2 - Trapped Rain Water
+(https://perlweeklychallenge.org/blog/perl-weekly-challenge-079/)
+
+=head1 SYSNOPSIS
+
+=head1 USAGE
+
+perl ch-2.pl [--help] [--no-utf8] [--no-color] <N> <N> <N> [ <N>*... ]
+
+=cut
+
+=head1 TEST
+
+ perl ch-2.pl --no-colour --no-utf8 2 1 4 1 2 5 6 8 2 1 3 4 8 1 3 2 9 3 7 3
+ Total capacity: 50
+  9|                                 #      
+  8|               # ~ ~ ~ ~ # ~ ~ ~ #      
+  7|               # ~ ~ ~ ~ # ~ ~ ~ # ~ #  
+  6|             # # ~ ~ ~ ~ # ~ ~ ~ # ~ #  
+  5|           # # # ~ ~ ~ ~ # ~ ~ ~ # ~ #  
+  4|     # ~ ~ # # # ~ ~ ~ # # ~ ~ ~ # ~ #  
+  3|     # ~ ~ # # # ~ ~ # # # ~ # ~ # # # #
+  2| # ~ # ~ # # # # # ~ # # # ~ # # # # # #
+  1| # # # # # # # # # # # # # # # # # # # #
+   `----------------------------------------
+     2 1 4 1 2 5 6 8 2 1 3 4 8 1 3 2 9 3 7 3
+
+ you can try with colour and utf8 option if your terminal is supported.
+
+ perl ch-2.pl 2 1 4 1 2 5 6 8 2 1 3 4 8 1 3 2 9 3 7 3
+ https://res.cloudinary.com/practicaldev/image/fetch/s--1OVve57x--/c_limit%2Cf_auto%2Cfl_progressive%2Cq_auto%2Cw_880/https://dev-to-uploads.s3.amazonaws.com/i/0mxarixhc6g8oe3bewx1.png
+
+BEGIN {
+    $::utf8   = 1;
+    $::colour = 1;
+    $::help   = 0;
+
+    GetOptions( 'help'          => \$::help,
+                'utf8!'         => \$::utf8,
+                'color|colour!' => \$::colour,
+              ) or pod2usage(2);
+    if ( $::utf8 ) {
+        binmode( STDERR, ':utf8' );
+        binmode( STDOUT, ':utf8' );
+    }
+
+    eval { ( @ARGV > 2 and all { $_ > 0 } @ARGV ) or die "invalid" };
+    ($@ or $::help)  and pod2usage( -exitval => 0, -verbose => ($::help ? 2:1));
+}
+
+sub ssprintf ($$) { sprintf "%#$_[0]s", $_[1] }
+sub map_ssprintf  { map { sprintf "%#$_[0]s", $_ } @_[1..$#_] }
+
+sub u_($) { # unicode
+    return $_[0] unless $::utf8;
+    my $a = shift;
+    state %u = ( qw{` └
+                    - ─
+                    | │
+                    ~ ≈}, '#' => '■' );
+    $u{$a} // $a
+}
+
+sub ch($$;$) { # unicode with colour
+    my $a  = shift;
+    my $ww = shift // 2;
+    my $colour_str = shift;
+
+    if ( $::colour and defined $colour_str ) {
+        $a eq '#' and $a = ' '; # distinguish by color
+        return colored( [ $colour_str ], ssprintf $ww, u_$a );
+    }
+    return ssprintf $ww, u_$a;
+}
+
+sub printTrappedInWater {
+    my @T = @{$_[0]}; # territory heights
+    my @W = @{$_[1]}; # water capacty
+
+    my $maxh = max @T;                  # max height
+    my $ww   = 1 + length $maxh;        # word width
+
+    for my $y ( reverse 1 .. $maxh ) {
+        my $line = ssprintf $ww, $y;
+        $line .= u_"|";
+        for my $x ( 0.. $#T ) {
+            my $ch;
+            if ( $T[$x] >= $y ) {
+                $ch = ch("#", $ww, 'black on_yellow' );
+            }
+            elsif ( $W[$x] > 0 and $T[$x]+$W[$x] >= $y ) {
+                $ch = ch("~", $ww, 'black on_cyan');
+            }
+            else {
+                $ch = ch(" ", $ww);
+            }
+            $line .= $ch;
+        }
+        say $line;
+    }
+
+    say ssprintf( $ww, " " ), u_"`",
+      map_ssprintf( $ww, ( (u_("-") x $ww ) x scalar @T ) );
+    say ssprintf($ww, " "), " ",map_ssprintf( $ww, @T );
+}
+
+package main;
+
+my @T = @ARGV;
+my @W = (0) x scalar @T; # for water capacity per column
+my ( $start, $left ) = ( 0, $T[0] );
+
+for ( my $x = 1; $x < @T; ) {
+    if ( $left <= $T[$x] ) { # increasing only: no useful data
+        ( $start, $left ) = ( $x, $T[$x] );
+        ++$x;
+    }
+    elsif ( (my $ri = firstidx { $_ >= $left } @T[$x..$#T]) >= 0 ) {
+        my $abs_ri = $x+$ri;
+        my $water_level = min( $left, $T[$abs_ri] );
+        for (($start+1) .. ($abs_ri-1)) { # water area only
+            $W[$_] = $water_level - $T[$_]
+        }
+
+        ( $start, $left ) = ( $x, $T[$abs_ri] );
+        $x += $ri;
+    }
+    else { # generally decreasing ...
+           # find a tallest one as right boundary
+        my $tallest = max @T[$x .. $#T];
+        if ( (my $ri = firstidx { $_ == $tallest } @T[$x..$#T]) >= 0 ) {
+            my $abs_ri = $x+$ri;
+            my $water_level = min( $left, $T[$abs_ri] );
+
+            for (($start+1) .. ($abs_ri-1)) {
+                $W[$_] = $water_level - $T[$_];
+            }
+        }
+        last; # no more useful data
+    }
+}
+
+say "Total capacity: ",sum(@W);
+printTrappedInWater( \@T, \@W );
+
diff --git a/challenge-079/jeongoon/raku/ch-1.raku b/challenge-079/jeongoon/raku/ch-1.raku
new file mode 100644
index 0000000000..8d2b049927
--- /dev/null
+++ b/challenge-079/jeongoon/raku/ch-1.raku
@@ -0,0 +1,36 @@
+#!/usr/bin/env raku
+# -*- Mode: Raku; indent-tabs-mode: nil; coding: utf-8 -*-
+# vim: set et ts=4 sw=4:
+use v6.d;
+
+constant big-num = 1000000007; # (10**9+7)
+our &trunc = (*%(big-num)); # as spec requested. but no need in raku.
+our &naive = {[+] (.base(2).indices(1).elems for ^$_[0]+1)};
+
+# this is the rule what I found. I guess this is not bad.
+sub sum-a-section ($m) {
+    state @K = 1, 3;
+    say "{@K}";
+    # summation of the counts of bits between 2**(m) .. 2**(m+1)-1
+    @K[$m]:exists ?? @K[$m] !! ( @K[$m] = [+] (1+<$m), |@K[0..$m-1] );
+}
+
+sub sum-upto-power2 ($pow) { # bits sum between 0 .. 2^pow
+    [+] 1, |(sum-a-section($_) for 0..($pow-1));
+}
+
+sub count-set-bits ( UInt \N ) {
+    N <= 2 and N.return;
+    #N < 999 and naive(N).return; # no noticeable difference
+
+    my $N = N;
+    my ( $sum, $m );
+    ++$m while $N +>= 1;
+
+    $N = N - (1+<$m);
+    say "??? {$N}";
+    $sum += sum-upto-power2($m);
+    $N == 0 ?? $sum !! $sum + $N + count-set-bits($N);
+}
+
+our &MAIN=&say∘&trunc∘&count-set-bits;
diff --git a/challenge-079/jeongoon/raku/ch-1.short.raku b/challenge-079/jeongoon/raku/ch-1.short.raku
index 763d8635d8..e758c706c2 100644
--- a/challenge-079/jeongoon/raku/ch-1.short.raku
+++ b/challenge-079/jeongoon/raku/ch-1.short.raku
@@ -1,5 +1 @@
-#!/usr/bin/env raku
-# -*- Mode: Raku -*-
-use v6.d;
-# works only equal or less than 65535
-our &MAIN=&say∘&sum∘(*.map(*.base(2).comb.grep(1).elems))∘(^(*+1));
+our &MAIN=&say∘(*%(10**9+7))∘{[+] (.base(2).indices(1).elems for ^$_[0]+1)}
diff --git a/challenge-079/jeongoon/raku/ch-2.raku b/challenge-079/jeongoon/raku/ch-2.raku
index b401839297..c597609a3d 100644
--- a/challenge-079/jeongoon/raku/ch-2.raku
+++ b/challenge-079/jeongoon/raku/ch-2.raku
@@ -5,77 +5,87 @@
 use v6.d;
 
 # test with:
-# raku jeongoon/ch-2.raku 2 1 4 1 2 5 # exmaple 1
-# raku jeongoon/ch-2.raku 3 1 3 1 1 5 # exmaple 2
-# raku jeongoon/ch-2.raku 1 2 3 4 3 1 # a mountain: no rain trapped
+# raku jeongoon/raku/ch-2.raku 2 1 4 1 2 5 # exmaple 1
+# raku jeongoon/raku/ch-2.raku 3 1 3 1 1 5 # exmaple 2
+# raku jeongoon/raku/ch-2.raku 1 2 3 4 3 1 # a mountain: no rain trapped
+# raku jeongoon/raku/ch-2.raku 2 1 4 1 2 5 6 8 2 1 3 4 8 1 3 2 9 3 7 3 # long
 
 unit sub MAIN ( *@T where { @T.elems > 0 and @T.all ~~ UInt } );
 #@T = @T».UInt; # unnecessary here. but note that thery are IntStr
 
-enum territory-stage
-<terri-nothing   terri-wall   terri-mountain
- terri-lake>; # terri-lake is not used here
-
 role lake {
-    method get-capacity( @territory = self.List ) {
-        # we need at least 3 data to build a water reservoir
-        @territory.elems < 3 and 0.return;
-        with @territory {
+    method get-capacity-info( $territory-data = self ) {
+        my ( $range, $terri ) = $territory-data.kv; # k: Range, v: List
+        # we need at least 3 data to build a water reservoir : will check later
+        #$terri.elems < 3 and (Nil => 0).return;
+        with $terri {
             my $water-level = min( .head, .tail );
             my @t = .[ 1 .. * -2 ];
-            @t.max > $water-level and 0.return;
-            ( [+] ( $water-level X- @t ) ).return;
+            #@t.max > $water-level and (Nil => 0).return; # will check later
+            ($range.[1 .. * -2] => ($water-level X- @t).cache ).return;
+            # k: Range, v: capacity
         }
     }
 }
 
-# we can do some brute-force for any combinations of region but
-# let's scan the territory and find proper lake region
 my $terri = class TerriInfo {
-    has ( $.left, $.right, $.start,
-          territory-stage $.stage  ) is rw;
-    method has-valley ( $pos-x ) { $pos-x - $!start > 1 }
-}.new( :left(0):start(0):stage(terri-nothing) );
+    has ( $.left, $.start ) is rw;
+    has @.T;
+    method export-lake($x) { ((self.start..$x)
+                              => (@!T[ self.start..$x ])) does lake }
+}.new( :T(@T):left(@T[0]):start(0) );
 
-my lake @lakes;
-
-for @T.kv -> $x, $h {
-    given $terri {
-        when .stage before terri-wall {
-            ( .left, .start, .stage ) = $h, $x, terri-wall;
-        }
-        when .stage before terri-mountain {
-            if .left <= $h {  # no useful data on the left hand side
-                           # -> update left boundary and position
-                ( .left, .start ) = $h, $x;
-            }
-            else { # has at lesast one lower height than left boundary
-                ( .right, .stage ) = $h, terri-mountain;
-            }
+my @lakes;
+# let's scan the territory and find proper lake region
+given $terri {
+    loop ( my $x = 1; $x < @T.elems; ) {
+        if .left <= @T[$x] { # climbing only: no useful data
+            ( .start, .left ) = $x, @T[$x];
+            ++$x;
         }
-        when  .left < $h { # and .stage eq terri-mountain
-            # found a lake
-            @lakes.push( @T[ .start .. $x ] does lake );
-            # right boundary is higher than left one and has valley
-            # -> start new scan with right boundary as new left boundary
-            $_ = TerriInfo.new( :start($x):left($h):stage( terri-wall ) );
-            next;
+        elsif my $right = @T[$x..*].pairs.first( *.value >= .left ) {
+            @lakes.push( .export-lake( $x+$right.key ) );
+            ( .start, .left ) = $x, $right.value;
+            $x += $right.key;
         }
-        default { # .left >= $h
-            # second-tallest height -> become a  temporary right boundary
-            .right < $h and .right = $h;
-
-            # otherwise we may have some water bucket here
-            # but still unsure until reach the right boundary
+        else { # generally desceding:
+               # find a tallest wall as right boundary
+            if ( my $right = @T[$x..*].pairs.max( *.value ) ) {
+                @lakes.push( .export-lake( $x+$right.key) );
+            }
+            last; # no more useful data: finish up.
         }
     }
+}
+
+my @lakes-info = @lakes».get-capacity-info;
+say "Total capacity: ", ([+] @lakes-info».value».sum),"\n";
+
+sub ssprintf ( UInt:D $w, $str ) { sprintf( "%#{$w}s", $str ) }
 
-    LAST {
-        # check if any possble lake remained
-        .stage eq terri-mountain
-        and @lakes.push( @T[ .start .. * ] does lake ) with $terri;
+# print histogram
+my @histo;
+my $mh = max @T;
+my $ww = $mh.chars + 1;
+for $mh ... 1 -> $y {
+    my $line = ssprintf( $ww, $y ) ~ '│';
+    for @T.kv -> $x, $h {
+        my $ch = " "; # assume air (can be changed later)
+        if $h >= $y {
+            $ch = "#";
+        }
+        else {
+            my ( $range, $cap ) = @lakes-info.first( $x ∈ *.key ).kv;
+            with $cap andthen $cap.[ $x -$range.[0] ] {
+                    $_ + $h >= $y and $ch = "≈";
+            }
+        }
+        $line ~= ssprintf( $ww, $ch );
     }
+    @histo.push($line);
 }
 
-my &say-simple-answer = &say ∘ &sum ∘ ( *.map( *.get-capacity ) );
-say-simple-answer @lakes;
+@histo.join("\n").say;
+
+say ssprintf( $ww, " " ) ~ '└' ~ ( "─" x ( $ww * @T.elems ) );
+say ssprintf( $ww, " " ) ~ ' ' ~ [~] @T.map( -> $h { ssprintf( $ww, $h ) });