Lisp - Split Recursive - recursion

I was trying to make a recursive function to split a list into two lists according the number of elements one wants.
Ex:
(split 3 '(1 3 5 7 9)) ((1 3 5) (7 9))
(split 7 '(1 3 5 7 9)) ((1 3 5 7 9) NIL)
(split 0 '(1 3 5 7 9)) (NIL (1 3 5 7 9))
My code is like this:
(defun split (e L)
(cond ((eql e 0) '(() L))
((> e 0) (cons (car L) (car (split (- e 1) (cdr L))))))))
I don't find a way to join the first list elements and return the second list.

Tail recursive solution
(defun split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((>= 0 n) (list (reverse acc-l) l))
(t (split (1- n) (cdr l) (cons (car l) acc-l)))))
Improved version
(in this version, it is ensured that acc-l is at the beginning '()):
(defun split (n l)
(labels ((inner-split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((= 0 n) (list (reverse acc-l) l))
(t (inner-split (1- n) (cdr l) (cons (car l) acc-l))))))
(inner-split n l)))
Test it:
(split 3 '(1 2 3 4 5 6 7))
;; returns: ((1 2 3) (4 5 6 7))
(split 0 '(1 2 3 4 5 6 7))
;; returns: (NIL (1 2 3 4 5 6 7))
(split 7 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split 9 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split -3 '(1 2 3 4 5 6 7))
;; returns (NIL (1 2 3 4 5 6 7))
In the improved version, the recursive function is placed one level deeper (kind of encapsulation) by using labels (kind of let which allows definition of local functions but in a way that they are allowed to call themselves - so it allows recursive local functions).
How I came to the solution:
Somehow it is clear, that the first list in the result must result from consing one element after another from the beginning of l in successive order. However, consing adds an element to an existing list at its beginning and not its end.
So, successively consing the car of the list will lead to a reversed order.
Thus, it is clear that in the last step, when the first list is returned, it hast to be reversed. The second list is simply (cdr l) of the last step so can be added to the result in the last step, when the result is returned.
So I thought, it is good to accumulate the first list into (acc-l) - the accumulator is mostly the last element in the argument list of tail-recursive functions, the components of the first list. I called it acc-l - accumulator-list.
When writing a recursive function, one begins the cond part with the trivial cases. If the inputs are a number and a list, the most trivial cases - and the last steps of the recursion, are the cases, when
the list is empty (equal l '()) ---> (null l)
and the number is zero ----> (= n 0) - actually (zerop n). But later I changed it to (>= n 0) to catch also the cases that a negative number is given as input.
(Thus very often recursive cond parts have null or zerop in their conditions.)
When the list l is empty, then the two lists have to be returned - while the second list is an empty list and the first list is - unintuitively - the reversed acc-l.
You have to build them with (list ) since the list arguments get evaluated shortly before return (in contrast to quote = '(...) where the result cannot be evaluated to sth in the last step.)
When n is zero (and later: when n is negative) then nothing is to do than to return l as the second list and what have been accumulated for the first list until now - but in reverse order.
In all other cases (t ...), the car of the list l is consed to the list which was accumulated until now (for the first list): (cons (car l) acc-l) and this I give as the accumulator list (acc-l) to split and the rest of the list as the new list in this call (cdr l) and (1- n). This decrementation in the recursive call is very typical for recursive function definitions.
By that, we have covered all possibilities for one step in the recursion.
And that makes recursion so powerful: conquer all possibilities in ONE step - and then you have defined how to handle nearly infinitely many cases.
Non-tail-recursive solution
(inspired by Dan Robertson's solution - Thank you Dan! Especially his solution with destructuring-bind I liked.)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (destructuring-bind (left right) (split (1- n) (cdr l))
(list (cons (car l) left) right)))))
And a solution with only very elementary functions (only null, list, >=, let, t, cons, car, cdr, cadr)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (let ((res (split (1- n) (cdr l))))
(let ((left-list (car res))
(right-list (cadr res)))
(list (cons (car l) left-list) right-list))))))

Remember: split returns a list of two lists.
(defun split (e L)
(cond ((eql e 0)
'(() L)) ; you want to call the function LIST
; so that the value of L is in the list,
; and not the symbol L itself
((> e 0)
; now you want to return a list of two lists.
; thus it probably is a good idea to call the function LIST
; the first sublist is made of the first element of L
; and the first sublist of the result of SPLIT
; the second sublist is made of the second sublist
; of the result of SPLIT
(cons (car L)
(car (split (- e 1)
(cdr L)))))))

Well let’s try to derive the recursion we should be doing.
(split 0 l) = (list () l)
So that’s our base case. Now we know
(split 1 (cons a b)) = (list (list a) b)
But we think a bit and we’re building up the first argument on the left and the way to build up lists that way is with CONS so we write down
(split 1 (cons a b)) = (list (cons a ()) b)
And then we think a bit and we think about what (split 0 l) is and we can write down for n>=1:
(split n+1 (cons a b)) = (list (cons a l1) l2) where (split n b) = (list l1 l2)
So let’s write that down in Lisp:
(defun split (n list)
(ecase (signum n)
(0 (list nil list))
(1 (if (cdr list)
(destructuring-bind (left right) (split (1- n) (cdr list))
(list (cons (car list) left) right))
(list nil nil)))))
The most idiomatic solution would be something like:
(defun split (n list)
(etypecase n
((eql 0) (list nil list))
(unsigned-integer
(loop repeat n for (x . r) on list
collect x into left
finally (return (list left r))))))

Related

How to return false if the number is not found in the list

So, I am trying to do this hw problem: write a function that takes two arguments, a list and a number, and the function returns the index of the leftmost occurrence of the number in the list. For example:
If '(1 2 3 3 4) and num = 3, then it returns 2
If '(3 2 3 3 4) and num = 3, then it returns 0
I was able to do that part but what if the number was never found? What if I want to return false when num is not found in the list? How do I do that?
Please remember, I am trying to do this in proper recursion, not tail recursion.
Here's my code.
(define (first_elt_occ lst num)
(cond
((null? lst) #f)
((eq? (car lst) num) 0)
(else
(+ 1 (first_elt_occ (cdr lst) num)))))
(first_elt_occ '(1 2 3 3 4) 3) ;2
(first_elt_occ '(3 2 3 3 4) 3) ;0
(first_elt_occ '(1 2 5 4 3) 3) ;4
(first_elt_occ '(1 2 5 4 3) 6) ;Error
;(makes sense because you can't add boolean expression)
Another question I have is, how would I approach this problem, if I was asked to return the index of the rightmost occurrence of the number in a list (proper recursion). For example: '(3 4 5 4 3 7 ), num = 3 returns 4.
Thank you!
As suggested in the comments, this will be easier if we implement the procedure using tail recursion - by the way, tail recursion is "proper recursion", what makes you think otherwise?
By defining a helper procedure called loop and passing the accumulated result in a parameter, we can return either #f or the index of the element:
(define (first_elt_occ lst num)
(let loop ((lst lst) (acc 0))
(cond
((null? lst) #f)
((equal? (car lst) num) acc)
(else (loop (cdr lst) (add1 acc))))))
If, for some bizarre requirement you can't use tail recursion in your solution, it's possible to rewrite you original solution to account for the case when the answer is #f - but this isn't as elegant or efficient:
(define (first_elt_occ lst num)
(cond
((null? lst) #f)
((equal? (car lst) num) 0)
(else
(let ((result (first_elt_occ (cdr lst) num)))
(if (not result) #f (add1 result))))))
Either way, it works as expected:
(first_elt_occ '(1 2 3 3 4) 3) ; 2
(first_elt_occ '(3 2 3 3 4) 3) ; 0
(first_elt_occ '(1 2 5 4 3) 3) ; 4
(first_elt_occ '(1 2 5 4 3) 6) ; #f
I don't recommend actually taking this approach because a normal tail-recursive implementation is a lot more efficient, simpler, and easier to understand, but you can use a continuation to short-circuit unwinding the call stack in the failure case:
(define (first_elt_occ lst num)
(call/cc
(lambda (return)
(letrec ((loop (lambda (lst)
(cond
((null? lst) (return #f))
((= (car lst) num) 0)
(else (+ 1 (loop (cdr lst))))))))
(loop lst)))))
The basic find first occurrence "skeleton" function is
(define (first_elt_occ lst num)
(and (not (null? lst))
(or (equal (car lst) num)
(first_elt_occ (cdr lst) num))))
This does not return index though. How to add it in?
(define (first_elt_occ lst num)
(and (not (null? lst))
(or (and (equal (car lst) num) 0)
(+ 1 (first_elt_occ (cdr lst) num)))))
Does it work? Not if the element isn't there! It'll cause an error then. How to fix that? Change the +, that's how!
(define (first_elt_occ lst num)
(let ((+ (lambda (a b) (if b (+ a b) b))))
(and (not (null? lst))
(or (and (= (car lst) num) 0)
(+ 1 (first_elt_occ (cdr lst) num))))))
And now it works as expected:
> (first_elt_occ '(1 2 3 3 4) 3)
2
> (first_elt_occ '(3 2 3 3 4) 3)
0
> (first_elt_occ '(3 2 3 3 4) 5)
#f
And to get your second desired function, we restructure it a little bit, into
(define (first_elt_occ lst num)
(let ((+ (lambda (a b) ...... )))
(and (not (null? lst))
(+ (and (= (car lst) num) 0)
(first_elt_occ (cdr lst) num)))))
Now, what should that new + be? Can you finish this up? It's straightforward!
It's unclear why you are opposed to tail recursion. You talk about "proper recursion", which is not a technical term anyone uses, but I assume you mean non-tail recursion: a recursive process rather than an iterative one, in SICP terms. Rest assured that tail recursion is quite proper, and in general is preferable to non-tail recursion, provided one does not have to make other tradeoffs to enable tail recursion.
As Óscar López says, this problem really is easier to solve with tail recursion. But if you insist, it is certainly possible to solve it the hard way. You have to avoid blindly adding 1 to the result: instead, inspect it, adding 1 to it if it's a number, or returning it unchanged if it's false. For example, see the number? predicate.

Question about foldl function in Racket. (Functional programming)

So I have this line of code:
(foldl cons '() '(1 2 3 4))
And the output I get when I run it is this:
'(4 3 2 1)
Can you please explain to me why I don’t get '(1 2 3 4) instead?
I read the documentation but I am still a bit confused about how foldl works. Also if I wanted to define foldl how would I specify in Racket that the function can take a variable amount of lists as arguments?
Thanks!
Yes. By the definition of left fold, the combining function is called with the first element of the list and the accumulated result so far, and the result of that call is passed (as the new, updated accumulated result so far) to the recursive invocation of foldl with the same combining function and the rest of the list:
(foldl cons '() '(1 2 3))
=
(foldl cons (cons 1 '()) '(2 3))
=
(foldl cons (cons 2 (cons 1 '())) '(3))
=
(foldl cons (cons 3 (cons 2 (cons 1 '()))) '())
=
(cons 3 (cons 2 (cons 1 '())))
And when the list is empty, the accumulated result so far is returned as the final result.
To your second question, variadic functions in Scheme are specified with the dot . in the argument list, like so:
(define (fold-left f acc . lists)
(if (null? (first lists)) ;; assume all have same length
acc
(apply fold-left ;; recursive call
f
(apply f (append (map first lists) ;; combine first elts
(list acc))) ;; with result so far
(map rest lists)))) ;; the rests of lists
Indeed,
(fold-left (lambda (a b result)
(* result (- a b)))
1
'(1 2 3)
'(4 5 6))
returns -27.

Scheme run length encoding

The problem is to:
Write a function (encode L) that takes a list of atoms L and run-length encodes the list such that the output is a list of pairs of the form (value length) where the first element is a value and the second is the number of times that value occurs in the list being encoded.
For example:
(encode '(1 1 2 4 4 8 8 8)) ---> '((1 2) (2 1) (4 2) (8 3))
This is the code I have so far:
(define (encode lst)
(cond
((null? lst) '())
(else ((append (list (car lst) (count lst 1))
(encode (cdr lst)))))))
(define (count lst n)
(cond
((null? lst) n)
((equal? (car lst) (car (cdr lst)))
(count (cdr lst) (+ n 1)))
(else (n)))))
So I know this won't work because I can't really think of a way to count the number of a specific atom in a list effectively as I would iterate down the list. Also, Saving the previous (value length) pair before moving on to counting the next unique atom in the list. Basically, my main problem is coming up with a way to keep a count of the amount of atoms I see in the list to create my (value length) pairs.
You need a helper function that has the count as additional argument. You check the first two elements against each other and recurse by increasing the count on the rest if it's a match or by consing a match and resetting count to 1 in the recursive call.
Here is a sketch where you need to implement the <??> parts:
(define (encode lst)
(define (helper lst count)
(cond ((null? lst) <??>)
((null? (cdr lst)) <??>))
((equal? (car lst) (cadr lst)) <??>)
(else (helper <??> <??>))))
(helper lst 1))
;; tests
(encode '()) ; ==> ()
(encode '(1)) ; ==> ((1 1))
(encode '(1 1)) ; ==> ((1 2))
(encode '(1 2 2 3 3 3 3)) ; ==> ((1 1) (2 2) (3 4))
Using a named let expression
This technique of using a recursive helper procedure with state variables is so common in Scheme that there's a special let form which allows you to express the pattern a bit nicer
(define (encode lst)
(let helper ((lst lst) (count 1))
(cond ((null? lst) <??>)
((null? (cdr lst)) <??>))
((equal? (car lst) (cadr lst)) <??>)
(else (helper <??> <??>)))))
Comments on the code in your question: It has excess parentheses..
((append ....)) means call (append ....) then call that result as if it is a function. Since append makes lists that will fail miserably like ERROR: application: expected a function, got a list.
(n) means call n as a function.. Remember + is just a variable, like n. No difference between function and other values in Scheme and when you put an expression like (if (< v 3) + -) it needs to evaluate to a function if you wrap it with parentheses to call it ((if (< v 3) + -) 5 3); ==> 8 or 2

Recursion on a list in Scheme - avoid premature termination

I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))

Given a recursive function, how do I change it to tail recursive and streams?

Given a recursive function in scheme how do I change that function to tail recursive, and then how would I implement it using streams? Are there patterns and rules that you follow when changing any function in this way?
Take this function as an example which creates a list of numbers from 2-m (this is not tail recursive?)
Code:
(define listupto
(lambda (m)
(if (= m 2)
'(2)
(append (listupto (- m 1)) (list m)))))
I'll start off by explaining your example. It is definitely not tail recursive. Think of how this function executes. Each time you append you must first go back and make the recursive call until you hit the base case, and then you pull your way back up.
This is what a trace of you function would look like:
(listupto 4)
| (append (listupto(3)) '4)
|| (append (append (listupto(2)) '(3)) '(4))
||| (append (append '(2) '(3)) '(4))
|| (append '(2 3) '(4))
| '(2 3 4)
'(2 3 4)
Notice the V-pattern you see pulling in and then out of the recursive calls. The goal of tail recursion is to build all of the calls together, and only make one execution. What you need to do is pass an accumulator along with your function, this way you can only make one append when your function reaches the base case.
Here is the tail recursive version of your function:
(define listupto-tail
(lambda (m)
(listupto m '())))
# Now with the new accumulator parameter!
(define listupto
(lambda (m accu)
(if (= m 2)
(append '(2) accu)
(listupto (- m 1) (append (list m) accu)))))
If we see this trace, it will look like this:
(listupto 4)
| (listupto (3) '(4)) # m appended with the accu, which is the empty list currently
|| (listupto (2) '(3 4)) # m appended with accu, which is now a list with 4
||| (append '(2) '(3 4))
'(2 3 4)
Notice how the pattern is different, and we don't have to traverse back through the recursive calls. This saves us pointless executions. Tail recursion can be a difficult concept to grasp I suggest taking a look here. Chapter 5 has some helpful sections in it.
Generally to switch to a tail recursive form you transform the code so that it takes an accumulator parameter which builds the result up and is used as the final return value. This is generally a helper function which your main function delegates too.
Something of the form:
(define listupto
(lambda (m)
(listupto-helper m '())))
(define listupto-helper
(lambda (m l)
(if (= m 2)
(append '(2) l)
(listupto-helper (- m 1) (append (list m) l)))))
As the comments point out, the helper function can be replaced with a named let which is apparently (haven't done much/enough Scheme!) more idiomatic (and as the comments suggest cons is much better than creating a list and appending.
(define listupto
(lambda (n)
(let loop ((m n) (l '()))
(if (= m 2)
(append '(2) l)
(loop (- m 1) (cons m l))))))
You also ask about streams. You can find a SICP styled streams used e.g. here or here which have a from-By stream builder defined:
;;;; Stream Implementation
(define (head s) (car s))
(define (tail s) ((cdr s)))
(define-syntax s-cons
(syntax-rules ()
((s-cons h t) (cons h (lambda () t)))))
;;;; Stream Utility Functions
(define (from-By x s)
(s-cons x (from-By (+ x s) s)))
Such streams creation relies on macros, and they must be accessed by special means:
(define (take n s)
(cond ; avoid needless tail forcing for n == 1 !
((= n 1) (list (head s))) ; head is already forced
((> n 1) (cons (head s) (take (- n 1) (tail s))))
(else '())))
(define (drop n s)
(cond
((> n 0) (drop (- n 1) (tail s)))
(else s)))
But they aren't persistent, i.e. take and drop recalculate them on each access. One way to make streams persistent is to have a tailing closure surgically altering the last cons cell on access:
(1 . <closure>)
(1 . (2 . <closure>))
....
like this:
(define (make-stream next this state)
(let ((tcell (list (this state)))) ; tail sentinel cons cell
(letrec ((g (lambda ()
(set! state (next state))
(set-cdr! tcell (cons (this state) g))
(set! tcell (cdr tcell))
tcell)))
(set-cdr! tcell g)
tcell)))
(define (head s) (car s))
(define (tail s)
(if (or (pair? (cdr s))
(null? (cdr s)))
(cdr s)
((cdr s))))
We can now use it like this
(define a (make-stream (lambda (i) (+ i 1)) (lambda (i) i) 1))
;Value: a
a
;Value 13: (1 . #[compound-procedure 14])
(take 3 a)
;Value 15: (1 2 3)
a
;Value 13: (1 2 3 . #[compound-procedure 14])
(define b (drop 4 a))
;Value: b
b
;Value 16: (5 . #[compound-procedure 14])
a
;Value 13: (1 2 3 4 5 . #[compound-procedure 14])
(take 4 a)
;Value 17: (1 2 3 4)
a
;Value 13: (1 2 3 4 5 . #[compound-procedure 14])
Now, what does (make-stream (lambda (i) (list (cadr i) (+ (car i) (cadr i)))) car (list 0 1)) define?
update: in Daniel Friedman's 1994 slides "The Joys of Scheme, Cont'd" we find simpler implementation of these "memoized streams" (as they are called there), making the tail function itself store the forced stream in the tail sentinel, as
(define (tail s)
(if (or (pair? (cdr s))
(null? (cdr s)))
(cdr s)
(let ((n ((cdr s))))
(set-cdr! s n)
(cdr s))))
;; can be used as e.g. (https://ideone.com/v6pzDt)
(define fibs
(let next-fib ((a 0) (b 1))
(s-cons a (next-fib b (+ a b)))))
Here's a tail recursive form -
(define (listupto n)
(let run
((m 0)
(return identity))
(if (> m n)
(return null)
(run (add1 m)
(lambda (r) (return (cons m r)))))))
(listupto 9)
; '(0 1 2 3 4 5 6 7 8 9)
And here it is as a stream -
(define (listupto n)
(let run
((m 0))
(if (> m n)
empty-stream
(stream-cons m
(run (add1 m))))))
(stream->list (listupto 9))
; '(0 1 2 3 4 5 6 7 8 9)

Resources