diff options
| -rw-r--r-- | challenge-200/dave-jacoby/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-200/dave-jacoby/perl/ch-1.pl | 49 | ||||
| -rw-r--r-- | challenge-200/dave-jacoby/perl/ch-2.pl | 42 |
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 |
