(defun make-long-list (x)
(do* ((y (make-list x))
(i y (cdr i)))
(nil)
(when (null i) (return y))
(rplaca i (random 1000))))
(defun make-long-array (x)
(do* ((y (make-array x :element-type 'fixnum))
(i 0 (1+ i)))
(nil)
(when (= x i) (return y))
(setf (aref y i) (random 1000))))
(defun count-inversions (lst)
(if (or (null lst) (null (cdr lst)))
0
(let* ((half (ceiling (/ (length lst) 2)))
(left-list (subseq lst 0 half))
(right-list (subseq lst half)))
(+ (loop for a in left-list
summing (loop for b in right-list
counting (not (< a b))))
(count-inversions left-list)
(count-inversions right-list)))))
(defun count-inversions-6 (x)
(declare (optimize (speed 3)
(compilation-speed 0)
(debug 0)
(safety 0))
(ftype (function ((simple-array fixnum (*)))
(unsigned-byte 32))
count-inversions-6)
(type (simple-array fixnum (*)) x))
(if (< (length x) 2)
0
(let* ((half-a (ash (length x) -1))
(left-array (subseq x 0 half-a))
(half-b (- (length x) half-a))
(right-array (subseq x half-a))
(current 0)
(total 0))
(declare (type (unsigned-byte 32) half-a)
(type (unsigned-byte 32) half-b)
(type fixnum current)
(type (simple-array fixnum (*)) right-array)
(type (simple-array fixnum (*)) left-array)
(type (unsigned-byte 32) total))
(the (unsigned-byte 32)
(+
(dotimes (i half-a total)
(setq current (aref left-array i))
(dotimes (j half-b)
(when (>= current
(the fixnum (aref right-array j)))
(setq total (the (unsigned-byte 32) (+ total 1))))))
(count-inversions-6 left-array)
(count-inversions-6 right-array))))))
(time (make-long-list 1000))
;; Evaluation took:
;; 0.000 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 100.00% CPU
;; 881,214 processor cycles
;; 159,744 bytes consed
(time (make-long-array 1000))
;; Evaluation took:
;; 0.000 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 100.00% CPU
;; 806,562 processor cycles
;; 80,016 bytes consed
(time (count-inversions (make-long-list 1000)))
;; Evaluation took:
;; 0.313 seconds of real time
;; 0.312019 seconds of total run time (0.308019 user, 0.004000 system)
;; [ Run times consist of 0.008 seconds GC time, and 0.305 seconds non-GC time. ]
;; 99.68% CPU
;; 875,653,434 processor cycles
;; 3,038,576 bytes consed
(time (count-inversions-6 (make-long-array 1000)))
;; Evaluation took:
;; 0.178 seconds of real time
;; 0.180011 seconds of total run time (0.180011 user, 0.000000 system)
;; 101.12% CPU
;; 500,373,921 processor cycles
;; 1,586,080 bytes consed