diff options
| -rw-r--r-- | challenge-200/bob-lied/README | 5 | ||||
| -rw-r--r-- | challenge-200/bob-lied/perl/ch-1.pl | 69 | ||||
| -rw-r--r-- | challenge-200/bob-lied/perl/ch-2.pl | 116 |
3 files changed, 188 insertions, 2 deletions
diff --git a/challenge-200/bob-lied/README b/challenge-200/bob-lied/README index 5a7d2f0335..3d4521e11d 100644 --- a/challenge-200/bob-lied/README +++ b/challenge-200/bob-lied/README @@ -1,3 +1,4 @@ -Solutions to weekly challenge 199 by Bob Lied +Solutions to weekly challenge 200 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-199/ +https://perlweeklychallenge.org/blog/perl-weekly-challenge-200/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-200/bob-lied diff --git a/challenge-200/bob-lied/perl/ch-1.pl b/challenge-200/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..dfd881146d --- /dev/null +++ b/challenge-200/bob-lied/perl/ch-1.pl @@ -0,0 +1,69 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 200 Task 1 Arithmetic Slice +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers. +# Write a script to find out all Arithmetic Slices for the given array of +# integers. An integer array is called arithmetic if it has at least 3 +# elements and the differences between any three consecutive elements are the same. +# +# Example 1 Input: @array = (1,2,3,4) Output: (1,2,3), (2,3,4), (1,2,3,4) +# Example 2 Input: @array = (2) Output: () as no slice found. +# +# Example 1 implies that we should get every sub-slice of length at least 3 +# and that output order should have shorter sequences first +#============================================================================= + +use v5.36; + +use List::Util qw/all/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +use constant MINLENGTH => 3; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +die "All args should be numeric" unless all { $_ =~ m/-?\d+/ } @ARGV; + +my $answer = aslice(@ARGV); # Should validate all numbers +say join(", ", map { "(". join(",", $_->@*) .")" } $answer->@*); + +sub aslice(@list) +{ + my @result = (); + while ( @list >= MINLENGTH ) + { + my $diff = $list[1] - $list[0]; + + for ( my $i = 2; $i < @list && $list[$i] - $list[$i-1] == $diff ; $i++ ) + { + # Push every sub-slice that is at least MINLENGTH long + push @result, [ @list[0..$i] ] if $i >= (MINLENGTH -1 ); + } + shift @list; + } + return [ sort { scalar(@$a) <=> scalar(@$b) } @result ]; +} + +sub runTest +{ + use Test2::V0; + + is( aslice( 1,2,3,4 ), [ [1,2,3], [2,3,4], [1,2,3,4] ], "Example 1"); + is( aslice( 2 ), [ ], "Example 2"); + is( aslice( 1,2,4,6,9,15,20,25,30,37 ), + [ [2,4,6], [15,20,25], [20,25,30], [15,20,25,30] ], "Bigger list, more diffs"); + is( aslice( 2,3,5,8,13,21 ), [], "No runs of 3"); + is( aslice( 3,6,4,7,10 ), [[4,7,10]], "Non-monotonic"); + is( aslice( 9,3,1,-1 ), [ [3,1,-1] ], "Negative difference"); + + done_testing; +} + diff --git a/challenge-200/bob-lied/perl/ch-2.pl b/challenge-200/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..be0e5fa7aa --- /dev/null +++ b/challenge-200/bob-lied/perl/ch-2.pl @@ -0,0 +1,116 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 200 Task 2 Seven Segment 200 +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# A seven segment display is an electronic component, usually used to +# display digits. The segments are labeled 'a' through 'g' as shown: +# +# -- <- a +# f| |b +# -- <- g +# e| |c +# -- <- d +# +# The encoding of each digit can be represented compactly as a truth table: +# +# my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>; +# +# For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ +# enabled. +# +# Write a program that accepts any decimal number and draws that number +# as # a horizontal sequence of ASCII seven segment displays, similar to +# the # following: +# +# ------- ------- ------- +# | | | | | +# | | | | | +# ------- +# | | | | | +# | | | | | +# ------- ------- ------- +# +# To qualify as a seven segment display, each segment must be drawn (or not +# drawn) according to your @truth table. +# The number "200" was of course chosen to celebrate our 200th week! +#============================================================================= + +use v5.36; + + # 0 1 2 3 4 5 6 7 8 9 +my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>; + +# 7x7 as one 49-character string, a few different styles +# aaaaaaa aaaaa aaaaa +# f f f b ff bb Bold version +# f b f b ff bb +# ggggggg ggggg ggggg +# e c e c ee cc +# e c e c ee cc +# ddddddd ddddd ddddd + my $Digit = 'aaaaaaaf bf bggggggge ce cddddddd'; # Match example +#my $Digit = ' aaaaa f bf b ggggg e ce c ddddd '; # Rounded corners +# Bold version, double vertical segments +#my $Digit = 'aaaaaaaff bbff bbgggggggee ccee ccddddddd'; + +# Display characteristics + my %Char = ( a => '-', b => '|', c => '|', d => '-', e => '|', f => '|', g => '-', ); +#my %Char = ( a => '_', b => '|', c => '|', d => '_', e => '|', f => '|', g => '_', ); +#my %Char = ( a => '=', b => '|', c => '|', d => '=', e => '|', f => '|', g => '=', ); +#my %Char = ( a => '#', b => '#', c => '#', d => '#', e => '#', f => '#', g => '#', ); + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +displayAsSegment($_) for @ARGV; + +sub displayAsSegment($str) +{ + my @seg = map { asSegment($_) } split '', $str; + + for my $row ( 0 .. 6 ) + { + say join(" ", map { substr($seg[$_], $row*7, 7) } 0 .. $#seg); + } +} + +sub asSegment($digit) +{ + my $seven = $Digit; + my $t = $truth[$digit]; + + # Turn off segments not in the digit + $seven =~ s/[^$t]/ /g; + + for my $on ( split '', $t ) + { + $seven =~ s/$on/$Char{$on}/g; + } + return $seven; +} + +sub runTest +{ + use Test2::V0; + + my $Digit = ' aaaaa f bf b ggggg e ce c ddddd '; + is( asSegment("0"), ' ----- | || | | || | ----- ', "asSegment 0"); + is( asSegment("1"), ' | | | | ', "asSegment 1"); + is( asSegment("2"), ' ----- | | ----- | | ----- ', "asSegment 2"); + is( asSegment("3"), ' ----- | | ----- | | ----- ', "asSegment 3"); + is( asSegment("4"), ' | || | ----- | | ', "asSegment 4"); + is( asSegment("5"), ' ----- | | ----- | | ----- ', "asSegment 5"); + is( asSegment("6"), ' ----- | | ----- | || | ----- ', "asSegment 6"); + is( asSegment("7"), ' ----- | | | | ', "asSegment 7"); + is( asSegment("8"), ' ----- | || | ----- | || | ----- ', "asSegment 8"); + is( asSegment("9"), ' ----- | || | ----- | | ', "asSegment 9"); + + done_testing; +} |