diff options
4 files changed, 318 insertions, 0 deletions
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; |