diff options
| -rwxr-xr-x | challenge-200/peter-meszaros/perl/ch-1.pl | 64 | ||||
| -rwxr-xr-x | challenge-200/peter-meszaros/perl/ch-2.pl | 228 |
2 files changed, 292 insertions, 0 deletions
diff --git a/challenge-200/peter-meszaros/perl/ch-1.pl b/challenge-200/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..a1f08b6247 --- /dev/null +++ b/challenge-200/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +# +=head1 Task 1: Arithmetic Slices + +Submitted by: Mohammad S Anwar + +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. + +=head2 Example 1 + + Input: @array = (1,2,3,4) + Output: (1,2,3), (2,3,4), (1,2,3,4) + +=head2 Example 2 + + Input: @array = (2) + Output: () as no slice found. + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; + +my $cases = [ + [[1, 2, 3, 4], [[1, 2, 3], [1, 2, 3, 4], [2, 3, 4]], 'Example 1'], + [[2], [], 'Example 2'], +]; + +sub arithmetic_slices +{ + my $l = shift; + + return [] if @$l < 3; + + my @res; + for my $i (0 .. $#$l-2) { + if ($l->[$i+1] - $l->[$i] == $l->[$i+2] - $l->[$i+1]) { + my $diff = $l->[$i+1] - $l->[$i]; + my @aseq = $l->@[$i, $i+1, $i+2]; + push @res, [@aseq]; + for my $j ($i+3 .. $#$l) { + last if $l->[$j] - $l->[$j-1] != $diff; + push @aseq, $l->[$j]; + push @res, [@aseq]; + } + } + } + return \@res; +} + +for (@$cases) { + is(arithmetic_slices($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; diff --git a/challenge-200/peter-meszaros/perl/ch-2.pl b/challenge-200/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..e02b079f1f --- /dev/null +++ b/challenge-200/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,228 @@ +#!/usr/bin/env perl +# +=head1 Task 2: Seven Segment 200 + +Submitted by: Ryan J Thompson + +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 | + +-----+ + + Seven Segment + +The encoding of each digit can thus 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! + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; + +my $cases = [ + [200, <<'EOD'], + ----- ----- ----- + || || | + || || | + ----- +| | || | +| | || | + ----- ----- ----- +EOD +]; + +package Diginum +{ + # 0123456 + # a + #0 ----- + #1 |b |f + #2 | d | + #3 ----- + #4 |c |g + #5 | e | + #6 ----- + + my $segments = { + a => { + char => '-', + coords => [ + [1, 0], + [2, 0], + [3, 0], + [4, 0], + [5, 0], + ], + }, + b => { + char => '|', + coords => [ + [0, 1], + [0, 2], + ], + }, + c => { + char => '|', + coords => [ + [0, 4], + [0, 5], + ], + }, + d => { + char => '-', + coords => [ + [1, 3], + [2, 3], + [3, 3], + [4, 3], + [5, 3], + ], + }, + e => { + char => '-', + coords => [ + [1, 6], + [2, 6], + [3, 6], + [4, 6], + [5, 6], + ], + }, + f => { + char => '|', + coords => [ + [6, 1], + [6, 2], + ], + }, + g => { + char => '|', + coords => [ + [6, 4], + [6, 5], + ], + }, + }; + + my $numbers = [ + [qw/a b c e f g/], # 0 + [qw/f g/], # 1 + [qw/a f d c e/], # 2 + [qw/a f d g e/], # 3 + [qw/b d f g/], # 4 + [qw/a b d g e/], # 5 + [qw/a b d c e g/], # 6 + [qw/a f g/], # 7 + [qw/a b c d e f g/], # 8 + [qw/a b f d g/], # 9 + ]; + + sub new + { + my $class = shift; + my $self = { + _num => [], + }; + return bless $self, $class; + } + + sub add_digit + { + my $self = shift; + my $num = $self->{_num}; + my $digit = shift // 8; + + my $startcol = defined $num->[0] ? $num->[0]->@* : 0; + for my $row (0 .. 6) { + push $num->[$row]->@*, (' ') x 7; + } + + for my $d ($numbers->[$digit]->@*) { + my $char = $segments->{$d}->{char}; + for my $c ($segments->{$d}->{coords}->@*) { + $num->[$c->[1]]->[$c->[0]+$startcol] = $char; + } + } + } + + sub add_pad + { + my $self = shift; + my $num = $self->{_num}; + my $chr = shift // ' '; + + for my $row (0 .. 6) { + push $num->[$row]->@*, $chr; + } + } + + sub print_num + { + my $self = shift; + my $num = $self->{_num}; + + for my $row (0 .. 6) { + print join('', $num->[$row]->@*), "\n"; + } + } + + sub get_num + { + my $self = shift; + my $num = $self->{_num}; + + my $ret; + for my $row (0 .. 6) { + $ret .= join('', $num->[$row]->@*) . "\n"; + } + return $ret; + } +} + +sub seven_segment +{ + my $num = shift; + + my $diginum = Diginum->new(); + for my $n (split '', $num) { + $diginum->add_digit($n); + } + $diginum->print_num(); + return $diginum->get_num(); +} + +for (@$cases) { + is(seven_segment($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; |