From f1249991c0a493ec1340df80d1e5b4b1dc4db05a Mon Sep 17 00:00:00 2001 From: LoneWolfiNTj Date: Sun, 22 Jan 2023 11:28:08 -0800 Subject: Robbie Hatley's Perl solutions to Weekly Challenge #200. --- challenge-200/robbie-hatley/README | 0 challenge-200/robbie-hatley/blog.txt | 1 + challenge-200/robbie-hatley/perl/ch-1.pl | 29 ++++++ challenge-200/robbie-hatley/perl/ch-2.pl | 161 +++++++++++++++++++++++++++++++ 4 files changed, 191 insertions(+) mode change 100644 => 100755 challenge-200/robbie-hatley/README create mode 100755 challenge-200/robbie-hatley/blog.txt create mode 100755 challenge-200/robbie-hatley/perl/ch-1.pl create mode 100755 challenge-200/robbie-hatley/perl/ch-2.pl diff --git a/challenge-200/robbie-hatley/README b/challenge-200/robbie-hatley/README old mode 100644 new mode 100755 diff --git a/challenge-200/robbie-hatley/blog.txt b/challenge-200/robbie-hatley/blog.txt new file mode 100755 index 0000000000..8889821122 --- /dev/null +++ b/challenge-200/robbie-hatley/blog.txt @@ -0,0 +1 @@ +https://hatley-software.blogspot.com/2023/01/robbie-hatleys-perl-solutions-to-weekly_22.html \ No newline at end of file diff --git a/challenge-200/robbie-hatley/perl/ch-1.pl b/challenge-200/robbie-hatley/perl/ch-1.pl new file mode 100755 index 0000000000..2d69624d72 --- /dev/null +++ b/challenge-200/robbie-hatley/perl/ch-1.pl @@ -0,0 +1,29 @@ +#! /usr/bin/perl +# Robbie Hatley's Perl solution to The Weekly Challenge #200-1 + +=pod + +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. + +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. + +=cut + +# NOTE: Input is by either built-in array of arrays, or by @ARGV. If using +# @ARGV, input should be a space-separated list of integers, which will +# be interpreted as a single array. + +# NOTE: Output is to stdout and will be a list of all arithmetic slice for +# each input array. + +# PRELIMINARIES: +use v5.36; + +say "Sorry, this is just a stub; ran out of time."; +say "\"Task 2\", however, is fully functional."; diff --git a/challenge-200/robbie-hatley/perl/ch-2.pl b/challenge-200/robbie-hatley/perl/ch-2.pl new file mode 100755 index 0000000000..e06aab39d2 --- /dev/null +++ b/challenge-200/robbie-hatley/perl/ch-2.pl @@ -0,0 +1,161 @@ +#! /usr/bin/perl +# Robbie Hatley's Perl solution to The Weekly Challenge #200-2 + +=pod + +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 + +The encoding of each digit can thus be represented compactly as a truth table: +my @truth = qw; +$truth[1] would thus be "bc", indicating that the digit 1 would have segments +"b" and "c" enabled. Write a program that accepts any [non-negative integer +of 1-9 digits] and draws that number as a horizontal sequence of seven-segment +digit displays, similar to the following: + ------- ------- ------- + | | | | | + | | | | | + ------- + | | | | | + | | | | | + ------- ------- ------- +Note that each row consists of 7 lines of 9*n characters, where n is the number +of digits to be displayed. + +=cut + +# NOTE: Input is by @ARGV and should be a single integer in the range +# 0 to 999999999. + +# NOTE: Output is to stdout and will be a row of 7-segment digit displays for +# the digits of the input number. + +# PRELIMINARIES: +use v5.36; + +# SUBROUTINES: +sub display_row($x) +{ + my $l = length($x); + my @digits = split //,$x; + my @lines = + (' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l)); + for ( my $idx = 0; $idx < $l ; ++$idx ) + { + if ( '0' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, '| |'; + substr $lines[2], 9*$idx+2, 7, '| |'; + substr $lines[3], 9*$idx+2, 7, ' '; + substr $lines[4], 9*$idx+2, 7, '| |'; + substr $lines[5], 9*$idx+2, 7, '| |'; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '1' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, ' '; + substr $lines[1], 9*$idx+2, 7, ' |'; + substr $lines[2], 9*$idx+2, 7, ' |'; + substr $lines[3], 9*$idx+2, 7, ' '; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, ' '; + } + elsif ( '2' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, ' |'; + substr $lines[2], 9*$idx+2, 7, ' |'; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, '| '; + substr $lines[5], 9*$idx+2, 7, '| '; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '3' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, ' |'; + substr $lines[2], 9*$idx+2, 7, ' |'; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '4' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, ' '; + substr $lines[1], 9*$idx+2, 7, '| |'; + substr $lines[2], 9*$idx+2, 7, '| |'; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, ' '; + } + elsif ( '5' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, '| '; + substr $lines[2], 9*$idx+2, 7, '| '; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '6' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, '| '; + substr $lines[2], 9*$idx+2, 7, '| '; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, '| |'; + substr $lines[5], 9*$idx+2, 7, '| |'; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '7' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, ' |'; + substr $lines[2], 9*$idx+2, 7, ' |'; + substr $lines[3], 9*$idx+2, 7, ' '; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, ' '; + } + elsif ( '8' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, '| |'; + substr $lines[2], 9*$idx+2, 7, '| |'; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, '| |'; + substr $lines[5], 9*$idx+2, 7, '| |'; + substr $lines[6], 9*$idx+2, 7, '-------'; + } + elsif ( '9' eq $digits[$idx] ) + { + substr $lines[0], 9*$idx+2, 7, '-------'; + substr $lines[1], 9*$idx+2, 7, '| |'; + substr $lines[2], 9*$idx+2, 7, '| |'; + substr $lines[3], 9*$idx+2, 7, '-------'; + substr $lines[4], 9*$idx+2, 7, ' |'; + substr $lines[5], 9*$idx+2, 7, ' |'; + substr $lines[6], 9*$idx+2, 7, ' '; + } + } + say for @lines; +} + +# SCRIPT BODY: +my $x = 200; +if (@ARGV) {$x=$ARGV[0]} +die if $x !~ m/^\d{1,9}$/; +display_row($x); -- cgit From 0c2c33a327dfca05bf91112b6d78d4c598176855 Mon Sep 17 00:00:00 2001 From: LoneWolfiNTj Date: Sun, 22 Jan 2023 13:05:33 -0800 Subject: Added challenge 200-1. --- challenge-200/robbie-hatley/perl/ch-1.pl | 50 ++++++++++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 3 deletions(-) diff --git a/challenge-200/robbie-hatley/perl/ch-1.pl b/challenge-200/robbie-hatley/perl/ch-1.pl index 2d69624d72..789427c264 100755 --- a/challenge-200/robbie-hatley/perl/ch-1.pl +++ b/challenge-200/robbie-hatley/perl/ch-1.pl @@ -15,15 +15,59 @@ Example 2: Input: @array = (2) Output: () as no slice found. =cut +# IO NOTES: +# # NOTE: Input is by either built-in array of arrays, or by @ARGV. If using # @ARGV, input should be a space-separated list of integers, which will # be interpreted as a single array. - +# # NOTE: Output is to stdout and will be a list of all arithmetic slice for # each input array. # PRELIMINARIES: use v5.36; +$,=" "; + +# SUBROUTINES: + +sub is_arith($slice_ref){ + my @slice = @{$slice_ref}; + my $size = scalar @slice; + if ( $size < 3 ) {return 0;} + my $init = $slice[1]-$slice[0]; + for ( my $idx = 2 ; $idx <= $#slice ; ++$idx ){ + if ($slice[$idx] - $slice[$idx-1] != $init) {return 0}} + return 1;} + +sub get_arith_slices($array_ref){ + my @array = @{$array_ref}; + my @slices = (); + my @arith_slices = (); + my $size = scalar @array; + my @masks = (0..((2**$size)-1)); + foreach my $mask (@masks){ + my @slice = (); + for ( my $idx = 0 ; $idx <= $#array ; ++$idx ){ + my $yesno = ($mask/2**($size-$idx-1))%2; + if ($yesno) {push @slice, $array[$idx]}} + push @slices, \@slice;} + foreach my $slice_ref (@slices){ + if (is_arith($slice_ref)) {push @arith_slices, $slice_ref}} + return @arith_slices;} + +# DEFAULT INPUT: +my @arrays = ([1,2,3,4],[2]); + +# NON-DEFAULT INPUT: +if (@ARGV) {@arrays = ([@ARGV])} -say "Sorry, this is just a stub; ran out of time."; -say "\"Task 2\", however, is fully functional."; +# MAIN BODY OF SCRIPT: +for (@arrays){ + my $array_ref = $_; + my @array = @{$array_ref}; + my @arith_slices = get_arith_slices($array_ref); + my $num_arith_slices = scalar @arith_slices; + say ''; + say "Array = (@array)"; + say "Found $num_arith_slices arithmetic slices:"; + for (@arith_slices) {my @slice=@{$_}; say "(@slice)";}} \ No newline at end of file -- cgit From a51df1084746b8933569ba2cc60244ba5f2da816 Mon Sep 17 00:00:00 2001 From: LoneWolfiNTj Date: Sun, 22 Jan 2023 13:25:17 -0800 Subject: Added some comments. --- challenge-200/robbie-hatley/perl/ch-1.pl | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/challenge-200/robbie-hatley/perl/ch-1.pl b/challenge-200/robbie-hatley/perl/ch-1.pl index 789427c264..19dab4fd9b 100755 --- a/challenge-200/robbie-hatley/perl/ch-1.pl +++ b/challenge-200/robbie-hatley/perl/ch-1.pl @@ -44,14 +44,14 @@ sub get_arith_slices($array_ref){ my @slices = (); my @arith_slices = (); my $size = scalar @array; - my @masks = (0..((2**$size)-1)); - foreach my $mask (@masks){ - my @slice = (); - for ( my $idx = 0 ; $idx <= $#array ; ++$idx ){ - my $yesno = ($mask/2**($size-$idx-1))%2; - if ($yesno) {push @slice, $array[$idx]}} - push @slices, \@slice;} - foreach my $slice_ref (@slices){ + my @masks = (0..((2**$size)-1)); + foreach my $mask (@masks){ # For each possible mask, + my @slice = (); # create a slice. + for ( my $idx = 0 ; $idx <= $#array ; ++$idx ){ # For each index in @array, + my $yesno = ($mask/2**($idx))%2; # examine corresponding binary digit in mask, + if ($yesno) {push @slice, $array[$idx]}} # and do-or-don't include $array[$idx] in @slice, + push @slices, \@slice;} # depending on whether digit is 0 or 1. + foreach my $slice_ref (@slices){ # But only return slices that are arithmetic. if (is_arith($slice_ref)) {push @arith_slices, $slice_ref}} return @arith_slices;} -- cgit From e80e6616a02316cde8aec2c9dba70d9a833a6d42 Mon Sep 17 00:00:00 2001 From: LoneWolfiNTj Date: Sun, 22 Jan 2023 13:34:15 -0800 Subject: Simplified mask. --- challenge-200/robbie-hatley/perl/ch-1.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-200/robbie-hatley/perl/ch-1.pl b/challenge-200/robbie-hatley/perl/ch-1.pl index 19dab4fd9b..99f752f39b 100755 --- a/challenge-200/robbie-hatley/perl/ch-1.pl +++ b/challenge-200/robbie-hatley/perl/ch-1.pl @@ -48,7 +48,7 @@ sub get_arith_slices($array_ref){ foreach my $mask (@masks){ # For each possible mask, my @slice = (); # create a slice. for ( my $idx = 0 ; $idx <= $#array ; ++$idx ){ # For each index in @array, - my $yesno = ($mask/2**($idx))%2; # examine corresponding binary digit in mask, + my $yesno = ($mask/2**$idx)%2; # examine corresponding binary digit in mask, if ($yesno) {push @slice, $array[$idx]}} # and do-or-don't include $array[$idx] in @slice, push @slices, \@slice;} # depending on whether digit is 0 or 1. foreach my $slice_ref (@slices){ # But only return slices that are arithmetic. -- cgit