1 ! Copyright (c) 2023 John Benediktsson.
2 ! See https://factorcode.org/license.txt for BSD license.
4 USING: anagrams assocs combinators.short-circuit http.client
5 io.encodings.utf8 io.files io.files.temp kernel math
6 math.combinatorics math.functions math.order math.parser
7 project-euler.common ranges sequences splitting ;
11 ! https://projecteuler.net/problem=98
16 ! By replacing each of the letters in the word CARE with 1, 2, 9,
17 ! and 6 respectively, we form a square number: 1296 = 36^2. What
18 ! is remarkable is that, by using the same digital substitutions,
19 ! the anagram, RACE, also forms a square number: 9216 = 96^2. We
20 ! shall call CARE (and RACE) a square anagram word pair and
21 ! specify further that leading zeroes are not permitted, neither
22 ! may a different letter have the same digital value as another
25 ! Using words.txt (right click and 'Save Link/Target As...'), a
26 ! 16K text file containing nearly two-thousand common English
27 ! words, find all the square anagram word pairs (a palindromic
28 ! word is NOT considered to be an anagram of itself).
30 ! What is the largest square number formed by any member of such
33 ! NOTE: All anagrams formed must be contained in the given text
39 : make-anagrams ( seq -- assoc )
40 make-anagram-hash values [ 2 all-combinations ] map concat
41 [ first length ] collect-by ;
44 "https://projecteuler.net/project/resources/p098_words.txt"
45 "p098_words.txt" temp-file [ ?download-to ] keep
46 utf8 file-contents "," split [ rest-slice but-last ] map ;
48 : squarelist ( n -- seq )
49 1 + 10^ sqrt [1..b] [ sq number>string ] map ;
51 :: square-anagram ( word1 word2 num1 num2 -- n/f )
53 [ num1 num2 word2 zip substitute word1 = ]
54 [ num2 num1 word1 zip substitute word2 = ]
55 [ word1 word2 num2 zip substitute num1 = ]
56 [ word2 word1 num1 zip substitute num2 = ]
57 } 0&& [ num1 num2 [ string>number ] bi@ max ] [ f ] if ;
59 :: euler098 ( -- answer )
60 wordlist make-anagrams :> words
61 words keys maximum :> n
62 n squarelist make-anagrams :> squares
69 [ first2 ] bi@ square-anagram [ max ] when*