Archive for 2013年9月|Monthly archive page

projecteuler12...または、返り値を記憶する関数

 projecteuler問題12 は、自然数を加算して得られる三角数において、約数の数が最初に500を超えるものを求めるもの。
 そのために、三角数を newLISP 組込関数 factor で因数分解し、そこから、約数をすべて求めます。
 その際、約数の組み合わせは projecteuler4(続き) で使った binary counting 利用します 。
 ということで、コードは、

(define-macro (memoize mem-func func) 
  (set (sym mem-func mem-func) 
    (letex (f func  c mem-func) 
      (lambda () 
        (or (context c (string (args))) 
            (context c (string (args)) (apply f (args))))))))
(define (make-sublist lst)
  (clean nil? (map (fn(x) (if x $idx)) lst))
)
(memoize combination (lambda (n)
  (let (res)
    (for (x 1 (-- (pow 2 n)))
      (let (lst (bits x true))
        (push (if (< (length lst) n) (append lst (dup nil (- n (length lst)))) lst)
              res -1))
    )
  (map make-sublist res))))
(memoize combination2 (lambda (n)
  (if (= n 0) '()
    (let (res (combination2 (-- n)))
      (push (list n) res -1)
      (dolist (x res (= (x 0) n))
         (push (append x (list n)) res -1))
      res))))
(define (divisors2 num , (res '(1)))
  (let (numbers (factor num))
    (if (= num 1) 1
        numbers
      (let (sublist (combination2 (length numbers)))
        (dolist (x sublist)
          (push (apply * (select numbers x)) res -1))
        (unique res)))))
(let (i 2 sum 1 res nil)
  (until res
    (let (x (divisors2 (++ sum i)))
	   (if (> (length x) 500) (setq res (list i (x -1))) (++ i))))
  res)

 binary counting で作った組み合わせは何度も使いますから、その度に計算するのは無駄。そこで、マクロ memoize の登場です。このマクロは、引数と答えを対で記憶する関数をつくるもので、newLISP の Code Snippets Create memoizing Functions として載っています。
 このマクロを使って関数を作ると、初めての引数には実際に計算し、一度計算した引数には保存してある値を返します。何度も同じ引数を使う時は、大幅に実行時間を短くできます。
 こんな風に、便利で役に立つマクロや関数の例が newLISP のホームページマニュアルコード例に載っているのが newLISP の魅力の一つ。
 さて、このコードを実行すると、

(12375 76576500)
> 

 こんな感じで、出てきます。
 つまり、答えは 12375段目の 76576500

 以上、如何でしょうか?

広告