/trunk/Examples/guile/matrix/matrix.scm
Lisp | 210 lines | 142 code | 34 blank | 34 comment | 0 complexity | 6a02dced5b9bcb328d4c1c8050dda5e2 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
- #!./matrix \
- -e do-test -s
- !#
- ;;; Authors: David Beazley <beazley@cs.uchicago.edu>, 1999
- ;;; Martin Froehlich <MartinFroehlich@ACM.org>, 2000
- ;;;
- ;;; PURPOSE OF THIS FILE: This file is an example for how to use the guile
- ;;; scripting options with a little more than trivial script. Example
- ;;; derived from David Beazley's matrix evaluation example. David
- ;;; Beazley's annotation: >>Guile script for testing out matrix
- ;;; operations. Disclaimer : I'm not a very good scheme
- ;;; programmer<<. Martin Froehlich's annotation: >>I'm not a very good
- ;;; scheme programmer, too<<.
- ;;;
- ;;; Explanation: The three lines at the beginning of this script are
- ;;; telling the kernel to load the enhanced guile interpreter named
- ;;; "matrix"; to execute the function "do-test" (-e option) after loading
- ;;; this script (-s option). There are a lot more options wich allow for
- ;;; even finer tuning. SEE ALSO: Section "Guile Scripts" in the "Guile
- ;;; reference manual -- Part I: Preliminaries".
- ;;;
- ;;;
- ;;; This program is distributed in the hope that it will be useful, but
- ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
- ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- ;;; Create a zero matrix
- (define (zero M)
- (define (zero-loop M i j)
- (if (< i 4)
- (if (< j 4) (begin
- (set-m M i j 0.0)
- (zero-loop M i (+ j 1)))
- (zero-loop M (+ i 1) 0))))
- (zero-loop M 0 0))
- ;;; Create an identity matrix
- (define (identity M)
- (define (iloop M i)
- (if (< i 4) (begin
- (set-m M i i 1.0)
- (iloop M (+ i 1)))))
- (zero M)
- (iloop M 0))
- ;;; Rotate around x axis
- (define (rotx M r)
- (define temp (new-matrix))
- (define rd (/ (* r 3.14159) 180.0))
- (zero temp)
- (set-m temp 0 0 1.0)
- (set-m temp 1 1 (cos rd))
- (set-m temp 1 2 (- 0 (sin rd)))
- (set-m temp 2 1 (sin rd))
- (set-m temp 2 2 (cos rd))
- (set-m temp 3 3 1.0)
- (mat-mult M temp M)
- (destroy-matrix temp))
- ;;; Rotate around y axis
- (define (roty M r)
- (define temp (new-matrix))
- (define rd (/ (* r 3.14159) 180.0))
- (zero temp)
- (set-m temp 1 1 1.0)
- (set-m temp 0 0 (cos rd))
- (set-m temp 0 2 (sin rd))
- (set-m temp 2 0 (- 0 (sin rd)))
- (set-m temp 2 2 (cos rd))
- (set-m temp 3 3 1.0)
- (mat-mult M temp M)
- (destroy-matrix temp))
- ;;; Rotate around z axis
- (define (rotz M r)
- (define temp (new-matrix))
- (define rd (/ (* r 3.14159) 180.0))
- (zero temp)
- (set-m temp 0 0 (cos rd))
- (set-m temp 0 1 (- 0 (sin rd)))
- (set-m temp 1 0 (sin rd))
- (set-m temp 1 1 (cos rd))
- (set-m temp 2 2 1.0)
- (set-m temp 3 3 1.0)
- (mat-mult M temp M)
- (destroy-matrix temp))
- ;;; Scale a matrix
- (define (scale M s)
- (define temp (new-matrix))
- (define (sloop m i s)
- (if (< i 4) (begin
- (set-m m i i s)
- (sloop m (+ i 1) s))))
- (zero temp)
- (sloop temp 0 s)
- (mat-mult M temp M)
- (destroy-matrix temp))
- ;;; Make a matrix with random elements
- (define (randmat M)
- (define (rand-loop M i j)
- (if (< i 4)
- (if (< j 4)
- (begin
- (set-m M i j (drand48))
- (rand-loop M i (+ j 1)))
- (rand-loop M (+ i 1) 0))))
- (rand-loop M 0 0))
- ;;; stray definitions collected here
- (define (rot-test M v t i)
- (if (< i 360) (begin
- (rotx M 1)
- (rotz M -0.5)
- (transform M v t)
- (rot-test M v t (+ i 1)))))
- (define (create-matrix) ; Create some matrices
- (let loop ((i 0) (result '()))
- (if (< i 200)
- (loop (+ i 1) (cons (new-matrix) result))
- result)))
- (define (add-mat M ML)
- (define (add-two m1 m2 i j)
- (if (< i 4)
- (if (< j 4)
- (begin
- (set-m m1 i j (+ (get-m m1 i j) (get-m m2 i j)))
- (add-two m1 m2 i (+ j 1)))
- (add-two m1 m2 (+ i 1) 0))))
- (if (null? ML) () (begin
- (add-two M (car ML) 0 0)
- (add-mat M (cdr ML)))))
- (define (cleanup ML)
- (if (null? ML) () (begin
- (destroy-matrix (car ML))
- (cleanup (cdr ML)))))
- (define (make-random ML) ; Put random values in them
- (if (null? ML) () (begin
- (randmat (car ML))
- (make-random (cdr ML)))))
- (define (mul-mat m ML)
- (if (null? ML) () (begin
- (mat-mult m (car ML) m)
- (mul-mat m (cdr ML)))))
- ;;; Now we'll hammer on things a little bit just to make
- ;;; sure everything works.
- (define M1 (new-matrix)) ; a matrix
- (define v (createv 1 2 3 4)) ; a vector
- (define t (createv 0 0 0 0)) ; the zero-vector
- (define M-list (create-matrix)) ; get list of marices
- (define M (new-matrix)) ; yet another matrix
- (display "variables defined\n")
- (define (do-test x)
- (display "Testing matrix program...\n")
- (identity M1)
- (print-matrix M1)
- (display "Rotate-x 45 degrees\n")
- (rotx M1 45)
- (print-matrix M1)
- (display "Rotate y 30 degrees\n")
- (roty M1 30)
- (print-matrix M1)
- (display "Rotate z 15 degrees\n")
- (rotz M1 15)
- (print-matrix M1)
- (display "Scale 0.5\n")
- (scale M1 0.5)
- (print-matrix M1)
- ;; Rotating ...
- (display "Rotating...\n")
- (rot-test M1 v t 0)
- (printv t)
- (make-random M-list)
- (zero M1)
- (display "Adding them together (in Guile)\n")
- (add-mat M1 M-list)
- (print-matrix M1)
- (display "Doing 200 multiplications (mostly in C)\n")
- (randmat M)
- (mul-mat M M-list)
- (display "Cleaning up\n")
- (cleanup M-list))
- ;;; matrix.scm ends here