From 6dff5af08a53bfe7b093959a0ec13c2342b38a9d Mon Sep 17 00:00:00 2001 From: liam <liam@a3d8a0fb-c1db-0310-ace7-a616afeb9e30> Date: Sun, 28 Jan 2007 23:49:22 +0000 Subject: [PATCH] make-histogram now includes alloc; some examples of histogram. Put polynomial-solve-ws after polynomial-solve. git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3177 a3d8a0fb-c1db-0310-ace7-a616afeb9e30 --- histogram/histogram.lisp | 12 +++++++++--- histogram/updating-accessing.lisp | 29 ++++++++++++++++++++++++++++- polynomial.lisp | 30 ++++++++++++++++-------------- 3 files changed, 53 insertions(+), 18 deletions(-) diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index e3266b9a..4b3fb350 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 5688f505..a6f72e80 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 568c0673..e8d298de 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 ;;;;**************************************************************************** -- GitLab