From 564908d55defa1f9884e43ce43a45d44f95fc681 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sun, 11 Nov 2007 02:10:02 -0500
Subject: [PATCH] * Added a word-frequency benchmark.

---
 benchmarks/benchall.ss                |  2 +-
 benchmarks/rnrs-benchmarks.ss         |  4 +-
 benchmarks/rnrs-benchmarks/bibfreq.ss | 61 +++++++++++++++++++++++++++
 3 files changed, 65 insertions(+), 2 deletions(-)
 create mode 100644 benchmarks/rnrs-benchmarks/bibfreq.ss

diff --git a/benchmarks/benchall.ss b/benchmarks/benchall.ss
index e28631a..15c6dc5 100755
--- a/benchmarks/benchall.ss
+++ b/benchmarks/benchall.ss
@@ -3,7 +3,7 @@
 (import (ikarus))
 
 (define all-benchmarks
-  '(ack array1 boyer browse cat compiler conform cpstak ctak dderiv
+  '(ack array1 bibfreq boyer browse cat compiler conform cpstak ctak dderiv
     deriv destruc diviter divrec dynamic earley fft fib fibc fibfp
     fpsum gcbench gcold graphs lattice matrix maze mazefun mbrot
     nbody nboyer nqueens ntakl nucleic paraffins parsing perm9 peval
diff --git a/benchmarks/rnrs-benchmarks.ss b/benchmarks/rnrs-benchmarks.ss
index 2659b47..1334e04 100644
--- a/benchmarks/rnrs-benchmarks.ss
+++ b/benchmarks/rnrs-benchmarks.ss
@@ -4,6 +4,7 @@
     call-with-output-file/truncate fast-run
      ack-iters 
      array1-iters
+     bibfreq-iters
      boyer-iters
      browse-iters
      cat-iters
@@ -178,6 +179,7 @@
 
   (define quicksort-iters 60)
   (define fpsum-iters 60)
-  (define nbody-iters         1) ; nondeterministic (order of evaluation)
+  (define nbody-iters         1)
+  (define bibfreq-iters 2)
 )
   
diff --git a/benchmarks/rnrs-benchmarks/bibfreq.ss b/benchmarks/rnrs-benchmarks/bibfreq.ss
new file mode 100644
index 0000000..5100b7e
--- /dev/null
+++ b/benchmarks/rnrs-benchmarks/bibfreq.ss
@@ -0,0 +1,61 @@
+ 
+;;; find the most frequently referenced word in the bible.
+;;; aziz ghuloum (Nov 2007)
+
+(library (rnrs-benchmarks bibfreq)
+  (export main)
+  (import (rnrs) (rnrs-benchmarks))
+
+  (define (fill h)
+    (let ([p (open-input-file "bib")])
+      (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)
+    (let ([h (make-eq-hashtable)])
+      (fill 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 . args)
+    (run-benchmark
+     "bibfreq"
+     bibfreq-iters
+     (lambda (result)
+       (equal? result
+         '((the . 63922) (and . 51696) (of . 34615) (to . 13562) (that . 12913) 
+           (in . 12666) (he . 10420) (shall . 9838) (unto . 8997) (for . 8971))))
+     (lambda () (lambda () (go))))))