;spell-checker.ss
(require scheme)
(define-struct node (char edges word?) #:mutable)
;(make-node (#\b (list node1 node2 ...) #t)
;word? determines if this node ends in a correct spelling
;add-word : node string -> (void)
(define (add-word root word)
(insert-word root (node-edges root) (string->list word)))
;insert-word : node nodes (listof char) -> void
(define (insert-word parent nodes a-word)
(cond
[(empty? a-word) (set-node-word?! parent #t)]
[(empty? nodes) (set-node-edges!
parent (append (list (chain-word a-word))
(node-edges parent)))]
[(char=? (first a-word) (node-char (first nodes)))
(insert-word (first nodes) (node-edges (first nodes)) (rest a-word))]
[else (insert-word parent (rest nodes) a-word)]))
;chain-word : (listof string) -> node
;give a string , makes a node of each char
;with each node having successor node as
;its edge; returns the first node;
(define (chain-word word)
(cond
[(empty? word) empty]
[else (let ([r (chain-word (rest word))])
(cond
[(empty? r) (make-node (first word) empty #t)]
[else (make-node (first word) (list r) #f)]))]))
;valid-spell? : node string -> boolean
(define (valid-spell? root word)
(local [(define (check-spell? root a-word)
(cond
[(empty? a-word) (and #t (node-word? root))]
[else (let ([nxt-node (findf (lambda (n)
(char=? (node-char n) (first a-word)))
(node-edges root))])
(if nxt-node (check-spell? nxt-node (rest a-word))
#f))]))]
(check-spell? root (string->list word))))
;dump
(define (dump-tri n)
(printf "~s : ~s\n" (node-char n) (map node-char (node-edges n)))
(for-each (lambda (e) (dump-tri e)) (node-edges n)))
;root
(define root (make-node empty empty #f))
;runs
(add-word root "cat")
(add-word root "cab")
(add-word root "dog")
(add-word root "dummy")
(add-word root "capital")
(printf "\n")
(dump-tri root)
(valid-spell? root "zxert")
(valid-spell? root "cat")
(valid-spell? root "cab")
(valid-spell? root "cap")
(valid-spell? root "capital")
(add-word root "cap")
(valid-spell? root "cap")
(printf "\n")
(dump-tri root)