The Bear's Den

Enter at your own risk

16 October 2026 Challenge 395

Complex Squares

Task 1: Complex Number

Submitted by: Mohammad Sajid Anwar

You are given two complex numbers as string.

Write a script to return the multiplication of the given complex numbers.

Using the formula: (a + bi) x (c + di) = (ac - bd) + (ad + bc)i

Example 1

Input: $num1 = "1+1i", $num2 = "1+1i"
Output: "0+2i"

Example 2

Input: $num1 = "1+(-1)i", $num2 = "1+(-1)i"
Output: "0+(-2)i"

Example 3

Input: $num1 = "0+3i", $num2 = "0+4i"
Output: "-12+0i"

Example 4

Input: $num1 = "3+4i", $num2 = "3+(-4)i"
Output: "25+0i"

Example 5

Input: $num1 = "50+(-20)i", $num2 = "-10+30i"
Output: "100+1700i"

Solution

The format of the complex numbers from the examples is kind of special:

I’ll be using the format as specified in the examples (with one extension):

Use Regexp::Common to match real numbers and let Math::Complex do the multiplication.

use strict;
use warnings;
use experimental 'signatures';
use Math::Complex;
use Regexp::Common;

sub complex_product (@num) {
    my $real = $RE{num}{real};
    my $num = qr{
        ^
        (?!\+)(-?$real)
        \+
        (?|
            (?![-+])($real)
            |
            \((?=-)($real)\)
        )
        i$
    }x;

    my ($c1, $c2) = map {
            my @n = /$num/;
            die "number invalid: $_" unless @n;
            cplx @n;
        } @num;
    my $prod = $c1 * $c2;

    sprintf '%s+%.*5$s%s%.*5$si', Re($prod), '(', Im($prod), ')',
        Im($prod) < 0;
}

A different way to specify the values from example 5:

$ perl/ch-1.pl -- '5.0e1+(-2.0e1)i' '-1.0e1+3.0e1i'
100+1700i

See the full solution to task 1.

Task 2: Word Squares

Submitted by: Mohammad Sajid Anwar

You are given a list of equal lengths words.

Write a script to arrange a set of words into a grid that reading across any row gives the exact same word as reading down its corresponding column.

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

Solution

We define an initially empty list of words that form the head of the square words.

A word may be appended to a head of size n, if it starts with the characters at the n-th position from each word from the head.

When the head has reached a size of one less than the words’ length, a matching word completes the square.

These steps may be used to implement a recursive solution.

Perl

use strict;
use warnings;
use experimental 'signatures';

sub word_square ($words, $head=[]) {
    my $prefix = '';
    $prefix .= substr($_, scalar @$head, 1) for @$head;
    for my $word (@$words) {
        next unless index($word, $prefix) == 0;
        return ($word) if length($word) == @$head + 1;
        my @tail = __SUB__->($words, [@$head, $word]);
        return ($word, @tail) if @tail;
    }
    ();
}

See the full solution to task 2.

J

The Perl solution can easily be ported to J as an explicitly defined verb using control words for., if., return. etc. But building an (almost) tacit verb to solve the task is more fun.

The verb “terminate fold” Z: is required to prematurely terminate a “fold” loop, but it can only be invoked within the body of a verb that is an operand to a “fold” conjunction. As tacit verbs don’t have a body, the post-processing verb term has to be defined explicitly.

word_square =: _(adverb define)

  NB. create prefix from head:
  NB. n-th character from each word in the head
  prefix =. #@] { [: |: ]

  NB. select words starting with the prefix
  start_with =. [ #~ {.@E."1~

  NB. create new candidate heads:
  NB. append each candidate word to the current head
  combine =. ,"_ 1

  NB. check if y is not empty
  has_items =. *@#@]

  NB. check if solution is complete:
  NB. there is a head candidate and
  NB. its number of words equals the word length
  is_complete =. (*@{. *. =/@}.)@$@]

  NB. provide the (first) full solution
  final =. {.@]

  NB. call self recursively,
  NB. box the result and return it on success or
  NB. pass the word array otherwise
  recur =. ] [`(<@])@.has_items $:

  NB. post-process loop results:
  NB. terminate and return unboxed result on success
  NB. otherwise return empty
  term =. {{
    is_boxed =. * L. y
    1 Z: is_boxed
    (''"_)`>@.is_boxed y
  }}

  NB. loop over all head candidates
  loop =. term F.. (recur f.)

  NB. empty 2-d array
  empty =. 0 1 $ ''

  NB. as a monad:
  NB. - provide an empty head and call the dyad
  NB. as a dyad:
  NB. - create the prefix from the head
  NB. - find candidate words starting with the with the prefix
  NB. - create a new head from each candidate by appending it to the old head
  NB. - check if the candidate head(s) form a complete solution:
  NB.   * return the first candidate head if it is complete
  NB.   * loop over all candidate heads, using each as an argument for
  NB.     a recursive call
  empty&$: : (([ (loop f.)`final@.is_complete ] combine [ start_with prefix)~ f.)
)

An extra example:

   word_square > ;: 'NOLAN CAINE TENET OPERA AREPO SATOR ROTAS'
SATOR
AREPO
TENET
OPERA
ROTAS

See the full solution.