extra/spelling/spelling.factor

   1 USING: arrays ascii assocs combinators combinators.smart fry
   2 http.client io.encodings.ascii io.files io.files.temp kernel
   3 literals locals math math.ranges math.statistics memoize
   4 sequences sequences.private sets sorting splitting strings urls ;
   5 IN: spelling
   6
   7 ! http://norvig.com/spell-correct.html
   8
   9 CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
  10
  11 : deletes ( word -- edits )
  12     [ length <iota> ] keep '[ _ remove-nth ] map ;
  13
  14 : transposes ( word -- edits )
  15     [ length [1,b) ] keep '[
  16         dup 1 - _ clone [ exchange-unsafe ] keep
  17     ] map ;
  18
  19 : replaces ( word -- edits )
  20     [ length <iota> ] keep '[
  21         ALPHABET [
  22             swap _ clone [ set-nth-unsafe ] keep
  23         ] with { } map-as
  24     ] map concat ;
  25
  26 : inserts ( word -- edits )
  27     [ length [0,b] ] keep '[
  28         CHAR: ? over _ insert-nth ALPHABET swap [
  29             swapd clone [ set-nth-unsafe ] keep
  30         ] curry with { } map-as
  31     ] map concat ;
  32
  33 : edits1 ( word -- edits )
  34     [
  35         {
  36             [ deletes ]
  37             [ transposes ]
  38             [ replaces ]
  39             [ inserts ]
  40         } cleave
  41     ] append-outputs ;
  42
  43 : edits2 ( word -- edits )
  44     edits1 [ edits1 ] map concat ;
  45
  46 : filter-known ( edits dictionary -- words )
  47     '[ _ key? ] filter ;
  48
  49 :: corrections ( word dictionary -- words )
  50     word 1array dictionary filter-known
  51     [ word edits1 dictionary filter-known ] when-empty
  52     [ word edits2 dictionary filter-known ] when-empty
  53     [ dictionary at ] sort-with reverse! ;
  54
  55 : words ( string -- words )
  56     >lower [ letter? not ] split-when harvest ;
  57
  58 : load-dictionary ( file -- assoc )
  59     ascii file-contents words histogram ;
  60
  61 MEMO: default-dictionary ( -- counts )
  62     URL" http://norvig.com/big.txt" "big.txt" temp-file
  63     [ ?download-to ] [ load-dictionary ] bi ;
  64
  65 : (correct) ( word dictionary -- word/f )
  66     corrections ?first ;
  67
  68 : correct ( word -- word/f )
  69     default-dictionary (correct) ;