external/clem/src/typed-ops/defmatrix-subset-matrix.lisp

   1 ;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;;
   2 ;;;
   3 ;;; file: defmatrix-subset-matrix.cl
   4 ;;; author: cyrus harmon
   5 ;;;
   6
   7 (in-package :clem)
   8
   9 (defmacro def-matrix-subset-matrix (matrix-type)
  10   (let ((element-type (element-type (find-class `,matrix-type))))
  11     `(progn
  12        (defmethod subset-matrix ((u matrix) startr endr startc endc)
  13          (destructuring-bind (ur uc) (dim u)
  14            (cond
  15              ((and (<= startr endr ur) (<= startc endc uc))
  16               (let* ((m (1+ (- endr startr)))
  17                      (n (1+ (- endc startc)))
  18                      (c (mat-copy-proto-dim u m n)))
  19                 (with-matrix-vals (u ,element-type a)
  20                   (with-matrix-vals (c ,element-type b)
  21                     (dotimes (i m)
  22                       (dotimes (j n)
  23                         (setf (aref b i j) (aref a (+ i startr) (+ j startc)))))))
  24                 c))
  25              (t nil)))))))
  26
  27
  28 (macrolet ((frob (type-1)
  29              `(def-matrix-subset-matrix ,type-1)))
  30   (frob double-float-matrix))