/usr/share/common-lisp/source/kmrcl/math.lisp is in cl-kmrcl 1.106-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: math.lisp
;;;; Purpose: General purpose math functions
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Nov 2002
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(in-package #:kmrcl)
(defun deriv (f dx)
#'(lambda (x)
(/ (- (funcall f (+ x dx)) (funcall f x))
dx)))
(defun sin^ (x)
(funcall (deriv #'sin 1d-8) x))
;;; (sin^ pi)
(defmacro ensure-integer (obj)
"Ensure object is an integer. If it is a string, then parse it"
`(if (stringp ,obj)
(parse-integer ,obj)
,obj))
(defun histogram (v n-bins &key min max)
(declare (fixnum n-bins))
(when (listp v)
(setq v (coerce v 'vector)))
(when (zerop (length v))
(return-from histogram (values nil nil nil)) )
(let ((n (length v))
(bins (make-array n-bins :element-type 'integer :initial-element 0))
found-min found-max)
(declare (fixnum n))
(unless (and min max)
(setq found-min (aref v 0)
found-max (aref v 0))
(loop for i fixnum from 1 to (1- n)
do
(let ((x (aref v i)))
(cond
((> x found-max)
(setq found-max x))
((< x found-min)
(setq found-min x)))))
(unless min
(setq min found-min))
(unless max
(setq max found-max)))
(let ((width (/ (- max min) n-bins)))
(setq width (+ width (* double-float-epsilon width)))
(dotimes (i n)
(let ((bin (nth-value 0 (truncate (- (aref v i) min) width))))
(declare (fixnum bin))
(when (and (not (minusp bin))
(< bin n-bins))
(incf (aref bins bin))))))
(values bins min max)))
(defun fixnum-width ()
(nth-value 0 (truncate (+ (/ (log (1+ most-positive-fixnum)) (log 2)) .5))))
(defun scaled-epsilon (float &optional (operation '+))
"Return the smallest number that would return a value different from
FLOAT if OPERATION were applied to FLOAT and this number. OPERATION
should be either + or -, and defauls to +."
(multiple-value-bind (significand exponent)
(decode-float float)
(multiple-value-bind (1.0-significand 1.0-exponent)
(decode-float (float 1.0 float))
(if (and (eq operation '-)
(= significand 1.0-significand))
(scale-float (typecase float
(short-float short-float-negative-epsilon)
(single-float single-float-negative-epsilon)
(double-float double-float-negative-epsilon)
(long-float long-float-negative-epsilon))
(- exponent 1.0-exponent))
(scale-float (typecase float
(short-float short-float-epsilon)
(single-float single-float-epsilon)
(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 numbers-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)))
|