Project Euler Problem 4

Project Euler Emacs Lisp

問題4: 3桁の数の積で表される回文数のうち最大のものはいくらになるか。[=>原文和訳]
今回は力技でもすぐ答えが出そうな簡単な問題です。

回文数チェック関数

(defun is-palindromic-number (x)
  "回文数チェック"
  (let* ((str (number-to-string x))
         (sub-loop
          (lambda (left right)
            (cond
             ((>= left right) t)
             ((not (= (aref str left) (aref str right))) nil)
             (t (funcall sub-loop (1+ left) (1- right)))))))
    (funcall sub-loop 0 (1- (length str)))))

　クロージャっぽく（？）書いてみました。let* の変数リストで 再帰的なlambda式をsub-loopという名前に束縛しています。動的スコープのEmacs Lispならではの構造です。似たようなことは scheme の letrec でもできますが意味は違うようです。letrec が再帰的な定義をするのに対して、Emacs Lisp の let は、実行時まで変数の束縛対象を保留していると私は理解しました。あってるかな？ ちなみにこれ、compile-defun でバイトコンパイルすると sub-loop でワニングが出ますが、たぶんこの使いかたなら問題は起きないだろうと思います。ロジックは左右のインデックスを中央に向かって寄せながら文字列要素を比較しているだけです。
　Emacs Lisp では、文字列、vector、bool-vectorの３つはまとめて「配列」と呼ばれるランダムアクセス可能なコレクション型で共通の操作ができます。 aref は任意の位置の要素を参照する関数です。

問題4の解答

(defun problem004 (N)
  "N桁の数同士の積で作られる回文数のうち最大のものを求める"
  (let ((max-val (1- (expt 10 N)))  ;N桁最大値
        (min-val (expt 10 (1- N)))  ;N桁最小値
        (x 0) (y 0) (z 0)           ;x * y = z
        (dx 0) (dy 0) (ans 0))
    (dotimes (dx (- max-val min-val))
      (setq x (- max-val dx))
      (if (>= ans (* x x))
          (return ans))
      (dotimes (dy (- x min-val))
        (setq y (- x dy))
        (if (>= ans (setq z (* x y)))
            (return))
        (if (is-palindromic-number z)
            (setq ans z))))))

(problem004 3) ; N=3 で実行

　こちらはもろに手続き的な書き方になりました。数千回オーダーのループは再帰で書くのがためらわれます。
　x * y = z を計算し z が回文数になるものを探すという単純な方針です。欲しいのは最大値なので発見済みの ans より小さい x * y はスキップするように工夫しています。
　x の値を 999 からデクリメントしてゆき、y は x 以下の範囲で減らしていきます（x, yの対象性から同じ組み合わせを排除するため）。x * y ( = z ) が、既出の回文数 ans 以下になったら y のループはそこで打ち切り。x を一つ減らして、また y のループに入ります。いずれ、x * x が ans より小さくなるので、そこで処理は終了となります。 y は x 以下なので、それ以降 ans より大きな値は現れません。
　x y のデクリメントは、 dotimesを使って 最大値からの距離 dx dy をインクリメントすることで実現しています。

while と progn を組み合わせる

　Emacs Lisp のマニュアルを眺めていたらこんな方法が紹介されていました。

(defun problem004-2 (N)
  (let* ((max-val (expt 10 N))      ;N桁最大値+1
         (min-val (expt 10 (1- N))) ;N桁最小値
         (x max-val) (ans 0))
    (while (progn
             (decf x)
             (and (< ans (* x x))
                  (<= min-val x)))
      (let ((y (1+ x)) (z 0))
        (while (progn
                 (decf y)
                 (and (< ans (setq z (* x y)))
                      (<= min-val y))) 
          (if (is-palindromic-number z)
              (setq ans z)))))
    ans))

　while の条件部に prognで複数の式を並べ、その最後の式で（ループを継続するかやめるかの）結論を出すというやり方です。なるほどね。