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.raku

Multiples of 3 and 5

prob001-eric256.raku

Multiples of 3 and 5

prob001-grondilu.raku

Multiples of 3 and 5

prob001-hexmode.raku

Multiples of 3 and 5

prob001-unobe.raku

Multiples of 3 and 5

prob002-eric256.raku

Even Fibonacci numbers

prob002-gerdr.raku

Even Fibonacci numbers

prob002-hexmode.raku

Even Fibonacci numbers

prob003-eric256.raku

Largest prime factor

prob003-gerdr.raku

Largest prime factor

prob003-hexmode.raku

Largest prime factor

prob003-lanny.raku

Largest prime factor

prob004-unobe.raku

Largest palindrome product

prob004-xfix.raku

Largest palindrome product

prob005-unobe.raku

Smallest multiple

prob005-xfix.raku

Smallest multiple

prob006-polettix.raku

Sum square difference

prob007-polettix.raku

10001st prime

prob008-duff.raku

Largest product in a series

prob008-duff2.raku

Largest product in a series

prob009-gerdr-feeds.raku

Special Pythagorean triplet

prob009-gerdr.raku

Special Pythagorean triplet

prob009-polettix.raku

Special Pythagorean triplet

prob010-polettix.raku

Summation of primes

prob011-moritz.raku

Largest product in a grid

prob012-polettix.raku

Highly divisible triangular number

prob013-grondilu.raku

Large sum

prob014-felher.raku

Longest Collatz sequence

prob015-felher.raku

Lattice paths

prob016-grondilu.raku

Power digit sum

prob017-duff.raku

Number letter counts

prob018-felher.raku

Maximum path sum I

prob019-grondilu.raku

Counting Sundays

prob020-grondilu.raku

Factorial digit sum

prob021-gerdr.raku

Amicable numbers

prob022-grondilu.raku

Names scores

prob023-shlomif.raku

Non-abundant sums

prob024-moritz.raku

Lexicographic permutations

prob025-polettix.raku

1000-digit Fibonacci number

prob026-shlomif.raku

Reciprocal cycles

prob027-shlomif.raku

Quadratic primes

prob028-shlomif.raku

Number spiral diagonals

prob029-gerdr.raku

Distinct powers

prob029-polettix.raku

Distinct powers

prob031-shlomif.raku

Coin sums

prob033-andreoss.raku

Digit cancelling fractions

prob034-quinny.raku

Digit factorials

prob036-xenu.raku

Double-base palindromes

prob038-andreoss.raku

Pandigital multiples

prob039-quinny.raku

Integer right triangles

prob041-heyajulia-alternative.raku

Pandigital Prime

prob041-heyajulia.raku

Pandigital Prime

prob042-shlomif.raku

Coded triangle numbers

prob047-gerdr.raku

Distinct primes factors

prob052-duff.raku

Permuted multiples

prob053-duff.raku

Combinatoric selections

prob053-gerdr.raku

Combinatoric selections

prob054-andreoss.raku

Poker hands

prob055-shlomif.raku

Lychrel numbers

prob056-shlomif.raku

prob059-andreoss.raku

XOR decryption

prob063-moritz.raku

Powerful digit counts

prob063-polettix.raku

Powerful digit counts

prob065-andreoss.raku

Convergents of e

prob065-grondilu.raku

prob066-andreoss.raku

Diophantine equation

prob067-felher.raku

Maximum path sum II

prob080-andreoss.raku

Square root digital expansion

prob081-moritz.raku

Path sum: two ways

prob089-andreoss.raku

Roman numerals

prob092-moritz.raku

Square digit chains

prob097-andreoss.raku

Large non-Mersenne prime

prob099-andreoss.raku

Largest exponential

README.md

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

Built with Podlite — the markup and publishing tools behind this site.