Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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 &optional (predicate #'<))
- (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 (funcall predicate a b))))
- (count-inversions left-list predicate)
- (count-inversions right-list predicate)))))
- (defun count-inversions-1 (x &optional (predicate #'<) (len (length x)))
- (if (or (null x) (null (cdr x)))
- 0
- (let* ((half-a (1- (ash len -1)))
- (half-b (- len half-a))
- (right-list (split-in-two! x)))
- (+ (loop for a in x
- summing (loop for b in right-list
- counting (not (funcall predicate a b))))
- (count-inversions-1 x predicate half-a)
- (count-inversions-1 right-list predicate half-b)))))
- (defun split-in-two! (x &optional (len (length x)))
- (setq len (1- (ash len -1)))
- (do ((c x (cdr c))
- (r)
- (i 0 (1+ i)))
- (nil)
- (when (= i len)
- (setq r (cdr c))
- (rplacd c nil)
- (return r))))
- ;; Note that you get a lot of bad optimization warnings, we'll fix that next
- (defun count-inversions-2 (lst &optional (predicate #'<))
- (declare (optimize (speed 3)
- (compilation-speed 0)
- (debug 0)
- (safety 0)))
- (declare (type list lst))
- (declare (type (function (fixnum fixnum)) predicate))
- (if (or (null lst) (null (cdr lst)))
- 0
- (let* ((half (the fixnum (ceiling (/ (the fixnum (length lst)) 2))))
- (left-list (subseq lst 0 half))
- (right-list (subseq lst half)))
- (declare (type fixnum half))
- (declare (type list left-list))
- (declare (type list right-list))
- (+ (the bignum (loop for a in left-list
- summing (loop for b in right-list
- counting (not (funcall
- (the function predicate)
- (the fixnum a)
- (the fixnum b))))))
- (the bignum (count-inversions-2 left-list predicate))
- (the bignum (count-inversions-2 right-list predicate))))))
- ;; (ftype (function (list function) bignum) count-inversions-3)
- (defun count-inversions-3 (lst &optional (predicate #'<))
- (declare (optimize (speed 3)
- (compilation-speed 0)
- (debug 0)
- (safety 0))
- (type list lst)
- (ftype (function (list function) integer) count-inversions-3)
- (type (function (fixnum fixnum) boolean) predicate))
- (if (or (null lst) (null (cdr lst)))
- 0
- (let* ((len (length lst))
- (half (the (unsigned-byte 32) (- len (ash len -1))))
- (left-list (subseq lst 0 half))
- (right-list (subseq lst half))
- (total 0))
- (declare (type (unsigned-byte 32) len)
- (type (unsigned-byte 32) half)
- (type list left-list)
- (type list right-list)
- (type integer total))
- (the integer
- (+
- (dolist (i left-list total)
- (dolist (j right-list)
- (when (not (funcall
- predicate
- (the fixnum i)
- (the fixnum j)))
- (setq total (the (unsigned-byte 32) (+ total 1))))))
- (count-inversions-3 left-list predicate)
- (count-inversions-3 right-list predicate))))))
- (defun count-inversions-4 (x &optional (predicate #'<) (len (length x)))
- (declare (optimize (speed 3)
- (compilation-speed 0)
- (debug 0)
- (safety 0))
- (ftype (function (list function (unsigned-byte 32)) (unsigned-byte 32))
- count-inversions-4)
- (type (function (fixnum fixnum) boolean) predicate)
- (type list x)
- (type (unsigned-byte 32) len)
- (inline split-in-two!-1))
- (if (or (null x) (null (cdr x)))
- 0
- (let* ((half-a (1- (ash len -1)))
- (half-b (- len half-a))
- (right-list (split-in-two!-1 x))
- (total 0))
- (declare (type (unsigned-byte 32) half-a)
- (type (unsigned-byte 32) half-b)
- (type list right-list)
- (type (unsigned-byte 32) total))
- (the integer
- (+
- (dolist (i x total)
- (dolist (j right-list)
- (when (not (funcall
- predicate
- (the fixnum i)
- (the fixnum j)))
- (setq total (the (unsigned-byte 32) (+ total 1))))))
- (count-inversions-4 x predicate half-a)
- (count-inversions-4 right-list predicate half-b))))))
- (defun split-in-two!-1 (x &optional (len (length x)))
- (declare (optimize (speed 3)
- (compilation-speed 0)
- (debug 0)
- (safety 0))
- (ftype (function (list (unsigned-byte 32)) list) split-in-two!-1)
- (type list x)
- (type (unsigned-byte 32) len))
- (setq len (1- (ash len -1)))
- (do ((c x (cdr c))
- (r)
- (i 0 (1+ i)))
- (nil)
- (declare (type list c)
- (type (unsigned-byte 32) i)
- (type list r))
- (when (= i len)
- (setq r (cdr c))
- (rplacd c nil)
- (return r))))
- (defun count-inversions-5 (x &optional (predicate #'<))
- (declare (optimize (speed 3)
- (compilation-speed 0)
- (debug 0)
- (safety 0))
- (ftype (function ((simple-array fixnum (*)) function)
- (unsigned-byte 32))
- count-inversions-5)
- (type (function (fixnum fixnum) boolean) predicate)
- (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 (not (funcall
- predicate
- current
- (the fixnum (aref right-array j))))
- (setq total (the (unsigned-byte 32) (+ total 1))))))
- (count-inversions-5 left-array predicate)
- (count-inversions-5 right-array predicate))))))
- (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 10000))
- ;; Evaluation took:
- ;; 0.000 seconds of real time
- ;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
- ;; 100.00% CPU
- ;; 865,284 processor cycles
- ;; 159,744 bytes consed
- (time (count-inversions (make-long-list 10000)))
- ;; Evaluation took:
- ;; 2.548 seconds of real time
- ;; 2.540159 seconds of total run time (2.536159 user, 0.004000 system)
- ;; 99.69% CPU
- ;; 7,126,743,462 processor cycles
- ;; 3,080,976 bytes consed
- (time (count-inversions-1 (make-long-list 10000)))
- ;; Evaluation took:
- ;; 2.528 seconds of real time
- ;; 2.520157 seconds of total run time (2.520157 user, 0.000000 system)
- ;; 99.68% CPU
- ;; 7,074,236,361 processor cycles
- ;; 194,672 bytes consed
- (time (count-inversions-2 (make-long-list 10000)))
- ;; Evaluation took:
- ;; 2.423 seconds of real time
- ;; 2.416151 seconds of total run time (2.416151 user, 0.000000 system)
- ;; 99.71% CPU
- ;; 6,781,155,228 processor cycles
- ;; 3,076,880 bytes consed
- (time (count-inversions-3 (make-long-list 10000)))
- ;; Evaluation took:
- ;; 2.290 seconds of real time
- ;; 2.280143 seconds of total run time (2.280143 user, 0.000000 system)
- ;; 99.56% CPU
- ;; 6,407,376,423 processor cycles
- ;; 2,647,840 bytes consed
- (time (count-inversions-4 (make-long-list 10000)))
- ;; Evaluation took:
- ;; 2.294 seconds of real time
- ;; 2.284143 seconds of total run time (2.284143 user, 0.000000 system)
- ;; 99.56% CPU
- ;; 6,417,973,587 processor cycles
- ;; 190,128 bytes consed
- (time (count-inversions-5 (make-long-array 10000)))
- ;; Evaluation took:
- ;; 2.326 seconds of real time
- ;; 2.316144 seconds of total run time (2.316144 user, 0.000000 system)
- ;; 99.57% CPU
- ;; 6,506,879,880 processor cycles
- ;; 1,617,056 bytes consed
- (time (count-inversions-6 (make-long-array 10000)))
- ;; Evaluation took:
- ;; 0.171 seconds of real time
- ;; 0.172010 seconds of total run time (0.168010 user, 0.004000 system)
- ;; 100.58% CPU
- ;; 478,246,785 processor cycles
- ;; 1,584,240 bytes consed
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement