bitree は Binary Indexed Tree (BIT) を操作するためのライブラリです。BIT は累積度数の取得・更新を効率的に行うことができるデータ構造です。詳しい説明は以下に示す拙作のページをお読みください。
アーカイブファイル minlib.tar.gz をインストールする、または プログラムリスト にある以下の 4 つのファイルを、~/common-lisp/ 以下の適当なサブディレクトリ (たとえば bitree など) に配置してください。
* (asdf:test-system :bitree) ; compiling file ... 略... ----- test start ----- (BITREE-P (SETQ BT (MAKE-BITREE 16))) => T OK (BITREE-TOTAL BT) => 0 OK (DOTIMES (X 16 (BITREE-TOTAL BT)) (BITREE-ADD BT X 2)) => 32 OK (MAPCAR (LAMBDA (X) (BITREE-GET BT X)) '(0 8 15)) => (2 2 2) OK (MAPCAR (LAMBDA (X) (BITREE-SUM BT X)) '(0 8 15)) => (0 16 30) OK (MAPCAR (LAMBDA (X) (BITREE-FIND BT X)) '(0 1 16 17 30 31)) => (0 0 8 8 15 15) OK (DOLIST (X '(0 8 15) (BITREE-TOTAL BT)) (BITREE-ADD BT X 8)) => 56 OK (MAPCAR (LAMBDA (X) (BITREE-GET BT X)) '(0 4 8 12 15)) => (10 2 10 2 10) OK (MAPCAR (LAMBDA (X) (BITREE-SUM BT X)) '(0 4 8 12 15)) => (0 16 24 40 46) OK (MAPCAR (LAMBDA (X) (BITREE-FIND BT X)) '(0 9 24 33 46 55)) => (0 0 8 8 15 15) OK (PROGN (BITREE-HALF BT) (BITREE-TOTAL BT)) => 28 OK (MAPCAR (LAMBDA (X) (BITREE-GET BT X)) '(0 4 8 12 15)) => (5 1 5 1 5) OK (BITREE-CLEAR BT) => 0 OK ----- test end ----- TEST: 13 OK: 13 NG: 0 ERR: 0 T
;;;
;;; sample_bitree.lisp : bitree のサンプル
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(require :bitree)
(use-package :bitree)
;;; データの生成
(defun make-data (n)
(do ((n n (1- n))
(a nil))
((zerop n) a)
(push (random 256) a)))
;;; 出現頻度表
(defstruct (freq
(:constructor make-freq
(size
&aux
(count (make-array size :initial-element 0))
(cumul (make-array size :initial-element 0))
(total 0))))
size count cumul total)
;;; 加算
(defun freq-add (freq c inc)
(incf (freq-total freq) inc)
(incf (aref (freq-count freq) inc))
(do ((i (1+ c) (1+ i)))
((>= i (freq-size freq)))
(incf (aref (freq-cumul freq) i) inc)))
(defun test-freq (xs)
(let ((f (make-freq 256)))
(dolist (x xs (freq-total f)) (freq-add f x 1))))
(defun test-bitree (xs)
(let ((f (make-bitree 256)))
(dolist (x xs (bitree-total f)) (bitree-add f x 1))))
* (load "sample_bitree.lisp") T * (defvar xs (make-data 100000)) XS * (time (test-freq xs)) Evaluation took: 0.180 seconds of real time 0.183969 seconds of total run time (0.183969 user, 0.000000 system) 102.22% CPU 441,542,456 processor cycles 15,040 bytes consed 100000 * (time (test-bitree xs)) Evaluation took: 0.000 seconds of real time 0.009860 seconds of total run time (0.009860 user, 0.000000 system) 100.00% CPU 23,647,414 processor cycles 0 bytes consed 100000 * (progn (setq xs (make-data 200000)) nil) NIL * (time (test-freq xs)) Evaluation took: 0.409 seconds of real time 0.417609 seconds of total run time (0.417609 user, 0.000000 system) 102.20% CPU 1,002,240,810 processor cycles 16,112 bytes consed 200000 * (time (test-bitree xs)) Evaluation took: 0.020 seconds of real time 0.016569 seconds of total run time (0.016569 user, 0.000000 system) 85.00% CPU 39,748,660 processor cycles 15,856 bytes consed 200000 実行環境: SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
;;;
;;; bitree.lisp : binary indexed tree
;;;
;;; Copyright (c) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :bitree)
(defpackage :bitree (:use :cl))
(in-package :bitree)
(export '(bitree
bitree-p
make-bitree
bitree-initialize
bitree-get
bitree-sum
bitree-add
bitree-total
bitree-find
bitree-half
bitree-clear))
;;; 中央値 (ルート) を求める
(defun get-mid (size)
(do ((mid 1 (ash mid 1))
(limit (ash size -1)))
((<= limit mid) mid)))
;;; 構造体の定義
(defstruct (bitree
(:constructor make-bitree
(size
&aux
(table (make-array size :initial-element 0))
(mid (get-mid size))
(total 0))))
size table mid total)
;;; 初期化
(defun bitree-initialize (code-size)
(let ((bt (make-bitree code-size)))
(dotimes (x code-size bt) (bitree-add bt x 1))))
;;; c の値 (出現頻度) を求める
(defun bitree-get (bt c)
(let ((n (aref (bitree-table bt) c)))
(if (or (zerop c) (oddp c))
n
(do ((p (logand c (1- c)))
(x (1- c) (logand x (1- x))))
((= x p) n)
(decf n (aref (bitree-table bt) x))))))
;;; 0 - c-1 までの累積度数を求める
(defun bitree-sum (bt c)
(if (zerop c)
0
(let ((n (aref (bitree-table bt) 0)))
;; c - 1 までの頻度を加算する
(do ((x (1- c) (logand x (1- x))))
((zerop x) n)
(incf n (aref (bitree-table bt) x))))))
;;; c の値に inc を加算する
(defun bitree-add (bt c inc)
(if (zerop c)
(incf (aref (bitree-table bt) c) inc)
(do ()
((<= (bitree-size bt) c))
(incf (aref (bitree-table bt) c) inc)
(incf c (logand c (- c)))))
(incf (bitree-total bt) inc))
;;; 探索 (cumul[c] <= val < cumul[c + 1])
(defun bitree-find (bt val)
(let ((n (aref (bitree-table bt) 0)))
(if (< val n)
(values 0 0)
(do ((h (bitree-mid bt) (ash h -1))
(c 0))
((zerop h) (values (1+ c) n))
(when (and (< (+ c h) (bitree-size bt))
(<= (+ n (aref (bitree-table bt) (+ c h))) val))
(incf n (aref (bitree-table bt) (+ c h)))
(incf c h))))))
;;; 各要素を半分にする (0 にはしない)
(defun bitree-half (bt)
(dotimes (x (bitree-size bt))
(let ((n (ash (bitree-get bt x) -1)))
(when (plusp n)
(bitree-add bt x (- n))))))
;;; 各要素を 0 にクリアする
(defun bitree-clear (bt)
(fill (bitree-table bt) 0)
(setf (bitree-total bt) 0))
リスト : bitree.asd (defsystem :bitree :description "binary indexed tree" :version "0.1.0" :author "Makoto Hiroi" :license "MIT" :depends-on () :in-order-to ((test-op (test-op :bitree_tst))) :components ((:file "bitree")))
;;;
;;; bitree_tst.lisp : bitree のテスト
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :bitree_tst)
(defpackage :bitree_tst (:use :cl :mintst :bitree))
(in-package :bitree_tst)
(export '(test))
(defvar bt nil)
(defun test ()
(initial)
(run (bitree-p (setq bt (make-bitree 16))) t)
(run (bitree-total bt) 0)
(run (dotimes (x 16 (bitree-total bt)) (bitree-add bt x 2)) 32)
(run (mapcar (lambda (x) (bitree-get bt x)) '(0 8 15))
'(2 2 2))
(run (mapcar (lambda (x) (bitree-sum bt x)) '(0 8 15))
'(0 16 30))
(run (mapcar (lambda (x) (bitree-find bt x)) '(0 1 16 17 30 31))
'(0 0 8 8 15 15))
(run (dolist (x '(0 8 15) (bitree-total bt)) (bitree-add bt x 8)) 56)
(run (mapcar (lambda (x) (bitree-get bt x)) '(0 4 8 12 15))
'(10 2 10 2 10))
(run (mapcar (lambda (x) (bitree-sum bt x)) '(0 4 8 12 15))
'(0 16 24 40 46))
(run (mapcar (lambda (x) (bitree-find bt x)) '(0 9 24 33 46 55))
'(0 0 8 8 15 15))
(run (progn (bitree-half bt) (bitree-total bt)) 28)
(run (mapcar (lambda (x) (bitree-get bt x)) '(0 4 8 12 15))
'(5 1 5 1 5))
(run (bitree-clear bt) 0)
(final))
リスト : bitree_tst.asd (defsystem :bitree_tst :description "test for bitree" :version "0.1.0" :author "Makoto Hiroi" :license "MIT" :depends-on (:mintst :bitree) :components ((:file "bitree_tst")) :perform (test-op (o s) (symbol-call :bitree_tst :test)))