Category: Scheme

If you haven’t had the chance, you really should pick up a copy of Common Lisp: A gentle introduction to symbolic computation by David Touretzky, in there you will find a series of “templates” for recursion. Consider these like tools in you toolbox.

The following is a presentation of these “recursion templates” in Scheme code with generous examples. Not as clumsy or imprecise as a for loop, they are elegant weapons, from a more civilized era.

Double-Test Tail Recursion

This template is a simple search recursion across a list.

(define (has-odd? lst)
	(cond
		((null? lst) #f)
		((odd? (car lst)) #t)
		(else
			(has-odd? (cdr lst)))))

As you see, we have a Double-Test at the beginning of the cond, the first tests null, and the second tests for the needle that we are searching for in the haystack that we’ve been passed.

In Touretzsky’s version, the first clause returned nil, I’ve elected to return #f which I think is more correct, as an empty list obviously does not have any odds in it. I prefer a uniformity in return types, even though in this example ‘() is certainly not true, therefore it is functionally equivalent.

Search a list for a value

(define (in-list? needle haystack)
    (cond
      ((null? haystack) #f)
      ((equal? (car haystack) needle)
        #t)
      (else
          (in-list? needle (cdr haystack)))))
(in-list? "Hello" '("Hello" "World")) ; #t
(in-list? "Hello" '("Goobye" "World")) ; #f

Single Test Augmenting Recursion, or Incrementing Recursion

This is a way to recursively accumulate or increment some value, such as counting.

(define (count-items lst)
    (cond
        ((null? lst) 0)
        (else
            (+ 1 (count-items (cdr lst))))))

List Consing Recursion

Here we build a list of values as we go along, notice that we are decrementing, so the numbers are in reverse order.

(define (count-down n)
	(cond
	  ((zero? n)
	   '())
	  (else
		(cons n (count-down (- n 1))))))

An alternative to this would be:

(define (count-up n)
  (let loop ((i 1))
    (cond
      ((> i n) '())
      (else
        (cons i (loop (+ i 1)))))))

Simultaneous Multivariate Recursion

Here we define a function that accepts an ordinal, like 1st, 2nd, 3rd (without the ordinal suffix), and
return that element.

In Touretzky’s book, he reimplements nth, which starts at zero, our function however does not accept 0.

(define (snatch i lst)
  (cond
    ((<= i 1)
      (car lst))
    (else
      (snatch (- i 1) (cdr lst)))))

Conditional Consing

Here we have two paths, one (number?) which conses the car of lst with the result of a recursive call to nums, or, which simply returns whatever would be returned via the continuation. Notice how the numbers come out in order!

(define (nums lst)
  (cond
	((null? lst) '())
	((number? (car lst))
	 (cons 
	   (car lst)
	   (nums (cdr lst))))
	(else
	  (nums (cdr lst)))))

Multiple Recursion

Here we combine the results from two independent recursions, each call has the possibility of generating 2 more recursions and on and on.

(define (fib n)
  (cond
	((equal? n 0) 1)
	((equal? n 1) 1)
	(else
	  (+ (fib (- n 1))
		 (fib (- n 2))))))

Car/Cdr Recursion

(define (find-number lst)
  (cond
	((number? lst) lst)
	((atom? lst) #f)
	(else
	  (or (find-number (car lst))
		  (find-number (cdr lst))))))

Page is a work in progress

This isn’t a true hash table, it’s really just a pair list, but it behaves how most imperative programmers would expect a hash table to behave. Note: it is a naive implementation, so it has a linear access time.

(define (store data key value)
  (cond
	((null? data) (cons (list key value) '()))
	((equal? (caar data) key)
	 (cons (list key value) (cdr data)))
	(else
	  (cons (car data) (store (cdr data) key value)))))
(define (fetch data key)
  (cond
	((null? data) '())
	((equal? (caar data) key) (cadar data))
	(else
	  (fetch (cdr data) key))))
(set! x (store '() 'hello "World"))
(set! x (store x "The rain in spain" "falls mainly on the plain"))
(set! x (store x '(a b c) 42))
(fetch x '(a b c))
(fetch x "The rain in spain")

Here is a bit of code I’ve been tinkering with, it’s a simple CSV parser in Scheme that I am using to parse Stock data so that I can back test trading strategies.

(define (csv->list file_name)
  (with-input-from-file file_name
	(lambda ()
	  (let reading ((chars '()) (rows '()) (cols '()))
		(let ((char (read-char)))
		  (cond
			((eof-object? char) (reverse rows))
			((char=? char #\newline)
			 (reading '() (cons 
					(reverse 
					  (cons (list->string (reverse chars)) cols)) 
					rows) '()))
			((char=? char #\,)
			 (reading '() rows
			   (cons (list->string (reverse chars)) cols)))
			(else
			  (reading (cons char chars) rows cols))))))))
(csv->list "D:/Projects/StockMarket/NASDAQ_20101105.txt")

The above is why I love Scheme. Such a succinct language.

How to design functions in Scheme

The above small function follows the basic function design pattern, we begin with the target or most significant goal state: EOF. What do we do?

((eof-object? char) (reverse rows))

We return the reverse of the rows. This is because cons prepends new elements. Now we could call (append) instead of (cons) but (append) has to find the end of the list each time, adding unnecessary overhead.

Our next goal, or major target is the end of line, or #\newline character.

((char=? char #\newline)
  (reading '() (cons 
    (reverse 
	(cons (list->string (reverse chars)) cols)) 
     rows) '()))

If the current char equals a new line, we need to:

  1. Produce the column value (newline works like comma)
  2. Prepend the column value to the lists (cols)
  3. Prepend the (reverse cols) list onto (rows)
  4. Recurse into (reading) with the new (rows) and ‘() for both chars and cols

The next goal state, is encountering a comma, or the delimiter:

((char=? char #\,)
    (reading '() rows
      (cons (list->string (reverse chars)) cols)))

In this case we need to recurse into (reading) with ‘() for chars, as well as prepending the (reverse) of (chars) stringified to (cols).

So I’ve picked up a new book, Introduction to Algorithms, 3rd ed. and I’ve decided to try implementing some of them as a practice using Scheme, specifically I’m using a vanilla install of Chez Scheme.

(define merge-sort
  (lambda (l A L R sw)
	(cond
	  ((and (null? L) (null? l)) (append A R))
	  ((and (null? R) (null? l)) (append A L))
	  (else
		(cond 
		  ((null? l)
		   (cond
			 ((and (null? A) (or (= sw 1) (= sw 0)))
			  (merge-sort 
				l 
				A 
				(merge-sort L '() '() '() 0) 
				(merge-sort R '() '() '() 0) 
				-1))
			 (else
		   		(if (<= (car L) (car R))
			 		(merge-sort 
					  l 
					  (append A (list (car L))) 
					  (cdr L) 
					  R 
					  sw)
			 		(merge-sort 
					  l 
					  (append A (list (car R))) 
					  L 
					  (cdr R) 
					  sw)))))
		  (else
			(if (= sw 0)
			  (merge-sort 
				(cdr l) 
				A 
				(append L (list (car l))) 
				R 
				1)
			  (merge-sort 
				(cdr l) 
				A 
				L 
				(append R (list (car l))) 
				0))))))))

(merge-sort '(85 6 43 33 21 9 1 3 22 84 85) '() '() '() 0)

So I’ve picked up a new book, Introduction to Algorithms, 3rd ed. and I’ve decided to try implementing some of them as a practice using Scheme, specifically I’m using a vanilla install of Chez Scheme.

(define isort 
    (lambda (l1 l2)
        (cond
            ((null? l1) l2)
            ((null? l2) (isort
                (cdr l1)
                (cons (car l1) l2)))
            ((<= (car l1) (car l2)) 
                (isort
                    (cdr l1)
                    (cons
                        (car l1)
                        l2)))
            ((> (car l1) (car l2))
                (isort
                    (cdr l1)
                    (cons 
                        (car l2) (isort 
                            (cons 
                                (car l1) 
                                '()) 
                            (cdr l2))))))))
(isort '(85 12 59 45 72 51) '())

Now that’s all fine and good, but we need ‘More Power’ as Tim the Toolman Taylor would say. I think it’d be nice if we could pass the function a comparator, so that we could do ascending and descending sorts.

(define isortf 
    (lambda (l1 l2 c1 c2)
        (cond
            ((null? l1) l2)
            ((null? l2) (isort
                (cdr l1)
                (cons (car l1) l2) c1 c2))
            ((apply 
                c1 (list 
                    (car l1) 
                    (car l2))) 
                (isortf
                    (cdr l1)
                    (cons
                        (car l1)
                        l2) 
                    c1 
                    c2))
            ((apply 
                c2 (list 
                    (car l1) (car l2)))
                (isortf
                    (cdr l1)
                    (cons 
                        (car l2) (isortf 
                            (cons 
                                (car l1) 
                                '()) 
                            (cdr l2) 
                            c1
                            c2)) 
                    c1
                    c2)))))

(isort '(3 4 2 1) '())
(isortf '(3 4 2 1) '() >= <)

When you write in Scheme, it all makes perfect sense to you. It looks hand crafted, like a fine old carving. But part of you knows it's probably completely incomprehensible to anyone else.

Oh well. At least I think it's beautiful.