Perl Weekly Challenge #212 - Spinning Letters and Chopping Numbers

Back already with this week's solutions to the PWC #212. Spoiler alert, because the challenge doesn't close for another few days if you want to have a try.

Challenge #1 - Spinning Letters

This week we've got a simple letter rotation. Take each letter of the word provided and rotate it by each number in the list. At first I thought this would be a lot longer code. i even put it in a sub. That actually doubles the size though for absolutely no benefit, so I just simplified. We split the word, then loop through the letters and apply the rotation. If it wraps we start from the start of the alphabet. Upper-case is handled with a simple test to insert the right case of each character. Then we don't even bother putting the word back together again because we can just say it as-is.

#!/bin/perl

use strict;
use v5.28;

my @letters = split(//, shift);
my @jumps = @ARGV;
my @new_word;

foreach (my $i = 0; $i <= $#letters; $i++) {
    push @new_word, ord($letters[$i]) + $jumps[$i] < (uc($letters[$i]) eq $letters[$i] ? 91 : 123) ? chr(ord($letters[$i]) + $jumps[$i]) : chr(ord($letters[$i]) + $jumps[$i] - 26);
}
say @new_word;

Challenge #2 - Chopping Numbers

This one's slightly more difficult. There may be a more efficient way of doing this, I think using hashes, but in this case it's not so slow as it seems with two for loops. The inner loop only cycles through the list once per number of resulting list. So for instance, in a list of 9 values with a size of 3, the inner list iterates over up to 9 numbers only 3 times. That's very satisfactory performance to me, so it's not worth optimization.

First we sort the list in ascending order, then check if the math works out for the original list size and the size of the intended chopped lists. If not, immediately exit. After that, we pretty much just have the outer loop to keep passing over the list once per needed pass, then the inner loop takes the first item in the list and looks for consecutive numbers up to the requested list size. If it finds all of them it removes them from the list and adds them to their own results array. If it doesn't, it exits. This one took me about an hour or so, but came together eventually and I'm still getting faster!

#!/bin/perl

use strict;
use v5.28;

my $size = shift;
my @list = sort @ARGV;

say '-1' and exit if scalar @list % $size != 0;
my $passes = (scalar @list / $size) - 1;

my @results;

for (my $i = 0; $i <= $passes; $i++) {
    my $curr_digit = 0;
    push @{$results[$i]}, $list[0];
    for (my $j = 1; $j <= $#list; $j++) {
        if ($list[$j] == $list[0] + $curr_digit + 1) {
            push @{$results[$i]}, $list[$j];
            splice (@list, $j, 1);
            if (scalar @{$results[$i]} == $size) {
                last;
            } else {
                $curr_digit++;
                $j--;
            }
        }
        if ($j == $#list and scalar @{$results[$i]} != $size) {say '-1' and exit}
    }
    splice (@list, 0, 1);
}

for (my $k = 0; $k <= $#results; $k++) {
    say @{$results[$k]};
}

That's it for this week. Drop me a comment if you like!

Leave a comment

About oldtechaa

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