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
|
#+kcl
(defmacro while (cond &rest body)
`(do ()
((not ,cond))
. ,body))
(defun partition (key nl)
(let (left right)
(dolist (x nl)
(if (< x key) (push x left) (push x right)))
(cons left (cons right nil))))
(defun qsort (nl rest)
(if (null nl)
rest
(let (list left right)
(setq list (partition (car nl) (cdr nl)))
(setq left (car list) right (cadr list))
(qsort left (cons (car nl) (qsort right rest))))))
(defun sequence-qsort (vec &optional (start 0) (end (1- (length vec))))
(declare (integer start end))
(let (key (i start) (j end))
(declare (type integer i j))
(when (< start end)
(while (< i j)
(setq key (elt vec i))
(while (and (< i j) (<= key (elt vec j))) (decf j))
(when (/= i j) (setf (elt vec i) (elt vec j))
(setf (elt vec j) key))
(while (and (< i j) (>= key (elt vec i))) (incf i))
(when (/= i j) (setf (elt vec j) (elt vec i))
(setf (elt vec i) key)) )
(sequence-qsort vec start j)
(sequence-qsort vec (1+ i) end)
) ))
(defun vector-qsort (vec &optional (start 0) (end (1- (length vec))))
(declare (integer start end))
(let (key (i start) (j end))
(declare (type integer i j))
(when (< start end)
(while (< i j)
(setq key (aref vec i))
(while (and (< i j) (<= key (aref vec j))) (decf j))
(when (/= i j) (setf (aref vec i) (aref vec j))
(setf (aref vec j) key))
(while (and (< i j) (>= key (aref vec i))) (incf i))
(when (/= i j) (setf (aref vec j) (aref vec i))
(setf (aref vec i) key)) )
(vector-qsort vec start j)
(vector-qsort vec (1+ i) end)
) ))
#+eus
(defmethod vector
(:sort (start end)
(let (key (i start) (j end))
(when (< start end)
(while (< i j)
(setq key (svref self i))
(while (and (< i j) (<= key (svref self j))) (decf j))
(when (/= i j) (svset self i (svref self j)) (svset self j key))
(while (and (< i j) (>= key (svref self i))) (incf i))
(when (/= i j) (svset self j (svref self i)) (svset self i key)) )
(send self :sort start j)
(send self :sort (1+ i) end)
) )) )
(defun bench (n)
(let* (tm1 tm2 tm3
(v (apply #'vector x))
(xxx (copy-seq v)))
(setq tm1 (get-internal-run-time))
(dotimes (i n) (replace xxx v) (vector-qsort xxx))
(setq tm2 (get-internal-run-time))
(* 0.0167 (- tm2 tm1))))
(setq x '(32 87 22 99 64 11 60 17 78 9 48 85 35 78 15 47 12 2 97 83 10 34 12 2 48 48 80 5 50 30 53 65 61 51 23 93 60 33 48 8 80 4 44 4 44 16 49 45 69 62 57 7 54 96 70 31 69 77 67 68 53 70 85 16 38 66 65 56 32 7 8 50 41 48 95 9 70 2 43 82 61 89 6 58 22 44 53 98 66 67 68 18 20 35 4 61 85 38 31 78 1))
(setq xx '(5807 5786 3318 1212 5272 4180 961 7532 5978 3095 6835 2318 846 7773 4186 1566 7592 7982 9801 5513 8215 2051 5718 1442 4061 1670 1163 5257 1285 8092 3950 5058 1529 5022 9686 6925 939 3942 518 8876 1119 6900 4986 890 4726 9646 7796 2200 7020 3356 4810 7572 1381 6743 8 660 9898 6980 9078 9003 113 9205 9019 3932 1543 1232 5956 2237 3348 4994 9223 454 262 6059 9703 8211 2555 616 4018 3179 7333 8468 4190 6342 9936 5162 9084 5024 2795 5069 9807 273 4067 5338 5116 773 4026 2884 5029 3746 5094 9034 4805 3750 2909 9883 7088 7578 4788 1840 5627 515 6938 7893 9144 9172 8631 8836 1527 5280 6326 7582 3887 4839 1208 2731 2764 7542 3113 8238 5815 2566 2408 9210 4017 1776 9358 4039 6382 8567 405 979 6472 6679 9799 3365 7847 5193 8017 3646 9777 3676 9858 8582 3030 364 1854 9093 4766 9963 2487 437 9155 9771 8707 5506 7390 397 7268 3973 4724 2601 785 7637 8670 5019 2174 1460 8732 9455 826 6244 4438 4917 2636 2443 1628 7535 9658 1941 2327 8449 3998 1538 7217 2969 2565 5946 1841 2662 2017 1026 4143 3405 6743 8368 6392 947 1878 7727 4753 5692 270 3800 3935 7626 9155 1937 7976 3587 3352 4022 5262 3284 6331 494 1377 9008 5091 8624 6135 1153 5837 6236 5765 7338 3734 6248 1254 4872 5095 2268 3622 2720 5254 2059 4525 1318 822 1514 222 3200 4159 797 1311 9067 8711 76 3567 7825 1719 9551 4190 3328 751 6850 6257 8613 219 27 4308 1899 5726 1758 9026 9475 7500 6730 5657 3876 8911 781 2046 1788 3864 4997 9563 3412 4640 7746 6105 2410 3423 1322 1243 4883 293 521 1494 4401 4196 7839 9634 3280 2275 2915 7820 3674 5591 3183 5685 4542 3798 3176 3068 6163 8552 3249 2971 4902 684 5472 5002 9921 2335 7604 7859 6117 5020 2203 2450 4810 2891 494 4539 4626 7276 2410 8192 9114 921 9476 2934 7405 5494 4835 8976 7585 3012 9776 4972 5310 5289 3485 1740 8920 6782 8449 6802 6304 6805 8744 8320 2752 624 9337 1352 5878 4258 8229 3813 6606 564 7699 7111 411 462 8654 6385 2199 800 2164 5211 1066 2643 2989 8536 7746 737 1415 7745 1078 6931 6170 1863 8697 9823 3668 5820 8030 7245 7474 8956 3534 2062 8633 6078 4867 9727 8549 7423 3848 4967 4196 9367 8992 6575 2812 2071 9019 2683 3522 4844 7817 2966 4667 1982 5301 216 2747 7109 1618 7807 5611 9595 7055 5112 4744 2964 463 3270 8912 9040 4270 4459 765 8073 1290 9491 5002 708 5282 8891 9017 2152 4042 9429 6258 8514 6921 1181 7361 4406 1962 4636 2170 5477 5930 5186 6476 8645 796 5714 4256 2049 5682 1169 9850 9949 4786 1352 4365 173 768 6114 7967 1895 3825 7244 176 4263 9018 2261 5958 5123 6164 668 7875 8180 5982 4048 6884 4554 4404 8300 4063 4886 746 2660 6566 3725 9437 3691 6960 2727 4305 8692 668 591 7197 6988 928 9251 2430 6839 365 9697 6866 2747 8239 135 4193 2197 9579 867 6306 2151 7825 7106 4912 5553 4282 4477 1094 3662 2525 4802 8354 5076 2874 8027 7569 922 4061 2196 7542 3989 6055 8001 7771 8818 8588 9632 6435 8220 4987 5017 5054 7823 5274 7594 6150 4575 7809 8953 3518 3142 5858 8121 9176 8757 6849 4084 2163 8811 4619 4219 3328 3474 2010 2346 5911 7674 5539 6804 3826 55 9944 5579 289 6150 6818 2517 7062 2275 3664 5011 4663 7860 2140 9292 3136 8619 3239 8413 446 2540 3296 9773 6283 8923 5129 2097 5683 6225 9917 5581 2726 3176 5594 6492 5805 5371 9164 7988 4379 4398 2396 151 2205 1566 1202 2879 4136 3703 8762 7967 5572 4514 5283 9810 4234 4165 4226 4878 9636 9320 6129 6627 3363 686 8620 6644 3122 9554 1142 2465 838 5933 7989 4153 3341 250 5740 2951 7187 7379 4719 7378 3838 4845 6815 2155 35 7727 8587 9385 1017 7102 2966 6247 2094 326 791 9799 567 3303 4717 3877 4445 2815 9328 812 3840 1384 8473 8103 3103 5941 1327 7193 7139 2330 4409 4130 142 497 6102 4804 3081 4901 868 6281 2293 3397 1828 9884 2863 7757 6204 6471 114 4296 8749 3782 1348 3216 3251 4960 9342 6612 2871 4953 3440 4224 1797 2381 3079 1555 5966 1819 151 667 620 9960 8881 600 589 6619 6222 2877 2677 2392 8702 982 2639 1515 7958 9097 5099 5150 1966 9962 8679 4133 244 9792 9558 4952 2775 7158 948 237 5436 4947 8503 8753 1477 9785 9581 6507 3954 1021 8567 2982 8410 3527 9126 6303 7034 1850 4217 764 3742 1738 4909 5926 6083 2657 2440 574 1795 7901 4237 8200 614 8392 2886 5182 1196 615 7786 4169 7574 6814 7461 4816 3582 6998 7829 2421 9292 3171 8916 3280 3377 9119 2170 8881 5003 6933 9386 181 9445 9036 5852 8007 2168 1812 7263 6613 6067 1150 6811 9033 8424 8296 4099 5454 5875 5905 6678 8377 3143 3083 2510 975 878 6371 3947 1396 9064 2154 1243 5657 9765 8951 3623 3538 9477 3765 4736 5030 91 1334 5352 2379 4800 4372 1558 3925 2824 4882 807 8256 4289 4414 9141 9804 4052 4923 862 2056 3847 1980 1179 806 4405 824 3746 4275 9669 682 8947 7779 929 8407 6989 9724 9587 3538 8635 936 8774 53 8520 7170 9581 7321 3556 2764 1136 2860 5746 2827 1968 1703 2784 9553 5382 2429 5904 925 4236 4542 6448 4294 1226 9228 6292 3574 3402 8908 2432 3812 3210 6043 9319 5809 128 8857 9832 2728 4560 8822 4530 102 9598 9540 878 6364 2716 9116 7963 7650 2392 3073 5521 3794 8561 4502 8252 1510 8245 4524 1125 1153 1462 3663 9012 9089 8675 2568 4040 3760 843 5326 7967 8597 996))
|
