Climb every mountain . . .

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

Perl Weekly Challenge #354 Solutions, "These arrays are a-poppin'!"

Task #1 is here: Perl Weekly Challenge 354, Task 1

#!/usr/bin/env perl

use v5.36;

my @inputs = ( [4, 2, 1, 3], [10, 100, 20, 30], [-5, -2, 0, 3], [8, 1, 15, 3], [12, 5, 9, 1, 15], );

foreach my $input ( @inputs ) {
    # Sorting the input is not required, but might help when debugging(?)
    my @sorted = sort {$a <=> $b} $input->@*;

    # Let's use a hash to store the absolute minimum differences
    # between all of the pair combinations of numbers in each array.  The hash keys will be
    # the differences we calculate, and the hash value(s) will be an arrayref of the number pairs
    # that share the same absolute minimum difference
    my %number_pairs_of = ();
    foreach my $i (0..$#sorted) {

        # skip subtracting self from self, instead start with the
        # next array element
        foreach my $j ($i+1..$#sorted) {
            my $abs_min_diff = $sorted[$j] - $sorted[$i];

            # create an anonymous array containing the current pair, and push that onto
            # the hash values arrayref
            push(@{$number_pairs_of{$abs_min_diff}}, [$sorted[$i], $sorted[$j]]);
        }
    }

    # Now, we extract the keys from the %number_pairs_of hash, and sort them numerically
    # to identify the minimum distance for this $input
    my @differences = sort {$a <=> $b} keys %number_pairs_of;

    # The smallest difference will be in the first array element, so use that as a hash key to
    # select all of the pairs that differ by that amount, and pretty print them to STDOUT
    foreach my $pair ( $number_pairs_of{$differences[0]}->@* ) {
        print "[$pair->[0], $pair->[1]] ";
    }
    print "\n\n";
}

Task #2 is here: Perl Weekly Challenge 354, Task 2

#!/usr/bin/env perl

use v5.36;
use Data::Dumper;

my @inputs = ( [[1, 2, 3], [4, 5, 6], [7, 8, 9]], [[10, 20], [30, 40]], [[1, 2], [3, 4], [5, 6]], [[1, 2, 3], [4, 5, 6]], [[1, 2, 3, 4]] );

# These are the k values for the number of times we are going to shift each grid:
my @integers = ( 1, 1, 1, 5, 1 );

foreach my $matrix ( @inputs ) {
    my @matrix = $matrix->@*;

    # Each time through the loop we use the next "k", and remove it from the array
    my $k = shift @integers;

    # Initialize a variable we'll need soon, using Perl Best Practices syntax
    # (Am I the only Perl hacker in the world that uses this syntax for ''?)
    my $output = q{};

    # There are five Example matrices provided for this task.  Four of them get shifted once
    # but one Example gets shifted more than once.  To handle two different cases
    # use a conditional test, coupled with two alternative code blocks.
    # I assume a more skilled software developer would design the
    # subroutine to call itself recursively.
    if ( $k > 1 ) {

        # If we want to shift the matrix more than once, then we are going to use
        # a for loop with a counter variable and just keep feeding the output from the
        # previous subroutine call, into the input for the next subroutine call, until we
        # use up all the numbers
        for my $i (1..$k) {
            my $new_matrix = shift_grid( \@matrix );
            @matrix = $new_matrix->@*;
        }
    }
    else {
        $output = shift_grid( \@matrix );
        @matrix = $output->@*;
    }

    # The output from each example gets printed to STDOUT
    print Data::Dumper->new([\@matrix],[qw(*matrix)])->Indent(0)->Quotekeys(0)->Dump, "\n\n";
}

sub shift_grid ( $matrix ) {
    my @matrix = $matrix->@*;

    # For each matrix we use the Perl pop function to strip
    # off the terminal element of each array, and we are going to store those popped
    # values in this array (in order, we need to keep track of them)
    my @popped = ();

    # This loop pops them off and then stashes the contents them in the array
    foreach my $row ( @matrix ) {
        my $pop = pop $row->@*;
        push( @popped, $pop );
    }

    foreach my $row (0..$#matrix) {

        # Now we are going to use the Perl unshift function to
        # "paste" those popped array values onto the front of our
        # collection of shortened arrays.  But we wanted to keep
        # track because there are two different types of arrays:
        # The first one, and all the rest
        if ($row == 0 ) {

            # IF: the $row we are processing is the FIRST $row
            # THEN: we use the array index from the terminal arrayref
            # to select the last value we added to the @popped array
            # That is what we paste onto the front of the "shifted"
            # grid:
            unshift $matrix->[$row]->@*, $popped[$#matrix];
        }
        else {

            # Otherwise, we want the popped value from the previous $row
            # to paste onto the front of this $row (this is to satisfy all
            # three of the the rules)
            unshift $matrix->[$row]->@*, $popped[$row - 1];
        }
    }
    return \@matrix;
}