Forem: Bob Lied

PWC 367 Overlapping Oddities

Bob Lied — Sun, 05 Apr 2026 14:15:46 +0000

Task 1, Maximum Odd Binary

It's the week of the Artemis 2 mission to the moon, and we have a problem about odd numbers. I'd call that a Space Oddity.

Task Description

You are given a binary string that has at least one ‘1’.

Write a script to rearrange the bits in such a way that the resulting binary number is the maximum odd binary number and return the resulting binary string. The resulting string can have leading zeros.

Example 1: Input: $str = "1011", Output: "1101"
Example 2: Input: $str = "100", Output: "001"
Example 3: Input: $str = "111000", Output: "110001"
Example 4: Input: $str = "0101",Output: "1001"
Example 5: Input: $str = "1111", Output: "1111"

Task Cogitation

To be as large as possible, a binary number must have all its 1s in the most-significant bits. To be odd, the least significant bit must be a one. So, what has to happen is that all the 1s shift to the left, one shifts to the right, and all the zeroes form a space between them.

I see three possible solutions:

Sort: sort the bits so that the 1s are on the left, the 0s on the right, and then rotate a 1 into the right-most position.
Split: make a pass over the bits, creating a pile of 1s and a pile of 0s. Form the required output string from the piles.
Count: There's no need to move the bits around. Count how many 1s there are. Conjure a string of 1s, and a string of 0s.

Task Implementation

Solution 1: Sorting

sub mobSort($str)
{
    my @bits = sort { $b cmp $a } split(//, $str);
    push @bits, shift @bits;
    return join("", @bits);
}

Notes:

Sort in descending order to put 1s on the left
Rotate by taking the bit on the left and pushing it onto the right.

Solution 2: Splitting

sub mobSplit($str)
{
    my @bit = ( "", "" );
    $bit[$_] .= $_ for split //, $str;

    substr($bit[1], -1, 0, $bit[0]);
    return $bit[1];
}

Notes:

I want a group of 0s and a group of 1s. That's an array of size two, conveniently indexed by [0] and [1].
For each 0 or 1, append to its string.
To form the output, use the four-argument form of substr, which replaces a substring. In the string of 1s, insert the string of 0s just before the zero-length string in front of the last bit.

Solution 3: Counting

sub mobCount($str)
{
    my $n = length($str);
    my $zero = ($str =~ tr/0/0/);

    return ("1" x ($n-$zero-1)) . ("0" x $zero) . ("1");
}

Notes:

The output will be the same length as the input.
The number of zeroes can be counted by the Perl FAQ idiom of using the tr/// operator -- it returns the number of substitutions.
Now we know how any 1s and 0s we need, so replicate them appropriately.

Task Benchmark

It's too trivial a problem to be concerned about performance, but let's benchmark it anyway.

               Rate   sorting splitting  counting
sorting    128205/s        --      -28%      -95%
splitting  178571/s       39%        --      -93%
counting  2500000/s     1850%     1300%        --

I'm not surprised that sorting is slowest (it's an O(n_log_n) algorithm). I am a little surprised how much faster counting is.

Task 2, Conflict Events

Task Description

You are given two events' start and end time.

Write a script to find out if there is a conflict between the two events. A conflict happens when two events have some non-empty intersection.

Example 1:
- Input: @event1 = ("10:00", "12:00") @event2 = ("11:00", "13:00")
- Output: true
- Both events overlap from "11:00" to "12:00".
Example 2:
- Input: @event1 = ("09:00", "10:30") @event2 = ("10:30", "12:00")
- Output: false
- Event1 ends exactly at 10:30 when Event2 starts. Since the problem defines intersection as non-empty, exact boundaries touching is not a conflict.
Example 3:
- Input: @event1 = ("14:00", "15:30") @event2 = ("14:30", "16:00")
- Output: true
- Both events overlap from 14:30 to 15:30.
Example 4:
- Input: @event1 = ("08:00", "09:00") @event2 = ("09:01", "10:00")
- Output: false
- There is a 1-minute gap from "09:00" to "09:01".
Example 5:
- Input: @event1 = ("23:30", "00:30") @event2 = ("00:00", "01:00")
- Output: true
- They overlap from "00:00" to "00:30".

Task Cogitation

The string form of time is annoying to work with. The first thing to do is to convert the time to a minute of the day. As we learned last week, there are 1440 minutes in a day. And as we learned long ago, there are 525,600 minutes in a year, but that's not relevant. Stay focused.

Once we have the times converted, then we have a problem in detecting overlapping ranges. I know how to do that. The examples highlight the edge cases.

Example 5 throws a curve: the ranges can cross midnight. There will be math involving modulo operators.

I'm going to break this down into small pieces.

Task Solution

What I'm going for is: does the range of event 1 overlap with the range of event 2? That means I need a function to see if ranges overlap, which means I need a function to convert times to ranges, which means I need functions to convert time strings to numbers. Let's pop that stack.

Subtask: Time conversion

Very straightforward. I'm assuming times have been validated and are in the specified format.

sub toMinute($hhmm)
{
    my ($h, $m) = split(":", $hhmm);
    my $minute = $m + 60 * $h;
    return $minute;
}

Subtask: Event range

Here's where we isolate the problem of spanning midnight. We figure out how long the event is, using a 24-hour clock modulo operation. Then, replace the beginning of the range by subtracting the duration from the end. That means we might get a negative number for the beginning, but that's okay -- it represents a time before midnight.

sub toRange($minBeg, $minEnd)
{
    my $duration = ($minEnd - $minBeg) % 1440;
    return [ $minEnd - $duration, $minEnd ];
}

Subtask: Range overlap

Given two ranges, whether they overlap depends on where their edges line up.

I like use enum as a way to introduce a little readability. It's a very efficent module, and quite flexible.

sub isOverlap($range1, $range2)
{
    use enum qw( BEG=0 END=1 );
    return $range1->[END] > $range2->[BEG]
        && $range1->[BEG] < $range2->[END];
}

Composition of the solution

sub isConflict($event1, $event2)
{
    return isOverlap(toRange( map { toMinute($_) } $event1->@* ),
                     toRange( map { toMinute($_) } $event2->@* ) );
}

Given all the pieces, the solution falls into place.

map { toMinute() " -- convert the time strings into pairs of numbers that we can do arithmetic with.
toRange( map {} ) - convert pairs of points in time into ranges that might span midnight.
isOverlap(...) - the answer is the result of checking for range overlap.

PWC 366, Task 2, Valid Times

Bob Lied — Fri, 27 Mar 2026 14:31:07 +0000

PWC 366 Task 2, Valid Times

Here we are at another Weekly Challenge, ticking away the moments that make up a dull day. Fritter and waste the hours in an off-hand way. Kicking around on a piece of ground in your home town, waiting for someone or something to show you the way. Here's a way.

The Requirements Phase

You are given a time in the form ‘HH:MM’. The earliest possible time is ‘00:00’ and the latest possible time is ‘23:59’. In the string time, the digits represented by the ‘?’ symbol are unknown, and must be replaced with a digit from 0 to 9. Write a script to return the count of different ways we can make it a valid time.

Example 1: Input: $time = "?2:34", Output: 3
- 02:34, 12:34, 22:34
Example 2: Input: $time = "?4:?0", Output: 12
- Combinations of hours 04 and 14, with minutes 00, 10, 20, 30, 40, 50
Example 3: Input: $time = "??:??", Output: 1440
Example 4: Input: $time = "?3:45", Output: 3
- 03:45, 13:45, 23:45
Example 5: Input: $time = "2?:15", Output: 4
- 20:15, 21:15, 22:15, 23:15

The Design Phase

My first thought is that it would be fun to make some kind of iterator or generator that replaces each ? with its valid possibilities. My second thought is, "Nah, that seems like a lot of work." And since the cardinal virtue of Perl programming is laziness, I moved on to something simpler.

There are 24 valid hours and 60 valid minutes. The total valid combinations is the cross-product of the two. Let's go with that.

The Implementation Phase

sub validTime($time)
{
    state @hour   = '00' .. '23';
    state @minute = '00' .. '59';

    my ($h, $m) = map { s/\?/./gr } split(/:/, $time);

    return (grep /$h/, @hour) * (grep /$m/, @minute);
}

Notes:

state variables -- These reference lists only need to be set up once, and only in the scope of this function. That's what state does.
'00' .. '23' -- The .. sequence operator has the nice feature that if you want leading zeroes, you get them. Looking at you, bash.
split(/:/, $time) -- Divide the input into its components. As in so many weekly challenge tasks, I'm assuming that the input has already been sanitized and is showing up here in a valid form.
map { ... } -- Do something to both the hours and the minutes.
s/\?/./gr -- The something is to replace ? with . so that it becomes a regular expression. The ? is a meta-character, so it needs to be quoted. Adding the r flag yields the modified string; otherwise s///g would yield the number of substitutions, which is not useful in this context.
my ($h, $m) = ... -- Declaring and initializing two variables from a list of two things.
(grep /$h/, @hour) -- Select a list of the valid hours that can match the $h pattern. This is in a scalar context (numerical multiplication), so the scalar value will result -- the number of matches. Similarly for minutes.
We only need the count, so multiply the two. We could have generated the list of valid times by using the hours and minutes returned from grep in array context, but (I believe I already mentioned this), lazy.

The Delivery Phase

And there you have it. You run and you run to catch up with the sun, but it's sinking, and racing around to come up behind you again. The sun is the same in a relative way, but you're older, shorter of breath, and one day closer to death. But at least you solved weekly challenge 366.

PWC 366 Count Prefixes: Could We Start Again, Please

Bob Lied — Fri, 27 Mar 2026 13:37:30 +0000

PCW 366, Task 1, Count Prefix

So many prefixes, starting from the beginning over and over. It reminds me of "Could We Start Again, Please?" from Jesus Christ, Superstar.

The Task

You are given an array of words and a string (contains only lowercase English letters). Write a script to return the number of words in the given array that are a prefix of the given string.

Example 1:
- Input: @array = ("a", "ap", "app", "apple", "banana"), $str = "apple"
- Output: 4
Example 2:
- Input: @array = ("cat", "dog", "fish"), $str = "bird"
- Output: 0
Example 3:
- Input: @array = ("hello", "he", "hell", "heaven", "he"), $str = "hello"
- Output: 4
Example 4:
- Input: @array = ("", "code", "coding", "cod"), $str = "coding"
- Output: 3
Example 5:
- Input: @array = ("p", "pr", "pro", "prog", "progr", "progra", "program"), $str = "program"
- Output: 7

An Obvious Solution Using a Regular Expression

The first thing that springs to mind is to do a pattern match of each string in @array against the string.

sub countPrefix($str, $array)
{
    scalar grep { $str =~ m/^$_/ } $array->@*;
}

Notes:

Because of the way Perl passes array arguments, I've chosen to invert the order and pass the scalar string first. Then, I further chose to pass an array reference instead of a copy of the array, for premature optimization.
grep returns different things depending on whether it's in scalar context or array context. I want the scalar value always (the count of the number of matches).

A Less-obvious Solution Using a Regular Expression

Another way to approach the problem is to look at it from the point of view of the string. What are all the possible prefixes? Then see if any of the @array values is in that set of alternatives. The programming task in this solution is to build a regular expression that matches every possible prefix.

sub onerex($str, $array)
{
    my $regex =  join('|', map { substr($str, 0, $_) } 0 .. length($str));

    return scalar grep /^(?:$regex)$/, $array->@*;
}

Notes:

0 .. length(str) -- generates the sequence of possible prefix lengths, including the empty string (one of the given examples implies that an empty string should be considered a valid prefix).
map { substr($str, 0, $_) } -- For each length, extract the prefix of that length, giving an array of increasingly longer strings.
join('|', ...) -- Combine the strings into a set of alternatives that can be used in a regular expression.
$array->@* -- Post-fix notation for de-referencing the array. I like it; Perl classic would probably use @$array.
/^(...)$/ -- The potential prefixes must be anchored at the start and end to exactly match one of the alternatives in $regex.
/^(?:...)/ -- We need the parentheses for grouping, but we don't need to extract the pattern match. The ?: assertion does that; it saves the overhead of extracting the match and then ignoring it.

A Solution Using String Compare

All of the strings involved in this task are constants; there's no meta-characters or repetitions that require a regular expression. It could be done with string compares, and that would probably be more efficient. Let's find out.

sub precmp($str, $array)
{
    scalar grep { substr($str, 0, length($_)) eq $_ } $array->@*;
}

Notes:

Implicitly loop over @array. For each possible prefix, extract the same length of string from the front of $str and see if they match exactly.

Benchmark

Let's see how the solutions compare. I'll make up a string of modest length, and an array with a lot of words. For the purpose of the benchmark, I don't really care how many prefixes are found.

sub runBenchmark($repeat)
{
    use Benchmark qw/cmpthese/;

    my $str = "abcdefghijklmnopqrstuvwxy";
  my $array = [ qw(lorem ipsum dolor sit amet consectetur adipiscing elit e tiam elit neque venenatis ut dolor consectetur iaculis venenatis arcu in in terdum mauris eget neque venenatis dapibus sed finibus varius sapien quis mal esuada fusce libero augue vulputate sit amet faucibus at feugiat at l ectus maecenas vehicula sem metus nullam lobortis massa et est vulputate f acilisis in tempus arcu metus vitae aliquam nibh sodales ac sed vitae era t nec nisl laoreet fringilla aliquam et lobortis purus ut a tristique nisi nec molest ie arcu duis mattis ultrices nisl eget consectetur donec ac lo rem non augue bibendum tincidunt interdum quis velit in gravida metus vitae) ];


    cmpthese($repeat, {
            regex  => sub { countPrefix($str, $array) },
            substr => sub { precmp($str, $array) },
            onerex => sub { onerex($str, $array) },
        });
}

And now for the unveil:

           Rate  regex onerex substr
regex    8636/s     --   -73%   -95%
onerex  31447/s   264%     --   -83%
substr 185185/s  2044%   489%     --

The solution with simple string compares wins by blowout. This is not surprising to me. The overhead of setting up regular expressions and doing their evaluation is mostly unnecessary for this task, and the string compares are highly optimized operations in Perl.

PWC 362 Echo Chamber

Bob Lied — Thu, 26 Feb 2026 15:34:51 +0000

The musical accompaniment must obviously be Pink Floyd's Echoes.

The Task

You are given a string containing lowercase letters.

Write a script to transform the string based on the index position of each character (starting from 0). For each character at position i, repeat it i + 1 times.

Example 1
- Input: "abca"
- Output: "abbcccaaaa"
Index 0: "a" -> repeated 1 time -> "a"
Index 1: "b" -> repeated 2 times -> "bb"
Index 2: "c" -> repeated 3 times -> "ccc"
Index 3: "a" -> repeated 4 times -> "aaaa"

The Thoughts, Both Profound and Superficial

A string transformation problem, an ideal domain for Perl. There are at least three approaches I can see.

Treat it as a regular expression problem, substituting each character for n copies of itself. It wouldn't be Perl if at least one of the more-than-one-way-do-its didn't have more punctuation than letters.
Treat it as a list problem. Separate the string into a list of characters and map each list element into n copies of itself.
Treat it as a string generation problem. Build a new string out of bits of the original.

In any case, the linchpin is going to be the repetition operator, x.

The Solutions

A Regular Expression Substition

sub echoRE($str)
{
    use English;
    return $str =~ s/(.)/$1 x $LAST_MATCH_END[1]/ger;
}

Several features of Perl regular expressions come into play.

We need to do some math in the substitution to replicate the characters. To put executable code into the substitution, we use the /e flag.
We need the index of the character we're replacing. Perl regular expressions have many useful side effects that are available in special variables. When using a capture group, the indexes of the beginning and end of the matching text are available in the @- and @+ special array variables.
The default result of a s///g global substitution is the number of replacements made, which can be useful in some contexts, but not this one. The /r flag changes the behavior so that it results in the modified string instead.
I'm conceding a tiny bit to readability. use English lets me use $LAST_MATCH_END in place of $+.

Here's the breakdown of willing the regular expression into existence:

s///gr -- It's going to be a global substituion (every character), and we want the result.
s/(.)//gr -- Capture every character, no matter what it is.
s/(.)/$1 x .../gre -- Replicate the captured character the appropriate number of times. Add the e flag to execute this expression.
s/(.)/$1 x $+[1]/gre -- After a visit to the Perl references (just to spite AI, I used an actual book of genuine paper), we find that the offset of the captured character is in the @- and @+ special variables. Using @+ (end of the match) instead of @- takes care of the index+1 annoyance.
As evidenced by the step above, I can't remember the special variables, so I add use English to get the name LAST_MATCH_END.

A List Solution

sub echoMap($str)
{
    return join "", map { substr($str, $_-1, 1) x $_} 1 .. length($str)
}

This solution turns each character into a longer string of repeated characters. It maps indexes into a corresponding string of the correct length.

A String-building solution

sub echoStr($str)
{
    my $result = "";
    for my ($i, $c) ( indexed split(//, $str) )
    {
        $result .= ($c x ($i+1));
    }
    return $result;
}

A variation on the list processing, this one builds a string with repeated concatenation. Instead of building a list with map and then join-ing it into a result, this one goes straight to the string.

split gives me the individual characters as a list. It's more efficient than repeated calls to substr.

Since we need both the character and its index, I relied on my favorite variation of the for loop using indexed to conveniently give me variable names.

The Comparison

As always, I'm curious about the relative efficiency of the solutions. Here's a benchmark result:

           Rate    regex  mapjoin splitstr
regex    2365/s       --     -43%     -57%
mapjoin  4118/s      74%       --     -25%
splitstr 5469/s     131%      33%       --

I'm a little surprised that regular expressions didn't fare better. I hypothesize that the addition of executable code in the substitution is a significant cost.

I'm not surprised that string building won. Iterating over lists and manipulating strings are a core strength of Perl, and those operations have no doubt been optimized to heck over the decades.

PWC 360 Pertaining to a subtlety of sorting

Bob Lied — Wed, 11 Feb 2026 17:05:44 +0000

It's been a while since I commented on a Weekly Challenge solution, but here we are at week 360. Such a useful number. So divisible, so circular. It deserves twenty minutes.

Task 2: Word Sorter

The task

You are given a sentence. Write a script to order words in the given
sentence alphabetically but keep the words themselves unchanged.

# Example 1 Input: $str = "The quick brown fox"
#           Output: "brown fox quick The"
# Example 2 Input: $str = "Hello    World!   How   are you?"
#           Output: "are Hello How World! you?"
# Example 3 Input: $str = "Hello"
#           Output: "Hello"
# Example 4 Input: $str = "Hello, World! How are you?"
#           Output: "are Hello, How World! you?"
# Example 5 Input: $str = "I have 2 apples and 3 bananas!"
#           Output: "2 3 and apples bananas! have I"

The thoughts

This should be quite simple: split the words, sort them, put them back together. The sort should be case-insensitive.

join " ", sort { lc($a) cmp lc($b) } split(" ", $str);

Creeping doubt #1

Is converting to lowercase with lc the right way to do case-insenstive compares? Not really. Perl has the fc -- fold-case -- function to take care of subtleties in Unicode. We won't see those in simple ASCII text, but for the full rabbit hole, start with the documentation of fc.

Creeping doubt #2

Doing the case conversion inside the sort means that we will invoke that every time there's a string comparison, which will be quite redundant. We could (probably?) speed it up by pre-calculating the conversions once.

The solution

sub sorter($str)
{
    return join " ",
        map { $_->[0] }
        sort { $a->[1] cmp $b->[1] }
        map { [$_, fc($_)] }
        split(" ", $str);
}

This solution uses the idiom of Schwartzian transformation. Every word gets turned into a pair of [original_word, case_folded_word]. That array of pairs gets sorted, and then we select the original words out of the sorted pairs. This is best read bottom-up.

split(" ", $str) -- turns the string into an array of words, where words are loosely defined by being white-space separated.
map { [$_, fc($_)] } -- every word turns into a pair: the original, and its case-folded variation. The result is a list of array references.
sort { $a->[1] cmp $b->[1] } -- sort by the case-folded versions. The result is still a list of array references.
map { $_->[0] } -- select the original word from each pair
join " " -- Return a single string, where the words are separated by one space.

Does it blend?

A quick benchmark shows that it is indeed faster to pre-calculate the case folding. This example used a text string of about 60 words.

           Rate oneline  pre_lc
oneline 32258/s      --    -45%
pre_lc  58140/s     80%      --

My intuition says that when the strings are much shorter, the overhead of the transform might not offset the gains in the sort, but as is so often true, my intuition is crap. This is the result for a string of five words:

oneline  470588/s      --    -59%
pre_lc  1142857/s    143%      --

PWC 353 To each (array) his own

Bob Lied — Mon, 22 Dec 2025 15:12:56 +0000

This week's challenges were early and on the easy side, which was appreciated as the holidays loom. The musical interlude this week ignores the challenge tasks in favor of seasonal light jazz; I have Spotify playing "Winter's Songs: A Windham Hill Christmas."

Task 1: Max Words

The Task

You are given an array of sentences. Write a script to return the maximum number of words that appear in a single sentence.

Example 1:
- Input: @sentences = ("Hello world", "This is a test", "Perl is great")
- Output: 4

The Solution

An easy one -- an early Xmas gift? Split each sentence into words and count them, then take the maximum. Completely ignoring all the complexities of punctuation and internationalization, it's a one-liner:

sub maxWords(@sentence)
{
    use List::Util qw/max/;
    return max map { scalar(split(" ", $_)) } @sentence;
}

The only thing mildly tricky here is transforming the list of words into a count. Inside the body of the map block, we're in array context, so split will return a list. Coercing it with scalar gives the count.

Task 2: Validate Coupon

The Task

You are given three arrays, @codes, @names and @status. Write a script to validate codes in the given array. A code is valid when the following conditions are true:

codes[i] is non-empty and consists only of alphanumeric characters (a-z, A-Z, 0-9) and underscores (_).
names[i] is one of the following four categories: "electronics", "grocery", "pharmacy", "restaurant".
status[i] is true.

Return an array of booleans indicating validity: output[i] is true if and only if codes[i], names[i] and status[i] are all valid.

Example 1:
- Input:
  - @codes = ("A123", "B_456", "C789", "D@1", "E123")
  - @names = ("electronics", "restaurant", "electronics", "pharmacy", "grocery")
  - @status = ("true", "false", "true", "true", "true")
- Output: (true, false, true, false, true)

Thoughts

The volume of text for this one was daunting at first glance, but it turns out to be mostly example data and actually quite easy.

The validation is straight-forward. @codes is a regular expression match; @names is a keyword lookup from a dictionary table (hash); and @status is just a string compare.

We'll be operating on parallel arrays. I see two ways of doing it. First, we could use a variable to loop over the indexes. That's going to yield code with a lot of array subscripts. Or second, we could use each_array from List::More::Utils to do the indexing for us. I'm curious which is more efficient.

To the code-sleigh, Rudolph!

Loop with `indexed`

sub valid($code, $name, $status)
{
    state %ValidName = ( electronics => true, grocery => true,
                         pharmacy => true, restaurant => true );
    my @valid = (true) x $code->@*;

    for my ($i, $c) ( indexed $code->@* )
    {
        $valid[$i] &&= ( $code->[$i] !~ m/[^a-zA-Z0-9_]/ );
        $valid[$i] &&= ( exists $ValidName{$name->[$i]} );
        $valid[$i] &&= $status->[$i] eq "true";
    }
    return \@valid;
}

Notes:

Passing multiple arrays as subroutine parameters implies using references. We could use traditional prototype attributes to make it possible to pass arrays, but let's not.
state %ValidName -- These are valid keywords for the @names input array. Using state makes this a static table, initialized only the first time the subroutine is entered.
@valid -- Our output array, same size as the input array. Assume they're all valid and turn elements false if any check fails.
indexed -- My favorite recent Perl improvement. Returns both the index and the value from an array during a for loop.
valid->[$i] &&= ... -- Any failing test will turn the value to false.
$code->[$i] !~ m/[^a-zA-Z0-9_]/ -- The code has to consist entirely of valid characters, or conversely, it must not match (!~) anything that contains a character other than those. Later I went back to look up exactly what \w and \W mean in Perl regular expressions and realized that I could have used that instead of the character classes.
exists $ValidName{...} -- Use exists explicitly to return a boolean value. A simple lookup that fails would return undef, and will make the result of the expression undef instead of false. Although undef is treated as false in many contexts, it failed the unit test.
return \@valid -- Return a reference. This is convenient for the is() function from the Test2::V0 unit testing framework, and returning a reference also improves performance by avoiding an array copy.

Loop with array iterator

sub validEach($code, $name, $status)
{
    state %ValidName = ( electronics => true, grocery => true,
                         pharmacy => true, restaurant => true );
    my @valid;

    use List::MoreUtils qw/each_arrayref/;
    my $ea = each_arrayref($code, $name, $status);
    while ( my ($c, $n, $s) = $ea->() )
    {
        push @valid, ( $c !~ m/[^a-zA-Z0-9_]/ )
                  && ( exists $ValidName{$n}    )
                  && ( $s eq "true"             );
    }
    return \@valid;
}

Notes:

This is basically the same function, except that the explicit indexing has been replaced by an iterator.
each_arrayref -- There's an each_array function, but since we have array references, this one is convenient.
my $ea = ... -- Creates an iterator over the three arrays.
ea->() -- Call the iterator. ea is the equivalent of a function pointer, and this is function dereference syntax.
while ( my ($c, $n, $s) = ea->() ) -- Each call to the iterator returns a tuple of the next element from each of the $code, $name, and $status arrays.
push @valid, ... -- The same three checks as before, but building the list instead of modifying it, because we don't have an index in hand.

Performance check

I think the iterator version is a little cleaner, because it eliminates the clutter of repeated array subscripts. But I was curious how it compared in efficiency, so I set up a quick benchmark using the examples.

It turns out that the explicit indexing is about twice as efficient as the each_arrayref iterator. Still gonna use it, though.

$ perl ch-2.pl -b 100000
             Rate iterator forindex
iterator  72464/s       --     -47%
forindex 136986/s      89%       --

To do the benchmarking, I set up the examples as an array of test cases, and used Benchmark::cmpthese to do a lot of iterations.

sub runBenchmark($repeat)
{
    use Benchmark qw/cmpthese/;

    cmpthese($repeat, {
            forindex => sub {
                for ( @case )
                {
                    valid($_->{codes}, $_->{names}, $_->{status});
                }
            },
            iterator => sub {
                for ( @case )
                {
                    validEach($_->{codes}, $_->{names}, $_->{status});
                }
            },
        });
}

And the input data looks like this:

my @case = (
    { id     => 'Example 1',
      codes  => [ 'A123',        'B_456',      'C789',        'D@1',      'E123' ],
      names  => [ 'electronics', 'restaurant', 'electronics', 'pharmacy', 'grocery' ],
      status => [ 'true',        'false',      'true',        'true',     'true' ],
      expect => [ true, false, true, false, true ],
    },
    { id     => 'Example 2',
      codes  => [ 'Z_9',      'AB_12',       'G01',     'X99',         'test' ],
      names  => [ 'pharmacy', 'electronics', 'grocery', 'electronics', 'unknown' ],
      status => [ 'true',     'true',        'false',   'true',        'true' ],
      expect => [ true, true, false, true, false ],
    },
    { id     => 'Example 3',
      codes  => [ '_123',       '123',         '',            'Coupon_A', 'Alpha' ],
      names  => [ 'restaurant', 'electronics', 'electronics', 'pharmacy', 'grocery' ],
      status => [ 'true',       'true',        'false',       'true',     'true' ],
      expect => [ true, true, false, true, true ],
    },
    { id     => 'Example 4',
      codes  => [ 'ITEM_1',      'ITEM_2',      'ITEM_3',  'ITEM_4' ],
      names  => [ 'electronics', 'electronics', 'grocery', 'grocery' ],
      status => [ 'true',        'true',        'true',    'true' ],
      expect => [ true, true, true, true ],
    },
    { id     => 'Example 5',
      codes  => [ 'CAFE_X',     'ELEC_100',    'FOOD_1',  'DRUG_A',   'ELEC_99' ],
      names  => [ 'restaurant', 'electronics', 'grocery', 'pharmacy', 'electronics' ],
      status => [ 'true',       'true',        'true',    'true',     'false' ],
      expect => [ true, true, true, true, false ],
    },
);

PWC 352 Five is the one-liest number

Bob Lied — Fri, 19 Dec 2025 22:27:21 +0000

Task 1: Match String

The Task

You are given an array of strings. Write a script to return all strings that are a substring of another word in the given array in the order they occur.

Example 1:
- Input: @words = ("cat", "cats", "dog", "dogcat", "dogcat", "rat", "ratcatdogcat")
- Output: ("cat", "dog", "dogcat", "rat")

The Deep Thoughts

Example 1 implies a couple of constraints. A complete match counts as a substring. Words may be repeated in the input. Repeated words are not duplicated in the output. The output order must match the input order. Noted.

For each word, we'll need to take it out of the list, check for substrings, and then put it back for the next round. A relatively simple way of doing that would be to shift it off the front of the list, do what needs to be done, and then return it by pushing it onto the back.

I don't see much of a way of getting around the idea that every word must be compared to every other word, so we're looking at an O(n²) performance algorithm.

One possibility for reducing the operation count might be to compare a pair of words both ways. If I have $w1 and $w2 in hand, I can check both directions for substring-i-ness. That way, instead of having to loop over the entire NxN matrix, we would only have to loop over the upper or lower triangle of the matrix. It's fewer looping operations, but still the same number of string comparisons. But it would mean more complexity in keeping track of what's been checked, so, meh.

The Code

sub matchString(@words)
{
    use List::Util qw/any/;
    my %seen;
    my @match;
    for ( 1 .. @words )
    {
        my $w = shift @words;
        push @match, $w if ( ! $seen{$w}++ && any { index($_, $w) >= 0  } @words );
        push @words, $w;
    }
    return \@match;
}

Notes:

Use a hash (%seen) to eliminate duplicates, and coincidentally optimize a little by not searching multiple times.
The main loop is once per word, so simply count. Normally, I would prefer something obviously tied to the array (like for (@words)), but since I'm changing the array within the loop, I don't want to have to think too hard about whether the iterator remains valid after removing and adding an element.
index is a cheaper operation than a regular expression match. Benchmarking bears this out -- it's about three times more efficient in my environment and test data.
List::Util::any stops as soon as something works, so it's cheaper than grep, which would evaluate the entire list every time.

Task 2: Binary Prefix

The Task

You are given an array, @nums, where each element is either 0 or 1.

Define xi as the number formed by taking the first i+1 bits of @nums (from $nums[0] to $nums[i]) and interpreting them as a binary number, with $nums[0] being the most significant bit.

For example: If @nums = (1, 0, 1), then:
x0 = 1 (binary 1)
x1 = 2 (binary 10)
x2 = 5 (binary 101)

For each i, check whether xi is divisible by 5.

Write a script to return an array @answer where $answer[i] is true if xi is divisible by 5, otherwise false.

Example 1:
- Input: @nums = (0,1,1,0,0,1,0,1,1,1)
- Output: (true, false, false, false, false, true, true, false, false, false)

Binary numbers formed (decimal values):

         0:   0  (false)
        01:   1  (false)
       011:   3  (false)
      0110:   6  (false)
     01100:  12  (false)
    011001:  25  ( true)
   0110010:  50  ( true)
  01100101: 101  (false)
 011001011: 203  (false)
0110010111: 407  (false)

The Deep Thoughts

Weird flex, but OK.

This puts me in mind of bit-twiddling with C code, but bit-twiddling in Perl is equally possible. The other alternative is probably to build strings and do binary number conversions by prefixing with '0b'.

I kind of want to do a list-based solution, using map to convert each 0 or 1 to a true or false, but I think that would be obfuscating a pretty simple loop.

The Code

sub bpre(@nums)
{
    my @isFive;
    my $b = 0;

    while ( defined(my $bit = shift @nums) )
    {
        $b = ($b << 1) | $bit;
        push @isFive, ( $b % 5 == 0 );
    }
    return \@isFive;
}

Notes:

Destroy the input by shifting a 1 or 0 off the left until the list is gone.
Do bit operations to form a new number.
Build an answer array consisting of boolean values.

Musical Interlude

The solution to task 1 reminds me of Katy Perry's Hot N Cold -- "You're yes, then you're no. You're in, then you're out."

And for Task 2, Mambo Number 5 is oddly appropriate. "Take one step left and one step right, One to the front and one to the side. Clap your hands once and clap your hands twice, And if it looks like this, then you're doin' it right."

PWC 350 Good Substring / Shuffle Pairs

Bob Lied — Wed, 03 Dec 2025 02:48:23 +0000

Musical Interlude

The movie version of Wicked is in theaters right now, so I am reminded of the song For Good -- but I'm gonna link to the Broadway version, because I'm classy like that. It's relevant to programming in Perl because "I don't know if I've been changed for the better, but I have been changed for good." For part two, Lido Shuffle by Boz Scaggs.

Task 1: Good Substrings

The Task

You are given a string. Write a script to return the number of good substrings of length three in the given string. A string is good if there are no repeated characters.

Example 1: Input $str = "abcaefg", Output: 5
- Good substrings of length 3: abc, bca, cae, aef and efg
Example 2: Input: $str = "xyzzabc", Output: 3
Example 3: Input: $str = "aababc", Output: 1
Example 4: Input: $str = "qwerty", Output: 4
Example 5: Input: $str = "zzzaaa", Output: 0

The Think-y Part

There's probably a regular expression for this, but I'm not going to find it. Do the simplest thing that works: take three characters at a time and see if they're different.

The Code-y Part

sub goodSubstring($str)
{
    my $good = 0;
    my @s = split(//, $str);
    for ( 0 .. $#s - 2 )
    {
        my ($first, $second, $third) = @s[$_, $_+1, $_+2];
        $good++ if ( $first ne $second && $first ne $third && $second ne $third );
    }
    return $good;
}

Notes:

Start by turning the string into a list of characters. It could be done with substr, but that would be untidy.
@s[$_, $_+1, $_+2] -- With a nod to readability, I'll extract three consecutive characters with an array slice. It occurs to me that I'll always have two of the next three characters in hand at the bottom of the loop, so doing a complete splice every time could probably be optimized, but I declare it "good" enough.
Since there's exactly three characters in play, check for uniqueness in the most obvious way.

Task 2:Shuffle Pairs

The Task

If two integers A <= B have the same digits but in different orders, we say that they belong to the same shuffle pair if and only if there is an integer k such that A = B * k. k is called the witness of the pair. For example, 1359 and 9513 belong to the same shuffle pair, because 1359 * 7 = 9513.

Interestingly, some integers belong to several different shuffle pairs. For example, 123876 forms one shuffle pair with 371628, and another with 867132, as 123876 * 3 = 371628, and 123876 * 7 = 867132.

Write a function that for a given $from, $to, and $count returns the number of integers $i in the range $from <= $i <= $to that belong to at least $count different shuffle pairs.

Example 1:
- Input: $from = 1, $to = 1000, $count = 1
- Output: 0
- There are no shuffle pairs with elements less than 1000.
Example 2:
- Input: $from = 1500, $to = 2500, $count = 1
- Output: 3
- There are 3 integers between 1500 and 2500 that belong to shuffle pairs.
  - 1782, the other element is 7128 (witness 4)
  - 2178, the other element is 8712 (witness 4)
  - 2475, the other element is 7425 (witness 3)
Example 3:
- Input: $from = 1_000_000, $to = 1_500_000, $count = 5
- Output: 2
- There are 2 integers in the given range that belong to 5 different shuffle pairs.
  - 1428570 pairs with 2857140, 4285710, 5714280, 7142850, and 8571420
  - 1429857 pairs with 2859714, 4289571, 5719428, 7149285, and 8579142
Example 4:
- Input: $from = 13_427_000, $to = 14_100_000, $count = 2
- Output: 11
- 6 integers in the given range belong to 3 different shuffle pairs,
- 5 integers belong to 2 different ones.
Example 5:
- Input: $from = 1030, $to = 1130, $count = 1
- Output: 2
- There are 2 integers between 1020 and 1120 that belong to at least one shuffle pair:
  - 1035, the other element is 3105 (witness k = 3)
  - 1089, the other element is 9801 (witness k = 9)

Deliberations

It takes a minute to digest this one.

I first wondered if there's some algebraic number theory trick that would cut the search space way down, but that made my head hurt, so I moved to doing what computers do best: grinding through a lot of possibilities.

A bad first thought was to try all combinations of the digits, but that's going to die an excruciating slow death on the crucifix of combinatorics, not to mention that we'd be completely wasting our time on all but a few combinations.

A better thought is to look only at the multiples of a given number. There are at most 8 multiples of a number in play: the 10th would add a digit, and therefore can't possibly be a reordering. Examples 3 and 4 have a lot of numbers to grind through, but how long can it take, really? It's one banana, Michael; how much could it cost, ten dollars?

How will I decide that a number is a re-ordering? I think I'll reduce each number to a canonical form where the digits are sorted, then use string compare to see if a multiple has the same canonical form.

To the bat-editor, Robin!

First, a little function to turn a number into a canonical form with its digits in sorted order. Turn the number into a list of digits, sort, and then join the digits back into a string.

sub canonical($n)
{
    join("", sort split(//, $n));
}

Now the main course. I'll want to examine every number in the range $from to $to, inclusive. For each number, I'll want to examine its multiples to see if they have the same digits. I need to count the ones that work so that I can check that there are at least $count of them.

sub shufflePair($from, $to, $count)
{
    my $answer = 0;

    for my $n ( $from .. $to )
    {
        my $base = canonical($n);
        my $max = (9 x length($n))+0;
        my $pair = 0;
        for ( 2 .. 9 )
        {
            my $multiple = $n * $_;

            next if $multiple > $max
                 || index($base, substr($multiple,  0, 1)) < 0
                 || index($base, substr($multiple, -1, 1)) < 0;

            if ( canonical($multiple) eq $base )
            {
                $pair++;
            }
        }
        $answer++ if $pair >= $count;
    }
    return $answer;
}

Notes:

my $base = canonical($n) -- hang on to this for comparison.
my $max = (9 x length($n))+0; -- An optimization. The maximum number we need to be concerned with is one that has the same number of digits, but is all 9s. For example, if $n is 480, then we are dealing with 3-digit numbers, so the largest possible is 999. That's less than 480*3=1440, so we don't have to examine any of the multiples beyond 480*2.
for ( 2..9 ) -- These are the only multiples of $n that could possibly have the same number of digits.
next if ... -- Besides the check on $max, we can make cheap checks on a single digit. If the first or last digit isn't one of the possible digits, we can avoid the overhead of canonical(), which isn't horrendous, but it does involve allocating lists and a sort.
canonical($multiple) eq $base -- This string compare is where we decide if we have a shuffle pair.
$answer++ if $pair >= $count -- We increment the answer if this number has at least $count shuffle pairs.

This solution takes a few seconds to run the examples. My optimizations to bail early in many cases cut the run time approximately in half (from about 8 seconds to about 4.5).

PWC 349 More complex than it has to be

Bob Lied — Wed, 26 Nov 2025 03:32:52 +0000

PWC 349 Task 2: Meeting Point

Musical Interlude

We're going deep cut from the classic Blood on the Tracks album by Bob Dylan, Meet Me in the Morning

The Task

You are given an instruction string made up of U (up), D (down), L (left) and R (right). Write a script to return true if following the instructions, you meet (0,0) at any point along the sequence.

Example 1:
- Input: $path = "ULD"
- Output: false
- U -> (0,1), L -> (-1,1), D -> (-1, 0)
Example 2:
- Input: $path = "ULDR"
- Output: true
- U -> (0,1), L -> (-1,1), D -> (-1, 0), R -> (0,0)
Example 5:
- Input: $path = "RRUULLDDRRUU"
- Output: true
- RRUULLDD -> (0,0), RRUU -> (2,2)

The Deliberation

The first thought is emulate the movement on the grid and see if we end up at (0,0).

A clever thought arises: to end up back where we began, every Up must be matched with a Down, and every Right must be matched with a Left. So all we really have to do is count moves, right?

But Example 5 throws a wrench. The path makes a big square and passes through (0,0), but doesn't end there. I guess I really do need to check every move in the path.

Second clever thought (this one might be worth keeping): moving around a grid can be like moving in the complex plane. A horizontal move is along the real axis, and a vertical move is along the imaginary axis. If we think of the location as a complex number, then a move is an increment of either the real or the imaginary part.

The Code

Nice try, no cigar

Let's dispense with what didn't work, because it looked good until we hit Example 5.

sub meet($path)
{
    my @m = map { scalar(()= $path =~ m/$_/g) } qw(U D L R);
    return $m[0] == $m[1]  && $m[2] == $m[3];
}

Notes:

We'll try to count the number of each direction and see if Ups cancel Downs and Rights cancel Lefts.
my @m = map {...} qw(U D L R) -- for each move, map to the number of occurrences of that move in $path
$path =~ m/$_/g -- $_ is one of (U,D,L,R). The regular expression match with a g flag can return a list of all the occurrences of that letter in $path.
scalar(()= ...) -- assigning the match to an empty list will create an array context, so that m// will yield a list. Then taking the scalar of that will give a count. This is a variant of the =()= Saturn secret operator
Now it only remains to check if the numbers align.

Moving on to something that works

sub meetComplex($path)
{
    use Math::Complex;

    state $origin = (0 + 0*i);
    state %move = ( R => (1 + 0*i), L => (-1 +  0*i),
                    U => (0 + 1*i), D => ( 0 + -1*i), );

    my $place = $origin;
    for ( split(//, uc $path) )
    {
        $place += $move{$_};
        return true if $place == $origin;
    }
    return false;
}

Notes:

use Math::Complex -- Yes, Perl does complex arithmetic.
state $origin = (0 + 0*i) -- Set up a "constant" for the origin. state makes a variable that is initialized only the first time the function is entered, and limits the scope to the function. Math::Complex makes it possible to write complex constants in a natural way.
state %move -- Set up "constants" for movements. Moving Right and Left affects the real part of the complex number; moving Up and Down affects the imaginary part.
for ( split(...) ) -- Take the path apart to process each move. I threw in an uc to make sure we would only have uppercase input.
$place += $move{$_} -- For each move, change $place in the complex plane. Math::Complex overloads operators as expected.
return true if $place == $origin -- Complex numbers can be compared, of course.
If we didn't find (0,0), then the answer is false.

PWC 348 String Alike, Convert Time

Bob Lied — Wed, 19 Nov 2025 03:18:12 +0000

PWC 348 Task 1: String Alike

The Task

You are given a string of even length. Write a script to find out whether the given string can be split into two halves of equal lengths, each with the same non-zero number of vowels.

Example 1:
- Input: $str = "textbook" text | book (1, 2)
- Output: false
Example 2:
- Input: $str = "book" bo | ok (1, 1)
- Output: true
Example 3:
- Input: $str = "AbCdEfGh" AbCd | EfGh (1, 1)
- Output: true
Example 4:
- Input: $str = "rhythmmyth" rhyth | mmyth (0, 0)
- Output: false
Example 5:
- Input: $str = "UmpireeAudio" Umpire | eAudio (3, 5)
- Output: false

Thoughts

Two steps are required: dividing the string in half, and counting vowels in each half. Let's do the obvious thing with substr to get the halves, and we can exploit the quirks of tr to count.

The examples give us a couple of important test cases: the string can contain uppercase and lowercase; and the string might not have any vowels at all. Also notice that vowels are strictly "aeiou" -- "y" is not counted as a vowel.

Code

sub strAlike($str)
{
    $str = lc($str);
    my $mid = length($str) / 2;
    my @count = map { $_ =~ tr/aeiou// }
                        substr($str, 0, $mid), substr($str, $mid);
    return $count[0] == $count[1] && $count[0] > 0;
}

Notes:

lc($str) -- eliminate uppercase letters
$mid = ... -- assuming even length given, as specified
substr($str, 0, mid) -- the left half
substr($str, $mid) -- the right half (third argument not needed). The two substr calls result in a list of two strings, which we will pass to ...
@count = map { } -- count vowels in each substring and assign into an array of vowel counts
$_ =~ tr/aeiou// -- Ah, tr. A quirk of tr is that it returns a count of replacements made. Replace all the vowels of interest, and there's our count. Another quirk of tr is that the first argument is not a regular expression, so there are no brackets for character class here. Note the literal use of aeiou. Yet another quirk of tr is that there is no variable interpolation, so it would be awkward to try to parameterize this.
return ... -- The description specifies non-zero counts, so the extra condition is needed to make Example 4 work.

PWC 348 Task 2: Convert Time

The Task

You are given two strings, $source and $target, containing time in 24-hour time form. Write a script to convert the source into target by performing one of the following operations:

Add 1 minute
Add 5 minutes
Add 15 minutes
Add 60 minutes

Find the total operations needed to get to the target.

Example 1:
- Input: $source = "02:30" $target = "02:45"
- Output: 1 (Add 15 minutes)
Example 2:
- Input: $source = "11:55" $target = "12:15"
- Output: 2 (Add 15 minutes, Add 5 minutes)
Example 3:
- Input: $source = "09:00" $target = "13:00"
- Output: 4 (Add 60 minutes four times)
Example 4:
- Input: $source = "23:45" $target = "00:30"
- Output: 3 (Add 15 minutes three times)
Example 5:
- Input: $source = "14:20" $target = "15:25"
- Output: 2 (Add 60 minutes, Add 5 minutes)

Thoughts

This is a variation on the problem of making change from a set of coins, or finding the combination of stamps to pay postage.

We need to find the difference in minutes from $source to $target. Example 4 shows that we might have to cross midnight.

I could take the hours and minutes apart and do the math. But I think I'd rather use well-tested modules, so I'll use Time::Piece to parse the times and find the difference.

The operation count will be taking the biggest number of chunks possible, so in reverse order: 60, 15, 5, 1.

Code

sub convert($source, $target)
{
    use Time::Piece;

    my $s = Time::Piece->strptime($source, "%H:%M");
    my $t = Time::Piece->strptime($target, "%H:%M");
    my $min = ($t - $s)->minutes;
    if ( $min <  0 ) { $min += 24*60; }

    my $count = 0;
    for my $period ( 60, 15, 5, 1 )
    {
        $count += int($min / $period);
        $min %= $period;
    }
    return $count;
}

Notes:

strptime() -- parse the time strings and create a Time::Piece object. Without any day information, this will be a time on January 1, 1970, but we don't care.
($t-$s)->minutes -- Time::Piece objects can be subtracted to get a duration. That duration is actually a Time::Seconds object, which has a method that returns the duration in minutes.
if ( $min < 0 ) -- This covers the case where $target is after midnight. We'll add 24 hours of minutes to wrap it around back to positive.
The rest is math. Reduce by hours, then quarter-hours, then 5-minute blocks. Since the last block is 1 minute, this will always eventually terminate.

PWC 345: I Went to the Mountains

Bob Lied — Thu, 30 Oct 2025 13:28:42 +0000

I found the two tasks this week straight-forward and oddly specific, respectively.

Music: the task titles this week are "Peak Positions" and "Last Visitor", which led me to the refrain "I went to the mountains." It's a reference to Closer to Fine by the Indigo Girls, which references Perl philosophy: "There's more than one answer to these questions pointing me in a crooked line, and the less I seek my source for some definitive, the closer I am to fine."

However, for "Peak Positions", let's go with Ain't No Mountain High Enough by Marvin Gaye; and for "Last Visitor", with it's odd back and forth, how about the venerable Hello, Goodbye by the Beatles.

Task 1: Peak Position

The task

You are given an array of integers, @ints. Find all the peaks in the array. A peak is an element that is strictly greater than its left and right neighbors. Return the indices of all such peak positions.

The thought process

My first thought was to use List::MoreUtils::indexes to test each element, but the edges make it weird. One way or another, they will have to be handled separately. Maybe put a fake element on each end? Do them first and then process the rest? Or test for edges while looping?

My mental model is that the edges of the list fall away into an abyss, so anything outside the list should be below the altitudes given at the edge positions. I suppose it's equally valid to assume that the list is surrounded by huge ice walls (winter is coming).

There are a couple of unspecified anomalies, for which I'm going to take executive decisions:

Empty list: return an empty list
Single element: that's one peak at index 0
Ramp up: (e.g. 7,8,9) the rightmost element is the only peak
Ramp down: (e.g. 6,5,4) the left-most element is the only peak
Plateau: (e.g., 7,7,7) No peak, return an empty list. This contradicts my decision for a single element (a plateau of one). Do I contradict myself? Very well then, I contradict myself. (I am large, I contain multitudes.)

The code

sub peakPos(@int)
{
    my @peak = ();
    for my ($i, $n) ( indexed @int )
    {
        my $left  = ( $i == 0     ) ? $n-1 : $int[$i-1];
        my $right = ( $i == $#int ) ? $n-1 : $int[$i+1];
        push @peak, $i if ( $n > $left && $n > $right );
    }
    return \@peak;
}

Notes:

Once again I chose indexed (anointed as non-experimental in Perl 5.40) for concise and efficient array traversal.
Each element has a left neighbor and a right neighbor. For the edges, I'm going to conjure up the missing neighbor and make it less, assuming that outside the list is a bottomless void. You know the one -- the one we scream into while we're on mute during Zoom calls.

Task 2: Last Visitor

The task

You are given an integer array @ints where each element is either a positive integer or -1. We process the array from left to right while maintaining two lists:

@seen: stores previously seen positive integers (newest at the front)
@ans: stores the answers for each -1

Rules:

If $ints[i] is a positive number -> insert it at the front of @seen
- If $ints[i] is -1:
- Let $x be how many -1s in a row we’ve seen before this one.
- If $x < len(@seen) -> append seen[x] to @ans
- Else -> append -1 to @ans

At the end, return @ans.

The thought process

This task description is highly proscriptive. I'm not sure there's anything better to do here than to translate the text into Perl statements.

sub lastVisitor(@int)
{
    my @seen = ();
    my @ans  = ();

    my $x = 0;  # Count of consecutive -1s
    for ( @int )
    {
        if ( $_ > 0 )
        {
            $x = 0;
            unshift @seen, $_;
        }
        else
        {
            if ( $x < @seen )
            {
                push @ans, $seen[$x];
            }
            else
            {
                push @ans, -1;
            }
            $x++;
        }
    }
    return \@ans;
}

Notes: I don't think there's much to add. There's a couple of basic language features being exploited.

for (@int) -- use the implicit $_ variable for array elements to avoid having to think of a name
unshift -- put things on the front of a list
@seen -- in scalar context gives the size of the array (no need for a length())

The only thing tricky here is incrementing and resetting $x so that it correctly counts the consecutive occurrences of -1. Because there was a possibility of error, I of course made that error, but unit tests straightened me out.

PWC 344, Task 2: Pick Up the Pieces

Bob Lied — Thu, 23 Oct 2025 14:51:34 +0000

Task 2: Array Formation

The Task

You are given two lists: @source and @target.

Write a script to see if you can build the exact @target by putting these smaller lists from @source together in some order. You cannot break apart or change the order inside any of the smaller lists in @source.

Example 1:

Input: @source=([2,3], [1], [4]), @target=(1, 2, 3, 4)
Output: true
Use in the order: [1], [2,3], [4]

Example 2:

Input: @source=([1,3], [2,4]), @target=(1, 2, 3, 4)
Output: false

Example 3:

Input: @source=([9,1], [5,8], [2]), @target=(5, 8, 2, 9, 1)
Output: true
Use in the order: [5,8], [2], [9,1]

Example 4:

Input: @source=([1], [3]), @target=(1, 2, 3)
Output: false
Missing number: 2

Example 5:

Input: @source=([7,4,6]), @target=(7, 4, 6)
Output: true
Use in the order: [7, 4, 6]

The Thought Process

The musical selection for our programming journey is the funky disco-adjacent Pick Up the Pieces, by Average White Band. It was a number one hit in 1974, a time when it was still possible for an instrumental tune to make the charts. Fun personal anecdote: in my high school, the English department partnered with a local radio station (KYVA AM 1230 in Gallup, New Mexico) to put on a 15-minute show on Thursday evenings, and "Pick Up the Pieces" was our intro music.

Nostalgia aside, with a small number of lists in @source, it's tempting to just plow through all the possible combinations and see if any work, but factorial complexity is scary.

There's a little bit of ambiguity in the description. Although the examples imply it, it's not clear if we need to use all the substrings in @source, or if we can accept a solution that only uses some of them. I'm going with not necessarilly using all of the lists in @source if we don't need them.

What about reusing them? I'm going to say no to that.

The solution I lean toward is to use a stack of possibilities and backtrack if we can't satisfy the @target.

The Code

Does it blend?

Let's start with the sub-problem of checking if one of the lists in @source is a prefix of @target. I want a predicate function that answers whether a list p is a leading prefix of a list t.

sub isPrefix($p, $t)
{
    return false if @$p > @$t;
    my $match = true;
    for my ($i, $n) ( indexed $p->@* )
    {
        $match &&= ($n == $t->[$i]);
    }
    return $match;
}

Notes:

Our arguments are array references, so we'll be de-referencing them a lot.
If $p is longer than $t, then it can't possibly be a prefix.
Start by assuming that the answer is yes.
The indexed builtin in Perl is a convenient way to get variables for the index and the thing at the index in a simple syntax. Love it.
For each element in the prefix, $match continues to be true if the same position $t matches. We could bail from the loop as soon as $match becomes false, but with expected short lists, it might be faster to complete the loop than to insert more logic into each execution. No, I'm not going to benchmark for it.

Does it match?

On to the main event. I want to pick lists from @source that match the beginning of @target. Then, I remove that from consideration, both from @source and from the front of @target. Repeat.

If we hit a dead end, I want to be able to backtrack to an earlier point, so I'll stack my possibilities.

sub canMake($source, $target)
{
    my @stack = ( [ [ $source->@* ], [ $target->@*] ] );
    while ( @stack )
    {
        my ($s, $t) = pop(@stack)->@*;

        for my ($i, $p) (indexed $s->@* )
        {
            next unless isPrefix($p, $t);

            my @t = $t->@*;     # Make a copy of remaining target.
            splice(@t, 0, @$p); # Remove prefix from target.

            # Have we completely matched the target?
            if ( @t == 0 )
            {
                return true;
            }

            my @s = $s->@*;     # Make a copy of remaining source.
            splice(@s, $i, 1);  # Remove the segment we used.

            push @stack, [ \@s, \@t ];  # Try again with smaller sets.
        }
    }
    return false;
}

Notes:

Although the task description uses arrays, I'm passing in array references.
@stack = ( [ ..., ...] ) -- Every element of @stack is a pair: the current set of possible lists, and the current target list. The stack starts with a copy of @source and a copy of @target. There's a lot of references here, and I want to operate on copies, not accidentally change things by going through references.
The main loop continues as long as there are things to try on the stack. There will be at least one iteration, because we explicitly pushed one possibility.
Take the top thing off the stack, and assign the anonymous references to variables we can use. $s will be a reference to the possible source lists, and $t will be a reference to the remaining target list that we have to match.
Oh look, it's indexed again. When I want to remove a list from @source, I'll need to know its position in $s, so this is a convenient way to get it.
Weed out candidates that aren't prefixes of @target. Luckily we have that isPrefix function. If none of the remaining lists match $t, then we'll backtrack to whatever was on the stack.
If we have a working prefix, we'll want to reduce our data. Make copies, and remove the matching pieces.
There are two uses of splice: one to chop off the prefix of $t, and one to surgically remove one element out of $s. It amazes and depresses me that after all these years, I still have to re-read the documentation for splice to remind myself of the order of arguments and what gets returned.
If we've whittled $t down to nothing, success! At this point, if we wanted to enforce the requirement to use all of @source, we could also check that the size of $s is down to 1 (not zero, because we haven't cleaned it up yet).
Note here that if we wanted to allow reuse of the lists in @source, we could do it by not removing the chosen prefix at this point.
Now we're down to a smaller set of possibilities. Push that checkpoint to the top of the stack and continue.
If we ever get out of this loop, it means that we never got @target down to zero, so that's a "no" from me, dawg.

Forem: Bob Lied

PWC 367 Overlapping Oddities

Task Description

Task Cogitation

Task Implementation

Solution 1: Sorting

Solution 2: Splitting

Solution 3: Counting

Task Benchmark

Task Description

Task Cogitation

Task Solution

Subtask: Time conversion

Subtask: Event range

Subtask: Range overlap

Composition of the solution

PWC 366, Task 2, Valid Times

The Requirements Phase

The Design Phase

The Implementation Phase

The Delivery Phase

PWC 366 Count Prefixes: Could We Start Again, Please

The Task

An Obvious Solution Using a Regular Expression

A Less-obvious Solution Using a Regular Expression

A Solution Using String Compare

Benchmark

PWC 362 Echo Chamber

The Task

The Thoughts, Both Profound and Superficial

The Solutions

A Regular Expression Substition

A List Solution

A String-building solution

The Comparison

PWC 360 Pertaining to a subtlety of sorting

The task

The thoughts

Creeping doubt #1

Creeping doubt #2

The solution

Does it blend?

PWC 353 To each (array) his own

The Task

The Solution

The Task

Thoughts

To the code-sleigh, Rudolph!

Loop with indexed

Loop with array iterator

Performance check

PWC 352 Five is the one-liest number

The Task

The Deep Thoughts

The Code

The Task

The Deep Thoughts

The Code

Musical Interlude

PWC 350 Good Substring / Shuffle Pairs

Musical Interlude

The Task

The Think-y Part

The Code-y Part

The Task

Deliberations

To the bat-editor, Robin!

PWC 349 More complex than it has to be

Musical Interlude

The Task

The Deliberation

The Code

Nice try, no cigar

Moving on to something that works

PWC 348 String Alike, Convert Time

The Task

Thoughts

Code

The Task

Thoughts

Loop with `indexed`