[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/UnTljjnx    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on May 27:
; ternary search tries

(define (node v? v s l e h) (vector v? v s l e h))
(define nil (vector #f #f (integer->char 0) (vector) (vector) (vector)))
(define (nil? tst) (eqv? tst nil))
(define (val? tst)  (vector-ref tst 0))
(define (val tst)   (vector-ref tst 1))
(define (split tst) (vector-ref tst 2))
(define (lokid tst) (vector-ref tst 3))
(define (eqkid tst) (vector-ref tst 4))
(define (hikid tst) (vector-ref tst 5))

(define (lookup t k)
  (cond ((nil? t) #f)
        ((null? k) (if (val? t) (val t) #f))
        ((char<? (car k) (split t)) (lookup (lokid t) k))
        ((char<? (split t) (car k)) (lookup (hikid t) k))
        (else (lookup (eqkid t) (cdr k)))))

(define (insert t k v)
  (cond ((nil? t) (insert (node #f #f (if (null? k) (integer->char 0) (car k)) nil nil nil) k v))
        ((null? k) (node #t v (split t) (lokid t) (eqkid t) (hikid t)))
        ((char<? (car k) (split t)) (node (val? t) (val t) (split t) (insert (lokid t) k v) (eqkid t) (hikid t)))
        ((char<? (split t) (car k)) (node (val? t) (val t) (split t) (lokid t) (eqkid t) (insert (hikid t) k v)))
        (else (node (val? t) (val t) (split t) (lokid t) (insert (eqkid t) (cdr k) v) (hikid t)))))

(define (update t k p v)
  (cond ((nil? t) (update (node #f #f (if (null? k) (integer->char 0) (car k)) nil nil nil) k p v))
        ((null? k) (if (val? t) (node #t (p k (val t)) (split t) (lokid t) (eqkid t) (hikid t))
                                (node #t v (split t) (lokid t) (eqkid t) (hikid t))))
        ((char<? (car k) (split t)) (node (val? t) (val t) (split t) (update (lokid t) k p v) (eqkid t) (hikid t)))
        ((char<? (split t) (car k)) (node (val? t) (val t) (split t) (lokid t) (eqkid t) (update (hikid t) k p v)))
        (else (node (val? t) (val t) (split t) (lokid t) (update (eqkid t) (cdr k) p v) (hikid t)))))

(define (delete t k)
  (cond ((nil? t) t)
        ((null? k) (node #f #f (split t) (lokid t) (eqkid t) (hikid t)))
        ((char<? (car k) (split t)) (node (val? t) (val t) (split t) (delete (lokid t) k) (eqkid t) (hikid t)))
        ((char<? (split t) (car k)) (node (val? t) (val t) (split t) (lokid t) (eqkid t) (delete (hikid t) k)))
        (else (node (val? t) (val t) (split t) (lokid t) (delete (eqkid t) (cdr k)) (hikid t)))))

(define (enlist t)
  (let enlist ((t t) (k '()))
    (if (nil? t) '()
      (append (enlist (lokid t) k)
              (if (val? t)
                  (cons (cons (list->string (reverse k)) (val t))
                        (enlist (eqkid t) (cons (split t) k)))
                  (enlist (eqkid t) (cons (split t) k)))
              (enlist (hikid t) k)))))

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (read-word)
  (let loop ((c (read-char)) (cs '()))
    (cond ((eof-object? c)
            (if (null? cs) c
              (list->string (reverse cs))))
          ((char-alphabetic? c)
            (loop (read-char) (cons (char-downcase c) cs)))
          ((pair? cs) (list->string (reverse cs)))
          (else (loop (read-char) cs)))))

(define (word-freq n file-name)
  (define (freq-gt? a b) (> (cdr a) (cdr b)))
  (with-input-from-file file-name
    (lambda ()
      (let loop ((word (read-word)) (freqs nil))
        (if (eof-object? word)
            (take n (sort freq-gt? (enlist freqs)))
            (loop (read-word) (update freqs (string->list word) (lambda (k v) (+ v 1)) 1)))))))

(display (word-freq 25 "bible.txt"))


Output:
1
with-input-from-file: cannot open input file: "/bible.txt" (No such file or directory; errno=2)


Create a new paste based on this one


Comments: