diff options
| -rw-r--r-- | challenge-267/robbie-hatley/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-267/robbie-hatley/perl/ch-1.pl | 80 | ||||
| -rwxr-xr-x | challenge-267/robbie-hatley/perl/ch-2.pl | 138 |
3 files changed, 219 insertions, 0 deletions
diff --git a/challenge-267/robbie-hatley/blog.txt b/challenge-267/robbie-hatley/blog.txt new file mode 100644 index 0000000000..f483d6a8b2 --- /dev/null +++ b/challenge-267/robbie-hatley/blog.txt @@ -0,0 +1 @@ +https://hatley-software.blogspot.com/2024/04/robbie-hatleys-solutions-to-weekly_30.html
\ No newline at end of file diff --git a/challenge-267/robbie-hatley/perl/ch-1.pl b/challenge-267/robbie-hatley/perl/ch-1.pl new file mode 100755 index 0000000000..0b01b0b388 --- /dev/null +++ b/challenge-267/robbie-hatley/perl/ch-1.pl @@ -0,0 +1,80 @@ +#!/usr/bin/env perl + +=pod + +-------------------------------------------------------------------------------------------------------------- +TITLE AND ATTRIBUTION: +Solutions in Perl for The Weekly Challenge 257-1, +written by Robbie Hatley on Mon Apr 29, 2024. + +-------------------------------------------------------------------------------------------------------------- +PROBLEM DESCRIPTION: +Task 267-1: Product Sign +Submitted by: Mohammad Sajid Anwar +You are given an array of @ints. Write a script to find the sign of the product of all integers in the given +array. The sign is 1 if the product is positive, -1 if the product is negative, and 0 if product is zero. + +Example 1 input: +[-1, -2, -3, -4, 3, 2, 1] +Expected output: 1 + +Example 2 input: +[1, 2, 0, -2, -1] +Expected output: 0 + +Example 3 input: +[-1, -1, 1, -1, 2] +Expected output: -1 + +-------------------------------------------------------------------------------------------------------------- +PROBLEM NOTES: +The sign of the product is the product of the signs, and sign(x) is given by "0 if x is 0, else x/abs(x)". +So these subs should work: + + use v5.36; + use List::Util 'product'; + sub sign($x) {0==$x and return 0 or return $x/abs($x)} + sub product_sign (@a) {return product map {sign($_)} @a;} + +-------------------------------------------------------------------------------------------------------------- +IO NOTES: +Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a +single-quoted array of arrays of integers, in proper Perl syntax, like so: +./ch-1.pl '([17, -82, 54, -13],[17, -82, -54, -13])' + +Output is to STDOUT and will be each input followed by the corresponding output. + +=cut + +# ------------------------------------------------------------------------------------------------------------ +# PRAGMAS, MODULES, AND SUBS: + + use v5.36; + use List::Util 'product'; + sub sign($x) {0==$x and return 0 or return $x/abs($x)} + sub product_sign (@a) {return product map {sign($_)} @a;} + +# ------------------------------------------------------------------------------------------------------------ +# INPUTS: +my @arrays = @ARGV ? eval($ARGV[0]) : +( + # Example 1 input: + [-1, -2, -3, -4, 3, 2, 1], + # Expected output: 1 + + # Example 2 input: + [1, 2, 0, -2, -1], + # Expected output: 0 + + # Example 3 input: + [-1, -1, 1, -1, 2], + # Expected output: -1 +); + +# ------------------------------------------------------------------------------------------------------------ +# MAIN BODY OF PROGRAM: +for my $aref (@arrays) { + say ''; + say 'Input array = (', join(', ', @$aref), ')'; + say 'Sign of product = product of signs = ', product_sign(@$aref); +} diff --git a/challenge-267/robbie-hatley/perl/ch-2.pl b/challenge-267/robbie-hatley/perl/ch-2.pl new file mode 100755 index 0000000000..c4e3cd7b8a --- /dev/null +++ b/challenge-267/robbie-hatley/perl/ch-2.pl @@ -0,0 +1,138 @@ +#!/usr/bin/env perl + +=pod + +-------------------------------------------------------------------------------------------------------------- +TITLE AND ATTRIBUTION: +Solutions in Perl for The Weekly Challenge 267-2, +written by Robbie Hatley on Mon Apr 29, 2024. + +-------------------------------------------------------------------------------------------------------------- +PROBLEM DESCRIPTION: +Task 267-2: Line Counts +Submitted by: Mohammad Sajid Anwar +You are given a string, $str, and a 26-items array @widths containing the width (in pixels) of each character +from a to z. Write a script to find out the number of lines and the width of the last line needed to display +the given string, assuming you can only fit 100 width units on a line. + +Example 1 inputs: + $str = "abcdefghijklmnopqrstuvwxyz" + @widths = (10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10) +Expected output: (3, 60) +Line 1: abcdefghij (100 pixels) +Line 2: klmnopqrst (100 pixels) +Line 3: uvwxyz (60 pixels) + +Example 2 inputs: + $str = "bbbcccdddaaa" + @widths = ( 4,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10) +Expected output: (2, 4) +Line 1: bbbcccdddaa (98 pixels) +Line 2: a (4 pixels) + +-------------------------------------------------------------------------------------------------------------- +PROBLEM NOTES: +I think I'll first store the 26 widths in a hash keyed by letter, then fill up lines in an array until I'm +out of characters, then return the scalar of that array (line count) and the length of the last element +(last-line length). + + +-------------------------------------------------------------------------------------------------------------- +IO NOTES: +Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a +single-quoted array of arrays, with each inner array consisting of a double-quoted string of lower-case +English letters followed by an array of 26 positive integers, in proper Perl syntax, like so: +./ch-2.pl '(["dlsnvkgueitasashdfirstpqwert",[1,23,17,4,7,2,8,20,5,3,1,23,17,4,7,2,8,20,5,3,5,2,4,3,1,7]])' + +Output is to STDOUT and will be each input followed by the corresponding output. + +=cut + +# ------------------------------------------------------------------------------------------------------------ +# PRAGMAS, MODULES, AND SUBS: + + use v5.36; + use List::Util 'sum0'; + use List::SomeUtils 'mesh'; + # Is a given scalar a string of lower-case English letters? + sub is_az_string ($x) { + # We're only interested in non-empty, non-huge strings consisting + # purely of lower-case English letters abcdefghijklmnopqrstuvwxyz: + $x !~ m/^[a-z]{1,10000}$/ and return 0; + # If we get to here, $x passes all tests so return 1: + return 1; + } + # Is a given scalar a positive integer? + sub is_posint ($x) { + # We're only interested in positive integers: + $x !~ m/^[1-9]\d*$/ and return 0; + # If we get to here, $x passes all tests so return 1: + return 1; + } + # Is a given array a list of 26 positive integers? + sub are_26_posints (@widths) { + return 0 if 26 != scalar(@widths); + for my $width (@widths) {return 0 if !is_posint($width);} + return 1; + } + # Return count of lines, width of last line, and lines: + sub lines ($str, @widths) { + return (0,0) if !is_az_string($str); + return (0,0) if !are_26_posints(@widths); + my @letters = 'a'..'z'; + my %w = mesh @letters, @widths; + my @lines ; + my ($line, $width, $next, $wext); + while ($str) { + ($line, $width, $next, $wext) = ('',0,'',0); + while ($str && $width + ($wext = $w{$next = substr($str, 0, 1)}) <= 100) { + $line .= $next; + $width += $wext; + substr($str, 0, 1, ''); + } + push @lines, $line; + } + return (scalar(@lines), $width, @lines); + } + +# ------------------------------------------------------------------------------------------------------------ +# INPUTS: +my @arrays = @ARGV ? eval($ARGV[0]) : +( + # Example 1 inputs: + [ + "abcdefghijklmnopqrstuvwxyz", + [10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10], + ], + # Expected output: (3, 60) + + # Example 2 inputs: + [ + "bbbcccdddaaa", + [ 4,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10,10,10,10,10, + 10,10,10,10,10,10], + ], + # Expected output: (2, 4) +); + +# ------------------------------------------------------------------------------------------------------------ +# MAIN BODY OF PROGRAM: +for my $aref (@arrays) { + say ''; + my $str = $aref->[0]; + my $wid = $aref->[1]; + my ($count, $width, @lines) = lines($str, @$wid); + say "String = $str"; + say "Widths = @$wid"; + say 'Lines:'; + say for @lines; + say "Line count = $count"; + say "Last width = $width"; +} |