Word squares

You are given a list of equal-length words.

Write a script to arrange them in a grid such that reading across any row gives the same word as reading down its corresponding column.

Examples

Example 1
Input: @words = ('MA', 'AM', 'MY', 'ME')
Output: ('MA', 'AM')
    M A
    A M

Example 2
Input: @words = ('SUN', 'USE', 'NET', 'SEE', 'TEN')
Output: ('SUN', 'USE', 'NET')
    S U N
    U S E
    N E T

Example 3
Input: @words = ('BOAT', 'TEAL', 'AREA', 'TSAR', 'OGRE')
Output: ('BOAT', 'OGRE', 'AREA', 'TEAL')
    B O A T
    O G R E
    A R E A
    T E A L

Example 4
Input: @words = ('CARD', 'AREA', 'REAR', 'DART')
Output: ('CARD', 'AREA', 'REAR', 'DART')
    C A R D
    A R E A
    R E A R
    D A R T

Example 5
Input: @words = ('HEART', 'TREND', 'EMBER', 'RESIN', 'ABUSE')
Output: ('HEART', 'EMBER', 'ABUSE', 'RESIN', 'TREND')
    H E A R T
    E M B E R
    A B U S E
    R E S I N
    T R E N D

Analysis

This has the air of a problem that has been around a while and indeed Wikipedia has an article documenting its history - which I didn't read before devising my own solution.

My first thought was to use an iterative approach to test and eliminate the possibilities, but in fact that isn't necessary and three nested loops suffice. The largest known square is 10 x 10, and my inmost loop quickly drops out for most failing attempts, so that shouldn't be unbearably slow.

The essence of my solution is the observation that a correct square is symmetrical with respect to the x == y diagonal, or in other words, cell(x, y) contains the same letter as cell(y, x).

The width of the square must be equal to the number of letters in each word, all of which must be the same length, and the number of words cannot be less than that length. So I use my old friend Algorithm::Combinatorics to generate all the qualifying subsets of the words, test them for diagonal symmetry and report the first set which passes that test.

And my solution manages the 10-letter example in under 10 seconds on my slowish computer, which confirms my choice of the easy solution.

Try it 

Your input:

#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2026-10-12
use utf8;     # Week 395 - task 2 - Word squares
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Algorithm::Combinatorics 'variations';
use Encode;

word_squares('SEE', 'TEN', 'SUN', 'NET', 'USE');
word_squares('BOAT', 'TEAL', 'AREA', 'TSAR', 'OGRE');
word_squares('CARD', 'AREA', 'REAR', 'DART');
word_squares('HEART', 'TREND', 'EMBER', 'RESIN', 'ABUSE');
word_squares('BLUE', 'GLUE', 'GLUT', 'BLUT', 'BLUZ');
word_squares('SERINETTE','ACHALASIA','ANABOLITE','ADDLEHEAD',
    'CRENIDENS','ASCENDERS', 'INITIATOR','LINOLENIN','HEXANDRIC');
word_squares('HALOBORATE','ANEITENSIS','CERRATEANA','PROCOLICIN',
    'SCAPHARCAE','RETIREMENT','ATELOMERES','EARNESTEST',
    'ARGOLETIER', 'CAICARENSE');

sub word_squares {
    
    my (@words, $n, $iter, $x, $y, $this);
    
    # initialise
    @words = @_;
    say qq[\nInput:  '] . join(q[', '], @words) . q['];
    $n = length($words[0]);
    $iter = variations(\@words, $n);
    
    # iterate over each possible subset of n n-letter words
    ITER: while ($this = $iter->next) {

        # see if they are symmetric about the x = y diagonal
        for $x (0 .. $n - 1) {
            for $y ($x + 1 .. $n - 1) {
                next ITER unless substr($this->[$x], $y, 1)
                              eq substr($this->[$y], $x, 1);
            }
        }
        
        # found a square!
        say qq[Output:];
        say join(qq[\n], '   ' . join(' ', split(//, $this->[$_]))) 
            for 0 .. $n - 1;
        return;
    }
    
    # no square found
    say qq[Output: cannot make a square];
}

16 lines of code

Output from script

Input:  'SEE', 'TEN', 'SUN', 'NET', 'USE'
Output:
   S U N
   U S E
   N E T

Input:  'BOAT', 'TEAL', 'AREA', 'TSAR', 'OGRE'
Output:
   B O A T
   O G R E
   A R E A
   T E A L

Input:  'CARD', 'AREA', 'REAR', 'DART'
Output:
   C A R D
   A R E A
   R E A R
   D A R T

Input:  'HEART', 'TREND', 'EMBER', 'RESIN', 'ABUSE'
Output:
   H E A R T
   E M B E R
   A B U S E
   R E S I N
   T R E N D

Input:  'BLUE', 'GLUE', 'GLUT', 'BLUT', 'BLUZ'
Output: cannot make a square

Input:  'SERINETTE', 'ACHALASIA', 'ANABOLITE', 'ADDLEHEAD',
   'CRENIDENS', 'ASCENDERS', 'INITIATOR', 'LINOLENIN', 'HEXANDRIC'
Output:
   A C H A L A S I A
   C R E N I D E N S
   H E X A N D R I C
   A N A B O L I T E
   L I N O L E N I N
   A D D L E H E A D
   S E R I N E T T E
   I N I T I A T O R
   A S C E N D E R S

Input:  'HALOBORATE', 'ANEITENSIS', 'CERRATEANA', 'PROCOLICIN',
   'SCAPHARCAE', 'RETIREMENT', 'ATELOMERES', 'EARNESTEST',
   'ARGOLETIER', 'CAICARENSE'
Output:
   S C A P H A R C A E
   C E R R A T E A N A
   A R G O L E T I E R
   P R O C O L I C I N
   H A L O B O R A T E
   A T E L O M E R E S
   R E T I R E M E N T
   C A I C A R E N S E
   A N E I T E N S I S
   E A R N E S T E S T