Anagramic squares

AUTHOR

Andrei Osipov

https://projecteuler.net/problem=98

By replacing each of the letters in the word CARE with 1, 2, 9, and 6 respectively, we form a square number: 1296 = 36². What is remarkable is that, by using the same digital substitutions, the anagram, RACE, also forms a square number: 9216 = 96². We shall call CARE (and RACE) a square anagram word pair and specify further that leading zeroes are not permitted, neither may a different letter have the same digital value as another letter.

Using words.txt https://projecteuler.net/project/resources/p098_words.txt, a 16K text file containing nearly two-thousand common English words, find all the square anagram word pairs (a palindromic word is NOT considered to be an anagram of itself).

What is the largest square number formed by any member of such a pair?

NOTE: All anagrams formed must be contained in the given text file.

use v6;



sub correspond([$word1, $word2], [$num1, $num2]) {
    $word2.trans($word1 => ~$num1) eq $num2   &&
    $num2.trans( ~$num1 => $word1) eq $word2;

}

sub anagrams(@x) {
    my %aux;
    my %result;

    %aux{$_.comb.sort.join}.push: $_
        for @x;

    for %aux.kv -> $k, @v {
        next if +@v < 2; ;
        %result{@v[0].chars}.push:
                +@v == 2
                  ?? @v.item
                  !! |@v.combinations(2).map(*.item);
    }

    %result;
}


sub MAIN(Bool :$verbose = False,
         Str  :$file    = $*SPEC.catdir($*PROGRAM-NAME.IO.dirname, 'words.txt')) {

    die "$file is missing" unless $file.IO.e;

    my @words = sort unique $file.IO.slurp.split: / <[,"]>+ /;

    my %words   =  anagrams(@words);
    my $longest-word = %words.keys.max;

    my %squares =  anagrams(
        (1 ... (10**($longest-word + 1).sqrt)) »**» 2
    );

    say max do for 3 ... $longest-word -> \size {
        next unless %words{size};
        |do for @(%words{size}) -> @pair {
            next unless %squares{size};
            |do for @(%squares{size}) -> @nums {
                if correspond(@pair, @nums) {
                    $verbose and say "@pair[] => @nums[]" ;
                    max @nums;
                }
            }
        }
    }
}

# vim: expandtab shiftwidth=4 ft=perl6

See Also

prob001-cspencer.pl

Multiples of 3 and 5

prob001-eric256.pl

Multiples of 3 and 5

prob001-grondilu.pl

Multiples of 3 and 5

prob001-hexmode.pl

Multiples of 3 and 5

prob001-unobe.pl

Multiples of 3 and 5

prob002-eric256.pl

Even Fibonacci numbers

prob002-gerdr.pl

Even Fibonacci numbers

prob002-hexmode.pl

Even Fibonacci numbers

prob003-eric256.pl

Largest prime factor

prob003-gerdr.pl

Largest prime factor

prob003-hexmode.pl

Largest prime factor

prob003-lanny.pl

Largest prime factor

prob004-unobe.pl

Largest palindrome product

prob004-xfix.pl

Largest palindrome product

prob005-unobe.pl

Smallest multiple

prob005-xfix.pl

Smallest multiple

prob006-polettix.pl

Sum square difference

prob007-polettix.pl

10001st prime

prob008-duff.pl

Largest product in a series

prob008-duff2.pl

Largest product in a series

prob009-gerdr-feeds.raku

Special Pythagorean triplet

prob009-gerdr.raku

Special Pythagorean triplet

prob009-polettix.pl

Special Pythagorean triplet

prob010-polettix.pl

Summation of primes

prob011-moritz.pl

Largest product in a grid

prob012-polettix.pl

Highly divisible triangular number

prob013-grondilu.pl

Large sum

prob014-felher.pl

Longest Collatz sequence

prob015-felher.pl

Lattice paths

prob016-grondilu.pl

Power digit sum

prob017-duff.pl

Number letter counts

prob018-felher.pl

Maximum path sum I

prob019-grondilu.pl

Counting Sundays

prob020-grondilu.pl

Factorial digit sum

prob021-gerdr.pl

Amicable numbers

prob022-grondilu.pl

Names scores

prob023-shlomif.pl

Non-abundant sums

prob024-moritz.pl

Lexicographic permutations

prob025-polettix.pl

1000-digit Fibonacci number

prob026-shlomif.pl

Reciprocal cycles

prob027-shlomif.pl

Quadratic primes

prob028-shlomif.pl

Number spiral diagonals

prob029-gerdr.pl

Distinct powers

prob029-polettix.pl

Distinct powers

prob031-shlomif.pl

Coin sums

prob033-andreoss.pl

Digit cancelling fractions

prob034-quinny.pl

Digit factorials

prob036-xenu.pl

Double-base palindromes

prob038-andreoss.pl

Pandigital multiples

prob039-quinny.pl

Integer right triangles

prob041-heyajulia-alternative.raku

Pandigital Prime

prob041-heyajulia.raku

Pandigital Prime

prob042-shlomif.p6

Coded triangle numbers

prob047-gerdr.pl

Distinct primes factors

prob052-duff.pl

Permuted multiples

prob053-duff.pl

Combinatoric selections

prob053-gerdr.pl

Combinatoric selections

prob054-andreoss.pl

Poker hands

prob055-shlomif.p6

Lychrel numbers

prob056-shlomif.p6

prob059-andreoss.pl

XOR decryption

prob063-moritz.pl

Powerful digit counts

prob063-polettix.pl

Powerful digit counts

prob065-andreoss.pl

Convergents of e

prob065-grondilu.pl

prob066-andreoss.pl

Diophantine equation

prob067-felher.pl

Maximum path sum II

prob080-andreoss.pl

Square root digital expansion

prob081-moritz.pl

Path sum: two ways

prob089-andreoss.pl

Roman numerals

prob092-moritz.pl

Square digit chains

prob097-andreoss.pl

Large non-Mersenne prime

prob099-andreoss.pl

Largest exponential

README.md

The Camelia image is copyright 2009 by Larry Wall. "Raku" is trademark of the Yet Another Society. All rights reserved.