diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index e3266b9a04c8af975afc770ace632723c9786cfd..4b3fb3500e00df8c2e3b91c547a9981b124a0dfb 100644 --- a/histogram/histogram.lisp +++ b/histogram/histogram.lisp @@ -3,7 +3,7 @@ ; description: The histogram structure. ; date: Mon Jan 1 2007 - 11:32 ; author: Liam M. Healy -; modified: Mon Jan 1 2007 - 20:44 +; modified: Tue Jan 2 2007 - 23:03 ;******************************************************** ;;; $Id: $ @@ -192,5 +192,11 @@ (defun make-histogram (size &optional from) "Make a histogram, optionally filling it with data from an existing histogram." - (make-instance 'histogram :number-of-bins size - :pointer (when from (clone from)))) + (let ((ret + (make-instance 'histogram :number-of-bins size + :pointer (when from (clone from))))) + (unless (pointer ret) + (alloc ret)) + ret)) + + diff --git a/histogram/updating-accessing.lisp b/histogram/updating-accessing.lisp index 5688f5053834727045d81bf4b0f2fe2e6005d458..a6f72e806f53b100ffc7bc5c1d39fb712ee7e497 100644 --- a/histogram/updating-accessing.lisp +++ b/histogram/updating-accessing.lisp @@ -4,7 +4,7 @@ ; elements. ; date: Mon Jan 1 2007 - 14:43 ; author: Liam M. Healy -; modified: Mon Jan 1 2007 - 20:50 +; modified: Tue Jan 2 2007 - 21:52 ;******************************************************** ;;; $Id: $ @@ -119,3 +119,30 @@ (histo-1d2d histogram histogram-find ((first values)) ((first values) (second values)))) + +;;; Examples and unit test +(defparameter *sample-histogram* + (let ((histo (make-histogram 10))) + (set-ranges-uniform histo 0.0d0 10.0d0) + histo)) + +#| + +(lisp-unit:define-test histogram + (lisp-unit:assert-equal + )) + + +(reset *sample-histogram*) +(increment *sample-histogram* 2.7d0) +(increment *sample-histogram* 6.9d0 2.0d0) +(increment *sample-histogram* -2.0d0) +(gsl-aref *sample-histogram* 1) +(gsl-aref *sample-histogram* 2) +(gsl-aref *sample-histogram* 6) +(gsl-aref *sample-histogram* 16) ; error +(gsl-min-range *sample-histogram*) +(gsl-max-range *sample-histogram*) +(bins *sample-histogram*) +(histogram-find *sample-histogram* 5.5d0) +|# diff --git a/polynomial.lisp b/polynomial.lisp index 568c067349a6abb509b8c5738b2e2ee0d65edec5..e8d298ded3d51afb5c33c1e791042378113d1bc0 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -3,7 +3,7 @@ ; description: Polynomials ; date: Tue Mar 21 2006 - 18:33 ; author: Liam M. Healy -; modified: Fri Jul 7 2006 - 23:11 +; modified: Tue Jan 2 2007 - 09:27 ;******************************************************** ;;; $Id: $ @@ -150,19 +150,6 @@ (progn ,@body) (complex-workspace-free ,workspace)))) -(defun-gsl polynomial-solve-ws (coefficients workspace answer-pd) - "gsl_poly_complex_solve" - (((gsl-array coefficients) :pointer) ((dim0 coefficients) :size) - (workspace :pointer) ((gsl-array answer-pd) :pointer)) - :return - ((loop for i from 0 below (dim0 answer-pd) by 2 - collect (complex (gsl-aref answer-pd i) - (gsl-aref answer-pd (1+ i))))) - :documentation - "Arguments are: - a GSL array of coefficients, a workspace, a gsl-array of doubles." - :export nil - :index polynomial-solve) (defun polynomial-solve (coefficients) "The roots of the general polynomial @@ -180,6 +167,21 @@ (with-poly-complex-workspace (ws len) (values-list (polynomial-solve-ws coef ws answer))))))) +(defun-gsl polynomial-solve-ws (coefficients workspace answer-pd) + "gsl_poly_complex_solve" + (((gsl-array coefficients) :pointer) ((dim0 coefficients) :size) + (workspace :pointer) ((gsl-array answer-pd) :pointer)) + :return + ((loop for i from 0 below (dim0 answer-pd) by 2 + collect (complex (gsl-aref answer-pd i) + (gsl-aref answer-pd (1+ i))))) + :documentation + "Arguments are: + a GSL array of coefficients, a workspace, a gsl-array of doubles." + :export nil + :index polynomial-solve) + + ;;;;**************************************************************************** ;;;; Examples and unit test ;;;;****************************************************************************