Merge pull request #3010 from ccntrq/challenge-091

add perl solutions for challenge-091

2 files changed, 94 insertions, 0 deletions

diff --git a/challenge-091/alexander-pankoff/perl/ch-1.pl b/challenge-091/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..f32e38127b
--- /dev/null
+++ b/challenge-091/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(reduce);
+use Scalar::Util qw(looks_like_number);
+
+{
+    my ( $number ) = @ARGV;
+    die "$0: expect a positive integer\n"
+      if !$number
+      || !looks_like_number( $number )
+      || $number <= 0
+      || int( $number ) != $number;
+    say count_number( $number );
+}
+
+sub count_number($n) {
+    my @digits = split( '', $n );
+
+    # group adjacent elements in @digits by numerical equality
+    my @groups = group_by( sub ( $a, $b ) { $a == $b }, @digits );
+
+    # get the size and an element from each group
+    my @count_digits = map { scalar( @$_ ), $_->[-1] } @groups;
+
+    # reassemble the number and return
+    return join( '', @count_digits );
+}
+
+# groups adjacent elements in @xs according to the result of comparing them by
+# $compare_fn
+sub group_by ( $compare_fn, @xs ) {
+    return @{
+        (
+            reduce {
+                # create new group in the first iteration and each time the
+                # result of comparing last and and cur is false
+                push @{ $a->{groups} }, []
+                  if !exists $a->{last}
+                  || !$compare_fn->( $a->{last}, $b );
+
+                # add the current element to the latest group
+                push @{ $a->{groups}[-1] }, $b;
+
+                # set last to the current element
+                $a->{last} = $b;
+                $a;
+
+            }
+            { groups => [] },
+            @xs,
+        )->{groups}
+    };
+}
diff --git a/challenge-091/alexander-pankoff/perl/ch-2.pl b/challenge-091/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..5c22cb5694
--- /dev/null
+++ b/challenge-091/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(any);
+use Scalar::Util qw(looks_like_number);
+
+{
+    my @jumps = @ARGV;
+    die "$0: expect a list of non negative integers\n"
+      if any {
+        !looks_like_number( $_ ) || $_ < 0 || int( $_ ) != $_
+    }
+    @jumps;
+    say jump_game( @jumps );
+}
+
+sub jump_game(@jumps) {
+
+    # we reached the end!
+    return 1 if @jumps == 1;
+
+    my $cur = $jumps[0];
+
+    # we cannot jump further or we jumped over the end of the list.
+    # an empty input list will also be considered as *jumped over the end*
+    return 0 if !@jumps || $cur == 0;
+
+    # assuming we are allowed to jump exactly $cur positions and no less.
+    return jump_game( @jumps[ $cur ... $#jumps ] );
+}