お気楽 Common Lisp プログラミング入門

utils

ちょっと便利なリストとベクタの操作関数を集めたライブラリです。

●インストール

アーカイブファイル minlib.tar.gz をインストールする、またはプログラムリストにある以下の 4 つのファイルを、~/common-lisp/ 以下の適当なサブディレクトリ (たとえば utils など) に配置してください。

utils.lisp
utils_tst.lisp
utils.asd
utils_tst.asd

●仕様

パッケージ名 :utils
xcons d a => (a . d)
cons の引数を逆にした関数
iota n &key (start 0) (step 1) => list
start から step 刻みで n 個の数を格納したリストを生成する
tabulate fn n &key (start 0) (step 1) => list
(mapcar fn (iota n :start start :step step)) と同じ動作
unfold p f g seed => list
解きほぐし (逆畳み込み)
- p : seed に関数 p を適用し、真を返したら解きほぐしを終了する
- f : seed に関数 f を適用した結果をリストに格納する
- g : seed に関数 g を適用して次の seed を生成する
- seed : 列の元になる値
take xs n => list
リスト xs の先頭から n 個の要素を取り出す
drop xs n => list
リスト xs の先頭から n 個の要素を取り除く
take-while pred xs => list
リスト xs の先頭から述語 pred を満たす要素を取り出す
drop-while pred xs => list
リスト xs の先頭から述語 pred を満たす要素を取り除く
split-at xs n => list, list
リスト xs を n 番目で分割する (多値を返す)
split-if pred xs => list, list
(values (take-while pred xs) (drop-while pred xs)) と同じ動作
split-if-not pred xs => list, list
split-if で pred の真偽を反転した動作
partition pred xs => list, list
リスト xs を述語 pred が真を返す要素と偽を返す要素で分割する (多値を返す)
insert xs x pred => list
述語 pred の順序で並んでいるリスト xs に x を挿入する
insert-at xs n x => list
リスト xs の n 番目に x を挿入する
remove-at xs n => list
リスト xs の n 番目の要素を削除する
selects xs => list
リスト xs から要素を一つ選択する。CAR に選んだ要素、CDR に残りの要素を格納し、それをリストに格納して返す
power-set xs => list
リスト xs のべき集合を求める
fold-left fn init xs [ys ...] => value
リストの先頭から畳み込むを行う。fn の引数には累積値, リストの要素, ... が渡される
fold-right fn init xs [ys ...] => value
リストの末尾から畳み込むを行う。fn の引数には累積値, リストの要素, ... が渡される
scan-left fn init xs [ys ...] => value
リストを先頭から畳み込むとき、計算途中の累積値をリストに格納して返す。fn の引数には累積値, リストの要素, ... が渡される
scan-right fn init xs [ys ...] => value
リストを末尾から畳み込むとき、計算途中の累積値をリストに格納して返す。fn の引数には累積値, リストの要素, ... が渡される

ベクタ操作関数
vector-iota n &key (start 0) (step 1) => list
start から step 刻みで n 個の数を格納したベクタを生成する
vector-tabulate fn n &key (start 0) (step 1) => list
(map 'vector fn (vector-iota n :start start :step step)) と同じ動作
vector-unfold n f g seed => list
解きほぐし (逆畳み込み)
- n : 生成するベクタの大きさ
- f : seed に関数 f を適用した結果をベクタに格納する
- g : seed に関数 g を適用して次の seed を生成する
- seed : 列の元になる値
vector-fold-left fn init xs [ys ...] => value
ベクタの先頭から畳み込むを行う。fn の引数には累積値, ベクタの要素, ... が渡される
vector-fold-right fn init xs [ys ...] => value
ベクタの末尾から畳み込むを行う。fn の引数には累積値, ベクタの要素, ... が渡される
vector-map-with-index fn xs [ys ...] => vector
添字付きマップ関数。fn の評価結果を格納した新しいベクタを返す。fn の引数には添字, ベクタの要素, ... が渡される。
vector-mapc-with-index fn xs [ys ...] => nil
添字付きマップ関数。fn の評価結果は捨てられる。fn の引数には添字, ベクタの要素, ... が渡される。
vector-swap vec i j => vector
引数 vec の i, j 番目の要素を交換する。引数 vec は破壊的に修正される。
vector-partition pred vec &key start end => index, vector
引数のベクタ vec を述語 pred を基準に二分割する。引数 vec は破壊的に修正される。
pred が真を返す要素を前半 [start - index-1] に、偽を返す要素が後半 [index - end-1] に集められる。
vector-bsearch x vec &key start end elt= elt< => index or nil
ベクタ vec から x を二分探索する。vec は elt< を基準にソートされていること。
elt= のデフォルトは #'eql, elt< のデフォルトは #'<
vector-shuffle vec => vector
引数 vec を乱数でシャッフルする。引数 vec は破壊的に修正される。
アルゴリズムはフィッシャー–イェーツのシャッフル (Fisher–Yates shuffle) を使用

●簡単なテスト

* (asdf:test-system :utils)
; compiling file ... 略 ...

----- test start -----

(XCONS 1 2)
=> (2 . 1) OK

(IOTA 3)
=> (0 1 2) OK

(IOTA 4 START 1)
=> (1 2 3 4) OK

(IOTA 5 START 2 STEP 2)
=> (2 4 6 8 10) OK

(TABULATE #'IDENTITY 3)
=> (0 1 2) OK

(TABULATE #'IDENTITY 4 START 1)
=> (1 2 3 4) OK

(TABULATE #'SQUARE 5 STEP 2)
=> (0 4 16 36 64) OK

(UNFOLD (LAMBDA (X) (>= X 4)) #'IDENTITY #'1+ 0)
=> (0 1 2 3) OK

(UNFOLD (LAMBDA (X) (>= X 5)) #'SQUARE #'1+ 1)
=> (1 4 9 16) OK

(TAKE '(1 2 3 4 5 6) 0)
=> NIL OK

(TAKE '(1 2 3 4 5 6) 3)
=> (1 2 3) OK

(TAKE '(1 2 3 4 5 6) 6)
=> (1 2 3 4 5 6) OK

(DROP '(1 2 3 4 5 6) 0)
=> (1 2 3 4 5 6) OK

(DROP '(1 2 3 4 5 6) 3)
=> (4 5 6) OK

(DROP '(1 2 3 4 5 6) 6)
=> NIL OK

(TAKE-WHILE #'EVENP '(1 3 5 7 9))
=> NIL OK

(TAKE-WHILE #'ODDP '(1 3 5 7 9))
=> (1 3 5 7 9) OK

(TAKE-WHILE #'EVENP '(2 4 6 8 1 3 5 7))
=> (2 4 6 8) OK

(DROP-WHILE #'EVENP '(1 3 5 7 9))
=> (1 3 5 7 9) OK

(DROP-WHILE #'ODDP '(1 3 5 7 9))
=> NIL OK

(DROP-WHILE #'EVENP '(2 4 6 8 1 3 5 7))
=> (1 3 5 7) OK

(MULTIPLE-VALUE-LIST (SPLIT-AT '(1 2 3 4 5 6) 0))
=> (NIL (1 2 3 4 5 6)) OK

(MULTIPLE-VALUE-LIST (SPLIT-AT '(1 2 3 4 5 6) 3))
=> ((1 2 3) (4 5 6)) OK

(MULTIPLE-VALUE-LIST (SPLIT-AT '(1 2 3 4 5 6) 6))
=> ((1 2 3 4 5 6) NIL) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF #'EVENP '(2 4 6 8 1 3 5 7)))
=> ((2 4 6 8) (1 3 5 7)) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF #'ODDP '(2 4 6 8 1 3 5 7)))
=> (NIL (2 4 6 8 1 3 5 7)) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF #'ODDP '(1 3 5 7 9)))
=> ((1 3 5 7 9) NIL) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF-NOT #'ODDP '(2 4 6 8 1 3 5 7)))
=> ((2 4 6 8) (1 3 5 7)) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF-NOT #'EVENP '(2 4 6 8 1 3 5 7)))
=> (NIL (2 4 6 8 1 3 5 7)) OK

(MULTIPLE-VALUE-LIST (SPLIT-IF-NOT #'EVENP '(1 3 5 7 9)))
=> ((1 3 5 7 9) NIL) OK

(MULTIPLE-VALUE-LIST (PARTITION #'EVENP '(0 1 2 3 4 5 6 7)))
=> ((0 2 4 6) (1 3 5 7)) OK

(MULTIPLE-VALUE-LIST (PARTITION #'EVENP '(0 2 4 6 8)))
=> ((0 2 4 6 8) NIL) OK

(MULTIPLE-VALUE-LIST (PARTITION #'ODDP '(0 2 4 6 8)))
=> (NIL (0 2 4 6 8)) OK

(INSERT '(1 3 5 7) 0 #'<)
=> (0 1 3 5 7) OK

(INSERT '(1 3 5 7) 4 #'<)
=> (1 3 4 5 7) OK

(INSERT '(1 3 5 7) 8 #'<)
=> (1 3 5 7 8) OK

(INSERT-AT '(1 3 5 7) 0 9)
=> (9 1 3 5 7) OK

(INSERT-AT '(1 3 5 7) 2 9)
=> (1 3 9 5 7) OK

(INSERT-AT '(1 3 5 7) 4 9)
=> (1 3 5 7 9) OK

(REMOVE-AT '(1 3 5 7 9) 0)
=> (3 5 7 9) OK

(REMOVE-AT '(1 3 5 7 9) 2)
=> (1 3 7 9) OK

(REMOVE-AT '(1 3 5 7 9) 4)
=> (1 3 5 7) OK

(SELECTS '(A))
=> ((A)) OK

(SELECTS '(A B))
=> ((A B) (B A)) OK

(SELECTS '(A B C))
=> ((A B C) (B A C) (C A B)) OK

(POWER-SET '(A B C D))
=> (NIL (D) (C) (C D) (B) (B D) (B C) (B C D) (A) (A D) (A C) (A C D) (A B)
    (A B D) (A B C) (A B C D)) OK

(FOLD-LEFT #'+ 0 '(1 2 3 4 5))
=> 15 OK

(FOLD-LEFT #'XCONS NIL '(A B C))
=> (C B A) OK

(FOLD-LEFT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL '(A B C) '(1 2 3))
=> ((C . 3) (B . 2) (A . 1)) OK

(FOLD-RIGHT #'+ 0 '(1 2 3 4 5))
=> 15 OK

(FOLD-RIGHT (LAMBDA (A X) (CONS X A)) NIL '(A B C))
=> (A B C) OK

(FOLD-RIGHT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL '(A B C) '(1 2 3))
=> ((A . 1) (B . 2) (C . 3)) OK

(SCAN-LEFT #'+ 0 (IOTA 10 START 1))
=> (0 1 3 6 10 15 21 28 36 45 55) OK

(SCAN-LEFT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL '(A B C) '(1 2 3))
=> (NIL ((A . 1)) ((B . 2) (A . 1)) ((C . 3) (B . 2) (A . 1))) OK

(SCAN-RIGHT #'+ 0 (IOTA 10 START 1))
=> (55 54 52 49 45 40 34 27 19 10 0) OK

(SCAN-RIGHT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL '(A B C) '(1 2 3))
=> (((A . 1) (B . 2) (C . 3)) ((B . 2) (C . 3)) ((C . 3)) NIL) OK

(VECTOR-IOTA 3)
=> #(0 1 2) OK

(VECTOR-IOTA 4 START 1)
=> #(1 2 3 4) OK

(VECTOR-IOTA 5 START 2 STEP 2)
=> #(2 4 6 8 10) OK

(VECTOR-TABULATE #'IDENTITY 3)
=> #(0 1 2) OK

(VECTOR-TABULATE #'IDENTITY 4 START 1)
=> #(1 2 3 4) OK

(VECTOR-TABULATE #'SQUARE 5 STEP 2)
=> #(0 4 16 36 64) OK

(VECTOR-UNFOLD 4 #'IDENTITY #'1+ 0)
=> #(0 1 2 3) OK

(VECTOR-UNFOLD 5 #'SQUARE #'1+ 1)
=> #(1 4 9 16 25) OK

(VECTOR-FOLD-LEFT #'+ 0 #(1 2 3 4 5))
=> 15 OK

(VECTOR-FOLD-LEFT #'XCONS NIL #(A B C))
=> (C B A) OK

(VECTOR-FOLD-LEFT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL #(A B C) #(1 2 3))
=> ((C . 3) (B . 2) (A . 1)) OK

(VECTOR-FOLD-RIGHT #'+ 0 #(1 2 3 4 5))
=> 15 OK

(VECTOR-FOLD-RIGHT (LAMBDA (A X) (CONS X A)) NIL #(A B C))
=> (A B C) OK

(VECTOR-FOLD-RIGHT (LAMBDA (A X Y) (CONS (CONS X Y) A)) NIL #(A B C) #(1 2 3))
=> ((A . 1) (B . 2) (C . 3)) OK

(VECTOR-MAP-WITH-INDEX (LAMBDA (I X) (LIST I X)) #(A B C))
=> #((0 A) (1 B) (2 C)) OK

(VECTOR-MAP-WITH-INDEX (LAMBDA (I X Y) (LIST I X Y)) #(A B C D) #(10 20 30))
=> #((0 A 10) (1 B 20) (2 C 30)) OK

(LET ((A NIL))
  (VECTOR-MAPC-WITH-INDEX (LAMBDA (I X) (PUSH (LIST I X) A)) #(A B C))
  (REVERSE A))
=> ((0 A) (1 B) (2 C)) OK

(LET ((A NIL))
  (VECTOR-MAPC-WITH-INDEX (LAMBDA (I X Y) (PUSH (LIST I X Y) A)) #(A B C D)
                          #(10 20 30))
  (REVERSE A))
=> ((0 A 10) (1 B 20) (2 C 30)) OK

(VECTOR-SWAP #(1 2 3 4 5) 0 4)
=> #(5 2 3 4 1) OK

(VECTOR-SWAP #(1 2 3 4 5) 1 3)
=> #(1 4 3 2 5) OK

(VECTOR-SWAP #(1 2 3 4 5) 2 2)
=> #(1 2 3 4 5) OK

(MULTIPLE-VALUE-LIST (VECTOR-PARTITION #'EVENP #(1 2 3 4 5 6)))
=> (3 #(6 2 4 3 5 1)) OK

(MULTIPLE-VALUE-LIST (VECTOR-PARTITION #'EVENP #(0 2 4 6 8 10)))
=> (6 #(0 2 4 6 8 10)) OK

(MULTIPLE-VALUE-LIST (VECTOR-PARTITION #'EVENP #(1 3 5 7 9 11)))
=> (0 #(1 3 5 7 9 11)) OK

(VECTOR-BSEARCH 5 #(1 2 3 4 5 6 7 8 9))
=> 4 OK

(VECTOR-BSEARCH 1 #(1 2 3 4 5 6 7 8 9))
=> 0 OK

(VECTOR-BSEARCH 9 #(1 2 3 4 5 6 7 8 9))
=> 8 OK

(VECTOR-BSEARCH 1 #(1 2 3 4 5 6 7 8 9) START 1)
=> NIL OK

(VECTOR-BSEARCH 9 #(1 2 3 4 5 6 7 8 9) END 8)
=> NIL OK

(VECTOR-BSEARCH 5.5 #(1 2 3 4 5 6 7 8 9))
=> NIL OK

(DOTIMES (X 12)
  (WHEN (EQUALP (VECTOR-SHUFFLE (VECTOR 1 2 3)) #(3 2 1)) (RETURN T)))
=> T OK

(DOTIMES (X 12)
  (WHEN (EQUALP (VECTOR-SHUFFLE (VECTOR 1 2 3)) #(1 2 3)) (RETURN T)))
=> T OK

----- test end -----
TEST: 88
OK: 88
NG: 0
ERR: 0
T

●サンプルプログラム

;;;
;;; sample_utils.lisp : utils のサンプルプログラム
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(require :utils)
(use-package :utils)

;;; n 以下のフィボナッチ数を求める
(defun fibonacci (n)
  (unfold (lambda (xs) (> (first xs) n))
          #'car
          (lambda (xs) (list (second xs) (apply #'+ xs)))
          '(0 1)))

;;; 三角数
(defun triangular (n)
  (scan-left #'+ 1 (iota (1- n) :start 2)))

;;; 四角数
(defun square (n)
  (tabulate (lambda (x) (* x x)) n :start 1))

;;; 五角数
(defun pentagonal (n)
  (scan-left #'+ 1 (iota (1- n) :start 4 :step 3)))

;;; n 以下の素数を求める (エラトステネスの篩)
(defun sieve (n)
  (do ((xs (iota (round (- n 2) 2) :start 3 :step 2))
       (ps (list 2)))
      ((< n (* (car xs) (car xs)))
       (nreconc ps xs))
      (push (car xs) ps)
      (setf xs (remove-if (lambda (x) (zerop (mod x (car xs))))
                          (cdr xs)))))

;;; 要素が n 個のリストに分割する
(defun group (xs n)
  (if (null xs)
      nil
    (cons (take xs n) (group (drop xs n) n))))

;;; 順列の生成
(defun permutation (fn xs &optional (a nil))
  (if (null xs)
      (funcall fn (reverse a))
    (dolist (ys (selects xs))
      (permutation fn (cdr ys) (cons (car ys) a)))))

;;; 接頭辞を求める
(defun inits (xs)
  (scan-left (lambda (a x) (append a (list x))) nil xs))

;;; 接尾辞を求める
(defun tails (xs)
  (scan-right (lambda (a x) (cons x a)) nil xs))

;;; ソート
(defun insert-sort (xs pred)
  (if (null (cdr xs))
      xs
    (insert (insert-sort (cdr xs) pred) (car xs) pred)))

(defun quick-sort (xs pred)
  (if (null (cdr xs))
      xs
    (multiple-value-bind
     (ys zs)
     (partition (lambda (x) (funcall pred x (car xs))) (cdr xs))
     (append (quick-sort ys pred)
             (cons (car xs)
                   (quick-sort zs pred))))))

;;; 連続している同じ記号をリストに格納する
(defun pack (xs)
  (if (null xs)
      nil
    (multiple-value-bind
     (ys zs)
     (split-if (lambda (x) (eql (car xs) x)) xs)
     (cons ys (pack zs)))))

;;; ランレングス符号
(defun rle (xs)
  (mapcar (lambda (ys) (cons (car ys) (length ys)))
          (pack xs)))

(defun rld (code)
  (mapcan (lambda (xs) (make-list (cdr xs) :initial-element (car xs)))
          code))

三角数、四角数、五角数の説明は拙作のページ Puzzle DE Programmng: 多角数をお読みください。

* (load "sample_utils.lisp")
T

* (fibonacci 10000)
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)

* (triangular 20)
(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210)

* (square 20)
(1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400)

* (pentagonal 20)
(1 5 12 22 35 51 70 92 117 145 176 210 247 287 330 376 425 477 532 590)

* (sieve 500)
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103
 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199
 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313
 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433
 439 443 449 457 461 463 467 479 487 491 499)

* (group '(a b c d e f) 3)
((A B C) (D E F))

* (group '(a b c d e f) 2)
((A B) (C D) (E F))

* (group '(a b c d e f) 1)
((A) (B) (C) (D) (E) (F))

* (group '(a b c d e f) 4)
((A B C D) (E F))

* (permutation #'print '(a b c))

(A B C)
(A C B)
(B A C)
(B C A)
(C A B)
(C B A)
NIL

* (inits '(a b c d e))
(NIL (A) (A B) (A B C) (A B C D) (A B C D E))

* (tails '(a b c d e))
((A B C D E) (B C D E) (C D E) (D E) (E) NIL)

* (insert-sort '(5 6 4 7 3 8 2 9 1) #'<)
(1 2 3 4 5 6 7 8 9)

* (quick-sort '(5 6 4 7 3 8 2 9 1) #'<)
(1 2 3 4 5 6 7 8 9)

* (pack '(a b b c c c d d d d e f f g))
((A) (B B) (C C C) (D D D D) (E) (F F) (G))

* (rle '(a b b c c c d d d d e f f g))
((A . 1) (B . 2) (C . 3) (D . 4) (E . 1) (F . 2) (G . 1))

* (rld (rle '(a b b c c c d d d d e f f g)))
(A B B C C C D D D D E F F G)

;;;
;;; sample_sort.lisp : ベクタのソート
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(require :utils)
(use-package :utils)

;;; 単純挿入ソート
(defun insert-sort (buff pred &key (start 0) (end (length buff)))
  (do ((i (+ start 1) (+ i 1)))
      ((>= i end) buff)
      (let ((temp (aref buff i))
            (j (- i 1)))
        (do ()
            ((or (< j start)
                 (funcall pred (aref buff j) temp)))
            (setf (aref buff (+ j 1)) (aref buff j))
            (decf j))
        (setf (aref buff (+ j 1)) temp))))

;;; 中央値を返す
(defun median3 (buff low high pred)
  (let ((a (aref buff low))
        (b (aref buff (truncate (+ low high) 2)))
        (c (aref buff (1- high))))
    (cond
     ((funcall pred b a)
      (cond
       ((funcall pred c b) b)
       ((funcall pred a c) a)
       (t c)))
     (t
      (cond
       ((funcall pred b c) b)
       ((funcall pred a c) c)
       (t a))))))

;;; クイックソート
(defun qsort (buff pred low high)
  (if (< (- high low) 10)
      (insert-sort buff pred :start low :end high)
    (let* ((p (median3 buff low high pred))
           (i (vector-partition (lambda (x) (funcall pred x p)) buff :start low :end high)))
      (when (< low i)
        (qsort buff pred low i))
      (when (> high i)
        (qsort buff pred i high)))))

(defun quick-sort (buff pred &key (start 0) (end (length buff)))
  (qsort buff pred start end))

* (load "sample_sort.lisp")
T

* (defvar a (vector-unfold 16 #'random #'identity 1d0))
A

* a
#(0.6294471125383416d0 0.8115843153081796d0 0.2539739311864577d0
  0.8267519197788646d0 0.26471834961609875d0 0.19508127901134142d0
  0.5569965251750717d0 0.09376334465151004d0 0.9150142635930303d0
  0.9297771145772331d0 0.3152262934102661d0 0.9411859332177082d0
  0.9143334482781893d0 0.9707515698488776d0 0.6005604715628141d0
  0.28377247312878073d0)

* (insert-sort a #'<)
#(0.09376334465151004d0 0.19508127901134142d0 0.2539739311864577d0
  0.26471834961609875d0 0.28377247312878073d0 0.3152262934102661d0
  0.5569965251750717d0 0.6005604715628141d0 0.6294471125383416d0
  0.8115843153081796d0 0.8267519197788646d0 0.9143334482781893d0
  0.9150142635930303d0 0.9297771145772331d0 0.9411859332177082d0
  0.9707515698488776d0)

* (insert-sort a #'>)
#(0.9707515698488776d0 0.9411859332177082d0 0.9297771145772331d0
  0.9150142635930303d0 0.9143334482781893d0 0.8267519197788646d0
  0.8115843153081796d0 0.6294471125383416d0 0.6005604715628141d0
  0.5569965251750717d0 0.3152262934102661d0 0.28377247312878073d0
  0.26471834961609875d0 0.2539739311864577d0 0.19508127901134142d0
  0.09376334465151004d0)

* (setq a (vector-unfold 64 #'random #'identity 1d0))
#(0.8435221790928993d0 0.8314710996278352d0 0.5844153198534443d0
  0.9189848934771323d0 0.3114812831197882d0 0.07142292146110663d0
  0.6982586020701715d0 0.867986375197924d0 0.35746993898250556d0
  0.5154807478401608d0 0.4862646815859608d0 0.7844537945629892d0
  0.3109552134181708d0 0.3423731822139042d0 0.4120920155333663d0
  0.0636656919006775d0 0.5538462375915718d0 0.09234251891515388d0
  0.1942644062695449d0 0.6469162196190497d0 0.3896571399524349d0
  0.6341989171505094d0 0.9004444986238855d0 0.06889215813209582d0
  0.8774882563558897d0 0.7631170370188469d0 0.5310335647739655d0
  0.5903997768795504d0 0.37374535439601986d0 0.979528863896518d0
  0.8911719203652637d0 0.29262618443963184d0 0.41872970664481257d0
  0.5093734813032391d0 0.5520503099195972d0 0.3594045665916752d0
  0.3101966006315946d0 0.32522358318420075d0 0.23799558261187026d0
  0.9967286814852989d0 0.919487546686808d0 0.6807717101644659d0
  0.17053585832165719d0 0.44762326981916d0 0.5025346958599008d0
  0.5101907928855745d0 0.011914196085003548d0 0.3981536986031673d0
  0.7818063956881678d0 0.9185825166289114d0 0.09443107419737284d0
  0.27724910901185384d0 0.2985880185661931d0 0.5150163743348586d0
  0.6814346204010016d0 0.5085643124087165d0 0.6285698889081055d0
  0.48704911569512044d0 0.8585273907068627d0 0.6999682496688058d0
  0.39319119307307426d0 0.5021686124969229d0 0.23208978547831527d0
  0.9465780138584392d0)

* (quick-sort a #'<)
#(0.011914196085003548d0 0.0636656919006775d0 0.06889215813209582d0
  0.07142292146110663d0 0.09234251891515388d0 0.09443107419737284d0
  0.17053585832165719d0 0.1942644062695449d0 0.23208978547831527d0
  0.23799558261187026d0 0.27724910901185384d0 0.29262618443963184d0
  0.2985880185661931d0 0.3101966006315946d0 0.3109552134181708d0
  0.3114812831197882d0 0.32522358318420075d0 0.3423731822139042d0
  0.35746993898250556d0 0.3594045665916752d0 0.37374535439601986d0
  0.3896571399524349d0 0.39319119307307426d0 0.3981536986031673d0
  0.4120920155333663d0 0.41872970664481257d0 0.44762326981916d0
  0.4862646815859608d0 0.48704911569512044d0 0.5021686124969229d0
  0.5025346958599008d0 0.5085643124087165d0 0.5093734813032391d0
  0.5101907928855745d0 0.5150163743348586d0 0.5154807478401608d0
  0.5310335647739655d0 0.5520503099195972d0 0.5538462375915718d0
  0.5844153198534443d0 0.5903997768795504d0 0.6285698889081055d0
  0.6341989171505094d0 0.6469162196190497d0 0.6807717101644659d0
  0.6814346204010016d0 0.6982586020701715d0 0.6999682496688058d0
  0.7631170370188469d0 0.7818063956881678d0 0.7844537945629892d0
  0.8314710996278352d0 0.8435221790928993d0 0.8585273907068627d0
  0.867986375197924d0 0.8774882563558897d0 0.8911719203652637d0
  0.9004444986238855d0 0.9185825166289114d0 0.9189848934771323d0
  0.919487546686808d0 0.9465780138584392d0 0.979528863896518d0
  0.9967286814852989d0)

* (quick-sort a #'>)
#(0.9967286814852989d0 0.979528863896518d0 0.9465780138584392d0
  0.919487546686808d0 0.9189848934771323d0 0.9185825166289114d0
  0.9004444986238855d0 0.8911719203652637d0 0.8774882563558897d0
  0.867986375197924d0 0.8585273907068627d0 0.8435221790928993d0
  0.8314710996278352d0 0.7844537945629892d0 0.7818063956881678d0
  0.7631170370188469d0 0.6999682496688058d0 0.6982586020701715d0
  0.6814346204010016d0 0.6807717101644659d0 0.6469162196190497d0
  0.6341989171505094d0 0.6285698889081055d0 0.5903997768795504d0
  0.5844153198534443d0 0.5538462375915718d0 0.5520503099195972d0
  0.5310335647739655d0 0.5154807478401608d0 0.5150163743348586d0
  0.5101907928855745d0 0.5093734813032391d0 0.5085643124087165d0
  0.5025346958599008d0 0.5021686124969229d0 0.48704911569512044d0
  0.4862646815859608d0 0.44762326981916d0 0.41872970664481257d0
  0.4120920155333663d0 0.3981536986031673d0 0.39319119307307426d0
  0.3896571399524349d0 0.37374535439601986d0 0.3594045665916752d0
  0.35746993898250556d0 0.3423731822139042d0 0.32522358318420075d0
  0.3114812831197882d0 0.3109552134181708d0 0.3101966006315946d0
  0.2985880185661931d0 0.29262618443963184d0 0.27724910901185384d0
  0.23799558261187026d0 0.23208978547831527d0 0.1942644062695449d0
  0.17053585832165719d0 0.09443107419737284d0 0.09234251891515388d0
  0.07142292146110663d0 0.06889215813209582d0 0.0636656919006775d0
  0.011914196085003548d0)

●プログラムリスト

;;;
;;; utils.lsp : Common Lisp ユーティリティ
;;;
;;; Copyright (c) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :utils)
(defpackage :utils (:use :cl))
(in-package :utils)
(export '(xcons
          iota
          tabulate
          unfold
          take
          drop
          take-while
          drop-while
          split-at
          split-if
          split-if-not
          partition
          insert
          insert-at
          remove-at
          selects
          power-set
          fold-left
          fold-right
          scan-left
          scan-right
          ;; ベクタ
          vector-iota
          vector-tabulate
          vector-unfold
          vector-fold-left
          vector-fold-right
          vector-map-with-index
          vector-mapc-with-index
          vector-swap
          vector-partition
          vector-bsearch
          vector-shuffle
          ))

;;;
;;; リストの生成
;;;
(defun xcons (d a) (cons a d))

(defun tabulate (fn n &key (acc nil) (start 0) (step 1))
  (if (zerop n)
      (nreverse acc)
    (tabulate fn (1- n) :acc (cons (funcall fn start) acc) :start (+ start step) :step step)))

(defun iota (n &key (start 0) (step 1))
  (tabulate #'identity n :start start :step step))

;;; 解きほぐし
(defun unfold (p f g s &optional (a nil))
  (if (funcall p s)
      (nreverse a)
    (unfold p f g (funcall g s) (cons (funcall f s) a))))

;;;
;;; リスト操作
;;;
(defun take (xs n &optional (a nil))
  (if (or (zerop n) (null xs))
      (nreverse a)
    (take (cdr xs) (1- n) (cons (car xs) a))))

(defun drop (xs n)
  (if (or (zerop n) (null xs))
      xs
    (drop (cdr xs) (1- n))))

(defun take-while (pred xs &optional (a nil))
  (if (or (null xs)
          (not (funcall pred (car xs))))
      (nreverse a)
    (take-while pred (cdr xs) (cons (car xs) a))))

(defun drop-while (pred xs)
  (if (or (null xs)
          (not (funcall pred (car xs))))
      xs
    (drop-while pred (cdr xs))))

;;;
;;; リストの分割
;;;
(defun split-at (xs n &optional (a nil))
  (if (or (null xs) (zerop n))
      (values (nreverse a) xs)
    (split-at (cdr xs) (1- n) (cons (car xs) a))))

(defun split-if (pred xs &optional (a nil))
  (if (or (null xs)
          (not (funcall pred (car xs))))
      (values (nreverse a) xs)
    (split-if pred (cdr xs) (cons (car xs) a))))

(defun split-if-not (pred xs &optional (a nil))
  (if (or (null xs)
          (funcall pred (car xs)))
      (values (nreverse a) xs)
    (split-if-not pred (cdr xs) (cons (car xs) a))))

(defun partition (pred xs &optional (ys nil) (zs nil))
  (cond
   ((null xs)
    (values (nreverse ys) (nreverse zs)))
   ((funcall pred (car xs))
    (partition pred (cdr xs) (cons (car xs) ys) zs))
   (t
    (partition pred (cdr xs) ys (cons (car xs) zs)))))

;;;
;;; 要素の挿入と削除
;;;
(defun insert (xs x pred &optional (a nil))
  (cond
   ((null xs)
    (nreverse (cons x a)))
   ((or (funcall pred x (car xs))
        (not (funcall pred (car xs) x)))
    (nreconc a (cons x xs)))
   (t
    (insert (cdr xs) x pred (cons (car xs) a)))))

(defun insert-at (xs n x &optional (a nil))
  (cond
   ((zerop n)
    (nreconc a (cons x xs)))
   ((null xs)
    (nreverse (cons x a)))
   (t
    (insert-at (cdr xs) (1- n) x (cons (car xs) a)))))

(defun remove-at (xs n &optional (a nil))
  (cond
   ((zerop n)
    (nreconc a (cdr xs)))
   ((null xs)
    (nreverse a))
   (t
    (remove-at (cdr xs) (1- n) (cons (car xs) a)))))

:;;
;;; 要素の選択 : 選んだ要素は CAR に、残りの要素は CDR に格納される
;;;
(defun selects (xs)
  (if (null (cdr xs))
      (list (list (car xs)))
    (cons (cons (car xs) (cdr xs))
          (mapcar (lambda (ys) (cons (car ys) (cons (car xs) (cdr ys))))
                  (selects (cdr xs))))))

;;; べき集合
(defun power-set (ls)
  (if (null ls)
      '(())
    (append (power-set (cdr ls))
            (mapcar (lambda (xs) (cons (car ls) xs))
                    (power-set (cdr ls))))))

;;;
;;; 畳み込み
;;;
(defun fold-left-1 (fn a xs)
  (if (null xs)
      a
    (fold-left-1 fn (funcall fn a (car xs)) (cdr xs))))

(defun fold-left-n (fn a xss)
  (if (member nil xss)
      a
    (fold-left-n fn (apply fn a (mapcar #'car xss)) (mapcar #'cdr xss))))

(defun fold-left (fn a xs &rest args)
  (if (null args)
      (fold-left-1 fn a xs)
    (fold-left-n fn a (cons xs args))))

;;; 末尾再帰ではないので注意
(defun fold-right-1 (fn a xs)
  (if (null xs)
      a
    (funcall fn (fold-right-1 fn a (cdr xs)) (car xs))))

(defun fold-right-n (fn a xss)
  (if (member nil xss)
      a
    (apply fn (fold-right-n fn a (mapcar #'cdr xss)) (mapcar #'car xss))))

(defun fold-right (fn a xs &rest args)
  (if (null args)
      (fold-right-1 fn a xs)
    (fold-right-n fn a (cons xs args))))

(defun scan-left-1 (fn a xs)
  (if (null xs)
      (list a)
    (cons a (scan-left-1 fn (funcall fn a (car xs)) (cdr xs)))))

(defun scan-left-n (fn a xss)
  (if (member nil xss)
      (list a)
    (cons a (scan-left-n fn (apply fn a (mapcar #'car xss)) (mapcar #'cdr xss)))))

(defun scan-left (fn a xs &rest args)
  (if (null args)
      (scan-left-1 fn a xs)
    (scan-left-n fn a (cons xs args))))

(defun scan-right-1 (fn a xs)
  (if (null xs)
      (list a)
    (let ((ys (scan-right-1 fn a (cdr xs))))
      (cons (funcall fn (car ys) (car xs)) ys))))

(defun scan-right-n (fn a xss)
  (if (member nil xss)
      (list a)
    (let ((ys (scan-right-n fn a (mapcar #'cdr xss))))
      (cons (apply fn (car ys) (mapcar #'car xss)) ys))))

(defun scan-right (fn a xs &rest args)
  (if (null args)
      (scan-right-1 fn a xs)
    (scan-right-n fn a (cons xs args))))

;;;
;;; ベクタの操作関数
;;;
(defun vector-tabulate (fn n &key (start 0) (step 1))
  (do ((vec (make-array n))
       (i 0 (1+ i))
       (x start (+ x step)))
      ((>= i n) vec)
      (setf (aref vec i) (funcall fn x))))

(defun vector-iota (n &key (start 0) (step 1))
  (vector-tabulate #'identity n :start start :step step))

(defun vector-unfold (n f g s)
  (do ((vec (make-array n))
       (i 0 (1+ i))
       (s s (funcall g s)))
      ((>= i n) vec)
      (setf (aref vec i) (funcall f s))))

;;;
;;; 添字付きマッピング
;;;
(defun vector-map-with-index-1 (fn vec)
  (do ((xs (make-array (length vec)))
       (i 0 (1+ i)))
      ((>= i (length vec)) xs)
      (setf (aref xs i) (funcall fn i (aref vec i)))))

(defun vector-map-with-index-n (fn vs)
  (do* ((k (apply #'min (mapcar #'length vs)))
        (xs (make-array k))
        (i 0 (1+ i)))
       ((>= i k) xs)
       (setf (aref xs i) (apply fn i (mapcar (lambda (ys) (aref ys i)) vs)))))

(defun vector-map-with-index (fn vec &rest args)
  (if (null args)
      (vector-map-with-index-1 fn vec)
    (vector-map-with-index-n fn (cons vec args))))

(defun vector-mapc-with-index-1 (fn vec)
  (do ((i 0 (1+ i)))
      ((>= i (length vec)))
      (funcall fn i (aref vec i))))

(defun vector-mapc-with-index-n (fn vs)
  (do* ((k (apply #'min (mapcar #'length vs)))
        (i 0 (1+ i)))
       ((>= i k))
       (apply fn i (mapcar (lambda (ys) (aref ys i)) vs))))

(defun vector-mapc-with-index (fn vec &rest args)
  (if (null args)
      (vector-mapc-with-index-1 fn vec)
    (vector-mapc-with-index-n fn (cons vec args))))

;;; 畳み込み
(defun vector-fold-left-1 (fn a vec)
  (dotimes (i (length vec) a)
    (setf a (funcall fn a (aref vec i)))))

(defun vector-fold-left-n (fn a vs)
  (do ((k (apply #'min (mapcar #'length vs)))
       (i 0 (1+ i)))
      ((>= i k) a)
      (setf a (apply fn a (mapcar (lambda (xs) (aref xs i)) vs)))))

(defun vector-fold-left (fn a vec &rest args)
  (if (null args)
      (vector-fold-left-1 fn a vec)
    (vector-fold-left-n fn a (cons vec args))))

(defun vector-fold-right-1 (fn a vec)
  (do ((i (1- (length vec)) (1- i)))
      ((minusp i) a)
      (setf a (funcall fn a (aref vec i)))))

(defun vector-fold-right-n (fn a vs)
  (do* ((k (apply #'min (mapcar #'length vs)))
        (i (1- k) (1- i)))
       ((minusp i) a)
       (setf a (apply fn a (mapcar (lambda (xs) (aref xs i)) vs)))))

(defun vector-fold-right (fn a vec &rest args)
  (if (null args)
      (vector-fold-right-1 fn a vec)
    (vector-fold-right-n fn a (cons vec args))))


;;; 要素の交換
(defun vector-swap (vec i j)
  (psetf (aref vec i) (aref vec j)
         (aref vec j) (aref vec i))
  vec)

;;; ベクタの分割 (破壊的)
(defun vector-partition (pred vec &key (start 0) (end (length vec)))
  (let ((i start) (j (1- end)))
    (loop
     (do () ((or (<= end i) (not (funcall pred (aref vec i))))) (incf i))
     (do () ((or (> start j) (funcall pred (aref vec j)))) (decf j))
     (cond
      ((>= i j)
       (return (values i vec)))
      (t
       (vector-swap vec i j)
       (incf i)
       (decf j))))))

;;; ベクタの二分探索
(defun bsearch (x xs low high key elt= elt<)
  (when (<= low high)
    (let ((mid (truncate (+ low high) 2)))
     (cond
      ((funcall elt= x (funcall key (aref xs mid))) mid)
      ((funcall elt< x (funcall key (aref xs mid)))
       (bsearch x xs low (1- mid) key elt= elt<))
      (t
       (bsearch x xs (1+ mid) high key elt= elt<))))))

(defun vector-bsearch (x xs &key (start 0) (end (length xs)) (key #'identity) (elt= #'eql) (elt< #'<))
  (bsearch x xs start (1- end) key elt= elt<))

;;; ベクタのシャッフル
(defun vector-shuffle (vec)
  (do ((i (1- (length vec)) (1- i)))
      ((zerop i) vec)
      (let ((j (random (1+ i))))
        (vector-swap vec i j))))

リスト : utils.asd

(defsystem :utils
  :description "Common Lisp utility programs"
  :version "0.1.0"
  :author "Makoto Hiroi"
  :license "MIT"
  :depends-on ()
  :in-order-to ((test-op (test-op :utils_tst)))
  :components ((:file "utils")))

;;;
;;; utils_tst.lisp : utils のテスト
;;;
;;; Copyright (C) 2023 Makoto Hiroi
;;;
;;; Released under the MIT license
;;; https://opensource.org/license/mit/
;;;
(provide :utils_tst)
(defpackage :utils_tst (:use :cl :mintst :utils))
(in-package :utils_tst)
(export '(test))

(defun square (x) (* x x))

;;; 実行
(defun test ()
  (initial)
  ;; リストの生成
  (run (xcons 1 2) '(2 . 1))
  (run (iota 3) '(0 1 2))
  (run (iota 4 :start 1) '(1 2 3 4))
  (run (iota 5 :start 2 :step 2) '(2 4 6 8 10))
  (run (tabulate #'identity 3) '(0 1 2))
  (run (tabulate #'identity 4 :start 1) '(1 2 3 4))
  (run (tabulate #'square 5 :step 2) '(0 4 16 36 64))
  (run (unfold (lambda (x) (<= x 4)) #'identity #'1+ 0) '(0 1 2 3))
  (run (unfold (lambda (x) (<= x 5)) #'square #'1+ 1) '(1 4 9 16))
  ;; リストの操作
  (run (take '(1 2 3 4 5 6) 0) nil)
  (run (take '(1 2 3 4 5 6) 3) '(1 2 3))
  (run (take '(1 2 3 4 5 6) 6) '(1 2 3 4 5 6))
  (run (drop '(1 2 3 4 5 6) 0) '(1 2 3 4 5 6))
  (run (drop '(1 2 3 4 5 6) 3) '(4 5 6))
  (run (drop '(1 2 3 4 5 6) 6) nil)
  (run (take-while #'evenp '(1 3 5 7 9)) nil)
  (run (take-while #'oddp '(1 3 5 7 9)) '(1 3 5 7 9))
  (run (take-while #'evenp '(2 4 6 8 1 3 5 7)) '(2 4 6 8))
  (run (drop-while #'evenp '(1 3 5 7 9)) '(1 3 5 7 9))
  (run (drop-while #'oddp '(1 3 5 7 9)) nil)
  (run (drop-while #'evenp '(2 4 6 8 1 3 5 7)) '(1 3 5 7))
  (run (multiple-value-list (split-at '(1 2 3 4 5 6) 0))
       '(nil (1 2 3 4 5 6)))
  (run (multiple-value-list (split-at '(1 2 3 4 5 6) 3))
       '((1 2 3) (4 5 6)))
  (run (multiple-value-list (split-at '(1 2 3 4 5 6) 6))
       '((1 2 3 4 5 6) nil))
  (run (multiple-value-list (split-if #'evenp '(2 4 6 8 1 3 5 7)))
       '((2 4 6 8) (1 3 5 7)))
  (run (multiple-value-list (split-if #'oddp '(2 4 6 8 1 3 5 7)))
       '(nil (2 4 6 8 1 3 5 7)))
  (run (multiple-value-list (split-if #'oddp '(1 3 5 7 9)))
       '((1 3 5 7 9) nil))
  (run (multiple-value-list (split-if-not #'oddp '(2 4 6 8 1 3 5 7)))
       '((2 4 6 8) (1 3 5 7)))
  (run (multiple-value-list (split-if-not #'evenp '(2 4 6 8 1 3 5 7)))
       '(nil (2 4 6 8 1 3 5 7)))
  (run (multiple-value-list (split-if-not #'evenp '(1 3 5 7 9)))
       '((1 3 5 7 9) nil))
  (run (multiple-value-list (partition #'evenp '(0 1 2 3 4 5 6 7)))
       '((0 2 4 6) (1 3 5 7)))
  (run (multiple-value-list (partition #'evenp '(0 2 4 6 8)))
       '((0 2 4 6 8) nil))
  (run (multiple-value-list (partition #'oddp '(0 2 4 6 8)))
       '(nil (0 2 4 6 8)))
  (run (insert '(1 3 5 7) 0 #'>) '(0 1 3 5 7))
  (run (insert '(1 3 5 7) 4 #'>) '(1 3 4 5 7))
  (run (insert '(1 3 5 7) 8 #'>) '(1 3 5 7 8))
  (run (insert-at '(1 3 5 7) 0 9) '(9 1 3 5 7))
  (run (insert-at '(1 3 5 7) 2 9) '(1 3 9 5 7))
  (run (insert-at '(1 3 5 7) 4 9) '(1 3 5 7 9))
  (run (remove-at '(1 3 5 7 9) 0) '(3 5 7 9))
  (run (remove-at '(1 3 5 7 9) 2) '(1 3 7 9))
  (run (remove-at '(1 3 5 7 9) 4) '(1 3 5 7))
  (run (selects '(a)) '((a)))
  (run (selects '(a b)) '((a b) (b a)))
  (run (selects '(a b c)) '((a b c) (b a c) (c a b)))
  (run (power-set '(a b c d))
       '(NIL (D) (C) (C D) (B) (B D) (B C) (B C D) (A) (A D) (A C)
             (A C D) (A B) (A B D) (A B C) (A B C D)))
  (run (fold-left #'+ 0 '(1 2 3 4 5)) 15)
  (run (fold-left #'xcons nil '(a b c)) '(c b a))
  (run (fold-left (lambda (a x y) (cons (cons x y) a)) nil '(a b c) '(1 2 3))
       '((C . 3) (B . 2) (A . 1)))
  (run (fold-right #'+ 0 '(1 2 3 4 5)) 15)
  (run (fold-right (lambda (a x) (cons x a)) nil '(a b c))
       '(a b c))
  (run (fold-right (lambda (a x y) (cons (cons x y) a)) nil '(a b c) '(1 2 3))
       '((A . 1) (B . 2) (C . 3)))
  (run (scan-left #'+ 0 (iota 10 :start 1))
       '(0 1 3 6 10 15 21 28 36 45 55))
  (run (scan-left (lambda (a x y) (cons (cons x y) a)) nil '(a b c) '(1 2 3))
       '(NIL ((A . 1)) ((B . 2) (A . 1)) ((C . 3) (B . 2) (A . 1))))
  (run (scan-right #'+ 0 (iota 10 :start 1))
       '(55 54 52 49 45 40 34 27 19 10 0))
  (run (scan-right (lambda (a x y) (cons (cons x y) a)) nil '(a b c) '(1 2 3))
       '(((A . 1) (B . 2) (C . 3)) ((B . 2) (C . 3)) ((C . 3)) NIL))

  ;; ベクタの操作
  (run (vector-iota 3) #(0 1 2) :test #'equalp)
  (run (vector-iota 4 :start 1) #(1 2 3 4) :test #'equalp)
  (run (vector-iota 5 :start 2 :step 2) #(2 4 6 8 10) :test #'equalp)
  (run (vector-tabulate #'identity 3) #(0 1 2) :test #'equalp)
  (run (vector-tabulate #'identity 4 :start 1) #(1 2 3 4) :test #'equalp)
  (run (vector-tabulate #'square 5 :step 2) #(0 4 16 36 64) :test #'equalp)
  (run (vector-unfold 4 #'identity #'1+ 0) #(0 1 2 3) :test #'equalp)
  (run (vector-unfold 5 #'square #'1+ 1) #(1 4 9 16 25) :test #'equalp)
  (run (vector-fold-left #'+ 0 #(1 2 3 4 5)) 15)
  (run (vector-fold-left #'xcons nil #(a b c)) '(c b a))
  (run (vector-fold-left (lambda (a x y) (cons (cons x y) a)) nil #(a b c) #(1 2 3))
       '((C . 3) (B . 2) (A . 1)))
  (run (vector-fold-right #'+ 0 #(1 2 3 4 5)) 15)
  (run (vector-fold-right (lambda (a x) (cons x a)) nil #(a b c))
       '(a b c))
  (run (vector-fold-right (lambda (a x y) (cons (cons x y) a)) nil #(a b c) #(1 2 3))
       '((A . 1) (B . 2) (C . 3)))
  (run (vector-map-with-index (lambda (i x) (list i x)) #(a b c))
       #((0 A) (1 B) (2 C)) :test #'equalp)
  (run (vector-map-with-index (lambda (i x y) (list i x y)) #(a b c d) #(10 20 30))
       #((0 A 10) (1 B 20) (2 C 30)) :test #'equalp)
  (run (let ((a nil))
         (vector-mapc-with-index (lambda (i x) (push (list i x) a)) #(a b c))
         (reverse a))
       '((0 A) (1 B) (2 C)))
  (run (let ((a nil))
         (vector-mapc-with-index (lambda (i x y) (push (list i x y) a)) #(a b c d) #(10 20 30))
         (reverse a))
       '((0 A 10) (1 B 20) (2 C 30)))
  (run (vector-swap #(1 2 3 4 5) 0 4) #(5 2 3 4 1) :test #'equalp)
  (run (vector-swap #(1 2 3 4 5) 1 3) #(1 4 3 2 5) :test #'equalp)
  (run (vector-swap #(1 2 3 4 5) 2 2) #(1 2 3 4 5) :test #'equalp)
  (run (multiple-value-list (vector-partition #'evenp #(1 2 3 4 5 6)))
       '(3 #(6 2 4 3 5 1)) :test #'equalp)
  (run (multiple-value-list (vector-partition #'evenp #(0 2 4 6 8 10)))
       '(6 #(0 2 4 6 8 10)) :test #'equalp)
  (run (multiple-value-list (vector-partition #'evenp #(1 3 5 7 9 11)))
       '(0 #(1 3 5 7 9 11)) :test #'equalp)
  (run (vector-bsearch 5 #(1 2 3 4 5 6 7 8 9)) 4)
  (run (vector-bsearch 1 #(1 2 3 4 5 6 7 8 9)) 0)
  (run (vector-bsearch 9 #(1 2 3 4 5 6 7 8 9)) 8)
  (run (vector-bsearch 1 #(1 2 3 4 5 6 7 8 9) :start 1) nil)
  (run (vector-bsearch 9 #(1 2 3 4 5 6 7 8 9) :end 8) nil)
  (run (vector-bsearch 5.5 #(1 2 3 4 5 6 7 8 9)) nil)
  (run (dotimes (x 12)
         (when (equalp (vector-shuffle (vector 1 2 3)) #(3 2 1)) (return t)))
       t)
  (run (dotimes (x 12)
         (when (equalp (vector-shuffle (vector 1 2 3)) #(1 2 3)) (return t)))
       t)
  (final))

リスト : utils_tst.asd

(defsystem :utils_tst
  :description "test for utils"
  :version "0.1.0"
  :author "Makoto Hiroi"
  :license "MIT"
  :depends-on (:mintst :utils)
  :components ((:file "utils_tst"))
  :perform (test-op (o s) (symbol-call :utils_tst :test)))

Common Lisp Programming

お気楽 Common Lisp プログラミング入門 : 自作ライブラリ編

utils

●インストール

●仕様

●簡単なテスト

●サンプルプログラム

●プログラムリスト