[ create a new paste ] login | about

Link: http://codepad.org/aHBN2HbM    [ raw code | fork ]

veerandscheme - Scheme, pasted on Apr 17:

(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)
    [(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)
    [(empty? word) empty]
    [else (let ([r (chain-word (rest word))])
              [(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)
              [(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))
    (check-spell? root (string->list word))))

(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)))

(define root (make-node empty empty #f))

(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)

Create a new paste based on this one