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)
Related
I have code which is inserting new word on the right side of choosen word
(define insertR
(lambda (new old lst)
(cond
((null? lst) (lst))
(else (cond
((eq? (car lst) old)
(cons old
(cons new (cdr lst))))
(else (cons (car lst)
(insertR new old
(cdr lst)))))))))
i need to make it insert that word beside first appearance of word starting from the end of list. Tried to work with reverse but could not get that to work.
There are two strategies you can take to add it next to the last occurence.
The first is to use a helper and start off with the reverse list. This is very simple and my preferred solution.
(define (insert-by-last-match insert find lst)
(let loop ((lst (reverse lst)) (acc '()))
(if (null? lst)
acc
(let ((a (car lst)))
(if (equal? a find)
(append (reverse (cdr lst))
(list* find insert acc))
(loop (cdr lst) (cons a acc)))))))
The other one is kind of obscure. Whenever you find the element you replace last-match with a callback that replaces the computation since it was made and until it gets called with the replacement and the rest of the list, which of course is the correct result. The work done until the end of the list is simply discarded since it is not used, but we do it since we are not sure if we are going to find a later one and then all the work uptil that is of course included in the result.
(define (insert-by-last-match insert find lst)
(define (helper lst last-match)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)))
(cons a
(if (equal? a find)
(let/cc k
(helper d (lambda () (k (cons insert d)))))
(helper d last-match))))))
(helper lst (lambda () lst)))
call/cc (or its variant let/cc) is often described as time travel or advanced goto. It is not very intuitive. Here is a CPS version:
(define (insert-by-last-match insert find lst)
(define (helper lst last-match k)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)) (k2 (lambda (v) (k (cons a v)))))
(if (equal? a find)
(helper d (lambda () (k2 (cons insert d))) k2)
(helper d last-match k2)))))
(helper lst (lambda () lst) (lambda (v) v)))
Basically this is the same as the previous only that here I have written the CPS code and with the let/cc version the implementation does it for me and I get to use k exactly where I need it. In this version you see there is no magic or time travel but the execution that should happen later is simply replaced at a point.
Write in a similar way insertL and apply it to the reversed list.
And reverse the result. Then you will have an insertion beside first appearance of word starting from the end of list
(define insertL
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons new lst))
(else (cons (car lst) (insertL new old (cdr lst)))))))
(define last-insertR
(lambda (new old lst)
(let* ((rlst (reverse lst))
(result (insertL new old rlst)))
(reverse result))))
test:
(last-insertR 'aa 'a '(b c d a h i a g))
;; '(b c d a h i a aa g)
By the way, the beauty of cond is that you can put the conditions always at the beginning - listed one under the other.
So one can write your insertR nicer as:
(define insertR
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons old (cons new (cdr lst))))
(else (cons (car lst) (insertR new old (cdr lst)))))))
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.
I have this method I wrote
(define (lev n L)
;(set! L(apply append L))
(cond ((null? L) '())
((eq? n (car (car L))) (car L))
(else (lev n (cdr L)))))
I want to apply the 'set!' only once before recursion and be done with it. I can't think of how to do this.
Try this:
(define (lev n L)
(let loop ((L (apply append L)))
(cond ((null? L) '())
((eq? n (car (car L))) (car L))
(else (loop (cdr L))))))
Here we're using a named let for defining a helper procedure inside lev (in this example, it's called loop), and before calling it we apply append to the input list and assign it to a new variable, also called L. In this case it's not necessary to use set!, in idiomatic Scheme we tend to avoid mutation operations.
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)]))
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.