Merge pull request #2673 from ccntrq/challenge-084

Challenge 084

7 files changed, 411 insertions, 20 deletions

diff --git a/challenge-083/alexander-pankoff/perl/ch-2.pl b/challenge-083/alexander-pankoff/perl/ch-2.pl
index 2e3ca72fca..116f701716 100755
--- a/challenge-083/alexander-pankoff/perl/ch-2.pl
+++ b/challenge-083/alexander-pankoff/perl/ch-2.pl
@@ -7,12 +7,16 @@ use autodie;
 use feature qw(say signatures);
 no warnings 'experimental::signatures';
 
-use Carp qw(croak);
 use List::Util qw(any first sum0);
 use Scalar::Util qw(looks_like_number);
 
 use Pod::Usage;
 
+use FindBin;
+use lib File::Spec->join( $FindBin::RealBin, 'lib' );
+
+use Combinations qw(combinations);
+
 pod2usage(
     -message => "$0: Expects a list of positive numbers",
     -exitval => 1,
@@ -38,25 +42,6 @@ sub flip_array(@numbers) {
     return 0;
 }
 
-# returns possible combinations of $length elements from @pool.
-sub combinations ( $count, @pool ) {
-    croak "cannot build combinations with $count elements from a list of "
-      . scalar(@pool)
-      . " elements"
-      if $count > @pool;
-    return ()                 if $count == 0;
-    return map { [$_] } @pool if $count == 1;
-
-    my @combinations;
-    while ( @pool && $count <= @pool ) {
-        my $elem             = shift @pool;
-        my @sub_combinations = combinations( $count - 1, @pool );
-        push @combinations, map { [ $elem, @$_, ] } @sub_combinations;
-    }
-
-    return @combinations;
-}
-
 =pod
 
 =head1 NAME
diff --git a/challenge-083/alexander-pankoff/perl/lib/Combinations.pm b/challenge-083/alexander-pankoff/perl/lib/Combinations.pm
new file mode 100644
index 0000000000..2fb005c0a7
--- /dev/null
+++ b/challenge-083/alexander-pankoff/perl/lib/Combinations.pm
@@ -0,0 +1,26 @@
+package Combinations;
+use strict;
+use warnings;
+use feature qw(signatures);
+no warnings 'experimental::signatures';
+
+use Exporter qw(import);
+
+our @EXPORT_OK = qw(combinations);
+
+# returns possible combinations of $length elements from @pool.
+sub combinations ( $count, @pool ) {
+    return () if $count == 0 || $count > @pool;
+    return map { [$_] } @pool if $count == 1;
+
+    my @combinations;
+    while ( @pool && $count <= @pool ) {
+        my $elem = shift @pool;
+        my @sub_combinations = combinations( $count - 1, @pool );
+        push @combinations, map { [ $elem, @$_, ] } @sub_combinations;
+    }
+
+    return @combinations;
+}
+
+1;
diff --git a/challenge-084/alexander-pankoff/perl/ch-1.pl b/challenge-084/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..f444938edd
--- /dev/null
+++ b/challenge-084/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use Scalar::Util qw(looks_like_number);
+
+use Pod::Usage;
+
+use constant SIGNED_32_BIT_INTEGER_MINIMUM => -2**31;
+use constant SIGNED_32_BIT_INTEGER_MAXIMUM => 2**31 - 1;
+
+my ($N) = @ARGV;
+
+pod2usage(
+    -message => "$0: Expects one integer number",
+    -exitval => 1,
+  )
+  if !defined $N
+  or $N !~ m/^-?[0-9]+/;
+
+say reverse_integer($N);
+
+sub reverse_integer($n) {
+    my $is_negative = $n =~ s/^-//;
+
+    my $reversed =
+      join( '', ( $is_negative ? '-' : '' ), reverse( split( //, $n ) ) );
+
+    return 0
+      if $reversed < SIGNED_32_BIT_INTEGER_MINIMUM
+      || $reversed > SIGNED_32_BIT_INTEGER_MAXIMUM;
+
+    return $reversed;
+}
+
+=pod
+
+=head1 NAME
+
+wk-084 ch-1 - Reverse Integer
+
+=head1 SYNOPSIS
+
+This script will print the reverse of the given integer. If the result doesn't
+fit into a signed 32-bit integers the result will be 0
+
+ch-1.pl <N>
+
+=head1 ARGUMENTS
+
+=over 8
+
+=item B<N> The input number
+
+
+=back
+
+=cut
diff --git a/challenge-084/alexander-pankoff/perl/ch-2.pl b/challenge-084/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..779685a979
--- /dev/null
+++ b/challenge-084/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use autodie;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(any sum0);
+
+use Getopt::Long;
+use Pod::Usage;
+
+use FindBin;
+use lib File::Spec->join( $FindBin::RealBin, 'lib' );
+use lib File::Spec->join( $FindBin::RealBin, '..', '..', '..', 'challenge-083',
+    'alexander-pankoff', 'perl', 'lib' );
+
+use Combinations qw(combinations);
+use MatrixParser;
+
+{
+    my $file;
+    GetOptions( "file=s" => \$file, ),
+      or pod2usage( -exitval => 1, );
+
+    my $input = read_input($file);
+
+    my $parser = MatrixParser->new($input);
+
+    # read the corners from the input matrix.
+    my $corners = $parser->corners();
+
+    say find_squares($corners);
+}
+
+# we process the corners row by row. For each row we build pairs from the
+# possible corners and check wether we can find the same pair in the row that is
+# as far away from the current row as the corners in the pair are apart from each
+# other
+sub find_squares ( $corners, $count = 0 ) {
+    ## base case. no more squares possible
+    return $count if keys @$corners < 2;
+
+    my $row  = $corners->[0];
+    my @rest = @{$corners}[ 1 .. $#{$corners} ];
+
+    # build corner pairs from the current row, if there are less than 2
+    # elements no pais will be build
+    my @corner_pairs = combinations( 2, keys %{$row} );
+
+    my $squares = sum0(
+        map {
+            my ( $a, $b ) = @{$_};
+
+            # calculate the distance between the 2 corners.
+            my $dist      = abs( $a - $b );
+            my $check_row = $rest[ $dist - 1 ];
+
+            # if both corners are set in check_row aswell we found a square
+            $check_row && $check_row->{$a} && $check_row->{$b}
+              ? 1
+              : 0
+        } @corner_pairs
+    );
+
+    return find_squares( \@rest, $count + $squares );
+}
+
+sub read_input($file) {
+    my $fh;
+    if ($file) {
+        open( $fh, '<', $file );
+    }
+    else {
+        $fh = *STDIN;
+    }
+    local $/ = undef;
+    my $input = <$fh>;
+    return $input;
+}
+
+=pod
+
+=head1 NAME
+
+wk-085 ch-2 - Find Squares
+
+=head1 SYNOPSIS
+
+Given a matrix of size M X N with only 1 and 0, this script will count the
+squares with all corners set to 1.
+
+The Matrix can be provided via STDIN or read from a file.
+
+Example:
+
+Input: [ 0 1 0 1 ]
+       [ 0 0 1 0 ]
+       [ 1 1 0 1 ]
+       [ 1 0 0 1 ]
+
+Output: 1
+
+ch-2.pl [--matrix=INPUTFILE]
+
+=head1 ARGUMENTS
+
+=over 8
+
+=item B<matrix> - the file to read the matrix from
+
+=back
+
+=cut
diff --git a/challenge-084/alexander-pankoff/perl/lib/MatrixParser.pm b/challenge-084/alexander-pankoff/perl/lib/MatrixParser.pm
new file mode 100644
index 0000000000..f2a8e91717
--- /dev/null
+++ b/challenge-084/alexander-pankoff/perl/lib/MatrixParser.pm
@@ -0,0 +1,109 @@
+package MatrixParser;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(none);
+
+use MatrixParser::Lexer;
+
+sub new ( $class, $input ) {
+    my $self = {
+        lexer         => MatrixParser::Lexer->new($input),
+        corners       => [],
+        row           => 0,
+        col           => 0,
+        element_count => undef,
+    };
+
+    $self->{lookahead} = $self->{lexer}->next_token;
+
+    return bless $self, $class;
+}
+
+# returns an array of hashes with the corner positions (1s) from the input
+# matrix. each hash contains the corner positions for the corresponding row in
+# the input matrix
+sub corners($self) {
+    while ( $self->{lookahead} ) {
+        $self->_parse_row;
+    }
+    return $self->{corners};
+}
+
+sub _parse_row($self) {
+    my $start = $self->_expect('[');
+
+    my $count = 0;
+    while ( !$self->_match(']') ) {
+        $self->_parse_element;
+        $count++;
+    }
+
+    $self->_expect(']');
+    if ( defined $self->{element_count} && $self->{element_count} != $count ) {
+        $self->_unexpected_element_count( $start, $count );
+    }
+    $self->{element_count} = $count;
+    $self->{col}           = 0;
+    $self->{row}++;
+
+    return;
+}
+
+sub _parse_element($self) {
+    if ( $self->_match('1') ) {
+        $self->{corners}[ $self->{row} ]{ $self->{col} } = 1;
+    }
+    elsif ( !$self->_match('0') ) {
+        $self->_unexpected_token( $self->{lookahead}, '1|0' );
+    }
+
+    $self->{col}++;
+    return $self->_next_token()->lexeme;
+}
+
+sub _match ( $self, $expect ) {
+    $self->_unexpected_eof()
+      if !$self->{lookahead};
+    return $self->{lookahead}->lexeme eq $expect;
+}
+
+sub _expect ( $self, $expect ) {
+    my $token = $self->_next_token();
+    return $token if $token->lexeme eq $expect;
+
+    $self->_unexpected_token( $token, $expect );
+}
+
+sub _next_token($self) {
+    my $token = $self->{lookahead};
+    $self->{lookahead} = $self->{lexer}->next_token;
+    return $token;
+}
+
+sub _unexpected_token ( $self, $got, $expect ) {
+    die sprintf(
+"unexpected character in line %d at position %d. Got '%s', expect: '%s'\n",
+        $got->line, $got->pos, $got->lexeme, $expect );
+}
+
+sub _unexpected_element_count ( $self, $start, $count ) {
+    die sprintf(
+"unexpected element count in row %d starting at line %d at position %d. Got %d, expect: %d \n",
+        $self->{row} + 1,
+        $start->line, $start->pos, $count, $self->{element_count}
+    );
+
+}
+
+sub _unexpected_eof ( $self ) {
+    die sprintf(
+        "unexpected end of input at line %d at position %d.\n",
+        $self->{lexer}{line},
+        $self->{lexer}{pos}
+    );
+}
+
+1;
diff --git a/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Lexer.pm b/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Lexer.pm
new file mode 100644
index 0000000000..9bc51e4e09
--- /dev/null
+++ b/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Lexer.pm
@@ -0,0 +1,67 @@
+package MatrixParser::Lexer;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(none);
+
+use MatrixParser::Token;
+
+sub new ( $class, $input ) {
+    my $self = {
+        input => [ split( //, $input ) ],
+        line  => 1,
+        pos   => 0
+    };
+
+    return bless $self, $class;
+}
+
+sub next_token($self) {
+    $self->_skip_whitespace;
+    return if $self->_eof;
+
+    my $char = $self->_advance();
+
+    $self->_unexpected_input($char)
+      if none { $_ eq $char } qw(1 0 [ ]);
+
+    return MatrixParser::Token->new( $char, $self->{line}, $self->{pos} );
+}
+
+sub _skip_whitespace($self) {
+    return if $self->_eof;
+    while (1) {
+        my $char = $self->_peek;
+        last if !defined $char or $char !~ /\s/;
+
+        $self->_advance;
+        if ( $char eq "\n" ) {
+            $self->{line} += 1;
+            $self->{pos} = 0;
+        }
+    }
+}
+
+sub _eof($self) {
+    return !( scalar @{ $self->{input} } );
+
+}
+
+sub _peek($self) {
+    return $self->{input}[0];
+}
+
+sub _advance($self) {
+    return if $self->_eof;
+    $self->{pos} += 1;
+    return shift @{ $self->{input} };
+}
+
+sub _unexpected_input ( $self, $char ) {
+    die sprintf( "unexpected input '%s' in line %d at position %d\n",
+        $char, $self->{line}, $self->{pos} );
+}
+
+1;
diff --git a/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Token.pm b/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Token.pm
new file mode 100644
index 0000000000..8fe2b25255
--- /dev/null
+++ b/challenge-084/alexander-pankoff/perl/lib/MatrixParser/Token.pm
@@ -0,0 +1,26 @@
+package MatrixParser::Token;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+sub new ( $class, $lexeme, $line, $pos ) {
+
+    my $self = [ $lexeme, $line, $pos ];
+
+    return bless $self, $class;
+}
+
+sub lexeme($self) {
+    $self->[0];
+}
+
+sub line($self) {
+    $self->[1];
+}
+
+sub pos($self) {
+    $self->[2];
+}
+
+1;