Project Euler Problem 8

Project Euler Emacs Lisp

問題8: 提示された1000桁の数字列内で連続する5つの数字の積の最大はいくつか。[=>原文和訳]

問題8 解答

　ちょっと凝った作りになりました。

(defun problem008 (str)
  "数字列内の5個の連続する数字の積の最大値を取得"
  (let ((N 5) (ans 0) (blk nil))
    (dolist (blk (split-string str "0") ans)
      (when (<= N (length blk))
        (let* ((lis (mapcar
                     #'(lambda (c) (- c ?0)) blk))
               (tmp (apply #'* (subseq lis 0 N))))
          (if (> tmp ans)
              (setq ans tmp))
          (let ((lis-len (length lis)))
            (if (> lis-len N)
                (let ((vec (vconcat lis))
                      (i 0) (j N))
                  (while (< j lis-len)
                    (setq tmp
                          (* (/ tmp
                                (aref vec i))
                             (aref vec j)))
                    (if (> tmp ans)
                        (setq ans tmp))
                    (incf i)
                    (incf j))))))))))

　5文字の中に 0 が含まれると積も 0 になります。0 をまたいだ数列は解になりえないので、つまり全体文字列を 0 で split して、分割されたそれぞれのブロック内での積を調べればよいわけです。分割されたブロックが 5文字未満の場合そのブロックは脱落です。
　6行目の let* は２つの変数を束縛します。１つ目の lis は 分割された１ブロック(blk)をリストに変換したものです。文字列をリストにする際、各要素から文字'0'（Emacs Lisp では ?0 と表記）を引くことで、数値リストに変換しています。
　let* の２つ目の変数 tmp は、lis のサブシーケンスの積で初期化されます。最初のN(=5)要素を subseq で切り出しています。以降 tmp は 5つの数字の積を作るための一時変数として使います。また、ansは解となる値を保持する変数で、最終的には dolist の評価値となります。
　もし lis が 6要素以上であれば 15行目の while で順にチェックを行います。ループ内では 5文字の先頭の数字で tmp を割り、次に5文字に入ってくる数字を掛けることで 1文字スライドした 5文字の積を新たに取得しています。ランダムアクセスが必要になるのであらかじめ lis は vector に変換しておきます。vconcat は複数のシーケンスを結合して新たな vector を作る関数ですが、単体のリストや文字列に使うと vectorへの型変換関数として機能します。
　あとは、tmp が ans を超えたら ans を更新する処理を繰り返すだけです。　

もっとシンプルに

　今回の問題はそこまで凝った作りにしなくても解けます。

(defun problem008-2 (str)
  (let ((N 5) (ans 0) (i 0)
        (lis (mapcar
              #'(lambda (c) (- c ?0)) str)))
    (dotimes (i (- (length lis) N) ans)
      (let ((tmp (apply
                  #'*
                  (subseq lis i (+ i N)))))
        (if (< ans tmp)
            (setq ans tmp))))))

　とにかく１文字ずつずらしながら 5要素を取り出し毎回5つの積をとる。0があろうと無かろうとお構いなし。無駄はあるけどシンプルなプログラムです。これでも一瞬で答が出ます。

比べてみよう

　profile モジュールを使って、一万回の繰り返しの平均を出してみました。

(defvar data
  (concat
  "73167176531330624919225119674426574742355349194934"
  "96983520312774506326239578318016984801869478851843"
  "85861560789112949495459501737958331952853208805511"
  "12540698747158523863050715693290963295227443043557"
  "66896648950445244523161731856403098711121722383113"
  "62229893423380308135336276614282806444486645238749"
  "30358907296290491560440772390713810515859307960866"
  "70172427121883998797908792274921901699720888093776"
  "65727333001053367881220235421809751254540594752243"
  "52584907711670556013604839586446706324415722155397"
  "53697817977846174064955149290862569321978468622482"
  "83972241375657056057490261407972968652414535100474"
  "82166370484403199890008895243450658541227588666881"
  "16427171479924442928230863465674813919123162824586"
  "17866458359124566529476545682848912883142607690042"
  "24219022671055626321111109370544217506941658960408"
  "07198403850962455444362981230987879927244284909188"
  "84580156166097919133875499200524063689912560717606"
  "05886116467109405077541002256983155200055935729725"
  "71636269561882670428252483600823257530420752963450"))

(require 'profile)
(setq profile-functions-list
      '(problem008 problem008-2))

(let ((i 0))
  (dotimes (i 10000)
    (problem008 data)
    (problem008-2 data)))

　あらかじめ、profile-functions-list に測定したい関数を登録して、M-x profile-functions を実行した後、好きなだけ関数を実行します。その後 M-x profile-results を実行するとこんな風に結果が表示されます。

Function       Calls  Total time (sec)  Avg time per call
============  ======  ================  =================
problem008     10000         10.349000           0.001035
problem008-2   10000         47.261000           0.004726

　一応、いろいろ考えたのが報われてパフォーマンスの差が出たようです。よかった。
　計測をやり直す場合は、M-x profile-finish を実行し、最初から手順をやり直します。