Continue working on the project in general

math.lisp

@@ -1,4 +1,4 @@
-(in-package :cl-quantum)
+(in-package :cl-quantum/math)
 
 (defmacro domatrix ((var matrix &optional retval) &body body)
   "Execute BODY for with VAR bound once for each element in MATRIX, then
@@ -42,7 +42,7 @@ VALUE, the ROW, and the COLUMN."
      (setf (aref new-mat row col) (funcall function elem row col)))))
 
 ;; Matrix subroutines
-(defun mat-minor (mat i j)
+(defun minor (mat i j)
   "Find the minor of MAT for I and J."
   (destructuring-bind (height width)
       (array-dimensions mat)
@@ -66,7 +66,7 @@ VALUE, the ROW, and the COLUMN."
 
 (defun cofactor (mat i j)
   "Find the cofactor for I and J in MAT."
-  (* (cofactor-sgn i j) (det (mat-minor mat i j))))
+  (* (cofactor-sgn i j) (det (minor mat i j))))
 
 (defun first-column-cofactors (mat)
   "Find the cofactors for the first column of MAT."
@@ -375,8 +375,27 @@ not destructive."
 
 (defun round-to-place (num places &key (base 10))
   "Round NUM to PLACES places in BASE."
-  (let ((scale (expt base places)))
-    (/ (floor (+ (* num scale) 1/2)) scale)))
+  (if (complexp num)
+      (let ((real (round-to-place (realpart num) places :base base))
+            (imag (round-to-place (imagpart num) places :base base)))
+        (if (zerop imag)
+            real
+            (complex real imag)))
+      (let ((scale (expt base places)))
+        (float (/ (floor (+ (* num scale) 1/2)) scale)))))
+
+(defun round-vector (vec places)
+  "Round each entry in VEC to PLACES."
+  (map 'vector (lambda (elt)
+                 (round-to-place elt places))
+       vec))
+
+(defun round-matrix (mat places)
+  "Round each entry in MAT to PLACES."
+  (mapmatrix (lambda (val row col)
+               (declare (ignorable row col))
+               (round-to-place val places))
+             mat))
 
 (defun count-digits (num &key (base 10))
   "Count the number of digits in NUM. If NUM is zero, return 1. If NUM is
@@ -388,80 +407,53 @@ negative, return the number of digits in its absolute value."
 
 (defun build-float (int dec)
   "Create a float with integer part INT and decimal part DEC."
-  (* (signum int) (+ (abs int) (/ dec (expt 10 (count-digits dec))))))
+  (* (if (zerop int) 1 (signum int))
+     (+ (abs int) (/ dec (expt 10 (count-digits dec))))))
 
-(defconstant +parse-real-regexp+
-  (ppcre:create-scanner
-   "^(\\s*([-+]?[0-9]+)(?:/([0-9]+)|\\.?([0-9]*)(?:[eE]([-+]?[0-9]+))?)\\s*)"
-   :extended-mode t)
-  "The regexp scanner used in `parse-real'.")
+(defun mexp (mat &key (times 100))
+  "Calculate exp(MAT) using a Taylor series. The calculation is performed TIMES
+times."
+  (assert (squarep mat)
+          (mat)
+          "Matrix must be square: ~s" mat)
+  (loop for i from 0 to times
+        for numer = (make-identity-matrix (array-dimension mat 0))
+          then (*mm numer mat)
+        for denom = 1 then (* denom i)
+        for res = (/ms numer denom) then (+mm res (/ms numer denom))
+        finally (return res)))
 
-(defun parse-real (string &key (start 0) end junk-allowed)
-  "Parse STRING into a real. Parsing starts at START and ends at END. If end is
-nil, the end of the string is used. If JUNK-ALLOWED is non-nil, don't signal an
-error if an unexpected character is encountered. Two values are returned, the
-first being the value parsed and the second being the index at which parsing
-stopped. That is, the index of the first un-parsed character."
-  (values-list
-   (or
-    (ppcre:register-groups-bind (whole main denom decim exp)
-        (+parse-real-regexp+ string :start start :end end :sharedp t)
-      (unless (or junk-allowed
-                  (= (length whole) (- (or end (length string)) start)))
-        (error "Malformed number: ~s" (subseq string start end)))
-      (let ((num
-              (cond
-                (denom
-                 (/ (parse-integer main)
-                    (parse-integer denom)))
-                ((/= (length decim) 0)
-                 (build-float (parse-integer main)
-                              (parse-integer decim)))
-                (t
-                 (parse-integer main)))))
-        (list (if exp
-                  (* num (expt 10 (parse-integer exp)))
-                  num)
-              (length whole))))
-    (if junk-allowed
-        (list 0 0)
-        (error "Malformed number: ~s" (subseq string start end))))))
+(defun wholep (num)
+  "Return non-nil if NUM is a whole number."
+  (or (integerp num)
+      (and (zerop (imagpart num)) ;; a complex number is not whole
+           (zerop (second (multiple-value-list (floor (realpart num))))))))
 
-(defconstant +parse-complex-regexp+
-  (ppcre:create-scanner
-   "^\\s*([-+])?\\s*([-+]?)([0-9/.]+(?:[eE][-+]?[0-9]+)?)?(i)?"
-   :extended-mode t)
-  "The regexp scanner used in `parse-complex'.")
+(defun mexpt (mat power)
+  "Calculate MAT to the POWERth power. POWER must be an integer."
+  (assert (wholep power)
+          (power)
+          "Not a whole number: ~s" power)
+  (let ((acc (make-identity-matrix (array-dimension mat 0))))
+    (dotimes (i (floor power) acc)
+      (setq acc (*mm acc mat)))))
 
-(defun parse-complex (string &key (start 0) end junk-allowed)
-  "Parse STRING into a complex number. Parsing starts at START and ends at
-END. If end is nil, the end of the string is used. If JUNK-ALLOWED is non-nil,
-don't signal an error if an unexpected character is encountered. Two values are
-returned, the first being the value parsed and the second being the index at
-which parsing stopped. That is, the index of the first un-parsed character."
-  (unless end (setq end (length string)))
-  (loop for pos = start then (+ pos (length whole))
-        for (whole matches) = (multiple-value-list
-                               (ppcre:scan-to-strings +parse-complex-regexp+
-                                                      string
-                                                      :start pos
-                                                      :end end))
-        for times below 2
-        while whole
-        for coef = (cond
-                     ((aref matches 2)
-                      (parse-real (concatenate 'string (aref matches 1)
-                                               (aref matches 2))))
-                     ((aref matches 3)
-                      (if (equal (aref matches 1) "-") -1 1))
-                     (t 0))
-        for sign = (if (equal (aref matches 0) "-") -1 1)
-        when (aref matches 3)
-          summing (complex 0 (* sign coef)) into num
-        else
-          summing (* sign coef) into num
-        finally
-           (if (and (not junk-allowed)
-                    (< pos end))
-               (error "Junk in string: ~s" (subseq string start end))
-               (return (values num pos)))))
+(defun matrix= (m1 m2)
+  "Return non-nil if each element of M1 and M2 are equal."
+  (and (= (array-rank m1) (array-rank m2))
+       (loop for d1 in (array-dimensions m1)
+             for d2 in (array-dimensions m2)
+             unless (= d1 d2)
+               do (return nil)
+             finally (return t))
+       (domatrix ((row col) m1 t)
+         (unless (= (aref m1 row col)
+                    (aref m2 row col))
+           (return-from matrix=)))))
+
+(defun vector= (v1 v2)
+  "Return non-nil if each element of V1 and V2 are equal."
+  (and (= (length v1) (length v2))
+       (dotimes (i (length v1) t)
+         (unless (= (aref v1 i) (aref v2 i))
+           (return-from vector=)))))