Some simple to moderately complicated Scheme procedures I wrote while learning Scheme.

funtimes.scm

;A bunch of increasingly complex Scheme procedures I wrote while
;learning Scheme.
;
; By David Warde-Farley -- user AT cs dot toronto dot edu (user = dwf)
; Redistributable under the terms of the 3-clause BSD license 
; (see http://www.opensource.org/licenses/bsd-license.php for details)

;Increment a value and return it.

(define inc
  (lambda (x)
  (+ x 1)))

;Absolute value example

(define (abs-val x)
    (if (>= x 0)
        x
        (- x)))

;Count the number of elements in a list. The builtin "length" does this.

(define how-many
  (lambda (x)
    (cond ((eq? x ())
           0)
          (else (+ 1 (how-many (cdr x)))))))

;An equivalent procedure, doing it with the if construct.
;also, uses (null? x) instead of the equivalent (eq? x ())

(define how-many2
  (lambda (x)
    (if (null? x)
        0
        (+ 1 (how-many2 (cdr x))))))

;A third implementation using a tail-call recursive helper and an
;accumulator variable.

(define how-many3
  (lambda (x)
    (define hmt
      (lambda (x n)
        (if (null? x)
            n
            (hmt (cdr x) (+ n 1)))))
    (hmt x 0)))

;Increment all the values in a list and any sublists.
;Taken from the CSC324 lecture notes handout.

(define increment-list
  (lambda (x)
    (cond ((null? x) ())
          ((number? x) (+ x 1))
          (else (cons (increment-list (car x))
                      (increment-list (cdr x)))))))

;Reverse the elements in a list (O(n^2)).

(define rev
  (lambda (x) 
    (if (eq? x ())
        ()
        (append (reverse (cdr x)) (cons (car x) ())))))

;Reverse a list in linear time.

(define revbetter
  (lambda (x)
    (define revaux
      (lambda (x acc)
        (if (null? x)
            acc
            (revaux (cdr x) (append (list (car x)) acc)))))
    (revaux x ())))

;Find the minimum value in a list.

(define minimum 
      (lambda (x) 
        (define minrecurse
          (lambda (x curmin)
            (if (null? x)
                curmin
                (if (< (car x) curmin)
                    (minrecurse (cdr x) (car x))
                    (minrecurse (cdr x) curmin)))))
          (minrecurse (cdr x) (car x))))

;The classical recursive problem: a factorial.

(define factorial
  (lambda (x)
    (if (eq? x 1)
        x
        (* x (factorial (- x 1))))))

;predicate for a valid matrix, that is, one with all rows the same length.

(define validmatrix?
  (lambda (x)
    
    ;and together a list
    
    (define andlist
      (lambda (x)
        (define andr
          (lambda (x rest)
            (if (null? rest)
                x
                (andr (and x (car rest)) (cdr rest)))))
        (andr (car x) (cdr x))))
    
    ;sub-procedure that checks each with the next

    (define checkwithnext
      (lambda (cur rest)
        (if (null? rest)
            #t
            (if (not (eq? (length cur) (length (car rest))))
                #f
                (checkwithnext (car rest) (cdr rest))))))
    (checkwithnext (car x) (cdr x))))


;Matrix addition - add two matrices of the same dimensions together.

(define matrix-add
  (lambda (x y)    
    ;add two rows together
    (define rowadd
      (lambda (v1 v2)
        (map + v1 v2)))
    
    ;Check both matrices are valid
    (if (and (validmatrix? x) (validmatrix? y))
        
        ;Check the dimensions match
        (if (and 
             (eq? (length x) (length y)) 
             (eq? (length (car x)) (length (car y))))
            (map rowadd x y)
            -1)
        -1)))

;Matrix transposition - useful for the multiplication procedure seen below.

(define transpose
  (lambda (x)
    (if (eq? (length (car x)) 1)
        (list (map car x))
        (append (list (map car x)) (transpose (map cdr x))))))

;Matrix multiplication - multiplies two M x N and N x P matrices together. 
;Returns -1 if either of the parameters are invalid matrices or the lengths.

(define matrix-mult
  (lambda (x y)
    (define multandadd
      (lambda (x y)
        (apply + (map * x y))))
    (if (null? x)
        ()
        (if (not (and (validmatrix? x) (validmatrix? y)
                      (eq? (length (car x)) (length y))))
            -1
            (append 
             (list (map (lambda (z) (multandadd (car x) z)) (transpose y)))
             (matrix-mult (cdr x) y))))))