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。

　以上、如何でしょうか？

« newLISP マニュアル v.10.5.3 日本語訳公開

newLISP マニュアル v.10.5.4 日本語訳公開 »