Lisp 系の言語で繰り返しといえば、Scheme では named-let などの再帰定義、Common Lisp では dotimes, dolist, do やループマクロでしょうか。もちろん、Scheme の規格 R7RS にも do は規定されていますが、Common Lisp よりも使う機会は少ないように思います。今回は繰り返しにおける Common Lisp と Scheme の違いについて簡単に説明します。
Common Lisp には do と do* という繰り返しを行うためのマクロがあります。do と do* の違いは変数の初期化と更新処理を並列に行うか逐次的に行うかだけで、let と let* の違いとよく似ています。簡単な例を示しましょう。使用する処理系は SBCL (ver 2.0.1) です。
* (let ((x 0)) (do ((x 1 (1+ x)) (y x x)) ((< 5 x)) (print (list x y)))) (1 0) (2 1) (3 2) (4 3) (5 4) NIL * (let ((x 0)) (do* ((x 1 (1+ x)) (y x x)) ((< 5 x)) (print (list x y)))) ; ; ワーニング (省略) ; (1 1) (2 2) (3 3) (4 4) (5 5) NIL
do の場合、y の初期値は let で定義した x の値 0 になります。これに対し、do* の場合は do* で定義した x の初期値 1 が y の初期値になります。更新処理も同様です。do の場合、y の値は更新前の x の値となり、do* の場合は更新後の x の値となります。
これらのプログラムは下記のプログラムと同じ動作になります。
* (let ((x 0))
(let ((x 1) (y x))
(block nil
(tagbody loop
(if (< 5 x) (return))
(print (list x y))
(psetq x (1+ x) y x)
(go loop)))))
(1 0)
(2 1)
(3 2)
(4 3)
(5 4)
NIL
* (let ((x 0))
(let* ((x 1) (y x))
(block nil
(tagbody loop
(if (< 5 x) (return))
(print (list x y))
(setq x (1+ x) y x)
(go loop)))))
;
; ワーニング (省略)
;
(1 1)
(2 2)
(3 3)
(4 4)
(5 5)
NIL
do は let で変数の初期化を行い、psetq で変数の更新処理を行いますが、do* の場合は let* と setq で行うわけです。ここで psetq と psetf を簡単に説明しておきましょう。
Common Lisp の場合、代入を並行に行うマクロ psetq や psetf を使うと、テンポラリ変数を使わなくても値を交換することができます。
psetq symbol1 value1 symbol2 value2 ...
psetq はシンボル symbol1 に value1 を評価した結果を代入し、symbol2 に value2 を評価した結果を代入する、というように値を順番に代入します。このとき、psetq は setq と違って代入した値の影響をうけません。簡単な例を示します。
(setq x 100 y 200) => 200 x => 100 y => 200 (psetq x y y x) => nil x => 200 y => 100
psetq で x に y の値 200 を代入し、そのあとで x の値を y に代入しています。このとき x の値は 200 ではなく、代入される前の値 100 のままなのです。したがって、y に代入される値は 100 になります。
psetf は setf と同様に指定された場所へ値を代入しますが、setf と違って代入した値の影響をうけません。psetf は nil を返します。簡単な例を示します。
(setq board '(1 2 3 4)) => (1 2 3 4)
(psetf (nth 0 board) (nth 3 board)
(nth 3 board) (nth 0 board)) => nil
board => (4 2 3 1)
このように、psetq や psetf を使うと簡単に値を交換することができます。
Scheme の場合、Common Lisp の go のようなジャンプ命令がないので、do は letrec を使って定義するのが一般的です。簡単な例を示しましょう。使用する処理系は Gauche (ver 0.9.10) です。
gosh[r7rs.user]> (let ((x 0)) (do ((x 1 (+ x 1)) (y x x)) ((< 5 x)) (display (list x y))))
(1 0)(2 1)(3 2)(4 3)(5 4)#t
gosh[r7rs.user]> (let ((x 0))
(letrec ((iter (lambda (x y)
(cond ((>= 5 x)
(display (list x y))
(iter (+ x 1) x))))))
(iter 1 x)))
(1 0)(2 1)(3 2)(4 3)(5 4)#<undef>
Scheme の規格 R7RS に do* はありませんが、let* を使って同様な動作を行わせることは可能です。次のリストを見てください。
リスト : do* と同様の動作をするプログラム
(let ((x 0))
(letrec ((iter (lambda (x y)
(cond ((>= 5 x)
(display (list x y))
(let* ((x (+ x 1)) (y x))
(iter x y)))))))
(let* ((x 1) (y x))
(iter x y))))
let* で逐次的に変数の値を書き換えて、それを局所関数 iter に渡します。実行例を示します。
gosh[r7rs.user]> (let ((x 0))
(letrec ((iter (lambda (x y)
(cond ((>= 5 x)
(display (list x y))
(let* ((x (+ x 1)) (y x))
(iter x y)))))))
(let* ((x 1) (y x))
(iter x y))))
(1 1)(2 2)(3 3)(4 4)(5 5)#<undef>
今回は let* を使いましたが、set! で変数の値を破壊的に書き換えても同様の動作を実現することができます。
ところで、参考 URL 『Island Life - 関数型言語で for 文が無いのは』と『Scheme:generatorとdoとwhile』によると、Common Lisp の do は変数の値を破壊的に書き換えるため、Scheme の do と動作が異なる場合があるとのことです。簡単な例を示しましょう。
gosh[r7rs.user]> (map (lambda (x) (x)) (do ((i 0 (+ i 1)) (a '())) ((< 4 i) a) (set! a (cons (lambda () i) a)))) (4 3 2 1 0)
do の本体でクロージャ (lambda () i) を生成してリストに格納します。Scheme の場合、do は再帰で実装されているので、繰り返すたびに変数 i の環境は新しく生成され、それがクロージャに保存されます。したがって、map でクロージャを評価すると (4 3 2 1 0) となります。
Common Lisp (SBCL) の場合は次のようになります。
* (mapcar #'(lambda (x) (funcall x)) (do ((i 0 (1+ i)) (a nil)) ((< 4 i) a) (push #'(lambda () i) a))) (5 5 5 5 5)
Common Lisp の do は変数 i の環境を 1 回だけ生成し、繰り返しのたびに i の値を破壊的に書き換えています。この場合、クロージャに保存される環境はみな同じものであり、その値を破壊的に書き換えているので、mapcar でクロージャを評価するとすべて同じ値 (5) になるわけです。ちなみに、SBCL は dotimes でも同じ結果になります。
* (let ((a nil)) (mapcar #'(lambda (x) (funcall x)) (dotimes (i 5 a) (push #'(lambda () i) a)))) (5 5 5 5 5) * (let ((a nil)) (mapcar #'(lambda (x) (funcall x)) (dolist (i '(1 2 3 4 5) a) (push #'(lambda () i) a)))) (5 4 3 2 1)
CLISP の場合、dolist も同じに結果になります。
> (let ((a nil)) (mapcar #'(lambda (x) (funcall x)) (dotimes (i 5 a) (push #'(lambda () i) a)))) (5 5 5 5 5) > (let ((a nil)) (mapcar #'(lambda (x) (funcall x)) (dolist (i '(1 2 3 4 5) a) (push #'(lambda () i) a)))) (5 5 5 5 5)
SBCL と CLISP では dolist の実装方法が異なっていると思われます。Common Lisp で繰り返し (do, do*, dotimes, dolist など) とクロージャを組み合わせて使う場合はご注意くださいませ。
それでは簡単な例題として、リストの総和を求める関数 sum-list を Common Lisp と Scheme で作ってみましょう。
リスト : 総和を求める
;;; Common Lisp 版
(defun sum-list (xs)
(do ((xs xs (cdr xs))
(a 0 (+ a (car xs))))
((null xs) a)))
;;; Scheme 版
(define (sum-list xs)
(let loop ((xs xs) (a 0))
(if (null? xs)
a
(loop (cdr xs) (+ a (car xs))))))
gosh[r7rs.user]> (sum-list '(1 2 3 4 5)) 15
* (sum-list '(1 2 3 4 5)) 15
apply (apply + xs, apply #'+ xs) や畳み込み (fold や reduce など) を使ったほうが簡単ですが、あえて繰り返しでプログラムしています。ここで仕様を変更して、負の要素があったら -1 を返すことにしましょう。Scheme 版は末尾再帰なので、簡単にプログラムすることができます。
リスト : 総和 (Scheme)
(define (sum-list1 xs)
(let loop ((xs xs) (a 0))
(cond ((null? xs) a)
((negative? (car xs)) -1)
(else (loop (cdr xs) (+ a (car xs)))))))
gosh[r7rs.user]> (sum-list1 '(1 2 3 -4 5)) -1
negative? でリストの要素 (car xs) が負かチェックして、そうであれば loop を再帰呼び出しせずに -1 を返すだけです。
Common Lisp で繰り返しから脱出する場合は return を使うと簡単です。
リスト : 総和 (Common Lisp)
(defun sum-list1 (xs)
(do ((xs xs (cdr xs))
(a 0 (+ a (car xs))))
((null xs) a)
(if (minusp (car xs))
(return -1))))
* (sum-list1 '(1 2 3 -4 5)) -1
Common Lisp の場合、do, dotimes, dolist などの本体は暗黙の block (タグは nil) に囲まれていて、return や return-from nil で繰り返しから脱出することができます。リストの要素 (car xs) が負ならば、(return -1) を評価して、繰り返しから脱出します。この場合、do の返り値は return の引数 (-1) になります。
次は、リストのリストを行列とみなして、行列の要素の総和を求める関数 sum-matrix を定義しましょう。sum-matrix は負の要素を見つけたら -1 を返します。
リスト : 行列の総和
;;; Scheme 版
(define (sum-matrix xs)
(let loop1 ((xs xs) (a 0))
(if (null? xs)
a
(let loop2 ((ys (car xs)) (b 0))
(cond ((null? ys)
(loop1 (cdr xs) (+ a b)))
((negative? (car ys)) -1)
(else (loop2 (cdr ys) (+ b (car ys)))))))))
;;; Common Lisp 版
(defun sum-matrix (xs)
(do ((xs xs (cdr xs))
(a 0))
((null xs) a)
(do ((ys (car xs) (cdr ys)))
((null ys))
(if (minusp (car ys))
(return-from sum-matrix -1)
(incf a (car ys))))))
gosh[r7rs.user]> (sum-matrix '((1 2 3) (4 5 6))) 21 gosh[r7rs.user]> (sum-matrix '((1 2 3) (4 -5 6))) -1
* (sum-matrix '((1 2 3) (4 5 6))) 21 * (sum-matrix '((1 2 3) (4 5 -6))) -1
Scheme 版は name-let で二重ループを実現しています。負の要素を見つけたら loop1 や loop2 を再帰呼び出しせずに -1 を返すだけです。Common Lisp の場合、関数の本体は暗黙の block (タグは関数名) で囲まれているので、(return-from sum-matix -1) を評価すれば二重ループを脱出して -1 を返すことができます。
Common Lisp の場合、block のタグはレキシカルスコープです。高階関数から return-from で脱出することができます。次のリストを見てください。
リスト : リストの総和
;;; Common Lisp 版
(defun sum-list11 (xs)
(reduce #'(lambda (a x)
(if (minusp x)
(return-from sum-list11 -1)
(+ a x)))
xs
:initial-value 0))
* (sum-list11 '(1 2 3 4 5 6)) 21 * (sum-list11 '(-1 2 3 4 5 6)) -1 * (sum-list11 '(1 2 3 4 5 -6)) -1
畳み込みを行う関数 reduce に渡すラムダ式の中で、要素 x が負ならば return-from で -1 を返します。タグ sum-list11 はレキシカルスコープなので、ラムダ式の中から参照することができ、return-from でそのブロックから脱出することができます。
また、return-from tag をラムダ式に包んで他の関数に渡すこともできます。この場合、渡されたラムダ式を実行すると、tag で指定した block から脱出することができるのです。次のリストを見てください。
リスト : 行列の総和
;;; Common Lisp 版
(defun sum-list2 (failure xs)
(do ((xs xs (cdr xs))
(a 0 (+ a (car xs))))
((null xs) a)
(if (minusp (car xs))
(funcall failure))))
(defun sum-matrix1 (xs)
(do ((xs xs (cdr xs))
(a 0 (+ a (sum-list2 #'(lambda () (return-from sum-matrix1 -1))
(car xs)))))
((null xs) a)))
* (sum-matrix1 '((1 2 3) (4 5 6) (7 8 9))) 45 * (sum-matrix1 '((1 2 3) (4 5 6) (-7 8 9))) -1
sum-matrix1 は行列 xs から 1 行ずつ取り出して sum-list2 に渡します。このとき、(return-from sum-matrix1 -1) を包んだラムダ式もいっしょに渡します。Common Lisp はレキシカルスコープなので、ラムダ式の中からタグ sum-matrix1 を参照することができます。
次に、sum-list2 でリストの要素が負の場合、渡されたラムダ式 failure を評価します。すると、制御は sum-matrix1 に戻って -1 を返すことができます。
この動作は Scheme の継続 (call/cc) による大域脱出とよく似ています。Scheme で同様のプログラムを作ると次のようになります。
リスト : 行列の総和 (Scheme)
(define (sum-list2 failure xs)
(let loop ((xs xs) (a 0))
(cond ((null? xs) a)
((negative? (car xs)) (failure -1))
(else (loop (cdr xs) (+ a (car xs)))))))
(define (sum-matrix1 xs)
(call/cc
(lambda (bk)
(let loop ((xs xs) (a 0))
(if (null? xs)
a
(loop (cdr xs) (+ a (sum-list2 bk (car xs)))))))))
gosh[r7rs.user]> (sum-matrix1 '((1 2 3) (4 5 6) (7 8 9))) 45 gosh[r7rs.user]> (sum-matrix1 '((1 2 3) (4 5 6) (7 -8 9))) -1
call/cc で継続を取り出して変数 bk にセットし、それを sum-list2 に渡します。sum-list2 では、要素が負であれば継続 failure を評価して -1 を返します。
Common Lisp と ISLisp は、catch, throw による例外処理をサポートしているので、block とラムダ式を使って大域脱出をプログラムすることはないでしょうが、高階関数などで処理を中断させたい場合、この方法を使うことができます。
Common Lisp では block のタグをレキシカルスコープで管理しますが、同様に tagbody と go のタグ (ジャンプ先) もレキシカルスコープで管理します。go をラムダ式に包んで他の関数に渡すこともでき、そのラムダ式を評価するとそのタグにジャンプすることができます。
簡単な例を示しましょう。
* (defun foo (x) (tagbody (let ((f #'(lambda () (go exit)))) (funcall x f) (print 1)) exit (print 2))) FOO * (foo #'(lambda (f) (funcall f))) 2 NIL * (foo #'(lambda (f) f)) 1 2 NIL
関数 foo の引数 x は関数で、その引数に go exit を包んだラムダ式を渡します。foo に渡す関数の中で引数 f を評価すると、go exit が実行されるので、tagbody のタグ exit に制御が移ります。したがって、(funcall x f) のあとの (print 1) は実行されません。
引数 f を評価しない場合、(print 1) が実行されて、そのあとに (print 2) が実行されます。なお、普通のプログラムで tagbody と go を使うことは滅多にありません。ましてや、このような使い方をすることはまずないと思います。tagbody と go を安易に使用してはいけません。くれぐれもご注意くださいませ。
ANSI Common Lisp は標準で「分数 (fraction)」を扱うことができます。整数と分数を合わせて「有理数 (rational number)」といいます。今回は分数の基本をおさらいし、分数に関する簡単なプログラムを Common Lisp で作ってみましょう。
Common Lisp の場合、分数は 2 つの整数を / で区切って表します。簡単な例を示します。
1/2, 2/3, 4/3, 11/13, -51/100, 30517578125/32768
また、4/6 や 3/12 のような入力もできますが、この場合は約分されることになります。とくに、4/2 のような割り切れる分数は、ただちに整数に変換されます。また、関数 / でも分数を生成することができます。整数同士の割り算で割り切れない場合は分数になります。引数が 0 の場合はエラーになります。
有理数 (整数と分数) は、型述語 rationalp で判定することができます。
rationalp number
rationalp は引数 number が有理数であれば真 (t) を、そうでなければ偽 (nil) を返します。
分数の分子は関数 numerator で、分母は関数 denominator で取得することができます。
numerator ratio denominator ratio
引数 ratio が有理数型でなければ例外を送出します。ratio が整数の場合、denominator の返り値は 1 になります。
簡単な例を示しましょう。
4/6 => 2/3 3/12 => 1/4 10/5 => 2 ; 整数に変換される (/ 2) => 1/2 ; 引数の逆数を求める (/ 8 4 2) => 1 ; 約分されて整数になる (/) => エラー (rationalp 1/2) => T (rationalp 0.5) => NIL (rationalp 1) => T (numerator 1/2) => 1 (denominator 1/2) => 2 (numerator -1/2) => -1 (denominator -1/2) => 2
ANSI Common Lisp の場合、分子は整数、分母は正の整数になります。符号は分子に付くことに注意してください。
分数は関数 float で実数 (浮動小数点数) に変換することができます。分数や浮動小数点数を整数に変換するには、関数 floor, ceiling, truncate, round を使います。詳しい説明は拙作のページ Common Lisp 入門: 「数と算術演算」をお読みください。
複素数以外の任意の数を有理数に変換するには以下の関数を使います。
rational number rationalize number
これらの関数は、引数 number が有理数であれば、それをそのまま返します。number が浮動小数点数 (規格 IEEE 754) の場合、number は不正確な数なので、正確に分数に変換できるとは限りません。rational は number が正確な値であることを前提として、その値と等しい有理数を返します。rationalize は number に最もよく近似している有理数を返します。
たとえば、0.5 は浮動小数点数でも正確に表すことができるので、どちらの関数でも 1/2 を返します。
* (rational 0.5) 1/2 * (rationalize 0.5) 1/2
ところが、1.1 は IEEE 754 で正確に表すことができません。1.1 の近似値になります。rational はその値を有理数に変換して返します。rationalize は、分子と分母の値が小さくなるように変換して返します。
* (rational 1.1) 9227469/8388608 * (rationalize 1.1) 11/10 * (rational 1.1d0) 2476979795053773/2251799813685248 * (rationalize 1.1d0) 11/10 * (rational 1.23456789d0) 5559999489367579/4503599627370496 * (rationalize 1.23456789d0) 123456789/100000000
一般に、rational は単純なアルゴリズムで実装できますが、rationalize のアルゴリズはちょっと複雑になります。その分だけ raitonalize の処理は rational よりも重くなると思われます。まあ、現在のパソコンは高性能なので、気にすることはないのかもしれません。
次は、分数を小数に直すことを考えてみましょう。1/2, 1/5, 1/8, 1/10 などは 0.5, 0.2, 0.125, 0.1 のように途中で割り切れて、有限な桁で表すことができます。これを「有限小数」といいます。ところが、1/3, 1/6, 1/7 は、次のように有限な桁では表すことができません。
1/3 は 3 を無限に繰り返し、1/6 は 0.1 のあと 6 を無限に繰り返し、1/7 は数列 142857 を無限に繰り返します。このような少数を「循環小数 (repeating decimal)」といい、繰り返される数字の列を「循環節」といいます。有理数を小数に直すと、有限小数か循環小数のどちらかになります。
循環小数は次のように循環節の始めと終わりを点で示します。
このほかに、循環節に下線を引いたり、カッコで囲む表記法もあります。
分数を循環小数に直すのは簡単です。筆算と同じように計算していくだけです。次の図を見てください。
0 1 4 2 8 5 7
----------------
7 ) 1
0
-----
1 0 <-- 余り 1
7
-------
3 0
2 8
-------
2 0
1 4
-------
6 0
5 6
-------
4 0
3 5
-------
5 0
4 9
-----
1 <-- 余り 1
7 で割った余り 1 が 2 回現れていますね。これから先は同じ数列を繰り返すことがわかります。7 の剰余は 0 から 6 まであり、剰余が 0 の場合は割り切れるので循環小数にはなりません。現れる余りの数が限られているので、割り切れなければ循環することになるわけです。また、このことから循環節の長さは分母の値よりも小さいことがわかります。
それではプログラムを作ってみましょう。
リスト : 循環小数を求める
(defun repeat-decimal (x)
(unless (rationalp x)
(error "must be rational number"))
(do ((m (numerator x))
(n (denominator x))
(xs nil) (ys nil))
(nil)
(multiple-value-bind
(p q)
(floor m n)
(cond
((zerop q)
(push p ys)
(return (list (nreverse ys) '(0))))
(t
(push p ys)
(let ((i (position q xs)))
(when (and i (>= i 0))
(return (list (nreverse (subseq ys (1+ i)))
(nreverse (subseq ys 0 (1+ i))))))
(push q xs)
(setq m (* q 10))))))))
関数 repeat-decmal は引数 x を循環小数に変換します。返り値は 2 つのリストを格納したリストで、先頭のリストが冒頭の小数部分を、次のリストが循環節の部分を表します。途中で割り切れる場合は循環節を (0) とします。これ以降、冒頭の小数部分を有限小数部分と記述することにします。
変数 xs が余りを格納するリスト、変数 ys が商を格納するリストです。最初に変数 m と n に x の分子と分母をセットし、その商と余りを計算して、変数 p と q にセットします。q が 0 ならば割り切れたので有限小数です。p を push で ys に追加して、それを反転したリストと (0) をリストに格納して返します。
割り切れない場合、p を push で ys に追加します。それから、余り q が xs にあるか関数 position でチェックして、その位置を変数 i にセットします。同じ値を見つけた場合、ys の i + 1 番目から末尾までの要素が有限小数部分で、0 から i 番目が循環部になります。ys を 2 つに分けて nreverse で反転して返します。見つからない場合は q を push で xs に追加して、m の値を q * 10 に更新してから割り算を続行します。
それでは実行してみましょう。
* (dolist (x '(2 3 4 5 6 7 8 9 10 11)) (print (repeat-decimal (/ x)))) ((0 5) (0)) ((0) (3)) ((0 2 5) (0)) ((0 2) (0)) ((0 1) (6)) ((0) (1 4 2 8 5 7)) ((0 1 2 5) (0)) ((0) (1)) ((0 1) (0)) ((0) (0 9)) NIL * (repeat-decimal 355/113) ((3) (1 4 1 5 9 2 9 2 0 3 5 3 9 8 2 3 0 0 8 8 4 9 5 5 7 5 2 2 1 2 3 8 9 3 8 0 5 3 0 9 7 3 4 5 1 3 2 7 4 3 3 6 2 8 3 1 8 5 8 4 0 7 0 7 9 6 4 6 0 1 7 6 9 9 1 1 5 0 4 4 2 4 7 7 8 7 6 1 0 6 1 9 4 6 9 0 2 6 5 4 8 6 7 2 5 6 6 3 7 1 6 8))
正常に動作していますね。
循環小数を分数に直すことも簡単にできます。循環小数 - Wikipedia によると、有限小数部分を a、循環節の小数表記を b、節の長さを n とすると、循環小数 x は次の式で表すことができる、とのことです。
ここで、カッコの中は初項 1, 公比 \(\frac{1}{10^n}\) の無限等比級数になるので、その和は次の公式より求めることができます。
簡単な例を示しましょう。
プログラムを作る場合、次のように考えると簡単です。
有限小数部分を表すリストを xs とすると
有限小数部分 = p0 / q0
ただし p0 = xs を整数に変換
q0 = 10 ^ (xsの長さ - 1)
循環節を表すリストを ys とすると
循環節 = p1 / q1
ただし p1 = ys を整数に変換
q1 = 10 ^ ysの長さ - 1
p0 p1 p0 * q1 + p1
循環小数 = ---- + --------- = --------------
q0 q0 * q1 q0 * q1
冒頭の有限小数部分を分数に変換するのは簡単ですね。先頭が整数部分になるので、小数部分の桁はリスト xs の長さ - 1 になります。循環節だけを分数に変換する場合、たとえば 1/7 の循環節は (1 4 2 8 5 7) になりますが、分子 p' は \(0.142857 \times 10^6 = 142857\) となるので、循環節を表すリストを整数に変換するだけでよいことがわかります。有限小数部分がある場合は、その桁数だけ循環節の部分を右シフトすればよいので、p1/q1 に 1/q0 を掛けるだけです。
これをプログラムすると、次のようになります。
リスト : 循環小数を分数に直す
(defun from-repeat-decimal (xs ys)
(let ((p0 (reduce (lambda (a x) (+ (* a 10) x)) xs :initial-value 0))
(q0 (expt 10 (1- (length xs))))
(p1 (reduce (lambda (a x) (+ (* a 10) x)) ys :initial-value 0))
(q1 (1- (expt 10 (length ys)))))
(/ (+ (* q1 p0) p1) (* q0 q1))))
アルゴリズムをそのままプログラムしただけなので、とくに難しいところは無いと思います。
それでは実行してみましょう。
* (dolist (x '(2 3 4 5 6 7 8 9 10 11)) (print (apply #'from-repeat-decimal (repeat-decimal (/ x))))) 1/2 1/3 1/4 1/5 1/6 1/7 1/8 1/9 1/10 1/11 NIL * (apply #' from-repeat-decimal (repeat-decimal 355/113)) 355/113
正常に動作していますね。
分子が 1 の分数を「単位分数」といいます。単位分数 1 / d のなかで、循環節が一番長くなる d を求めるプログラムを作ってみましょう。
repeat-decamil を使って単純にプログラムを作ると次のようになります。
リスト : 循環節が一番長い 1 / d を求める
(defun solver (d)
(do ((k 0)
(m 0)
(d d (1- d)))
((>= k d) (list m k))
(let* ((xs (repeat-decimal (/ d)))
(l (length (second xs))))
(when (> l k)
(setf k l m d)))))
変数 k に循環節の長さの最大値、変数 m にそのときの分母の値 d を保存します。循環節の長さは分母 d よりも小さいので、d の大きな値から循環節の長さを調べていき、d が k 以下になったら、処理を終了して m, k の値を返します。
実行結果は次のようになりました。
(time (solver 10000)) Evaluation took: 0.799 seconds of real time 0.796553 seconds of total run time (0.796553 user, 0.000000 system) 99.75% CPU 1,911,705,861 processor cycles 2,326,528 bytes consed (9967 9966) (time (solver 20000)) Evaluation took: 1.980 seconds of real time 1.977863 seconds of total run time (1.977863 user, 0.000000 system) 99.90% CPU 4,746,873,370 processor cycles 1,490,944 bytes consed (19993 19992) (time (solver 40000)) Evaluation took: 7.620 seconds of real time 7.614418 seconds of total run time (7.614418 user, 0.000000 system) 99.92% CPU 18,275,209,839 processor cycles 3,260,416 bytes consed (39989 39988) 実行環境 : Ubuntu 22.04 LTS (WSL2), Intel Core i5-6200U 2.30GHz
プログラムは簡単ですが、d が大きくなると時間がかかるようになります。循環節の長さを求めるだけでよければ、repeat-decamil を使うよりも高速な方法があります。
今回は小数を 10 進数で表記しているので、d を素因数分解して 2 と 5 の因子しかない場合、1 / d は有限小数になります。d が 2 と 5 の因子を含んでいない場合は循環節だけになります。それ以外の場合は 有限小数 + 循環小数 の形になります。
簡単な例を示しましょう。
1 / 7 => ([0], [1, 4, 2, 8, 5, 7]) 1 / 14 => ([0, 0], [7, 1, 4, 2, 8, 5]) 1 / 21 => ([0], [0, 4, 7, 6, 1, 9]) 1 / 28 => ([0, 0, 3], [5, 7, 1, 4, 2, 8]) 1 / 35 => ([0, 0], [2, 8, 5, 7, 1, 4]) 1 / 49 => ([0], [0, 2, 0, 4, 0, 8, 1, 6, 3, 2, 6, 5, 3, 0, 6, 1, 2, 2, 4, 4, 8, 9, 7, 9, 5, 9, 1, 8, 3, 6, 7, 3, 4, 6, 9, 3, 8, 7, 7, 5, 5, 1]) 1 / 56 => ([0, 0, 1, 7], [8, 5, 7, 1, 4, 2]) 1 / 70 => ([0, 0], [1, 4, 2, 8, 5, 7])
このように、循環節の長さは 2 と 5 以外の因子により決定されます。d に 2 と 5 の因子が含まれていると、循環節の長さは d よりも小さな値になります。そして、1 / d が循環節だけの場合、その長さを n とすると次の式が成り立ちます。
上式は \(10^n\) を d で割った余りが 1 のとき、循環節の長さが n になることを表しています。この式は簡単に求めることができます。
たとえば、1 / d = 0.(xs)(xs)(xs) ... としましょう。xs は長さ n の循環節を表します。両辺を \(10^n\) して、両辺から 1 / d を引くと次のようになります。
1 / d = 0.(xs)(xs)(xs) ... 10n / d = (xs).(xs)(xs) ... 10n / d - 1 / d = (xs).(xs)(xs) ... - 0.(xs)(xs) ... (10n - 1) / d = xs
10n - 1 は d で割り切れるので、10n を d で割れば 1 余るわけです。簡単な例を示しましょう。
1 / 7 => ([0], [1, 4, 2, 8, 5, 7]) (10 ** 1) % 7 = 3 (10 ** 2) % 7 = 2 (10 ** 3) % 7 = 6 (10 ** 4) % 7 = 4 (10 ** 5) % 7 = 5 (10 ** 6) % 7 = 1 1 / 31 => ([0], [0, 3, 2, 2, 5, 8, 0, 6, 4, 5, 1, 6, 1, 2, 9]) (10 ** 1) % 31 = 10 (10 ** 2) % 31 = 7 (10 ** 3) % 31 = 8 (10 ** 4) % 31 = 18 (10 ** 5) % 31 = 25 (10 ** 6) % 31 = 2 (10 ** 7) % 31 = 20 (10 ** 8) % 31 = 14 (10 ** 9) % 31 = 16 (10 ** 10) % 31 = 5 (10 ** 11) % 31 = 19 (10 ** 12) % 31 = 4 (10 ** 13) % 31 = 9 (10 ** 14) % 31 = 28 (10 ** 15) % 31 = 1
確かに \(10^n \equiv 1 \pmod d\) を満たす n が循環節の長さになっています。これをプログラムすると次のようになります。
リスト : 循環節が一番長い 1 / d を求める (2)
;;; 循環節の長さを求める
(defun repeat-length (d)
(do ((n 1 (1+ n))
(m (mod 10 d) (mod (* m 10) d)))
((= m 1) n)))
(defun solver1 (d)
(when (evenp d) (decf d))
(do ((k 0)
(m 0)
(d d (- d 2)))
((>= k d) (list m k))
(unless (zerop (mod d 5))
(let ((n (repeat-length d)))
(when (> n k)
(setf k n m d))))))
プログラムのポイントは循環節の長さを求める関数 repeat-length です。Common Lisp は多倍長整数をサポートしていますが、多倍長整数の計算には時間がかかるので、\(10^n \bmod d\) で余りを求めると、実行時間はかえって遅くなってしまいます。この場合、次に示す合同式の性質を使います。
\(10^k \bmod d\) の値を \(m^k\) とすると、\(10^{k+1} \bmod d\) の値は \((m^k \times 10) \bmod d\) で求めることができます。つまり、\(10^n\) を実際に計算しなくても、\(10^n \bmod d\) を求めることができるわけです。repeat-length は剰余 m が 1 になるまで、この処理を繰り返すだけです。
実行結果を示します。
(time (solver1 100000)) Evaluation took: 0.000 seconds of real time 0.005628 seconds of total run time (0.005628 user, 0.000000 system) 100.00% CPU 13,491,426 processor cycles 0 bytes consed (99989 99988) (time (solver1 200000)) Evaluation took: 0.020 seconds of real time 0.019731 seconds of total run time (0.019731 user, 0.000000 system) 100.00% CPU 47,332,693 processor cycles 0 bytes consed (199967 199966) (time (solver1 400000)) Evaluation took: 0.020 seconds of real time 0.013265 seconds of total run time (0.013265 user, 0.000000 system) 65.00% CPU 31,811,529 processor cycles 0 bytes consed (399989 399988)
とても速くなりましたね。