Skip to content

Instantly share code, notes, and snippets.

@offby1
Created April 19, 2009 18:40
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save offby1/98166 to your computer and use it in GitHub Desktop.
#! /bin/sh
#| Hey Emacs, this is -*-scheme-*- code!
#$Id: v4-script-template.ss 5887 2008-12-30 18:12:50Z erich $
exec mzscheme -l errortrace --require "$0" --main -- ${1+"$@"}
|#
#lang scheme
(require "trie.ss"
(planet schematics/schemeunit:3)
(planet schematics/schemeunit:3/text-ui))
(define snarf-dictionary
(match-lambda
[(? string? inp)
(snarf-dictionary (build-path inp))]
[(? path? inp)
(fprintf (current-error-port) "Reading dictionary ~s ... " inp)
(let ((dict (call-with-input-file inp snarf-dictionary)))
(fprintf (current-error-port) "done; ~s words~%"
(dict-count dict))
dict)]
[(? input-port? inp)
(for/fold ([dict (make-immutable-trie)])
([word (in-lines inp)])
(dict-set dict word word ))]))
(define dict-tests
(test-suite
"dictionary"
(let ((d (snarf-dictionary "/usr/share/dict/words")))
(check-not-false (dict-ref d "dog"))
(check-false (dict-ref d "I bet this word isn't in the dictionary"))
(printf "Hey: ~a~%"
(for/list ((w (in-list '("sam" "Sam" "snord" "flutter" "butter" "smith" "Smith"))))
(cons w (dict-ref d w))))
)))
(define trie-tests
(test-suite
"top"
(test-case
"tries"
(let ((t (make-immutable-trie)))
(check-true (trie? t))
(check-equal? (dict-count t) 0)
(let ((t (dict-set t "c" "The letter 'c'")))
(check-equal? (dict-count t) 1)
(check-equal? (dict-ref t "c") "The letter 'c'")
(let* ((exp "The furry 'cat'")
(t (dict-set t "cat" exp)))
(check-false (dict-ref t "ca" #f))
(check-equal? (dict-count t) 2)
(check-equal? (dict-ref t "cat") exp)
))
)
(let ((t (make-immutable-trie)))
(check-true (dict? t))
(check-false (dict-ref t "cat" #f))
(check-equal? (dict-count t) 0)
(let ((t (dict-set t "c" 'plurgh)))
(check-equal? (dict-ref t "c" #f) 'plurgh)
(check-equal? (dict-count t) 1)
(let ((t (dict-set t "cat" "hat")))
(check-equal? (dict-ref t "cat" #f) "hat")
(let ((t (dict-set t "cats" "mats")))
(check-equal? (dict-ref t "cat" #f) "hat")
(check-equal? (dict-ref t "cats" #f) "mats")
(check-equal? (dict-count t) 3))
)
)))
dict-tests))
(provide main)
(define (main . args)
(exit (run-tests
trie-tests
'verbose)))
#lang scheme
(require mzlib/trace)
(define (ref t key [failure-result #f])
(define (ref-inner t chars)
(if (null? chars)
(if (box? (trie-value t))
(unbox (trie-value t))
failure-result)
(let ((probe (dict-ref (trie-alist t) (car chars) #f)))
(cond
((not probe)
failure-result)
((box? probe)
(unbox probe))
(#t
(ref-inner probe
(cdr chars)))))))
;; (trace ref-inner)
(ref-inner t (string->list key)))
;; (trace ref)
(define (set t key value)
(define (set-inner t chars value)
;; chars: () => set the box
;; chars: (ch . rest) => lookup ch => old value; (set-inner oldvalue (cdr chars) value)
(let ((new (make-trie '() (box-immutable value))))
(if (null? chars)
new
(let ((probe (dict-ref (trie-alist t) (car chars) (make-trie '() #f))))
(make-trie
(dict-set (trie-alist t) (car chars)
(set-inner probe (cdr chars) value))
(trie-value t))))))
;; (trace set-inner)
(set-inner t (string->list key) value))
;; (trace set)
(define (count t)
(foldl +
(if (box? (trie-value t))
1
0)
(map (compose count cdr) (trie-alist t))))
;; (trace count)
(define (iterate-first t)
(and (not (null? t))
0))
;; (trace iterate-first)
(define (iterate-next t pos)
(if (= pos (sub1 (length t)))
#f
(add1 pos)))
;; (trace iterate-next)
(define (iterate-key t pos)
(car (list-ref t pos)))
;; (trace iterate-key)
(define (iterate-value t pos)
(cdr (list-ref t pos)))
;; (trace iterate-value)
(define-struct trie
(alist
value ;;either #f or a box
)
#:property prop:dict (vector
ref
#f set
#f remove
count
iterate-first iterate-next
iterate-key iterate-value)
#:transparent)
(provide make-immutable-trie trie?)
(define (make-immutable-trie)
(make-trie '() #f))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment