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.

Examples

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

Analysis

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 

Script

#!/usr/bin/perl

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

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;
maximum_pairs(uniq(@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];
}

Output

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'