Merge pull request #7427 from jacoby/master

#200 DAJ

3 files changed, 92 insertions, 0 deletions

diff --git a/challenge-200/dave-jacoby/blog.txt b/challenge-200/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..a8e037aefa
--- /dev/null
+++ b/challenge-200/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/01/16/bicentweekly-solution-weekly-challenge-200.html
diff --git a/challenge-200/dave-jacoby/perl/ch-1.pl b/challenge-200/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..6d3d9c53b5
--- /dev/null
+++ b/challenge-200/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+    [ 1, 2, 3, 4 ],
+    [ 2, 4, 6, 8, 9, 10, 11 ],
+    [2],
+
+);
+
+for my $e (@examples) {
+    my @out = arithmatic_slices( $e->@* );
+    my $out = join ', ', map { "($_)" } map { join ',', $_->@* } @out;
+    my $in  = join ',',  $e->@*;
+    say <<"END";
+    Input:  \@array = ($in) 
+    Output: ($out)
+END
+}
+
+sub arithmatic_slices ( @array ) {
+    return () if scalar @array < 3;
+    my @output;
+    my $max = -1 + scalar @array;
+OUTER: for my $i ( 0 .. $max - 1) {
+        my $diff = abs( $array[$i] - $array[ $i + 1 ] );
+        my @slice;
+        push @slice, $array[$i];
+        for my $j ( $i + 1 .. $max ) {
+            my $ldiff = abs( $array[$j] - $array[ $j - 1 ] );
+            if ( $ldiff == $diff ) {
+                push @slice, $array[$j];
+                my @copy = @slice;
+                push @output, \@copy if scalar @slice > 2;
+            }
+            else {
+                next OUTER;
+            }
+        }
+    }
+    # first sort makes the arrays numerically sorted by first value
+    # second sort makes the arrays sorted by length
+    @output = sort { scalar $a->@* <=> scalar $b->@* }
+        sort { $a->[0] <=> $b->[0] } @output;
+    return @output;
+}
diff --git a/challenge-200/dave-jacoby/perl/ch-2.pl b/challenge-200/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..fb6d690fb1
--- /dev/null
+++ b/challenge-200/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+use Algorithm::Permute;
+
+my @examples = ( 1, 27, 190 .. 200 );
+@examples = @ARGV if scalar @ARGV;
+my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;
+my @base  = map { chomp $_; $_ } <DATA>;
+
+for my $e (@examples) {
+    seven_segment($e);
+}
+
+sub seven_segment( $num ) {
+    my @digits = split //, $num;
+    my @segs   = 'a' .. 'g';
+    my @out;
+    for my $digit (@digits) {
+        my %segs = map { $_ => 1 } split //, $truth[$digit];
+        for my $s ( 0 .. 6 ) {
+            my $line = $base[$s];
+            for my $seg (@segs) {
+                if   ( $segs{$seg} ) { $line =~ s/$seg/*/g }
+                else                 { $line =~ s/$seg/ /g }
+            }
+            push $out[$s]->@*, $line;
+        }
+    }
+    say join "\n", '',map { join '', $_->@* } @out;
+}
+
+__DATA__
+ aaaaa   
+f     b  
+f     b  
+ ggggg   
+e     c  
+e     c  
+ ddddd