aboutsummaryrefslogtreecommitdiff
path: root/challenge-087
diff options
context:
space:
mode:
Diffstat (limited to 'challenge-087')
-rw-r--r--challenge-087/laurent-rosenfeld/blog.txt1
-rw-r--r--challenge-087/laurent-rosenfeld/perl/ch-1.pl29
-rw-r--r--challenge-087/laurent-rosenfeld/perl/ch-2.pl97
-rw-r--r--challenge-087/laurent-rosenfeld/raku/ch-1.raku25
-rw-r--r--challenge-087/laurent-rosenfeld/raku/ch-2.raku54
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 "";
+}