Improved squared-error performance.

sirherrbatka · Nov 23, 2021 · 7751080 · 7751080
1 parent fd42507
commit 7751080
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 25 deletions.
diff --git a/source/ensemble/methods.lisp b/source/ensemble/methods.lisp
@@ -465,7 +465,9 @@
                                            nil
                                            t))
          (unfolded (cl-ds.utils:unfold-table result)))
-    (map-into unfolded (cl-ds:iota-range))
+    (iterate
+      (for i from 0 below (length unfolded))
+      (setf (aref unfolded i) i))
     (funcall (if parallel #'lparallel:pmap-into #'map-into)
              unfolded
              (lambda (index)

diff --git a/source/optimization/methods.lisp b/source/optimization/methods.lisp
@@ -46,21 +46,29 @@
          (right-count 0))
     (declare (type (simple-array double-float (*)) left-sum right-sum)
              (type fixnum left-count right-count))
-    (cl-ds.utils:cases ((null split-array))
+    (cl-ds.utils:cases ((null split-array)
+                        (null weights))
       (iterate
         (declare (type fixnum i j))
-        (for j from 0 below (length data-points))
+        (with length = (length data-points))
+        (for j from 0 below length)
         (for i = (aref data-points j))
         (for rightp = (and split-array (eql right (aref split-array j))))
-        (if rightp (incf right-count) (incf left-count))
-        (iterate
-          (declare (type fixnum ii)
-                   (type double-float value))
-          (for ii from 0 below target-data-width)
-          (for value = (sl.data:mref target-data i ii))
-          (if rightp
-              (incf (aref right-sum ii) value)
-              (incf (aref left-sum ii) value))))
+        (if rightp
+            (progn (incf right-count)
+                   (iterate
+                     (declare (type fixnum ii)
+                              (type double-float value))
+                     (for ii from 0 below target-data-width)
+                     (for value = (sl.data:mref target-data i ii))
+                     (incf (aref right-sum ii) value)))
+            (progn (incf left-count)
+                   (iterate
+                     (declare (type fixnum ii)
+                              (type double-float value))
+                     (for ii from 0 below target-data-width)
+                     (for value = (sl.data:mref target-data i ii))
+                     (incf (aref left-sum ii) value)))))
       (iterate
         (declare (type double-float
                        left-error right-error)

diff --git a/source/optimization/utils.lisp b/source/optimization/utils.lisp
@@ -51,16 +51,19 @@
 (declaim (inline data-point-squared-error))
 (defun data-point-squared-error (avg-vector target-data weights i)
   (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
-  (iterate
-    (declare (type fixnum ii)
-             (type double-float error avg value result))
-    (with weight = (if (null weights)
-                       1.0d0
-                       (weight-at weights i)))
-    (with result = 0.0d0)
-    (for ii from 0 below (array-dimension target-data 1))
-    (for value = (sl.data:mref target-data i ii))
-    (for avg = (aref avg-vector ii))
-    (for error = (* weight (square (- value avg))))
-    (incf result error)
-    (finally (return result))))
+  (macrolet ((op (result ii)
+               `(let* ((value (sl.data:mref target-data i ,ii))
+                       (avg (aref avg-vector ,ii))
+                       (error (* weight (square (- value avg)))))
+                  (incf ,result error))))
+    (iterate
+      (declare (type fixnum ii1)
+               (type double-float result1))
+      (with weight = (if (null weights)
+                         1.0d0
+                         (weight-at weights i)))
+      (with result1 = 0.0d0)
+      (with size = (array-dimension target-data 1))
+      (for ii1 from 0 below size by 1)
+      (op result1 ii1)
+      (finally (return result1 )))))