Here are my two solutions to this week's Perl Weekly Challenge #355, explanatory comments are in situ:
(with apologies to Julie Andrews and Rodgers & Hammerstein, The Sound of Music)
#!/usr/bin/env perl
use v5.36;
# https://theweeklychallenge.org/blog/perl-weekly-challenge-355/#TASK1
my @examples = qw/123 1234 100000 1000000 1 12345/;
foreach my $input ( @examples ) {
my $output = q{};
# Split the numbers up into individual digits and store them,
# in order, in an array
my @digits = split( //, $input );
# Use Perl's built-in length operator to filter out numbers
# too small to require a thousands comma separator
if ( length( $input ) < 4 ) {
$output = $input;
}
# Since there are 3 different types of numbers to handle, we can
# distinguish between them using the remainder from
# Perl's modulo division operator
elsif ( scalar( @digits ) % 3 == 0 ) {
# The posted example data for this challenge did not include
# any numbers in this category, so I added one to make
# sure the code was working as intended
$output = thousand_separator( \@digits, 3 );
}
elsif ( scalar( @digits ) % 3 == 2 ) {
$output = thousand_separator( \@digits, 2 );
}
else {
# We do not require a test here, there is only one
# option left
$output = thousand_separator( \@digits, 1 );
}
print "Input: \$int = " . $input ."\n";
print "Output: \"" . $output . "\"\n\n";
}
# After inspection I realized that my initial solution could be
# substantially shortened by creating one subroutine to do all
# of the heavy lifting
sub thousand_separator ( $digits, $divisor ) {
my $output = q{};
my $count = 0;
foreach my $digit ( $digits->@* ) {
# Each time through this loop we concatenate the current
# digit onto the end of the number we are building up, and
# then we autoincrement the counter
$output .= $digit;
$count++;
# This test avoids printing an undesired terminal comma
last if scalar( $digits->@* ) == $count;
# For each digit in the array, test to see if it is time
# to add a comma to the number we are building up
if ( $count == $divisor or $count % 3 == $divisor ) {
$output .= ',';
}
}
return $output;
}
Task #2:
#!/usr/bin/env perl
use strict;
use warnings;
# https://theweeklychallenge.org/blog/perl-weekly-challenge-355/#TASK2
while ( ) {
my @row = split(/\t/, $_);
chomp( @row );
next if ( scalar( @row ) < 3 );
print "Input: \@ints = (" . join(", ", @row), ")\n";
# a priori pretend each record will pass the tests
my $is_a_mountain = 'true';
# To detect the desired pattern we are going to keep track of the
# preceding element in the array. Since there is no element before
# index [0] we are going to check this now
my $preceding_element_is = $row[0] > $row[1] ? 'higher' : 'lower';
# If the current array matches the pattern then the value in
# $preceding_element_is "switches" from 'lower' to 'higher' once
# and exactly once, during the analysis loop, and we keep track to
# see IF: it switches at all, AND, how many times it switches
my $switch_count = 0;
while ( my ( $i, $v ) = each( @row ) ) {
# I decided to test this at the start of each iteration, I suspect
# some folks would test it at the end of each cycle.
last if $is_a_mountain eq 'false';
# We already evaluated the value in $row[0]
if ( $i > 0 ) {
if ( $row[$i-1] > $v ) {
$switch_count++ if $preceding_element_is eq 'lower';
$preceding_element_is = 'higher';
}
elsif ( $row[$i-1] < $v ) {
$switch_count++ if $preceding_element_is eq 'higher';
$preceding_element_is = 'lower';
}
else {
# The task does not permit a data record
# where the value in two adjacent array elements are equivalent
# so this condition immediately triggers failure
$preceding_element_is = 'same';
$is_a_mountain = 'false';
}
}
if ( $switch_count > 1 ) {
# If the pattern switches a second time
# it triggers a failure
$is_a_mountain = 'false';
}
}
print "Output: ";
if ( $is_a_mountain eq 'true' and $switch_count == 1 ) {
print "true\n\n";
}
else {
print "false\n\n";
}
}
=pod
=head1 COMMENTS
In order for an array of numbers to meet all of the criteria for a so-called
"Mountain Array" it must contain no adjacent repeated numbers, one
maximum value that is in neither the first nor the last element, and
each array element prior to the max must be larger than the preceding element.
Each element after the max must be smaller than the preceding element.
In this script, starting with the second element in the array, we
determine if it's value is either higher, lower, or the same as the
preceding element. By applying these criteria, and monitoring
if and when that the results of the comparisons "switch" (in this case
from lower to higher), we can determine if the fields in the current
record match the desired pattern (or "shape") of the data. Here are
two different depictions of the pattern. In this case using an array
of seven elements from Example #3 in this weekly challenge.
| index | value | preceding_element_is |
|--------------------------------------|
| 0 | 0 | -- |
| 1 | 2 | lower |
| 2 | 4 | lower |
| 3 | 6 | lower |
| 4 | 4 | higher |
| 5 | 2 | higher |
| 6 | 0 | higher |
Here is an alternative, crude, visualization of what a
Mountain Array would "look" like:
lower
lower higher
lower higher
--- higher
=cut
__DATA__
1 2 3 4 5
0 2 4 6 4 2 0
5 4 3 2 1
1 3 5 5 4 2
1 3 2
