mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'fix/stable-inline-sort-on-vectors' into 'develop'

Browse source 
New inline stable sort for vectors

This PR should improve on the current stable sorting of vectors, fixing issues such as #217 (bug) and #101 (performance).

Full disclosure: The merge sort algorithm was completely stolen from sbcl.

I'm sure the new version can be optimized, for example by inlining `stable-sort-merge-vectors`, and by treating simple-arrays differently.

But for now, it already has slightly better performance on the sequences that I tested with, for example running:

```common-lisp
(time (dotimes (x 50000)
	(defparameter *my-arr* 
		(make-array 9 :initial-contents
		(list
		  (cons 3 'a)
		  (cons 2 'b)
		  (cons 2 'c)
		  (cons 2 'd)
		  (cons 3 'e)
		  (cons 2 'f)
		  (cons 2 'g)
		  (cons 2 'h)
		  (cons 1 'i))))

	(stable-sort *my-arr* #'< :key #'car)))
```

gave me 0.34 sec in the old version, and 0.28sec in the new one (even with the overhead of the make-array call, which is the same for both). But most importantly, the new version leaves the array sorted, which fixes bug #217:

```common-lisp
> *my-arr*
#A(T (9) ((1 . I) (2 . B) (2 . C) (2 . D) (2 . F) (2 . G) (2 . H) (3 . A) (3 . E)))
```

while in the old-version:
```common-lisp
> *my-arr*
#A(T (9) ((3 . A) (2 . B) (2 . C) (2 . D) (3 . E) (2 . F) (2 . G) (2 . H) (1 . I)))
```

The example in #217 also works now, of course:
```common-lisp
> (let ((a (copy-seq "BCA")))
        (stable-sort a #'char<)
        a)

"ABC"
```

See merge request !28
This commit is contained in:
Daniel Kochmański 2016-07-28 16:13:23 +00:00
commit 6930c315a6
1 changed files with 88 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

93
src/lsp/seqlib.lsp
View file

@ -1,6 +1,5 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: SYSTEM -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
;;;;
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
;;;; Copyright (c) 1990, Giuseppe Attardi.
@ -871,6 +870,93 @@ evaluates to NIL. See STABLE-SORT."
seq))
(defun stable-sort-merge-vectors (source target start-1
end-1 end-2 pred key)
(let ((i start-1)
(j end-1) ; start-2
(target-i start-1))
(declare (fixnum i j target-i))
(loop
(cond ((= i end-1)
(loop (if (= j end-2) (return))
(setf (aref target target-i)
(aref source j))
(incf target-i)
(incf j))
(return))
((= j end-2)
(loop (if (= i end-1) (return))
(setf (aref target target-i)
(aref source i))
(incf target-i)
(incf i))
(return))
((if key
(funcall pred (funcall key (aref source j))
(funcall key (aref source i)))
(funcall pred (aref source j) (aref source i)))
(setf (aref target target-i)
(aref source j))
(incf j))
(t (setf (aref target target-i)
(aref source i))
(incf i)))
(incf target-i))))
(defun vector-merge-sort (vector pred key)
(let* ((vector-len (length (the vector vector)))
(n 1) ; bottom-up size of contiguous runs to be merged
(direction t) ; t vector --> temp nil temp --> vector
(temp (make-array vector-len))
(unsorted 0) ; unsorted..vector-len are the elements that need
; to be merged for a given n
(start-1 0)) ; one n-len subsequence to be merged with the next
(declare (fixnum vector-len n unsorted start-1))
(loop
;; for each n we start taking n-runs from the start of the vector
(setf unsorted 0)
(loop
(setf start-1 unsorted)
(let ((end-1 (+ start-1 n)))
(declare (fixnum end-1))
(cond ((< end-1 vector-len)
;; there are enough elements for a second run
(let ((end-2 (+ end-1 n)))
(declare (fixnum end-2))
(if (> end-2 vector-len) (setf end-2 vector-len))
(setf unsorted end-2)
(if direction
(stable-sort-merge-vectors
vector temp start-1 end-1 end-2 pred key)
(stable-sort-merge-vectors
temp vector start-1 end-1 end-2 pred key))
(if (= unsorted vector-len) (return))))
;; if there is only one run copy those elements to the end
(t (if direction
(do ((i start-1 (1+ i)))
((= i vector-len))
(declare (fixnum i))
(setf (aref temp i) (aref vector i)))
(do ((i start-1 (1+ i)))
((= i vector-len))
(declare (fixnum i))
(setf (aref vector i) (aref temp i))))
(return)))))
;; If the inner loop only executed once then there were only enough
;; elements for two subsequences given n so all the elements have
;; been merged into one list. Start-1 will have remained 0 upon exit.
(when (zerop start-1)
(when direction
;; if we just merged into the temporary copy it all back
;; to the given vector.
(dotimes (i vector-len)
(setf (aref vector i) (aref temp i))))
(return vector))
(setf n (ash n 1)) ; (* 2 n)
(setf direction (not direction)))))
(defun stable-sort (sequence predicate &key key)
"Args: (sequence test &key key)
Destructively sorts SEQUENCE and returns the result. TEST should return non-
@ -886,10 +972,7 @@ SEQUENCE. See SORT."
(list-merge-sort sequence predicate key)
(if (bit-vector-p sequence)
(sort sequence predicate :key key)
(coerce (list-merge-sort (coerce sequence 'list)
predicate
key)
(seqtype sequence)))))
(vector-merge-sort sequence predicate key))))
(defun merge (result-type sequence1 sequence2 predicate &key key