language: Common Lisp (clisp) (clisp 2.47)
date: 363 days 14 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

(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