Bitmap sort from Programming Pearls

In the first chapter of Programming Pearls, the topic revolves around choosing the correct algorithm to sort a large file of random phone numbers. The discussion started by suggesting mergesort or a similar well know algorithm. But due to the restricted domain of inputs and the costly disk access back in the day, the author proposed the following solution:

• Create a bitmap of size 10000000 initialized to 0.
• Read the file and for each phone number, set bitmap[phone-number] = 1.
• Iterate through the bitmap, and for each non-zero element write the index to the output.

This resulted in a sorted list that performed better than mergersort due to the fact of less disk access overhead.

The results made me wonder if the same performance gains would occur with today’s fast reading SSDs. So I created the following Common Lisp script to compare merge sort, the default sort from SBCL, and bitmap sort:

(alexandria:define-constant +max-phone-number+ 9999999)

(deftype phone-number () `(integer 0 ,+max-phone-number+))
(deftype phone-number-vector () '(vector phone-number))

(defun random-phone-number ()
  (random +max-phone-number+))

(defun write-phone-number-file (file-path max-numbers)
  (with-open-file (file file-path :direction :output :if-exists :supersede)
    ;; Use a hash table to ensure we do write any duplicate phone
    ;; numbers.
    (let ((hash-table (make-hash-table :test #'equalp :size max-numbers)))
      (loop repeat max-numbers
            for phone-number = (random-phone-number)
            unless (gethash phone-number hash-table)
              do (format file "~A~%" (setf (gethash phone-number hash-table) phone-number))))))

(defun count-file-lines (file-path)
  (with-open-file (file file-path)
    (loop for line = (read-line file nil)
          for count from 0
          while line
          finally (return count))))

(defun read-phone-number-file-to-vector (file-path)
  (let* ((phone-number-count (count-file-lines file-path))
         (phone-number-vector (make-array (list phone-number-count) :element-type 'phone-number)))
    (with-open-file (file file-path)
      (loop for line = (read-line file nil)
            for index from 0
            while line
            do (setf (aref phone-number-vector index) (parse-integer line))))
    (the phone-number-vector phone-number-vector)))

(defun default-sort (file-path)
  (let ((phone-number-vector (read-phone-number-file-to-vector file-path)))
    (sort phone-number-vector #'<)))

(defun do-merge-sort (phone-number-vector)
  (declare (phone-number-vector phone-number-vector))
  (if (or (null phone-number-vector) (= 1 (length phone-number-vector)))
      phone-number-vector
      (let ((half (truncate (/ (length phone-number-vector) 2))))
        (merge 'phone-number-vector
               (do-merge-sort (subseq phone-number-vector 0 half))
               (do-merge-sort (subseq phone-number-vector half))
               #'<))))

(defun merge-sort (file-path)
  (let ((phone-number-vector (read-phone-number-file-to-vector file-path)))
    (do-merge-sort phone-number-vector)))

(defun bitmap-sort (file-path)
  (let* ((bitmap (make-array (list (1+ +max-phone-number+)) :element-type 'bit :initial-element 0))
         (phone-number-count (count-file-lines file-path))
         (phone-number-vector (make-array (list phone-number-count) :element-type 'phone-number)))
    (with-open-file (file file-path)
      (loop for line = (read-line file nil)
            while line
            do (setf (aref bitmap (parse-integer line)) 1)))
    (loop with phone-number-index = 0
          for x across bitmap
          for bitmap-index from 0
          when (= 1 x)
            do (setf (aref phone-number-vector phone-number-index) bitmap-index)
            and do (incf phone-number-index))
    phone-number-vector))

And the results:

WB-SCRATCH> (time (progn (default-sort "/tmp/phonenumbers")
                         'done))
Evaluation took:
  1.395 seconds of real time
  1.474052 seconds of total run time (1.469602 user, 0.004450 system)
  [ Run times consist of 0.008 seconds GC time, and 1.467 seconds non-GC time. ]
  105.66% CPU
  3,347,659,604 processor cycles
  96,823,648 bytes consed

DONE
WB-SCRATCH> (time (progn (merge-sort "/tmp/phonenumbers")
                         'done))
Evaluation took:
  2.017 seconds of real time
  2.108636 seconds of total run time (2.108636 user, 0.000000 system)
  104.56% CPU
  4,840,574,542 processor cycles
  369,787,504 bytes consed

DONE
WB-SCRATCH> (time (progn (bitmap-sort "/tmp/phonenumbers")
                         'done))
Evaluation took:
  0.476 seconds of real time
  0.477942 seconds of total run time (0.477942 user, 0.000000 system)
  100.42% CPU
  1,141,716,964 processor cycles
  98,101,856 bytes consed

So it looks like the same approach using today’s SSDs still results in a performance gain. The merge sort implementation did use a lot of memory as it made new arrays on every call, so that has room for improvement. However the fact that bitmap sort beat the default implementation’s sort proves the general thesis.