From acccf0e972d6809366a7ebd9ccca643302edbf93 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 9 Oct 2010 20:40:03 +0300 Subject: [PATCH] 3 minutes of work on new-roots.lisp Split SOLVE-QUADRIC into two parts -- inline the optional argument parsing and keep the body out-of-line. --- new-roots.lisp | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/new-roots.lisp b/new-roots.lisp index 3fddfd9..8227ee4 100644 --- a/new-roots.lisp +++ b/new-roots.lisp @@ -37,10 +37,7 @@ (declare (fixnum n)) (make-array n :element-type 'double-float)) -(defun solve-quadric (quadric &optional (roots (make-roots 2)) - &key (offset 0)) - "Solve QUADRIC, returning number of real roots and storing their values in ROOTS, -starting at OFFSET." +(defun %solve-quadric (quadric roots offset) (declare (type (simple-array double-float (*)) quadric roots)) ;; normal form: x^2 + px + q = 0 (let* ((K (aref quadric 2)) @@ -58,6 +55,12 @@ starting at OFFSET." (aref roots (+ offset 1)) (- (- sqrt-D) p)) (values 2 roots)))))) +(declaim (inline solve-quadric)) +(defun solve-quadric (quadric &optional (roots (make-roots 2))) + "Solve QUADRIC, returning number of real roots and storing their values in ROOTS, +starting at OFFSET." + (%solve-quadric quadric roots 0)) + (defun solve-cubic (cubic &optional (roots (make-roots 3))) "Solve CUBIC, returning number of real roots and storing their values in ROOTS." (declare (type (simple-array double-float (*)) cubic roots)) @@ -164,11 +167,11 @@ starting at OFFSET." (setf (aref coeffs 0) (- z u) (aref coeffs 1) (if (< q 0) (- v) v) (aref coeffs 2) 1.0d0) - (setf n-roots (solve-quadric coeffs roots)) + (setf n-roots (%solve-quadric coeffs roots 0)) (setf (aref coeffs 0) (+ z u) (aref coeffs 1) (if (< q 0) v (- v)) (aref coeffs 2) 1.0d0) - (incf n-roots (solve-quadric coeffs roots :offset n-roots)))))) + (incf n-roots (%solve-quadric coeffs roots n-roots)))))) ;; resubstitute (let ((sub (* 1/4 A))) (dotimes (i n-roots)