Project Euler Problem 14

問題14: 100万未満の数の中でコラッツ数列がもっとも長くなる数を求める。[=>問題文]
 最初の10個を書いてみると。

  1 (1) : 1
  2 (2) : 2 - 1 
  3 (8) : 3 - 10 - 5 - 16 - 8 - 4 - 2 - 1
  4 (3) : 4 - 2 - 1
  5 (6) : 5 - 16 - 8 - 4 - 2 - 1
  6 (9) : 6 - 3 - 10 - 5 - 16 - 8 - 4 - 2 - 1
  7 (17): 7 - 22 - 11 - 34 - 17 - 52 - 26 - 13 - 40 - 20 - 10 - 5 - 16 - 8 - 4 - 2 - 1
  8 (4) : 8 - 4 - 2 - 1
  9 (20): 9 - 28 - 14 - 7 - 22 - 11 - 34 - 17 - 52 - 26 - 13 - 40 - 20 - 10 - 5 - 16 - 8 - 4 - 2 - 1
 10 (7) : 10 - 5 - 16 - 8 - 4 - 2 - 1

 「9」のコラッツ列は、4番目で「7」が現れます。数列の長さを「1」から順にチェックするならば、「9」の時点では「7」は調べ終わっているはずです。したがって「9」から「7」へ到達するまでの長さ 3 と既にわかっている「7」のコラッツ列長 17 を足した 20 が「9」の長さとわかります。17回の計算が省略できたことになります。このように過去のデータを記録しておき計算量を減らすことを「メモ化」というそうです。

問題14の解答

vectoer によるメモ化

(defun problem014 (N)
  (let ((memo (make-vector (1+ N) 0))
        (ans 1) (max-cnt 0) (n 1))
    (aset memo 1 1)
    (while (< (incf n) N)
      (if (evenp n)
          (aset memo n (1+ (aref memo (/ n 2))))
        (let ((cnt 0) (m (float n)))
          (while (>= m n)
            (incf cnt)
            (setq m (if (zerop (mod m 2))
                        (/ m 2)
                      (1+ (* 3 m)))))
          (incf cnt (aref memo (truncate m)))
          (aset memo n cnt)
          (when (> cnt max-cnt)
            (setq max-cnt cnt)
            (setq ans n)))))
    ans))

(problem014 1000000)

 小さいほうから順に100万まで n を増加させコラッツ列を調べます。数列を計算して n より小さな値が現れたら、memo を参照し、そこまでの cnt と加算し列の長さを求めます。
 偶数は最初にいきなり半分にされ、必ず自身より小さな値になるので memo の インデックス (/ n 2)に保存されている値に 1 を加えるだけで計算がすみます。
 100万までのコラッツ列に現れる数の最大は 56991483520 で、これは 28bitどころか32bitで表現できる整数の範囲も超えてしまいます。そのためfloat型で数列作成を行っています。ただし、vector の インデックスには float 型が使えないため、memo を参照するさいに truncate をかける必要があります。

hash table 版

 ところで「3」のコラッツ列(3-10-5-16-8-4-2-1)を調べると「10」のコラッツ列の長さは 7,「5」の長さは 6、「16」の長さは 5 と、自分(n)より大きなコラッツ数列も調べていることになります。はじめに書いたプログラムでは、n より大きい数についての情報は保存しないので、これらの情報は捨てられ、「5」や「10」を調べる時、もう一度計算しなおしています。これらも記録したらもっと早くなるでしょうか?

(defun problem014-2 (N)
  (let ((memo (make-hash-table))
        (ans 1) (max-cnt 0) (n 1))
    (puthash 1.0 1 memo)
    (while (< (incf n) N)
      (let ((m (float n)))
        (when (null (gethash m memo))
          (if (evenp n)
              (puthash m
                       (1+ (gethash (/ m 2) memo))
                       memo))
          (let ((pool nil) (cnt 0))
            (while (null (setq cnt (gethash m memo)))
              (push m pool)
              (setq m (if (zerop (mod m 2))
                          (/ m 2)
                        (1+ (* 3 m)))))
            (let ((x 0))
              (dolist (x pool)
                (incf cnt)
                (puthash x cnt memo)))
            (when (> cnt max-cnt)
              (setq max-cnt cnt)
              (setq ans n))))))
    ans))

 n より大きい数といってもどれだけ大きい値が出るのか事前にはわかりません。固定サイズのvectorでは扱えません。そこで vector の代わりに ハッシュテーブルを使うことにします。ハッシュに記録が無い数値が続く間は、リスト pool に値を push してゆきます。ハッシュに記録が見つかったらそのカウント値を取得し、while を終了。次の dolist で pool に保存されている値を順に取り出し、cnt を増やしながら ハッシュに保存します。これで n より大きな数のコラッツ長が保存されてゆきます。
 実行して処理にかかる時間を計測すると・・・

Function       Avg time per call
=============  =================
problem014     5.328500   (vector)
problem014-2   9.031000   (hash table)

 むしろ、大きく速度低下してしまいました。ループ回数は85%ほどに減っているけど、それ以上に ハッシュデータの作成と参照にかかるコストが上回ってしまっているのでしょうね。

vector + hash table 版

 では、100万以下の数は vector に保存し、100万を越えたらhash tableに保存するという方法ではどうでしょうか? 両者のいいとこ取りで速くなるかも?

(defun problem014-3 (N)
  (let ((memo-vect (make-vector (1+ N) 0))
        (memo-hash (make-hash-table))
        (ans 1) (max-cnt 0) (n 1))
    (aset memo-vect 1 1)
    (while (< (incf n) N)
      (if (zerop (aref memo-vect n))
          (if (evenp n)
              (aset memo-vect n
                    (1+ (aref memo-vect (/ n 2))))
            (let ((m (float n))
                  (pool nil) (cnt-from-hash nil))
              (while (and
                      (>= m n)
                      (null (setq cnt-from-hash
                                  (gethash m memo-hash))))
                (push m pool)
                (setq m (if (zerop (mod m 2))
                            (/ m 2)
                          (1+ (* 3 m)))))
              (let ((cnt (if (null cnt-from-hash)
                             (aref memo-vect (truncate m))
                           (gethash m memo-hash)))
                    (x 0))
                (dolist (x pool)
                  (incf cnt)
                  (if (< N x)
                      (puthash x cnt memo-hash)
                    (aset memo-vect (truncate x) cnt)))
                (when (> cnt max-cnt)
                  (setq max-cnt cnt)
                  (setq ans n)))))))
    ans))

 プロファイルすると・・・

Function       Avg time per call
=============  =================
problem014     5.328500   (vector)
problem014-3   5.680000   (vector + hash table)
problem014-2   9.031000   (hash table)

 だいぶ肉薄しましたが結局 vector だけの方式が一番速いようです。
 hashtable は生成時にキャパシティを指定して、メモリ再確保のコストをなくすオプションがありますが :size 200万 を指定しても高速化は微々たる物でした。