count.rkt

#lang racket/base
(require racket/string racket/bytes racket/vector racket/port)

(define h (make-hash))
;(#%declare #:unsafe)

(define (split-lines/bytes)
  (for* ([l (in-bytes-lines)])
    (let loop ([i 0] [last 0])
      (cond [(= i (bytes-length l))
             (unless (eq? i last)
               (hash-update! h (bytes-downcase! (subbytes l last i)) add1 0))]
            [(eq? (bytes-ref l i) (char->integer #\space))
             (unless (eq? i last)
               (hash-update! h (bytes-downcase! (subbytes l last i)) add1 0))
             (loop (add1 i) (add1 i))]
            [else
             (loop (add1 i) last)]))))

(define (bytes-downcase! b)
  (for ([(n i) (in-indexed (in-bytes b))])
    (when (<= (char->integer #\A) n (char->integer #\Z))
      (bytes-set! b i (- n (- (char->integer #\A) (char->integer #\a))))))
  b)

(define (string-downcase! b)
  (for ([(n i) (in-indexed (in-string b))])
    (when (char<=? (values #\A) n (values #\Z))
      (string-set! b i (integer->char (- (char->integer n) (- (char->integer #\A) (char->integer #\a)))))))
  b)

(define (split-lines/string)
  (for* ([l (in-lines)])
    (let loop ([i 0] [last 0])
      (cond [(= i (string-length l))
             (unless (eq? i last)
               (hash-update! h (string-downcase (substring l last i)) add1 0))]
            [(or (eq? (string-ref l i) #\space)
                 (eq? (string-ref l i) #\tab))
             (unless (eq? i last)
               (hash-update! h (string-downcase (substring l last i)) add1 0))
             (loop (add1 i) (add1 i))]
            [else
             (loop (add1 i) last)]))))


(define (split-chunks/string)
  (for* ([l (in-producer (lambda () (read-string 64000)) eof)])
    (let loop ([i 0] [last 0])
      (cond [(= i (string-length l))
             (unless (eq? i last)
               (hash-update! h (string-downcase (substring l last i)) add1 0))]
            [(or (eq? (string-ref l i) #\space)
                 (eq? (string-ref l i) #\newline)
                 (eq? (string-ref l i) #\tab))
             (unless (eq? i last)
               (hash-update! h (string-downcase (substring l last i)) add1 0))
             (loop (add1 i) (add1 i))]
            [else
             (loop (add1 i) last)]))))

(define (split-chunks/bytes)
  (for* ([l (in-producer (lambda () (read-bytes 64000)) eof)])
    (let loop ([i 0] [last 0])
      (cond [(= i (bytes-length l))
             (unless (eq? i last)
               (hash-update! h (bytes-downcase! (subbytes l last i)) add1 0))]
            [(or (eq? (bytes-ref l i) (char->integer #\space))
                 (eq? (bytes-ref l i) (char->integer #\newline))
                 (eq? (bytes-ref l i) (char->integer #\tab)))
             (unless (eq? i last)
               (hash-update! h (bytes-downcase! (subbytes l last i)) add1 0))
             (loop (add1 i) (add1 i))]
            [else
             (loop (add1 i) last)]))))


(define (split-port-regexp)
  (let loop ()
    (define word (regexp-match #px"[^\\s\n]+" (current-input-port)))
    (when word
      (define w* (string-downcase (bytes->string/utf-8 (car word))))
      (hash-update! h w* add1 0)
      (loop))))


(time (split-lines/string))

(define v
  (time
   (for/vector #:length (hash-count h)
       ([(k v) (in-hash h)])
     (cons k v))))
(time (vector-sort! v > #:key cdr))
(define p (current-output-port) #; (open-output-nowhere))
(time
 (for ([pair (in-vector v)])
   (display (car pair) p) (write-bytes #" " p)
   (write (cdr pair) p)
   (newline p)))