Peter’s blog ✴ Week 377 ✴ 8 June 2026

THE WEEKLY CHALLENGE
Strings within strings

The Perl Camel

Task 2

Prefix suffix

You are given an array of strings. Write a script to find if the two strings ($str1, $str2) in the given array such that $str1 is a prefix and suffix of $str2. Return the total count of such pairs.

Examples


Example 1
Input: @array = ('a', 'aba', 'ababa', 'aa')
Output: 4
$array[0], $array[1]: 'a' is a prefix and suffix of 'aba'
$array[0], $array[2]: 'a' is a prefix and suffix of
   'ababa'
$array[0], $array[3]: 'a' is a prefix and suffix of 'aa'
$array[1], $array[2]: 'aba' is a prefix and suffix of
   'ababa'

Example 2
Input: @array = ('pa', 'papa', 'ma', 'mama')
Output: 2
$array[0], $array[1]: 'pa' is a prefix and suffix of
   'papa'
$array[2], $array[3]: 'ma' is a prefix and suffix of
   'mama'

Example 3
Input: @array = ('abao', 'ab')
Output: 0

Example 4
Input: @array = ('abab', 'abab')
Output: 1
$array[0], $array[1]: 'abab' is a prefix and suffix of
   'abab'

Example 5
Input: @array = ('ab', 'abab', 'ababab')
Output: 3
$array[0], $array[1]: 'ab' is a prefix and suffix of
   'abab'
$array[0], $array[2]: 'ab' is a prefix and suffix of
   'ababab'
$array[1], $array[2]: 'abab' is a prefix and suffix of
   'ababab'

Example 6
Input: @array = ('abc', 'def', 'ghij')
Output: 0

Analysis

This is another challenge in the category of 'why would you ever need to do that?', but let's have a go.

The immediately obvious way is simply to test every pair of strings for this peculiar property. Even with 1000 strings that's only a million tests, and it won't take more than a second or so.

But there are some possible optimisations. Firstly, string A can only be a prefix or suffix of string B if it is no longer than string B. That cuts the number of tests by 2, and since length() is a cheap test I imagine it will cut the runtime by about the same.

And we can (probably) do better still by sorting the strings into length order, so that any any string can only posssibly be a prefix or suffix of itself or a subsequent string.

Another dilemma concerns the check that string A is or isn't a prefix or suffix of string B. The obvious way is:

     $string[$b] =~ m|^$string[$a]|
 and $string[$b] =~ m|$string[$a]$|

But you could do:

($string[$b] . $string[$b]) =~ m|^$string[$a].*$string[$a]$|

which still allows for the fact that the prefix and suffix may overlap, for example 'aba', 'ababa', but halves the number of regex matches, and that's what I've submitted.

Perl Weekly’s review

from PW issue 777

Peter offers a refreshingly simple and useful way to accomplish this task using only Perl. He places an emphasis on keeping the code readable, ensuring UTF-8 characters can safely contain more than one byte, and maintaining a high level of performance in real-world applications. There is no ambiguity or sacrifice made in developing an easy-to-interpret solution to a hard problem and accommodating corner cases.

Try it 

Your input:



eg: a banana ba abba nabban bannab

Script


#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2026-06-08
use utf8;     # Week 377 - task 2 - Prefix suffix
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

prefix_suffix('a', 'aba', 'ababa', 'aa');
prefix_suffix('pa', 'papa', 'ma', 'mama');
prefix_suffix('abao', 'ab');
prefix_suffix('abab', 'abab');
prefix_suffix(qw[a aa aaa aaaa aaaaa aaaaaa]);
prefix_suffix(qw[aba ababa]);

sub prefix_suffix {
    
    my (@strings, $count, $i, $j, $explain);
    
    # initialise
    @strings = @_;
    say qq[\nInput:  ('] . join(q[', '], @strings) . q[')];
    
    # sort by length
    @strings = sort {length($a) <=> length($b)} @strings;
    
    # loop over potential pairs
    $count = 0;
    for $i (0 .. $#strings) {
        for $j ($i + 1 .. $#strings) {
            
            # test for prefix and suffix match
            if (($strings[$j] . $strings[$j]) =~ 
                m|^$strings[$i].*$strings[$i]$|) {
                $count ++;
                $explain .= qq[$strings[$i] of $strings[$j], ];
            }
        }
    }       
        
    say qq[Output: $count] . ($count ? qq[ - ] . 
        substr($explain, 0, -2) : '');
}

14 lines of code

Output from script



Input:  ('a', 'aba', 'ababa', 'aa')
Output: 4 - a of aa, a of aba, a of ababa, aba of ababa

Input:  ('pa', 'papa', 'ma', 'mama')
Output: 2 - pa of papa, ma of mama

Input:  ('abao', 'ab')
Output: 0

Input:  ('abab', 'abab')
Output: 1 - abab of abab

Input:  ('a', 'aa', 'aaa', 'aaaa', 'aaaaa', 'aaaaaa')
Output: 15 - a of aa, a of aaa, a of aaaa, a of aaaaa, a of aaaaaa, aa
   of aaa, aa of aaaa, aa of aaaaa, aa of aaaaaa, aaa of aaaa, aaa of
   aaaaa, aaa of aaaaaa, aaaa of aaaaa, aaaa of aaaaaa, aaaaa of
   aaaaaa

Input:  ('aba', 'ababa')
Output: 1 - aba of ababa

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain