コラッツ予想（Mathematica, Lisp編）

投稿日時: 投稿者: 
f[1] = 1;
f[n_?EvenQ] := n/2
f[n_?OddQ] := 3 n + 1

g[n_] := Length[NestWhileList[f, n, # != 1 &]]
(*gは、nが1になるまでにfを作用させる回数*)

h[n_] := With[{li = Map[g, Range[n]]}, Position[li, Max[li]]]
(*hは、n以下の数で、gの最大値を与えるもの*)

h[100]
{{97}}

数の列ではなくf[100]のような式の列を処理したいなら、

Clear[f];
f[1] = 1;
f[n_?EvenQ] := Hold[f[n/2]];
f[n_?OddQ] := Hold[f[3 n + 1]];
(*fは言われたとおり。でも計算が終わらないようにHoldする*)

g[n_] := Length[NestWhileList[ReleaseHold, f[n], (# =!= 1) &]]
(*gは、fが1になるまでにHoldを解く回数*)

日本語の説明のとおりにコードを書けるのがMathematicaのよいところ。

この問題は、

  1. h[100]をいかに早く求めるか（これがLLってことだと思う）
  2. いかに速いコードを書くか

で戦略がぜんぜんちがうわけで、1ならばこれで終わり。

もう少し進もうと思うなら、このままではgやhでメモリがあふれないか心配になるわけで、末尾再帰に書き換えることになる。こういう書き換えは読みやすさを損なうからLLっぽくはないね。

g[1, t_] := t;
g[n_?EvenQ, t_] := g[n/2, t + 1];
g[n_, t_] := g[3 n + 1, t + 1];
g[n_] := g[n, 1];

h[1, position_, score_] := position;
h[n_, position_, score_] :=
  With[{tmp = g[n]},
   If[score < tmp, h[n - 1, n, tmp], h[n - 1, position, score]]];
h[n_] := h[n, 0, 0];

h[100]
97

ちなみにこれなら、そのままLispに翻訳できる。

(defun g (n) (g1 n 1))

(defun g1 (n x)
  (cond
   ((eq n 1) x)
   ((evenp n) (g1 (/ n 2) (+ x 1)))
   (t (g1 (+ (* 3 n) 1) (+ x 1)))))

(defun h (n) (h1 n 0 0))

(defun h1 (n position score)
  (cond
   ((eq n 1) position)
   (t (let ((tmp (g n)))
        (if (< score (g n)) (h1 (- n 1) n (g n))
          (h1 (- n 1) position score))))))

(h 100)
97

途中の計算結果を記憶しておいて利用した方が速いのかもしれないけど、それは自明なことではない。計算するのとテーブルを参照するののどちらが速いかは問題の性質による。それを調べる間にh[100]が求められないということは、絶対にない！　Collatzとの旅には主記憶じゃぜんぜん足りないかもしれないよ。

キミならどう書く 2.0 – ROUND 2 –

No related posts.