Quicksort in Scheme?

[cknapp]

So, I figured a fun little waste of time would be to write quicksort in scheme. I have my code below, poorly documented. Basically, it takes the first element as the pivot (for simplicity), and then there's a method which returns a pair which is ( (list of everything smaller than pivot) . (list of everything else)), and then lists ( (sorted car of above list) pivot (sorted cdr) )

(define (quicksort L)
    (if (null? L) L
    (letrec ((pivot (car L)) ;chooses first element as pivot
         (split  
        (lambda (piv li return) 
            ;return is the list to be returned
            ;return will be (<pivot . >=pivot)
          (cond ((null? li) return) 
                ((< (car li) piv)
                 (split piv (cdr li) (cons (cons (car li) (car return))
                                             (cdr return))))
                (else   
                   (split piv (cdr li) (cons (car return) 
                                             (cons (car li)
                                                (cdr return)))))))
            ))      
      `(,@(quicksort (car (split pivot (cdr L) '(() . ())))) ,pivot
       ,@(quicksort (cdr (split pivot (cdr L) '(() . ()))))) 
      )
    )
  )

Anyway, my questions:

Is there another simple of choosing the pivot that doesn't require O(n^2) time to "sort" a sorted list?

Does my code actually calculate (split pivot ... ) twice? How can I rewrite this to be a little cleaner?

Thanks,
Cory

[shrughes]

One way to clean this up is to avoid letrec. Instead, write

(define (quicksort L)
  (define (split piv li return) ...)
  (if (null? L)
      L
      ...))

Another thing is that godawful quasiquote notation. You could also clean it up by having split take two parameters in place of return, and then only cons them together when you do finally return a value.

Does my code actually calculate (split pivot ... ) twice?

Why are you asking this? You don't know Scheme's execution model?

[cknapp]

Thanks; I'll post something up here when I can fix it

And, yeah, I don't know why I asked that...

[shrughes]

I just KNEW you know Scheme's execution model! And you thought you could hide that fact from me...

[cknapp]

So, I cleaned it up a bit, but...
When I responded with "I don't know why I asked that", I wasn't really thinking about it, and once I started thinking I confused myself again... So, I guess it is best to ask what the execution model is. I thought it was [for a procedure (proc arg1 ... argn)]:
(eval (proc (eval arg1) (eval arg2) ... (eval arg n))
... or something like that (ignoring any sort of explosion that may or may not occur.

My code is below, it seems a bit nicer.

Thanks, again for your help

(define (quicksort L)
    (define (split piv li less greater)
          (cond ((null? li) (cons less greater))
                ((< (car li) piv)
                 (split piv (cdr li) (cons (car li) less) greater))
                                   
                (else   
                   (split piv (cdr li) less (cons (car li) greater)))))

    (if (null? L) L)
    (define pivot (car L)) 
    (list (quicksort (car (split pivot (cdr L) () ()))) pivot
       (quicksort (cdr (split pivot (cdr L) () ())))))

Edit: Haven't tested it, and just realized that the return will have lists in it. That's easy enough to fix though, so I think you can ignore it.

[cknapp]

Gah... code failing horribly... I should pay attention to things before I post one of these days...

[shrughes]

So my point is, you know that it's evaluating (split pivot ...) twice because you have the same expression written twice in there.

So where you have

(list (quicksort (car (split pivot (cdr L) () ()))) pivot
(quicksort (cdr (split pivot (cdr L) () ())))))

you should write

(let ((x (split pivot (cdr L) () ())))
  (list (quicksort (car x)) pivot (quicksort (cdr x))))

That way, you're only evaluating the split once.

So I would write, as a simple tweak of your version:

(define (split piv xs lessers greaters)
  (cond ((null? xs) (cons lessers greaters))
	((< (car xs) piv)
	 (split piv (cdr xs) (cons (car xs) lessers) greaters))
	(else
	 (split piv (cdr xs) lessers (cons (car xs) greaters)))))

(define (bad-quicksort xs)
  (if (null? xs)
      '()
      (let* ((pivot (car xs))
	     (splitted (split pivot (cdr xs) '() '())))
	(append (bad-quicksort (car splitted))
		(cons pivot (bad-quicksort (cdr splitted)))))))

The reason I call it "bad" is that some improvement can be made. The bad thing about this quicksort implementation is that once the interior lists are sorted, they have to be appended together. This requires copying the list you've just built! So instead, I would recommend changing the question from "sorting a list" to "sorting a list and appending it onto another list".

(define (quicksort-onto xs onto)
  (if (null? xs)
    onto
    (let* ((pivot (car xs))
	   (splitted (split pivot (cdr xs) '() '())))
      (quicksort-onto (car splitted)
		      (cons pivot (quicksort-onto (cdr splitted)
						  onto))))))

(define (quicksort-calls-onto xs)
  (quicksort-onto xs '()))

In terms of algorithm design, if we disallow destructive operations, this seems the best we can get. But the implementation can be better by using a named let macro.

(define (quicksort-decent xs)
  (let sort ((xs xs) (onto '()))
    (if (null? xs)
	onto
	(let* ((pivot (car xs))
	       (splitted (split pivot (cdr xs) '() '())))
	  (sort (car splitted)
		(cons pivot (sort (cdr splitted)
				  onto)))))))

The code (let f ((arg1 val1) ...) <body>) is equivalent to (letrec ((f (lambda (arg1 ...) <body>))) (f val1 ...)) and it's handy for writing tail-recursive loops. But you can also use it for general recursive functions, like we did above.

Now, that's still kind of ugly, because we rely on the ugly split function. To avoid that, we can use the function filter from the SFRI-1 library.

(define (quicksort-filter xs)
  (let sort ((xs xs) (onto '()))
    (if (null? xs)
	onto
	(let ((pivot (car xs)))
	  (sort (filter (lambda (x) (< x pivot)) (cdr xs))
		(cons pivot
		      (sort (filter (lambda (x) (<= pivot x)) (cdr xs))
			    onto)))))))

Which cleans up our code quite a bit. But even better, SFRI-1 has a function called partition that pretty much does what our split function does! The thing is, partition returns multiple values... but not in a cons cell. It returns multiple values directly, using some crazy feature that Scheme has for some reason.

If a procedure returns more than one value, you can't assign it to something like you do with let . (At least not without SFRI-8, but we'll get to that.) Instead, you have to use the call-with-values function. An example of usage:

(call-with-values
  (lambda () (values 20 21))  ; returns two values, 20 and 21
  (lambda (x y) (sqrt (+ (* x x) (* y y)))))  ; receives 20 and 21 as arguments

With that in mind, we can write quicksort to use partition :

(define (quicksort-call-with-values xs)
  (let sort ((xs xs) (onto '()))
    (if (null? xs)
	onto
	(let ((pivot (car xs)))
	  (call-with-values
	      (lambda ()
		(partition (lambda (x) (< x pivot)) (cdr xs)))
	    (lambda (fore aft)
	      (sort fore (cons pivot (sort aft onto)))))))))

Ugly! Fortunately, the Scheme extension SFRI-8 provides a macro, much like let , that makes using
functions that return multiple values a bit easier.

(define (quicksort-receive xs)
  (let sort ((xs xs) (onto '()))
    (if (null? xs)
	onto
	(let ((pivot (car xs)))
	  (receive (fore aft) (partition (lambda (x) (< x pivot)) (cdr xs))
	    (sort fore (cons pivot (sort aft onto))))))))

We can also write a destructive quicksort implementation simply by using the destructive version of partition.

(define (quicksort! xs)
  (let sort ((xs xs) (onto '()))
    (if (null? xs)
	onto
	(let ((pivot (car xs)))
	  (receive (fore aft) (partition! (lambda (x) (< x pivot)) (cdr xs))
	    (sort fore (cons pivot (sort aft onto))))))))

Since destructive partitioning can be done without burning through a bunch of memory allocations, maybe it's faster. So that gives us a non-destructive quicksort function:

(define (quicksort xs)
  (quicksort! (list-copy xs)))

[cknapp]

Thanks! That helps a lot. I was going to ask a couple of questions about call-with-values and receive, but decided not to ask questions I know the answer to.

Also, it seems you've spelled SRFI a little backwards... The google search would have been a bit easier, otherwise :D

Thanks, again for all your help!