fork(2) download
copy 
  1. ; heavy hitters, the britney spears algorithm
  2.  
  3. (define (take n xs)
  4.   (let loop ((n n) (xs xs) (ys '()))
  5.     (if (or (zero? n) (null? xs))
  6.         (reverse ys)
  7.         (loop (- n 1) (cdr xs)
  8.               (cons (car xs) ys)))))
  9.  
  10. (define (hashtable-pairs ht)
  11.   (call-with-values
  12.     (lambda () (hashtable-entries ht))
  13.     (lambda (keys values)
  14.       (map cons (vector->list keys) (vector->list values)))))
  15.  
  16. (define (read-word)
  17.   (let loop ((c (read-char)) (cs '()))
  18.     (cond ((eof-object? c)
  19.             (if (null? cs) c
  20.               (list->string (reverse cs))))
  21.           ((char-alphabetic? c)
  22.             (loop (read-char) (cons (char-downcase c) cs)))
  23.           ((pair? cs) (list->string (reverse cs)))
  24.           (else (loop (read-char) cs)))))
  25.  
  26. (define (word-freq n file-name)
  27.   (define (freq-gt? a b) (> (cdr a) (cdr b)))
  28.   (with-input-from-file file-name (lambda ()
  29.     (let ((freqs (make-hashtable string-hash string=?)))
  30.       (do ((word (read-word) (read-word)))
  31.           ((eof-object? word) (map car (take n
  32.             (sort freq-gt? (hashtable-pairs freqs)))))
  33.         (hashtable-update! freqs word add1 0))))))
  34.  
  35. (define (misra-gries n file-name)
  36.   (define (freq-gt? a b) (> (cdr a) (cdr b)))
  37.   (let ((keys (make-hashtable string-hash string=?)))
  38.     (with-input-from-file file-name (lambda ()
  39.       (do ((word (read-word) (read-word)))
  40.           ((eof-object? word) (map car (take n
  41.             (sort freq-gt? (hashtable-pairs keys)))))
  42.         (if (or (hashtable-contains? keys word)
  43.                 (< (hashtable-size keys) n))
  44.             (hashtable-update! keys word add1 0)
  45.             (vector-for-each
  46.               (lambda (word)
  47.                 (hashtable-update! keys word sub1 1)
  48.                 (when (zero? (hashtable-ref keys word 0))
  49.                   (hashtable-delete! keys word)))
  50.               (hashtable-keys keys))))))))
  51.  
  52. (define (space-saving n file-name)
  53.   (define (freq-gt? a b) (> (cdr a) (cdr b)))
  54.   (let ((keys (make-hashtable string-hash string=?)))
  55.     (with-input-from-file file-name (lambda ()
  56.       (do ((word (read-word) (read-word)))
  57.           ((eof-object? word) (map car (take n
  58.             (sort freq-gt? (hashtable-pairs keys)))))
  59.         (if (or (hashtable-contains? keys word)
  60.                 (< (hashtable-size keys) n))
  61.             (hashtable-update! keys word add1 0)
  62.             (let ((kv-pairs (hashtable-pairs keys)))
  63.               (let loop ((min-k (caar kv-pairs))
  64.                          (min-v (cdar kv-pairs))
  65.                          (kv-pairs (cdr kv-pairs)))
  66.                 (if (pair? kv-pairs)
  67.                     (if (< (cdar kv-pairs) min-v)
  68.                         (loop (caar kv-pairs)
  69.                               (cdar kv-pairs)
  70.                               (cdr kv-pairs))
  71.                         (loop min-k min-v (cdr kv-pairs)))
  72.                     (begin
  73.                       (hashtable-delete! keys min-k)
  74.                       (hashtable-update! keys word
  75.                         add1 min-v))))))))))
Runtime error #stdin #stdout #stderr 0.04s 8744KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
ERROR: In procedure primitive-load:
ERROR: In procedure scm_i_lreadparen: /home/gDVYky/prog.scm:75:45: end of file
https://ideone.com/BPHZqT
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!