external/clem/src/exponential.lisp

   1
   2 (in-package :clem)
   3
   4 (defmethod mat-square ((u matrix))
   5   (map-set-val-copy u #'(lambda (x) (* x x))))
   6
   7 (defmethod mat-square! ((u matrix))
   8   (map-set-val u #'(lambda (x) (* x x))))
   9
  10 (defmethod mat-sqrt ((u matrix))
  11   (map-set-val-copy u #'(lambda (x) (sqrt x))))
  12
  13 (defmethod mat-sqrt! ((u matrix))
  14   (map-set-val u #'(lambda (x) (sqrt x))))
  15
  16 (defmacro def-matrix-square (matrix-type)
  17   (let ((element-type (element-type (find-class `,matrix-type))))
  18     `(progn
  19       (defmethod mat-square! ((u ,matrix-type))
  20         (declare (optimize (speed 3)
  21                            (safety 0)))
  22         (destructuring-bind (rows cols) (mapcar #'1- (dim u))
  23           (declare (type fixnum rows cols))
  24           (with-typed-map-range u ,element-type 0 rows 0 cols (a i j)
  25             (let ((val (aref a i j)))
  26               (declare (type ,element-type val))
  27               (setf (aref a i j) (* val val)))))
  28         u)
  29
  30       (defmethod mat-sqrt! ((u ,matrix-type))
  31         (destructuring-bind (rows cols) (mapcar #'1- (dim u))
  32           (declare (type fixnum rows cols))
  33           (with-map-range u ,element-type 0 rows 0 cols (a i j)
  34             (setf (aref a i j) (sqrt (aref a i j)))))
  35         u))))
  36
  37 (macrolet ((frob (type-1)
  38              `(def-matrix-square ,type-1)))
  39   (frob double-float-matrix)
  40   (frob single-float-matrix))