Merge pull request #3016 from LubosKolouch/master

Challenge 091 LK

2 files changed, 105 insertions, 0 deletions

diff --git a/challenge-091/lubos-kolouch/perl/ch_1.pl b/challenge-091/lubos-kolouch/perl/ch_1.pl
new file mode 100644
index 0000000000..88fd4d34ed
--- /dev/null
+++ b/challenge-091/lubos-kolouch/perl/ch_1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch_1.pl
+#
+#        USAGE: ./ch_1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge #091
+#               Task 1 - Count Number
+#               www.perlweeklychallenge.org
+#
+#       AUTHOR: Lubos Kolouch
+#      VERSION: 1.0
+#      CREATED: 12/20/2020 10:27:07 AM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub as_we_read {
+    my $what = shift;
+
+    my $solution = '';
+
+    my $pos = 1;
+    my $count = 1;
+    my $last_char = substr($what, 0, 1);
+
+    while ($pos <= length($what)) {
+        if (($pos == length($what)) or (substr($what, $pos, 1) != $last_char)) {
+            $solution .= $count.$last_char;
+            $count = 1;
+            $last_char = substr($what, $pos, 1);
+        } else {
+            $count++;
+        }
+
+
+        $pos += 1;
+    }
+
+    return $solution;
+
+}
+
+use Test::More;
+
+is(as_we_read(1122234), 21321314);
+is(as_we_read(2333445), 12332415);
+is(as_we_read(12345), 1112131415);
+
+done_testing;
diff --git a/challenge-091/lubos-kolouch/perl/ch_2.pl b/challenge-091/lubos-kolouch/perl/ch_2.pl
new file mode 100644
index 0000000000..8c7a755298
--- /dev/null
+++ b/challenge-091/lubos-kolouch/perl/ch_2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch_2.pl
+#
+#        USAGE: ./ch_2.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge #091
+#               Task 2 - Jump Game
+#               www.perlweeklychallenge.org
+#
+#       AUTHOR: Lubos Kolouch
+#      VERSION: 1.0
+#      CREATED: 12/20/2020 10:27:07 AM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub jump {
+    my $in_arr = shift;
+
+    # test if each zero can be overjumped
+    
+    my $pos = 0;
+    for my $num (@$in_arr) {
+        if ($in_arr->[$pos] == 0) {
+            my $offset = 1;
+            # work backwards and stop if we can jump over or at the beginning
+            while ($pos - $offset  >= 0) {
+                my $test_pos = $pos - $offset;
+
+                my $elem_at_pos = $in_arr->[$pos - $offset];
+
+                last if ($elem_at_pos + $pos - $offset > $pos);
+                $offset++;
+            } 
+
+            return 0 unless $pos - $offset > 0;
+        }
+        $pos++;
+    }
+
+    return 1;
+
+}
+
+use Test::More;
+
+is(jump([1, 2, 1, 2]), 1);
+is(jump([2, 1, 1, 0, 2]), 0);
+is(jump([2, 1, 2, 0, 2]), 1);
+done_testing;