Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Comparison of inversion finding functions

By: a guest on Jun 20th, 2012  |  syntax: Lisp  |  size: 9.60 KB  |  views: 37  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defun make-long-list (x)
  2.   (do* ((y (make-list x))
  3.         (i y (cdr i)))
  4.        (nil)
  5.     (when (null i) (return y))
  6.     (rplaca i (random 1000))))
  7.  
  8. (defun make-long-array (x)
  9.   (do* ((y (make-array x :element-type 'fixnum))
  10.         (i 0 (1+ i)))
  11.        (nil)
  12.     (when (= x i) (return y))
  13.     (setf (aref y i) (random 1000))))
  14.  
  15. (defun count-inversions (lst &optional (predicate #'<))
  16.   (if (or (null lst) (null (cdr lst)))
  17.       0
  18.       (let* ((half (ceiling (/ (length lst) 2)))
  19.              (left-list (subseq lst 0 half))
  20.              (right-list (subseq lst half)))
  21.         (+ (loop for a in left-list
  22.               summing (loop for b in right-list
  23.                          counting (not (funcall predicate a b))))
  24.            (count-inversions left-list predicate)
  25.            (count-inversions right-list predicate)))))
  26.  
  27. (defun count-inversions-1 (x &optional (predicate #'<) (len (length x)))
  28.   (if (or (null x) (null (cdr x)))
  29.       0
  30.       (let* ((half-a (1- (ash len -1)))
  31.              (half-b (- len half-a))
  32.              (right-list (split-in-two! x)))
  33.         (+ (loop for a in x
  34.                 summing (loop for b in right-list
  35.                              counting (not (funcall predicate a b))))
  36.            (count-inversions-1 x predicate half-a)
  37.            (count-inversions-1 right-list predicate half-b)))))
  38.  
  39. (defun split-in-two! (x &optional (len (length x)))
  40.   (setq len (1- (ash len -1)))
  41.   (do ((c x (cdr c))
  42.        (r)
  43.        (i 0 (1+ i)))
  44.       (nil)
  45.     (when (= i len)
  46.       (setq r (cdr c))
  47.       (rplacd c nil)
  48.        (return r))))
  49.  
  50. ;; Note that you get a lot of bad optimization warnings, we'll fix that next
  51. (defun count-inversions-2 (lst &optional (predicate #'<))
  52.   (declare (optimize (speed 3)
  53.            (compilation-speed 0)
  54.            (debug 0)
  55.            (safety 0)))
  56.   (declare (type list lst))
  57.   (declare (type (function (fixnum fixnum)) predicate))
  58.   (if (or (null lst) (null (cdr lst)))
  59.       0
  60.       (let* ((half (the fixnum (ceiling (/ (the fixnum (length lst)) 2))))
  61.         (left-list (subseq lst 0 half))
  62.         (right-list (subseq lst half)))
  63.    (declare (type fixnum half))
  64.    (declare (type list left-list))
  65.    (declare (type list right-list))
  66.    (+ (the bignum (loop for a in left-list
  67.            summing (loop for b in right-list
  68.                  counting (not (funcall
  69.                       (the function predicate)
  70.                       (the fixnum a)
  71.                       (the fixnum b))))))
  72.       (the bignum (count-inversions-2 left-list predicate))
  73.       (the bignum (count-inversions-2 right-list predicate))))))
  74.  
  75.  ;; (ftype (function (list function) bignum) count-inversions-3)
  76.  
  77. (defun count-inversions-3 (lst &optional (predicate #'<))
  78.   (declare (optimize (speed 3)
  79.                      (compilation-speed 0)
  80.                      (debug 0)
  81.                      (safety 0))
  82.            (type list lst)
  83.            (ftype (function (list function) integer) count-inversions-3)
  84.            (type (function (fixnum fixnum) boolean) predicate))
  85.   (if (or (null lst) (null (cdr lst)))
  86.       0
  87.       (let* ((len (length lst))
  88.              (half (the (unsigned-byte 32) (- len (ash len -1))))
  89.              (left-list (subseq lst 0 half))
  90.              (right-list (subseq lst half))
  91.              (total 0))
  92.         (declare (type (unsigned-byte 32) len)
  93.                  (type (unsigned-byte 32) half)
  94.                  (type list left-list)
  95.                  (type list right-list)
  96.                  (type integer total))
  97.         (the integer
  98.           (+
  99.            (dolist (i left-list total)
  100.              (dolist (j right-list)
  101.                (when (not (funcall
  102.                            predicate
  103.                            (the fixnum i)
  104.                            (the fixnum j)))
  105.                  (setq total (the (unsigned-byte 32) (+ total 1))))))
  106.            (count-inversions-3 left-list predicate)
  107.            (count-inversions-3 right-list predicate))))))
  108.  
  109. (defun count-inversions-4 (x &optional (predicate #'<) (len (length x)))
  110.   (declare (optimize (speed 3)
  111.                      (compilation-speed 0)
  112.                      (debug 0)
  113.                      (safety 0))
  114.            (ftype (function (list function (unsigned-byte 32)) (unsigned-byte 32))
  115.                   count-inversions-4)
  116.            (type (function (fixnum fixnum) boolean) predicate)
  117.            (type list x)
  118.            (type (unsigned-byte 32) len)
  119.            (inline split-in-two!-1))
  120.   (if (or (null x) (null (cdr x)))
  121.       0
  122.       (let* ((half-a (1- (ash len -1)))
  123.              (half-b (- len half-a))
  124.              (right-list (split-in-two!-1 x))
  125.              (total 0))
  126.         (declare (type (unsigned-byte 32) half-a)
  127.                  (type (unsigned-byte 32) half-b)
  128.                  (type list right-list)
  129.                  (type (unsigned-byte 32) total))
  130.         (the integer
  131.           (+
  132.            (dolist (i x total)
  133.              (dolist (j right-list)
  134.                (when (not (funcall
  135.                            predicate
  136.                            (the fixnum i)
  137.                            (the fixnum j)))
  138.                  (setq total (the (unsigned-byte 32) (+ total 1))))))
  139.            (count-inversions-4 x predicate half-a)
  140.            (count-inversions-4 right-list predicate half-b))))))
  141.  
  142. (defun split-in-two!-1 (x &optional (len (length x)))
  143.   (declare (optimize (speed 3)
  144.                      (compilation-speed 0)
  145.                      (debug 0)
  146.                      (safety 0))
  147.            (ftype (function (list (unsigned-byte 32)) list) split-in-two!-1)
  148.            (type list x)
  149.            (type (unsigned-byte 32) len))
  150.   (setq len (1- (ash len -1)))
  151.   (do ((c x (cdr c))
  152.        (r)
  153.        (i 0 (1+ i)))
  154.       (nil)
  155.     (declare (type list c)
  156.              (type (unsigned-byte 32) i)
  157.              (type list r))
  158.     (when (= i len)
  159.       (setq r (cdr c))
  160.       (rplacd c nil)
  161.       (return r))))
  162.  
  163. (defun count-inversions-5 (x &optional (predicate #'<))
  164.   (declare (optimize (speed 3)
  165.                      (compilation-speed 0)
  166.                      (debug 0)
  167.                      (safety 0))
  168.            (ftype (function ((simple-array fixnum (*)) function)
  169.                             (unsigned-byte 32))
  170.                   count-inversions-5)
  171.            (type (function (fixnum fixnum) boolean) predicate)
  172.            (type (simple-array fixnum (*)) x))
  173.   (if (< (length x) 2)
  174.       0
  175.       (let* ((half-a (ash (length x) -1))
  176.              (left-array (subseq x 0 half-a))
  177.              (half-b (- (length x) half-a))
  178.              (right-array (subseq x half-a))
  179.              (current 0)
  180.              (total 0))
  181.         (declare (type (unsigned-byte 32) half-a)
  182.                  (type (unsigned-byte 32) half-b)
  183.                  (type fixnum current)
  184.                  (type (simple-array fixnum (*)) right-array)
  185.                  (type (simple-array fixnum (*)) left-array)
  186.                  (type (unsigned-byte 32) total))
  187.         (the (unsigned-byte 32)
  188.           (+
  189.            (dotimes (i half-a total)
  190.              (setq current (aref left-array i))
  191.              (dotimes (j half-b)
  192.                (when (not (funcall
  193.                            predicate
  194.                            current
  195.                            (the fixnum (aref right-array j))))
  196.                  (setq total (the (unsigned-byte 32) (+ total 1))))))
  197.            (count-inversions-5 left-array predicate)
  198.            (count-inversions-5 right-array predicate))))))
  199.  
  200. (defun count-inversions-6 (x)
  201.   (declare (optimize (speed 3)
  202.                      (compilation-speed 0)
  203.                      (debug 0)
  204.                      (safety 0))
  205.            (ftype (function ((simple-array fixnum (*)))
  206.                             (unsigned-byte 32))
  207.                   count-inversions-6)
  208.            (type (simple-array fixnum (*)) x))
  209.   (if (< (length x) 2)
  210.       0
  211.       (let* ((half-a (ash (length x) -1))
  212.              (left-array (subseq x 0 half-a))
  213.              (half-b (- (length x) half-a))
  214.              (right-array (subseq x half-a))
  215.              (current 0)
  216.              (total 0))
  217.         (declare (type (unsigned-byte 32) half-a)
  218.                  (type (unsigned-byte 32) half-b)
  219.                  (type fixnum current)
  220.                  (type (simple-array fixnum (*)) right-array)
  221.                  (type (simple-array fixnum (*)) left-array)
  222.                  (type (unsigned-byte 32) total))
  223.         (the (unsigned-byte 32)
  224.           (+
  225.            (dotimes (i half-a total)
  226.              (setq current (aref left-array i))
  227.              (dotimes (j half-b)
  228.                (when (>= current
  229.                          (the fixnum (aref right-array j)))
  230.                  (setq total (the (unsigned-byte 32) (+ total 1))))))
  231.            (count-inversions-6 left-array)
  232.            (count-inversions-6 right-array))))))
  233.  
  234. (time (make-long-list 10000))
  235.  
  236. ;; Evaluation took:
  237. ;;   0.000 seconds of real time
  238. ;;   0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  239. ;;   100.00% CPU
  240. ;;   865,284 processor cycles
  241. ;;   159,744 bytes consed
  242.  
  243. (time (count-inversions (make-long-list 10000)))
  244.  
  245. ;; Evaluation took:
  246. ;;   2.548 seconds of real time
  247. ;;   2.540159 seconds of total run time (2.536159 user, 0.004000 system)
  248. ;;   99.69% CPU
  249. ;;   7,126,743,462 processor cycles
  250. ;;   3,080,976 bytes consed
  251.  
  252. (time (count-inversions-1 (make-long-list 10000)))
  253.  
  254. ;; Evaluation took:
  255. ;;   2.528 seconds of real time
  256. ;;   2.520157 seconds of total run time (2.520157 user, 0.000000 system)
  257. ;;   99.68% CPU
  258. ;;   7,074,236,361 processor cycles
  259. ;;   194,672 bytes consed
  260.  
  261. (time (count-inversions-2 (make-long-list 10000)))
  262.  
  263. ;; Evaluation took:
  264. ;;   2.423 seconds of real time
  265. ;;   2.416151 seconds of total run time (2.416151 user, 0.000000 system)
  266. ;;   99.71% CPU
  267. ;;   6,781,155,228 processor cycles
  268. ;;   3,076,880 bytes consed
  269.  
  270. (time (count-inversions-3 (make-long-list 10000)))
  271.  
  272. ;; Evaluation took:
  273. ;;   2.290 seconds of real time
  274. ;;   2.280143 seconds of total run time (2.280143 user, 0.000000 system)
  275. ;;   99.56% CPU
  276. ;;   6,407,376,423 processor cycles
  277. ;;   2,647,840 bytes consed
  278.  
  279. (time (count-inversions-4 (make-long-list 10000)))
  280.  
  281. ;; Evaluation took:
  282. ;;   2.294 seconds of real time
  283. ;;   2.284143 seconds of total run time (2.284143 user, 0.000000 system)
  284. ;;   99.56% CPU
  285. ;;   6,417,973,587 processor cycles
  286. ;;   190,128 bytes consed
  287.  
  288. (time (count-inversions-5 (make-long-array 10000)))
  289.  
  290. ;; Evaluation took:
  291. ;;   2.326 seconds of real time
  292. ;;   2.316144 seconds of total run time (2.316144 user, 0.000000 system)
  293. ;;   99.57% CPU
  294. ;;   6,506,879,880 processor cycles
  295. ;;   1,617,056 bytes consed
  296.  
  297. (time (count-inversions-6 (make-long-array 10000)))
  298.  
  299. ;; Evaluation took:
  300. ;;   0.171 seconds of real time
  301. ;;   0.172010 seconds of total run time (0.168010 user, 0.004000 system)
  302. ;;   100.58% CPU
  303. ;;   478,246,785 processor cycles
  304. ;;   1,584,240 bytes consed
clone this paste RAW Paste Data