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。

　以上、如何でしょうか？

projecteuler4（続き）．．．または、組み合わせの求め方

　さて、問題4 の続きです。
　三桁の数同士を掛け算して、最大の回文数を求めるために、最初に回文数を用意します。

(setq digit 3
       max-num (pow 10 digit)
       numbers (sequence (pow 10 (- digit 1)) (- max-num 1))
       strings1 (map string numbers)
       strings2 (map reverse strings1)
       palindromes (map int (map append strings1 strings2)))

　palindromes の中に回文数が小さい順に入っています。それを newLISP 組込関数 reverse を使って順を逆にして、大きい順から一個一個、三桁の数同士の掛け算になるかどうかを確認します。
　そのために、例えば 906609 を newLISP 組込関数 factor で因数分解すると、

> (factor 906609)
(3 11 83 331)
> 

　このままでは、三桁の数同士の掛け算になるかどうか判りません。4つの数値を組み合わせて、二つの掛け算にする必要があります。
　その組み合わせは、

((3 11 83) (331))
((3 11 331) (83))
((3 11) (83 331))
((3 83 331) (11))
((3 83) (11 331))
((3 331) (11 83))
((3) (11 83 331))

　の7通り、リスト (3 11 83 331) の位置で表すと、

(0 0 0 1)
(0 0 1 0)
(0 0 1 1)
(0 1 0 0)
(0 1 0 1)
(0 1 1 0)
(0 1 1 1)

　と、こんな感じ。お気づきでしょうか、この組み合わせ方を binary counting と言うそうです。ここまで来れば、あとは実装するだけ。それが、前回紹介したコードになります。実行時間は早いはず、わずか 94 個目で解答にたどり着くわけですから（笑）。

　以上、如何でしょうか？

newLISP で On Lisp する．．．第５章（その１）

（この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。）
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp に定義してあります。

　今回から、第５章 返り値としての関数 。
　まず、Common Lisp は進化する では、スクリプト例がいくつかありますが、“On Lisp”本書の主張は、

“レキシカル･スコープなら、それだけで、実行時にクロージャを生成できる。”

ということです。
決して、

“レキシカルスコープと違って、ダイナミック･スコープでは実行時にクロージャを生成できないし、出来たとしても、内部変数が、最終的に呼び出された環境に左右される”

　ではありません。なぜなら、Common Lisp からすればダイナミック･スコープといえる newLISP でも、実行時にクロージャを生成可能だからです。それは、第２章（その３）で make-adder の例 を実証しました。また、そこでは、内部状態を変化させられるクロージャも可能であることも示しました。
　ということは、newLISP は、レキシカル・スコープ？そんな訳はありません。こう言い換えるべきでしょう、

“ダイナミック･スコープでも、レキシカル･スコープのようなクロージャを生成できる言語もある。newLISP のように。”

　冗談（笑）は、さておき、スクリプトを実装しましょう。（defun は newlisp-utility.lsp に定義してあります）

(defun joiner (obj)
  (case (type-of obj)
    ("list" append)
    ("integer" +)
    ("float" add)))
(defun joinEx ()
  (apply (joiner (args 0)) (args)))

　newLISP には、組込join があるので、joinEx に改名してあります。また、newLISP には、typecase は無いので、前に紹介したこと のある ArtfulCode ユーティリティ の type-of と組込<a href="http://www.newlisp.org/downloads/newlisp_manual.html#case"case を組み合わせています。
　動作は、

> (joinEx 1 2 3)
6
> (joinEx 1.1 2.2 3.3)
6.6
> (joinEx '(1) '(2 3) '(4 5 6))
(1 2 3 4 5 6)

　ダイナミックスコープの下でできることだから、当たり前。
　make-adder は、第２章（その３）で試しているので、次の関数complement を

(defun complement (f)
  (letex (func f)
    (fn () (not (apply func (args))))))

　もちろん、所望の動作をします（remove-if、evenp、oddp、numberp は newlisp-utility.lsp に定義してあります）。

> evenp
(lambda (num) (= (& num 1) 0))
> oddp
(lambda (num) (= (& num 1) 1))
> remove-if
clean
> (remove-if oddp '(1 2 3 4 5 6))
(2 4 6)
> (remove-if (complement oddp) '(1 2 3 4 5 6))
(1 3 5)
> numberp
number?
> (remove-if (complement numberp) '(1 a 2 b 3 c))
(1 2 3)
> (setq e? (complement oddp))
(lambda () (not (apply (lambda (num) (= (& num 1) 1)) (args))))
> (map e? '(1 2))
(nil true)
> (setq s? (complement numberp))
(lambda () (not (apply number? (args))))
> (map s? '(a 1))
(true nil)

　引数の関数が、組込であれ、自作であれ、クロージャ内に束縛されているのを見ることができます。つまり、Common Lisp 同様、newLISP も抽象化のための強力な道具を手にしています。

　次は、直交性 。newLISP も、直交的なプログラミング言語だといえると思います。最初は、等価で破壊的な関数を返すオペレータを newLISP で定義した例です。newLISP には、ハッシュがありませんので、代わりに context のハッシュ的な使い方を使っています。

(define *equivs*:*equivs*)
(defun !! (f)
  (or  (*equivs* (string "'" f)) f))
(defun def! (f f!)
  (*equivs* (string "'" f) '())
  (setf (*equivs* (string "'" f)) f!))

　! 単品は、newLISP では、組込関数なので、!! に名前を変えてあります。関数def! の一行目は、context 内に、シンボルを用意しておかないと、setf が変更できる対象がないというエラーになるからです。
　動作は、破壊的関数delete-if がないので、用意します。

(define-macro (delete-if)
  (let (_sym (symbol? (args 1)))
    (letex (_fn (args 0)
            _lst (args 1))
      (if _sym
          (setf _lst (clean _fn _lst))
        (clean _fn _lst)))))

そして、

> (def! remove-if delete-if)
(lambda-macro () 
 (let (_sym (symbol? (args 1))) 
  (letex (_fn (args 0) _lst (args 1)) 
   (if _sym 
    (setf _lst (clean _fn _lst)) 
    (clean _fn _lst)))))
> (setq lst (sequence 0 9))
(0 1 2 3 4 5 6 7 8 9)
> (remove-if evenp lst)
(1 3 5 7 9)
> lst
(0 1 2 3 4 5 6 7 8 9)
> ((!! remove-if) evenp lst)
(1 3 5 7 9)
> lst
(1 3 5 7 9)
> ((!! remove-if) evenp (sequence 0 9))
(1 3 5 7 9)
> (remove-if evenp (sequence 0 9))
(1 3 5 7 9)

　所望の動作をしています。newLISP では、破壊と非破壊の両方の関数がある場合が少ないので、そういう用途で使うことは、あまりないでしょうけど（笑）。

　関数の値のメモ化 の、関数memoize は、newLISP の解説書 “Code Patterns in newLISP” にあります（“Speed up with memoization” の項）。ただし、紹介されているコードは、関数を定義するマクロです。本章に合わせてクロージャを返す関数に再定義します。
（gensym は newlisp-utility.lsp に定義してあります）

(defun memoize (func) 
  (let (ctx (gensym))
    (context ctx)
    (letex (f func  c ctx) 
      (fn () 
        (or (context c (string (args))) 
            (context c (string (args)) (apply f (args))))))))

もちろん、context を使っています。そして、動作例です。

> (setq slowid (memoize (fn (x) (sleep 5000) x)))
(lambda () (or (context gensym3 (string (args))) (context gensym3 (string (args)) 
   (apply (lambda (x) (sleep 5000) x) (args)))))
> (time (slowid 1))
5000
> (time (slowid 1))
0

newLISP の場合、組込sleep の引数と組込time の戻り値の単位は、共に、ミリ秒です。

切りが良いので、関数を合成する は、次回に。

以上、如何でしょうか？