Work on parsing and operators

math.lisp

@@ -60,13 +60,6 @@ VALUE, the ROW, and the COLUMN."
                                col)))
               (setf (aref minor out-row out-col) (aref mat row col)))))))))
 
-(defun first-column-cofactors (mat)
-  "Find the cofactors for the first column of MAT."
-  (let* ((height (array-dimension mat 0))
-         (out-arr (make-array height)))
-    (dotimes (i height out-arr)
-      (setf (aref out-arr i) (cofactor mat i 0)))))
-
 (defun cofactor-sgn (i j)
   "Return the sign of the cofactor at I and J."
   (expt -1 (+ i j)))
@@ -75,6 +68,13 @@ VALUE, the ROW, and the COLUMN."
   "Find the cofactor for I and J in MAT."
   (* (cofactor-sgn i j) (det (mat-minor mat i j))))
 
+(defun first-column-cofactors (mat)
+  "Find the cofactors for the first column of MAT."
+  (let* ((height (array-dimension mat 0))
+         (out-arr (make-array height)))
+    (dotimes (i height out-arr)
+      (setf (aref out-arr i) (cofactor mat i 0)))))
+
 (defun det2x2 (mat)
   "Find the determinate of a 2x2 matrix MAT."
   (let ((a (aref mat 0 0))
@@ -295,6 +295,84 @@ already been calculated, they can be supplied in FIRST-COLUMN-COFACTORS."
     (dotimes (i n mat)
       (setf (aref mat i i) 1))))
 
+(defun copy-matrix (mat)
+  "Return a copy of MAT."
+  (mapmatrix (lambda (val row col)
+               (declare (ignorable row col))
+               val)
+             mat))
+
+(defun nswap-rows (mat r1 r2)
+  "Swap rows R1 and R2 in mat. R1 and R2 are 0-indexed. This operation is
+destructive."
+  (let ((width (array-dimension mat 1)))
+    (dotimes (i width mat)
+      (rotatef (aref mat r1 i) (aref mat r2 i)))))
+
+(defun swap-rows (mat r1 r2)
+  "Swap rows R1 and R2 in mat. R1 and R2 are 0-indexed. This operation is
+not destructive."
+  (mapmatrix (lambda (val row col)
+               (cond
+                 ((= r1 row)
+                  (aref mat r2 col))
+                 ((= r2 row)
+                  (aref mat r1 col))
+                 (t val)))
+             mat))
+
+(defun nscale-row (mat row scale)
+  "Replace ROW in MAT with itself multiplied by SCALE. ROW is 0-indexed."
+  (let ((width (array-dimension mat 1)))
+    (dotimes (i width mat)
+      (setf (aref mat row i)
+            (* scale (aref mat row i))))))
+
+(defun scale-row (mat row scale)
+  "Like `nscale-row', but copy MAT."
+  (mapmatrix (lambda (val irow col)
+               (declare (ignorable col))
+               (if (= irow row)
+                   (* val scale)
+                   val))
+             mat))
+
+(defun nreplace-row-with-sum (mat r1 r2 &key (scale 1))
+  "Replace row R2 in MAT with R1 + SCALE * R2. ROW is 0-indexed."
+  (let ((width (array-dimension mat 1)))
+    (dotimes (i width mat)
+      (incf (aref mat r1 i) (* scale (aref mat r2 i))))))
+
+(defun replace-row-with-sum (mat r1 r2 &key (scale 1))
+  "Like `nreplace-row-with-sum', but copy MAT."
+  (mapmatrix (lambda (val row col)
+               (if (= row r1)
+                   (+ val (* scale (aref mat r2 col)))
+                   val))
+             mat))
+
+(defun tensor-mm (m1 m2)
+  "Calculate the tensor product of M1 and M2."
+  (let* ((height (* (array-dimension m1 0)
+                    (array-dimension m2 0)))
+         (width (* (array-dimension m1 1)
+                   (array-dimension m2 1)))
+         (out-mat (make-array (list height width))))
+    (dotimes (row height out-mat)
+      (dotimes (col width)
+        (setf (aref out-mat row col)
+              (* (aref m1 (floor row (array-dimension m2 0))
+                       (floor col (array-dimension m2 1)))
+                 (aref m2 (mod row (array-dimension m2 0))
+                       (mod col (array-dimension m2 1)))))))))
+
+(defun tensor-vv (v1 v2)
+  "Calculate the tensor product of V1 and V2."
+  (apply 'concatenate 'vector
+         (map 'list (lambda (elt)
+                      (*vs v2 elt))
+              v1)))
+
 (defun round-to-place (num places &key (base 10))
   "Round NUM to PLACES places in BASE."
   (let ((scale (expt base places)))
@@ -387,5 +465,3 @@ which parsing stopped. That is, the index of the first un-parsed character."
                     (< pos end))
                (error "Junk in string: ~s" (subseq string start end))
                (return (values num pos)))))
-
-