factor: trim using lists

[factor.git] / extra / spelling / spelling.factor

diff --git a/extra/spelling/spelling.factor b/extra/spelling/spelling.factor
index b8a90bd2dae94fadad191f39dda0af47a9ae4af9..66b0a38fddf2cd9cc95044d4b83afb68e88b7799 100644 (file)
--- a/extra/spelling/spelling.factor
+++ b/extra/spelling/spelling.factor
@@ -1,46 +1,36 @@
-USING: arrays ascii assocs combinators combinators.smart fry
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+USING: arrays ascii assocs combinators combinators.smart
 http.client io.encodings.ascii io.files io.files.temp kernel
-locals math math.statistics memoize sequences sorting splitting
-strings urls ;
+math math.statistics ranges sequences sequences.private sorting
+splitting urls ;
 IN: spelling
 
 ! http://norvig.com/spell-correct.html
 
 CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
 
-: splits ( word -- sequence )
-    dup length iota [ cut 2array ] with map ;
-
-: deletes ( sequence -- sequence' )
-    [ second length 0 > ] filter [ first2 rest append ] map ;
-
-: transposes ( sequence -- sequence' )
-    [ second length 1 > ] filter [
-        [
-            {
-                [ first ]
-                [ second second 1string ]
-                [ second first 1string ]
-                [ second 2 tail ]
-            } cleave
-        ] "" append-outputs-as
-    ] map ;
-
-: replaces ( sequence -- sequence' )
-    [ second length 0 > ] filter [
-        [ ALPHABET ] dip first2
-        '[ 1string _ _ rest surround ] { } map-as
-    ] map concat ;
-
-: inserts ( sequence -- sequence' )
-    [
-        ALPHABET
-        [ [ first2 ] dip 1string glue ] with { } map-as
-    ] map concat ;
+: deletes ( word -- edits )
+    [ length <iota> ] keep '[ _ remove-nth ] map ;
+
+: transposes ( word -- edits )
+    [ length [1..b) ] keep
+    '[ dup 1 - _ clone [ exchange-unsafe ] keep ] map ;
+
+: replace1 ( i word -- words )
+    [ ALPHABET ] 2dip bounds-check
+    '[ _ _ clone [ set-nth-unsafe ] keep ] { } map-as ;
+
+: replaces ( word -- edits )
+    [ length <iota> ] keep '[ _ replace1 ] map concat ;
+
+: inserts ( word -- edits )
+    [ length [0..b] ] keep
+    '[ CHAR: ? over _ insert-nth replace1 ] map concat ;
 
 : edits1 ( word -- edits )
     [
-        splits {
+        {
             [ deletes ]
             [ transposes ]
             [ replaces ]
@@ -51,14 +41,14 @@ CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
 : edits2 ( word -- edits )
     edits1 [ edits1 ] map concat ;
 
-: filter-known ( words dictionary -- words' )
+: filter-known ( edits dictionary -- words )
     '[ _ key? ] filter ;
 
 :: corrections ( word dictionary -- words )
     word 1array dictionary filter-known
     [ word edits1 dictionary filter-known ] when-empty
     [ word edits2 dictionary filter-known ] when-empty
-    [ dictionary at 1 or ] sort-with ;
+    [ dictionary at ] sort-with reverse! ;
 
 : words ( string -- words )
     >lower [ letter? not ] split-when harvest ;
@@ -67,12 +57,11 @@ CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
     ascii file-contents words histogram ;
 
 MEMO: default-dictionary ( -- counts )
-    "big.txt" temp-file dup exists?
-    [ URL" http://norvig.com/big.txt" over download-to ] unless
-    load-dictionary ;
+    URL" http://norvig.com/big.txt" "big.txt" temp-file
+    [ ?download-to ] [ load-dictionary ] bi ;
 
 : (correct) ( word dictionary -- word/f )
-    corrections [ f ] [ first ] if-empty ;
+    corrections ?first ;
 
 : correct ( word -- word/f )
     default-dictionary (correct) ;