extra/project-euler/098/098.factor

   1 ! Copyright (c) 2023 John Benediktsson.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3
   4 USING: anagrams assocs combinators.short-circuit http.download
   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 ;
   8
   9 IN: project-euler.098
  10
  11 ! https://projecteuler.net/problem=98
  12
  13 ! DESCRIPTION
  14 ! -----------
  15
  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
  23 ! letter.
  24
  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).
  29
  30 ! What is the largest square number formed by any member of such
  31 ! a pair?
  32
  33 ! NOTE: All anagrams formed must be contained in the given text
  34 ! file.
  35
  36 ! SOLUTION
  37 ! --------
  38
  39 : make-anagrams ( seq -- assoc )
  40     make-anagram-hash values [ 2 all-combinations ] map concat
  41     [ first length ] collect-by ;
  42
  43 : wordlist ( -- seq )
  44     "https://projecteuler.net/project/resources/p098_words.txt"
  45     "p098_words.txt" temp-file download-once-to
  46     utf8 file-contents "," split [ rest-slice but-last ] map ;
  47
  48 : squarelist ( n -- seq )
  49     1 + 10^ sqrt [1..b] [ sq number>string ] map ;
  50
  51 :: square-anagram ( word1 word2 num1 num2 -- n/f )
  52     {
  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 ;
  58
  59 :: euler098 ( -- answer )
  60     wordlist make-anagrams :> words
  61     words keys maximum :> n
  62     n squarelist make-anagrams :> squares
  63
  64     0 n [1..b] [| i |
  65         words i of :> w
  66         squares i of :> s
  67         w s and [
  68             w s [
  69                 [ first2 ] bi@ square-anagram [ max ] when*
  70             ] cartesian-each
  71         ] when
  72     ] each ;
  73
  74 SOLUTION: euler098