guile-examples/matrices/matrices.scm

;; ===============
;; data abstration
;; ===============
(define* (make-matrix rows cols #:key (fill 'undefined))
  (make-array fill rows cols))

(define (list->matrix lst)
  (let ([dimensions 2])
    (list->array dimensions lst)))

(define (matrix->list mat)
  (array->list mat))

(define (matrix-ref mat row-ind col-ind)
  (array-ref mat row-ind col-ind))

(define (matrix-set! mat val . inds)
  (apply array-set! mat val inds))

(define (matrix-shape mat)
  (array-shape mat))

(define (matrix-row-count mat)
  (array-length mat))

(define (matrix-col-count mat)
  (let ([shape (matrix-shape mat)])
    (let ([upper-lower-inds-col (cadr shape)])
      (+ (- (cadr upper-lower-inds-col)
            (car upper-lower-inds-col))
         1))))

(define (matrix-get-row mat row-ind)
  (define col-count (matrix-col-count mat))
  (define (iter col-ind)
    (cond [(> col-ind (- col-count 1)) '()]
          [else (cons (matrix-ref mat row-ind col-ind)
                      (iter (+ col-ind 1)))]))
  (list->vector (iter 0)))

(define (matrix-get-col mat col-ind)
  (define row-count (matrix-row-count mat))
  (define (iter row-ind)
    (cond [(> row-ind (- row-count 1)) '()]
          [else (cons (matrix-ref mat row-ind col-ind)
                      (iter (+ row-ind 1)))]))
  (list->vector (iter 0)))


;; =================
;; matrix operations
;; =================
(define (multiply-vectors v1 v2)
    (define (iter ind max-ind)
      (cond [(> ind max-ind) '()]
            [else (cons (* (vector-ref v1 ind) (vector-ref v2 ind))
                        (iter (+ ind 1) max-ind))]))
    (apply + (iter 0 (- (vector-length v1) 1))))

(define (matrix-multiply mat1 mat2)
  (let ([mat1-row-count (matrix-row-count mat1)]
        [mat1-col-count (matrix-col-count mat1)]
        [mat2-row-count (matrix-row-count mat2)]
        [mat2-col-count (matrix-col-count mat2)])
    (cond [(not (= mat1-row-count mat2-col-count))
           (throw 'incompatible-matrix-dimensions
                  (simple-format #f "matrix 1 row count ~a, matrix 2 column count: ~a"
                                 mat1-row-count
                                 mat2-col-count))]
          [else
           (let ([result-mat (make-matrix mat1-row-count mat2-col-count #:fill 'undefined)])
             (do ([r1 0 (+ r1 1)])
                 ([>= r1 mat1-row-count])
               (do ([c2 0 (+ c2 1)])
                   ([>= c2 mat2-col-count])
                 (matrix-set! result-mat
                              (multiply-vectors (matrix-get-row mat1 r1)
                                                (matrix-get-col mat2 c2))
                              r1 c2)))
             result-mat)])))