67 lines
1.8 KiB
Scheme
67 lines
1.8 KiB
Scheme
;;; find the most frequently referenced word in the bible.
|
|
;;; aziz ghuloum (Nov 2007)
|
|
;;; modified by Will Clinger (Nov 2007)
|
|
;;; to use symbol-hash instead of eq? hashtables
|
|
|
|
(import (rnrs base)
|
|
(rnrs unicode)
|
|
(rnrs sorting)
|
|
(rnrs hashtables)
|
|
(rnrs io simple))
|
|
|
|
(define (fill input-file h)
|
|
(let ((p (open-input-file input-file)))
|
|
(define (put ls)
|
|
(hashtable-update! h
|
|
(string->symbol
|
|
(list->string
|
|
(reverse ls)))
|
|
(lambda (x) (+ x 1))
|
|
0))
|
|
(define (alpha ls)
|
|
(let ((c (read-char p)))
|
|
(cond
|
|
((eof-object? c)
|
|
(put ls))
|
|
((char-alphabetic? c)
|
|
(alpha (cons (char-downcase c) ls)))
|
|
(else (put ls) (non-alpha)))))
|
|
(define (non-alpha)
|
|
(let ((c (read-char p)))
|
|
(cond
|
|
((eof-object? c) (values))
|
|
((char-alphabetic? c)
|
|
(alpha (list (char-downcase c))))
|
|
(else (non-alpha)))))
|
|
(non-alpha)
|
|
(close-input-port p)))
|
|
|
|
(define (list-head ls n)
|
|
(cond
|
|
((or (zero? n) (null? ls)) '())
|
|
(else (cons (car ls) (list-head (cdr ls) (- n 1))))))
|
|
|
|
(define (go input-file)
|
|
(let ((h (make-hashtable symbol-hash eq?)))
|
|
(fill input-file h)
|
|
(let-values (((keys vals) (hashtable-entries h)))
|
|
(let ((ls (map cons
|
|
(vector->list keys)
|
|
(vector->list vals))))
|
|
(list-head
|
|
(list-sort (lambda (a b) (> (cdr a) (cdr b))) ls)
|
|
10)))))
|
|
|
|
(define (main)
|
|
(let* ((count (read))
|
|
(input1 (read))
|
|
(output (read))
|
|
(s2 (number->string count))
|
|
(s1 input1)
|
|
(name "bibfreq2"))
|
|
(run-r6rs-benchmark
|
|
(string-append name ":" s2)
|
|
1
|
|
(lambda () (go (hide count input1)))
|
|
(lambda (result) (equal? result output)))))
|