Sort a list in scheme - scheme

I want to create function which sorts list. For example I have this list:
x1, x2, x3 .... xn
or
1, 2, 3, 4, 5, 6
I want to display the numbers in this order:
x1, xn, x2, xn-1
or
1, 6, 2, 5, 3, 4
Can you help me to write this example?

Usually when we talk about sorting, we refer to ordering the items by some characteristic of the item contents, not the item position in the list. I would call your situation permuting, but perhaps some people might dispute that usage, too. :-)
Here's how you might approach the problem:
Split the list in the middle (you can do this using tortoise-and-hare if you only want to traverse the list once); call those lists head and tail, if you want.
Reverse the tail list, and interleave it with the head list.
Another approach:
Reverse the original list pairs (let's call it rev).
Interleave the original list with rev, keeping track of the element traversed each time. When they meet in the middle, stop.
Here's a demonstration of the second approach (requires SRFI 1 to be loaded):
(define (zippy lst)
(if (null? lst)
'()
(let recur ((lst lst)
(rev (pair-fold cons '() lst)))
(cond ((eq? lst (car rev)) (list (car lst)))
((eq? (cdr lst) (car rev)) (list (car lst) (caar rev)))
(else (cons* (car lst) (caar rev)
(recur (cdr lst) (cdr rev))))))))

This is not really a sorting operation, more like a shuffling; here's another way to solve it. First, let's define the interleave procedure that alternates elements from two lists, returning a single list:
(define (interleave l1 l2)
(cond ((empty? l1) l2)
((empty? l2) l1)
(else (cons (first l1)
(interleave l2 (rest l1))))))
Now we take the original list and split-at the middle (this is a Racket-specific procedure); finally we interleave the two resulting lists, reversing the tail:
(define (zippy lst)
(let-values (((head tail) (split-at lst (quotient (length lst) 2))))
(interleave head (reverse tail))))
The above implementation IMHO is a bit more intuitive, and if you're working with Racket it doesn't require external libraries. It works as expected:
(zippy '(1 2 3 4 5 6))
=> '(1 6 2 5 3 4)

Related

Scheme: Trying to find largest element in two lists

I have 3 functions union, largest, and largest_of_two. Union takes two lists and combines them into one (this function has been tested and works). largest is supposed to return the largest element in a given list but only returns #f whether I call it via largest_of_two or on its own. Any help will be greatly appreciated.
(define (union l1 l2)
(cond (
(null? l1) l2)
((cons (car l1) (union (cdr l1) l2)))
)
)
(define (largest x a_list)
(cond
((null? a_list) x)
((< x (car a_list)) (= x (car a_list)))
(else (largest x (cdr a_list)))
)
)
(define (largest_of_two l1 l2)
(largest (car l1) (cdr (union l1 l2)))
)
(display(largest_of_two '(19 30 13 29 38) '(1 50 5 20 41)))
The fundamental problem is that (= x (car a_list)) is a comparison, but you need to make a recursive call here:
(define (largest x a_list)
(cond ((null? a_list) x)
((< x (car a_list)) ; if x is less than the first element
(largest (car a_list) (cdr a_list))) ; call with first element and cdr
(else
(largest x (cdr a_list)))))
When x is less than the first element of the list, you want to call largest again with the first element and a reduced list as arguments.
Yet, calling largest with two arguments like this seems awkward. If I want to find the largest element of the list (1 6 1 8 0 3) I have to call (largest 1 '(6 1 8 0 3)), which is not ideal. A better approach would be to discard the smaller of the first two elements on each iteration until there is only one element left:
(define (largest xs)
(cond ((null? xs) #f) ; empty input: no largest member
((null? (cdr xs)) ; only one member
(car xs))
((> (car xs) (cadr xs)) ; first member is larger than the second
(largest (cons (car xs) (cddr xs)))) ; keep the first member
(else
(largest (cdr xs))))) ; discard the first member
It doesn't make sense to return a numeric result when the input list is empty, so #fis returned in that case. If the input list contains only a single value, then that value is returned (note that this code does not verify that a list of one element contains a number, so (largest '(z)) --> z).
Otherwise the list contains at least two values. If the first is larger than the second, the first is consed onto the rest of the list with the second removed ((cddr xs)) and largest is called again on the result. Otherwise the first value is not larger than the second, so the first element is discarded ((cdr xs)) and largest is called on that result.
There is another minor issue with the posted definition of union in the conditional form:
((cons (car l1) (union (cdr l1) l2)))
There is only one test expression here. Now, this is legal Scheme because when a selected conditional clause contains only a test expression, the value of the test expression is returned. But this is not idiomatic, and it is hard to read. The posted definition for largest used else in a similar situation, and it should be used here, too. Or, just use an if form:
(define (union xs ys)
(if (null? xs)
ys
(cons (car xs) (union (cdr xs) ys))))
Be consistent; use formatting and line breaks to make code clear. And while we are talking about style, please don't scatter parentheses about haphazardly, and prefer kebab-case (aka lisp-case) to snake_case for identifiers in lisps.
With the new definition for largest, largest-of-two has a simpler definition:
(define (largest-of-two xs ys)
(largest (union xs ys)))
> (largest-of-two '(1 4 2 6 3 11 6 -2) '(3 8 -3 7 10 4))
11
Filtering is often called reduce in Scheme and functional languages. It is already explained in detail here. I quote the implementation:
(define (reduce fn list init)
(if (null? list) init
(fn (car list)
(reduce fn (cdr list) init))))
This is a very general function, which takes the operation, the list to operate on and an accumulator, which holds the value of each step.
You just need to implement your maximum function for two arguments.
(define (max a b)
(if (> a b)
a
b))
And then you can pass it to reduce. You just need to add an initial value.
(reduce max '(19 30 13 29 38) 0)
In your case it might be better to split your input list, because all elements can be negative.
(let ((lst '(19 30 13 29 38)))
(reduce max (cdr lst) (car lst)))
If you want to do anything twice or for even more arguments, just use map.
(map (lambda (lst)
(reduce max (cdr lst) (car lst)))
'((19 30 13 29 38)
(1 50 5 20 41)))
The following puts everything in one function.
(define (largest-of . lists)
(define (reduce fn list init)
(if (null? list) init
(fn (car list)
(reduce fn (cdr list) init))))
(define (max a b)
(if (> a b)
a
b))
(map (lambda (lst)
(reduce max (cdr lst) (car lst)))
lists))
(largest-of '(19 30 13 29 38) '(1 50 5 20 41)) ;; => (38 50)
This works also for more than two lists. It is just limited by the maximum number of arguments of your Scheme implementation.
And it works for just one argument.
(largest-of (largest-of '(19 30 13 29 38) '(1 50 5 20 41))) ;; => (50)
You just need to unbox the value with car.

Racket find shared elements between lists

I'm trying to create a specific response for a given list if it has shared elements with another list. As in if I have a list that is (My name is John) and I have another list of (John Adam Jacob) I would want the first list to be able to see that John is in the second list, and be able to print something along the lines of (this is a known name) or something similiar.
The code I have thought of uses map, and member.
(define (specific-reply user-list)
(cond (member (map (lambda (user-list)) '(John Adam Jacob)))
(write (this is a known name))
(else
(write (this is not a known name)))))
I'm extremely knew to both racket and scheme however and I haven't really gotten it to compile yet so I think I'm largely off.
Any help would be greatly appreciated.
You don't need to complicate the problem if your task is to just find if a is a member of (a b c),
Here's a piece of Scheme code that can tell if a is a member of lat.
It's just a simple recursive function that compares each element of lat with a for a match.
(define member?
(lambda (a lat)
(cond
((null? lat) #f)
((eq? a lat) #t)
(else
(member? a (cdr lat))))))
If you want to take this further and find the intersection of two lists, we can do something like this!
(define intersect
(lambda (set1 set2)
(letrec
((I (lambda (set)
(cond
((null? set) (quote ()))
((member? (car set) set2)
(cons (car set)
(I (cdr set))))
(else (I (cdr set)))))))
(I set1))))
You can use this code as such. Tested from guile compiler
(begin
(display (intersect `(1 2 3) `(1 3 4 5 2)))
(newline))
>> (1 2)
EDIT
I recommend you read The Little Schemer and the The Seasoned Schemer to get more familiar with these kind of concepts
Why not use set in racket:
(define (list-intersect-2 lst1 lst2)
(set->list
(set-intersect (list->set lst1)
(list->set lst2))))
For a solution that takes one or more lists:
(define (list-intersect lst1 . lstn)
(set->list
(foldl set-intersect
(list->set lst1)
(map list->set lstn))))
(list-intersect '(1 2 3) '(2 3 4) '(3 4 8))
; ==> (3)
One can also use built-in functions filter and member to find intersection of 2 lists:
(define (intersection l1 l2)
(remove-duplicates
(filter (λ (x) (member x l1))
l2)))
Above checks each item of l2 to keep it only if it is a member of l1 also.
One can also use for/list to check each element and return a list of common items:
(define (intersect l1 l2)
(remove-duplicates
(for/list ((i l1)
#:when (member i l2))
i)))
Both above function remove duplicates. Just avoiding use of remove-duplicates may result in different result if simply the order of l1 and l2 is interchaged. If one wants that the repeated elements to come repeatedly in outcome list, one can use following function in which common items are removed before proceeding:
(define (intersection2 l1 l2)
(let loop ((l1 l1)
(l2 l2)
(ol '()))
(cond
[(empty? l1) (reverse ol)]
[(member (first l1) l2) ; first item of l1 is common
(loop (rest l1) ; loop with rest of l1
(remove (first l1) l2) ; remove common item from l2
(cons (first l1) ol))] ; add common item to outlist
[else
(loop (rest l1)
l2
ol)])))
Testing:
(intersection2 '(2 4 2 7 2 10) '(10 2 9 2 0 11))
Output:
'(2 2 10)

Scheme dot product function of two lists

I'm trying to define a dot-prod function that takes two lists as parameters and applies the dot product version by taking x1*y1+x2*y2 and so on. I got it to work with an empty list but that is it. Thanks.
(define (dot-prod l1 l2)
(cond ((or (null? l1)(null? l2)) '())
(else
(cons (* (car l1) (car l2))
(* (cdr l1) (cdr l2))))))
This is perfect for using built-in procedures. Assuming that the lists have equal length:
(define (dot-prod l1 l2)
(apply + (map * l1 l2)))
But if you want to write a solution from scratch, you must:
Return a value that makes sense for the base case - if it's an addition, we want a zero there, not an empty list, we're not building a new list as output
Call the dot-prod procedure in the recursive step, something that you entirely forgot
Combine the result meaningfully - again, if we're doing an addition, we want to use + not cons
This is what I mean:
(define (dot-prod l1 l2)
(cond ((null? l1) 0)
(else
(+ (* (car l1) (car l2))
(dot-prod (cdr l1) (cdr l2))))))
Either way, it works as expected:
(dot-prod '(1 2 3) '(4 5 6))
=> 32
'for/sum' loop can be used here for a simple understandable function. If l and k are 2 lists:
(define (dotproduct l k)
(for/sum ((i l)(j k))
(* i j)))
Testing:
(dotproduct '(1 2 3) '(4 5 6))
; =>32
This can also be modified if (x y) values occur as a list of lists:
(define (f l)
(for/sum ((i l))
(apply * i)))
(f '((1 4)(2 5)(3 6)))
; => 32
The method is also extendable if x,y,z or even more values are to be evaluated.

Return alternate elements of 3 given lists. Scheme

This procedure is supposed to return a list with alternative values from 3 given lists. So for example (alt ('a b c)'(1 2 3)'(i j k)) should return '(a 1 i b 2 j c 3 k).
This is my logic so far. I would take the first element of each list and recursively call the procedure again with cdr as the new arguments.
(define (alternate lst1 lst2 lst3)
(cons (car lst1)
(cons (car lst2)
(cons (car lst3)
(alternate (cdr lst1)(cdr lst2)(cdr lst3))))))
The error occurs in
(cons (car lst1)
"mcar: contract violation
expected: mpair?
given()"
(cons a d) returns a newly allocated pair whose first element is a and second element is d. But since there are 3 not 2 given lists, is there another way to approach creating lists?
Would this be another approach?
(define (alternate lst1 lst2 lst3)
(list (car lst1)(car lst2)(car lst3))
(alternate (cdr lst1)(cdr lst2)(cdr lst3)))
You need to add empty list check to avoid the error. So your code should look like this:
(define (alternate lst1 lst2 lst3)
(if (or (null? lst1) (null? lst2) (null? lst3))
'()
(cons (car lst1)
(cons (car lst2)
(cons (car lst3)
(alternate (cdr lst1)(cdr lst2)(cdr lst3)))))))
If you can use SRFI-1 (or more precisely append-map), then you can also write like this:
(define (alt l1 l2 l3) (append-map list l1 l2 l3))
You can just use the following standard Scheme:
(define (alternate . lists)
(apply append (apply map list lists)))
Not very optimized, but does the job :)
Eval: http://eval.ironscheme.net/?id=175

Can I implement quicksort efficiently with Scheme?

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

Resources