diff options
| -rwxr-xr-x | challenge-151/alexander-pankoff/perl/ch-1.pl | 173 | ||||
| -rwxr-xr-x | challenge-151/alexander-pankoff/perl/ch-2.pl | 78 |
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; +} |