1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: General purpose math functions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Nov 2002
10 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
12 ;;;; KMRCL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
22 (/ (- (funcall f (+ x dx)) (funcall f x))
26 (funcall (deriv #'sin 1d-8) x))
30 (defmacro ensure-integer (obj)
31 "Ensure object is an integer. If it is a string, then parse it"
36 (defun histogram (v n-bins &key min max)
37 (declare (fixnum n-bins))
39 (setq v (coerce v 'vector)))
40 (when (zerop (length v))
41 (return-from histogram (values nil nil nil)) )
43 (bins (make-array n-bins :element-type 'integer :initial-element 0))
47 (setq found-min (aref v 0)
49 (loop for i fixnum from 1 to (1- n)
56 (setq found-min x)))))
60 (setq max found-max)))
61 (let ((width (/ (- max min) n-bins)))
62 (setq width (+ width (* double-float-epsilon width)))
64 (let ((bin (nth-value 0 (truncate (- (aref v i) min) width))))
65 (declare (fixnum bin))
66 (when (and (not (minusp bin))
68 (incf (aref bins bin))))))
69 (values bins min max)))
72 (defun fixnum-width ()
73 (nth-value 0 (truncate (+ (/ (log (1+ most-positive-fixnum)) (log 2)) .5))))
75 (defun scaled-epsilon (float &optional (operation '+))
76 "Return the smallest number that would return a value different from
77 FLOAT if OPERATION were applied to FLOAT and this number. OPERATION
78 should be either + or -, and defauls to +."
79 (multiple-value-bind (significand exponent)
81 (multiple-value-bind (1.0-significand 1.0-exponent)
82 (decode-float (float 1.0 float))
83 (if (and (eq operation '-)
84 (= significand 1.0-significand))
85 (scale-float (typecase float
86 (short-float short-float-negative-epsilon)
87 (single-float single-float-negative-epsilon)
88 (double-float double-float-negative-epsilon)
89 (long-float long-float-negative-epsilon))
90 (- exponent 1.0-exponent))
91 (scale-float (typecase float
92 (short-float short-float-epsilon)
93 (single-float single-float-epsilon)
94 (double-float double-float-epsilon)
95 (long-float long-float-epsilon))
96 (- exponent 1.0-exponent))))))
101 (let ((x (coerce x 'double-float)))
105 (defun numbers-within-percentage (a b percent)
106 "Determines if two numbers are equal within a percentage difference."
107 (let ((abs-diff (* 0.01 percent 0.5 (+ (abs a) (abs b)))))
108 (< (abs (- a b)) abs-diff)))