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 ;
7 ! http://norvig.com/spell-correct.html
9 CONSTANT: ALPHABET "abcdefghijklmnopqrstuvwxyz"
11 : deletes ( word -- edits )
12 [ length iota ] keep '[ _ remove-nth ] map ;
14 : transposes ( word -- edits )
15 [ length [1,b) ] keep '[
16 dup 1 - _ clone [ exchange-unsafe ] keep
19 : replaces ( word -- edits )
20 [ length iota ] keep '[
22 swap _ clone [ set-nth-unsafe ] keep
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
33 : edits1 ( word -- edits )
43 : edits2 ( word -- edits )
44 edits1 [ edits1 ] map concat ;
46 : filter-known ( edits dictionary -- words )
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! ;
55 : words ( string -- words )
56 >lower [ letter? not ] split-when harvest ;
58 : load-dictionary ( file -- assoc )
59 ascii file-contents words histogram ;
61 MEMO: default-dictionary ( -- counts )
62 URL" http://norvig.com/big.txt" "big.txt" temp-file
63 [ ?download-to ] [ load-dictionary ] bi ;
65 : (correct) ( word dictionary -- word/f )
68 : correct ( word -- word/f )
69 default-dictionary (correct) ;