(module nw:matrices (export (make-matrix n m . fill) (matrix? obj) (matrix-ref T i j) (matrix-set! T i j val) (matrix-nlines T) (matrix-ncols T) (matrix-margins M s1 s2) (matrix-print T)) (import nw:chains)) (define matrix-tag "*MATRIX*") (define (make-matrix lin col . fill) (let ((the-table (vector matrix-tag (make-vector lin #f)))) (do ((i 0 (+ i 1))) ((= i lin)) (vector-set! (vector-ref the-table 1) i (if (null? fill) (make-vector col) (make-vector col (car fill))))) the-table)) ;; un prédicat d'appartenance, pour vérifier qu'un ;; objet appartient bien au type : (define (matrix? obj) (and (vector? obj) (string=? (vector-ref obj 0) matrix-tag) (vector? (vector-ref obj 1)))) ;; un mutateur, pour modifier un objet du type en ;; affectant une valeur à un élément du tableau : (define (matrix-set! T i j val) (if (matrix? T) (vector-set! (vector-ref (vector-ref T 1) i) j val))) ;; un sélecteur, pour accéder à un élément du tableau : (define (matrix-ref T i j) (if (matrix? T) (vector-ref (vector-ref (vector-ref T 1) i) j))) (define (matrix-margins M s1 s2) ;; pour remplir les marges (let ((nlin (matrix-nlines M));; du tableau avec les (ncol (matrix-ncols M)));; textes des séquences (do ((j 2 (+ j 1)) (c (chain-ref s1 1) (chain-ref s1 (min j (- ncol 2))))) ((= j ncol) 'fait) (matrix-set! M 0 j c)) (do ((i 2 (+ i 1)) (c (chain-ref s2 1) (chain-ref s2 (min i (- nlin 2))))) ((= i nlin) 'fait) (matrix-set! M i 0 c)) (matrix-set! M 0 0 #\space) (matrix-set! M 0 1 #\space) (matrix-set! M 1 0 #\space))) ;; diverses procédures utilitaires dont la fonction se ;; comprend d'elle-même : (define (matrix-nlines T) (if (matrix? T) (vector-length (vector-ref T 1)))) (define (matrix-ncols T) (if (matrix? T) (vector-length (vector-ref (vector-ref T 1) 0)))) (define (matrix-print T) (if (matrix? T) (let ((n (matrix-nlines T)) (m (matrix-ncols T))) (do ((i 0 (+ 1 i))) ((= i n)) (let ((this-line (vector-ref (vector-ref T 1) i))) (do ((j 0 (+ 1 j))) ((= j m)) (display (vector-ref this-line j)) (display " ")) (newline))))))