-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 ]
: 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 ;
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) ;