1BRC in Racket

[williewillus]

Extremely basic and slow implementation for Racket CS 8.11. Takes 12 minutes on my computer, which runs the baseline in about 3m21s. Memory usage is extremely low (~77KiB resident at all times).

#lang racket/base

(require racket/flonum)

(define slot-n 0)
(define slot-min 1)
(define slot-max 2)
(define slot-sum 3)

(define (rnd v)
  (fl/ (round (fl* v 10.0))
       10.0))

(define (show-states states)
  (hash-for-each
   states
   (λ (station state)
     (displayln (format "~a ~a/~a/~a"
                      station
                      (rnd (flvector-ref state slot-min))
                      (rnd (fl/ (flvector-ref state slot-sum)
                                (flvector-ref state slot-n)))
                      (rnd (flvector-ref state slot-max)))))
   #t))

(define re (regexp (regexp-quote ";")))
(define (my-string-split s)
  #|
  ;; Don't use the fully general string-split which does a lot of extra work
  ;; I don't have numbers but it's noticeably slower than the below approach.
  (define splits (string-split s ";"))
  (define station (string->symbol (car splits)))
  (define value (real->double-flonum (string->number (cadr splits))))
  |#
  (define semicolon-idx (caar (regexp-match-positions re s)))
  (define station (string->symbol (substring s 0 semicolon-idx)))
  (define value (real->double-flonum (string->number (substring s (add1 semicolon-idx)))))
  (values station value))

(define (main)
  (call-with-input-file "measurements.txt"
    (λ (port)
      (define states (make-hasheq))
      (for ([(line i) (in-indexed (in-lines port 'linefeed))])
        (when (zero? (modulo i 10000000))
          (displayln (format "Processed ~a" i)))
        (define-values (station value) (my-string-split line))
        (define state
          (hash-ref! states station
                     (λ () (make-flvector 4))))
        (if (zero? (flvector-ref state slot-n))
            (let ()
              (flvector-set! state slot-n 1.0)
              (flvector-set! state slot-min value)
              (flvector-set! state slot-max value)
              (flvector-set! state slot-sum value))
            (let ([n (flvector-ref state slot-n)]
                  [mi (flvector-ref state slot-min)]
                  [mx (flvector-ref state slot-max)]
                  [sum (flvector-ref state slot-sum)])
              (flvector-set! state slot-n (fl+ n 1.0))
              (flvector-set! state slot-min (flmin mi value))
              (flvector-set! state slot-max (flmax mx value))
              (flvector-set! state slot-sum (fl+ sum value)))))
      (show-states states))))

(module* main #f
  (main))

It doesn't output in the same format as required by the contest because I didn't feel like bothering.

Follow up ideas:

• Try unsafe float ops
• Try parallelizing with futures or places
• Try to reduce parsing overhead somehow
• Try just a normal hashtable of string keys vs. string->symbol + hasheq

[williewillus]

Changing the (require racket/flonum) at the top of the program to the following will change all the float operations to unsafe versions:

(require (for-syntax racket/base)
         racket/require)
(require (only-in racket/flonum make-flvector))
(require (filtered-in
          (λ (name)
            (and (regexp-match #rx"^unsafe-fl" name)
                 (regexp-replace #rx"unsafe-" name "")))
              racket/unsafe/ops))

This shaves several seconds off the runtime, getting me to 11m48s.

[williewillus]

Trying to replace string->symbol and hasheq with just string keys in a hash regresses runtime from the above 11m48s to 12m58s, worse than the original version.

[williewillus]

Here is my attempt at parallelizing with futures, but something in work is causing the futures to block and run serially...

#lang racket/base

(require racket/future racket/hash
         future-visualizer future-visualizer/trace)
(require (for-syntax racket/base)
         racket/require)
(require (only-in racket/flonum make-flvector))
(require (filtered-in
          (λ (name)
            (and (regexp-match #rx"^unsafe-fl" name)
                 (regexp-replace #rx"unsafe-" name "")))
          racket/unsafe/ops))

(define slot-n 0)
(define slot-min 1)
(define slot-max 2)
(define slot-sum 3)

(define (merge state1 state2)
  (flvector-set! state1 slot-n (fl+ (flvector-ref state1 slot-n)
                                    (flvector-ref state2 slot-n)))
  (flvector-set! state1 slot-min (flmin (flvector-ref state1 slot-min)
                                        (flvector-ref state2 slot-min)))
  (flvector-set! state1 slot-max (flmax (flvector-ref state1 slot-max)
                                        (flvector-ref state2 slot-max)))
  (flvector-set! state1 slot-sum (fl+ (flvector-ref state1 slot-sum)
                                      (flvector-ref state2 slot-sum)))
  state1)

(define (rnd v)
  (fl/ (round (fl* v 10.0))
       10.0))

(define (show-states states)
  (hash-for-each
   states
   (λ (station state)
     (displayln (format "~a ~a/~a/~a"
                      station
                      (rnd (flvector-ref state slot-min))
                      (rnd (fl/ (flvector-ref state slot-sum)
                                (flvector-ref state slot-n)))
                      (rnd (flvector-ref state slot-max)))))
   #t))

(define re (regexp (regexp-quote ";")))
(define (my-string-split s)
  ;; Don't use the fully general string-split function which does a lot of extra work
  ;; I don't have numbers but it's noticeably slower than the below approach.
  (define semicolon-idx (caar (regexp-match-positions re s)))
  (define station (string->symbol (substring s 0 semicolon-idx)))
  (define value (real->double-flonum (string->number (substring s (add1 semicolon-idx)))))
  (values station value))

(define (work batch)
  (define states (make-hasheq))
  (for ([line (in-list batch)])
    (define-values (station value) (my-string-split line))
    (define state
      (hash-ref! states station
                 (λ () (make-flvector 4))))
    (if (zero? (flvector-ref state slot-n))
        (let ()
          (flvector-set! state slot-n 1.0)
          (flvector-set! state slot-min value)
          (flvector-set! state slot-max value)
          (flvector-set! state slot-sum value))
        (let ([n (flvector-ref state slot-n)]
              [mi (flvector-ref state slot-min)]
              [mx (flvector-ref state slot-max)]
              [sum (flvector-ref state slot-sum)])
          (flvector-set! state slot-n (fl+ n 1.0))
          (flvector-set! state slot-min (flmin mi value))
          (flvector-set! state slot-max (flmax mx value))
          (flvector-set! state slot-sum (fl+ sum value)))))
  states)

(define batch-size 1000000)

(define (main)
  (call-with-input-file "measurements.txt"
    (λ (port)
      (define batch-futures null)
      (define next-batch null)
      (define next-batch-len 0) ;; same as (length next-batch), to avoid O(n) linked list counting
      (start-future-tracing!)
      (for ([line (in-lines port 'linefeed)])
        (define next-batch-this-iter (cons line next-batch))
        (if (= next-batch-len batch-size)
            ;; issue a new batch
            (let ()
              (set! batch-futures (cons (future (λ () (work next-batch-this-iter))) batch-futures))
              (set! next-batch null)
              (set! next-batch-len 0))
            ;; build up next batch
            (let ()
              (set! next-batch next-batch-this-iter)
              (set! next-batch-len (add1 next-batch-len)))))
      (define final-states (touch (car batch-futures)))
      (for ([fut (in-list (cdr batch-futures))])
        (hash-union! final-states
                     (touch fut)
                     #:combine merge))
      (stop-future-tracing!)
      (show-states final-states)
      (show-visualizer))))

(module* main #f
  (main))