I am writing an iterative version of the Pell numbers and I need to print out the output of the numbers in a list. I have done everything right up until the list. Instead of returning a flat list, it returns individual lists of the Pell numbers.
I tried to append all the individual lists but it does not work. What am I missing?
(defun iterPell (n)
(let ((a 0) (b 1) (c n))
(loop for i from 2 to n do
(setq c (+ a (* 2 b))
a b
b c))
c))
(dotimes (n 7)
(write(append(list(iterPell n))))
)
>>(0)(1)(2)(5)(12)(29)(70)
(loop for n from 0 to 7
collect (iterPell n))
;; => (0 1 2 5 12 29 70 169)
(let ((res)) ;; initialize collector = ((res nil))
(dotimes (n 7)
(setf res (cons (iterPell n) res))) ;; setf the result new-value-consed
(nreverse res)) ;; revert it (after all consing to beginning of list)
;; => (0 1 2 5 12 29 70 169)
;; or write recursive function
(defun apply-on-0-to-n (n func acc)
(cond ((zerop n) (cons (funcall func 0) acc))
(t (apply-on-0-to-n (1- n) func (cons (funcall func n) acc)))))
(apply-on-0-to-n 7 #'iterPell '())
;; => (0 1 2 5 12 29 70 169)
Related
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))))))
I am trying to build the built-in procedure build-list in Racket.
The built-in function works like this:
(build-list 10 (lambda (x) (* x x)))
>> '(0 1 4 9 16 25 36 49 64 81)
My implementation is a recursive definition for a recursive procedure:
(define (my-build-list-recur list-len proc)
(if (= list-len 0)
'()
(cons (proc (sub1 list-len)) (my-build-list-recur (sub1 list-len) proc))))
When I call my implementation, I have:
(my-build-list-recur 10 (lambda (x) (* x x)))
>> '(81 64 49 36 25 16 9 4 1 0)
As you might have seen, I get the same result, but in a reverse order.
What can I do to have the result in the same order as the native function?
P.S.: I have done an implementation using a recursive definition for an iterative procedure which works perfectly. I am struggling now to generate the same result with the totally recursive procedure. I already know how to solve this doubt with long tail recursion.
This is my implementation with long tail recursion:
(define (my-build-list list-len proc)
(define (iter list-len accu n)
(if (= (length accu) list-len)
(reverse accu)
(iter list-len (cons (proc n) accu) (add1 n))))
;(trace iter)
(iter list-len '() 0))
Ok so you're looking for an answer that does not use state variables and a tail call. You want for a recursive procedure that also evolves a recursive process. Not sure why you want this other than just to see how the definition would differ. You should also read about tail recursion modulo cons (here, and on wikipedia) – it's relevant to this question.
;; recursive procedure, recursive process
(define (build-list n f)
(define (aux m)
(if (equal? m n)
empty
(cons (f m) (aux (add1 m)))))
(aux 0))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Notice how the aux call is no longer in tail position – ie, cons cannot finish evaluating until it has evaluated the aux call in its arguments. The process will look something like this, evolving on the stack:
(cons (f 0) ...)
(cons (f 0) (cons (f 1) ...))
(cons (f 0) (cons (f 1) (cons (f 2) ...)))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) ...))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) ...)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) empty)))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) (cons (f 4) '())))))
(cons (f 0) (cons (f 1) (cons (f 2) (cons (f 3) '(16)))))
(cons (f 0) (cons (f 1) (cons (f 2) '(9 16))))
(cons (f 0) (cons (f 1) '(4 9 16)))
(cons (f 0) '(1 4 9 16))
'(0 1 4 9 16)
You'll see that the cons calls are left hanging open until ... is filled in. And the last ... isn't filled in with empty until m is equal to n.
If you don't like the inner aux procedure, you can use a default parameter, but this does leak some of the private API to the public API. Maybe it's useful to you and/or maybe you don't really care.
;; recursive procedure, recursive process
(define (build-list n f (m 0))
(if (equal? m n)
'()
(cons (f m) (build-list n f (add1 m)))))
;; still only apply build-list with 2 arguments
(build-list 5 (lambda (x) (* x x)))
;; => '(0 1 4 9 16)
;; if a user wanted, they could start `m` at a different initial value
;; this is what i mean by "leaked" private API
(build-list 5 (lambda (x) (* x x) 3)
;; => '(9 16)
Stack-safe implementations
Why you'd specifically want a recursive process (one which grows the stack) is strange, imo, especially considering how easy it is to write a stack-safe build-list procedure which doesn't grow the stack. Here's some recursive procedures with a linear iterative processes.
The first one is extremely simple but does leak a little bit of private API using the acc parameter. You could easily fix this using an aux procedure like we did in the first solution.
;; recursive procedure, iterative process
(define (build-list n f (acc empty))
(if (equal? 0 n)
acc
(build-list (sub1 n) f (cons (f (sub1 n)) acc))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
Check out the evolved process
(cons (f 4) empty)
(cons (f 3) '(16))
(cons (f 2) '(9 16))
(cons (f 1) '(4 9 16))
(cons (f 0) '(1 4 9 16))
;; => '(0 1 4 9 16)
This is insanely better because it can constantly reuse one stack frame until the entire list is built. As an added advantage, we don't need to keep a counter that goes from 0 up to n. Instead, we build the list backwards and count from n-1 to 0.
Lastly, here's another recursive procedure that evolves a linear iterative process. It utilizes a named-let and continuation passing style. The loop helps prevent leaking the API this time.
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (λ (rest) (k (cons (f m) rest)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
It cleans up a little tho if you use compose and curry:
;; recursive procedure, iterative process
(define (build-list n f)
(let loop ((m 0) (k identity))
(if (equal? n m)
(k empty)
(loop (add1 m) (compose k (curry cons (f m)))))))
(build-list 5 (λ (x) (* x x)))
;; => '(0 1 4 9 16)
The process evolved from this procedure is slightly different, but you'll notice that it also doesn't grow the stack, creating a sequence of nested lambdas on the heap instead. So this would be sufficient for sufficiently large values of n:
(loop 0 identity) ; k0
(loop 1 (λ (x) (k0 (cons (f 0) x))) ; k1
(loop 2 (λ (x) (k1 (cons (f 1) x))) ; k2
(loop 3 (λ (x) (k2 (cons (f 2) x))) ; k3
(loop 4 (λ (x) (k3 (cons (f 3) x))) ; k4
(loop 5 (λ (x) (k4 (cons (f 4) x))) ; k5
(k5 empty)
(k4 (cons 16 empty))
(k3 (cons 9 '(16)))
(k2 (cons 4 '(9 16)))
(k1 (cons 1 '(4 9 16)))
(k0 (cons 0 '(1 4 9 16)))
(identity '(0 1 4 9 16))
'(0 1 4 9 16)
When written this way the error says: 4 parts after if:
(define (rolling-window l size)
(if (< (length l) size) l
(take l size) (rolling-window (cdr l) size)))
and when there's another paranthesis to make it 3 parts:
(define (rolling-window l size)
(if (< (length l) size) l
((take l size) (rolling-window (cdr l) size))))
then it says: application: not a procedure;
How to write more than one expression in if's else in racket/scheme?
Well that's not really the question. The question is "How to build a rolling window procedure using racket?". Anyway, it looks like you're probably coming from another programming language. Processing linked lists can be a little tricky at first. But remember, to compute the length of a list, you have to iterate through the entire list. So using length is a bit of an anti-pattern here.
Instead, I would recommend you create an auxiliary procedure inside your rolling-window procedure which builds up the window as you iterate thru the list. This way you don't have to waste iterations counting elements of a list.
Then if your aux procedure ever returns and empty window, you know you're done computing the windows for the given input list.
(define (rolling-window n xs)
(define (aux n xs)
(let aux-loop ([n n] [xs xs] [k identity])
(cond [(= n 0) (k empty)] ;; done building sublist, return sublist
[(empty? xs) empty] ;; reached end of xs before n = 0, return empty window
[else (aux-loop (sub1 n) (cdr xs) (λ (rest) (k (cons (car xs) rest))))]))) ;; continue building sublist
(let loop ([xs xs] [window (aux n xs)] [k identity])
(cond ([empty? window] (k empty)) ;; empty window, done
([empty? xs] (k empty)) ;; empty input list, done
(else (loop (cdr xs) (aux n (cdr xs)) (λ (rest) (k (cons window rest)))))))) ;; continue building sublists
(rolling-window 3 '(1 2 3 4 5 6))
;; => '((1 2 3) (2 3 4) (3 4 5) (4 5 6))
It works for empty windows
(rolling-window 0 '(1 2 3 4 5 6))
;; => '()
And empty lists too
(rolling-window 3 '())
;; => '()
Here is an alternative:
#lang racket
(define (rolling-window n xs)
(define v (list->vector xs))
(define m (vector-length v))
(for/list ([i (max 0 (- m n -1))])
(vector->list (vector-copy v i (+ i n)))))
(rolling-window 3 '(a b c d e f g))
(rolling-window 3 '())
(rolling-window 0 '(a b c))
Output:
'((a b c) (b c d) (c d e) (d e f) (e f g))
'()
'(() () () ()) ; lack of spec makes this ok !
Following modification of OP's function works. It includes an outlist for which the initial default is empty list. Sublists are added to this outlist till (length l) is less than size.
(define (rolling-window l size (ol '()))
(if (< (length l) size) (reverse ol)
(rolling-window (cdr l) size (cons (take l size) ol))))
Testing:
(rolling-window '(1 2 3 4 5 6) 2)
(rolling-window '(1 2 3 4 5 6) 3)
(rolling-window '(1 2 3 4 5 6) 4)
Output:
'((1 2) (2 3) (3 4) (4 5) (5 6))
'((1 2 3) (2 3 4) (3 4 5) (4 5 6))
'((1 2 3 4) (2 3 4 5) (3 4 5 6))
Any improvements on this one?
(define (rolling-window l size)
(cond ((eq? l '()) '())
((< (length l) size) '())
((cons (take l size) (rolling-window (cdr l) size)))))
I want to implement Heap's algorithm in Scheme (Gambit).
I read his paper and checked out lots of resources but I haven't found many functional language implementations.
I would like to at least get the number of possible permutations.
The next step would be to actually print out all possible permutations.
Here is what I have so far:
3 (define (heap lst n)
4 (if (= n 1)
5 0
6 (let ((i 1) (temp 0))
7 (if (< i n)
8 (begin
9 (heap lst (- n 1))
10 (cond
11 ; if even: 1 to n -1 consecutively cell selected
12 ((= 0 (modulo n 2))
13 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
14 (+ 1 (heap (cdr lst) (length (cdr lst)))))
15
16 ; if odd: first cell selectd
17 ((= 1 (modulo n 2))
18 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
19 (+ 1 (heap (car lst) 1)))
20 )
21 )
22 0
23 )
24 )
25 )
26 )
27
28 (define myLst '(a b c))
29
30 (display (heap myLst (length myLst)))
31 (newline)
I'm sure this is way off but it's as close as I could get.
Any help would be great, thanks.
Here's a 1-to-1 transcription of the algorithm described on the Wikipedia page. Since the algorithm makes heavy use of indexing I've used a vector as a data structure rather than a list:
(define (generate n A)
(cond
((= n 1) (display A)
(newline))
(else (let loop ((i 0))
(generate (- n 1) A)
(if (even? n)
(swap A i (- n 1))
(swap A 0 (- n 1)))
(if (< i (- n 2))
(loop (+ i 1))
(generate (- n 1) A))))))
and the swap helper procedure:
(define (swap A i1 i2)
(let ((tmp (vector-ref A i1)))
(vector-set! A i1 (vector-ref A i2))
(vector-set! A i2 tmp)))
Testing:
Gambit v4.8.4
> (generate 3 (vector 'a 'b 'c))
#(a b c)
#(b a c)
#(c a b)
#(a c b)
#(b c a)
#(c b a)
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)