From b43594669e466089305948a40cfacd1b63b0767a Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 26 Apr 2005 21:45:12 +0000
Subject: [PATCH] r10469: add number-within-percentage

---
 math.lisp    | 12 ++++++++++++
 os.lisp      |  2 +-
 package.lisp |  4 +++-
 tests.lisp   | 10 +++++++++-
 4 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/math.lisp b/math.lisp
index fcbab3c..b3df9d6 100644
--- a/math.lisp
+++ b/math.lisp
@@ -96,3 +96,15 @@
 		       (double-float double-float-epsilon)
 		       (long-float long-float-epsilon))
 		     (- exponent 1.0-exponent))))))
+
+(defun sinc (x)
+  (if (zerop x)
+      1d0
+    (let ((x (coerce x 'double-float)))
+      (/ (sin x) x))))
+
+
+(defun number-within-percentage (a b percent)
+  "Determines if two numbers are equal within a percentage difference."
+  (let ((abs-diff (* 0.01 percent 0.5 (+ (abs a) (abs b)))))
+    (< (abs (- a b)) abs-diff)))
diff --git a/os.lisp b/os.lisp
index 9eece91..805b10c 100644
--- a/os.lisp
+++ b/os.lisp
@@ -167,7 +167,7 @@ returns (VALUES output-string pid)"
   #+(and lispworks (not win32)) (system::getpid)
   #+sbcl (sb-posix:getpid)
   #+cmu (unix:unix-getpid)
-  #+openmcl (ccl:getpid)
+  #+openmcl (ccl::getpid)
   #+(and clisp unix) (system::program-id)
   #+(and clisp win32) (cond ((find-package :win32)
 			     (funcall (find-symbol "GetCurrentProcessId" 
diff --git a/package.lisp b/package.lisp
index db3f1c7..f714514 100644
--- a/package.lisp
+++ b/package.lisp
@@ -146,7 +146,9 @@
    #:histogram
    #:fixnum-width
    #:scaled-epsilon
-   
+   #:sinc
+   #:number-within-percentage
+
    ;; macros.lisp
    #:time-iterations
    #:time-seconds
diff --git a/tests.lisp b/tests.lisp
index b555555..9a84a7b 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -396,7 +396,15 @@
 (deftest :unique.2
     (unique-slot-values nil 'a)
   nil)
-     
+
+(deftest :nwp.1     
+       (number-within-percentage 1. 1.1 9)
+  nil)
+
+(deftest :nwp.2
+       (number-within-percentage 1. 1.1 11)
+  t)
+  
 	   
  ;;; MOP Testing
 
-- 
2.34.1