The Liitle Schemer 4th page81 rember* function - scheme

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.

Related

Returning two parts of a list as a pair

In my program, I am supposed to write a function where it splits a list into even and odd. The problem is that the output/syntax is incorrect. I am getting ((1 3) (2 4)) when testing out the example (split '(1 2 3 4)). The output needs to look like ((1 3) 2 4)
Here is my code:
(define (split l)
(define (odd l)
(if (null? l) '()
(if (null? (cdr l)) (list (car l))
(cons (car l) (odd (cddr l))))))
(define (even l)
(if (null? l) '()
(if (null? (cdr l)) '()
(cons (cadr l) (even (cddr l))))))
(cons (odd l) (cons (even l) '())))
(even l) is already a list. You don't need to wrap it in an extra cons.
The code below should work.
(define (split l)
(define (odd l)
(if (null? l) '()
(if (null? (cdr l)) (list (car l))
(cons (car l) (odd (cddr l))))))
(define (even l)
(if (null? l) '()
(if (null? (cdr l)) '()
(cons (cadr l) (even (cddr l))))))
(cons (odd l) (even l)))

Recurring with anonymous functions Common Lisp vs. Scheme

I'm working through the Little Schemer and I'm trying to convert all of the answers into Common Lisp.
In chapter 8, anonymous functions are discussed, as well as returning anonymous functions.
For example:
(define insertL-f
(lambda (test?)
(lambda (new old l)
(cond
((null? l) (quote ()))
((test? (car l) old) (cons new l)))
(else (cons (car l) ((insertL-f test?) new old (cdr l))))))))
My code:
(defun insertL-f (test)
(lambda (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l) (insertL-f test) new old (cdr l))))))
The problem is the last line of the second block of code. I get the error "too many arguments for cons" but I can't add an extra pair of parentheses like the Scheme code does. Is this style of recursion just not possible in Common Lisp?
(defun insertL-f (test)
(lambda (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l)
(funcall (insertL-f test)
new
old
(cdr l)))))))
insertL-f returns a function and in your Scheme version you apply it while in CL have flattened the list instead if applying it with funcall However it seems like the function that is to be returned is equal to the one it fetches so you can cache it by defining it locally with labels:
(defun insert-l-f (test)
(labels ((func (new old l)
(cond
((null l) '())
((funcall test (car l) old) (cons new l))
(t (cons (car l) (func new old (cdr l)))))))
#'func))
The same in Scheme using local define (which really is aletrec with flatter syntax):
(define (insert-l-f test?)
(define (func new old l)
(cond
((null? l) (quote ()))
((test? (car l) old) (cons new l)))
(else (cons (car l) (func new old (cdr l)))))
func)

Sort function with customizable comparision function

After writing:
(define (sort-asc l)
(cond ((eq? l '()) '())
((eq? (cdr l) '()) (list (car l)))
((< (car l) (cadr l)) (cons (car l) (sort-asc (cdr l)) ))
(else (cons (cadr l) (sort-asc (cons (car l) (cddr l)) )))))
How do you write a function that can additionally take a comparison function as a parameter?
Tried:
(define (sort-f l f)
(cond ((eq? l '()) '())
((eq? (cdr l) '()) (list (car l)))
((lambda ()(f (car l) (cadr l))) (cons (car l) (sort-f (cdr l) f)))
(else (cons (cadr l) (sort-f (cons (car l) (cddr l)) f)))))
But (sort-f '(4 3 8 2 5) <) returns the same list.
p.s. Is there any way to make this code look more elegant by somehow rewriting of all the car's, cadr's and cdr's?
Your third cond branch condition should be (f (car l) (cadr l)), not (lambda () ...). The lambda expression returns a procedure (which is not invoked), and since all procedures are truthy, the fourth (else) branch is never reached.
That is,
((lambda ()(f (car l) (cadr l))) (cons (car l) (sort-f (cdr l) f)))
should be
((f (car l) (cadr l)) (cons (car l) (sort-f (cdr l) f)))

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

How to improve this mergesort in scheme?

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.

Resources