Merge pull request #7437 from choroba/ech200

Solve 200: Arithmetic Slices & Seven Segment 200 by E. Choroba

2 files changed, 86 insertions, 0 deletions

diff --git a/challenge-200/e-choroba/perl/ch-1.pl b/challenge-200/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..1e0f2e369f
--- /dev/null
+++ b/challenge-200/e-choroba/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+use experimental 'signatures';
+
+sub arithmetic_slices ($arr) {
+    return [] if @$arr < 3;
+    my $indicator = 0 x (@$arr - 3) . '111';
+    my @slices;
+  SLICE:
+    while (1) {
+        next if 3 > $indicator =~ tr/1//;
+        my @slice = @$arr[ map substr($indicator, $_, 1) ? $_ : (),
+                               0 .. $#$arr ];
+        my $d = $slice[0] - $slice[1];
+        $d != $slice[ $_ - 1 ] - $slice[$_] and next SLICE for 2 .. $#slice;
+
+        push @slices, \@slice;
+
+    } continue {
+        increment(\$indicator) or last
+    }
+    return \@slices
+}
+
+sub increment($indicator) {
+    $$indicator =~ s/0$/1/
+    or $$indicator =~ s/0(1+)$/1 . 0 x length $1/e
+    or 0
+}
+
+use Test2::V0;
+plan 2 + 3;
+
+is arithmetic_slices([1, 2, 3, 4]),
+    bag { item $_ for [1, 2, 3], [2, 3, 4], [1, 2, 3, 4] },
+    'Example 1';
+
+is arithmetic_slices([2]), [], 'Example 2';
+
+is arithmetic_slices([3, 2, 1]),
+    [[3, 2, 1]],
+    'Decreasing';
+
+is arithmetic_slices([3, 5, 7, 9, 11]),
+    bag { item $_ for [3, 7, 11],
+                      [3, 5, 7], [5, 7, 9], [7, 9, 11],
+                      [3, 5, 7, 9], [5, 7, 9, 11],
+                      [3, 5, 7, 9, 11] },
+    'Skipping';
+
+is arithmetic_slices([(1) x 4]),
+    bag { item $_ for ([1, 1, 1]) x 4, [(1) x 4] },
+    'All the same';
diff --git a/challenge-200/e-choroba/perl/ch-2.pl b/challenge-200/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..6e6a1f6881
--- /dev/null
+++ b/challenge-200/e-choroba/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental 'signatures';
+
+my @digit = qw( abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg );
+my @segments = (['a'], (['f', 'b']) x 2, ['g'], (['e', 'c']) x 2, ['d']);
+
+# Char 1, length, count of spaces in between, char 2, length.
+my %line = (1 => ['-', 7, 0, "", 0],
+            2 => ['|', 1, 5, '|', 1]);
+
+sub draw($number) {
+    my @digits = map $digit[$_], split //, $number;
+    for my $s (@segments) {
+        for my $digit (@digits) {
+            my $type = scalar @$s;
+            print join ' ' x $line{$type}[2],
+                map +(
+                         (-1 == index $digit, $s->[$_] // "")
+                         ? ' '
+                         : $line{$type}[ 3 * $_ ]
+                     ) x $line{$type}[ 3 * $_ + 1 ],
+                0, 1;
+            print '  ';
+        }
+        print "\n";
+    }
+}
+
+draw(join "", 0 .. 9);
+draw(200);