Data commit

Task/Deconvolution-1D/Common-Lisp/deconvolution-1d-1.lisp

@@ -0,0 +1,22 @@
+;; Assemble the mxn matrix A from the 2D row vector x.
+(defun make-conv-matrix (x m n)
+  (let ((lx (cadr (array-dimensions x)))
+        (A  (make-array `(,m ,n) :initial-element 0)))
+
+    (loop for j from 0 to (- n 1) do
+         (loop for i from 0 to (- m 1) do
+              (setf (aref A i j)
+                    (cond ((or (< i j) (>= i (+ j lx)))
+                           0)
+                          ((and (>= i j) (< i (+ j lx)))
+                           (aref x 0 (- i j)))))))
+    A))
+
+;; Solve the overdetermined system A(f)*h=g by linear least squares.
+(defun deconv (g f)
+  (let* ((lg (cadr (array-dimensions g)))
+         (lf (cadr (array-dimensions f)))
+         (lh (+ (- lg lf) 1))
+         (A  (make-conv-matrix f lg lh)))
+
+    (lsqr A (mtp g))))

Task/Deconvolution-1D/Common-Lisp/deconvolution-1d-2.lisp

@@ -0,0 +1,29 @@
+(setf f #2A((-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1)))
+(setf h #2A((-8 -9 -3 -1 -6 7)))
+(setf g #2A((24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7)))
+
+(deconv g f)
+#2A((-8.0)
+    (-9.000000000000002)
+    (-2.999999999999999)
+    (-0.9999999999999997)
+    (-6.0)
+    (7.000000000000002))
+
+(deconv g h)
+#2A((-2.999999999999999)
+    (-6.000000000000001)
+    (-1.0000000000000002)
+    (8.0)
+    (-5.999999999999999)
+    (3.0000000000000004)
+    (-1.0000000000000004)
+    (-9.000000000000002)
+    (-9.0)
+    (2.9999999999999996)
+    (-1.9999999999999991)
+    (5.0)
+    (1.9999999999999996)
+    (-2.0000000000000004)
+    (-7.000000000000001)
+    (-0.9999999999999994))