Posted 2021-12-21 21:00:32 GMT
Lisp一人 Advent Calendar 2021 22日目の記事です。
記事にまとめられるネタが切れてしまったので、十年ぶりにKMRCLを眺めてみたいと思います。
いまから十年程前には、KMRCLを眺める、というお題で毎日のようにKMRCLのコード片を眺めてブログ記事にしていましたが、実に236回もやっていたようです。
しかし、その割には未だに完読していません。
math.lisp を眺める
どこまで読み進めたかのメモを残していた筈なのですが、みつからないため、本ブログを検索して該当なしなので、未だ眺めていないと思われるmath.lispを眺めます。
deriv sin^
(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))
よくある微分ユーティリティです。
(funcall (deriv (lambda (x) (expt x 2)) 1d-8) 8)
→ 15.999998481674993D0(sin^ pi)
→ -0.999999993922529D0
ensure-integer
(defmacro ensure-integer (obj)
"Ensure object is an integer. If it is a string, then parse it"
`(if (stringp ,obj)
(parse-integer ,obj)
,obj))parse-integerを若干安全にした感じでしょうか。nilでのエラーを回避するため?
(ensure-integer "42")
→ 42
2histogram
(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)))Wikipediaのヒストグラムの例を計算してみるとこんな感じです。
(histogram '(78 126 156 231 215 304 484 544 566 545 478 258 225 373 620
625 606 483 377 370 587 667 643 756 505 436 399 611 679 575 565)
8
:min 0
:max 799)
→ #(1 2 4 5 4 7 7 1)
0
799
fixnum-width
(defun fixnum-width ()
(nth-value 0 (truncate (+ (/ (log (1+ most-positive-fixnum)) (log 2)) .5))))(integer-length most-positive-fixnum) → 60
と同じ気がするんですが、何か違ってくるのかもしれない。
(fixnum-width)
→ 60scaled-epsilon
(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))))))このユーティリティの使い方が良く分からないのですが誤差を確認するためのものでしょうか。
sinc
(defun sinc (x)
(if (zerop x)
1d0
(let ((x (coerce x 'double-float)))
(/ (sin x) x))))double-floatを返す非正規化sinc関数です。
numbers-within-percentage
(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)))或る二つの数が指定されたパーセントの誤差範囲に収まっているかを確認するものです。
(numbers-within-percentage 100 96 5)
→ t(numbers-within-percentage 100 94 5)
→ nil
まとめ
実に十年ぶりにKMRCLを眺めましたが、237回も記事にしているなら流石に完読を目指したいところです。
■
HTML generated by 3bmd in LispWorks 8.0.0