Can I implement quicksort efficiently with Scheme? - performance

This is what I've done:
(define qsort
(lambda (l)
(let ((lesser '()))
(let ((greater '()))
(cond
((null? l) '())
(else (map (lambda (ele)
(if (> (car l) ele)
(set! lesser (cons ele lesser))
(set! greater (cons ele greater)))) (cdr l))
(append (qsort lesser) (cons (car l) (qsort greater))))
)))))
I noticed that when provided with an already sorted list, it becomes extremely sluggish.
After some searching, I found that if the "pivot" is selected in a random manner, the performance can be improved.
However the only way I know to achieve this is by list-ref, and it seems to be O(n).
To make matters even worse, I have to implement a cdr-like function to remove n-th element in the list, which might also be extremely inefficient.
Maybe I'm in the wrong direction. Could you give me some advice?

true quicksort runs on random-access arrays, with in-place partitioning. e.g. see this.
you can start by converting your list to vector with list->vector, then implementing the quicksort by partitioning the vector with mutating swaps, in C fashion.
Randomizing it is easy: just pick a position randomly, and swap its contents with the first element in range being sorted, before each partition step. When you're done, convert it back with vector->list.
Efficient implementation of quicksort may run without recursion, in a loop, maintaining a stack of bigger parts boundaries, always descending on the smaller ones (then, when at the bottom, switching to the first part in the stack). Three-way partitioning is always preferable, dealing with equals in one blow.
Your list-based algorithm is actually an unraveled treesort.
see also:
http://www.reddit.com/r/programming/comments/2h0j2/real_quicksort_in_haskell
Pseudo-quicksort time complexity

Although there's already an accepted answer, I thought you might appreciate a Scheme translation of the Sheep Trick from The Pitmanual. Your code is actually quite similar to it already. Scheme does support do loops, but they're not particularly idiomatic, whereas named lets are much more common, so I've used the latter in this code. As you've noted, choosing the first element as the pivot cause perfomance problems if the list is already sorted. Since you have to traverse the list on each iteration, there might be some clever thing you could do to pick the pivots for the left and right sides for the recursive calls in advance.
(define (nconc l1 l2)
;; Destructively concatenate l1 and l2. If l1 is empty,
;; return l2. Otherwise, set the cdr of the last pair
;; of l1 to l2 and return l1.
(cond
((null? l1)
l2)
(else
(let loop ((l1 l1))
(if (null? (cdr l1))
(set-cdr! l1 l2)
(loop (cdr l1))))
l1)))
(define (quicksort lst)
(if (null? lst) lst
(let ((pivot (car lst))
(left '())
(right '()))
(let loop ((lst (cdr lst))) ; rebind to (cdr lst) since pivot wasn't popped
(if (null? lst)
(nconc (quicksort left)
(cons pivot
(quicksort right)))
(let ((tail (cdr lst)))
(cond
((< (car lst) pivot)
(set-cdr! lst left)
(set! left lst))
(else
(set-cdr! lst right)
(set! right lst)))
(loop tail)))))))
(quicksort (list 9 1 8 2 7 3 6 4 5))
;=> (1 2 3 4 5 6 7 8 9)
Scheme does support do, so if you are interested in that (it does make the Common Lisp and Scheme version very similar), it looks like this:
(define (quicksort lst)
(if (null? lst) lst
(do ((pivot (car lst))
(lst (cdr lst)) ; bind lst to (cdr lst) since pivot wasn't popped
(left '())
(right '()))
((null? lst)
(nconc (quicksort left)
(cons pivot
(quicksort right))))
(let ((tail (cdr lst)))
(cond
((< (car lst) pivot)
(set-cdr! lst left)
(set! left lst))
(else
(set-cdr! lst right)
(set! right lst)))
(set! lst tail)))))
(display (quicksort (list 9 1 8 2 7 3 6 4 5)))
;=> (1 2 3 4 5 6 7 8 9)

A truly efficient implementation of Quicksort should be in-place and implemented using a data structure that can be accessed efficiently by index - and that makes immutable linked lists a poor choice.
The question asks whether Quicksort can be efficiently implemented with Scheme - the answer is yes, as long as you don't use lists. Switch to using a vector, which is mutable and has O(1) index-based access over its elements, like an array in C-like programming languages.
If your input data comes in a linked list, you can always do something like this, it'll probably be faster than directly sorting the list:
(define (list-quicksort lst)
(vector->list
(vector-quicksort ; ToDo: implement this procedure
(list->vector lst))))

Related

Can't get the end list i want in swapping procedure

Ultimately, i shall be trying to reimplement sorting algorithms in scheme for linked lists. I have written a subprocedure that will help me along the way. The goal is to simply swap 2 elements, given as arguments "pair1 and pair2" and then return the list.
(define (cons-til lst until)
(cond
((or (null? lst) (eq? (car lst) until)) '())
(else (cons (car lst) (cons-til (cdr lst) until)))))
(define (swap lst pair1 pair2)
(cons (cons (append (cons-til lst (car pair1))
(car pair2)) (car pair1)) (cdr pair2)))
(define my-list '(1 2 3 4 5 6 7))
(swap my-list (cdr (cdr my-list)) (cdr (cdr (cdr my-list))))
When the code is executed, it returns:
(((1 2 . 4) . 3) 5 6 7)
How can i fix this in order to have a plain scheme list. The element seems to have swapped correctly.
Two suggestions:
Do you really want to write n cdr calls to index the nth element? I recommend strongly using integer indexes (if you need them, that is).
Referring to elements by index in a linked list (i. e. “random access”) is not very efficient most of the time, especially when done in loops. I strongly recommend using either vectors or a better suited algorithm that doesn't need random access, e. g. merge sort.
(define (swap2 lst pair1 pair2)
(append (append (append (cons-til lst (car pair1))
(list (car pair2)))
(list (car pair1))) (cdr pair2)))
This code seems to work. I'm not sure this is completely efficient or a smart solution to the problem. Looking forward to other suggestions. The value given back is '(1 2 4 3 5 6 7)

How to check if a list is even, in

I want to test if a list is even, in . Like (evenatom '((h i) (j k) l (m n o)) should reply #t because it has 4 elements.
From Google, I found how to check for odd:
(define (oddatom lst)
(cond
((null? lst) #f)
((not (pair? lst)) #t)
(else (not (eq? (oddatom (car lst)) (oddatom (cdr lst)))))))
to make it even, would I just swap the car with a cdr and cdr with car?
I'm new to Scheme and just trying to get the basics.
No, swapping the car and cdr won't work. But you can swap the #f and #t.
Also, while the list you gave has 4 elements, what the function does is actually traverse into sublists and count the atoms, so you're really looking at 8 atoms.
You found odd atom using 'Google' and need even atom. How about:
(define (evenatom obj) (not (oddatom obj)))
or, adding some sophistication,
(define (complement pred)
(lambda (obj) (not (pred obj))))
and then
(define evenatom (complement oddatom))
you are mixing a procedure to check if a list has even numbers of elements (not restricted to atoms) and a procedure that checks if there are an even number of atomic elements in the list structure. Example: ((a b) (c d e) f) has an odd number of elements (3) but an even number (6) of atoms.
If you had some marbles, how would you determine if you had an odd or even number of marbles? you could just count them as normal and check the end sum for evenness or count 1,0,1,0 or odd,even,odd,even so that you really didn't know how many marbles I had in the end, only if it's odd or even. Lets do both:
(define (even-elements-by-count x)
(even? (length x)))
(define (even-elements-by-boolean x)
(let loop ((x x)(even #t))
(if (null? x)
even
(loop (cdr x) (not even)))))
now imagine that you had some cups in addition and that they had marbles to and you wondered the same. You'd need to count the elements on the floor and the elements in cups and perhaps there was a cup in a cup with elements as well. For this you should look at How to count atoms in a list structure and use the first approach or modify one of them to update evenness instead of counting.
The equivalent of the procedure you link to, for an even number of atoms, is
(define (evenatom lst)
(cond
((null? lst) #t)
((not (pair? lst)) #f)
(else (eq? (evenatom (car lst)) (evenatom (cdr lst))))))
You need to swap #t and #f, as well as leave out the not clause of the last line.

recursive function accepts list in scheme

I'm new to Scheme and this is my very first Functional language. Implementing almost everything recursively seems to be awkward for me. Nevertheless, was able to implement functions of Factorial and Fibonacci problems having a single integer input.
However, what about when your function has an input of a list? Suppose this exercise:
FUNCTION: ret10 - extracts and returns as a list all the numbers greater than 10
that are found in a given list, guile> (ret10 ‘(x e (h n) 1 23 12 o))
OUTPUT: (23 12)
Should I have (define c(list)) as the argument of my function in this? or is there any other way?
Please help. Thanks!
Here's my derived solution based on sir Óscar López's answer below.. hope this helps others:
(define (ret10 lst)
(cond
((null? lst) '())
((and (number? (car lst)) (> (car lst) 10))
(cons (car lst)
(ret10 (cdr lst))))
(else (ret10 (cdr lst)))
)
)
This kind of problem where you receive a list as input and return another list as output has a well-known template for a solution. I'd start by recommending you take a look at The Little Schemer or How to Design Programs, either book will teach you the correct way to start thinking about the solution.
First, I'll show you how to solve a similar problem: copying a list, exactly as it comes. That'll demonstrate the general structure of the solution:
(define (copy lst)
(cond ((null? lst) ; if the input list is empty
'()) ; then return the empty list
(else ; otherwise create a new list
(cons (car lst) ; `cons` the first element
(copy (cdr lst)))))) ; and advance recursion over rest of list
Now let's see how the above relates to your problem. Clearly, the base case for the recursion will be the same. What's different is that we cons the first element with the rest of the list only if it's a number (hint: use the number? procedure) and it's greater than 10. If the condition doesn't hold, we just advance the recursion, without consing anything. Here's the general idea, fill-in the blanks:
(define (ret10 lst)
(cond (<???> <???>) ; base case: empty list
(<???> ; if the condition holds
(cons <???> ; `cons` first element
(ret10 <???>))) ; and advance recursion
(else ; otherwise
(ret10 <???>)))) ; simply advance recursion
Don't forget to test it:
(ret10 '(x e (h n) 1 23 12 o))
=> '(23 12)
As a final note: normally you'd solve this problem using the filter procedure - which takes as input a list and returns as output another list with only the elements that satisfy a given predicate. After you learn and understand how to write a solution "by hand", take a look at filter and write the solution using it, just to compare different approaches.
Solve the problem for the first element of the list and the recurse on rest of the list. Make sure you handle the termination condition (list is null?) and combine results (cons or append in the following)
(define (extract pred? list)
(if (null? list)
'()
(let ((head (car list))
(rest (cdr list)))
(cond ((pred? head) (cons head (extract pred? rest)))
((list? head) (append (extract pred? head)
(extract pred? rest)))
(else (extract pred? rest))))))
(define (ret10 list)
(extract (lambda (x) (and (number? x) (> x 10))) list))
> (ret10 '(0 11 (12 2) 13 3))
(11 12 13)

Scheme return a list with first half of its elements

Write a procedure (first-half lst) that returns a list with the first half of its elements. If the length of the given list is odd, the returned list should have (length - 1) / 2 elements.
I am given these program as a example and as I am new to Scheme I need your help in solving this problem.
(define list-head
(lambda (lst k)
(if (= k 0)
'()
(cons (car lst)(list-head (cdr lst)(- k 1)))))))
(list-head '(0 1 2 3 4) 3)
; list the first 3 element in the list (list 0 1 2)
Also the expected output for the program I want is :
(first-half '(43 23 14 5 9 57 0 125))
(43 23 14 5)
This is pretty simple to implement in terms of existing procedures, check your interpreter's documentation for the availability of the take procedure:
(define (first-half lst)
(take lst (quotient (length lst) 2)))
Apart from that, the code provided in the question is basically reinventing take, and it looks correct. The only detail left to implement would be, how to obtain the half of the lists' length? same as above, just use the quotient procedure:
(define (first-half lst)
(list-head lst (quotient (length lst) 2)))
It looks like you are learning about recursion? One recursive approach is to walk the list with a 'slow' and 'fast' pointer; when the fast pointer reaches the end you are done; use the slow pointer to grow the result. Like this:
(define (half list)
(let halving ((rslt '()) (slow list) (fast list))
(if (or (null? fast) (null? (cdr fast)))
(reverse rslt)
(halving (cons (car slow) rslt)
(cdr slow)
(cdr (cdr fast))))))
Another way to approach it is to have a function that divides the list at a specific index, and then a wrapper to calculate floor(length/2):
(define (cleave_at n a)
(cond
((null? a) '())
((zero? n) (list '() a))
(#t
((lambda (x)
(cons (cons (car a) (car x)) (cdr x)))
(cleave_at (- n 1) (cdr a))))))
(define (first-half a)
(car (cleave_at (floor (/ (length a) 2)) a)))

Sorting algorithm lisp-scheme

I have decided to learn some functional language and I hooked up with the lisp-scheme after all.
I am trying to make a function which checks if a list is sorted, either with lowest first getting higher or vice versa, and if it can be sorted it should return true else false.
This is my first code, working only if the list is increasing (or equal).
(define sorted?
(lambda (lst)
(cond ((empty? lst) #t)
(else (and (<= (car lst) (cadr lst))
(sorted? (cdr lst)))))))
clarification: something like (sorted? '(1 2 3 4 5)) and (sorted? '(5 4 3 2 1)) should return true, else if not sorted false of course.
How am I supposed to think when programming in a functional style? The syntax seems straight-forward but I'm not used to the logic.
Specific implementation
I'd take Óscar López's answer and go one step further:
(define sorted? (lambda (lst)
(letrec ((sorted-cmp
(lambda (lst cmp)
(cond ((or (empty? lst) (empty? (cdr lst)))
#t)
(else (and (cmp (car lst) (cadr lst))
(sorted-cmp (cdr lst) cmp)))))))
(or (sorted-cmp lst <=) (sorted-cmp lst >=)))))
The biggest difference between this version and his is that sorted? now defines Óscar's version as an internal helper function using letrec and calls it both ways.
Functional Thinking
You actually chose a good example for illustrating some aspects of how Scheme views the world, and your implementation was off to a very good start.
One important functional principle involved in the solution to this problem is that anything you could put (**here** more stuff '(1 2 3 4)), you can pass around as an argument to another function. That is, functions are first class in a functional programming language. So the fact that you were using <= in your comparison means that you can pass <= as a parameter to another function that makes a comparison accordingly. Óscar's answer is a great illustration of that point.
Another aspect of this problem that embodies another common functional pattern is a function that consists primarily of a (cond) block. In many functional programming languages (Haskell, ML, OCaml, F#, Mathematica), you get stronger pattern matching abilities than you get, by default in Scheme. So with (cond) in Scheme, you have to describe how to test for the pattern that you seek, but that's usually fairly straightforward (for example the (or (empty? lst) (empty? (cdr lst))) in this implementation.
One final functional programming pattern that I see as well-embodied in this problem is that many functional programming solutions are recursive. Recursion is why I had to use letrec instead of plain ol' let.
Almost anything you can do by operating on the first element (or 2 elements as in this case) and then repeating the operation on the tail (cdr) of the list you do that way. Imperative for- or while-style loops aren't impossible in Scheme (although they are pretty much impossible in pure functional languages such as Haskell), they're slightly out of place in Scheme under many circumstances. But Scheme's flexibility that allows you, as the developer, to make that decision enables important performance or maintainability optimizations in certain circumstances.
Continuing exploration
My first implementation of sorted? for my answer here was going to decide which comparison operator to pass to sorted-cmp based on what it saw in the list. I backed off on that when I spotted that a list could start with two equal numbers '(1 1 2 3 4 5). But as I think more about it, there's definitely a way to track whether you've decided a direction yet and, thus, only have one call required to sorted-cmp. You might consider exploring that next.
You almost got it right, look:
(define sorted?
(lambda (lst)
(cond ((or (empty? lst) (empty? (cdr lst)))
#t)
(else (and (<= (car lst) (cadr lst))
(sorted? (cdr lst)))))))
A little modification in the base case, and you're all set. It's necessary to stop when there's only one element left in the list, otherwise the cadr expression will throw an error.
For the second part of your question: If you want to check if it's sorted using a different criterion, simply pass the comparison function as an argument, like this:
(define sorted?
(lambda (lst cmp)
(cond ((or (empty? lst) (empty? (cdr lst)))
#t)
(else (and (cmp (car lst) (cadr lst))
(sorted? (cdr lst) cmp))))))
(sorted? '(1 2 3 4 5) <=)
> #t
(sorted? '(5 4 3 2 1) >=)
> #t
Now if you want to know if a list is sorted in either ascending order or in descending order:
(define lst '(1 2 3 4 5))
(or (sorted? lst >=) (sorted? lst <=))
> #t
As you can see, functional programming is about defining procedures as generic as possible and combining them to solve problems. The fact that you can pass functions around as parameters helps a great deal for implementing generic functions.
I'm going to take your question to mean, more specifically, "if I already program in an imperative language like C or Java, how do I adjust my thinking for functional programming?" Using your problem as an example, I'm going to spend my Saturday morning answering this question in long form. I'll trace the evolution of a functional programmer through three stages, each a successively higher plane of zen - 1) thinking iteratively; 2) thinking recursively; and 3) thinking lazily.
Part I - Thinking Iteratively
Let's say I'm programming in C and I can't or won't use recursion - perhaps the compiler does not optimize tail recursion, and a recursive solution would overflow the stack. So I start thinking about what state I need to maintain. I imagine a little machine crawling over the input. It remembers if it is searching for an increasing or a decreasing sequence. If it hasn't decided yet, it does so based on the current input, if it can. If it finds input headed in the wrong direction, it terminates with zigzag=true. If it reaches the end of the input, it terminates with zigzag=false.
int
zigzag(int *data, int n)
{
enum {unknown, increasing, decreasing} direction = unknown;
int i;
for (i = 1; i < n; ++i)
{
if (data[i] > data[i - 1]) {
if (direction == decreasing) return 1;
direction = increasing;
}
if (data[i] < data[i - 1]) {
if (direction == increasing) return 1;
direction = decreasing;
}
}
/* We've made it through the gauntlet, no zigzagging */
return 0;
}
This program is typical of C programs: it is efficient but it is difficult to prove that it will do the right thing. Even for this simple example, it's not immediately obvious that this can't get stuck in an infinite loop, or take a wrong turn in its logic somewhere. Of course, it gets worse for more complicated programs.
Part II - Thinking Recursively
I find that the key to writing readable programs in the spirit of functional languages (as opposed to just trying to morph an imperative solution into that language) is to focus on what the program should calculate rather than on how it should do it. If you can do that with enough precision - if you can write the problem out clearly - then most of the time in functional programming, you're almost at the solution!
So let's start by writing out the thing to be calculated in more detail. We want to know if a list zigzags (i.e. decreases at some point, and increases at another). Which lists meet this criterion? Well, a list zigzags if:
it is more than two elements long AND
it initially increases, but then decreases at some point OR
it initially decreases, but then increases at some point OR
its tail zigzags.
It's possible to translate the above statements, more or less directly, into a Scheme function:
(define (zigzag xs)
(and (> (length xs) 2)
(or (and (initially-increasing xs) (decreases xs))
(and (initially-decreasing xs) (increases xs))
(zigzag (cdr xs)))))
Now we need definitions of initially-increasing, initially-decreasing, decreases, and increases. The initially- functions are straightforward enough:
(define (initially-increasing xs)
(> (cadr xs) (car xs)))
(define (initially-decreasing xs)
(< (cadr xs) (car xs)))
What about decreases and increases? Well, a sequence decreases if it is of length greater than one, and the first element is greater than the second, or its tail decreases:
(define (decreases xs)
(letrec ((passes
(lambda (prev rest)
(cond ((null? rest) #f)
((< (car rest) prev)
#t)
(else (passes (car rest) (cdr rest)))))))
(passes (car xs) (cdr xs))))
We could write a similar increases function, but it's clear that only one change is needed: < must become >. Duplicating so much code should make you uneasy. Couldn't I ask the language to make me a function like decreases, but using > in that place instead? In functional languages, you can do exactly that, because functions can return other functions! So we can write a function that implements: "given a comparison operator, return a function that returns true if that comparison is true for any two successive elements of its argument."
(define (ever op)
(lambda (xs)
(letrec ((passes
(lambda (prev rest)
(cond ((null? rest) #f)
((op (car rest) prev)
#t)
(else (passes (car rest) (cdr rest)))))))
(passes (car xs) (cdr xs)))))
increases and decreases can now both be defined very simply:
(define decreases (ever <))
(define increases (ever >))
No more functions to implement - we're done. The advantage of this version over the C version is clear - it's much easier to reason that this program will do the right thing. Most of this program is quite trivial with all the complexity being pushed into the ever function, which is a quite general operation that would be useful in plenty of other contexts. I am sure by searching one could find a standard (and thus more trustworthy) implementation rather than this custom one.
Though an improvement, this program still isn't perfect. There's lots of custom recursion and it's not obvious at first that all of it is tail recursive (though it is). Also, the program retains faint echos of C in the form of multiple conditional branches and exit points. We can get an even clearer implementation with the help of lazy evaluation, and for that we're going to switch languages.
Part III - Thinking Lazily
Let's go back to the problem definition. It can actually be stated much more simply than it was in part II - "A sequence zigzags (i.e. is non-sorted) if it contains comparisons between adjacent elements that go in both directions". I can translate that sentence, more or less directly, into a line of Haskell:
zigzag xs = LT `elem` comparisons && GT `elem` comparisons
Now I need a way to derive comparisons, the list of comparisons of every member of xs with its successor. This is not hard to do and is perhaps best explained by example.
> xs
[1,1,1,2,3,4,5,3,9,9]
> zip xs (tail xs)
[(1,1),(1,1),(1,2),(2,3),(3,4),(4,5),(5,3),(3,9),(9,9)]
> map (\(x,y) -> compare x y) $ zip xs (tail xs)
[EQ,EQ,LT,LT,LT,LT,GT,LT,EQ]
That's all we need; these two lines are the complete implementation -
zigzag xs = LT `elem` comparisons && GT `elem` comparisons
where comparisons = map (\(x,y) -> compare x y) $ zip xs (tail xs)
and I'll note that this program makes just one pass through the list to test for both the increasing and decreasing cases.
By now, you have probably thought of an objection: isn't this approach wasteful? Isn't this going to search through the entire input list, when it only has to go as far as the first change of direction? Actually, no, it won't, because of lazy evaluation. In the example above, it calculated the entire comparisons list because it had to in order to print it out. But if it's going to pass the result to zigzag, it will only evaluate the comparisons list far enough to find one instance of GT and one of LT, and no further. To convince yourself of this, consider these cases:
> zigzag $ 2:[1..]
True
> zigzag 1:[9,8..]
True
The input in both cases is an infinite list ([2,1,2,3,4,5..] and [1,9,8,7,6,5...]). Try to print them out, and they will fill up the screen. But pass them to zigzag, and it will return very quickly, as soon as it finds the first change in direction.
A lot of the difficultly in reading code comes from following multiple branches of control flow. And a lot of those branches are really efforts to avoid calculating more than we need to. But much of the same thing can be achieved with lazy evaluation, allowing the program to be both shorter and truer to the original question.
Try this
(define sorted?
(lambda (l)
(cond ((null? l) #t)
(else (check-asc? (car l) (sorted? (cdr l))
(check-desc? (car l) (sorted? (cdr l))))))
(define check-asc?
(lambda (elt lst)
(cond ((null? lst) #t)
(else (or (< elt (car lst)) (= elt (car lst))) (check-asc? (car lst) (cdr lst))))))
(define check-desc?
(lambda (elt lst)
(cond ((null? lst) #t)
(else (or (< elt (car lst)) (= elt (car lst))) (check-desc? (car lst) (cdr lst))))))
I am a newbie myself. I haven't tested this code. Still struggling with recursion. Please tell me if it worked or what error it gave.
The previous answer i gave was really bad.
I ran the code in DrScheme and it gave errors.
However I have modified it. Here is a code that works:
(define sorted?
(lambda (l)
(cond ((null? l) #t)
(else (if (check-asc? (car l) (cdr l)) #t
(check-desc? (car l) (cdr l)))))))
(define check-asc?
(lambda (elt lst)
(cond ((null? lst) #t)
(else (if (or (< elt (car lst)) (= elt (car lst))) (check-asc? (car lst) (cdr lst))
#f)))))
(define check-desc?
(lambda (elt lst)
(cond ((null? lst) #t)
(else (if (or (> elt (car lst)) (= elt (car lst))) (check-desc? (car lst) (cdr lst))
#f)))))
Cases checked:
(sorted? '(5 4 3 2 1))
returns #t
(sorted? '(1 2 3 4 5))
returns #t
(sorted? '(1 2 3 5 4))
returns #f
(sorted? '())
returns #t
(sorted? '(1))
returns #t

Resources