oldtechaa

Hi everybody! Back this week with a solution to just the first challenge project. I know I won't have time for the second one, plus I'm not sure of an efficient solution. I really liked this first one, though! I got to try some new techniques in it.

Spoiler alert, since I know it's only Wednesday/Thursday depending on where you are, but if you're looking to solve this challenge yourself you might prefer not to read this yet.

So the goal of the first challenge is to find the 3 integers in a list that have the greatest product, and print the product.

First, here's the code as usual:

#!/usr/bin/perl

use strict;
use v5.24;

my @sorted = sort {abs($b) <=> abs($a)} @ARGV;
my $complete;
until ($complete) {
    my $negCount = isNeg($sorted[0]) + isNeg($sorted[1]) + isNeg($sorted[2]);
    if ($negCount == 2 || $negCount == 0) {
        $complete = 1;
    } else {
        my $positives;
        for (2..$#sorted) {
            $positives = 1 if !isNeg($sorted[$_]);
        }
        if ($positives) {
            for (2, 1, 0) {
                if (abs($sorted[$_]) == $sorted[$_]) {
                    next;
                } else {
                    splice (@sorted, $_, 1);
                    last;
                }
            }
        } else {
            say $sorted[-1] * $sorted[-2] * $sorted[-3] and exit;
        }
    }
}
say $sorted[0] * $sorted[1] * $sorted[2];

sub isNeg {
    my $num = shift;
    return $num < 0 ? 1 : 0;
}

So, what's it doing? First of all, we know that we want the list sorted so highest numbers are first, because they will result in the highest product if the 3 highest are first. So this means we can first sort by absolute value. However, the element of complexity here is that negative numbers can change things. If you have 1 or 3 negative numbers as your top 3 by absolute value, you need to get that down to 0 or 2. Otherwise the multiplication by an odd number of negative numbers results in a negative product, which is certainly not going to be the greatest product. If we can't get the negative numbers in the final 3 to 2 or 0, then we have special handling for that negative product.

So first, we use a custom sort routine to sort the list by absolute values without replacing them. This was recommended by ChatGPT, and it's an excellent solution to this. I need to think of custom sort routines as solutions for more things. Then we start a loop until we've decided we've found the top 3 finalists.

We count the number of negative numbers in the top three, and if we don't need any further filtering we end the loop. If we do need further filtering, we check if there are any other positive numbers to filter to. If there aren't, we assume we have a negative product and choose the smallest numbers possible to multiply and print out. If there are, we splice out negatives until we get an additional positive in the top 3.

It might sound complicated, but negative numbers do really complicate this task. I have a feeling someone else will find a more efficient or easier way to do it, so I look forward to the other solutions. And I look forward to solutions for the second task also. See you next week!

This week we have a very simple challenge! Again due to time, I just did the first challenge this week, but I have an idea of how I'd solve the second and I'll compare with the way others implemented it.

Anyway, to the challenge. The goal is to find the 3rd smallest element of a matrix. The simplest way is simply to flatten, sort, and pick the element. There might be absolutely more performant ways to do it, such as scanning the entire matrix once and keeping a list of the lowest three as you iterate, but this is a case where I feel that it's simply not worth it. One pass to flatten and one sort isn't worth all the extra implementation complexity. I do look forward to seeing any solutions including that technique though.

Here's my code:

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

foreach (@matrix1) {map {push @list1, $_} @{$_}}
@list1 = sort @list1;
say $list1[2];

Repeated for each input dataset.

So the easy simple way to do this is just to use map to flatten the array onto @list1, then sort it in place and pick the third element. That simple. Essentially 3 lines for the majority of the task.

As I said, I look forward to seeing the other solutions for these challenges, and I'll hopefully see you next week!

Hi everybody!

Just one solution to the first task in the weekly challenge this week, and it's a different type. I didn't have time to do any more, and this solution might not be the most efficient or cleanest, but it looks reasonably good to me.

The goal is to find any words which contain all the letters of the car registration number. I assume this would be to find a nickname for your car based on its registration number. In the examples, all of the words are lower-case, so I just assume that my inputs are lower-case. This week I used a few language features that I haven't used in previous challenges, like loop labels, POSIX classes, and a variable regex. As usual, the first argument to the script (without the space in the rego in the examples) is the registration and the rest of the arguments are the words to match it to.

Here's the code: #!/usr/bin/perl

use strict;
use warnings;
use v5.24;

my %reg;
foreach (split(//, shift)) {
    my ($char) = ($_ =~ /([[:alpha:]])/);
    $reg{lc($char)}++ if $char;
}

WORD:
foreach (@ARGV) {
    my $word = $_;
    MATCH:
    foreach (keys %reg) {
        my $char = $_;
        my $count = $reg{$_};

        next WORD if $word !~ /${char}{$count,}/;
    }
    say $word;
}

Even though none of the examples include registrations with duplicate letters, to protect against this we create a hash containing the letters in the registration number as keys and the number of occurrences as values. Then we search each word for the characters in the hash and make sure that we have at least as many occurrences as the hash value. If we've successfully run through all the values in the hash we say the word that successfully matched.

That's all for this week, like I said I ran out of time, so hopefully I'll see you next week!

Hello everybody! Back this week for weekly challenge 215, where we look for unsorted words and sets of zeros. This week both challenges took me only about 10-15 minutes each. The usual disclaimer about an early post, so don't read spoilers if you want to do the challenge yourself.

Odd One Out

This one's a very simple task to print the number of words that are not alphabetically sorted. Here's the code:

#!/usr/bin/perl

use strict;
use v5.24;

my $removed = 0;
foreach (@ARGV) {if ($_ ne join('', sort(split(//, $_)))) {$removed++}}
say $removed;

It's that simple. We just make a variable to count the number of non-alphabetical words, then for each word in the list we split it, sort the letters, and see if the resulting word matches the word we're testing. If not, we add it to the count. 3 lines essentially, not including the boilerplate. It might be possible to make it look cleaner, but in this one it was so easy to make it compact that I didn't see a point in cleaning it up.

Number Placement

In this task, you're provided with a number of how many zeros you want to remove. We print out a binary value, 1 or 0, of whether it's possible to remove that many zeros. Technically we don't remove the zeros, we change them to 1, but it can only happen if the adjacent numbers are also zero. Here's the solution:

#!/usr/bin/perl

use strict;
use v5.24;

my $count = shift;
say 'You chose a count of 0, please provide a different count.' and exit if $count == 0;
say 'There are not enough elements, please provide more elements to replace.' and exit if @ARGV < 3;
for (my $i = 1; $i < $#ARGV - 1; $i++) {
    if (!($ARGV[$i - 1] + $ARGV[$i] + $ARGV[$i + 1])) {$ARGV[$i] = 1 and $count--}
}
say ($count > 0 ? '0' : '1');

This one I decided to do a little error-checking on zero counts and not having at least 3 elements. Also, I take the count as the first argument provided. I iterate through the numbers provided with a cursor starting at the second position looping to the second to last. If the cursor and its adjacent numbers are all 0, then we switch the cursor element to 1 and subtract from the remaining number to be found. If we haven't found all of them by the time we're done we print a failure 0, and if we have we print a success 1.

That's it for this week! Have a good week everybody and I'll probably see you next week!

Just one weekly challenge entry this week, because I am lacking in time and have no idea how to efficiently solve the second challenge.

So here goes:

Rank Score

First, the code:

#!/usr/bin/perl

use strict;
use v5.24;

my @sorted = reverse sort @ARGV;
my %hash;
my @table = ('G', 'S', 'B');
my $curr;

foreach (@sorted) {
    if ($curr <= 2) {
        $hash{$_} //= $table[$curr];
    } else {
        $hash{$_} //= $curr + 1;
    }
    $curr++;
}

say $hash{$_} for @ARGV;

At first, I thought this challenge was something totally different, I don't know why, but it still turned out quite simply. We want to keep the output in the same order as the input, so we obviously can't just sort and replace the inputs. The easiest way is then to use each score as the key of a hash, where the value is the rank. Since all equal scores will be equally ranked, this sorts the scores from highest to lowest and iteratively assigns ranks. For any duplicates, the index counter continues counting but the defined-or ranks that entry in the hash as the first appropriate rank. For the first 3 ranks, the table of podium winners is used.

That's all for this week! As usual, if you have any comments by all means post them. I'll look forward to seeing the other solutions to challenge 2.