add Perl and Raku solution

6 files changed, 438 insertions, 1 deletions

diff --git a/challenge-075/jeongoon/haskell/ch-2.hs b/challenge-075/jeongoon/haskell/ch-2.hs
index 482bbf3175..934aad2211 100644
--- a/challenge-075/jeongoon/haskell/ch-2.hs
+++ b/challenge-075/jeongoon/haskell/ch-2.hs
@@ -6,7 +6,6 @@ import Data.List (unfoldr)
 import System.Exit (die)
 
 -- solution
-
 getLargestRectArea :: [Int] -> Int
 getLargestRectArea hdata = maximum allPossibleAreas where
   allPossibleAreas =  map calcArea1 [ 0 .. (dataLen - 1) ]
diff --git a/challenge-075/jeongoon/perl/CombinationsIndex.pm b/challenge-075/jeongoon/perl/CombinationsIndex.pm
new file mode 100644
index 0000000000..47dbcde67f
--- /dev/null
+++ b/challenge-075/jeongoon/perl/CombinationsIndex.pm
@@ -0,0 +1,121 @@
+# -*- Mode: cperl; cperl-indent-level:4; tab-width: 8; indent-tabs-mode: nil -*-
+# Copyright (c) 2013,2020 JEON Myoungjin <jeongoon@gmail.com>
+use strict; use warnings;
+
+use version 0.77 our $VERSION = version->declare( '0.2' );
+package CombinationsIndex;
+
+use parent 'Exporter';
+our @EXPORT_OK = qw(combinationsIndex);
+
+=pod
+
+=head1 Basic concept
+
+If we find the combintions when choosing 3 digits from index of 0 .. 4
+which shown below
+
+  0  1  2  3  4
+ ^1 ^2 ^3         initial selection: index position: ( 0, 1, 2 )
+
+to get next combination we can move ^3 cursor from 2 to 3
+
+  0  1  2  3  4
+ ^1 ^2    ^3      note: ^3 can move up to 4
+
+as you can see ^3 can only go up to 4, next movement we can imagine is that
+moving ^2 to next one and ^3 is just followed by ^2
+and next movement will be again ^3 to the index 4
+
+  0  1  2  3  4       =>    0  1  2  3  4      =>     0  1  2  3  4
+ ^1 ^2       ^3            ^1    ^2 ^3               ^1    ^2    ^3
+
+and last case of combinations will be
+
+  0  1  2  3  4
+       ^1 ^2 ^3
+
+so I make two arrays to record
+   1. where each cursor is pointing now,
+   2. how many rooms left for each cursor to move
+
+and also remember what is the current cursor move next.
+
+so we can also make combinations without recursive routine.
+
+=cut
+
+sub combinationsIndex ( $$ ) {
+    my $N   = $_[0];            # number of selection
+    my $M   = $_[1];            # choice" 0 .. ($M - 1)
+
+    my @result;
+
+    # minimum sanity check
+    if ( $M < $N ) {
+        warn "unable to choose $N from given selection of $M";
+        return ();
+    }
+
+    my ( @room,         # number of spaces(rooms) each
+         @pos,          # current position of cursor
+         $next_csr      # next cursor to move
+       );
+
+    # set initial values ...
+    {
+        # each finger can move to right number of ( M-N ) space(s).
+        @room     = ( $M-$N ) x $N;
+        @pos      = 0 .. ($N - 1);
+        $next_csr = $N - 1; # last cursor at rightmost
+
+        # initial record; note: use not index number but real value
+        push @result, [ @pos ];
+    }
+
+    {
+        if ( $room[$next_csr] > 0 ) {
+            # current csr can move to right so just do it.
+            ++$pos[ $next_csr];
+            --$room[$next_csr]; # room decreased of course
+
+            # and make a record
+            push @result, [ @pos ];
+            redo;
+        }
+        else {
+            # no more room to move
+            # so find the next cursor to move
+            my $found = 0;
+            for ( my $i = $next_csr; $i > 0; --$i ) {
+                if ( $room[ $i-1 ] > 0 ) {
+                    $next_csr = $i-1;
+                    $found = 1;
+                    last ;
+                }
+            }
+
+            if ( $found ) {
+                # move all the cursors which are starts from
+                # $next_csr to last one
+                @pos[ $next_csr .. ($N-1) ]
+                    = map { $pos[$next_csr] + $_ } 1 .. ($N-$next_csr);
+                # note: all these finger has same room when moved
+                @room[ $next_csr .. ($N-1) ]
+                  = ( $room[ $next_csr ] - 1 ) x        ($N-$next_csr);
+
+                # and make a record
+                push @result, [ @pos ];
+
+                # next finger to move will be ($N-1)
+                # or even if it is not next loop will find anohter
+                $next_csr = ($N-1);
+
+                redo; # if we can move next cursor
+            }
+        }
+    }
+    @result;
+}
+
+!!"^^";
diff --git a/challenge-075/jeongoon/perl/ch-1.pl b/challenge-075/jeongoon/perl/ch-1.pl
new file mode 100644
index 0000000000..e089621853
--- /dev/null
+++ b/challenge-075/jeongoon/perl/ch-1.pl
@@ -0,0 +1,49 @@
+#!/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 feature qw(say);
+
+# solution
+sub combiCoinSum {
+    my $S  = shift;
+    my @RC = sort { $b <=> $a } @_;   # (R)est of (C)oins (sorted)
+    my $fc = shift @RC;               # (f)irst (c)oin
+
+    defined $fc or ( warn "no coins provided", return ());
+
+    my @result;
+
+    my $maxNoc = int $S / $fc ;
+    for my $noc ( reverse 0 .. $maxNoc ) {
+        my $change  = $S -$fc * $noc;
+        my @coins   = ( $fc ) x $noc;
+        if ( $change > 0 ) {
+            push @result, map { [ @coins, @$_ ] } combiCoinSum( $change, @RC );
+        }
+        else { push @result, [ @coins ] }
+    }
+    @result;
+}
+
+# testing
+package main;
+
+sub usage {
+    say "perl ch-1.pl <sum> <coins ...>\n";
+}
+sub raku_array { "[".(join ", ", @_)."]" }
+
+scalar @ARGV < 2 and ( usage, exit -1 );
+
+my $S = shift;
+my @C = @ARGV;
+my @combi = combiCoinSum( $S, @C );
+
+say "Input:";
+say "\@C = @{[raku_array @C]}";
+say "\$S = $S";
+say "Output: @{[scalar @combi ]}";
+say "possible ways are:";
+say "@{[raku_array @$_ ]}" for @combi;
diff --git a/challenge-075/jeongoon/perl/ch-2.pl b/challenge-075/jeongoon/perl/ch-2.pl
new file mode 100644
index 0000000000..029cab4a47
--- /dev/null
+++ b/challenge-075/jeongoon/perl/ch-2.pl
@@ -0,0 +1,159 @@
+#!/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;
+no warnings "experimental::smartmatch";
+use v5.14; # say, switch
+
+use Getopt::Long qw(:config gnu_compat);
+use Pod::Usage;
+use Term::ANSIColor;
+use List::Util qw(min max);
+
+use FindBin;
+use lib ( $FindBin::Bin );
+use CombinationsIndex qw(combinationsIndex);
+
+BEGIN {
+    $::utf8   = 1;
+    $::colour = 1;
+
+    GetOptions( 'help'          => \$::help,
+                'utf8!'         => \$::utf8,
+                'color|colour!' => \$::colour,
+              ) or pod2usage(2);
+    if ( $::utf8 ) {
+        binmode( STDERR, ':utf8' );
+        binmode( STDOUT, ':utf8' );
+    }
+}
+
+=pod Largest Rectangle Histogram
+
+perl ch-2.pl [--help] [--no-utf8] [--no-color] <histogram data ...>
+
+=cut
+
+# I guess List::Util is a standard library
+#sub min {
+#    scalar @_ == 0 and warn "no values are given";
+#    my $min = shift;
+#    ( $_ < $min ) and ( $min = $_ ) for @_;
+#    $min
+#}
+#sub max {
+#    scalar @_ == 0 and warn "no values are given";
+#    my $max = shift;
+#    ( $_ > $max ) and ( $max = $_ ) for @_;
+#    $max
+#}
+
+# solution
+sub allPairOfAreaRange {
+# return as [ area1, area2 ... ], [ [range1], [range2], ... ] in the same order
+    my @H = @_;
+    my @range;
+    my @area;
+
+    # there are chance one peak data can create the largest area
+    push @range, map { [$_, $_] } @H;
+    push @area,  map { $_ } @H;       # areas by (width of one) X (each height)
+
+    # range combinations
+    my @range_comb = combinationsIndex 2, (scalar @H);
+    push @range, @range_comb;
+    push @area,  map {
+        # my ( $i0, $i1 ) = ( min @$_, max @$_ );
+        my ( $i0, $i1 ) = @$_; # combinationsIndex always return sorted values.
+        my $common_h    = min @H[ $i0 .. $i1 ];
+        $common_h * ( $i1 - $i0 +1 );
+    } @range_comb;
+
+    [ @area ], [ @range ]
+}
+
+sub getLargestRectArea { max @{ (allPairOfAreaRange@_ )[0] } }
+
+# bonus
+sub raku_array { "[".(join ", ", @_)."]" } # from ch-1.pl
+# from #074/ch-1.pl
+sub ssprintf ($$) { sprintf "%#$_[0]s", $_[1] }
+sub map_ssprintf  { map { sprintf "%#$_[0]s", $_ } @_[1..$#_] }
+sub u_($) {
+    return $_[0] unless $::utf8;
+    my $ch;
+    for ($_[0]) {
+        $ch = '└' when '`';
+        $ch = '─' when '-';
+        $ch = '│' when '|';
+        $ch = '■' when '#';
+        default { $ch = $_[0] }
+    }
+    $ch;
+}
+
+sub printLargestRectArea {
+    my @H      = @_;
+    my @result = allPairOfAreaRange @H;
+    my @ar     = @{$result[0]};
+    my @rg     = @{$result[1]};
+
+    my $maxh = max @H;                  # max height
+    my $ww   = 1 + length $maxh;        # word width
+
+    my $arL   = max @ar;                # area Largest
+    my @rgL;
+
+    for my $i ( 0..$#ar ) {
+        $ar[$i] == $arL and ( push @rgL, $rg[$i] ) # multiple largest area ??
+    }
+
+    say "Input: "  . raku_array( @H );
+    say "Output: " . $arL;
+    say "Where:";
+
+    for my $y ( reverse 1 .. $maxh ) {
+        my $line = ssprintf $ww, $y;
+        $line .= u_"|";
+
+        if ( $::colour ) {
+            for my $x ( 0 .. $#H ) { # go through histogram data
+                my $ch = " ";
+                my $x_in_largest_rectangle = 0;
+                if ( $H[$x] >= $y ) {
+                    for my $r (@rgL) {
+                        if ( $$r[0] <= $x and $x <= $$r[1] ) {
+                            my $common_h = min @H[ $$r[0] .. $$r[1] ];
+                            $x_in_largest_rectangle = $common_h >= $y;
+                        }
+                    }
+                    $line .= colored( [ $x_in_largest_rectangle
+                                        ? 'black on_yellow'
+                                        :'black on_white' ], ssprintf $ww, u_$ch );
+                }
+                else {
+                    $line .= ssprintf $ww, " ";
+                }
+            }
+        }
+        else {
+            $line .= join "",
+              map_ssprintf $ww, ( map { $_ >= $y ? u_"#" : u_" " } @H );
+        }
+        say $line;
+    }
+
+    say ssprintf( $ww, " " ), u_"`",
+      map_ssprintf( $ww, ( (u_("-") x $ww ) x scalar @H ) );
+    say ssprintf($ww, " "), " ",map_ssprintf( $ww, @H );
+}
+
+# testing
+package main;
+
+( $::help or scalar @ARGV < 1 )
+  and pod2usage( -exitval => 0 -verbose => 2 );
+
+printLargestRectArea @ARGV;
diff --git a/challenge-075/jeongoon/raku/ch-1.raku b/challenge-075/jeongoon/raku/ch-1.raku
new file mode 100644
index 0000000000..7cb85944b5
--- /dev/null
+++ b/challenge-075/jeongoon/raku/ch-1.raku
@@ -0,0 +1,47 @@
+#!/usr/bin/env raku
+# -*- Mode: Raku; indent-tabs-mode: nil; coding: utf-8 -*-
+# vim: set et ts=4 sw=4:
+
+use v6.d;
+
+subset Coin of Int where { $^a > 0 }
+
+# solution
+sub combiCoinSum ( Coin:D $S, @C ) {
+    my @result;
+    my @RC = @C.sort( { $^b <=> $^a } );  # (R)est of (C)oins
+    my $fc = shift @RC;                  # (f)irst (c)oin
+
+    $fc.defined or ().return;
+
+    my $max-noc = $S div $fc;
+    for $max-noc ... 0 -> $noc {
+        my $change = $S - $fc * $noc;
+        my @coins  = $fc xx $noc;
+        if $change > 0 {
+            with (combiCoinSum( $change, @RC )) {
+                if .elems > 0 {
+                    .map( -> @rest-coins
+                          { @result.push( [ |@coins, |@rest-coins ] ) } );
+                }
+            }
+        }
+        elsif @coins.elems > 0 {
+            @result.push( @coins );
+        }
+    }
+    @result;
+}
+
+# testing
+sub MAIN (
+    Coin:D $S,                                   #= sum of coins
+    **@C where { @C.elems > 0 and @C.all ~~ Coin } #= coin list
+) {
+    @C = @C>>.Int;
+    my @combi = combiCoinSum( $S, @C );
+    say "Input:\n\@C = {@C.raku}\n\$S = {$S}";
+    say "Output: {@combi.elems}";
+    say "possible ways are:";
+    .say for @combi>>.Array;
+}
diff --git a/challenge-075/jeongoon/raku/ch-2.raku b/challenge-075/jeongoon/raku/ch-2.raku
new file mode 100644
index 0000000000..c413e1f17f
--- /dev/null
+++ b/challenge-075/jeongoon/raku/ch-2.raku
@@ -0,0 +1,62 @@
+#!/usr/bin/env raku
+# -*- Mode: Raku; indent-tabs-mode: nil; coding: utf-8 -*-
+# vim: set et ts=4 sw=4:
+
+use v6.d;
+
+# solution
+class Rect {
+    has ( @.x, $.h );
+    method x-range() {  (min @!x) .. (max @!x) }
+    method area () {
+        $!h * (@!x.elems == 1 ?? 1 !! 1 + abs( [-] @!x ) )
+    }
+}
+
+sub all-possible-rect ( @H ) {
+    ( ^@H.elems ).combinations( 1..2 ).map(
+        -> @range {
+            Rect.new( :x(@range),
+                      :h( @H[ min(@range) .. max(@range) ].min ) );
+        } );
+}
+
+sub get-largest-ares ( Rect:D @rects ) {
+    @rects.map( *.area ).max;
+}
+
+sub ssprintf ( UInt:D $w, $str ) { sprintf( "%#{$w}s", $str ) }
+
+# bonus
+sub print-histogram ( :histogram-data(@H), :all-rects(@rects) ) {
+    my $max-area   = get-largest-ares( @rects );
+    my @ma-rects   = @rects.grep( -> $r { $r.area == $max-area } );
+    my $mh = max @H;
+    my $ww = $mh.chars + 1;
+    for $mh ... 1 -> $y {
+        my $line = ssprintf( $ww, $y ) ~ '│';
+        for 0 .. @H.end Z @H -> ($i, $h) {
+            my $ch = " ";
+            if $h >= $y {
+                $ch = "#";
+                for @ma-rects -> $r {
+                    $ch = "■" if $r.h >= $y and $i (elem) $r.x-range;
+                }
+            }
+            $line ~= ssprintf( $ww, $ch );
+        }
+        $line.say;
+    }
+    say ssprintf( $ww, " " ) ~ '└' ~ ( "─" x ( $ww * @H.elems ) );
+    say ssprintf( $ww, " " ) ~ ' ' ~ [~] @H.map( -> $h { ssprintf( $ww, $h ) });
+}
+
+sub MAIN ( **@H where { @H.elems > 0 and @H.all ~~ UInt } ) {
+    @H = @H>>.UInt;
+    my Rect @rects = all-possible-rect( Array[UInt].new(@H) );
+    my $largest = get-largest-ares( @rects );
+    say "Input: {@H.raku}";
+    say "Output: {$largest}";
+    say "Where:";
+    print-histogram( :histogram-data(@H), :all-rects( @rects ) );
+}