M.Hiroi's Home Page

Common Lisp Programming

お気楽 ISLisp プログラミング超入門

[ Home | Common Lisp | ISLisp ]

簡単なプログラム

●遅延評価

Scheme の delay と force は ISLisp でもマクロを使って簡単に実装することができます。次のリストを見てください。

リスト : delay と force

(defmacro delay (expr)
  `(make-promise (lambda () ,expr)))

(defun make-promise (f)
  (let ((flag nil) (result nil))
    (lambda ()
      (if (not flag)
        (let ((x (funcall f)))
          (cond ((not flag)
                 (setq flag t)
                 (setq result x)))))
      result)))

(defun force (promise)
  (funcall promise))

delay と force は 参考文献 1 に掲載されているプログラムを ISLisp で書き直したものです。delay の引数 expr をクロージャに格納して関数 make-promis に渡します。make-promise はクロージャを生成して返します。このデータを Scheme では「プロミス」といいます。本稿では遅延オブジェクトと呼ぶことにします。force は簡単で、引数 promise を funcall で評価するだけです。

make-promise はクロージャを生成し、その中にクロージャ f の評価結果を格納します。flag が nil の場合は f を評価していないので、funcall で f を評価して、その返り値を result にセットし、flag の値を t に書き換えます。flag が t ならば f は評価済みなので result を返します。

簡単な使用例を示しましょう。

ISLisp>(defglobal a (delay (+ 10 20)))
A
ISLisp>a
#<UFUNCTION 0026DE36: #<LAMBDA>>
ISLisp>(force a)
30

(delay (+ 10 20)) の返り値を変数 a にセットします。このとき、S 式 (+ 10 20) は評価されていません。遅延オブジェクトの値を実際に求める関数が force です。(force a) を評価すると、S 式 (+ 10 20) を評価して値 30 を返します。

また、遅延オブジェクトは式の評価結果をキャッシュします。したがって、(force a) を再度実行すると、同じ式を再評価することなく値を求めることができます。次の例を見てください。

ISLisp>(defglobal b (delay (progn (write "oops!") (+ 10 20))))
B
ISLisp>(force b)
"oops!"30
ISLisp>(force b)
30

最初に (force b) を実行すると、S 式 (progn (write "oops!") (+ 10 20)) が評価されるので、画面に oops! が表示されます。次に、(force b) を実行すると、式を評価せずにキャッシュした値を返すので oops! は表示されません。

●参考文献

  1. R. Kent Dybvig (著), 村上雅章 (訳), 『プログラミング言語 SCHEME』, 株式会社ピアソン・エデュケーション, 2000

●遅延ストリーム

「ストリーム (stream)」はデータの流れを抽象化したデータ構造です。たとえば、ファイル入出力はストリームと考えることができます。また、リストを使ってストリームを表すこともできます。ただし、単純なリストでは有限個のデータの流れしか表すことができません。ところが、遅延評価を用いると擬似的に無限個のデータを表すことができるようになります。これを「遅延ストリーム」とか「遅延リスト」と呼びます。

●遅延ストリームの構造

遅延ストリームの基本的な考え方は、必要になったときに新しいデータを生成することです。このときに遅延評価を用います。具体的にはデータを生成する関数を用意し、それを遅延評価してストリームに格納しておきます。そして、必要になった時点で遅延評価しておいた関数を呼び出して値を求めればよいわけです。

今回は遅延ストリームをコンスセルで表すことにします。コンスセルの CAR が現時点での先頭データを表し、CDR が遅延ストリームを生成する関数を格納する遅延オブジェクトです。次のリストを見てください。

リスト : 遅延ストリーム

;; 遅延ストリームの生成
(defmacro stream-cons (a b)
  `(cons ,a (delay ,b)))

;; 要素を取り出す
(defun stream-car (s) (car s))

;; 次の要素を求める
(defun stream-cdr (s) (force (cdr s)))

マクロ stream-cons はコンスセルの CAR にストリームの要素 a を格納し、CDR に遅延オブジェクトを格納します。遅延オブジェクトにはストリームを生成する関数 b を格納します。遅延オブジェクトを force することで、次の要素を格納した遅延ストリームを生成します。ストリームの終端は nil で表すことにします。

関数 stream-car は遅延ストリーム s から要素を取り出して返します。関数 stream-cdr は s の遅延オブジェクトを force して、次の要素を格納した遅延ストリームを生成して返します。ようするに、これらのマクロと関数はリスト操作の cons, car, cdr に対応します。

●遅延ストリームの生成

それでは、遅延ストリームを生成する関数を作りましょう。たとえば、low から high までの整数列を生成するストリームは次のようにプログラムすることができます。

リスト : 整数列を生成するストリーム

(defun intgen (low high)
  (if (> low high)
      nil
    (stream-cons low (intgen (+ low 1) high))))

関数 intgen は遅延ストリームを生成して返します。stream-cons の第 1 引数が現時点でのデータになります。第 2 引数のプロミスを force すると、(intgen (+ low 1) high) が実行されて次のデータを格納した遅延ストリームが返されます。そして、その中の遅延オブジェクトを force すると、その次のデータを得ることができます。

簡単な実行例を示しましょう。

ISLisp>(defglobal s (intgen 1 4))
S
ISLisp>(stream-car s)
1
ISLisp>(setq s (stream-cdr s))
(2 . #<UFUNCTION 0026B636: #<LAMBDA>>)
ISLisp>(stream-car s)
2
ISLisp>(setq s (stream-cdr s))
(3 . #<UFUNCTION 0026B036: #<LAMBDA>>)
ISLisp>(stream-car s)
3
ISLisp>(setq s (stream-cdr s))
(4 . #<UFUNCTION 0026A836: #<LAMBDA>>)
ISLisp>(stream-car s)
4
ISLisp>(setq s (stream-cdr s))
NIL
ISLisp>s
NIL

もう一つ、簡単な例を示しましょう。フィボナッチ数列を生成する遅延ストリームを作ります。次のリストを見てください。

リスト : フィボナッチ数列を生成する遅延ストリーム

(defun fibgen (a b)
  (stream-cons a (fibgen b (+ a b))))

関数 fibgen の引数 a がフィボナッチ数列の最初の項で、b が次の項です。したがって、プロミスに (fibgen b (+ a b)) を格納しておけば、force することでフィボナッチ数列を生成することができます。

ISLisp>(defglobal f (fibgen 0 1))
F
ISLisp>(stream-car f)
0
ISLisp>(setq f (stream-cdr f))
(1 . #<UFUNCTION 00269A36: #<LAMBDA>>)
ISLisp>(stream-car f)
1
ISLisp>(setq f (stream-cdr f))
(1 . #<UFUNCTION 00269436: #<LAMBDA>>)
ISLisp>(stream-car f)
1
ISLisp>(setq f (stream-cdr f))
(2 . #<UFUNCTION 00268C36: #<LAMBDA>>)
ISLisp>(stream-car f)
2
ISLisp>(setq f (stream-cdr f))
(3 . #<UFUNCTION 00268636: #<LAMBDA>>)
ISLisp>(stream-car f)
3
ISLisp>(setq f (stream-cdr f))
(5 . #<UFUNCTION 00267E36: #<LAMBDA>>)
ISLisp>(stream-car f)
5

●遅延ストリームの操作関数

次は遅延ストリームを操作する関数を作りましょう。最初は n 番目の要素を求める関数 stream_ref です。

リスト : n 番目の要素を求める

(defun stream-ref (s n)
  (for ((n n (- n 1))
        (s s (stream-cdr s)))
       ((= n 0) (stream-car s))))

stream_ref は stream_tail を n 回繰り返すことで n 番目の要素を求めます。ストリームから n 個の要素を取り出してリストに格納して返す関数 stream_take() も同様にプログラムすることができます。

リスト : n 個の要素を取り出す

(defun stream-take (s n)
  (for ((n n (- n 1))
        (s s (stream-cdr s))
        (a nil (cons (stream-car s) a)))
       ((= n 0) (nreverse a))
       (if (null s)
           (error "Empty Stream"))))

それでは、簡単な実行例を示しましょう。

ISLisp>(defglobal f (fibgen 0 1))
F
ISLisp>(stream-ref f 0)
0
ISLisp>(stream-ref f 1)
1
ISLisp>(stream-ref f 2)
1
ISLisp>(stream-ref f 3)
2
ISLisp>(stream-ref f 4)
3
ISLisp>(stream-ref f 5)
5
ISLisp>(stream-ref f 6)
8
ISLisp>(stream-ref f 7)
13
ISLisp>(stream-ref f 8)
21
ISLisp>(stream-ref f 9)
34
ISLisp>(stream-ref f 10)
55
ISLisp>(stream-take f 20)
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)
ISLisp>(stream-ref f 100)
354224848179261915075

変数 f にフィボナッチ数列を生成するストリームをセットします。stream_ref で順番に要素を 20 個取り出すと、その値はフィボナッチ数列になっていますね。同様に、stream_take で 20 個の要素を取り出すと、配列の要素はフィボナッチ数列になります。メモリの許す限り大きなフィボナッチ数でも求めることができます。

このほかにも、便利な関数や高階関数などをいろいろ定義することができます。遅延ストリームに興味のある方は拙作のページ Common Lisp 入門 番外編 遅延ストリーム (1), (2) をお読みくださいませ。

●クロージャで遊ぼう

クロージャをサポートしているプログラミング言語では、効率を考慮しないでよければ、クロージャを使って「連結リスト」を実装しすることができます。連結リストの操作関数 cons, car, cdr には次の関係が成り立ちます。

(car (cons 'x 'y)) => x
(cdr (cons 'x 'y)) => y

ここで、関数 cons で生成したオブジェクトがセルではない場合を考えてみましょう。もし、そのオブジェクトに car を適用すれば cons の第 1 引数 x を返し、cdr を適用すれば第 2 引数を返すことができれば、セルと同じことが実現できます。

そこで、cons はセルではなくクロージャを返すことにしましょう。クロージャは引数 x, y の値を保持することができます。そして、このクロージャは引数に関数を受け取ることにします。あとは、この関数に引数 x, y を渡して評価すれば car と cdr を実現することができます。ISLisp で cons, car, cdr をプログラムすると次のようになります。

ISLisp>(defun cons2 (x y) (lambda (z) (funcall z x y)))
CONS2
ISLisp>(defun car2 (z) (funcall z (lambda (x y) x)))
CAR2
ISLisp>(defun cdr2 (z) (funcall z (lambda (x y) y)))
CDR2

関数 cons2 はクロージャを返します。このクロージャは引数 z に関数を受け取り、その関数に x, y を渡して評価します。関数 car2 は引数 z にクロージャを渡して評価し、第 1 引数 x を返します。これで car と同じ動作になります。同様に、関数 cdr2 は引数 z にクロージャを渡して評価し、第 2 引数 y を返します。これで cdr と同じ動作になります。

それでは実際に試してみましょう。

ISLisp>(defglobal a (cons2 1 0))
A
ISLisp>(car2 a)
1
ISLisp>(cdr2 a)
0
ISLisp>(defglobal b (cons2 2 a))
B
ISLisp>(car2 b)
2
ISLisp>(car2 (cdr2 b))
1
ISLisp>(cdr2 (cdr2 b))
0

このように、クロージャを使って連結リストを作成することができます。ご参考までに、簡単なリスト操作関数を下記リストに示します。

;;
;; list2.l : クロージャによる連結リストの実装
;;
;;           Copyright (C) 2016 Makoto Hiroi
;;

;; 基本関数
(defun cons2 (x y) (lambda (z) (funcall z x y)))
(defun car2 (z) (funcall z (lambda (x y) x)))
(defun cdr2 (z) (funcall z (lambda (x y) y)))

;; 述語
(defun cons2p (x) (functionp x))
(defun list2p (x) (or (null x) (cons2p x)))
(defun atom2 (x) (not (cons2p x)))

;; 簡単な入出力
(defun display (x) (format (standard-output) "~A" x))
(defun terpri () (format (standard-output) "~%"))

;; リストの表示
(defun printlist2(xs)
  (display "(")
  (while (cons2p xs)
    (if (list2p (car2 xs))
        (printlist2 (car2 xs))
      (display (car2 xs)))
    (if (cons2p (cdr2 xs))
        (display " "))
    (setq xs (cdr2 xs)))
  (cond ((not (null xs))
         (display " . ")
         (display xs)))
  (display ")")
  (terpri))

;; リストの生成
(defun list2 (&rest xs)
  (for ((xs (reverse xs) (cdr xs))
        (a nil (cons2 (car xs) a)))
       ((null xs) a)))

;; リストの連結
(defun append2 (xs ys)
  (if (null xs)
      ys
    (cons2 (car2 xs) (append2 (cdr2 xs) ys))))

;; マッピング
(defun mapcar2 (f xs)
  (if (null xs)
      nil
    (cons2 (funcall f (car2 xs)) (mapcar2 f (cdr2 xs)))))

;; フィルター
(defun remove2 (f xs)
  (cond ((null xs) nil)
        ((funcall f (car2 xs))
         (remove2 f (cdr2 xs)))
        (t (cons2 (car2 xs) (remove2 f (cdr2 xs))))))

;; 畳み込み
(defun fold-left2 (f a xs)
  (if (null xs)
      a
    (fold-left2 f (funcall f a (car2 xs)) (cdr2 xs))))

(defun fold-right2 (f a xs)
  (if (null xs)
      a
    (funcall f (car2 xs) (fold-right2 f a (cdr2 xs)))))
ISLisp>(defglobal a (list2 1 2 3 4 5))
A
ISLisp>(printlist2 a)
(1 2 3 4 5)
NIL
ISLisp>(defglobal b (list2 6 7 8 9 10))
B
ISLisp>(printlist2 (append2 a b))
(1 2 3 4 5 6 7 8 9 10)
NIL
ISLisp>(printlist2 (mapcar2 (lambda (x) (* x x)) a))
(1 4 9 16 25)
NIL
ISLisp>(printlist2 (remove2 (lambda (x) (= (mod x 2) 0)) a))
(1 3 5)
NIL
ISLisp>(fold-left2 #'+ 0 a)
15
ISLisp>(fold-right2 #'+ 0 a)
15
ISLisp>(printlist2 (fold-right2 #'cons2 nil a))
(1 2 3 4 5)
NIL
ISLisp>(printlist2 (fold-left2 (lambda (x y) (cons2 y x)) nil a))
(5 4 3 2 1)
NIL

●チャーチ数

「ラムダ計算 (lambda calculus)」は、文字λを使って関数を表す「λ記法」という表記法を用いた抽象的な計算モデルで、1930 年代に A. Church 氏によって考案されました。ラムダ計算は Lisp, Scheme, ML, Haskell など多くの関数型言語の基礎理論として、大きな役割を果たしています。ラムダ計算とか計算モデルというと難しい話のように思われるかもしれません。Lisp / Scheme では無名関数のことを「ラムダ式」といいますが、実をいうとこのラムダ式の考え方がラムダ計算の基本なのです。

純粋なラムダ計算の定義はとても単純です。ラムダ計算で扱う式は、次に示す 3 通りしかありません。

関数抽象は関数定義、関数適用は関数呼び出し、変数は関数の仮引数のことと考えてください。つまり、純粋なラムダ計算には関数しかないのです。したがって、ラムダ計算では数を表すのにも関数を使います。これを「チャーチ数 (Church numerals)」と呼びます。

ラムダ計算とラムダ式はまったく同じではありせんが、今回は難しいことを考えずに ISLisp のラムダ式を使って「チャーチ数」を試してみましょう。

●チャーチ数の基本

チャーチ数は関数 f と x を受け取り、x に f を適用した回数で数 (自然数) を表します。たとえば、自然数 n は (f (f (f (...(f x)) ...))) のように f を n 回呼び出すことで表します。ただし、Common Lisp や ISLisp は funcall が必要になるので、プログラムは Scheme よりもちょっと複雑になります。

簡単な例を示しましょう。

ISLisp>(defun zero (f) (lambda (x) x))
ZERO
ISLisp>(defun one (f) (lambda (x) (f x)))
ONE
ISLisp>(defun one (f) (lambda (x) (funcall f x)))
ONE
ISLisp>(defun two (f) (lambda (x) (funcall f (funcall f x))))
TWO
ISLisp>(defun three (f) (lambda (x) (funcall f (funcall f (funcall f x)))))
THREE

関数 zero は、引数 f を受け取ったら関数 (lambda (x) x) を返します。つまり、zero の返り値 (関数) に引数 x を渡して評価すると x をそのまま返すだけです。このとき、x に f を適用していないことに注意してください。これで 0 を表すことができます。

同様に、one は f を 1 回適用しているので 1 を、two は 2 回適用しているので 2 を、three は 3 回適用しているので 3 を表すことができます。そうはいっても、このままではよくわからないので、実際に引数として関数 (lambda (n) (+ n 1)) と 0 を渡して実行してみましょう。実行結果は次のようになります。

ISLisp>(funcall (zero (lambda (n) (+ n 1))) 0)
0
ISLisp>(funcall (one (lambda (n) (+ n 1))) 0)
1
ISLisp>(funcall (two (lambda (n) (+ n 1))) 0)
2
ISLisp>(funcall (three (lambda (n) (+ n 1))) 0)
3

(lambda (n) (+ n 1)) は引数 n に 1 を加算するので、もう一つの引数に 0 を渡せば (lambda (n) (+ n 1)) を適用した回数、つまりチャーチ数を ISLisp の数に変換することができます。

●足し算

次は数 n に 1 を加える関数 (succ f n) を定義してみましょう。このとき、n はチャーチ数であることに注意してください。プログラムは次のようになります。

ISLisp>(defun succ (f n) (lambda (x) (funcall f (funcall (funcall n f) x))))
SUCC

(funcall (funcall n f) x) は数 n を表しているので、それに関数 f を再度適用すれば、n に 1 を加えることができます。簡単な実行例を示します。

ISLisp>(funcall (succ (lambda (n) (+ n 1)) #'zero) 0)
1
ISLisp>(funcall (succ (lambda (n) (+ n 1)) #'one) 0)
2
ISLisp>(funcall (succ (lambda (n) (+ n 1)) #'two) 0)
3
ISLisp>(funcall (succ (lambda (n) (+ n 1)) #'three) 0)
4

このように、succ でチャーチ数 zero, one, two, three に 1 を加算することができます。

次は 2 つのチャーチ数 m, n を足し算する関数 (plus f m n) を作りましょう。この場合、(funcall (funcall n f) x) で n を表すチャーチ数になるので、この結果に関数 (funcall m f) を適用すれば m + n を実現することができます。プログラムは次のようになります。

ISLisp>(defun plus (f m n) (lambda (x) (funcall (funcall m f) (funcall (funcall
n f) x))))
PLUS
ISLisp>(funcall (plus (lambda (n) (+ n 1)) #'zero #'one) 0)
1
ISLisp>(funcall (plus (lambda (n) (+ n 1)) #'one #'one) 0)
2
ISLisp>(funcall (plus (lambda (n) (+ n 1)) #'one #'three) 0)
4
ISLisp>(funcall (plus (lambda (n) (+ n 1)) #'three #'three) 0)
6

正常に動作していますね。

●掛け算

次はチャーチ数 m と n を掛け算する関数 (mult f m n) を定義してみましょう。m * n は n を m 回足し算すればいいので、関数 (funcall n f) を m に渡して (funcall m (funcall n f)) とするだけです。プログラムと実行結果を示します。

ISLisp>(defun mult (f n m) (lambda (x) (funcall (funcall m (funcall n f)) x)))
MULT
ISLisp>(funcall (mult (lambda (n) (+ n 1)) #'zero #'three) 0)
0
ISLisp>(funcall (mult (lambda (n) (+ n 1)) #'one #'three) 0)
3
ISLisp>(funcall (mult (lambda (n) (+ n 1)) #'two #'three) 0)
6
ISLisp>(funcall (mult (lambda (n) (+ n 1)) #'three #'three) 0)
9

このように、チャーチ数の足し算と掛け算は簡単なのですが、引き算はとても難しくなります。本稿の範囲を超える (M.Hiroi が理解できない) ので、チャーチ数はここまでにしておきましょう。興味のある方は調べてみてください。

●参考文献, URL

  1. Ravi Sethi (著), 神林靖 (訳), 『プログラミング言語の概念と構造』,アジソンウェスレイ, 1995
  2. ラムダ計算入門 (PDF), (住井英二郎さん)
  3. ラムダ計算 - Wikipedia

●数で遊ぼう

今回は簡単な数理パズルを出題します。プログラムを作って解いてもかまいませんが、なかには筆算 (電卓) で解くことができる問題もあるので、興味のある方は挑戦してみてください。

  1. 1000000 以下の自然数で、3 の倍数になっている数字の和を求めてください。
  2. 10000! の末尾に付く 0 の個数を求めてください。
  3. 7654321 の末尾の数字を求めてください。
  4. 将棋盤の1ずつのマスに米粒を置きます。最初のマスへは1粒、次のマスへは2粒、そのつぎのマスへは4粒というようにして、つぎつぎに倍増していきます。最後のマス (81 マス) まで置き終わったときの米粒の総数を求めてください。
  5. 7 以上の素数で割り切れない N 以下の正の整数を求めるプログラムを作ってください (ハミングの問題)。
-- 参考文献 --------
1. Steven G. krantz (著), 関沢正躬 (訳), 『問題解決への数学』, 丸善, 2001
2. 中村義作, 『どこまで解ける日本の算法』, ブルーバックス, 1994
3. 大村平, 『数学公式のはなし』, 日科技連, 1996
4. 奥村晴彦,『C言語による最新アルゴリズム事典』, 技術評論社, 1991

●解答1

今のパソコンは高性能なので、次のようにプログラムしても瞬時に答えを求めることができます。

ISLisp>(defun sum-of-multiples (n m)
  (for ((x m (+ x m))
        (a 0 (+ a x)))
       ((> x n) a)))
SUM-OF-MULTIPLES
ISLisp>(sum-of-multiples 1000000 3)
166666833333

ところが、数列の和を求める公式を使うと、もっと簡単に答えを求めることができます。

\( 1 + 2 + 3 + \cdots + n = \dfrac{n(n + 1)}{2} \)

上記公式より n 個の 3 の倍数の和は 3 + 6 + 9 + ... + 3n = 3n(n + 1) / 2 となります。したがって、1000000 以下の 3 の倍数の和は 1 から (div 1000000 3) => 333333 までの和を 3 倍することで求めることができます。

3 * 333333 * (333333 + 1) / 2 = 166666833333

これをプログラムすると次のようになります。

ISLisp>(defun sum-of-multiples (n m)
(let ((x (div n m))) (div (* m x (+ x 1)) 2)))
SUM-OF-MULTIPLES
ISLisp>(sum-of-multiples 1000000 3)
166666833333

●等差数列の和

次のように、一定の差で並んだ数列を「等差数列」といいます。

\(a, \ a + d, \ a + 2d, \ a + 3d, \ \cdots, \ a + (n - 1)d, \ \cdots\)

a を「初項」、d を「公差」といいます。等差数列の一般項は次の式で表すことができます。

\(a_n = a + (n-1)d\)

初項から an までの和 Sn は次の式で求めることができます。

\(S_n = \displaystyle \sum_{i=1}^{n} a_i = \dfrac{n(2a + (n - 1)d)}{2}\)

初項を 1, 公差 を 1 とすると、1 から n までの和は n(n + 1)/ 2 となります。

この公式は次のように導出することができます。

\(\begin{eqnarray} Sn &=& a &+& (a + d) &+& \cdots \ &+& (a + (n - 2)d) &+& (a + (n - 1)d) \\ Sn &=& (a + (n - 1)d) &+& (a + (n - 2)d) &+& \cdots \ &+& (a + d) &+& a \end{eqnarray}\)

足し算すると

\(\begin{array}{l} 2Sn = (2a + (n - 1)d) + (2a + (n - 1)d) + \cdots + (2a + (n - 1)d) + (2a + (n - 1)d) \\ 2Sn = n(2a + (n - 1)d) \\ Sn = \dfrac{n(2a + (n - 1)d}{2} \end{array}\)

このように、右辺を逆順に並べ替えて足し算すると、\(2a + (n - 1)d\) が n 個並ぶことになります。あとは、これを 2 で割り算すればいいわけです。


●解答2

10000! であれば、次のようなプログラムでも瞬時に答えを求めることができます。

ISLisp>(defun fact (n) (for ((n n (- n 1)) (a 1 (* a n))) ((= n 0) a)))
FACT
ISLisp>(let ((a (fact 10000)) (c 0))
 (while (= (mod a 10) 0) (setq c (+ c 1)) (setq a (div a 10))) c)
2499

単純に n! を求めて、10 で割れる回数を求めているだけです。ところが、この方法では n が大きくなると極端に遅くなります。多倍長整数の場合、除算や余りを求める処理は乗算よりもはるかに時間がかかります。たとえば、1 桁増やした 100000! の場合、階乗の値は短時間で求めることができても、(div a 10) の回数が増えることにより実行時間が極端に遅くなるのです。

そこで、他の方法を考えてみましょう。階乗を計算するとき、末尾に 0 が付くのは値を 10 倍したときです。これは数字 10 や 100 を乗算するときだけではありません。次の例を見てください。

1 = 1
1 * 2 = 2
1 * 2 * 3 = 6
1 * 2 * 3 * 4 = 24
1 * 2 * 3 * 4 * 5 = 120
1 * 2 * 3 * 4 * 5 * 6 = 720
1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040
1 * 2 * 3 * 4 * 5 * 6 * 7 * 8 = 40320 
1 * 2 * 3 * 4 * 5 * 6 * 7 * 8 * 9 = 362880 
1 * 2 * 3 * 4 * 5 * 6 * 7  * 8 * 9 * 10 = 3628800 

10 は 2 * 5 に素因数分解することができます。つまり、2 と 5 の組があれば、末尾に 0 がひとつ追加されるわけです。また、0 が複数追加されることもあります。次の例を見てください。

24! = 620448401733239439360000
25! = 15511210043330985984000000

25 は 5 * 5 と素因数分解することができます。このとき、2 * 5 の組が 2 つできるので、末尾に 0 が 2 つ付くわけです。階乗を素因数分解したとき、因数 2 の個数は因数 5 の個数よりも多くなるので、2 と 5 は必ず組にすることができます。つまり、因数 5 の個数が末尾に付く 0 の 個数になるわけです。

階乗の場合、因数の個数を求めるのは簡単です。10000! の場合、10000 / 5 で 5 の倍数の個数 2000 を求めることができます。次に、25 (= 5 * 5) の倍数の個数を 10000 / 25 で求めます。さらに、125 (= 5 * 5 * 5) の倍数の個数を 10000 / 125 で求めます、これを 10000 > 5m が成立する m まで繰り返し、その総和が 5 の因子の個数になります。

10000 / 5    = 2000
10000 / 25   =  400
10000 / 125  =   80
10000 / 625  =   16
10000 / 3125 =    3.2 (小数点切捨て)
----------------------
        合計 = 2499

プログラムと実行結果を示します。

ISLisp>(defun solver (n)
(for ((m 5 (* m 5)) (a 0 (+ a (div n m)))) ((> m n) a)))
SOLVER
ISLisp>(solver 10000)
2499
ISLisp>(solver 100000)
24999
ISLisp>(solver 1000000)
249998
ISLisp>(solver 10000000)
2499999
ISLisp>(solver 100000000)
24999999
ISLisp>(solver 1000000000)
249999998
ISLisp>(solver 10000000000)
2499999997

●解答3

ISLisp の場合、次のように簡単に求めることができます。

ISLisp>(mod (expt 7 654321) 10)
7

ただし、OKI-ISLisp は実行速度がちょっと遅いので、答えが出るまでに少々時間がかかります。実をいうと、この問題は筆算で簡単に求めることができます。7n (n > 0) の末尾の数字は次のように 7, 9, 3, 1, ... と巡回します。

7^1 = 7
7^2 = 49
7^3 = 343
7^4 = 2401
7^5 = 16807
7^6 = 117649
7^7 = 823543
7^8 = 5764801

ここで、74 の末尾は 1 になることに注目してください。末尾が 1 の数字を何回乗算しても、その結果の末尾は 1 になります。7654321 は (74)163580 * 7 なので、末尾の数字は 7 と求めることができます。


●解答4

米粒の合計値は \(1 + 2 + 2^2 + 2^3 + \cdots + 2^{80}\) になります。これを素直にプログラムすると次のようになります。

ISLisp> (for ((x 0 (+ x 1)) (a 0 (+ a (expt 2 x)))) ((> x 80) a))
2417851639229258349412351

とても大きな数になるので、普通の電卓では計算できません。Windows の電卓を使用するときは関数電卓に切り替えてください。もちろん、数学の公式を使うともっと簡単に求めることができます。

●等比数列の和

次のように、一定の比で並んだ数列を「等比数列」といいます。

\(a, \ ar, \ ar^2, \ \cdots, \ ar^{n-1}, \ \cdots\)

a を「初項」、d を「公比」といいます。等比数列の一般項は次の式で表すことができます。

\(a_n = ar^{n-1}\)

初項から an までの和 Sn は次の式で求めることができます。

\(S_n = \displaystyle \sum_{i=1}^{n} a_i = \dfrac{a(1 - r^n)}{1 - r}\)

問題は初項 1 で公比 2 なので、米粒の合計は次のようになります。

\(\dfrac{1 - 2^{81}}{1 - 2} = 2^{81} - 1\)
ISLisp>(- (expt 2 81) 1)
2417851639229258349412351

この公式は次のように導出することができます。

\(Sn = a + ar + ar^2 + \cdots + ar^{n-1}\)

両辺を r 倍すると

\(rSn = ar + ar^2 + \cdots + ar^{n-1} + ar^n\)

これを引き算すると

\(\begin{array}{l} Sn - rSn = a - ar^n \\ Sn = \dfrac{a(1 - r^n)}{1 - r} \end{array}\)

右辺を引き算すると \(ar\) から \(ar^{n-1}\) の項がなくなって、\(a - ar^n\) だけになります。あとは、\(1 - r\) で割り算すればいいわけです。


●解答5

7 以上の素数で割り切れない正の整数は、素因子が 2, 3, 5 しかない自然数のことです。これを「ハミング数 (Hamming Numbers)」といいます。ハミング数は素因数分解したとき、\(2^i \times 3^j \times 5^k \ (i, j, k \geq 0)\) の形式になります。たとえば、100 以下のハミング数は次のようになります。

1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 40, 45, 48, 50, 
54, 60, 64, 72, 75, 80, 81, 90, 96, 100

それではプログラムを作りましょう。一番簡単な方法は、1 から n までの整数列を生成して、そこからハミング数を取り出していくことです。これを ISLisp でプログラムすると次のようになります。

ISLisp>(defun check (n)
(while (= (mod n 2) 0) (setq n (div n 2)))
(while (= (mod n 3) 0) (setq n (div n 3)))
(while (= (mod n 5) 0) (setq n (div n 5)))
(= n 1))
CHECK
ISLisp>(load "list.l")
T
ISLisp>(remove-if (lambda (x) (not (check x))) (iota 1 100))
(1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60 64 72 75
80 81 90 96 100)
ISLisp>(length (remove-if (lambda (x) (not (check x))) (iota 1 100)))
34
ISLisp>(length (remove-if (lambda (x) (not (check x))) (iota 1 1000)))
86
ISLisp>(length (remove-if (lambda (x) (not (check x))) (iota 1 10000)))
175
ISLisp>(length (remove-if (lambda (x) (not (check x))) (iota 1 100000)))
313
ISLisp>(length (remove-if (lambda (x) (not (check x))) (iota 1 1000000)))
507

関数 check は引数 n がハミング数かチェックします。これは 2, 3, 5 だけで割り切れるか試しているだけです。プログラムはとても簡単ですが、引数 n の値が大きくなると時間がかかるようになります。n に比べてハミング数の個数は少ないようなので、\(2^i \times 3^j \times 5^k \ (i, j, k \geq 0)\) を使ってハミング数を生成したほうがよさそうです。引数 n に対して i, j, k の上限値は \(\log_2 n, \log_3 n, \log_5 n\) で求めることができます。たとえば、100000000 の場合は次のようになります。

i : 0 - 26
j : 0 - 16
k : 0 - 11

全体で 27 * 17 * 12 = 5508 個しかありません。この中から 100000000 以下の数を選べばいいわけです。プログラムは次のようになります。

リスト : ハミングの問題 (2)

(load "list.l")

(defun product (f xs ys)
  (for ((xs xs (cdr xs))
        (a nil))
       ((null xs) (nreverse a))
       (for ((ys ys (cdr ys)))
            ((null ys))
            (setq a (cons (funcall f (car xs) (car ys)) a)))))

(defun hamming-sub(n m)
  (mapcar (lambda (x) (expt m x)) (iota 0 (floor (quotient (log n) (log m))))))

(defun hamming (n)
  (let ((xs (hamming-sub n 5)))
    (setq xs (product #'* xs (hamming-sub n 3)))
    (setq xs (remove-if (lambda (x) (< n x)) xs))
    (setq xs (product #'* xs (hamming-sub n 2)))
    (setq xs (remove-if (lambda (x) (< n x)) xs))
    (quick-sort xs)))

関数 product はリスト xs, ys の直積集合を生成し、その要素に関数 f を適用した結果をリストに格納して返します。簡単な実行例を示します。

ISLisp>(product #'cons '(1 2 3) '(4 5 6))
((1 . 4) (1 . 5) (1 . 6) (2 . 4) (2 . 5) (2 . 6) (3 . 4) (3 . 5) (3 . 6))
ISLisp>(product #'+ '(1 2 3) '(4 5 6))
(5 6 7 6 7 8 7 8 9)

関数 hamming-sub は mi (i = 0, 1, 2, ... logm n) をリストに格納して返します。あとは関数 hamming で直積集合を求め、remove-if で n より大きい値を取り除くだけです。

それでは実行してみましょう。

ISLisp>(hamming 100)
(1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60 64 72 75
80 81 90 96 100)
ISLisp>(length (hamming 100))
34
ISLisp>(length (hamming 1000))
86
ISLisp>(length (hamming 10000))
175
ISLisp>(length (hamming 100000))
313
ISLisp>(length (hamming 1000000))
507
ISLisp>(length (hamming 10000000))
768
ISLisp>(length (hamming 100000000))
1105
ISLisp>(length (hamming 1000000000))
1530
ISLisp>(length (hamming 10000000000))
2053

この方法だと短時間で答えを求めることができます。


Copyright (C) 2016 Makoto Hiroi
All rights reserved.

[ Home | Common Lisp | ISLisp ]