extra/rosetta-code/anagrams-deranged/anagrams-deranged.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: assocs http.client io.encodings.utf8 io.files
   4 io.files.temp kernel math math.combinatorics sequences sorting
   5 strings urls ;
   6
   7 IN: rosettacode.anagrams-deranged
   8
   9 ! https://rosettacode.org/wiki/Anagrams/Deranged_anagrams
  10
  11 ! Two or more words are said to be anagrams if they have the
  12 ! same characters, but in a different order. By analogy with
  13 ! derangements we define a deranged anagram as two words with the
  14 ! same characters, but in which the same character does not appear
  15 ! in the same position in both words.
  16
  17 ! The task is to use the word list at
  18 ! https://www.puzzlers.org/pub/wordlists/unixdict.txt to find and
  19 ! show the longest deranged anagram.
  20
  21 : derangement? ( str1 str2 -- ? ) [ = not ] 2all? ;
  22
  23 : derangements ( seq -- seq )
  24     2 [ first2 derangement? ] filter-combinations ;
  25
  26 : parse-dict-file ( path -- hash )
  27     utf8 file-lines
  28     H{ } clone [
  29         '[
  30             [ natural-sort >string ] keep
  31             _ [ swap suffix  ] with change-at
  32         ] each
  33     ] keep ;
  34
  35 : anagrams ( hash -- seq )
  36     [ nip length 1 > ] assoc-filter values ;
  37
  38 : deranged-anagrams ( path -- seq )
  39     parse-dict-file anagrams [ derangements ] map concat ;
  40
  41 : (longest-deranged-anagrams) ( path -- anagrams )
  42     deranged-anagrams [ first length ] sort-with last ;
  43
  44 : default-word-list ( -- path )
  45     URL" https://puzzlers.org/pub/wordlists/unixdict.txt"
  46     "unixdict.txt" temp-file [ ?download-to ] keep ;
  47
  48 : longest-deranged-anagrams ( -- anagrams )
  49     default-word-list (longest-deranged-anagrams) ;