fork download
copy 
  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)
  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 (< a b))))
  24. 	   (count-inversions left-list)
  25. 	   (count-inversions right-list)))))
  26.  
  27. (defun count-inversions-6 (x)
  28.   (declare (optimize (speed 3)
  29. 		     (compilation-speed 0)
  30. 		     (debug 0)
  31. 		     (safety 0))
  32. 	   (ftype (function ((simple-array fixnum (*)))
  33. 			    (unsigned-byte 32))
  34. 		  count-inversions-6)
  35. 	   (type (simple-array fixnum (*)) x))
  36.   (if (< (length x) 2)
  37.       0
  38.       (let* ((half-a (ash (length x) -1))
  39. 	     (left-array (subseq x 0 half-a))
  40. 	     (half-b (- (length x) half-a))
  41.              (right-array (subseq x half-a))
  42. 	     (current 0)
  43. 	     (total 0))
  44. 	(declare (type (unsigned-byte 32) half-a)
  45. 		 (type (unsigned-byte 32) half-b)
  46. 		 (type fixnum current)
  47.       		 (type (simple-array fixnum (*)) right-array)
  48. 		 (type (simple-array fixnum (*)) left-array)
  49.       		 (type (unsigned-byte 32) total))
  50. 	(the (unsigned-byte 32)
  51. 	  (+
  52. 	   (dotimes (i half-a total)
  53. 	     (setq current (aref left-array i))
  54. 	     (dotimes (j half-b)
  55. 	       (when (>= current
  56. 			 (the fixnum (aref right-array j)))
  57. 		 (setq total (the (unsigned-byte 32) (+ total 1))))))
  58. 	   (count-inversions-6 left-array)
  59. 	   (count-inversions-6 right-array))))))
  60.  
  61. (time (make-long-list 1000))
  62.  
  63. ;; Evaluation took:
  64. ;;   0.000 seconds of real time
  65. ;;   0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  66. ;;   100.00% CPU
  67. ;;   881,214 processor cycles
  68. ;;   159,744 bytes consed
  69.  
  70. (time (make-long-array 1000))
  71.  
  72. ;; Evaluation took:
  73. ;;   0.000 seconds of real time
  74. ;;   0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  75. ;;   100.00% CPU
  76. ;;   806,562 processor cycles
  77. ;;   80,016 bytes consed
  78.  
  79. (time (count-inversions (make-long-list 1000)))
  80.  
  81. ;; Evaluation took:
  82. ;;   0.313 seconds of real time
  83. ;;   0.312019 seconds of total run time (0.308019 user, 0.004000 system)
  84. ;;   [ Run times consist of 0.008 seconds GC time, and 0.305 seconds non-GC time. ]
  85. ;;   99.68% CPU
  86. ;;   875,653,434 processor cycles
  87. ;;   3,038,576 bytes consed
  88.  
  89. (time (count-inversions-6 (make-long-array 1000)))
  90.  
  91. ;; Evaluation took:
  92. ;;   0.178 seconds of real time
  93. ;;   0.180011 seconds of total run time (0.180011 user, 0.000000 system)
  94. ;;   101.12% CPU
  95. ;;   500,373,921 processor cycles
  96. ;;   1,586,080 bytes consed
Success #stdin #stdout 2.24s 10576KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Real time: 0.001355 sec.
Run time: 0.002 sec.
Space: 8000 Bytes
Real time: 0.001917 sec.
Run time: 0.002 sec.
Space: 4176 Bytes
Real time: 0.854696 sec.
Run time: 0.85387 sec.
Space: 91392 Bytes
Real time: 1.362522 sec.
Run time: 1.358793 sec.
Space: 6170416 Bytes
GC: 12, GC time: 0.031996 sec.
https://ideone.com/ufhJ6
language:
Common Lisp (clisp 2.49.92)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!