DEV Community

Bob Lied
Bob Lied

Posted on

PWC 311 Why do you build me up just to let me down?

Another Perl Weekly Challenge, number 311 in a series of, as far as I can tell, infinity. We're gonna change some cases; we're gonna build some groups and tear them down. While we do it, we'll be singing badly out of key to Build Me Up, Buttercup, a Billboard Hot 100 hit from 1969, when I was a mere lad and none of the languages in the Weekly Challenge had yet been invented. Fun fact: the Foundations were the first multi-racial group to have a number one hit in the UK (Sri Lanka -- wasn't expecting that).

311 Task 1: Upper Lower

You are given a string that consists of English
letters only. Write a script to convert lower
case to upper and upper case to lower in the
given string.
Enter fullscreen mode Exit fullscreen mode
  • Example 1: Input: $str = "pERl" Output: "PerL"
  • Example 2: Input: $str = "rakU" Output: "RAKu"
  • Example 3: Input: $str = "PyThOn" Output: "pYtHoN"

This is too easy if, by "English letters" we mean "stick to ASCII." It's considerably harder if we try to include anything that remotely smells of Unicode. But the cardinal virtue of Perl programming is laziness, so we'll stick to ASCII for a one-line program that transliterates as requested.

perl -E 'say tr/a-zA-Z/A-Za-z/r for @ARGV' pERL rakU PyThOn
Enter fullscreen mode Exit fullscreen mode

Possibly notable: the trailing r on the tr/// function returns a copy of the modified string. The default behavior is to return a count of substitutions made, which is perhaps unintuitive but certainly has its uses.

311 Task 2: Group Digit Sum

You are given a string, $str, made up of
digits,and an integer, $int, which is less
than the length of the given string.
Write a script to divide the given string
into consecutive groups of size $int (plus
one for leftovers if any). Then sum the
digits of each group, and concatenate all
group sums to create a new string. If the
length of the new string is less than or
equal to the given integer then return the
new string, otherwise continue the process.
Enter fullscreen mode Exit fullscreen mode
  • Example 1
    • Input: $str = "111122333", $int = 3
    • Output: "359"
    • Step 1: "111", "122", "333" => "359"
  • Example 2
    • Input: $str = "1222312", $int = 2
    • Output: "76"
    • Step 1: "12", "22", "31", "2" => "3442"
    • Step 2: "34", "42" => "76"
  • Example 3
    • Input: $str = "100012121001", $int = 4
    • Output: "162"
    • Step 1: "1000", "1212", "1001" => "162"

The Plan

The task has a basic recursive nature: do something to the string, then do the same thing to the string that results. I take a moment to convince myself that every time I apply the group-sum steps, the resulting string is going to get smaller, and eventually we really will get a string shorter than $n, and not a hike to an infinite loop.

Recursion has an ick factor greater than one. By "ick" I mean that I get confused when debugging. I'm instead going to use an overall structure that looks like

sub groupSum($str, $n)
{
   while ( length($str) > $n )
   {
        $str = mangle($str, $n);
   }
   return $str;
}
Enter fullscreen mode Exit fullscreen mode

Now we have some sub-problems to implement mangle(). The first is how to group digits. The substr function seems like an obvious choice, or we could exploit regular-expression matching. If we put matching in an array context and use the g flag, it will return an array of matches:

my @group = ($str =~ m/.{1,$n}/g);
Enter fullscreen mode Exit fullscreen mode
  • .{1,$n} -- match any character 1 to n times. $n is interpolated into the expression; the range doesn't have to be constant.
  • This works for the leftover that might be less than n long. Matching is greedy, so it will take n characters as long as it can, but when it can't, it will match the leftover bit.
  • Because of the leftover problem, /.{$n}/ would not work. That would need to match n characters every time, so the shorter bit at the end would be left out.

There's another way to do it which is more unique to Perl. The unpack function is designed to deal with data that is in fixed formats (and with binary formats, but that's a whole different subject). With unpack, you give it a format for the string. In our case, the format is n ASCII characters, repeated indefinitely.

my @group = unpack("(a$n)*", $str);
Enter fullscreen mode Exit fullscreen mode

Once again, Perl does that do-what-I-mean thing, and this format also picks up the trailing characters that may be less than n long.

Okay, so we have a way to turn the string into an array of the appropriate-size groups. Each member of the group now needs to be separated into digits and added up. That could be a loop, but I choose map.

use List::Util qw/sum/;
my @sums = map { sum( split(//, $_) ) } @group 
Enter fullscreen mode Exit fullscreen mode

And then those sums need to be combined into a new string.

return join("", @sums); 
Enter fullscreen mode Exit fullscreen mode

All those bits can be turned into concise code without intermediate variables that Perl haters like to disdain, but that connoisseurs of punctuation and fine Perl can appreciate.

sub mangle($str, $n)
{
    return join "", map { sum( split(//, $_) ) } ($str =~ m/(.{1,$n})/g);
}
Enter fullscreen mode Exit fullscreen mode

Well, now our mangle function has been reduced to one line. We may as well re-factor it into our original loop:

sub groupDigitSum($str, $n)
{
    while ( length($str) > $n )
    {
        $str = join "", map { sum( split("", $_) ) } unpack("(a$n)*", $str);
    }
    return $str;
}
Enter fullscreen mode Exit fullscreen mode

Ta-da.

A digression

While I was putting this together, I was annoyed that the mangle function, which would only be used inside of groupDigitSum, was being defined at the same level and therefore entering (dare I say polluting) the global name space.

sub groupDigitSum { ... }
sub mangle { ... }
Enter fullscreen mode Exit fullscreen mode

I grumbled that even Pascal allowed nested function definition. Surely Perl, the overflowing receptacle of the cast-off bits of so many languages that came before, could allow nested subs? Yes! Perl syntax allows the declaration of one sub inside another:

sub groupDigitSum { ...
   sub mangle { ... }
}
Enter fullscreen mode Exit fullscreen mode

Wouldn't that be a nice way to encapsulate the utility function? Alas, no. Subroutines don't localize the same way that variables do. Even though it looks like mangle is inside the scope of groupDigitSum, it goes into the global name space and is still accessible from outside.

One way to make it truly local is to assign an anonymous sub to a scalar variable and use function de-referencing.

sub groupDigitSum { ...
  my $mangle = sub { ... };
  $mangle->($str, $n)
}
Enter fullscreen mode Exit fullscreen mode

That solves the localization, but looks unnecessarily obfuscated, and makes it impossible to unit-test the mangle function.

Another way to hide it is to put these functions inside a package (or class), exporting one and not the other, but that's one step up and one step back -- we hide the mangle name, but we introduce a package/class name.

Top comments (0)