- Added solutions by Laurent Rosenfeld.

5 files changed, 206 insertions, 0 deletions

diff --git a/challenge-087/laurent-rosenfeld/blog.txt b/challenge-087/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..0e6b348695
--- /dev/null
+++ b/challenge-087/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2020/11/perl-weekly-challenge-87-longest-consecutive-sequences-and-largest-rectangle.html
diff --git a/challenge-087/laurent-rosenfeld/perl/ch-1.pl b/challenge-087/laurent-rosenfeld/perl/ch-1.pl
new file mode 100644
index 0000000000..daf911e9d1
--- /dev/null
+++ b/challenge-087/laurent-rosenfeld/perl/ch-1.pl
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+use feature "say";
+use Data::Dumper;
+
+my @tests = ( [ 100, 4, 50, 3, 2 ],
+              [ 20, 30, 10, 40, 50 ],
+              [ 20, 19, 9, 11, 10 ]
+            );
+
+for my $t_ref (@tests) {
+    my @in = sort { $a <=> $b } @$t_ref;
+    my $last = $in[0];
+    my @sequences;
+    my $index = 0;
+    push @{$sequences[$index]}, $last;
+    for my $i (1..$#in) {
+        my $current = $in[$i];
+        $index++ if $current != $last + 1;
+        push @{$sequences[$index]}, $current;
+        $last = $current;
+    }
+    my @sorted_seq = sort { scalar @$b <=> scalar @$a } @sequences;
+    if (scalar @{$sorted_seq[0]} > 1) {
+        say "@{$sorted_seq[0]}";
+    } else {
+        say 0;
+    }
+}
diff --git a/challenge-087/laurent-rosenfeld/perl/ch-2.pl b/challenge-087/laurent-rosenfeld/perl/ch-2.pl
new file mode 100644
index 0000000000..de03ff2f50
--- /dev/null
+++ b/challenge-087/laurent-rosenfeld/perl/ch-2.pl
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+use feature "say";
+use Data::Dumper;
+
+my @matrices =
+    ( [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ],
+        [ qw <1 1 0 1> ], [ qw <1 1 0 1> ]
+      ],
+
+      [ [ qw <1 1 0 1> ], [ qw <1 1 0 0> ],
+        [ qw <0 1 1 1> ], [ qw <1 0 1 1> ]
+      ],
+
+      [ [ qw <0 1 0 1> ], [ qw <1 0 1 0> ],
+        [ qw <0 1 0 0> ], [ qw <1 0 0 1> ]
+      ],
+
+      [ [ qw <1 1 0 1 1 1> ], [ qw <1 1 1 0 1 0> ],
+          [ qw <1 1 0 1 0 1> ], [ qw <1 1 1 0 0 1> ]
+      ],
+
+      [ [ qw <0 0 0 1 0 0> ], [ qw <1 1 1 0 0 0> ],
+          [ qw <0 0 1 0 0 1> ], [ qw <1 1 1 1 1 0> ],
+          [ qw <1 1 1 1 1 0>],
+      ],
+      [ [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
+          [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
+      ],
+      [ [ qw <0 0 0 1 1 1> ], [ qw <1 1 1 1 1 1> ],
+          [ qw <0 0 1 0 0 1> ], [ qw <0 0 1 1 1 1> ],
+          [ qw <0 0 1 1 1 1> ],
+      ],
+    );
+
+for my $m_ref (@matrices) {
+    print_matrix($m_ref);
+    find_rect($m_ref);
+}
+
+sub print_matrix {
+    my @matrix = @{$_[0]};
+    say "";
+    say "[ @$_ ]" for @matrix;
+    say "";
+}
+
+sub find_rect {
+    my @m = @{$_[0]};
+    my $max_h = scalar @m;
+    my $max_w = scalar @{$m[0]};
+    my @positions;
+    for my $i (0..$#m) {
+        for my $j (0..$#m) {
+            push @positions, [$i, $j] unless $m[$i][$j] == 0;
+        }
+    }
+    my @pairs;
+    for my $k (0..$#positions) {
+        for my $n ($k+1..$#positions) {
+            push @pairs, [ [@{$positions[$k]}], [@{$positions[$n]}] ];
+        }
+    }
+
+    my @eligible;
+    for my $p_ref (@pairs) {
+        my @p = @$p_ref;
+        next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
+        my $only_ones = 1;
+        for my $i ($p[0][0].. $p[1][0]) {
+            for my $j ($p[0][1]..$p[1][1]) {
+                if ($m[$i][$j] == 0) {
+                    $only_ones = 0;
+                    next;
+                }
+            }
+        }
+         push @eligible, $p_ref if $only_ones;
+    }
+
+    say 0 and return unless @eligible;
+
+my @sorted = map { $_->[0] }
+             sort { $b->[1] <=> $a->[1] }
+             map { [$_, ($_->[1][0] - $_->[0][0] + 1)
+                   * ($_->[1][1] - $_->[0][1] + 1)] }
+                   @eligible;
+    my $rect = $sorted[0];
+    say "Rectangle corners: ";
+    say "@$_" for @$rect;
+    say "\nRectangle:";
+
+    for my $row ($rect->[0][0]..$rect->[1][0]) {
+        say "@{$m[$row]}[$rect->[0][1]..$rect->[1][1]]";
+    }
+    say "";
+}
diff --git a/challenge-087/laurent-rosenfeld/raku/ch-1.raku b/challenge-087/laurent-rosenfeld/raku/ch-1.raku
new file mode 100644
index 0000000000..e6be94fa14
--- /dev/null
+++ b/challenge-087/laurent-rosenfeld/raku/ch-1.raku
@@ -0,0 +1,25 @@
+use v6;
+
+my @tests = [ 100, 4, 50, 3, 2 ],
+            [ 20, 30, 10, 40, 50 ],
+            [ 20, 19, 9, 11, 10 ];
+
+for @tests -> @t {
+    my @in = sort @t;
+    my $last = @in[0];
+    my @sequences;
+    my $index = 0;
+    push @sequences[$index], $last;
+    for 1..@in.end -> $i {
+        my $current = @in[$i];
+        $index++ if $current != $last + 1;
+        push @sequences[$index], $current;
+        $last = $current;
+    }
+    my @sorted_seq = sort { $^b.elems <=> $^a.elems }, @sequence;
+    if @sorted_seq[0] > 1 {
+        say @sorted_seq[0];
+    } else {
+        say 0;
+    }
+}
diff --git a/challenge-087/laurent-rosenfeld/raku/ch-2.raku b/challenge-087/laurent-rosenfeld/raku/ch-2.raku
new file mode 100644
index 0000000000..94f5f7f61e
--- /dev/null
+++ b/challenge-087/laurent-rosenfeld/raku/ch-2.raku
@@ -0,0 +1,54 @@
+use v6;
+
+my @matrices =
+    [ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ],
+    [ [ <1 1 0 1> ], [ <1 1 0 0> ], [ <0 1 1 1> ], [ <1 0 1 1> ] ],
+    [ [ <0 1 0 1> ], [ <1 0 1 0> ], [ <0 1 0 0> ], [ <1 0 0 1> ] ],
+
+    [ [ <1 1 0 1 1 1> ], [ <1 1 1 0 1 0> ],
+        [ <1 1 0 1 0 1> ], [ <1 1 1 0 0 1> ]
+    ],
+
+    [ [ <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>],
+    ],
+
+    [ [ <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> ],
+    ];
+
+for @matrices -> @m {
+    print-matrix @m;
+    find-rect @m;
+}
+sub print-matrix (@matrix) {
+    say "[ $_ ]" for @matrix;
+    say "";
+}
+
+sub find-rect (@m) {
+    my $max-h = @m.end;
+    my $max-w = @m[0].end;
+    my @positions =  ((0..$max-h) X  (0..$max-w))
+        .grep({@m[$_[0]][$_[1]] == 1});
+    # say @positions;
+    my @pairs = @positions.combinations: 2;
+    # say @pairs;
+    my @eligible = gather {
+        for @pairs -> $p {
+            next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
+            next if @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]].any == 0;
+            take $p;
+        }
+    }
+    say "0\n" and return unless @eligible;
+    my $rect = (reverse sort {
+            ($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1)
+            }, @eligible)[0];
+    say  "Rectangle corners: ", $rect;
+    for $rect[0][0]..$rect[1][0] -> $row {
+        say @m[$row][$rect[0][1]..$rect[1][1]];
+    }
+    say "";
+}