; this is assuming that the input is case-insensitive ; despite a unique word count implying words and not 'words with following or ; leading punctuation', this will terminate only on space or newline (define (trie-new) (make-vector 256 0)) (define (trie-insert tr s) (let ((l (string-length s))) (let loop ((i (or (and (= 0 l) 0) (- l 1))) (t tr)) (if (= i 0) (begin (vector-set! t 0 (+ 1 (vector-ref t 0))) tr) (let ((c (char->integer (char-downcase (string-ref s i))))) (cond ((or (= 32 c) (= 10 c)) ; 32 = #\space 10 = #\newline (vector-set! t 0 (+ 1 (vector-ref t 0))) (loop (- i 1) tr)) ((vector? (vector-ref t c)) (loop (- i 1) (vector-ref t c))) (else (let ((tn (trie-new))) (vector-set! tn 0 (vector-ref t c)) (vector-set! t c tn) (loop (- i 1) tn))))))))) (define (words-read f) (with-input-from-file f (lambda () (let loop ((l (read-line)) (tr (trie-new))) (if (eof-object? l) tr (loop (trie-insert tr l) (read-line))))))) (define idx-list (let loop ((i 1) (r '())) (if (= i 256) r (loop (+ 1 i) (cons i r))))) (define char-list (map integer->char idx-list)) (define (trie->wordlist tr) (vector-set! tr 0 0) ; remove repeated spaces (let ((r '())) (let loop ((b '()) (t tr)) (for-each (lambda (i c) (let ((e (vector-ref t i))) (if (vector? e) (loop (cons c b) e) (or (= 0 e) (set! r (cons (cons (list->string (cons c b)) e) r)))))) idx-list char-list) (or (= 0 (vector-ref t 0)) (set! r (cons (cons (list->string b) (vector-ref t 0)) r)))) r))