I was talking to a programmer about lisp and he mentioned someone
writing qsort in haskell and python in 5 or 6 lines of code. Well I
found this evidence
http://mail.python.org/pipermail/python-list/2003-June/168593.html
I thought if any of you are looking for something to do for kicks how
about coming up with a brief version in lisp?
As a starter heres a basic implentation with a couple of optimizations
but no attempt at bevity... 11 lines of main code with 11 lines of
assistance
;;; quick sort on a list
; given a list return three lists
; a list of items less than pivot, a list of items the same and a list
of items
; greater than it...
(defun partition(lst pivot)
(let ((less nil) (same nil) (grtr nil))
(loop for item in lst do
(if (eql item pivot)
(setf same (cons item same))
(if (< item pivot)
(setf less (cons item less))
(setf grtr (cons item grtr)))))
(values less same grtr)))
; fast way to answer this question compared to (> (length lst) 1)
; since length must walk the whole list just to find the length
(defun more-than-one-element(lst)
(not (null (car (cdr lst)))))
(defun qsort(lst)
(labels ((qsorter (lst pivot)
(if (more-than-one-element lst)
(multiple-value-bind (less-lst same-lst
greater-lst)
(partition lst pivot)
(append
(qsorter less-lst (car lst))
same-lst
(qsorter greater-lst (car lst))))
lst)))
(qsorter lst (car lst))))
; helper: generate random number list to sort of length n
(defun get-random-list(n)
(loop for x from 1 to n collect
(random 10000)))
; (time (progn (qsort (get-random-list 100000)) nil))
I guess this partition is shorter, but less efficient.
(defun partition(lst pivot)
(values (remove-if #'(lambda(n) (>= n pivot)) lst)
(remove-if #'(lambda(n) (not (eq n pivot))) lst)
(remove-if #'(lambda(n) (<= n pivot)) lst)))
Is there any built in function than can split a list into different
components based on a function?
Using the SETL package
(defun partition (list pivot)
(values [x in list / (< x pivot)] [x in list / (> x pivot)]))
And without using partition at all
(defun qsort (list)
(when list
(append (qsort [x in list / (< x (first list))]) (list (first
list)) (qsort [x in list / (> x (first list))]))))
This beats Python (as if...)
If you do not want to use the SETL package
(defun qsort (list)
(when list
(append (qsort (remove-if (lambda (x) (> x (first list))) list)
(list (first list))
(qsort (remove-if (lambda (x) (< x (first list))) list))))
Same line count of Haskell.
But then again, why rewrite it when SORT is built in in CL?
Cheers
--
Marco
Marco Antoniotti wrote:
> If you do not want to use the SETL package
It seems fair to only use standard CL
> (defun qsort (list)
> (when list
> (append (qsort (remove-if (lambda (x) (> x (first list))) list)
> (list (first list))
> (qsort (remove-if (lambda (x) (< x (first list))) list))))
I had trouble with this. I had to change list to lst to eval it, and
add a bracket at the end.
Once I'd done that it over-flowed (flew?) the stack so I think the exit
condition is not working.
Although if it can be made to work it wins.
> Same line count of Haskell.
> But then again, why rewrite it when SORT is built in in CL?
For kicks.
Justin
justinhj wrote:
> Marco Antoniotti wrote:
> > If you do not want to use the SETL package
>
> It seems fair to only use standard CL
>
> > (defun qsort (list)
> > (when list
> > (append (qsort (remove-if (lambda (x) (> x (first list))) list)
> > (list (first list))
> > (qsort (remove-if (lambda (x) (< x (first list))) list))))
>
> I had trouble with this. I had to change list to lst to eval it, and
> add a bracket at the end.
It is buggy. Sorry. Here is a better version
(defun qsort (list &aux (x (first list)) (xs (rest list)))
(when list
(append (qsort (remove-if (lambda (y) (>= y x)) xs))
(list x)
(qsort (remove-if (lambda (y) (< y x)) xs)))))
This *was* tested :)
--
Marco
If it wasn't for google's line length...
(defun qsort(list)
(when ...
(let ...
(append ...))))
(defun qsort(list)
(when list
(let ((sorted-partitions
(mapcar #'qsort
(loop for x in (cdr list)
if (< x (car list)) collect x into ls
else collect x into ge
finally return (list ls ge)))))
(append (car sorted-partitions)
(list (car list))
(cadr sorted-partitions)))))
---
Geoff
Geoffrey Summerhayes wrote:
> If it wasn't for google's line length...
>
> (defun qsort(list)
> (when ...
> (let ...
> (append ...))))
>
> (defun qsort(list)
> (when list
> (let ((sorted-partitions
> (mapcar #'qsort
> (loop for x in (cdr list)
> if (< x (car list)) collect x into ls
> else collect x into ge
> finally return (list ls ge)))))
> (append (car sorted-partitions)
> (list (car list))
> (cadr sorted-partitions)))))
Here is a variation with a little CLOS added. ;)
(defgeneric qsort (sequence)
(:method ((sequence null)) '())
(:method ((sequence cons))
(loop with pivot = (first sequence)
for x in (rest sequence)
if (< x pivot) collect x into ls
else collect x into ge
finally (return (nconc (qsort ls) (cons pivot (qsort ge)))))))
Adding a method for vectors is left as an exercise to the reader. ;)
Comment about the code above: It should be "finally (return ...", not
"finally return ...". The latter is not specificed in ANSI CL.
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
"Pascal Costanza" <··@p-cos.net> wrote
> Here is a variation with a little CLOS added. ;)
>
> (defgeneric qsort (sequence)
> (:method ((sequence null)) '())
> (:method ((sequence cons))
> (loop with pivot = (first sequence)
> for x in (rest sequence)
> if (< x pivot) collect x into ls
> else collect x into ge
> finally (return (nconc (qsort ls) (cons pivot (qsort ge)))))))
And one with ITERATE
(defun qsort (sequence)
(when sequence
(iterate (with (pivot . rest) = sequence)
(for x in rest)
(if (< x pivot)
(collect x into ls)
(collect x into ge))
(finally (return (nconc (qsort ls) (cons pivot (qsort
ge))))))))
> (qsort '(4 5 6 9 8 2 1 4 5 6 0 5 6))
(0 1 2 4 4 5 5 5 6 6 6 8 9)
Common Lisp the multi-paradigms language! ;-)
Marc
Pascal Costanza wrote:
> Geoffrey Summerhayes wrote:
>
> Here is a variation with a little CLOS added. ;)
>
> (defgeneric qsort (sequence)
> (:method ((sequence null)) '())
> (:method ((sequence cons))
> (loop with pivot = (first sequence)
> for x in (rest sequence)
> if (< x pivot) collect x into ls
> else collect x into ge
> finally (return (nconc (qsort ls) (cons pivot (qsort ge)))))))
>
>
> Adding a method for vectors is left as an exercise to the reader. ;)
Ok I did it... vector-partition is perhaps the ugliest part of it, but
it works ;-)
Nice to see the output showing very small amount of cons'ing for the
vector in-place sort, but surprising how little difference in speed
there is. This is compiled code under lispworks
Timing the evaluation of (PROGN (QSORT TEST-VECTOR) NIL)
user time = 1.187
system time = 0.000
Elapsed time = 0:00:01
Allocation = 16 bytes standard / 110 bytes conses
0 Page faults
Timing the evaluation of (PROGN (QSORT TEST-LIST) NIL)
user time = 1.015
system time = 0.000
Elapsed time = 0:00:01
Allocation = 24 bytes standard / 25249587 bytes conses
0 Page faults
;;; oop qsort
; from a comp.lang.lisp post by Pascal Costanza
; in place vector qsort by Justin Heyes-Jones
(defun swap-vector-elts(vec a b)
(if (not (= a b))
(let ((tmp (elt vec b)))
(setf (elt vec b) (elt vec a))
(setf (elt vec a) tmp))))
;;;; helper for inplace vector qsort
; in place sort so that items less than pivot are left of pivot, items
equal
; in the middle followed by greater than items...
; returns the first index after the pivot value
(defun vector-partition(vec first-elt last-elt pivot)
(let ((less-insert first-elt) (grtr-insert last-elt) (lesser
first-elt))
(loop for item from first-elt to last-elt do
(let ((x (elt vec item)))
(if (< x pivot)
(progn
(swap-vector-elts vec item lesser)
(setf lesser (1+ lesser)))))
finally
(loop for item from lesser to last-elt do
(let ((x (elt vec item)))
(if (and (= x pivot) (not (= item lesser)))
(progn
(swap-vector-elts vec item lesser)
(setf lesser (1+ lesser)))))))
(loop for item from first-elt to last-elt do
(let ((x (elt vec item)))
(if (> x pivot)
(return-from vector-partition item))))
last-elt))
(defun vector-qsort(vec pivot start end)
(if (> end start)
(let ((split (vector-partition vec start end pivot)))
(vector-qsort vec (elt vec start) start (1- split))
(vector-qsort vec (elt vec split) split end))
vec))
(defgeneric qsort (sequence)
(:method ((sequence null)) '())
(:method ((sequence cons))
(loop with pivot = (first sequence)
for x in (rest sequence)
if (< x pivot) collect x into ls
else collect x into ge
finally (return (nconc (qsort ls) (cons pivot (qsort
ge))))))
(:method ((sequence vector))
(vector-qsort sequence (elt sequence 0) 0 (1- (length
sequence)))))
justinhj wrote:
> (defun swap-vector-elts(vec a b)
> (if (not (= a b))
> (let ((tmp (elt vec b)))
> (setf (elt vec b) (elt vec a))
> (setf (elt vec a) tmp))))
It's better to say svref instead of elt when you know that you are
dealing with (simple) vectors. If you want to say somewhat more general,
use aref. elt is generic in that it also deals with lists, but this
means that it generally has to perform an additional type test at runtime.
Instead of (if (not ...) ...) better say (unless ... ...). Instead of
using a temporary variable, you can just use rotatef. So here we go:
(defun swap-vector-elts (vec a b)
(unless (= a b)
(rotatef (aref vec a) (aref vec b))))
You can probably also just use rotatef itself.
> ;;;; helper for inplace vector qsort
> ; in place sort so that items less than pivot are left of pivot, items
> equal
> ; in the middle followed by greater than items...
> ; returns the first index after the pivot value
>
> (defun vector-partition(vec first-elt last-elt pivot)
> (let ((less-insert first-elt) (grtr-insert last-elt) (lesser
> first-elt))
> (loop for item from first-elt to last-elt do
> (let ((x (elt vec item)))
> (if (< x pivot)
> (progn
> (swap-vector-elts vec item lesser)
> (setf lesser (1+ lesser)))))
> finally
> (loop for item from lesser to last-elt do
> (let ((x (elt vec item)))
> (if (and (= x pivot) (not (= item lesser)))
> (progn
> (swap-vector-elts vec item lesser)
> (setf lesser (1+ lesser)))))))
> (loop for item from first-elt to last-elt do
> (let ((x (elt vec item)))
> (if (> x pivot)
> (return-from vector-partition item))))
> last-elt))
(defun vector-partition (vec first-elt last-elt pivot)
(let ((less-insert first-elt)
(grtr-insert last-elt)
(lesser first-elt))
(loop for item from first-elt to last-elt
for x = (aref vec item)
when (< x pivot) do
(rotatef (aref vec item) (aref vec lesser))
(incf lesser))
(loop for item from lesser to last-elt
for x = (aref vec item)
when (and (= x pivot) (not (= item lesser))) do
(rotatef (aref vec item) (aref vec lesser))
(incf lesser))
(loop for item from first-elt to last-elt
for x = (aref vec item)
when (> x pivot) do
(return-from vector-partition item))
last-elt))
There are probably ways to improve this - I have just edited this for
style (and haven't tested it):
- If your if-test has only one branch, use when or unless. This is a
commonly accepted idiom and saves you an extra progn.
- In a LOOP, you can use multiple for's in parallel, so you don't need a
DO in order to introduce new local variables.
- A DO can be followed by multiple statements - there is no need for a
progn there.
- The FINALLY part was superfluous.
Pascal
> (defun vector-qsort(vec pivot start end)
> (if (> end start)
> (let ((split (vector-partition vec start end pivot)))
> (vector-qsort vec (elt vec start) start (1- split))
> (vector-qsort vec (elt vec split) split end))
> vec))
>
> (defgeneric qsort (sequence)
> (:method ((sequence null)) '())
> (:method ((sequence cons))
> (loop with pivot = (first sequence)
> for x in (rest sequence)
> if (< x pivot) collect x into ls
> else collect x into ge
> finally (return (nconc (qsort ls) (cons pivot (qsort
> ge))))))
> (:method ((sequence vector))
> (vector-qsort sequence (elt sequence 0) 0 (1- (length
> sequence)))))
>
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
Pascal Costanza wrote:
> justinhj wrote:
>
> > (defun swap-vector-elts(vec a b)
> > (if (not (= a b))
> > (let ((tmp (elt vec b)))
> > (setf (elt vec b) (elt vec a))
> > (setf (elt vec a) tmp))))
>
> It's better to say svref instead of elt when you know that you are
> dealing with (simple) vectors. If you want to say somewhat more general,
> use aref. elt is generic in that it also deals with lists, but this
> means that it generally has to perform an additional type test at runtime.
>
> Instead of (if (not ...) ...) better say (unless ... ...). Instead of
> using a temporary variable, you can just use rotatef. So here we go:
>
> (defun swap-vector-elts (vec a b)
> (unless (= a b)
> (rotatef (aref vec a) (aref vec b))))
>
> You can probably also just use rotatef itself.
>
> > ;;;; helper for inplace vector qsort
> > ; in place sort so that items less than pivot are left of pivot, items
> > equal
> > ; in the middle followed by greater than items...
> > ; returns the first index after the pivot value
> >
> > (defun vector-partition(vec first-elt last-elt pivot)
> > (let ((less-insert first-elt) (grtr-insert last-elt) (lesser
> > first-elt))
> > (loop for item from first-elt to last-elt do
> > (let ((x (elt vec item)))
> > (if (< x pivot)
> > (progn
> > (swap-vector-elts vec item lesser)
> > (setf lesser (1+ lesser)))))
> > finally
> > (loop for item from lesser to last-elt do
> > (let ((x (elt vec item)))
> > (if (and (= x pivot) (not (= item lesser)))
> > (progn
> > (swap-vector-elts vec item lesser)
> > (setf lesser (1+ lesser)))))))
> > (loop for item from first-elt to last-elt do
> > (let ((x (elt vec item)))
> > (if (> x pivot)
> > (return-from vector-partition item))))
> > last-elt))
>
> (defun vector-partition (vec first-elt last-elt pivot)
> (let ((less-insert first-elt)
> (grtr-insert last-elt)
> (lesser first-elt))
> (loop for item from first-elt to last-elt
> for x = (aref vec item)
> when (< x pivot) do
> (rotatef (aref vec item) (aref vec lesser))
> (incf lesser))
> (loop for item from lesser to last-elt
> for x = (aref vec item)
> when (and (= x pivot) (not (= item lesser))) do
> (rotatef (aref vec item) (aref vec lesser))
> (incf lesser))
> (loop for item from first-elt to last-elt
> for x = (aref vec item)
> when (> x pivot) do
> (return-from vector-partition item))
> last-elt))
>
> There are probably ways to improve this - I have just edited this for
> style (and haven't tested it):
>
> - If your if-test has only one branch, use when or unless. This is a
> commonly accepted idiom and saves you an extra progn.
> - In a LOOP, you can use multiple for's in parallel, so you don't need a
> DO in order to introduce new local variables.
> - A DO can be followed by multiple statements - there is no need for a
> progn there.
> - The FINALLY part was superfluous.
>
>
> Pascal
>
> > (defun vector-qsort(vec pivot start end)
> > (if (> end start)
> > (let ((split (vector-partition vec start end pivot)))
> > (vector-qsort vec (elt vec start) start (1- split))
> > (vector-qsort vec (elt vec split) split end))
> > vec))
> >
> > (defgeneric qsort (sequence)
> > (:method ((sequence null)) '())
> > (:method ((sequence cons))
> > (loop with pivot = (first sequence)
> > for x in (rest sequence)
> > if (< x pivot) collect x into ls
> > else collect x into ge
> > finally (return (nconc (qsort ls) (cons pivot (qsort
> > ge))))))
> > (:method ((sequence vector))
> > (vector-qsort sequence (elt sequence 0) 0 (1- (length
> > sequence)))))
> >
>
>
> --
> My website: http://p-cos.net
> Closer to MOP & ContextL:
> http://common-lisp.net/project/closer/
Thanks for the tips!
Justin
justinhj wrote:
> Pascal Costanza wrote:
>
>>Geoffrey Summerhayes wrote:
>>
>>Here is a variation with a little CLOS added. ;)
>>
>>(defgeneric qsort (sequence)
>> (:method ((sequence null)) '())
>> (:method ((sequence cons))
>> (loop with pivot = (first sequence)
>> for x in (rest sequence)
>> if (< x pivot) collect x into ls
>> else collect x into ge
>> finally (return (nconc (qsort ls) (cons pivot (qsort ge)))))))
>>
>>
>>Adding a method for vectors is left as an exercise to the reader. ;)
>
> Ok I did it... vector-partition is perhaps the ugliest part of it, but
> it works ;-)
Here is another version, transliterated from equivalent Pico code
written by my boss:
(defmethod qsort ((vector vector))
(labels ((aux (vector low high)
(let* ((left low)
(right high)
(pivot (aref vector (floor (+ left right) 2))))
(loop until (> left right) do
(loop while (< (aref vector left) pivot)
do (incf left))
(loop while (> (aref vector right) pivot)
do (decf right))
(unless (> left right)
(rotatef (aref vector left)
(aref vector right))
(incf left)
(decf right)))
(when (< low right)
(aux vector low right))
(when (> high left)
(aux vector left high)))))
(let ((length (length vector)))
(when (> length 0)
(aux vector 0 (1- length)))))
vector)
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
Pascal Costanza wrote:
> Here is another version, transliterated from equivalent Pico code
> written by my boss:
>
> (defmethod qsort ((vector vector))
> (labels ((aux (vector low high)
> (let* ((left low)
> (right high)
> (pivot (aref vector (floor (+ left right) 2))))
> (loop until (> left right) do
> (loop while (< (aref vector left) pivot)
> do (incf left))
> (loop while (> (aref vector right) pivot)
> do (decf right))
> (unless (> left right)
> (rotatef (aref vector left)
> (aref vector right))
> (incf left)
> (decf right)))
> (when (< low right)
> (aux vector low right))
> (when (> high left)
> (aux vector left high)))))
> (let ((length (length vector)))
> (when (> length 0)
> (aux vector 0 (1- length)))))
> vector)
Olin Shivers in "The Anatomy of a Loop":
(let recur ((l 0) (r (vector-length v)))
(if (> (- r l) 1)
(loop (initial (p (pick-pivot l r))
(i (- l 1))
(j r))
(subloop (incr i from i)
(bind (vi (vector-ref v i)))
(while (< vi p)))
(subloop (decr j from j)
(bind (vj (vector-ref v j)))
(while (> vj p)))
(until (<= j i))
(do (vector-set! v i vj)
(vector-set! v j vi))
(after (recur l i)
(recur (+ j 1) r)))))
It is interesting to compare
(loop while (< (aref vector left) pivot)
do (incf left))
with
(subloop (incr i from i)
(bind (vi (vector-ref v i)))
(while (< vi p)))
The interesting part is the scope rules of
Shivers's loop, which later allows him simply
to write
(vector-set! v j vi)
in stead of (vector-ref v i).
--
Jens Axel S�gaard
Jens Axel S�gaard wrote:
> Olin Shivers in "The Anatomy of a Loop":
>
> (let recur ((l 0) (r (vector-length v)))
> (if (> (- r l) 1)
> (loop (initial (p (pick-pivot l r))
> (i (- l 1))
> (j r))
> (subloop (incr i from i)
> (bind (vi (vector-ref v i)))
> (while (< vi p)))
> (subloop (decr j from j)
> (bind (vj (vector-ref v j)))
> (while (> vj p)))
> (until (<= j i))
> (do (vector-set! v i vj)
> (vector-set! v j vi))
> (after (recur l i)
> (recur (+ j 1) r)))))
>
> It is interesting to compare
>
> (loop while (< (aref vector left) pivot)
> do (incf left))
>
> with
>
> (subloop (incr i from i)
> (bind (vi (vector-ref v i)))
> (while (< vi p)))
>
> The interesting part is the scope rules of
> Shivers's loop, which later allows him simply
> to write
>
> (vector-set! v j vi)
>
> in stead of (vector-ref v i).
(defmethod qsort ((vector vector))
(labels ((aux (vector low high)
(loop with i = low
with j = high
with pivot = (aref vector (floor (+ i j) 2))
with left
with right
until (> i j) do
(loop do (setf left (aref vector i))
while (< left pivot)
do (incf i))
(loop do (setf right (aref vector j))
while (> right pivot)
do (decf j))
(unless (> i j)
(setf (aref vector i) right
(aref vector j) left))
(incf i)
(decf j)
(when (< low j)
(aux vector low j))
(when (> high i)
(aux vector left high)))))
(let ((length (length vector)))
(when (> length 0)
(aux vector 0 (1- length)))))
vector)
?!?
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
On Tue, 27 Dec 2005 19:58:19 +0100, Pascal Costanza <··@p-cos.net> wrote:
> Jens Axel S�gaard wrote:
>
> (defmethod qsort ((vector vector))
> (labels ((aux (vector low high)
> (loop with i = low
> with j = high
> with pivot = (aref vector (floor (+ i j) 2))
> with left
> with right
> until (> i j) do
> (loop do (setf left (aref vector i))
> while (< left pivot)
> do (incf i))
> (loop do (setf right (aref vector j))
> while (> right pivot)
> do (decf j))
> (unless (> i j)
> (setf (aref vector i) right
> (aref vector j) left))
> (incf i)
> (decf j)
> (when (< low j)
> (aux vector low j))
> (when (> high i)
> (aux vector left high)))))
> (let ((length (length vector)))
> (when (> length 0)
> (aux vector 0 (1- length)))))
> vector)
>
> ?!?
>
>
> Pascal
>
Olin Shivers "The Anatomy of a Loop":
http://www.cc.gatech.edu/~hhivers/papers/loop.pdf
A scheme implementation of loop.
The algorithm is decribed in the paper as a example.
--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
> But then again, why rewrite it when SORT is built in in CL?
CL's sort can be quite inefficient (in the constants --- it's still
O(n log n) in all implementations as far as I know). Every comparison
is a function call, and there's no way I know of to either inline that
function call or avoid boxing and unboxing its arguments. In
particular, consider sorting an array of double-floats, in an
implementation like CMUCL that supports unboxed arrays. I believe
that when I finally wrote a fully optimized, fully specialized qsort,
I got 2-3 orders of magnitude speedup over the built-in.
Cheers,
rif
rif wrote:
> > But then again, why rewrite it when SORT is built in in CL?
>
> CL's sort can be quite inefficient (in the constants --- it's still
> O(n log n) in all implementations as far as I know). Every comparison
> is a function call, and there's no way I know of to either inline that
> function call or avoid boxing and unboxing its arguments. In
> particular, consider sorting an array of double-floats, in an
> implementation like CMUCL that supports unboxed arrays. I believe
> that when I finally wrote a fully optimized, fully specialized qsort,
> I got 2-3 orders of magnitude speedup over the built-in.
>
Sure, but I would say that this is a case of "first you got it right,
then you got it fast".
The simple REMOVE-IF based QSORT we have been playing around with is
obviously suboptimal when it comes to efficiency. :)
Cheers
--
Marco
<···@mit.edu> wrote:
>
>> But then again, why rewrite it when SORT is built in in CL?
>
> CL's sort can be quite inefficient (in the constants --- it's still
> O(n log n) in all implementations as far as I know). Every comparison
> is a function call, and there's no way I know of to either inline that
> function call or avoid boxing and unboxing its arguments.
Why not? An implementation is allowed to inline SORT, and when doing
that it can also inline the comparison function (as long as it is
constant and inlinable). For example in SBCL:
CL-USER> (locally
(declare (optimize speed))
(let ((array (make-array (* 1024 1024) :element-type 'double-float)))
(loop for i below (length array) do (setf (aref array i)
(random 1000d0)))
(time (sort array #'<))
nil))
Evaluation took:
12.576 seconds of real time
11.372711 seconds of user run time
0.976061 seconds of system run time
0 page faults and
962,526,752 bytes consed.
NIL
CL-USER> (locally
(declare (optimize speed (space 0)))
(let ((array (make-array (* 1024 1024) :element-type 'double-float)))
(loop for i below (length array) do (setf (aref array i)
(random 1000d0)))
(time (sort array #'<))
nil))
Evaluation took:
0.634 seconds of real time
0.596037 seconds of user run time
0.0 seconds of system run time
0 page faults and
0 bytes consed.
NIL
CL-USER> (locally
(declare (optimize speed (space 0)) (notinline <))
(let ((array (make-array (* 1024 1024) :element-type 'double-float)))
(loop for i below (length array) do (setf (aref array i)
(random 1000d0)))
(time (sort array #'<))
nil))
Evaluation took:
5.107 seconds of real time
3.964248 seconds of user run time
1.072067 seconds of system run time
0 page faults and
928,935,936 bytes consed.
NIL
--
Juho Snellman
Marco Antoniotti wrote:
> If you do not want to use the SETL package
>
> (defun qsort (list)
> (when list
> (append (qsort (remove-if (lambda (x) (> x (first list))) list)
> (list (first list))
> (qsort (remove-if (lambda (x) (< x (first list))) list))))
>
> Same line count of Haskell.
Nice. Of course, you mean something like this :-)
(defun qsort (list)
(when list
(let ((x (first list))
(xs (rest list)))
(append (qsort (remove-if (lambda (y) (>= y x)) xs))
(list x)
(qsort (remove-if (lambda (y) (< y x)) xs))))))
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> Marco Antoniotti wrote:
> Nice. Of course, you mean something like this :-)
>
> (defun qsort (list)
> (when list
> (let ((x (first list))
> (xs (rest list)))
> (append (qsort (remove-if (lambda (y) (>= y x)) xs))
> (list x)
> (qsort (remove-if (lambda (y) (< y x)) xs))))))
>
Winner!
Except that's now slower than mine (at least with the testing I did
with the two versions compiled, on a 100,000 element random number
list).
My partition func makes one pass through the list which is where the
speed up probably comes from, wherease this one does two remove-if's
Why not factor out the REMOVE-IF related code?
(defun qsort (list)
(when list
(let ((x (first list)) (xs (rest list)))
(labels ((part (op)
(remove-if (lambda (y) (funcall op y x)) xs)))
(append (qsort (part #'>)) (list x) (qsort (part #'<)))))))
This shows that Lisp can be competitive in going for less lines of code
in a contrived example, but the Haskell page is pointing out that their
code is easier to read if you don't already know the language. The Lisp
(and referenced Python code) both require some serious understanding of
the language, so I those examples are missing the point.
Lisp has a nastier learning curve, but once you're up to speed the
productivity is great. C/C++ require a nasty learning curve also, but
without the productivity payoff.
Sure, this example makes Haskell seem easy to learn, but frequent use
of concepts like Arrows and Monads make it about as hard to grok as CPS
in Lisp or Scheme. And they require you to learn it to be productive -
most of my Lisp code does not use CPS.
Python - what can I say about interpreted performance? And they're
moving away from their crippled lambda. Nice set of standard libraries
though.
Harold wrote:
> This shows that Lisp can be competitive in going for less lines of code
> in a contrived example, but the Haskell page is pointing out that their
> code is easier to read if you don't already know the language. The Lisp
> (and referenced Python code) both require some serious understanding of
> the language, so I those examples are missing the point.
I know Lisp already a bit, so perhaps I'm not the right one to say this,
but for me the Lisp code looks easier compared to the Haskell code
(especially Marco's version, but not necessarily Geoffrey's version :-)
The only thing to know is that after a "(" almost every time is a function
name, followed by some parameters for this function. To understand the
Haskell version you have to know a lot more about operator precedence,
pattern matching, list comprehension etc.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
"Frank Buss" <··@frank-buss.de> wrote in message ···································@40tude.net...
>
> I know Lisp already a bit, so perhaps I'm not the right one to say this,
> but for me the Lisp code looks easier compared to the Haskell code
> (especially Marco's version, but not necessarily Geoffrey's version :-)
>
Ouch! That hurts, it's a fair assessment, but it still hurts. *sob* :-)
Actually I wonder if the Haskell version is all that efficient,
it would take a take a rather strange little optimization to
eliminate running two tests and doing the equivalent of the
remove-ifs versions.
On a different note, I got to thinking about the partioning, then
the old card sorters, and came up with this:
(defmacro card-sort ((item list) tests)
"CARD-SORT iterates through a list pushing
each item into the list of the first test that
succeeds if no test succeeds the item is dropped
returns a list of lists in order of the tests."
(let ((collectors (mapcar (lambda (x)
(declare (ignore x))
(gensym))
tests)))
`(let ,collectors
(dolist (,item ,list (list ,@collectors))
(cond ,@(loop for test in tests
for sym in collectors
collect `(,test (push ,item ,sym))))))))
CL-USER > (card-sort (x '(1 2 3 4 5 6 7 8 9)) ((< x 3) (< x 6) t))
((2 1) (5 4 3) (9 8 7 6))
So dividing the list in qsort becomes
(card-sort (x (rest list)) ((< x (first list)) t))
And that's enough of my mind meandering off the path for today.
---
Geoff
"Geoffrey Summerhayes" <·······@NhOoStPmAaMil.com> writes:
> "Frank Buss" <··@frank-buss.de> wrote in message ···································@40tude.net...
> >
> > I know Lisp already a bit, so perhaps I'm not the right one to say this,
> > but for me the Lisp code looks easier compared to the Haskell code
> > (especially Marco's version, but not necessarily Geoffrey's version :-)
> >
>
> Ouch! That hurts, it's a fair assessment, but it still hurts. *sob* :-)
>
> Actually I wonder if the Haskell version is all that efficient,
> it would take a take a rather strange little optimization to
> eliminate running two tests and doing the equivalent of the
> remove-ifs versions.
It's terribly inefficient because of excessive copying & consing.
Quicksort is meant to be done _in place_.
Matthias
"Matthias" <··@spam.please> wrote in message
····················@hundertwasser.ti.uni-mannheim.de...
>
> It's terribly inefficient because of excessive copying & consing.
> Quicksort is meant to be done _in place_.
>
Certainly it was designed with in place swapping in mind, but the
algorithm of the sort is independent of it.
But one religious argument a month is more than enough.
--
Geoff
justinhj wrote:
> Frank Buss wrote:
> > Marco Antoniotti wrote:
> > Nice. Of course, you mean something like this :-)
> >
> > (defun qsort (list)
> > (when list
> > (let ((x (first list))
> > (xs (rest list)))
> > (append (qsort (remove-if (lambda (y) (>= y x)) xs))
> > (list x)
> > (qsort (remove-if (lambda (y) (< y x)) xs))))))
> >
>
> Winner!
>
> Except that's now slower than mine (at least with the testing I did
> with the two versions compiled, on a 100,000 element random number
> list).
>
> My partition func makes one pass through the list which is where the
> speed up probably comes from, wherease this one does two remove-if's
True. However this isn't much different from the Haskell version.
You can also get more mileage by replacing the APPEND with NCONC.
REMOVE-IF returns a fresh list, so the NCONCing is warranted and most
likely always a win over the APPEND.
Incidentally, here is a partition in CL that seems reasonably fast (and
general).
(defun partition (seq &optional (left 0) (right (1- (length seq)))
(pivot-index left))
(declare (type sequence seq)
(type fixnum left right pivot-index))
(let ((pivot-value (elt seq pivot-index))
(store-index left)
)
(declare (type fixnum store-index))
(rotatef (elt seq pivot-index) (elt seq right))
(loop for i of-type fixnum from left below right
when (<= (elt seq i) pivot-value)
do (rotatef (elt seq i) (elt seq store-index))
and do (incf store-index))
(rotatef (elt seq right) (elt seq store-index))
(values store-index seq)))
Cheers
--
Marco
"Marco Antoniotti" <·······@gmail.com> writes:
> You can also get more mileage by replacing the APPEND with NCONC.
> REMOVE-IF returns a fresh list, so the NCONCing is warranted and most
> likely always a win over the APPEND.
Actually, this is not safe. REMOVE-IF is not required to return a fresh
list. Excerpting from the Hyperspec, (emphasis mine):
remove, remove-if, remove-if-not return a sequence of the same type as
sequence that has the same elements except that those in the subsequence
bounded by start and end and satisfying the test have been removed. This
is a non-destructive operation. If any elements need to be removed, the
result will be a copy. THE RESULT OF REMOVE MAY SHARE WITH SEQUENCE; THE
RESULT MAY BE IDENTICAL TO THE INPUT SEQUENCE IF NO ELEMENTS NEED TO BE
REMOVED.
--
Thomas A. Russ, USC/Information Sciences Institute
Thomas A. Russ wrote:
> "Marco Antoniotti" <·······@gmail.com> writes:
>
> > You can also get more mileage by replacing the APPEND with NCONC.
> > REMOVE-IF returns a fresh list, so the NCONCing is warranted and most
> > likely always a win over the APPEND.
>
> Actually, this is not safe. REMOVE-IF is not required to return a fresh
> list. Excerpting from the Hyperspec, (emphasis mine):
>
> remove, remove-if, remove-if-not return a sequence of the same type as
> sequence that has the same elements except that those in the subsequence
> bounded by start and end and satisfying the test have been removed. This
> is a non-destructive operation. If any elements need to be removed, the
> result will be a copy. THE RESULT OF REMOVE MAY SHARE WITH SEQUENCE; THE
> RESULT MAY BE IDENTICAL TO THE INPUT SEQUENCE IF NO ELEMENTS NEED TO BE
> REMOVED.
>
Ooops. My bad.
Cheers
--
Marco
Marco Antoniotti wrote:
> Using the SETL package
>
> (defun partition (list pivot)
> (values [x in list / (< x pivot)] [x in list / (> x pivot)]))
>
> And without using partition at all
>
> (defun qsort (list)
> (when list
> (append (qsort [x in list / (< x (first list))]) (list (first
> list)) (qsort [x in list / (> x (first list))]))))
This is I must honestly say: very cool. I will never deride Common Lisp
for the time coming.
By the way anyone care to comment whether such tricks are doable by
means of Scheme its srfi-1 library (I added comp.lang.scheme to the
header).
Sir Francis Drake
Förster vom Silberwald wrote:
> Marco Antoniotti wrote:
> > Using the SETL package
> >
> > (defun partition (list pivot)
> > (values [x in list / (< x pivot)] [x in list / (> x pivot)]))
> >
> > And without using partition at all
> >
> > (defun qsort (list)
> > (when list
> > (append (qsort [x in list / (< x (first list))]) (list (first
> > list)) (qsort [x in list / (> x (first list))]))))
>
> This is I must honestly say: very cool. I will never deride Common Lisp
> for the time coming.
>
> By the way anyone care to comment whether such tricks are doable by
> means of Scheme its srfi-1 library (I added comp.lang.scheme to the
> header).
I suppose you can, if you add reader macros to Scheme (thus proving the
obvious :) )
Cheers
--
Marco
F�rster vom Silberwald wrote:
> Marco Antoniotti wrote:
>
>>Using the SETL package
>>
>>(defun partition (list pivot)
>> (values [x in list / (< x pivot)] [x in list / (> x pivot)]))
>>
>>And without using partition at all
>>
>>(defun qsort (list)
>> (when list
>> (append (qsort [x in list / (< x (first list))]) (list (first
>>list)) (qsort [x in list / (> x (first list))]))))
>
> This is I must honestly say: very cool. I will never deride Common Lisp
> for the time coming.
Finally, you start to see the light. ;)
It's not what Common Lisp already has, it's what you can add...
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
F�rster vom Silberwald wrote:
> By the way anyone care to comment whether such tricks are doable by
> means of Scheme its srfi-1 library (I added comp.lang.scheme to the
> header).
If you by similar tricks mean list comprehensions, then look at
srfi-42 in stead of srfi-1.
--
Jens Axel S�gaard
justinhj wrote:
> I was talking to a programmer about lisp and he mentioned someone
> writing qsort in haskell and python in 5 or 6 lines of code.
; Hope this isn't too far off-topic. Here's a transliteration
; of the Haskell version to Scheme. Has the same problems.
; Compare to...
; qsort [] = []
; qsort (x:xs) = qsort less ++ [x] ++ qsort more
; where less = filter (<x) xs
; more = filter (>=x) xs
(require (lib "1.ss" "srfi")) ;DrScheme
(define (qsort xss)
(if (null? xss)
'()
(let* ((x (car xss))
(xs (cdr xss))
(lt (lambda (m) (lambda (n) (< n m))))
(gt (lambda (m) (lambda (n) (>= n m))))
(less (filter (lt x) xs))
(more (filter (gt x) xs)))
(append (qsort less) (append (list x) (qsort more))))))
(display (qsort (list 5 4 9 2 3 8 7 1 6)))
Greg Buchholz wrote:
> justinhj wrote:
>
>>I was talking to a programmer about lisp and he mentioned someone
>>writing qsort in haskell and python in 5 or 6 lines of code.
>
>
> ; Hope this isn't too far off-topic. Here's a transliteration
> ; of the Haskell version to Scheme. Has the same problems.
> ; Compare to...
> ; qsort [] = []
> ; qsort (x:xs) = qsort less ++ [x] ++ qsort more
> ; where less = filter (<x) xs
> ; more = filter (>=x) xs
Using CUT from srfi-26 to "curry" we can translate the Haskell
directly into PLT Scheme:
(require (lib "26.ss" "srfi"))
(define qsort
(match-lambda
[() '()]
[(x . xs) (append
(qsort (filter (cut < <> x) xs))
(list x)
(qsort (filter (cut >= <> x) xs)))]))
(qsort (list 5 1 2 4 1 3 2 1)) ; => (1 1 1 2 2 3 4 5)
Marcos solution with the SETL package was nice - using
eager comprehensions from srfi-42 a similar solution
is possible:
(define qsort
(match-lambda
[() '()]
[(pivot . xs) (append
(qsort (list-ec (: x xs) (if (< x pivot)) x))
(list pivot)
(qsort (list-ec (: x xs) (if (>= x pivot)) x)))]))
(qsort (list 5 1 2 4 1 3 2 1)) ; => (1 1 1 2 2 3 4 5)
Justin - for another example consider how you would write an in-place
quick-sort of an array.
--
Jens Axel S�gaard
noone said it had to be fast right? ; - )
(defun qsort (list &optional 2nd)
(if (null list)
2nd
(let ((max (eval (cons 'max list))))
(qsort (remove max list :count 1) (cons max 2nd)))))
nick
<········@gmail.com> wrote
> noone said it had to be fast right? ; - )
>
> (defun qsort (list &optional 2nd)
> (if (null list)
> 2nd
> (let ((max (eval (cons 'max list))))
The eval will be really slow and the evaluation of max will crash if list is too big.
You should use (reduce 'max list) instead.
But don't worry it will be slow enough anyway ;-)
> (qsort (remove max list :count 1) (cons max 2nd)))))
Marc
"Marc Battyani" <·············@fractalconcept.com> wrote
> <········@gmail.com> wrote
> > noone said it had to be fast right? ; - )
> >
> > (defun qsort (list &optional 2nd)
> > (if (null list)
> > 2nd
> > (let ((max (eval (cons 'max list))))
>
> The eval will be really slow and the evaluation of max will crash if list is too big.
> You should use (reduce 'max list) instead.
>
> But don't worry it will be slow enough anyway ;-)
In fact I would rewrite it that way:
(note that it's not a quick sort anymore)
(defun qsort (list)
(when list
(let ((max (reduce 'max list)))
(cons max (qsort (remove max list :count 1))))))
(qsort '(1 5 3 2 4 6 8 4 5 6 1 5))
(8 6 6 5 5 5 4 4 3 2 1 1)
Marc
········@gmail.com wrote:
> noone said it had to be fast right? ; - )
>
> (defun qsort (list &optional 2nd)
> (if (null list)
> 2nd
> (let ((max (eval (cons 'max list))))
> (qsort (remove max list :count 1) (cons max 2nd)))))
If me eyes doesn't deceive me that's a selection sort and
not a quick sort.
--
Jens Axel S�gaard
>The eval will be really slow and the evaluation of max will crash if list is >too big.
>You should use (reduce 'max list) instead.
right! I was doing an xpath tutorial in the other window and it made me
dumb
>In fact I would rewrite it that way:
>(note that it's not a quick sort anymore)
>(defun qsort (list)
> (when list
> (let ((max (reduce 'max list)))
> (cons max (qsort (remove max list :count 1))))))
hah, cool!
>If me eyes doesn't deceive me that's a selection sort and
>not a quick sort.
luckily there is no test today ; - )
nick
justinhj wrote:
> I was talking to a programmer about lisp and he mentioned someone
> writing qsort in haskell and python in 5 or 6 lines of code.
your version looks a bit like the C version, but you could write it like
the Haskell version at http://www.haskell.org/aboutHaskell.html
(defun partition (list pivot)
(loop for item in list
with less = '() and greater-or-equal = '()
finally (return (values (nreverse less)
(nreverse greater-or-equal)))
do (if (< item pivot)
(push item less)
(push item greater-or-equal))))
(defun qsort (list)
(when list
(let ((pivot (first list)))
(multiple-value-bind (less greater-or-equal)
(partition (rest list) pivot)
(append
(qsort less)
(list pivot)
(qsort greater-or-equal))))))
Small tasks are not very short in Lisp, but people, who knows Lisp better
than I, think that the larger the task to solve, the smaller is the Lisp
program, compared to other languages. The reason is because in Lisp the
problem dictates how the language looks like, and you don't have to think
how you have to formulate it in a given restricted language to solve your
problem, like in C. E.g. if you have lots of list comprehensions, you can
implement it with your own embedded language in Lisp (see
http://user.it.uu.se/~svenolof/Collect/ ) and then qsort in Lisp can look
as small as the Haskell version.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> justinhj wrote:
>
> > I was talking to a programmer about lisp and he mentioned someone
> > writing qsort in haskell and python in 5 or 6 lines of code.
>
> your version looks a bit like the C version, but you could write it like
> the Haskell version at http://www.haskell.org/aboutHaskell.html
>
> (defun partition (list pivot)
> (loop for item in list
> with less = '() and greater-or-equal = '()
> finally (return (values (nreverse less)
> (nreverse greater-or-equal)))
> do (if (< item pivot)
> (push item less)
> (push item greater-or-equal))))
(defun partition (list &aux (pivot-value (first list)))
(loop for item in list
if (< item pivot-value)
collect item into less
else
collect item into greater-or-equal
finally (return (values less greater-or-equal))))
Never underestimate the power of LOOP :)
Cheers
--
Marco
justinhj schrieb:
> I was talking to a programmer about lisp and he mentioned someone
> writing qsort in haskell and python in 5 or 6 lines of code. Well I
> found this evidence
>
> http://mail.python.org/pipermail/python-list/2003-June/168593.html
If it is brevity what you want, why don't you try this haskell code:
qsort [] = []
qsort (x:xs) = qsort [y | y <- xs, y < x] ++ [x] ++ qsort [y | y <- xs,
y >= x]
[ from http://de.wikipedia.org/wiki/Haskell_(Programmiersprache) ]
André
--