今回は拡張されたループ機能、いわゆる「ループマクロ」について簡単に説明します。ループマクロは、loop の中でループキーワードを指定することにより、さまざまな繰り返しや値の蓄積など多くの処理を行わせることができます。
ループマクロは高機能なのですが、使いこなすのは難しいのではないか、と思われている方もいるでしょう。実をいうと、M.Hiroi は繰り返しよりも再帰定義を好むので、ループマクロはほとんど使ったことがありません。食わず嫌いはやめて、簡単なところから少しずつ勉強していくことにしましょう。
ループマクロの基本は単純な loop マクロと同じです。基本的には無限ループですが、loop の中で特定のシンボル (ループキーワード) を使って繰り返しの制御や値の累積を行います。
ループキーワード as, for, repeat は繰り返しを制御するためのキーワードです。for と as は同じ意味で、どちらを使ってもかまいません。for の基本的な動作は手続き型言語の for 文と似ています。
for var 初期化キーワード expr1 終了キーワード expr2 更新キーワード expr3 ...
初期化キーワード: form, downfrom, upfrom 終了キーワード: to, downto, upto, below, above 更新キーワード: by
for は expr1 から expr2 の値まで、expr3 で示された値で増減する繰り返しを行います。変数 var はレキシカル変数として扱われます。expr1, expr2, expr3 は一度だけ評価され、その結果は数値でなければなりません。
初期化キーワードを省略すると初期値は 0 になります。終了キーワードを省略すると無限ループになります。更新キーワードを省略すると数値は 1 になります。初期化キーワード、終了キーワード、更新キーワードをすべて省略することはできません。必ずどれかひとつを指定してください。
基本的な使い方を示します。
loop for x from 1 to 10 ... ; 1 から 10 まで loop for x form 1 to 10 by 2 ... ; 1, 3, 5, 7, 9 loop for x from 1 below 10 ... ; 1 から 9 まで (10 を含まない) loop for x from 10 downto 1 ... ; 10 から 1 まで loop for x from 10 downto 1 by 2 ... ; 10, 8, 6, 4, 2 loop for x from 10 above 1 ... ; 10 から 2 まで (1 を含まない)
loop の中で S 式を評価したい場合はキーワード do を使います。S 式の評価結果をリストに格納して返す場合はキーワード collect を使います。簡単な例を示しましょう。
* (loop for x from 1 to 5 do (print x)) 1 2 3 4 5 NIL * (loop for x from 1 to 5 collect (* x x)) (1 4 9 16 25)
collect を使うと Python や Haskell などの「内包表記」と同じような動作になります。なお、do は複数の S 式を記述することができます。
指定した回数だけ処理を繰り返したい場合はキーワード repeat を使うと簡単です。
repeat expr ...
repeat は式 expr を評価し、その結果が正であれば、その回数だけ処理を繰り返します。0 または負の場合は処理を行いません。簡単な例を示しましょう。
* (loop repeat 5 do (print "hello, world")) "hello, world" "hello, world" "hello, world" "hello, world" "hello, world" NIL * (loop repeat 0 do (print "hello, world")) NIL
リストの要素に対して繰り返しを行うには次の構文を使います。
for 変数 in expr1 by step-func ...
式 expr1 の評価結果はリストでなければいけません。繰り返しのたびに step-func がリストに適用され、その先頭要素が変数にセットされます。step-func のデフォルトは #'cdr です。簡単な例を示しましょう。
* (loop for x in '(1 2 3 4 5 6) collect (* x x)) (1 4 9 16 25 36) * (loop for x in '(1 2 3 4 5 6) by #'cddr collect (* x x)) (1 9 25)
maplist のように、要素ではなくリストを渡したい場合は in のかわりに on を使います。
for 変数 on expr1 by step-func ...
簡単な例を示しましょう。
* (loop for x on '(1 2 3 4 5 6) do (print x)) (1 2 3 4 5 6) (2 3 4 5 6) (3 4 5 6) (4 5 6) (5 6) (6) NIL * (loop for x on '(1 2 3 4 5 6) by #'cddr do (print x)) (1 2 3 4 5 6) (3 4 5 6) (5 6) NIL
キーワード while と until はループの終了条件を指定します。
while expr until expr
while は expr が偽になるまで処理を繰り返します。逆に、until は expr が真になるまで処理を繰り返します。while と until は loop 本体のどこに置いてもかまいません。簡単な例を示しましょう。
* (loop for x from 1 while (< x 10) collect x) (1 2 3 4 5 6 7 8 9) * (loop for x downfrom 10 until (zerop x) collect x) (10 9 8 7 6 5 4 3 2 1)
変数の更新を S 式で行いたい場合は次の構文を使います。
loop for 変数 = expr1 then expr2 ...
変数は式 expr1 で初期化され、式 expr2 で更新されます。expr2 は繰り返しを行うたびに評価されます。then expr2 が省略された場合、繰り返しを行うたびに expr1 が評価されます。簡単な例を示しましょう。
* (loop for x = 1 then (* x 2) while (< x 1000) collect x) (1 2 4 8 16 32 64 128 256 512)
ループキーワード if, when, unless を使うと、ある条件を満たしたときだけ処理を実行するように指定することができます。
if expr clause1 [and clause ...] [else clasue2 [and clause ...]] [end] when expr clause1 [and clause ...] [else clasue2 [and clause ...]] [end] unless expr clause1 [and clause ...] [else clasue2 [and clause ...]] [end]
if と when は同じ意味です。条件式 expr が真のとき節 clause1 を評価します。偽ならばループキーワード else 以降の節 clause2 (else 節) を評価します。else 節は省略してもかまいません。複数の節を実行するときは節をループキーワード and でつなぎます。
unless は if と when の逆で、expr が偽の場合に clause1 を評価して、真の場合は clause2 を評価します。それから、ループキーワード end を使って節の終わりを明確にすることもできます。
簡単な例を示しましょう。
* (loop for x from 1 to 10 if (oddp x) collect x) (1 3 5 7 9) * (loop for x from 1 to 10 unless (oddp x) collect x) (2 4 6 8 10)
これは内包表記とよく似た動作なので、内包表記をご存じの方であればすぐに理解できると思います。
手続き型言語のように、else の後ろに if をつなげることもできます。
* (loop for x from -2 to 2 if (minusp x) do (print "minus") else if (zerop x) do (print "zero") else do (print "plus")) "minus" "minus" "zero" "plus" "plus" NIL
節の中で条件式 expr の評価結果を参照するためループキーワード it が用意されています。and で節をつなげた場合、it を参照できるのは最初の節だけです。簡単な例を示しましょう。
* (loop for x from 1 to 10 if (and (oddp x) x) collect it) (1 3 5 7 9)
条件式 (and (oddp x) x) の評価結果が真の場合、その値は X になるので、it は X と同じ値になります。
ベクタの要素に対して繰り返しを行うには次の構文を使います。
for var across vector
簡単な例を示しましょう。
* (loop for x across #(1 2 3 4 5) collect x) (1 2 3 4 5) * (loop for x across #(1 2 3 4 5) do (print x)) 1 2 3 4 5 NIL * (loop for x across "abcde" collect x) (#\a #\b #\c #\d #\e) * (loop for x across "abcde" do (print x)) #\a #\b #\c #\d #\e NIL
across は文字列でも動作します。
ハッシュ表の要素に対して繰り返しを行うには次の構文を使います。
for var being the hash-values in hash-table [using (hash-key var1)] ...
hash-keys (hash-value var1)
the の後ろで hash-values を指定すると、ハッシュ表から値を取り出して変数 var にセットします。hash-keys を指定するとキーを取り出して変数 var にセットします。using で (hash-key var1) を指定すると、キーが変数 var1 にセットされます。(hash-value var1) とすると、値が変数 var1 にセットされます。これでキーと値の両方にアクセスすることができます。
簡単な例を示しましょう。
* (defvar ht (make-hash-table))
HT
* (setf (gethash "foo" ht) 10 (gethash "bar" ht) 20 (gethash "baz" ht) 30)
30
* (loop for x being the hash-keys in ht do (print x))
"foo"
"bar"
"baz"
NIL
* (loop for x being the hash-values in ht do (print x))
10
20
30
NIL
* (loop for x being the hash-keys in ht using (hash-value y) collect (list x y))
(("foo" 10) ("bar" 20) ("baz" 30))
* (loop for x being the hash-values in ht using (hash-key y) collect (list x y))
((10 "foo") (20 "bar") (30 "baz"))
for は複数指定することができます。このとき、for は入れ子になるのではなく、繰り返すたびに各 for の更新処理が行われ、一番短い繰り返しで終了します。Python や Haskell などの「内包表記」とは違うので注意してください。簡単な例を示しましょう。
* (loop for x from 1 to 3 for y from 10 to 14 collect (list x y)) ((1 10) (2 11) (3 12))
X は 1 から 3 まで、Y は 10 から 14 まで繰り返します。そのたびに X と Y の値が +1 されますが、繰り返しは短いほうの 3 回で終了します。また、for はその前に定義された変数の値を参照することもできます。
* (loop for x from 10 downto 1 for y from 1 to (/ x 2) collect (list x y)) ((10 1) (9 2) (8 3) (7 4) (6 5)) * (loop for x from 10 downto 1 for y = (- 10 x) collect (list x y)) ((10 0) (9 1) (8 2) (7 3) (6 4) (5 5) (4 6) (3 7) (2 8) (1 9))
この場合、変数の更新処理は逐次的に行われます。変数 X の値が更新されたあと、変数 Y の値が更新されますが、このとき更新された X の値を参照することができます。
ここで、ループキーワード and を使って for を連結すると、変数の更新処理を並列に行うことができます。これは psetq と同じで、すべての更新処理が評価されたあと、変数の値が書き換えられます。簡単な例を示しましょう。
* (loop for x from 10 downto 1 and y = nil then x collect (list x y)) ((10 NIL) (9 10) (8 9) (7 8) (6 7) (5 6) (4 5) (3 4) (2 3) (1 2)) * (loop for x from 10 downto 1 for y = nil then x collect (list x y)) ((10 NIL) (9 9) (8 8) (7 7) (6 6) (5 5) (4 4) (3 3) (2 2) (1 1))
and は for と置き換えて使います。最初の例で Y は X の値で更新されますが、X の更新前の値が参照されていることが分かります。and ではなく for を使うと、Y の値は更新された X の値になります。
ループマクロには collect 以外にも値を累積する処理がいろいろ用意されています。以下にループキーワードを示します。
簡単な例を示しましょう。
* (loop for x from 1 to 5 collect (list x x)) ((1 1) (2 2) (3 3) (4 4) (5 5)) * (loop for x from 1 to 5 append (list x x)) (1 1 2 2 3 3 4 4 5 5) * (loop for x from 1 to 5 nconc (list x x)) (1 1 2 2 3 3 4 4 5 5) * (loop for x from 1 to 10 count (evenp x)) 5 * (loop for x from 1 to 10 sum x) 55 * (loop for x from 1 to 10 sum (* x x)) 385 * (loop for x from 1 to 10 sum (* x x x)) 3025 * (loop for x in '(5 6 4 3 7 8 2 9 0 1) maximize x) 9 * (loop for x in '(5 6 4 3 7 8 2 9 0 1) minimize x) 0
ループの終了条件は while や until だけではなく、次のループキーワードで指定することができます。
always と never の動作は関数 every と notany と似ています。notany は (not (some ...)) と同じ動作です。
簡単な使用例を示しましょう。
* (loop for x in '(2 4 6 8 10) always (evenp x)) T * (loop for x in '(2 4 5 6 8 10) always (evenp x)) NIL * (every #'evenp '(2 4 6 8 10)) T * (every #'evenp '(2 4 5 6 8 10)) NIL * (loop for x in '(1 3 5 7 9) never (evenp x)) T * (loop for x in '(1 3 4 5 7 9) never (evenp x)) NIL * (notany #'evenp '(1 3 5 7 9)) T * (notany #'evenp '(1 3 4 5 7 9)) NIL * (loop for x in '(1 3 5 7 9) thereis (and (evenp x) x)) NIL * (loop for x in '(1 3 4 5 7 9) thereis (and (evenp x) x)) 4
ループの前処理はループキーワード initially で、後処理は finally で指定することができます。initially と finally は複数の S 式を記述することができます。initially で指定した前処理は、繰り返しが行われなくても必ず実行されます。なお、return でループから脱出するとき、後処理は実行されません。ご注意くださいませ。
簡単な例を示しましょう。
* (loop for x from 1 to 5 do (print x) initially (print "start") finally (print "end")) "start" 1 2 3 4 5 "end" NIL * (loop for x from 1 to 5 if (< x 4) do (print x) else do (return) initially (print "start") finally (print "end")) "start" 1 2 3 NIL
loop は暗黙のブロック block nil ... で囲まれているため、2 番目の例のように (return) で loop を脱出することができます。この場合、finally 節は評価されません。これと同じ動作を行うループキーワード return も用意されています。
return expr
* (loop for x from 1 to 5 if (< x 4) do (print x) else return nil initially (print "start") finally (print "end")) "start" 1 2 3 NIL
ループキーワード named で loop のブロックに名前を付けて、return-from で脱出することもできます。
* (loop named oops for x from 1 to 5 if (< x 4) do (print x) else do (return-from oops t) initially (print "start") finally (print "end")) "start" 1 2 3 T
これは多重ループの内側から一気に脱出するとき役に立ちます。
マクロ loop-finish を評価すると、ループを終了して累積した値を返します。もちろん、finally 節も評価されます。
* (loop for x from 1 to 5 if (< x 4) collect x else do (loop-finish) initially (print "start") finally (print "end")) "start" "end" (1 2 3)
ループキーワード with は loop 内で使用するレキシカル変数を定義します。
with var = expr [and var1 = expr1 and ...]
変数 var は式 expr の評価結果で初期化されます。with は複数指定することができます。この場合、変数の初期化は逐次的に行われます。つまり、let* と同じ動作になります。with を複数指定するとき and でつなげると、変数の初期化は並列に初期化されます。つまり、let と同じ動作になります。
簡単な例を示しましょう。
* (loop with a = 1 with b = (+ 1 a) with c = (+ b 2) return (list a b c)) (1 2 4) * (loop with a = 1 and b = 2 and c = 3 return (list a b c)) (1 2 3) * (loop with a = nil for x from 1 to 10 do (push x a) finally (return a)) (10 9 8 7 6 5 4 3 2 1)
値を累積するとき、ループキーワード into で累積変数を定義することができます。次の例を見てください。
* (loop for x from 1 to 10 collect x into a) NIL * (loop for x from 1 to 10 collect x into a finally (return a)) (1 2 3 4 5 6 7 8 9 10) * (loop for x in '(5 6 4 7 3 8 2 9 0 1) maximize x into a minimize x into b finally (return (list a b))) (9 0)
into で指定した累積変数の値は、return などを使って明示的に返すようにしてください。ループ終了時に自動的に返されることはありません。ご注意くださいませ。
for や with などで変数を定義するとき、「分配 (destructuring)」を使うことができます。ループ機能の分配は、変数を格納したリスト (変数リスト) と値を格納したリスト (値リスト) を照合し、変数リストの変数と同じ位置にある値リストの値でその変数を初期化します。
簡単な例を示しましょう。
* (loop with (a b c) = '(1 2 3) return (list a b c)) (1 2 3) * (loop with (a b c) = '(1 2) return (list a b c)) (1 2 NIL) * (loop with (a b c) = '(1 2 3 4) return (list a b c)) (1 2 3)
変数が余る場合、その変数の値は NIL に初期化されます。値が余る場合、余った値は無視されます。変数リストと値リストは入れ子であったりドットリストでもかまいません。
* (loop with ((a b) (c d)) = '((1 2) (3 4)) return (list a b c d)) (1 2 3 4) * (loop with ((a . b) (c . d)) = '((1 . 2) (3 . 4)) return (list a b c d)) (1 2 3 4) * (loop with ((a . b) c) = '((1 . 2) (3 . 4)) return (list a b c)) (1 2 (3 . 4))
ループマクロを使うとリストの操作関数や高階関数を簡単に作成することができます。簡単な例と実行結果を示します。
リスト : ループマクロの簡単な使用例
;;; 数列の生成
(defun iota (n &key (start 0) (step 1))
(loop for x from start by step repeat n collect x))
(defun tabulate (fn n &key (start 0) (step 1))
(loop for x from start by step repeat n collect (funcall fn x)))
;;; リスト操作
(defun take (xs n)
(loop for x in xs repeat n collect x))
(defun drop (xs n)
(loop for x on xs repeat n finally (return x)))
(defun zip (xs ys)
(loop for x in xs for y in ys collect (list x y)))
(defun unzip (zs)
(loop for (x y) in zs collect x into xs collect y into ys finally (return (values xs ys))))
;;; 線形探索
(defun my-find-if (pred xs)
(loop for x in xs if (funcall pred x) return x))
(defun my-position-if (pred xs)
(loop for x in xs for i upfrom 0 if (funcall pred x) return i))
(defun my-count-if (pred xs)
(loop for x in xs count (funcall pred x)))
;;; 高階関数
(defun map1 (fn xs)
(loop for x in xs collect (funcall fn x)))
(defun map2 (fn xs ys)
(loop for x in xs for y in ys collect (funcall fn x y)))
(defun filter (fn xs)
(loop for x in xs if (funcall fn x) collect x))
(defun fold-left (fn init xs)
(loop for x in xs
for a = (funcall fn init x) then (funcall fn a x)
finally (return a)))
(defun partition-if (pred xs)
(loop for x in xs
if (funcall pred x) collect x into ys else collect x into zs
finally (return (values ys zs))))
* (iota 10) (0 1 2 3 4 5 6 7 8 9) * (iota 10 :start 1 :step 2) (1 3 5 7 9 11 13 15 17 19) * (tabulate (lambda (x) (* x x)) 10) (0 1 4 9 16 25 36 49 64 81) * (tabulate (lambda (x) (* x x)) 10 :start 1) (1 4 9 16 25 36 49 64 81 100) * (take '(1 2 3 4 5) 0) NIL * (take '(1 2 3 4 5) 3) (1 2 3) * (take '(1 2 3 4 5) 5) (1 2 3 4 5) * (drop '(1 2 3 4 5) 0) (1 2 3 4 5) * (drop '(1 2 3 4 5) 3) (4 5) * (drop '(1 2 3 4 5) 5) NIL * (zip '(a b c d e) '(1 2 3 4 5)) ((A 1) (B 2) (C 3) (D 4) (E 5)) * (unzip (zip '(a b c d e) '(1 2 3 4 5))) (A B C D E) (1 2 3 4 5) * (my-find-if #'oddp '(2 4 6 8 9 10)) 9 * (my-find-if #'oddp '(2 4 6 8 10)) NIL * (my-position-if #'oddp '(2 4 6 8 9 10)) 4 * (my-position-if #'oddp '(2 4 6 8 10)) NIL * (my-count-if #'oddp '(2 4 6 8 9 10)) 1 * (my-count-if #'evenp '(2 4 6 8 9 10)) 5 * (map1 (lambda (x) (* x x)) '(1 2 3 4 5))) (1 4 9 16 25) * (map2 (lambda (x y) (* x y)) '(1 2 3 4 5) '(10 20 30 40 50)) (10 40 90 160 250) * (filter #'oddp '(1 2 3 4 5)) (1 3 5) * (filter #'evenp '(1 2 3 4 5)) (2 4) * (fold-left #'+ 0 '(1 2 3 4 5 6 7 8 9 10)) 55 * (partition-if #'oddp '(1 2 3 4 5 6 7 8 9 10)) (1 3 5 7 9) (2 4 6 8 10)
ループ機能を使って次に示す関数を定義してください。
拙作のページ 配列 の「素数を求める (2)」で作成したプログラムを loop で書き直すと次のようになります。
リスト : 素数を求める
;;; 素数のチェック
(defun primep (x ps)
(loop for p across ps while (<= (* p p) x) always (not (zerop (mod x p)))))
;;; 素数のベクタを返す
(defun prime (n)
(loop with ps = (make-array 1 :fill-pointer t :adjustable t :initial-contents '(2))
for x from 3 to n by 2
when (primep x ps)
do (vector-push-extend x ps)
finally (return ps)))
* (prime 100) #(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) * (prime 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) * (time (length (prime 100000))) Evaluation took: 0.024 seconds of real time 0.031250 seconds of total run time (0.031250 user, 0.000000 system) 129.17% CPU 59,719,096 processor cycles 226,336 bytes consed 9592
実行速度は 配列 の「素数を求める (2)」で作成したプログラムと同じくらいでした。
リスト : 素因数分解
(defun factor-sub (n m)
(loop with c = 0
while (zerop (mod n m))
do (incf c)
(setq n (/ n m))
finally (return (values c n))))
(defun factorization (n)
(loop with zs and c and m
for x from 3 by 2
while (<= (* x x) m)
do (multiple-value-setq (c m) (factor-sub m x))
(when (plusp c)
(push (list x c) zs))
initially
(multiple-value-setq (c m) (factor-sub n 2))
(when (plusp c)
(push (list 2 c) zs))
finally
(when (< 1 m)
(push (list m 1) zs))
(return (nreverse zs))))
最初に 2 で割り算し、それから奇数で割り算していきます。割り算するときは、その数で割り切れるあいだは割り算を続けることに注意してください。たとえば、27 を素因数分解すると 3 * 3 * 3 になりますが、3 を一回だけしか割り算しないと、結果は 3 * 9 のように素数ではない数が含まれてしまいます。この処理を関数 factor-sub で行っています。
あとは、factor-sub の返り値をチェックして、割り算した回数 C が 0 よりも大きければ、素数と C をリストに格納して、それをリスト ZS に追加します。これを変数 X が √M 以下のあいだ繰り返します。最後に M が 1 よりも大きければ、(M 1) を ZS に追加して、return で (nreverse zs) を返します。
それでは実行してみましょう。
* (factorization 24) ((2 3) (3 1)) * (factorization 12345678) ((2 1) (3 2) (47 1) (14593 1)) * (factorization 1234567890) ((2 1) (3 2) (5 1) (3607 1) (3803 1)) * (factorization 1111111111) ((11 1) (41 1) (271 1) (9091 1))
n の素因数分解ができると、約数の個数を求めるのは簡単です。\(n = p^a \times q^b \times r^c\) とすると、約数の個数は \((a + 1) \times (b + 1) \times (c + 1)\) になります。たとえば、12 は \(2^2 \times 3^1\) になるので、約数の個数は 3 * 2 = 6 になります。実際、12 の約数は 1, 2, 3, 4, 6, 12 の 6 個です。
関数 factorization を使うと、プログラムは次のようになります。
リスト : 約数の個数
(defun divisor-num (n)
(loop for (m p) in (factorization n)
for a = (1+ p) then (* a (1+ p))
finally (return a)))
関数 divisor-num は loop でリストの要素を順番に取り出し、(1+ p) を変数 A に掛け算していくだけです。
簡単な実行例を示します。
* (divisor-num 24) 8 * (divisor-num 12345678) 24 * (divisor-num 1234567890) 48 * (divisor-num 1111111111) 16
n の素因数分解ができると、約数の合計値を求めるのは簡単です。n の素因数分解が \(p^a\) だった場合、その約数の合計値は次の式で求めることができます。
たとえば、8 の素因数分解は \(2^3\) になり、素数の合計値は 8 + 4 + 2 + 1 = 15 になります。
\(p^a\) の約数の合計値を \(\sigma(p, a)\) で表すことにします。\(n = p^a \times q^b \times r^c\) の場合、n の約数の合計値は \(\sigma(p, a) \times \sigma(q, b) \times \sigma(r, c)\) になります。たとえば、12 は \(2^2 \times 3\) に素因数分解できますが、その合計値は (4 + 2 + 1) * (3 + 1) = 28 となります。12 の約数は 1, 2, 3, 4, 6, 12 なので、その合計値は確かに 28 になります。
関数 factorization を使うと、プログラムは次のようになります。
リスト : 約数の合計値
;;; σ(p, n) の計算
(defun sigma (n p)
(loop for x from 0 to p sum (expt n x)))
(defun divisor-sum (n)
(loop for (m p) in (factorization n)
for a = (sigma m p) then (* a (sigma m p))
finally (return a)))
関数 sigma は σ(p, n) を計算します。あとは loop で sigma の返り値を変数 A に掛け算していくだけです。
簡単な実行例を示します。
* (divisor-sum 24) 60 * (divisor-sum 12345678) 27319968 * (divisor-sum 1234567890) 3211610688 * (divisor-sum 1111111111) 1246404096
p が素数の場合、\(p^a\) の約数は次のように簡単に求めることができます。
n の素因数分解が pa * qb だったとすると、その約数は次のようになります。
たとえば、12 の約数は 24 = (1, 2, 4) と 3 = (1, 3) から、(1, 2, 4) * 1 と (1, 2, 4) * 3 のすべての要素 (1, 2, 4, 3, 6, 12) になります。
プログラムは次のようになります。
リスト : 約数をすべて求める
;;; XS と YS の直積集合で、要素の積を求める
(defun product (xs ys)
(loop for x in xs
nconc (loop for y in ys collect (* x y))))
;;; pq の約数を求める
(defun divisor-sub (p q)
(loop for i from 0 to q collect (expt p i)))
;;; 約数を求める
(defun divisor (n)
(loop for (p q) in (factorization n)
for zs = (divisor-sub p q)
then (product zs (divisor-sub p q))
finally (return (sort zs #'<))))
関数 product は引数 XS と YS の直積集合を求めます。このとき、要素同士を掛け算します。関数 divisor-sub は \(p^q\) の約数をリストに格納して返します。関数 divisor は引数 N を factorization で素因数分解し、divisor-sub で \(p^q\) の約数を求めて変数 ZS にセットします。あとは繰り返すごとに ZS と (divisor-sub p q) を product で掛け合わせていくだけです。
簡単な実行例を示します。
* (divisor 24) (1 2 3 4 6 8 12 24) * (divisor 12345678) (1 2 3 6 9 18 47 94 141 282 423 846 14593 29186 43779 87558 131337 262674 685871 1371742 2057613 4115226 6172839 12345678) * (divisor 1234567890) (1 2 3 5 6 9 10 15 18 30 45 90 3607 3803 7214 7606 10821 11409 18035 19015 21642 22818 32463 34227 36070 38030 54105 57045 64926 68454 108210 114090 162315 171135 324630 342270 13717421 27434842 41152263 68587105 82304526 123456789 137174210 205761315 246913578 411522630 617283945 1234567890) * (divisor 1111111111) (1 11 41 271 451 2981 9091 11111 100001 122221 372731 2463661 4100041 27100271 101010101 1111111111)
今回は文字と文字列を操作する関数について簡単に説明します。
述語 characterp はデータが文字型 (character) であるかどうか判定します。
characterp obj
引数 obj が文字型であれば T を、そうでなければ NIL を返します。
Common Lisp には文字種別を判定するために以下の述語が用意されています。
| 関数名 | 機能 |
|---|---|
| standard-char-p char | 引数 char が標準文字であれば真を返す |
| graphic-char-p char | 引数 char が「図形 (表示)」であれば真を返す |
| alpha-char-p char | 引数 char がアルファベットならば真を返す |
| upper-case-p char | 引数 char が英大文字ならば真を返す |
| lower-case-p char | 引数 char が英小文字ならば真を返す |
| both-case-p char | 引数 char に対応する大文字 (または小文字) があれば真を返す |
| digit-char-p char [radix] | 引数 char が数字であれば非負の整数を返し、そうでなければ偽を返す |
| alphanumricp char | 引数 char が英数字であれば心を返す |
標準文字は ASCII コードでいうと #x20 から #x7e までの文字と改行文字 (#\Newline) のことです。図形文字は、簡単に言うと画面に表示できる文字のことです。Common Lisp の場合、空白文字 (ASCII コードで #x20) も図形文字になるので注意してください。
digit-char-p は基数 radix を指定することができます。引数 char が数字の場合は、その基数における重み (非負の整数) を返します。簡単な使用例を示しましょう。
* (digit-char-p #\0) 0 * (digit-char-p #\9) 9 * (digit-char-p #\a) NIL * (digit-char-p #\a 16) 10 * (digit-char-p #\F 16) 15
Common Lisp には文字を比較する述語が用意されています。
char= char ... char/= char ... char< char ... char> char ... char<= char ... char>= char ...
これらの関数は複数の文字を比較します。このとき英大小文字の区別をします。条件を満たせば真を返し、そうでなければ NIL を返します。条件はそれぞれ、等しい、等しくない、小さい、大きい、小さいか等しい、大きいか等しいです。英大小文字を区別しないで比較する場合は、次の関数を使います。
char-equal char ... char-not-equal char ... char-lessp char ... char-greaterp char ... char-not-greaterp char ... char-not-lessp char ...
簡単な使用例を示しましょう。
* (char= #\a #\a) T * (char= #\a #\A) NIL * (char-equal #\a #\A) T * (char< #\a #\A) NIL * (char< #\A #\a) T * (char-greaterp #\A #\a) NIL * (char-greaterp #\a #\A) NIL
関数 character は引数 obj を可能であれば文字に変換します。
* (character "1") #\1 * (character "a") #\a
関数 char-upcase と char-downcase は引数の文字を英大文字 (英小文字) に変換します。
* (char-upcase #\a) #\A * (char-upcase #\1) #\1 * (char-downcase #\A) #\a * (char-downcase #\1) #\1
関数 digit-char weight [radix] は基数 radix における重み weigth に対応する文字を返します。
* (digit-char 0) #\0 * (digit-char 9) #\9 * (digit-char 15) NIL * (digit-char 15 16) #\F
関数 char-int char は引数の文字 char を非負の整数に変換します。
* (char-int #\a) 97 * (char-int #\A) 65 * (char-int #\ ) 32 * (char-int #\Newline) 10
Common Lisp には文字列を比較する述語が用意されています。
string= string1 string2 string< string1 string2 string> string1 string2 string<= string1 string2 string>= string1 string2 string/= string1 string2
これらの関数は 2 つの文字列を比較します。このとき英大小文字の区別をします。条件を満たせば真を返し、そうでなければ NIL を返します。条件はそれぞれ、string1 が string2 と等しい、小さい、大きい、小さいか等しい、大きいか等しい、等しくないです。簡単な例を示します。
* (string= "abcd" "abcd") T * (string= "abcd" "ABCD") NIL * (string< "abcd" "efgh") 0 * (string< "abc" "ABCDE") NIL
string= 以外の関数は、条件を満たすと T を返すのではなく、条件を満たすことがわかる最初の文字の位置 (添字) を返します。たとえば、(string< "abcd" "efgh") は最初の文字 #\a と #\e の比較で条件 "abcd" < "efgh" を満たすことがわかるので、返り値は 0 になります。
英大小文字を区別しないで比較する場合は、次の関数を使います。
string-equal string1 string2 string-lessp string1 string2 string-greaterp string1 string2 string-not-greaterp string1 string2 string-not-lessp string1 string2 string-not-equal string1 string2
2 つの文字列を英大小文字の区別をしないで比較し、条件を満たせば真を返します。そうでなければ NIL を返します。条件はそれぞれ、string1 が string2 と等しい、小さい、大きい、小さいか等しい、大きいか等しい、等しくないです。簡単な例を示します。
* (string-equal "ABCD" "abcd") T * (string-equal "ABCD" "ABCD") T
これらの関数は、キーワード :start1, :end1, :start2, :end2 を指定することができます。:start1 と :end1 は引数 string1 の範囲、:start2 と :end2 は引数 string2 の範囲を表します。また、引数にシンボルを与えると、シンボルを文字列に変換してから比較を行います。次の例を見てください。
* (string= 'abc "abc") T * (string-equal 'abc "ABC") T
文字列は関数 make-string で作成することができます。
make-string size &key :initial-element
* (make-string 10 :initial-element #\a) "aaaaaaaaaa"
関数 string-upcase は英小文字を英大文字に、string-downcase は英大文字を英小文字に変換します。
* (string-upcase "abcdefg") "ABCDEFG" * (string-downcase "ABCDEFG") "abcdefg"
関数 string-capitalize は文字列の中の単語において、先頭文字を英大文字に、残りの文字を英小文字に変換します。
* (string-capitalize "hello, world") "Hello, World" * (string-capitalize "hELLO, wORLD") "Hello, World"
これらの関数は、キーワード :start, :end で範囲を指定することができます。なお、引数の文字列を破壊的に修正する関数 nstring-upcase, nstring-downcase, nstring-caaptialize も用意されています。
関数 string-trime, string-left-trim, string-right-trime は文字列の先頭 (left) あるいは末尾 (right) から指定した文字を削除します。
string-trim chars string string-left-trim chars string string-right-trim chars string
引数 chars は削除する文字を格納したリストです。
* (string-trim '(#\Space) " hello, world ") "hello, world" * (string-left-trim '(#\Space #\h) " hello, world ") "ello, world " * (string-right-trim '(#\Space #\d) " hello, world ") " hello, worl"
関数 string は引数が文字列ならば、それを返します。シンボルならば印字名を返します。
* (string "a") "a" * (string 'a) "A"