Common Lisp: Why does my tail-recursive function cause a stack overflow? - common-lisp

I have a problem in understanding the performance of a Common Lisp function (I am still a novice). I have two versions of this function, which simply computes the sum of all integers up to a given n.
Non-tail-recursive version:
(defun addup3 (n)
(if (= n 0)
0
(+ n (addup (- n 1)))))
Tail-recursive version:
(defun addup2 (n)
(labels ((f (acc k)
(if (= k 0)
acc
(f (+ acc k) (- k 1)))))
(f 0 n)))
I am trying to run these functions in CLISP with input n = 1000000. Here is the result
[2]> (addup3 1000000)
500000500000
[3]> (addup2 1000000)
*** - Program stack overflow. RESET
I can run both successfully in SBCL, but the non-tail-recursive one is faster (only by a little, but that seems strange to me). I've scoured Stackoverflow questions for answers but couldn't find something similar. Why do I get a stack overflow although the tail-recursive function is designed NOT to put all recursive function calls on the stack? Do I have to tell the interpreter/compiler to optimise tail calls? (I read something like (proclaim '(optimize (debug 1)) to set the debug level and optimize at the cost of tracing abilities, but I don't know what this does).
Maybe the answer is obvious and the code is bullshit, but I just can't figure it out.
Help is appreciated.
Edit: danlei pointed out the typo, it should be a call to addup3 in the first function, so it is recursive. If corrected, both versions overflow, but not his one
(defun addup (n)
"Adds up the first N integers"
(do ((i 0 (+ i 1))
(sum 0 (+ sum i)))
((> i n) sum)))
While it may be a more typical way to do it, I find it strange that tail recursion is not always optimised, considering my instructors like to tell me it's so much more efficient and stuff.

There is no requirement for a Common Lisp implementation to have tail call optimization. Most do, however (I think that ABCL does not, due to limitations of the Java virtual machine).
The documentation of the implementation should tell you what optimization settings should be chosen to have TCO (if available).
It is more idiomatic for Common Lisp code to use one of the looping constructs:
(loop :for i :upto n
:sum i)
(let ((sum 0))
(dotimes (i n)
(incf sum (1+ i))))
(do ((i 0 (1+ i))
(sum 0 (+ sum i)))
((> i n) sum))
In this case, of course, it is better to use the "little Gauß":
(/ (* n (1+ n)) 2)

Well, your addup3 just isn't recursive at all.
(defun addup3 (n)
(if (= n 0)
0
(+ n (addup (- n 1))))) ; <--
It calls whatever addup is. Trying a corrected version in SBCL:
CL-USER> (defun addup3 (n)
(if (= n 0)
0
(+ n (addup3 (- n 1)))))
ADDUP3
CL-USER> (addup3 100000)
Control stack guard page temporarily disabled: proceed with caution
; ..
; Evaluation aborted on #<SB-SYS:MEMORY-FAULT-ERROR {C2F19B1}>.
As you'd expect.

Using GNU CommonLisp, GCL 2.6.12, compilation of addup2 will optimize tail calls, here is what I got:
>(compile 'addup2)
Compiling /tmp/gazonk_3012_0.lsp.
End of Pass 1.
;; Note: Tail-recursive call of F was replaced by iteration.
End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
Finished compiling /tmp/gazonk_3012_0.lsp.
Loading /tmp/gazonk_3012_0.o
start address -T 0x9556e8 Finished loading /tmp/gazonk_3012_0.o
#<compiled-function ADDUP2>
NIL
NIL
>>(addup2 1000000)
500000500000
>(addup3 1000000)
Error: ERROR "Invocation history stack overflow."
Fast links are on: do (si::use-fast-links nil) for debugging
Signalled by IF.
ERROR "Invocation history stack overflow."
Broken at +. Type :H for Help.
1 Return to top level.
>>(compile 'addup3)
Compiling /tmp/gazonk_3012_0.lsp.
End of Pass 1.
End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
Finished compiling /tmp/gazonk_3012_0.lsp.
Loading /tmp/gazonk_3012_0.o
start address -T 0x955a00 Finished loading /tmp/gazonk_3012_0.o
#<compiled-function ADDUP3>
NIL
NIL
>>(addup3 1000000)
Error: ERROR "Value stack overflow."
Hope it helps.

In SBCL User Manual:
The compiler is “properly tail recursive.” [...] The elimination of tail-recursive frames can be prevented by disabling tail-recursion optimization, which happens when the debug optimization quality is greater than 2.
And works as is in the REPL of a fresh image:
(defun sum-no-tail (n)
(if (zerop n)
0
(+ n (sum-no-tail (- n 1)))))
(defun sum-tail (n &key (acc 0))
(if (zerop n)
acc
(sum-tail (- n 1) :acc (+ n acc))))
CL-USER> (sum-no-tail 10000)
50005000 (26 bits, #x2FB0408)
CL-USER> (sum-no-tail 100000)
Control stack guard page temporarily disabled: proceed with caution
; Debugger entered on #<SB-KERNEL::CONTROL-STACK-EXHAUSTED {10026620A3}>
[1] CL-USER>
; Evaluation aborted on #<SB-KERNEL::CONTROL-STACK-EXHAUSTED {10026620A3}>
CL-USER> (sum-tail 100000)
5000050000 (33 bits, #x12A06B550)
CL-USER> (sum-tail 1000000)
500000500000 (39 bits, #x746A5A2920)
CL-USER> (sum-tail 10000000)
50000005000000 (46 bits, #x2D7988896B40)
Hope it helps in SBCL.

Related

Scheme: Compiling with continuations

im currently writing a compiler in OCaml for a subset of scheme and am having trouble understanding how to compile with continuations. I found some great resources, namely:
The cps slides of the cmsu compiler course:
https://www.cs.umd.edu/class/fall2017/cmsc430/
This explanation of another cs course:
https://www.cs.utah.edu/~mflatt/past-courses/cs6520/public_html/s02/cps.pdf
Matt Mights posts on a-normal form and cps:
http://matt.might.net/articles/a-normalization/ and
http://matt.might.net/articles/cps-conversion/
Using the anormal transformation introduced in the anormal-paper, I now have code where function calls are either bound to a variable or returned.
Example:
(define (fib n)
(if (<= n 1)
n
(+ (fib (- n 1))
(fib (- n 2)))))
becomes:
(define (fib n)
(let ([c (<= n 1)])
(if c
n
(let ([n-1 (- n 1)])
(let ([v0 (fib n-1)])
(let ([n-2 (- n 2)])
(let ([v1 (fib n-2)])
(+ v0 v1)))))))
In order to cps-transform, I now have to:
add cont-parameters to all non-primitive functions
call the cont-parameter on tail-positions
transform all non-primitive function calls, so that they escape the let-binding and become an extra lambda with the previous let-bound variable as sole argument and the previous let-body
as the body
The result would look like:
(define (fib n k)
(let ([c (<= n 1)])
(if c
(k n)
(let ([n-1 (- n 1)])
(fib n-1
(lambda (v0)
(let ([n-2 (- n 2)])
(fib n-2
(lambda (v1)
(k (+ v0 v1))))))))))
Is this correct?
The csmu-course also talks about how Programs in CPS require no stack and never return. Is that because we don't need to to save the adresses to return to and closures as well as other datatypes are stored on the heap and references are kept alive by using the closures?
The csmu also talks about desugaring of call/cc:
(call/cc) => ((lambda (k f) (f k k)))
when using such desugaring, how does:
(+ 2 (call/cc (lambda (k) (k 2))))
in MIT-Scheme return 4, since the current continuation would probably be something like display?
is this correct?
(define (fib n k)
(let ([c (<= n 1)])
(if c
(k n)
(let ([n-1 (- n 1)])
(fib n-1
(lambda (v0)
(let ([n-2 (- n 2)])
(fib n-2
(lambda (v1)
(k (+ v0 v1))))))))))
you get an A+ 💯
The csmu-course also talks about how Programs in CPS require no stack and never return. Is that because we don't need to to save the addresses to return to and closures as well as other datatypes are stored on the heap and references are kept alive by using the closures?
Exactly! See Chicken Complilation Process for an in-depth read about such a technique.
The csmu also talks about desugaring of call/cc:
(call/cc) => ((lambda (k f) (f k k)))
That doesn't look quite right. Here's a desugar of call/cc from Matt Might -
call/cc => (lambda (f cc) (f (lambda (x k) (cc x)) cc))
The essence of the idea of compiling with continuations is that you want to put an order on the evaluation of arguments passed to each function and after you evaluate that argument you send its value to the continuation passed.
It is required for the language in which you rewrite the code in CPS form to be tail recursive, otherwise it will stack empty frames, followed only by a return. If the implementation language does not impose tail-recursion you need to apply more sophisticated methods to get non-growing stack for cps code.
Take care, if you do it, you also need to change the signature of the primitives. The primitives will also be passed a continuation but they return immediately the answer in the passed continuation, they do not create other continuations.
The best reference about understanding how to compile with continuations remains the book of Andrew W. Appel and you need nothing more.

Space complexity of streams in Scheme

I am reading Structure and Interpretation of Computer Programs (SICP) and would like to make sure that my thinking is correct.
Consider the following simple stream using the recursive definition:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define ints (integers-starting-from 1))
(car (cdr-stream (cdr-stream (cdr-stream (cdr-stream ints)))))
If we adopt the implementation in SICP, whenever we cons-stream, we are effectively consing a variable and a lambda function (for delayed evaluation). So as we cdr-stream along this stream, nested lambda functions are created and a chain of frames is stored for the evaluation of lambda functions. Those frames are necessary since lambda functions evaluate expressions and find them in the enclosing frame. Therefore, I suppose that in order to evaluate the n-th element of the stream, you need to store n extra frames that take up linear space.
This is different from the behavior of iterators in other languages. If you need to go far down the stream, much space will be taken. Of course, it is possible to only keep the direct enclosing frame and throw away all the other ancestral frames. Is this what the actual scheme implementation does?
Short answer, yes, under the right circumstances the directly enclosing environment is thrown away.
I don't think this would happen in the case of (car (cdr-stream (cdr-stream (cdr-stream (... but if you instead look at stream-refin sect. 3.5.1:
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
and if you temporarily forget what you know about environment frames but think back to Chapter 1 and the disussion of recursive vs iterative processes, then this is a iterative process because the last line of the body is a call back to the same function.
So perhaps your question could be restated as: "Given what I know now about the environmental model of evaluation, how do iterative processes use constant space?"
As you say it's because the ancestral frames are thrown away. Exactly how this happens is covered later in the book in chapter 5, e.g., sect. 4.2 "Sequence Evaluation and Tail Recursion", or if you like the videos of the lectures, in lecture 9b.
A significant part of Chapter 4 and Chapter 5 covers the details necessary to answer this question explicitly. Or as the authors put it, to dispel the magic.
I think it's worth pointing out that the analysis of space usage in cases like this is not always quite simple.
For instance here is a completely naïve implementation of force & delay in Racket:
(define-syntax-rule (delay form)
(λ () form))
(define (force p)
(p))
And we can build enough of something a bit compatible with SICP streams to be dangerous on this:
(define-syntax-rule (cons-stream kar kdr)
;; Both car & cdr can be delayed: why not? I think the normal thing is
;; just to delay the cdr
(cons (delay kar) (delay kdr)))
(define (stream-car s)
(force (car s)))
(define (stream-cdr s)
(force (cdr s)))
(define (stream-nth s n)
(if (zero? n)
(stream-car s)
(stream-nth (stream-cdr s) (- n 1))))
(Note there is lots missing here because I am lazy.)
And on that we can build streams of integers:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
And now we can try this:
(define naturals (integers-starting-from 0))
(stream-nth naturals 10000000)
And this last thing returns 10000000, after a little while. And we can call it several times and we get the same answer each time.
But our implementation of promises sucks: forcing a promise makes it do work each time we force it, and we'd like to do it once. Instead we could memoize our promises so that doesn't happen, like this (this is probably not thread-safe: it could be made so):
(define-syntax-rule (delay form)
(let ([thunk/value (λ () form)]
[forced? #f])
(λ ()
(if forced?
thunk/value
(let ([value (thunk/value)])
(set! thunk/value value)
(set! forced? #t)
value)))))
All the rest of the code is the same.
Now, when you call (stream-nth naturals 10000000) you are probably going to have a fairly bad time: in particular you'll likely run out of memory.
The reason you're going to have a bad time is two things:
there's a reference to the whole stream in the form of naturals;
the fancy promises are memoizing their values, which are the whole tail of the stream.
What this means is that, as you walk down the stream you use up increasing amounts of memory until you run out: the space complexity of the program goes like the size of the argument to stream-nth in the last line.
The problem here is that delay is trying to be clever in a way which is unhelpful in this case. In particular if you think of streams as objects you traverse generally once, then memoizing them is just useless: you've carefully remembered a value which you will never use again.
The versions of delay & force provided by Racket memoize, and will also use enormous amounts of memory in this case.
You can avoid this either by not memoizing, or by being sure never to hold onto the start of the stream so the GC can pick it up. In particular this program
(define (silly-nth-natural n)
(define naturals (integers-starting-from 0))
(stream-nth naturals n))
will not use space proportional to n, because once the first tail call to stream-nth is made there is nothing holding onto the start of the stream any more.
Another approach is to make the memoized value be only weakly held, so that if the system gets desperate it can drop it. Here's a hacky and mostly untested implementation of that (this is very Racket-specific):
(define-syntax-rule (delay form)
;; a version of delay which memoizes weakly
(let ([thunk (λ () form)]
[value-box #f])
(λ ()
(if value-box
;; the promise has been forced
(let ([value-maybe (weak-box-value value-box value-box)])
;; two things that can't be in the box are the thunk
;; or the box itself, since we made those ourselves
(if (eq? value-maybe value-box)
;; the value has been GCd
(let ([value (thunk)])
(set! value-box (make-weak-box value))
value)
;; the value is good
value-maybe))
;; the promise has not yet been forced
(let ((value (thunk)))
(set! value-box (make-weak-box value))
value)))))
I suspect that huge numbers of weak boxes may make the GC do a lot of work.
"nested lambda functions are created"
nope. There is no nested scope. In
(define integers-starting-from
(lambda (n)
(cons-stream n (integers-starting-from (+ n 1)))))
the argument to the nested call to integers-starting-from in the (integers-starting-from (+ n 1)) form, the expression (+ n 1), refers to the binding of n in the original call to (integers-starting-from n), but (+ n 1) is evaluated before the call is made.
Scheme is an eager programming language, not a lazy one.
Thus the lambda inside the result of cons-stream holds a reference to the call frame, yes, but there is no nesting of environments. The value is already obtained before the new lambda is created and returned as part of the next cons cell representing the stream's next state.
(define ints (integers-starting-from 1))
=
(define ints (let ((n 1))
(cons-stream n (integers-starting-from (+ n 1)))))
=
(define ints (let ((n 1))
(cons n (lambda () (integers-starting-from (+ n 1))))))
and the call proceeds
(car (cdr-stream (cdr-stream ints)))
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints ((cdr ints)))
(cdr-cdr-ints ((cdr cdr-ints)))
(res (car cdr-cdr-ints)))
res)
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints ((cdr ints))
=
((let ((n 1))
(lambda () (integers-starting-from (+ n 1)))))
=
(integers-starting-from 2) ;; args before calls!
=
(let ((n 2))
(cons n
(lambda () (integers-starting-from (+ n 1)))))
)
(cdr-cdr-ints ((cdr cdr-ints)))
(res (car cdr-cdr-ints)))
res)
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints (let ((n 2))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-cdr-ints (let ((n 3))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(res (car cdr-cdr-ints)))
res)
=
3
So there is no nested lambdas here. Not even a chain of lambdas, because the implementation is non-memoizing. The values for cdr-ints and cdr-cdr-ints are ephemeral, liable to be garbage-collected while the 3rd element is being calculated. Nothing holds any reference to them.
Thus getting the nth element is done in constant space modulo garbage, since all the interim O(n) space entities are eligible to be garbage collected.
In (one possible) memoizing implementation, each lambda would be actually replaced by its result in the cons cell, and there'd be a chain of three -- still non-nested -- lambdas, congruent to an open-ended list
(1 . (2 . (3 . <procedure-to-go-next>)))
In programs which do not hold on to the top entry of such chains, all the interim conses would be eligible for garbage collection as well.
One such example, even with the non-memoizing SICP streams, is the sieve of Eratosthenes. Its performance characteristics are consistent with no memory retention of the prefix portions of its internal streams.

Recursion in Common Lisp, pushing values, and the Fibonacci Sequence

This is not a homework assignment. In the following code:
(defparameter nums '())
(defun fib (number)
(if (< number 2)
number
(push (+ (fib (- number 1)) (fib (- number 2))) nums))
return nums)
(format t "~a " (fib 100))
Since I am quite inexperienced with Common Lisp, I am at a loss as to why the function does not return an value. I am a trying to print first 'n' values, e.g., 100, of the Fibonacci Sequence.
Thank you.
An obvious approach to computing fibonacci numbers is this:
(defun fib (n)
(if (< n 2)
n
(+ (fib (- n 1)) (fib (- n 2)))))
(defun fibs (n)
(loop for i from 1 below n
collect (fib i)))
A little thought should tell you why no approach like this is going to help you compute the first 100 Fibonacci numbers: the time taken to compute (fib n) is equal to or a little more than the time taken to compute (fib (- n 1)) plus the time taken to compute (fib (- n 2)): this is exponential (see this stack overflow answer).
A good solution to this is memoization: the calculation of (fib n) repeats subcalculations a huge number of times, and if we can just remember the answer we computed last time we can avoid doing so again.
(An earlier version of this answer has an overcomplex macro here: something like that may be useful in general but is not needed here.)
Here is how you can memoize fib:
(defun fib (n)
(check-type n (integer 0) "natural number")
(let ((so-far '((2 . 1) (1 . 1) (0 . 0))))
(labels ((fibber (m)
(when (> m (car (first so-far)))
(push (cons m (+ (fibber (- m 1))
(fibber (- m 2))))
so-far))
(cdr (assoc m so-far))))
(fibber n))))
This keeps a table – an alist – of the results it has computed so far, and uses this to avoid recomputation.
With this memoized version of the function:
> (time (fib 1000))
Timing the evaluation of (fib 1000)
User time = 0.000
System time = 0.000
Elapsed time = 0.000
Allocation = 101944 bytes
0 Page faults
43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
The above definition uses a fresh cache for each call to fib: this is fine, because the local function, fibber does reuse the cache. But you can do better than this by putting the cache outside the function altogether:
(defmacro define-function (name expression)
;; Install EXPRESSION as the function value of NAME, returning NAME
;; This is just to avoid having to say `(setf ...)`: it should
;; probably do something at compile-time too so the compiler knows
;; the function will be defined.
`(progn
(setf (fdefinition ',name) ,expression)
',name))
(define-function fib
(let ((so-far '((2 . 1) (1 . 1) (0 . 0))))
(lambda (n)
(block fib
(check-type n (integer 0) "natural number")
(labels ((fibber (m)
(when (> m (car (first so-far)))
(push (cons m (+ (fibber (- m 1))
(fibber (- m 2))))
so-far))
(cdr (assoc m so-far))))
(fibber n))))))
This version of fib will share its cache between calls, which means it is a little faster, allocates a little less memory but may be less thread-safe:
> (time (fib 1000))
[...]
Allocation = 96072 bytes
[...]
> (time (fib 1000))
[...]
Allocation = 0 bytes
[...]
Interestingly memoization was invented (or at least named) by Donald Michie, who worked on breaking Tunny (and hence with Colossus), and who I also knew slightly: the history of computing is still pretty short!
Note that memoization is one of the times where you can end up fighting a battle with the compiler. In particular for a function like this:
(defun f (...)
...
;; no function bindings or notinline declarations of F here
...
(f ...)
...)
Then the compiler is allowed (but not required) to assume that the apparently recursive call to f is a recursive call into the function it is compiling, and thus to avoid a lot of the overhead of a full function call. In particular it is not required to retrieve the current function value of the symbol f: it can just call directly into the function itself.
What this means is that an attempt to write a function, memoize which can be used to mamoize an existing recursive function, as (setf (fdefinition 'f) (memoize #'f)) may not work: the function f still call directly into the unmemoized version of itself and won't notice that the function value of f has been changed.
This is in fact true even if the recursion is indirect in many cases: the compiler is allowed to assume that calls to a function g for which there is a definition in the same file are calls to the version defined in the file, and again avoid the overhead of a full call.
The way to deal with this is to add suitable notinline declarations: if a call is covered by a notinline declaration (which must be known to the compiler) then it must be made as a full call. From the spec:
A compiler is not free to ignore this declaration; calls to the specified functions must be implemented as out-of-line subroutine calls.
What this means is that, in order to memoize functions you have to add suitable notinline declarations for recursive calls, and this means that memoizing either needs to be done by a macro, or must rely on the user adding suitable declarations to the functions to be memoized.
This is only a problem because the CL compiler is allowed to be smart: almost always that's a good thing!
Your function unconditionally returns nums (but only if a variable called return exists). To see why, we can format it like this:
(defun fib (number)
(if (< number 2)
number
(push (+ (fib (- number 1)) (fib (- number 2))) nums))
return
nums)
If the number is less than 2, then it evaluates the expression number, uselessly, and throws away the result. Otherwise, it pushes the result of the (+ ....) expression onto the nums list. Then it uselessly evaluates return, throwing away the result. If a variable called return doesn't exist, that's an error situation. Otherwise, it evaluates nums and that is the return value.
In Common Lisp, there is a return operator for terminating and returning out of anonymous named blocks (blocks whose name is the symbol nil). If you define a named function with defun, then an invisible block exists which is not anonymous: it has the same name as that function. In that case, return-from can be used:
(defun function ()
(return-from function 42) ;; function terminates, returns 42
(print 'notreached)) ;; this never executes
Certain standard control flow and looping constructs establish a hidden anonymous block, so return can be used:
(dolist (x '(1 2 3))
(return 42)) ;; loop terminates, yields 42 as its result
If we use (return ...) but there is no enclosing anonymous block, that is an error.
The expression (return ...) is different from just return, which evaluates a variable named by the symbol return, retrieving its contents.
It is not clear how to repair your fib function, because the requirements are unknown. The side effect of pushing values into a global list normally doesn't belong inside a mathematical function like this, which should be pure (side-effect-free).
So you might know that if you know the two previous numbers you can compute the next. What comes after 3, 5? If you guess 8 you have understood it. Now if you start with 0, 1 and roll 1, 1, 1, 2, etc you collect the first variable until you have the number of numbers you'd like:
(defun fibs (elements)
"makes a list of elements fibonacci numbers starting with the first"
(loop :for a := 0 :then b
:for b := 1 :then c
:for c := (+ a b)
:for n :below elements
:collect a))
(fibs 10)
; ==> (0 1 1 2 3 5 8 13 21 34)
Every form in Common Lisp "returns" a value. You can say it evaluates to. eg.
(if (< a b)
5
10)
This evaluates either to 5 or 10. Thus you can do this and expect that it evaluates to either 15 or 20:
(+ 10
(if (< a b)
5
10))
You basically want your functions to have one expression that calculates the result. eg.
(defun fib (n)
(if (zerop n)
n
(+ (fib (1- n)) (fib (- n 2)))))
This evaluates to the result og the if expression... loop with :collect returns the list. You also have (return expression) and (return-from name expression) but they are usually unnecessary.
Your global variable num is actually not that a bad idea.
It is about to have a central memory about which fibonacci numbers were already calculated. And not to calculate those already calculated numbers again.
This is the very idea of memoization.
But first, I do it in bad manner with a global variable.
Bad version with global variable *fibonacci*
(defparameter *fibonacci* '(1 1))
(defun fib (number)
(let ((len (length *fibonacci*)))
(if (> len number)
(elt *fibonacci* (- len number 1)) ;; already in *fibonacci*
(labels ((add-fibs (n-times)
(push (+ (car *fibonacci*)
(cadr *fibonacci*))
*fibonacci*)
(cond ((zerop n-times) (car *fibonacci*))
(t (add-fibs (1- n-times))))))
(add-fibs (- number len))))))
;;> (fib 10)
;; 89
;;> *fibonacci*
;; (89 55 34 21 13 8 5 3 2 1 1)
Good functional version (memoization)
In memoization, you hide the global *fibonacci* variable
into the environment of a lexical function (the memoized version of a function).
(defun memoize (fn)
(let ((cache (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(multiple-value-bind (val win) (gethash args cache)
(if win
val
(setf (gethash args cache)
(apply fn args)))))))
(defun fib (num)
(cond ((zerop num) 1)
((= 1 num) 1)
(t (+ (fib (- num 1))
(fib (- num 2))))))
The previously global variable *fibonacci* is here actually the local variable cache of the memoize function - encapsulated/hidden from the global environment,
accessible/look-up-able only through the function fibm.
Applying memoization on fib (bad version!)
(defparameter fibm (memoize #'fib))
Since common lisp is a Lisp 2 (separated namespace between function and variable names) but we have here to assign the memoized function to a variable,
we have to use (funcall <variable-name-bearing-function> <args for memoized function>).
(funcall fibm 10) ;; 89
Or we define an additional
(defun fibm (num)
(funcall fibm num))
and can do
(fibm 10)
However, this saves/memoizes only the out calls e.g. here only the
Fibonacci value for 10. Although for that, Fibonacci numbers
for 9, 8, ..., 1 are calculated, too.
To make them saved, look the next section!
Applying memoization on fib (better version by #Sylwester - thank you!)
(setf (symbol-function 'fib) (memoize #'fib))
Now the original fib function is the memoized function,
so all fib-calls will be memoized.
In addition, you don't need funcall to call the memoized version,
but just do
(fib 10)

Recursive Factorial Function in Common-Lisp

Ok, I'm been learning COMMON LISP programming and I'm working on a very simple program to calculate a factorial of a given integer. Simple, right?
Here's the code so far:
(write-line "Please enter a number...")
(setq x (read))
(defun factorial(n)
(if (= n 1)
(setq a 1)
)
(if (> n 1)
(setq a (* n (factorial (- n 1))))
)
(format t "~D! is ~D" n a)
)
(factorial x)
Problem is, when I run this on either CodeChef or Rexter.com, I get a similar error: "NIL is NOT a number."
I've tried using cond instead of an if to no avail.
As a side note, and most bewildering of all, I've seen a lot of places write the code like this:
(defun fact(n)
(if (= n 1)
1
(* n (fact (- n 1)))))
Which doesn't even make sense to me, what with the 1 just floating out there with no parentheses around it. However, with a little tinkering (writing additional lines outside the function) I can get it to execute (equally bewildering!).
But that's not what I want! I'd like the factorial function to print/return the values without having to execute additional code outside it.
What am I doing wrong?
One actually needs to flush the I/O buffers in portable code with FINISH-OUTPUT - otherwise the Lisp may want to read something and the prompt hasn't yet been printed. You better replace SETQ with LET, as SETQ does not introduce a variable, it just sets it.
(defun factorial (n)
(if (= n 1)
1
(* n (factorial (- n 1)))))
(write-line "Please enter a number...")
(finish-output) ; this makes sure the text is printed now
(let ((x (read)))
(format t "~D! is ~D" x (factorial x)))
Before answering your question, I would like to tell you some basic things about Lisp. (Neat fix to your solution at the end)
In Lisp, the output of every function is the "last line executed in the function". Unless you use some syntax manipulation like "return" or "return-from", which is not the Lisp-way.
The (format t "your string") will always return 'NIL as its output. But before returning the output, this function "prints" the string as well.
But the output of format function is 'NIL.
Now, the issue with your code is the output of your function. Again, the output would be the last line which in your case is:
(format t "~D! is ~D" n a)
This will return 'NIL.
To convince yourself, run the following as per your defined function:
(equal (factorial 1) 'nil)
This returns:
1! is 1
T
So it "prints" your string and then outputs T. Hence the output of your function is indeed 'NIL.
So when you input any number greater than 1, the recursive call runs and reaches the end as input 1 and returns 'NIL.
and then tries to execute this:
(setq a (* n (factorial (- n 1))))
Where the second argument to * is 'NIL and hence the error.
A quick fix to your solution is to add the last line as the output:
(write-line "Please enter a number...")
(setq x (read))
(defun factorial(n)
(if (= n 1)
(setq a 1)
)
(if (> n 1)
(setq a (* n (factorial (- n 1))))
)
(format t "~D! is ~D" n a)
a ;; Now this is the last line, so this will work
)
(factorial x)
Neater code (with Lisp-like indentation)
(defun factorial (n)
(if (= n 1)
1
(* n (factorial (- n 1)))))
(write-line "Please enter a number...")
(setq x (read))
(format t "~D! is ~D" x (factorial x))
Common Lisp is designed to be compiled. Therefore if you want global or local variables you need to define them before you set them.
On line 2 you give x a value but have not declared the existence of a variable by that name. You can do so as (defvar x), although the name x is considered unidiomatic. Many implementations will give a warning and automatically create a global variable when you try to set something which hasn’t been defined.
In your factorial function you try to set a. This is a treated either as an error or a global variable. Note that in your recursive call you are changing the value of a, although this wouldn’t actually have too much of an effect of the rest of your function were right. Your function is also not reentrant and there is no reason for this. You can introduce a local variable using let. Alternatively you could add it to your lambda list as (n &aux a). Secondarily your factorial function does not return a useful value as format does not return a useful value. In Common Lisp in an (implicit) progn, the value of the final expression is returned. You could fix this by adding a in the line below your format.
For tracing execution you could do (trace factorial) to have proper tracing information automatically printed. Then you could get rid of your format statement.
Finally it is worth noting that the whole function is quite unidiomatic. Your syntax is not normal. Common Lisp implementations come with a pretty printer. Emacs does too (bound to M-q). One does not normally do lots of reading and setting of global variables (except occasionally at the repl). Lisp isn’t really used for scripts in this style and has much better mechanisms for controlling scope. Secondarily one wouldn’t normally use so much mutating of state in a function like this. Here is a different way of doing factorial:
(defun factorial (n)
(if (< n 2)
1
(* n (factorial (1- n)))))
And tail recursively:
(defun factorial (n &optional (a 1))
(if (< n 2) a (factorial (1- n) (* a n))))
And iteratively (with printing):
(defun factorial (n)
(loop for i from 1 to n
with a = 1
do (setf a (* a i))
(format t “~a! = ~a~%” i a)
finally (return a)))
You can split it up into parts, something like this:
(defun prompt (prompt-str)
(write-line prompt-str *query-io*)
(finish-output)
(read *query-io*))
(defun factorial (n)
(cond ((= n 1) 1)
(t (* n
(factorial (decf n)))))
(defun factorial-driver ()
(let* ((n (prompt "Enter a number: "))
(result (factorial n)))
(format *query-io* "The factorial of ~A is ~A~%" n result)))
And then run the whole thing as (factorial-driver).
Sample interaction:
CL-USER 54 > (factorial-driver)
Enter a number:
4
The factorial of 4 is 24

Clojure: Simple factorial causes stack overflow

What am I doing wrong? Simple recursion a few thousand calls deep throws a StackOverflowError.
If the limit of Clojure recursions is so low, how can I rely on it?
(defn fact[x]
(if (<= x 1) 1 (* x (fact (- x 1)) )))
user=> (fact 2)
2
user=> (fact 4)
24
user=> (fact 4000)
java.lang.StackOverflowError (NO_SOURCE_FILE:0)
Here's another way:
(defn factorial [n]
(reduce * (range 1 (inc n))))
This won't blow the stack because range returns a lazy seq, and reduce walks across the seq without holding onto the head.
reduce makes use of chunked seqs if it can, so this can actually perform better than using recur yourself. Using Siddhartha Reddy's recur-based version and this reduce-based version:
user> (time (do (factorial-recur 20000) nil))
"Elapsed time: 2905.910426 msecs"
nil
user> (time (do (factorial-reduce 20000) nil))
"Elapsed time: 2647.277182 msecs"
nil
Just a slight difference. I like to leave my recurring to map and reduce and friends, which are more readable and explicit, and use recur internally a bit more elegantly than I'm likely to do by hand. There are times when you need to recur manually, but not that many in my experience.
The stack size, I understand, depends on the JVM you are using as well as the platform. If you are using the Sun JVM, you can use the -Xss and -XThreadStackSize parameters to set the stack size.
The preferred way to do recursion in Clojure though is to use loop/recur:
(defn fact [x]
(loop [n x f 1]
(if (= n 1)
f
(recur (dec n) (* f n)))))
Clojure will do tail-call optimization for this; that ensures that you’ll never run into StackOverflowErrors.
And due defn implies a loop binding, you could omit the loop expression, and use its arguments as the function argument. And to make it a 1 argument function, use the multiary caracteristic of functions:
(defn fact
([n] (fact n 1))
([n f]
(if (<= n 1)
f
(recur (dec n) (* f n)))))
Edit: For the record, here is a Clojure function that returns a lazy sequence of all the factorials:
(defn factorials []
(letfn [(factorial-seq [n fact]
(lazy-seq
(cons fact (factorial-seq (inc n) (* (inc n) fact)))))]
(factorial-seq 1 1)))
(take 5 (factorials)) ; will return (1 2 6 24 120)
Clojure has several ways of busting recursion
explicit tail calls with recur. (they must be truely tail calls so this wont work)
Lazy sequences as mentioned above.
trampolining where you return a function that does the work instead of doing it directly and then call a trampoline function that repeatedly calls its result until it turnes into a real value instead of a function.
(defn fact ([x] (trampoline (fact (dec x) x)))
([x a] (if (<= x 1) a #(fact (dec x) (*' x a)))))
(fact 42)
620448401733239439360000N
memoizing the the case of fact this can really shorten the stack depth, though it is not generally applicable.
ps: I dont have a repl on me so would someone kindly test-fix the trapoline fact function?
As I was about to post the following, I see that it's almost the same as the Scheme example posted by JasonTrue... Anyway, here's an implementation in Clojure:
user=> (defn fact[x]
((fn [n so_far]
(if (<= n 1)
so_far
(recur (dec n) (* so_far n)))) x 1))
#'user/fact
user=> (fact 0)
1
user=> (fact 1)
1
user=> (fact 2)
2
user=> (fact 3)
6
user=> (fact 4)
24
user=> (fact 5)
120
etc.
As l0st3d suggested, consider using recur or lazy-seq.
Also, try to make your sequence lazy by building it using the built-in sequence forms as a opposed to doing it directly.
Here's an example of using the built-in sequence forms to create a lazy Fibonacci sequence (from the Programming Clojure book):
(defn fibo []
(map first (iterate (fn [[a b]] [b (+ a b)]) [0 1])))
=> (take 5 (fibo))
(0 1 1 2 3)
The stack depth is a small annoyance (yet configurable), but even in a language with tail recursion like Scheme or F# you'd eventually run out of stack space with your code.
As far as I can tell, your code is unlikely to be tail recursion optimized even in an environment that supports tail recursion transparently. You would want to look at a continuation-passing style to minimize stack depth.
Here's a canonical example in Scheme from Wikipedia, which could be translated to Clojure, F# or another functional language without much trouble:
(define factorial
(lambda (n)
(let fact ([i n] [acc 1])
(if (zero? i)
acc
(fact (- i 1) (* acc i))))))
Another, simple recursive implementation simple could be this:
(defn fac [x]
"Returns the factorial of x"
(if-not (zero? x) (* x (fac (- x 1))) 1))
To add to Siddhartha Reddy's answer, you can also borrow the Factorial function form Structure And Interpretation of Computer Programs, with some Clojure-specific tweaks. This gave me pretty good performance even for very large factorial calculations.
(defn fac [n]
((fn [product counter max-count]
(if (> counter max-count)
product
(recur (apply *' [counter product])
(inc counter)
max-count)))
1 1 n))
Factorial numbers are by their nature very big. I'm not sure how Clojure deals with this (but I do see it works with java), but any implementation that does not use big numbers will overflow very fast.
Edit: This is without taking into consideration the fact that you are using recursion for this, which is also likely to use up resources.
Edit x2: If the implementation is using big numbers, which, as far as I know, are usually arrays, coupled with recursion (one big number copy per function entry, always saved on the stack due to the function calls) would explain a stack overflow. Try doing it in a for loop to see if that is the problem.

Resources