; treaps

(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 rand
  (let* ((a 3141592653) (c 2718281829)
         (m (expt 2 35)) (x 5772156649)
         (next (lambda ()
                 (let ((x-prime (modulo (+ (* a x) c) m)))
                   (set! x x-prime) x-prime)))
         (k 103)
         (v (list->vector (reverse
              (let loop ((i k) (vs (list x)))
                (if (= i 1) vs
                  (loop (- i 1) (cons (next) vs)))))))
         (y (next))
         (init (lambda (s)
                 (set! x s) (vector-set! v 0 x)
                 (do ((i 1 (+ i 1))) ((= i k))
                   (vector-set! v i (next))))))
    (lambda seed
      (cond ((null? seed)
              (let* ((j (quotient (* k y) m))
                     (q (vector-ref v j)))
                (set! y q)
                (vector-set! v j (next)) (/ y m)))
            ((eq? (car seed) 'get) (list a c m x y k v))
            ((eq? (car seed) 'set)
              (let ((state (cadr seed)))
                (set! a (list-ref state 0))
                (set! c (list-ref state 1))
                (set! m (list-ref state 2))
                (set! x (list-ref state 3))
                (set! y (list-ref state 4))
                (set! k (list-ref state 5))
                (set! v (list-ref state 6))))
            (else (init (modulo (numerator
                    (inexact->exact (car seed))) m))
                  (rand))))))

(define (treap k p v l r) (vector k p v l r))
(define (key t) (vector-ref t 0))
(define (prio t) (vector-ref t 1))
(define (val t) (vector-ref t 2))
(define (lkid t) (vector-ref t 3))
(define (rkid t) (vector-ref t 4))
(define nil (vector 'nil -1 'nil 'nil 'nil))
(define (nil! k) (vector-set! nil 0 k))
(define (nil? t) (eq? t nil))
(define (leaf? t) (and (nil? (lkid t)) (nil? (rkid t))))
(define (leaf-or-nil? t) (eq? (lkid t) (rkid t)))

(define (rot-left t)
  (let ((l (treap (key t) (prio t) (val t) (lkid t) (lkid (rkid t)))))
    (treap (key (rkid t)) (prio (rkid t)) (val (rkid t)) l (rkid (rkid t)))))

(define (rot-right t)
  (let ((r (treap (key t) (prio t) (val t) (rkid (lkid t)) (rkid t))))
    (treap (key (lkid t)) (prio (lkid t)) (val (lkid t)) (lkid (lkid t)) r)))

(define (lookup lt? t k)
  (cond ((nil? t) #f)
        ((lt? k (key t)) (lookup lt? (lkid t) k))
        ((lt? (key t) k) (lookup lt? (rkid t) k))
        (else (cons k (val t)))))

(define (insert lt? t k v)
  (cond ((nil? t) (treap k (rand) v nil nil))
        ((lt? k (key t))
          (let ((t (treap (key t) (prio t) (val t) (insert lt? (lkid t) k v) (rkid t))))
            (if (< (prio t) (prio (lkid t))) (rot-right t) t)))
        ((lt? (key t) k)
          (let ((t (treap (key t) (prio t) (val t) (lkid t) (insert lt? (rkid t) k v))))
            (if (< (prio t) (prio (rkid t))) (rot-left t) t)))
        (else (treap k (prio t) v (lkid t) (rkid t)))))

(define (deroot t)
  (cond ((leaf-or-nil? t) nil)
        ((< (prio (lkid t)) (prio (rkid t)))
          (let ((t (rot-left t)))
            (treap (key t) (prio t) (val t) (deroot (lkid t)) (rkid t))))
        (else (let ((t (rot-right t)))
                (treap (key t) (prio t) (val t) (lkid t) (deroot (rkid t)))))))

(define (delete lt? t k)
  (nil! k)
  (let delete ((t t))
    (cond ((lt? k (key t))
            (treap (key t) (prio t) (val t) (delete (lkid t)) (rkid t)))
          ((lt? (key t) k)
            (treap (key t) (prio t) (val t) (lkid t) (delete (rkid t))))
          (else (deroot t)))))

(define (update lt? t f k v)
  (cond ((nil? t) (treap k (rand) v nil nil))
        ((lt? k (key t))
          (let ((t (treap (key t) (prio t) (val t) (update lt? (lkid t) f k v) (rkid t))))
            (if (< (prio t) (prio (lkid t))) (rot-right t) t)))
        ((lt? (key t) k)
          (let ((t (treap (key t) (prio t) (val t) (lkid t) (update lt? (rkid t) f k v))))
            (if (< (prio t) (prio (rkid t))) (rot-left t) t)))
        (else (treap k (prio t) (f k (val t)) (lkid t) (rkid t)))))

(define (enlist t)
  (if (nil? t) '()
    (append (enlist (lkid t)) (list (cons (key t) (val t))) (enlist (rkid t)))))

(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 string<? freqs (lambda (k v) (+ v 1)) word 1)))))))