How to improve this mergesort in scheme? - algorithm

I am a C++ programmer, I wrote this code to see if I can think functionally :)
Any hints to improve it ?
(define (append listOne listTwo)
(cond
((null? listOne) listTwo)
(else (cons (car listOne) (append (cdr listOne) listTwo)))))
(define (merge listOne listTwo)
(cond
((null? listOne) listTwo)
((null? listTwo) listOne)
((< (car listOne) (car listTwo))
(append (cons (car listOne) '())
(merge (cdr listOne) listTwo)))
((= (car listOne) (car listTwo))
(append (cons (car listOne) '())
(merge (cdr listOne) listTwo)))
(else (append (cons (car listTwo) '())
(merge listOne (cdr listTwo))))))
(define (mergesort lis)
(cond
((null? lis) '())
((null? (cdr lis)) lis)
(else (merge (cons (car lis) '())
(mergesort (cdr lis))))))
(mergesort '(99 77 88 66 44 55 33 11 22 0))

There's only one small improvement that I see:
(append (cons (car listTwo) '())
(merge listOne (cdr listTwo))))
can everywhere be simplified to
(cons (car listTwo)
(merge listOne (cdr listTwo)))
I think you were thinking of something like (in Python-esque syntax):
[car(listTwo)] + merge(listOne, cdr(listTwo))
But cons adds an item directly to the front of a list, like a functional push, so it's like the following code:
push(car(listTwo), merge(listOne, cdr(listTwo)))
Ultimately the extra append only results in double cons cell allocation for each item, so it's not a big deal.
Also, I think you might get better performance if you made mergesort fancier so that it maintains the list length and sorts both halves of the list at each step. This is probably not appropriate for a learning example like this, though.
Something like:
(define (mergesort l)
(let sort-loop ((l l) (len (length l)))
(cond
((null? l) '())
((null? (cdr l)) l)
(else (merge (sort-loop (take (/ len 2) l) (/ len 2)))
(sort-loop (drop (/ len 2) l) (/ len 2)))))))))
(define (take n l)
(if (= n 0)
'()
(cons (car l) (take (sub1 n) (cdr l)))))
(define (drop n l)
(if (= n 0)
l
(drop (sub1 n) (cdr l))))

In general, mergesort is doing a lot of list manipulations, so it is much better to do things destructively by sorting sub parts "in-place". You can see the implementation of sort in PLT Scheme for example of a common code, which originated in SLIB. (It might look intimidating on first sight, but if you read the comments and ignore the knobs and the optimizations, you'll see it all there.)
Also, you should look at SRFI-32 for an extended discussion of a sorting interface.

Related

The Liitle Schemer 4th page81 rember* function

I'm studying The Liitle Schemer 4th.
Sometimes I have a different solution. It confuses me and I can't easily understand the standard answer of the book.
For example, with rember*:
My solution is :
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? l) l)
((eq? a (car l)) (rember* a (cdr l)))
(else (cons (rember* a (car l)) (rember* a (cdr l)))))))
The book's solution:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (car l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l)))))))
Which is better?
One more question.
Original structure:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? (car l) a)
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (car l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l)))))))
New structrue:
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l)) (cond
((eq? (car l) a) (rember* a (cdr l)))
(else (cons (car l) (rember* a (cdr l))))))
(else (cons (rember* a (car l)) (rember* a (cdr l)))))))
Which is better for everyone?
In general, is not unusual that the same function is implemented by different programs. In your example, however, the two programs implement different functions, so that I think is not immediate to say “which is the best”.
The second program (that of the book), implements a function defined over the domain of the lists, and only that domain. So, you cannot give to it an atom, for instance, since it would produce an error.
The first one (your version), on the other hand, can be applied to lists (and in this case has the same behaviour of the second one), but can be applied also to atoms, so that you can do, for instance:
(rember* 'a 'a) ; returns a
(rember* 'a 'b) ; returns b
So, one should look at the specification of the function, and see if a program implements in a consistent way this specification. I would say that the first program in not entirely consistent with the specification of the function (remove an element from the second argument), but this is just an opinion, since the function is well defined only over the domain of the lists.

Combining count and flatten functions in scheme

So i have these two functions that work fine alone. I am trying to write one function to accomplish both but i keep getting a car error. Any guidance on the best way to solve this?
(define (countNumbers lst)
(cond
((null? lst) 0)
((number? (car lst))(+ 1 (countNumbers (cdr lst))))
(else (countNumbers (cdr lst)))))
(define (flatten x)
(cond ((null? x) '())
((pair? x) (append (flatten (car x)) (flatten (cdr x))))
(else (list x))))
I tried something like this im rather new to functional programming in general so im still trying to wrap my mind around it it says the problem is after number?(car lst)
(define (flatten lst)
(cond ((null? lst) '())
((pair? lst) (append (flatten (car lst)) (flatten (cdr lst))))
(else (list(cond
((null? lst) 0)
((number? (car lst))(+ 1 (flatten (cdr lst))))
(else (flatten (cdr lst))))))))
As I mentioned in my comment, I don't think it's a good idea to stick everything in a single function. Anyway, you were kinda on the right track, but we have to remember that if we're going to return a number as the final result, then our base case should reflect this and also return a number (not an empty list), and the combining step should add numbers, not append them. This is what I mean:
(define (count-flatten lst)
(cond ((null? lst) 0)
((pair? lst)
(+ (count-flatten (car lst))
(count-flatten (cdr lst))))
((number? lst) 1)
(else 0)))
But I'd rather do this:
(define (count-flatten lst)
(countNumbers (flatten lst)))
We can even write an idiomatic solution using only built-in procedures, check your interpreter's documentation, but in Racket we can do this:
(define (count-flatten lst)
(count number? (flatten lst)))
Anyway, it works as expected:
(count-flatten '(1 x (x 2) x (3 (4 x (5) 6) 7)))
=> 7

List order after duplicate filtering

I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)

How to sort disorder list of numbers in scheme

What it the proper way to sort a list with values in Scheme? For example I have the values which are not ordered:
x1, x5, x32 .... xn
or
3, 4, 1, 3, 4, .. 9
First I want to for them by increase number and display them in this order:
x1, xn, x2, xn-1
or
1, 6, 2, 5, 3, 4
Any help will be valuable.
This is the same question you posted before, but with a small twist. As I told you in the comments of my answer, you just have to sort the list before rearranging it. Here's a Racket solution:
(define (interleave l1 l2)
(cond ((empty? l1) l2)
((empty? l2) l1)
(else (cons (first l1)
(interleave l2 (rest l1))))))
(define (zippy lst)
(let-values (((head tail) (split-at
(sort lst <) ; this is the new part
(quotient (length lst) 2))))
(interleave head (reverse tail))))
It works as expected:
(zippy '(4 2 6 3 5 1))
=> '(1 6 2 5 3 4)
This R6RS solution does what Chris Jester-Young proposes and it really is how to do it the bad way. BTW Chris' and Óscar's solutions on the same question without sorting is superior to this zippy procedure.
#!r6rs
(import (rnrs base)
(rnrs sorting)) ; list-sort
(define (zippy lis)
(let loop ((count-down (- (length lis) 1))
(count-up 0))
(cond ((> count-up count-down) '())
((= count-up count-down) (cons (list-ref lis count-down) '()))
(else (cons (list-ref lis count-down)
(cons (list-ref lis count-up)
(loop (- count-down 1)
(+ count-up 1))))))))
(define (sort-rearrange lis)
(zippy (list-sort < lis)))
Here is a simple, tail-recursive approach that uses a 'slow/fast' technique to stop the recursion when half the list is traversed:
(define (interleave l)
(let ((l (list-sort < l)))
(let merging ((slow l) (fast l) (revl (reverse l)) (rslt '()))
(cond ((null? fast)
(reverse rslt))
((null? (cdr fast))
(reverse (cons (car slow) rslt)))
(else
(merging (cdr slow) (cddr fast) (cdr revl)
(cons (car revl) (cons (car slow) rslt))))))))
So, you don't mind slow and just want a selection-based approach, eh? Here we go....
First, we define a select1 function that gets the minimum (or maximum) element, followed by all the other elements. For linked lists, this is probably the simplest approach, easier than trying to implement (say) quickselect.
(define (select1 lst cmp?)
(let loop ((seen '())
(rest lst)
(ext #f)
(extseen '()))
(cond ((null? rest)
(cons (car ext) (append-reverse (cdr extseen) (cdr ext))))
((or (not ext) (cmp? (car rest) (car ext)))
(let ((newseen (cons (car rest) seen)))
(loop newseen (cdr rest) rest newseen)))
(else
(loop (cons (car rest) seen) (cdr rest) ext extseen)))))
Now actually do the interweaving:
(define (zippy lst)
(let recur ((lst lst)
(left? #t))
(if (null? lst)
'()
(let ((selected (select1 lst (if left? < >))))
(cons (car selected) (recur (cdr selected) (not left?)))))))
This approach is O(n²), whereas the sort-and-interleave approach recommended by everybody else here is O(n log n).

Writing flatten method in Scheme

I have been working on the following function flatten and so far have it working for just lists. I was wondering if someone could provide me with some insight on how to get it work with pairs? For example (flatten '(a .a)) would return (a a). Thanks.
(define (flatten list)
(cond ((null? list) null)
((list? (car list)) (append (flatten (car list)) (flatten (cdr list))))
(else
(cons (car list) (flatten (cdr list))))))
Here's one option:
(define (flatten x)
(cond ((null? x) '())
((pair? x) (append (flatten (car x)) (flatten (cdr x))))
(else (list x))))
This does what you want, without requiring append, making it o(n). I walks the list as a tree. Some schemes might throw a stack overflow error if the list is too deeply nested. In guile this is not the case.
I claim no copyright for this code.
(define (flatten lst)
(let loop ((lst lst) (acc '()))
(cond
((null? lst) acc)
((pair? lst) (loop (car lst) (loop (cdr lst) acc)))
(else (cons lst acc)))))
(define (flatten l)
(cond
[(empty? l) empty]
[(list? l)
(append (flatten (first l))
(flatten (rest l)))]
[else (list l)]))

Resources