codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
(define (make-hash hash eql? oops size) (let ((table (make-vector size '()))) (lambda (message . args) (if (eq? message 'enlist) (let loop ((k 0) (result '())) (if (= size k) result (loop (+ k 1) (append (vector-ref table k) result)))) (let* ((key (car args)) (index (modulo (hash key) size)) (bucket (vector-ref table index))) (case message ((lookup) (let loop ((bucket bucket)) (cond ((null? bucket) oops) ((eql? (caar bucket) key) (cdar bucket)) (else (loop (cdr bucket)))))) ((insert) (vector-set! table index (let loop ((bucket bucket)) (cond ((null? bucket) (list (cons key (cadr args)))) ((eql? (caar bucket) key) (cons (cons key (cadr args)) (cdr bucket))) (else (cons (car bucket) (loop (cdr bucket)))))))) ((delete) (vector-set! table index (let loop ((bucket bucket)) (cond ((null? bucket) '()) ((eql? (caar bucket) key) (cdr bucket)) (else (cons (car bucket) (loop (cdr bucket)))))))) ((update) (vector-set! table index (let loop ((bucket bucket)) (cond ((null? bucket) (list (cons key (caddr args)))) ((eql? (caar bucket) key) (cons (cons key ((cadr args) key (cdar bucket))) (cdr bucket))) (else (cons (car bucket) (loop (cdr bucket)))))))) )))))) (define (string-hash str) (let loop ((cs (string->list str)) (s 0)) (if (null? cs) s (loop (cdr cs) (+ (* s 31) (char->integer (car cs))))))) (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 (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 (word-freq n file-name) (define (freq-gt? a b) (> (cdr a) (cdr b))) (with-input-from-file file-name (lambda () (let ((freqs (make-hash string-hash string=? 0 49999))) (do ((word (read-word) (read-word))) ((eof-object? word) (take n (sort freq-gt? (freqs 'enlist)))) (freqs 'update word (lambda (k v) (+ v 1)) 1))))))
Private
[
?
]
Run code
Submit