06 November 2026

Challenge 005

A Serpent As A Present

• Task 1: All anagrams for a word
• Task 2: Sequence with most anagrams

Task 1: All anagrams for a word

Write a program which prints out all anagrams for a given word. For more information about Anagram, please check this wikipedia page.

---

Solution

Build a criterion for an anagram of the given word and apply it to the words of a dictionary.

Perl

Create a regular expression that:

• for each letter of the given word:
  • matches a word having exactly as many occurrences of that letter
• has the same length as the given word

Apply this to the dictionary with all words converted to lower case and all duplicates removed.

use strict;
use warnings;
use autodie;
use experimental 'signatures';
use List:MoreUtils 'frequency';
use List::Util 'uniqstr';

sub anagrams ($word, $dict) {
    my %freq = frequency split //, $word;
    my $re = '';
    $re .= "(?=(?:[^$_]*+[$_]){$freq{$_}}[^$_]*+\$)" for keys %freq;
    my $full = ".{" . length($word) . "}";
    open my $words, '<', $dict;
    my @anagrams;
    while (<$words>) {
        chomp;
        push @anagrams, lc if /^$re$full$/i;
    }
    close $words;
    uniqstr @anagrams;
}

See the full solution to task 1.

J

Compare the sorted letters of the given word in y to the sorted letters of each word from the dictionary in x, reduced to lowercase unique words.

Another difference to the Perl implementation: the dictionary is expected as a list of boxed strings.

anagrams =: _(adverb define)
  uniq_lower =. ~. @ (tolower L:0)
  sort_letters =. /:~&.>

  [: : (<@[ (=&sort_letters # ]) uniq_lower@])~ f.
)

See the full solution.

Task 2: Sequence with most anagrams

Write a program to find the sequence of characters that has the most anagrams. Last week Gabor Szabo suggested I should add another optional challenge every week asking members to provide Perl implementation to a given API. You don’t have to create a module, since it is an API. I am working out on the format currently. If you have any suggestions in this regard then please do share with us.

---

Solution

Reduce the dictionary to unique lowercase word, sort the letters of each word, find the frequencies of these and pick the letters for the most frequent result.

Perl

use strict;
use warnings;
use autodie;
use experimental 'signatures';
use List::Util 'uniqstr';
use List::MoreUtils 'frequency';
use List::UtilsBy 'max_by';

sub most_anagrams ($dict) {
    open my $words, '<', $dict;
    my @all = <$words>;
    close $words;
    chomp @all;
    my @words = map join('', sort split //), uniqstr map lc, @all;
    my %words = frequency @words;
    max_by {$words{$_}} keys %words;
}

See the full solution to task 2.

J

Again, expecting the dictionary as a list of boxed words.

max_anagrams =: _(adverb define)
  uniq_lower =. ~. @ (tolower L:0)
  sort_letters =. /:~ L:0
  frequency =. ({. ; #)/.~
  max_by =. [ #~ ] = >./@]
  (max_by&:>/ @ |: @ frequency @ sort_letters @ uniq_lower) f. : [:
)

See the full solution.