diff options
| -rwxr-xr-x | challenge-087/e-choroba/perl/ch-1.pl | 55 | ||||
| -rwxr-xr-x | challenge-087/e-choroba/perl/ch-2.pl | 194 |
2 files changed, 249 insertions, 0 deletions
diff --git a/challenge-087/e-choroba/perl/ch-1.pl b/challenge-087/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..0ef7264ff3 --- /dev/null +++ b/challenge-087/e-choroba/perl/ch-1.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl +use warnings; +use strict; + +sub longest_consecutive_sequence { + my @N = sort { $a <=> $b } @_; + + # To simplify the code, the last number will never be part of the + # sequence. + push @N, $N[-1] + 2; + + my ($from, $to, @longest); + for my $i (1 .. $#N) { + my $is_sequence = $N[$i - 1] == $N[$i] - 1; + if (defined $from) { + if ($is_sequence) { + $to = $N[$i]; + } else { + [ + sub { push @longest, [$from, $to] }, + sub { @longest = [$from, $to] }, + sub {} + ]->[@longest + ? $to - $from <=> $longest[0][1] - $longest[0][0] + : 1 + ](); + undef $from; + } + } elsif (defined( + $from = $is_sequence ? $N[$i - 1] : undef + )) { + $to = $N[$i]; + } + } + + return [0] unless @longest; + + return [ map [ $_->[0] .. $_->[1] ], @longest ]; +} + +use Test::More tests => 6; + +is_deeply longest_consecutive_sequence(100, 4, 50, 3, 2), + [[2, 3, 4]], 'Example 1'; +is_deeply longest_consecutive_sequence(20, 30, 10, 40, 50), + [0], 'Example 2'; +is_deeply longest_consecutive_sequence(20, 19, 9, 11, 10), + [[9, 10, 11]], 'Example 3'; + +is_deeply longest_consecutive_sequence(1, 2, 3, 4, 6, 7, 8, 9), + [[1, 2, 3, 4], [6, 7, 8, 9]], 'More than one'; +is_deeply longest_consecutive_sequence(1, 2, 3, 4, 6, 7, 8, 9, 10), + [[6, 7, 8, 9, 10]], 'Has shorter'; +is_deeply longest_consecutive_sequence(1, 3, 4, 7, 8), + [[3, 4], [7, 8]], 'Length 2'; diff --git a/challenge-087/e-choroba/perl/ch-2.pl b/challenge-087/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..206837c867 --- /dev/null +++ b/challenge-087/e-choroba/perl/ch-2.pl @@ -0,0 +1,194 @@ +#!/usr/bin/perl +use warnings; +use strict; + +sub find_largest { + my ($lines, $x, $y) = @_; + my ($max, %how) = 0; + for my $vector ([0, 1], [1, 0]) { + my $m = $lines->[$y][$x][ $vector->[0] ]; + next if $m < 1; + + my $n = 1; + while (my $m2 = $lines->[ $y + $n * $vector->[0] ] + [ $x + $n * $vector->[1] ] + [ $vector->[0] ] + ) { + last if $m2 < 1; + + $m = $m2 if $m2 < $m; + + if ($n > 0) { + my $area = ($m + 1) * ($n + 1); + if ($area > $max) { + $max = $area; + %how = (); + } + if ($area == $max) { + undef($vector->[0] ? $how{$m}{$n} : $how{$n}{$m}); + + # Surprisingly, this doesn't help the performance. + # last if ($m + 1) * ($lines->[$y][$x] + 1) <= $max; + } + } + ++$n; + } + } + my @coords = map { + my $k = $_; + map [ $k, $_ ], keys %{ $how{$k} } + } sort { $a <=> $b } keys %how; + return $max, @coords +} + +sub calculate_lines { + my ($matrix) = @_; + my @lines; + for my $y (0 .. $#$matrix) { + for my $x (0 .. $#{ $matrix->[$y] }) { + if ($matrix->[$y][$x]) { + if ($y > 0 && $matrix->[$y - 1][$x]) { + $lines[$y][$x][0] = $lines[$y - 1][$x][0] - 1; + } else { + my $j = $y; + ++$j while $j <= $#$matrix && $matrix->[$j][$x]; + $lines[$y][$x][0] = $j - $y - 1; + } + if ($x > 0 && $matrix->[$y][$x - 1]) { + $lines[$y][$x][1] = $lines[$y][$x - 1][1] - 1; + } else { + my $i = $x; + ++$i while $i <= $#{ $matrix->[$y] } && $matrix->[$y][$i]; + $lines[$y][$x][1] = $i - $x - 1; + } + } else { + $lines[$y][$x] = [0, 0]; + } + } + } + return @lines +} + +sub largest_rectangle_detail { + my ($input) = @_; + my @matrix; + push @matrix, [ /[01]/g ] for split /\n/, $input; + my @lines = calculate_lines(\@matrix); + + my $max = 0; + my @where; + for my $y (0 .. $#matrix) { + for my $x (0 .. $#{ $matrix[$y] }) { + next unless $lines[$y][$x][0] && $lines[$y][$x][1]; + + my ($area, @how) = find_largest(\@lines, $x, $y); + if ($area > $max) { + @where = (); + $max = $area; + } + push @where, [$x, $y, \@how] if $area == $max; + } + } + return [$max, @where] +} + +sub largest_rectangle { + my ($input) = @_; + my ($max, @where) = @{ largest_rectangle_detail($input) }; + return [0] unless $max; + + my @rectangles; + for my $size (map @{ $_->[2] }, @where) { + my ($x, $y) = @$size; + my $r = ""; + for my $i (0 .. $y) { + for my $j (0 .. $x) { + $r .= ($j ? ' ' : "") . '1'; + } + $r .= "\n" + } + push @rectangles, $r; + } + return \@rectangles +} + +use Test::More; +use Test::Deep; + +my @examples = (<< '__EXAMPLE__', + [ 0 0 0 1 0 0 ] + [ 1 1 1 0 0 0 ] + [ 0 0 1 0 0 1 ] + [ 1 1 1 1 1 0 ] + [ 1 1 1 1 1 0 ] +__EXAMPLE__ +<< '__EXAMPLE__', + [ 1 0 1 0 1 0 ] + [ 0 1 0 1 0 1 ] + [ 1 0 1 0 1 0 ] + [ 0 1 0 1 0 1 ] +__EXAMPLE__ +<< '__EXAMPLE__', + [ 0 0 0 1 1 1 ] + [ 1 1 1 1 1 1 ] + [ 0 0 1 0 0 1 ] + [ 0 0 1 1 1 1 ] + [ 0 0 1 1 1 1 ] +__EXAMPLE__ +<< '__EXAMPLE__', + [ 0 0 0 0 0 0 ] + [ 0 1 1 1 0 0 ] + [ 0 1 1 1 0 0 ] + [ 0 1 1 0 0 0 ] + [ 0 0 0 0 0 0 ] + [ 0 0 0 0 0 0 ] + [ 0 0 0 1 1 1 ] + [ 0 0 0 1 1 1 ] + [ 0 0 0 0 0 0 ] +__EXAMPLE__ +<< '__EXAMPLE__', + [ 1 1 1 1 1 1 ] + [ 1 1 1 1 1 1 ] + [ 1 1 1 1 0 0 ] +__EXAMPLE__ +); + +is_deeply largest_rectangle_detail($examples[0]), + [10, [0, 3, [[4, 1]]]], + 'Example 1 - details'; + +is_deeply largest_rectangle_detail($examples[1]), + [0], + 'Example 2 - details'; + +is_deeply largest_rectangle_detail($examples[2]), + [8, [2, 3, [[3, 1]]]], + 'Example 3 - details'; + +cmp_deeply largest_rectangle_detail($examples[3]), + [6, [1, 1, bag([1, 2], [2, 1])], [3, 6, [[2, 1]]]], + 'Three solutions - details'; + +cmp_deeply largest_rectangle_detail($examples[4]), + [12, [0, 0, [[3, 2], [5, 1]]]], + '2x6 versus 3x4 - details'; + +my %solution = ('5x2' => "1 1 1 1 1\n" x 2, + '4x2' => "1 1 1 1\n" x 2, + '2x3' => "1 1\n" x 3, + '3x2' => "1 1 1\n" x 2, + '4x3' => "1 1 1 1\n" x 3, + '6x2' => "1 1 1 1 1 1\n" x 2, +); + +is_deeply largest_rectangle($examples[0]), [$solution{'5x2'}], 'Example 1'; +is_deeply largest_rectangle($examples[1]), [0], 'Example 2'; +is_deeply largest_rectangle($examples[2]), [$solution{'4x2'}], 'Example 3'; +is_deeply largest_rectangle($examples[3]), + [@solution{'2x3', '3x2', '3x2'}], + 'Three solutions'; +is_deeply largest_rectangle($examples[4]), + [@solution{'4x3', '6x2'}], + '2x6 versus 3x4'; + +done_testing(); |