;A bunch of simple Scheme procedures. ; ;By David Warde-Farley -- dwf AT cs dot toronto dot edu ; ;Copyright (c) 2005 David Warde-Farley ;All rights reserved. ; ;Redistribution and use in source and binary forms, with or without ;modification, are permitted provided that the following conditions ;are met: ;1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ;2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ;3. The name of the author may not be used to endorse or promote products ; derived from this software without specific prior written permission. ; ;THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ;IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ;OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ;IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ;INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ;NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ;DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ;THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;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))))))