projecteuler23

　正の自然数の約数の総和が、その自然数の2倍より大きい時、その数を過剰数（abundant number） と呼ぶそうです。さらに、数理解析（mathematical analysis） によると、28123より多きい数は二つの過剰数の和で表されるとか。
　そして、projecteuler の 問題23 は、二つの過剰数の和で表されない数の和を求める問題。
　つまり、二つの過剰数の和で表される 28123 以下の数値がわかれば答えが求まります。
　さて、まず二つの過剰数を求めます。最小の過剰数が 12 と示されているので、

(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 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)))))
(setq max-num 28124 abundants '())
(for (i 2 (- max-num 12))
  (let (lst (divisors2 i))
    (if (> (apply + (0 -1 lst)) (lst -1)) (push i abundants -1))))

　これで、計算に必要な過剰数が abundants に入ります。
　中身はこんな感じ、

> (0 10 abundants)
(12 18 20 24 30 36 40 42 48 54)
> (-10 10 abundants)
(28074 28080 28084 28086 28092 28098 28100 28104 28110 28112)
> (length abundants)
6962
> 

　つぎに、二つの過剰数の和を求めます。

(setq lst '())
(for (i 0 (-- (length abundants)))
  (if (> max-num (* 2 (abundants i)))
  (push (map (curry + (abundants i)) (i abundants)) lst　－１)))
(setq two-abundants (filter (fn(x) (< x max-num)) (unique (flat lst))))

　さて、二つの過剰数の和の最大値と最小値は

> (apply max two-abundants)
28123
> (apply min two-abundants)
24
> 

　予定通りです。
　あとは、1 ～ 28123 までの数値から二つの過剰数の和を取り除いて、和を取るだけ。sequence と difference を使えば、簡単（笑）

> (apply + (difference (sequence 1 (-- max-num)) two-abundants))
4179871
> 

　これで答えが出ました。
　ちなみに、

> (sort (difference (sequence 1 (-- max-num)) two-abundants))
(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 25 26 27 28 29 31 33 
　：
 13621 13829 13879 14143 14251 14297 15371 15557 16187 17261 17891 18437 19067 20161)
> 

　ということから、20162 以上の数値が二つの過剰数の和になるようです。
　以上、如何でしょうか？

projecteuler5．．．または、和集合を定義する

　projecteuler の問題 5 は、1 から 20 の整数で割り切れる最小の値を求めるもの。ちなみに、1 から 20 の場合は 2520 。
　順当に割り算で割り切れるかどうか調べる方法だと、

(let (max-num 20 res 2)
  (for (i 2 max-num)
    (let (factors (factor i))
      (while (> (% res i) 0)
        (setq res (* res (pop factors -1))))))
  res)

　こんな感じ。ここで、% は余りを返す組込の整数演算子、同じく組込の浮動小数点数用の mod を使っても、同じ結果 232792560 になります。
　やっていることは、2 から 20 までの整数で res（初期値 2 ）を割り、余りが 0 でないなら、組込関数 factor で素因数分解した値を大きい方から順に res に掛け算して、余りが 0 になるまで繰り返すもの。
　ちなみに newLISP では、整数演算に +, -, *, /, % を、浮動小数点数演算に add、sub、mul、div、mod を使います。
　もちろん、+, -, *, /, % に浮動小数点数演算を割り当てることも簡単にできますが、この整数演算には桁数に制限がないというとんでもない利点があります（笑）。projecteuler13 で紹介した時は、開発版の newLISP で可能でしたが、今では標準装備（V.10.5.0）です。
　これでお終いですが、もう一つ解答例を、

(define (list-or2 lst1 lst2)
  (let (tmp lst1)
    (dolist (x lst2)
      (let (i (find x tmp))
        (if i (pop tmp i) (push x lst1 -1)))))
 lst1)

　と二つのリスト要素の和集合を返す関数list-or2 を定義しておきます。こうすれば、後は 2 から 20 までの整数を素因数分解したリストの集合和を取って、そのリスト要素を全て掛け算するだけ。

> (apply * (apply list-or2 (map factor (sequence 2 20)) 2))
232792560
> 

　こんな感じ。newLISP の組込apply はオプションで畳み込みができますからね。こういう小技も newLISP の魅力の一つ。
　和集合は、組込関数difference を使って、

(define (list-or2 lst1 lst2)
  (let (x (append (difference lst2 lst1 true) lst1)
        y (append (difference lst1 lst2 true) lst2))
    (if (> (length x) (length y)) x y)))

　という風にも書けます。組込関数difference はリスト要素の差を返しますが方向性を持っているので、どちらを返すかリストの長さで決めています。
　さらに和集合を汎用関数として、

(context 'MAIN:list-or)
(define (or2 lst1 lst2)
  (let (tmp (or lst1 '()))
    (dolist (x (or lst2 '()))
      (let (i (and tmp (find x tmp)))
        (if i (pop tmp i) (push x lst1 -1)))))
 lst1)
(define (list-or:list-or)
  (let (len (length (args)))
    (if (= len 1) (args 0)
        (= len 2) (or2 (args 0) (args 1))
        (> len 2) (list-or (args 0) (apply list-or (1 (args))))
        '())))
(context MAIN)

　と定義すれば、

> (apply * (apply list-or (map factor (sequence 2 10))))
2520
> (apply * (apply list-or (map factor (sequence 2 20))))
232792560
> 

　畳み込みもいらない！この方が context を使っていて newLISP っぽい（笑）。

　以上、如何でしょうか？