oldtechaa

Hello everybody! Welcome back to the Weekly Challenge series, where today we're working on dates again. I like these challenges in particular, for some reason. In this case, we have a rather simple challenge except that it gives us less common date formats than usual.

The challenge gives us a year, month, week(day) of the month, and day of week. Now DateTime provides us with get operations to find WoM and DoW info, but it doesn't provide set operations. For that we need to do a little math. Here's the code below:

#!/usr/bin/perl
use v5.36;
use DateTime;

my ($year, $month, $wom, $dow) = @ARGV;
my $obj = DateTime->new(year => $year, month => $month, day => 1);
if($obj->dow() <= $dow) {
    $obj->add(days => (($dow - $obj->dow()) + (($wom - 1) * 7)));
} else {
    $obj->add(days => ((7 - ($obj->dow() - $dow)) + (($wom - 1) * 7)));
}
say 0 and exit if $obj->month() != $month;
say $obj->day();

We only really have to handle wrapping and assessing whether that day is possible within the month. We use DateTime because it just makes sense, and we create an object with the first day of the month that we're using. If the day is the same or earlier in the week (to save code complexity) than the day we're looking for, we shift the difference and add that to the number of weeks later that the target day is on. If the 1st of the month is later in the week than our target day, we wrap and still shift $wom-1 weeks later.

If our addition to the date means we're now in a different month from the intended one we print out 0 and exit, otherwise we say what the date is now.

It's that simple! Just 12 lines including file header and boilerplate. Hope to see you next week!

Welcome back to another round of the weekly challenge, with just one solution this week. I'm setting up a lemonade stand and need to deal with change. Interestingly, I can only sell one juice per person, so I hope you're not super thirsty!

We can take $5, $10, and $20 bills, and we don't start with any change, so we need our previous customers to provide us with change for future customers. Let's find out if we can make change for a set of customers.

Here's the code:

#!/usr/bin/perl
use v5.36;
use List::Util 'any';

my %till;
my $failure;
foreach my $bill (@ARGV) {
    if(!any {$bill == $_} (5, 10, 20)) {
        say('At least one bill provided is not $5, $10, or $20.') and exit;
    }
    $till{$bill}++;
    if($bill == 20) {
        if($till{10} and $till{5}) {
            $till{10}--;
            $till{5}--;
        } elsif($till{5} >= 3) {
            $till{5} -= 3;
        } else {
            $failure = 'false';
            last;
        }
    } elsif($bill == 10) {
        if($till{5}) {
            $till{5}--;
        } else {
            $failure = 'false';
            last;
        }
    }
}
say(defined($failure) ? $failure : 'true');

It might be possible to make this cleaner, but this is what I came up with quickly, so here it is. Our cash drawer is represented by the hash %till, which contains our $5s, $10s, and $20s. We add each bill we get, then we need to make change (unless it's a 5). If we can't make change at any point, we set our failure flag and stop serving customers. We check for the ability to successfully make change depending on the bill we've been handed. For a 20, first we try to make change with a $10 and a $5, otherwise three $5s, and for a $10 we see if we have any $5s. That's all we have to do! It's a lot of code for a simple result.

Hope to see you all next week. Enjoy!

Hi everybody, we've got another two challenges this week, so let's dive into them!

Remove One

The goal is to see if there's any one number that can be removed to make the set sorted in increasing order. Here's the code:

#!/usr/bin/perl
use v5.36;

my $success = 0;
REMOVAL: for my $removal (0 .. $#ARGV) {
    my @modified = @ARGV;
    splice(@modified, $removal, 1);
    for my $scan (1 .. $#modified) {
        if($modified[$scan] <= $modified[$scan - 1]) {
            next REMOVAL;
        }
    }
    $success = 1;
    last;
}

say ($success ? 'true' : 'false');

We have a labelled outer loop for the numbers we choose to remove. $removal is set to the index of each number we attempt to remove, then we copy the array, remove that number, and scan the result to make sure they all are increasing. If they don't, we skip this number and move on.

If we succeed, we set our flag and exit the loops and print the result.

Duplicate Ones

The next one is an array shifting challenge. We want to insert a duplicate of each 0, shifting everything to the right, and popping off the list to keep the length the same.

Here's the code:

#!/usr/bin/perl
use v5.36;

my @ints = @ARGV;
for(my $i = 0; $i <= $#ints; $i++) {
    if($ints[$i] == 0) {
        splice(@ints, $i, 0, 0);
        pop(@ints);
        $i++;
    }
}

say('(', join(', ', @ints), ')');

This one's also really quite simple. We scan the array, use splice to insert a 0, pop the last number off the end of the array, and skip over the 0 we just inserted. It's that simple!

Both of this week's solutions make use of splice() to insert and remove array elements, something I haven't used a lot before.

Stay tuned for next week's challenge, which should come out Monday!

Hi everybody! Back this week with a (surprisingly long) solution to just Task 1 of the weekly challenge. Task 2 makes no sense to me at all because it seems like examples 1 and 3 disagree with each other. Just sticking to one challenge for that reason. Anyways, let's dive into it!

The goal here is to find the letters that all the provided words share. Here's the code:

#!/usr/bin/perl
use v5.36;

my @words;
my %result_chars;

for(@ARGV) {
    push(@words, [split(//, $_)])
}
@words = sort {$#{$a} <=> $#{$b}} @words;
$result_chars{$_}++ for @{$words[0]};

for my $word (1..$#words) {
    for my $key (keys(%result_chars)) {
        my $occurrences = grep(/$key/, @{$words[$word]});
        if($occurrences == 0) {
            delete($result_chars{$key});
            next;
        } elsif($occurrences <= $result_chars{$key}) {
            $result_chars{$key} = $occurrences;
        }
    }
}

for my $char (@{$words[0]}) {
    if($result_chars{$char}) {
        $result_chars{$char}--;
        say $char;
    }
}

First we make a 2D array of the characters in all the words. That way we only have to split the words up once, instead of repeatedly as we seek through them. It does mean a bit more complexity to deal with a matrix, unfortunately.

We also sort the words by length so the shortest one is first, then make a histogram of all the letters in it. Now it's important to keep all the letters and not remove duplicates, because we have to print duplicates as we see from the example that prints "e, l, l".

We loop through each word, then loop through each letter in the first word (keys of the histogram) and search the current word for that letter. If we don't find it, we delete the letter from the histogram. If we find fewer occurrences than in the histogram, we remove some from the histogram to show how many we actually can make in the current word. If that letter is in the histogram fewer or equal times to the occurrences in the word, we move on to the next letter.

Next, for printing, we would have to have multiple loops to loop through the histogram and remove one instance at a time, so instead I decided I should simply search the original word for characters that successfully passed the test of the other words, then print those characters.

When I first started, I thought this would be super easy, but I discovered complications numerous times through the challenge. Perhaps others will have some better ideas of solutions I can learn from. Unfortunately Flavio Poletti hasn't been doing his solutions recently, I always enjoyed them very much, but be sure to check out past solutions of his at github.polettix.it.

Hopefully I'll be back next week with more solutions!

Hello everybody! For this week's weekly challenge I thought the challenges looked really easy, but they both had a couple slight complicating factors. Also, this was the first time I've used sub signatures.

Similar Words

For this one, we're looking for words that share all characters. We print out each pair of countries.

#!/usr/bin/perl
use v5.36;

my @words = @ARGV;
my $matched = 0;
for (my $i = 0; $i <= $#ARGV - 1; $i++) {
    my $start_word = $words[$i];
    my %start_chars = map {$_ => 1} split(//, $start_word);

    for (my $j = $i + 1; $j <= $#ARGV; $j++) {
        my $match_word = $words[$j];
        my %match_chars = map {$_ => 1} split(//, $match_word);

        if (hashes_equal(\%start_chars, \%match_chars)) {
            say $start_word . ", " . $match_word;
            $matched = 1;
        }
    }
}
say 0 unless $matched;

sub hashes_equal ($start_ref, $match_ref) {
    my %start_chars = %{$start_ref};
    my %match_chars = %{$match_ref};

    if (scalar keys %start_chars == scalar keys %match_chars) {
        foreach (keys %start_chars) {
            if (!defined($match_chars{$_})) {
                return;
            }
        }
        return 1;
    } else {
        return;
    }
}

It essentially boils down to looping through all combinations of words in two loops, converting each word to a hash containing all unique characters. hashes_equal makes sure that the hashes have the same number of keys, then tries the keys and makes sure they have the same values.

Frequency Sort

For this one, we're sorting numbers by how frequently they occur, in increasing order, except when they share a frequency, then we sort them decreasing by value.

Here's the code:

#!/usr/bin/perl
use v5.36;

my %ints;
$ints{$_}++ foreach @ARGV;

my %ints_by_occurrence;
my @results;

foreach (keys %ints) {
    push @{$ints_by_occurrence{$ints{$_}}}, $_;
}
foreach (sort keys %ints_by_occurrence) {
    my $frequency = $_;
    foreach (sort {$b <=> $a} @{$ints_by_occurrence{$frequency}}) {
        my $number = $_;
        for (1..$frequency) {
            push @results, $number;
        }
    }
}
say $_ foreach @results;

This time we're making a hash of arrays, where %intsbyoccurrence uses frequencies as the key, and an array of numbers as the value. %ints contains the initial histogram which is reversed into %intsbyoccurrence. We sort once by frequency, then we sort each array of a given frequency by value, which is pushed onto the results array in the proper order.

Those are my solutions to this week's challenge! Hopefully I'll have more for both challenges next week. See you then.