Perl Weekly Challenge #211

A couple very very last-minute solutions to the Weekly Challenge #211. I was crammed for time, so I didn't get to these until the last minute.

Challenge #1

For challenge number 1 I had an idea of the method I would use, but since I've been experimenting with it anyway, I asked ChatGPT for its ideas as well. Because of my lack of time, I wanted to get some help with the design process. ChatGPT is amazing at both developing and describing an algorithm in simple terms to make it understandable. I based my solution somewhat off the AI's algorithm, but I did write it entirely by hand. It's pretty simple, it just iterates across the matrix and makes sure everything matches its diagonal neighbor prior to it.

Another thing you might notice this week is that I actually put my solutions into functions, not just a basic script. Anyways, here it is:

#!/bin/perl

use strict;
use v5.28;

my @matrix1 = (
    [4, 3, 2, 1],
    [5, 4, 3, 2],
    [6, 5, 4, 3],
);

my @matrix2 = ([1, 2, 3], [3, 2, 1]);

say 'Is Matrix1 a Toeplitz matrix? : ' . (is_toeplitz(@matrix1) ? 'TRUE' : 'FALSE');
say 'Is Matrix2 a Toeplitz matrix? : ' . (is_toeplitz(@matrix2) ? 'TRUE' : 'FALSE');

sub is_toeplitz {
    my @matrix = @_;

    my $rows = scalar @matrix;
    my $cols = scalar @{$matrix[0]};

    for (my $r = 1; $r < $rows; $r++) {
        for (my $c = 1; $c < $cols; $c++) {
            if ($matrix[$r][$c] != $matrix[$r - 1][$c - 1]) {return 0;}
        }
    }
    return 1;
}

Challenge #2

For the second challenge, I had no idea of the algorithm to use, so I did some more research on it and found an algorithm to achieve the result. This sorts the numbers, adds the largest ones first, then adds alternating ends to each list to bring the average together. Interestingly, once both arrays match, it continues adding to the first array, so the solution that it finds to the first example is to put 1, 3, 4, 5, 6, and 8 all in the first array and only 2 and 7 in the second. It still works well and is a single pass, so it is quite efficient.

#!/bin/perl

use strict;
use v5.28;

use List::Util 'sum';

if ($#ARGV > 0) {can_split(@ARGV) ? say 'true' : say 'false'};

sub can_split {
    my @nums = sort {$b <=> $a} (@_);
    my $maxindex = scalar @nums;
    my $avg = sum(@nums) / scalar(@nums);
    my (@list1, @list2, $sum1, $sum2);

    for (my $i = 0; $i < $maxindex; $i++) {
        if (scalar @list1 == 0) {
            push @list1, @nums[0];
            $sum1 += @nums[0];
            splice @nums, 0, 1;
        } elsif (scalar @list2 == 0) {
            push @list2, @nums[0];
            $sum2 += @nums[0];
            splice @nums, 0, 1;
        } else {
            if (abs(($sum1 / @list1) - $avg) >= abs(($sum2 / @list2) - $avg)) {
                if ($sum1 / @list1 <= $avg) {
                    push @list1, @nums[0];
                    $sum1 += @nums[0];
                    splice @nums, 0, 1;
                } else {
                    push @list1, @nums[$#nums];
                    $sum1 += @nums[$#nums];
                    splice @nums, $#nums, 1;
                }
            } else {
                if ($sum2 / @list2 <= $avg) {
                    push @list2, @nums[0];
                    $sum2 += @nums[0];
                    splice @nums, 0, 1;
                } else {
                    push @list2, @nums[$#nums];
                    $sum2 += @nums[$#nums];
                    splice @nums, $#nums, 1;
                }
            }
        }
    }
    $sum1 / scalar @list1 == $sum2 / scalar @list2 ? return 1 : return 0;

}

That's all for this week! If I have time I'll see you all next week with more solutions!

Leave a comment

About oldtechaa

user-pic Just getting back into Perl programming. I have a personal project, SeekMIDI, a small graphical MIDI sequencer.