diff --git a/source/ensemble/methods.lisp b/source/ensemble/methods.lisp index ad010f5..34f1ae4 100644 --- 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 index 48dfd60..55ec92b 100644 --- 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 index fe22596..3d9df63 100644 --- 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 )))))