qsort optimized for brevity

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://www.**--****.com/ 

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?

your version looks a bit like the C version, but you could write it like
the Haskell version at  http://www.**--****.com/ 

(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://www.**--****.com/ ~svenolof/Collect/ ) and then qsort in Lisp can look
as small as the Haskell version.

-- 
Frank Bu?  XXXX@XXXXX.COM 
 http://www.**--****.com/ ,  http://www.**--****.com/ 

; 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)))

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

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?  XXXX@XXXXX.COM 
 http://www.**--****.com/ ,  http://www.**--****.com/ 

It seems fair to only use standard CL


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.


For kicks.


Justin

Duh!  Of course. :}

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

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 :)

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

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

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 Saard

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

In article < XXXX@XXXXX.COM >,







This is silly, but here's a Dylan version:

module: qsort

define method qsort(l == #()) #() end;
define method qsort(l :: <list>)
  local partition(by) choose(rcurry(by, l.head), l.tail).qsort end;
  concatenate(\<.partition, l.head.list, \>=.partition);
end;

format-out("%=\n", qsort(#(3, 1, 4, 1, 5, 9, 2, 6, 5, 4)));

-- 
Bruce |  41.1670S | \  spoken |          -+-
Hoult | 174.8263E | /\ here.  | ----------O----------