Peter Campbell Smith

Pairs, sriap and

Weekly challenge 256 — 12 February 2024

Week 256 - 12 Feb 2024

Task 1

Task — Maximum pairs

You are given an array of distinct words, @words. Write a script to find the maximum pairs in the given array. The words $words[i] and $words[j] are a pair if one is the other reversed.


Example 1
Input: @words = ("ab", "de", "ed", "bc")
Output: 1

There is one pair in the given array: "de" and "ed"

Example 2
Input: @words = ("aa", "ba", "cd", "ed")
Output: 0

Example 3
Input: @words = ("uv", "qp", "st", "vu", "mn", "pq")
Output: 2


One of the things I used to tell project teams was: if the requirements aren't clear, ask the client and don’t just guess.

However, rather than bothering Mohammad I am guessing that case is irrelevant, so that ('Cat', 'Tac') contains one pair, and that any word can only be part of a single pair, so that ('cat', 'cat', 'tac') contains one pair, not two.

A useful, but little used by me at least, Perl keyword is reverse. It will reverse the order of the letters in a string provided you force scalar context, for example by assiging the result to a scalar. So with that established, I do two nested loops over @words. In the outer loop I reverse the word and then do an inner loop over all the subsequent words, looking for a match. If I find one, I make a note of it. I also set the inner loop member of @words to a zero-length string, and jump to the next word in the outer loop to avoid the words being used again, eg in a sequence like ('cat', 'cat', 'tac').

You’ll see in my code that I tried it on a list of 2429 unique words, and that runs on my slowish computer in under 2 seconds. And I now also check that all text-based challenges work with non-ASCII characters.

Try it 

Try running the script with any input:

example: dog, cat, hen, neh, tac, cow



# Blog:

use v5.26;    # The Weekly Challenge - 2024-02-12
use utf8;     # Week 256 - task 1 - Maximum pairs
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use List::Uniq 'uniq';

my (@words, $file);

maximum_pairs('ab', 'de', 'ed', 'bc', 'ed');
maximum_pairs('rotagilla', 'cat', 'dog', 'mouse', 'hen', 'tac', 'alligator', 'esuom');
maximum_pairs('cat', 'cat', 'tac', 'mouse', 'ESUOM');
maximum_pairs('Kätze', 'fünf', 'café', 'crème', 'éfac', 'fnüf');

# lots of words
open $file, '<:utf8', '../data/lots_of_words.txt';
push @words, $_ while <$file>;
close $file;
chop @words;

sub maximum_pairs {
    my (@words, $i, $j, $pairs, $explain, $wi);
    # initialise
    push @words, lc($_) for @_; 
    say @words < 40 ? (qq[\nInput:  \@words = ('] . join(q[', '], @words) . q[')])
        : (qq[\nInput: ] . (scalar @words) . qq[ words]);
    # loop over word pairs
    ILOOP: for $i (0 .. scalar @words - 2) {
        $wi = reverse $words[$i];
        for $j ($i + 1 .. scalar @words - 1) {
            # found a pair?
            if ($words[$j] and $wi eq $words[$j]) {
                $pairs ++;
                $explain .= qq['$words[$i]' and '$words[$j]', ];
                $words[$j] = '';
                next ILOOP;
    # report result
    say $pairs ? qq[Output: $pairs\n        ] . substr($explain, 0, -2) :
        say qq[Output: none];


Input:  @words = ('ab', 'de', 'ed', 'bc', 'ed')
Output: 1
        'de' and 'ed'

Input:  @words = ('rotagilla', 'cat', 'dog', 'mouse', 'hen', 'tac', 'alligator', 'esuom')
Output: 3
        'rotagilla' and 'alligator', 'cat' and 'tac', 'mouse' and 'esuom'

Input:  @words = ('cat', 'cat', 'tac', 'mouse', 'esuom')
Output: 2
        'cat' and 'tac', 'mouse' and 'esuom'

Input:  @words = ('kätze', 'fünf', 'café', 'crème', 'éfac', 'fnüf')
Output: 2
        'fünf' and 'fnüf', 'café' and 'éfac'

Input: 2429 words
Output: 6
        'tap' and 'pat', 'part' and 'trap', 'room' and 'moor', 'step' and 'pets', 'top' and 'pot', 'drawer' and 'reward'

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