Advertisement
Guest User

Comparison of inversion finding functions

a guest
Jun 20th, 2012
141
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 9.60 KB | None | 0 0
  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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement