Commits

David Jones committed 5a1d3d6

ok, multiple dispatch is fun.

  • Participants
  • Parent commits 18268fe

Comments (0)

Files changed (1)

File lisp/examples/clos.lisp

 (defstruct (full-matrix (:include matrix))
   data)
 
+(defstruct (diagonal-matrix (:include matrix))
+  data)
+
+
 
 
 (defmethod matrix-get-data ((m full-matrix) row column)
 (defmethod matrix-set-data ((m full-matrix) row column value)
   (setf (aref (full-matrix-data m) row column) value))
 
+
+(defmethod matrix-get-data ((m diagonal-matrix) row column)
+  (if (/= row column) 
+      0.0
+      (aref (diagonal-matrix-data m) row)))
+
+
+
+(defmethod matrix-set-data ((m diagonal-matrix) row column value)
+  (if (= row column) 
+      (setf (aref (diagonal-matrix-data m) row) value)
+      (error "this would make the matrix non-diagonal...")))
+
+
+
   
 
 (defmethod matrix-multiply ((x matrix) (y matrix))
   (error "not implemented"))
 
+
+(defmethod check-dimensions ((x matrix) (y matrix))
+  (when (/= (matrix-columns x) (matrix-rows y))
+    (error "dimensions don't agree")))
+
+
+(defmethod matrix-multiply ((x matrix) (y matrix))
+  "This is ugly, but it implements the naive triple loop matrix
+multiple on matrices."
+  (check-dimensions x y)
+  (let* ((m (matrix-rows x))
+         (n (matrix-columns y))
+         (p (matrix-rows y))
+         (result (make-full-matrix :rows m :columns n 
+                                   :data (make-array (list m n)
+                                                     :initial-element 0d0))))
+    (dotimes (i m result)
+      (dotimes (j n)
+        (dotimes (k p)
+          (matrix-set-data result i j 
+                           (+ (matrix-get-data result i j)
+                              (* (matrix-get-data x i k)
+                                 (matrix-get-data y k j)))))))))
+    
+
 (defmethod matrix-multiply ((x full-matrix) (y full-matrix))
   "This is ugly, but it implements the naive triple loop matrix
 multiple on matrices."
+  (check-dimensions x y)
   (let* ((m (matrix-rows x))
          (n (matrix-columns y))
          (p (matrix-rows y))
           (incf (aref (full-matrix-data result) i j)
                 (* (aref (full-matrix-data x) i k)
                    (aref (full-matrix-data y) k j))))))))
-    
+
+
+(defmethod matrix-multiply ((x diagonal-matrix) (y full-matrix))
+  "This is ugly, but it implements the naive triple loop matrix
+multiple on matrices."
+  (check-dimensions x y)
+  (let* ((m (matrix-rows x))
+         (n (matrix-columns y))
+         (p (matrix-rows y))
+         (result (make-full-matrix :rows m :columns n 
+                                   :data (make-array (list m n)
+                                                     :initial-element 0d0))))
+    (dotimes (i m result)
+      (dotimes (j n)
+        (when (< i p)
+          (incf (aref (full-matrix-data result) i j)
+                (* (matrix-get-data x i i)
+                   (matrix-get-data y i j))))))))
+
+
+(defmethod matrix-multiply ((x diagonal-matrix) (y diagonal-matrix))
+  "This is ugly, but it implements the naive triple loop matrix
+multiple on matrices."
+  (check-dimensions x y)
+  (let* ((m (matrix-rows x))
+         (result (make-diagonal-matrix :rows m :columns m 
+                                       :data (make-array m
+                                                         :initial-element 0d0))))
+    (dotimes (i m result)
+      (matrix-set-data result i i
+                       (* (matrix-get-data x i i)
+                          (matrix-get-data y i i))))))
+
+
+
+
+
+
+