Recursion (or while loops) in Scheme - recursion

(define (orderedTriples n)
(set! i n)
(set! j n)
(set! k n)
(while (>= i 0)
(while (>= j 0)
(while (>= k 0)
(printf "(~a, ~a, ~a)" i j k)
(set! k (- k 1)))
(set! j (- j 1)))
(set! i (- i 1))))
So my issue is...I am confused as to how to make while loops work in scheme (I'm very new to this so excuse the syntax if I am WAY off). I typed while into here just for the purpose of working through a problem and to show what I am trying to accomplish. Could anyone help me with a simple recursion example or nested recursion?

Depending on the Scheme interpreter in use, there are several ways to implement the required loops. For example, in Racket it's as simple as using iterations and comprehensions:
(define (orderedTriples n)
(for* ([i (in-range n -1 -1)]
[j (in-range n -1 -1)]
[k (in-range n -1 -1)])
(printf "(~a, ~a, ~a)" i j k)))
The style of programming shown in the question (assuming it worked) is heavily discouraged in Scheme - using mutation (the set! operation) for looping is a big no-no, that's how you'd solve the problem in a C-like language, but in Scheme in particular (and in Lisp in general) there are other constructs for implementing iteration in a program (the solution given by #TerjeD demonstrates the use of do, for instance), and even if such constructs didn't exist, a recursive solution or a solution using higher-order procedures would be preferred. For example, here's another possible solution, using nested mappings with only standard procedures (with the exception of printf, which is non-standard):
(define (range n)
(if (negative? n)
'()
(cons n (range (- n 1)))))
(define (orderedTriples n)
(for-each (lambda (i)
(for-each (lambda (j)
(for-each (lambda (k)
(printf "(~a, ~a, ~a)" i j k))
(range n)))
(range n)))
(range n)))

You can use the do loop, which is written like this (for the inner loop of your function):
(do ((k n (- k 1))) ; variable, initialization, and updating form
((< k 0)) ; stop condition, and optionally return value
(printf "(~a, ~a, ~a)" i j k)) ; body forms
See http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-7.html#%_idx_138 for further information on the do iteration construct.

If you had to, you could do this with recursion.
(define (ordered-triples n)
(let iloop ((i n))
(unless (negative? i)
(let jloop ((j n))
(unless (negative? j)
(let kloop ((k n))
(unless (negative? k)
(printf "~a ~a ~a\n" i j k)
(kloop (sub1 k))))
(jloop (sub1 j))))
(iloop (sub1 i)))))
Of course, it's easier to use Racket's for* loop.

Related

How to implement optional arguments in CHICKEN?

I'm new to CHICKEN and Scheme. In my quest to understanding tail recursion, I wrote:
(define (recsum x) (recsum-tail x 0))
(define (recsum-tail x accum)
(if (= x 0)
accum
(recsum-tail (- x 1) (+ x accum))))
This does what I expect it to. However, this seems a little repetitive; having an optional argument should make this neater. So I tried:
(define (recsum x . y)
(let ((accum (car y)))
(if (= x 0)
accum
(recsum (- x 1) (+ x accum)))))
However, in CHICKEN (and maybe in other scheme implementations), car cannot be used against ():
Error: (car) bad argument type: ()
Is there another way to implement optional function arguments, specifically in CHICKEN 5?
I think you're looking for a named let, not for optional procedure arguments. It's a simple way to define a helper procedure with (possibly) extra parameters that you can initialize as required:
(define (recsum x)
(let recsum-tail ((x x) (accum 0))
(if (= x 0)
accum
(recsum-tail (- x 1) (+ x accum)))))
Of course, we can also implement it with varargs - but I don't think this looks as elegant:
(define (recsum x . y)
(let ((accum (if (null? y) 0 (car y))))
(if (= x 0)
accum
(recsum (- x 1) (+ x accum)))))
Either way, it works as expected:
(recsum 10)
=> 55
Chicken has optional arguments. You can do it like this:
(define (sum n #!optional (acc 0))
(if (= n 0)
acc
(sum (- n 1) (+ acc n))))
However I will vote against using this as it is non standard Scheme. Chicken say they support SRFI-89: Optional positional and named parameters, but it seems it's an earlier version and the egg needs to be redone. Anyway when it is re-applied this should work:
;;chicken-install srfi-89 # install the egg
(use srfi-89) ; imports the egg
(define (sum n (acc 0))
(if (= n 0)
acc
(sum (- n 1) (+ acc n))))
Also your idea of using rest arguments work. However keep in mind that the procedure then will build a pair on the heap for each iteration:
(define (sum n . acc-lst)
(define acc
(if (null? acc-lst)
0
(car acc-lst)))
(if (= n 0)
acc
(sum (- n 1) (+ acc n))))
All of these leak internal information. Sometimes it's part of the public contract to have an optional parameter, but in this case it is to avoid writing a few more lines. Usually you don't want someone to pass a second argument and you should keep the internals private. The better way would be to use named let and keep the public contract as is.
(define (sum n)
(let loop ((n n) (acc 0))
(if (= n 0)
acc
(loop (- n 1) (+ acc n))))

How to write the code so that car and list aren't in it?

Is there anyway to write the below code as to not have to make a list from which later on we have to car the element?
(define (square-it l)
(map (lambda (x) (* x x)) l))
(define (sum-it l)
(foldl + 0 l))
(define (sum-of-squares n)
(sum-it (square-it (numbers n))))
(define (square-of-sum n)
(square-it (*list* (sum-it (numbers n)))))
(- (*car* (square-of-sum 100)) (sum-of-squares 100))
As mentioned by #Sylwester, square-it is useful for squaring a list but not for squaring a single value, the inputs and outputs are different in each case, and sqr is the right procedure for squaring a single value. This should be enough to fix the problem:
(define (square-of-sum n)
(sqr (sum-it (numbers n))))
(- (square-of-sum 100) (sum-of-squares 100))
A simpler solution would be to use iterations and comprehensions and define each procedure independently. We can calculate the values directly over a range of values using only built-in procedures, there's no need to reinvent the wheel:
(define (sum-of-squares n)
(for/fold ([sum 0])
([i (in-range n)])
(+ sum (sqr i))))
(define (square-of-sum n)
(sqr (apply + (range n))))

Infinite fibonacci series, take only n from the list, without using mutation?

I'm trying to solve this problem in a pure-functional way, without using set!.
I've written a function that calls a given lambda for each number in the fibonacci series, forever.
(define (each-fib fn)
(letrec
((next (lambda (a b)
(fn a)
(next b (+ a b)))))
(next 0 1)))
I think this is as succinct as it can be, but if I can shorten this, please enlighten me :)
With a definition like the above, is it possible to write another function that takes the first n numbers from the fibonacci series and gives me a list back, but without using variable mutation to track the state (which I understand is not really functional).
The function signature doesn't need to be the same as the following... any approach that will utilize each-fib without using set! is fine.
(take-n-fibs 7) ; (0 1 1 2 3 5 8)
I'm guessing there's some sort of continuations + currying trick I can use, but I keep coming back to wanting to use set!, which is what I'm trying to avoid (purely for learning purposes/shifting my thinking to purely functional).
Try this, implemented using lazy code by means of delayed evaluation:
(define (each-fib fn)
(letrec
((next (lambda (a b)
(fn a)
(delay (next b (+ a b))))))
(next 0 1)))
(define (take-n-fibs n fn)
(let loop ((i n)
(promise (each-fib fn)))
(when (positive? i)
(loop (sub1 i) (force promise)))))
As has been mentioned, each-fib can be further simplified by using a named let:
(define (each-fib fn)
(let next ((a 0) (b 1))
(fn a)
(delay (next b (+ a b)))))
Either way, it was necessary to modify each-fib a little for using the delay primitive, which creates a promise:
A promise encapsulates an expression to be evaluated on demand via force. After a promise has been forced, every later force of the promise produces the same result.
I can't think of a way to stop the original (unmodified) procedure from iterating indefinitely. But with the above change in place, take-n-fibs can keep forcing the lazy evaluation of as many values as needed, and no more.
Also, take-n-fibs now receives a function for printing or processing each value in turn, use it like this:
(take-n-fibs 10 (lambda (n) (printf "~a " n)))
> 0 1 1 2 3 5 8 13 21 34 55
You provide an iteration function over fibonacci elements. If you want, instead of iterating over each element, to accumulate a result, you should use a different primitive that would be a fold (or reduce) rather than an iter.
(It might be possible to use continuations to turn an iter into a fold, but that will probably be less readable and less efficient that a direct solution using either a fold or mutation.)
Note however that using an accumulator updated by mutation is also fine, as long as you understand what you are doing: you are using mutable state locally for convenience, but the function take-n-fibs is, seen from the outside, observationally pure, so you do not "contaminate" your program as a whole with side effects.
A quick prototype for fold-fib, adapted from your own code. I made an arbitrary choice as to "when stop folding": if the function returns null, we return the current accumulator instead of continuing folding.
(define (fold-fib init fn) (letrec ([next (lambda (acc a b)
(let ([acc2 (fn acc a)])
(if (null? acc2) acc
(next acc2 b (+ a b)))))])
(next init 0 1)))
(reverse (fold-fib '() (lambda (acc n) (if (> n 10) null (cons n acc)))))
It would be better to have a more robust convention to end folding.
I have written few variants. First you ask if
(define (each-fib fn)
(letrec
((next (lambda (a b)
(fn a)
(next b (+ a b)))))
(next 0 1)))
can be written any shorter. The pattern is used so often that special syntax called named let has been introduced. Your function looks like this using a named let:
(define (each-fib fn)
(let next ([a 0] [b 1])
(fn a)
(next b (+ a b))))
In order to get the control flowing from one function to another, one can in languages with supports TCO use continuation passing style. Each function gets an extra argument often called k (for continuation). The function k represents what-to-do-next.
Using this style, one can write your program as follows:
(define (generate-fibs k)
(let next ([a 0] [b 1] [k k])
(k a (lambda (k1)
(next b (+ a b) k1)))))
(define (count-down n k)
(let loop ([n n] [fibs '()] [next generate-fibs])
(if (zero? n)
(k fibs)
(next (λ (a next)
(loop (- n 1) (cons a fibs) next))))))
(count-down 5 values)
Now it is a bit annoying to write in style manually, so it could
be convenient to introduce the co-routines. Breaking your rule of not using set! I have chosen to use a shared variable fibs in which generate-fibs repeatedly conses new fibonacci numbers onto. The count-down routine merely read the values, when the count down is over.
(define (make-coroutine co-body)
(letrec ([state (lambda () (co-body resume))]
[resume (lambda (other)
(call/cc (lambda (here)
(set! state here)
(other))))])
(lambda ()
(state))))
(define fibs '())
(define generate-fib
(make-coroutine
(lambda (resume)
(let next ([a 0] [b 1])
(set! fibs (cons a fibs))
(resume count-down)
(next b (+ a b))))))
(define count-down
(make-coroutine
(lambda (resume)
(let loop ([n 10])
(if (zero? n)
fibs
(begin
(resume generate-fib)
(loop (- n 1))))))))
(count-down)
And a bonus you get a version with communicating threads:
#lang racket
(letrec ([result #f]
[count-down
(thread
(λ ()
(let loop ([n 10] [fibs '()])
(if (zero? n)
(set! result fibs)
(loop (- n 1) (cons (thread-receive) fibs))))))]
[produce-fibs
(thread
(λ ()
(let next ([a 0] [b 1])
(when (thread-running? count-down)
(thread-send count-down a)
(next b (+ a b))))))])
(thread-wait count-down)
result)
The thread version is Racket specific, the others ought to run anywhere.
Building a list would be hard. But displaying the results can still be done (in a very bad fashion)
#lang racket
(define (each-fib fn)
(letrec
((next (lambda (a b)
(fn a)
(next b (+ a b)))))
(next 0 1)))
(define (take-n-fibs n fn)
(let/cc k
(begin
(each-fib (lambda (x)
(if (= x (fib (+ n 1)))
(k (void))
(begin
(display (fn x))
(newline))))))))
(define fib
(lambda (n)
(letrec ((f
(lambda (i a b)
(if (<= n i)
a
(f (+ i 1) b (+ a b))))))
(f 1 0 1))))
Notice that i am using the regular fibonacci function as an escape (like i said, in a very bad fashion). I guess nobody will recommend programming like this.
Anyway
(take-n-fibs 7 (lambda (x) (* x x)))
0
1
1
4
9
25
64

a recursive Fibonacci function in Clojure

I'm a newcomer to clojure who wanted to see what all the fuss is about. Figuring the best way to get a feel for it is to write some simple code, I thought I'd start with a Fibonacci function.
My first effort was:
(defn fib [x, n]
(if (< (count x) n)
(fib (conj x (+ (last x) (nth x (- (count x) 2)))) n)
x))
To use this I need to seed x with [0 1] when calling the function. My question is, without wrapping it in a separate function, is it possible to write a single function that only takes the number of elements to return?
Doing some reading around led me to some better ways of achieving the same funcionality:
(defn fib2 [n]
(loop [ x [0 1]]
(if (< (count x) n)
(recur (conj x (+ (last x) (nth x (- (count x) 2)))))
x)))
and
(defn fib3 [n]
(take n
(map first (iterate (fn [[a b]] [b (+ a b)]) [0 1]))))
Anyway, more for the sake of the exercise than anything else, can anyone help me with a better version of a purely recursive Fibonacci function? Or perhaps share a better/different function?
To answer you first question:
(defn fib
([n]
(fib [0 1] n))
([x, n]
(if (< (count x) n)
(fib (conj x (+ (last x) (nth x (- (count x) 2)))) n)
x)))
This type of function definition is called multi-arity function definition. You can learn more about it here: http://clojure.org/functional_programming
As for a better Fib function, I think your fib3 function is quite awesome and shows off a lot of functional programming concepts.
This is fast and cool:
(def fib (lazy-cat [0 1] (map + fib (rest fib))))
from:
http://squirrel.pl/blog/2010/07/26/corecursion-in-clojure/
In Clojure it's actually advisable to avoid recursion and instead use the loop and recur special forms. This turns what looks like a recursive process into an iterative one, avoiding stack overflows and improving performance.
Here's an example of how you'd implement a Fibonacci sequence with this technique:
(defn fib [n]
(loop [fib-nums [0 1]]
(if (>= (count fib-nums) n)
(subvec fib-nums 0 n)
(let [[n1 n2] (reverse fib-nums)]
(recur (conj fib-nums (+ n1 n2)))))))
The loop construct takes a series of bindings, which provide initial values, and one or more body forms. In any of these body forms, a call to recur will cause the loop to be called recursively with the provided arguments.
You can use the thrush operator to clean up #3 a bit (depending on who you ask; some people love this style, some hate it; I'm just pointing out it's an option):
(defn fib [n]
(->> [0 1]
(iterate (fn [[a b]] [b (+ a b)]))
(map first)
(take n)))
That said, I'd probably extract the (take n) and just have the fib function be a lazy infinite sequence.
(def fib
(->> [0 1]
(iterate (fn [[a b]] [b (+ a b)]))
(map first)))
;;usage
(take 10 fib)
;;output (0 1 1 2 3 5 8 13 21 34)
(nth fib 9)
;; output 34
A good recursive definition is:
(def fib
(memoize
(fn [x]
(if (< x 2) 1
(+ (fib (dec (dec x))) (fib (dec x)))))))
This will return a specific term. Expanding this to return first n terms is trivial:
(take n (map fib (iterate inc 0)))
Here is the shortest recursive function I've come up with for computing the nth Fibonacci number:
(defn fib-nth [n] (if (< n 2)
n
(+ (fib-nth (- n 1)) (fib-nth (- n 2)))))
However, the solution with loop/recursion should be faster for all but the first few values of 'n' since Clojure does tail-end optimization on loop/recur.
this is my approach
(defn fibonacci-seq [n]
(cond
(= n 0) 0
(= n 1) 1
:else (+ (fibonacci-seq (- n 1)) (fibonacci-seq (- n 2)))
)
)
For latecomers. Accepted answer is a slightly complicated expression of this:
(defn fib
([n]
(fib [0 1] n))
([x, n]
(if (< (count x) n)
(recur (conj x (apply + (take-last 2 x))) n)
x)))
For what it's worth, lo these years hence, here's my solution to 4Closure Problem #26: Fibonacci Sequence
(fn [x]
(loop [i '(1 1)]
(if (= x (count i))
(reverse i)
(recur
(conj i (apply + (take 2 i)))))))
I don't, by any means, think this is the optimal or most idiomatic approach. The whole reason I'm going through the exercises at 4Clojure ... and mulling over code examples from Rosetta Code is to learn clojure.
Incidentally I'm well aware that the Fibonacci sequence formally includes 0 ... that this example should loop [i '(1 0)] ... but that wouldn't match their spec. nor pass their unit tests despite how they've labelled this exercise. It is written as an anonymous recursive function in order to conform to the requirements for the 4Clojure exercises ... where you have to "fill in the blank" within a given expression. (I'm finding the whole notion of anonymous recursion to be a bit of a mind bender; I get that the (loop ... (recur ... special form is constrained to tail-recursion ... but it's still a weird syntax to me).
I'll take #[Arthur Ulfeldt]'s comment, regarding fib3 in the original posting, under consideration as well. I've only used Clojure's iterate once, so far.

Binomial Coefficient using Tail Recursion in LISP

I want to program a function to find C(n,k) using tail recursion, and I would greatly appreciate your help.
I have reached this:
(defun tail-recursive-binomial (n k)
(cond ((or (< n k) (< k 0)) NIL)
((or (= k 0) (= n k)) 1)
(T (* (tail-recursive-binomial (- n 1) (- k 1)) (/ n k)))))
Using the following property of the binomial coefficients.
But I don't know how to make the recursive call to be the last instruction executed by each instance, since there the last one is the product. I have been trying it by using an auxiliary function, which I think is the only way, but I haven't found a solution.
As starblue suggests, use a recursive auxiliary function:
(defun binom (n k)
(if (or (< n k) (< k 0))
NIL ; there are better ways to handle errors in Lisp
(binom-r n k 1)))
;; acc is an accumulator variable
(defun binom-r (n k acc)
(if (or (= k 0) (= n k))
acc
(binom-r (- n 1) (- k 1) (* acc (/ n k)))))
Or, give the main function an optional accumulator argument with a default value of 1 (the recursive base case):
(defun binom (n k &optional (acc 1))
(cond ((or (< n k) (< k 0)) NIL)
((or (= k 0) (= n k)) acc)
(T (binom (- n 1) (- k 1) (* acc (/ n k))))))
The latter option is slightly less efficient, since the error condition is checked in every recursive call.
You need an auxiliary function with an extra argument, which you use for computing and passing the result.

Resources