Merge pull request #5650 from ccntrq/challenge-151

Challenge 151

2 files changed, 251 insertions, 0 deletions

diff --git a/challenge-151/alexander-pankoff/perl/ch-1.pl b/challenge-151/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..7f6d3de5da
--- /dev/null
+++ b/challenge-151/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,173 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+# TASK #1 › Binary Tree Depth
+# Submitted by: Mohammad S Anwar
+#
+# You are given binary tree.
+#
+# Write a script to find the minimum depth.
+#
+#     The minimum depth is the number of nodes from the root to the nearest leaf node (node without any children).
+#
+# Example 1:
+#
+# ```
+# Input: '1 | 2 3 | 4 5'
+#
+#                 1
+#                / \
+#               2   3
+#              / \
+#             4   5
+#
+# Output: 2
+# ```
+#
+#
+# ```
+# Example 2:
+#
+# Input: '1 | 2 3 | 4 *  * 5 | * 6'
+#
+#                 1
+#                / \
+#               2   3
+#              /     \
+#             4       5
+#              \
+#               6
+# Output: 3
+# ```
+
+run() unless caller();
+
+sub run() {
+    my ($input) = @ARGV;
+
+    my @tokens = tokenize($input);
+    say minimum_binary_tree_depth(@tokens);
+}
+
+sub minimum_binary_tree_depth ( @tokens) {
+    my $depth = 0;
+    my $tree  = [];
+
+    while (@tokens) {
+        push @$tree, [];
+        my $num_elems = 2**$depth;
+        for ( my $i = 0 ; $i < $num_elems ; $i++ ) {
+
+            if ( !@tokens || $tokens[0]->isa('SeperatorToken') ) {
+                ## fill row with dummy placeholder tokens.
+                unshift @tokens,
+                  map { PlaceHolderToken->new(-1) }
+                  0 .. ( $num_elems - 1 - $i );    # Dummy Token
+            }
+
+            my $cur = shift @tokens;
+            if ( $cur->isa('ValueToken') ) {
+                if ( $depth && !defined( $tree->[-2][ int( $i / 2 ) ] ) ) {
+                    die join( " ",
+                        "Missing parent for node with value",
+                        $cur->{lexeme},
+                        "at position",
+                        $cur->pos_human_readable(),
+                        "in input\n" );
+                }
+                push @{ $tree->[-1] }, $cur->{lexeme};
+            }
+            elsif ( $cur->isa('PlaceHolderToken') ) {
+                if (   $i % 2
+                    && !defined $tree->[-1][-1]
+                    && ( !$depth || defined $tree->[-2][ int( $i / 2 ) ] ) )
+                {
+                    return $depth;
+                }
+                push @{ $tree->[-1] }, undef;
+                ## do nothing
+            }
+        }
+
+        $depth += 1;
+
+        # handle optional seperatortoken
+        if ( @tokens && $tokens[0]->isa("SeperatorToken") ) {
+            shift @tokens;
+        }
+    }
+
+    return $depth;
+}
+
+sub tokenize ( $input) {
+    my @tokens;
+    my $pos = 0;
+    while ( $pos < length $input ) {
+        my $cur = substr( $input, $pos, 1 );
+
+        if ( $cur =~ m/\|/ ) {
+            push @tokens, SeperatorToken->new($pos);
+            $pos += 1;
+        }
+        elsif ( $cur =~ m/\*/ ) {
+            push @tokens, PlaceHolderToken->new($pos);
+            $pos += 1;
+        }
+        elsif ( $cur =~ m/\d/ ) {
+            my $start_pos = $pos;
+            my $lexeme    = '';
+            do {
+                $lexeme .= $cur;
+                $pos += 1;
+                $cur = substr( $input, $pos, 1 );
+            } while ( $cur =~ m/\d/ );
+            push @tokens, ValueToken->new( $lexeme, $pos );
+        }
+        elsif ( $cur =~ m/\s/ ) {
+            do {
+                $pos += 1;
+                $cur = substr( $input, $pos, 1 );
+            } while ( $cur =~ m/\s/ );
+        }
+        else {
+            my $pos_human_readable = $pos + 1;
+            die "Unexpected input at position $pos_human_readable: '$cur'\n";
+        }
+    }
+    return @tokens;
+}
+
+package TokenType {
+
+    sub new ( $class, $lexeme, $pos ) {
+        return bless { lexeme => $lexeme, position => $pos }, $class;
+    }
+
+    sub pos_human_readable($self) {
+        return $self->{position} + 1;
+    }
+}
+
+package ValueToken {
+    use base 'TokenType';
+}
+
+package PlaceHolderToken {
+    use base 'TokenType';
+
+    sub new ( $class, $pos ) {
+        return bless { lexeme => '*', position => $pos }, $class;
+    }
+}
+
+package SeperatorToken {
+    use base 'TokenType';
+
+    sub new ( $class, $pos ) {
+        return bless { lexeme => '|', position => $pos }, $class;
+    }
+}
diff --git a/challenge-151/alexander-pankoff/perl/ch-2.pl b/challenge-151/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..8fb1634a84
--- /dev/null
+++ b/challenge-151/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+# TASK #2 › Rob The House
+# Submitted by: Mohammad S Anwar
+#
+# You are planning to rob a row of houses, always starting with the first and moving in the same direction. However, you can’t rob two adjacent houses.
+#
+# Write a script to find the highest possible gain that can be achieved.
+# Example 1:
+#
+# Input: @valuables = (2, 4, 5);
+# Output: 7
+#
+# If we rob house (index=0) we get 2 and then the only house we can rob is house (index=2) where we have 5.
+# So the total valuables in this case is (2 + 5) = 7.
+#
+#
+# Example 2:
+#
+# Input: @valuables = (4, 2, 3, 6, 5, 3);
+# Output: 13
+#
+# The best choice would be to first rob house (index=0) then rob house (index=3) then finally house (index=5).
+# This would give us 4 + 6 + 3 =13.
+
+use List::Util qw(all reduce sum0);
+
+use Data::Dumper;
+
+run() unless caller();
+
+sub run() {
+    my @valuables = @ARGV;
+    die "Invalid input\n" unless all { m/^-?\d+$/ } @valuables;
+
+    rob_house(@valuables);
+
+}
+
+sub rob_house (@valuables) {
+    my @tours = plan_tour($#valuables);
+
+    my $best_tour = reduce sub {
+        my @tour       = @$b;
+        my $tour_value = sum0 map { $valuables[$_] } @tour;
+        if ( $tour_value > $a->{value} ) {
+            return {
+                value => $tour_value,
+                tour  => [@tour],
+            };
+        }
+        if ( $tour_value == $a->{value} && @tour < @{ $a->{tour} } ) {
+            return {
+                value => $tour_value,
+                tour  => [@tour],
+            };
+        }
+
+        return $a;
+
+    }, { value => 0, tour => [] }, @tours;
+
+    print Dumper $best_tour;
+}
+
+sub plan_tour ( $max, $cur = 0 ) {
+    return [] if $cur > $max;
+    my @paths = (
+        ( map { [ $cur, @$_ ] } plan_tour( $max, $cur + 2 ) ),
+        plan_tour( $max, $cur + 1 )
+    );
+
+    return @paths;
+}