projecteuler14．．．または、再帰か繰り返しか

　projecteuler の 問題14 は、コラッツの問題から、百万以下で最も長い数列をもたらす数値を求めるもの。
　数値を与えて、コラッツの数列を求める関数は、再帰を使うと簡単に定義できます。

(define (collatz n lst)
  (push n lst -1)
  (if (even? n) (collatz (/ n 2) lst)
      (and (odd? n) (> n 1)) (collatz (++ (* 3 n)) lst)
      lst))

　newLISP の if は cond 的な記述ができるので、楽です（笑）。

> (collatz 13)
(13 40 20 10 5 16 8 4 2 1)
> 

　再帰を使うと見通しはいいですが、難点は速度。
　そこで、newLISP には豊富にある繰り返し関数から while を使って、再度定義してみます。

(define (Collatz n)
  (let (lst (list n))
    (while (> n 1)
      (if (even? n) (setq n (/ n 2)) (setq n (++ (* n 3))))
      (push n lst -1))
    lst))

　この程度なら、再帰と比べて見通しも悪くありませんし、早さは 5 ～ 6 倍違います。

> (Collatz 13)
(13 40 20 10 5 16 8 4 2 1)
> 

　これで、コラッツの数列を求める関数はできました。
　後は、百万回繰り返して、最長のリストを求めるだけ。

> [cmd]
(let (res)
  (for (i 1 1000000)
    (let (x (Collatz i)) (if (> (length x) (length res)) (setq res x))))
  res)
[/cmd]
(837799 2513398 1256699 3770098 1885049 5655148 2827574 1413787 4241362 2120681 6362044 
 3181022 1590511 4771534 2385767 7157302 3578651 10735954 5367977 16103932 8051966 
 ：
 ：
 4025983 12077950 6038975 18116926 9058463 27175390 13587695 40763086 20381543  911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 
 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1)
> 

　最長の数列の長さは 525 。繰り返し関数 for も newLISP では標準です。
　さて、問題の要求しているのは、数列の最初の数値 837799 だけですから、もう少し工夫して、

> [cmd]
(let (res '(0 0))
  (for (i 1 1000000)
    (let (x (length (Collatz i))) (if (> x (res 1)) (setq res (list i x)))))
  (res 0))
[/cmd]
837799
> 

　こんな感じ。

　以上、如何でしょうか？

projecteuler9．．．または、newLISP 繰り返し構文からの脱出

　projecteuler の問題 9 は、ピタゴラスの三平方の定理を満足する自然数の組み a b c の和が 1000 になるものの積。
　結果はこうなります。

> [cmd]
(let (res)
  (for (a 1 998 1 res)
    (for (b 1 998 1 res)
      (let (c (- 1000 a b))
        (if (= (* c c) (+ (* a a) (* b b)))
            (setq res (list a b c))))))
  (println res)
  (apply * res))
[/cmd]
(200 375 425)
31875000
> 

　newLISP の繰り返し関数 for、dolist、dostring、dotimes には、オプションで脱出条件があります。条件式が nil 以外になると繰り返し構文を抜けるというもの。空リストも nil 以外ですから、ご注意を。上記スクリプトでは、 for 文の最初の引数リストの最後にある変数 res が、それです。この変数が nil 以外になると、直ちに for 文が終了します。
　さて、newLISP と使っている時、map を使うか繰り返し構文を使うかは迷いどころ。私の場合は、リストの要素に同じ処理を施してリストで返す場合は map 、それ以外は繰り返し構文を使うことが多いです。
　さて、上記スクリプトは、ピタゴラスの定理が満足した所で res に求める自然数の組みがリストで入り、脱出条件を満足するので for 文も終了します。後は、その積を求めるだけ。
　前回 と同じで println 文は答えになる数字の組みを表示するためのもので、問題には必要のないコード。無くても、構いません。

　以上、如何でしょうか？

projecteuler4．．．または、newLISP の繰り返し構文

　projecteuler も５回目。前回はちょっと飛びましたが、今回は順当（笑）に問題4。三桁の数同士を掛け算して、最大の回文数を求めるというもの。
　これをで力技でやると、

(let (lst)
  (for (i 100 999)
    (for (j i 999)
      (let (str (string (* i j)))
        (if (and (= 6 (length str))
                 (= (0 3 str) (reverse (3 3 str))))
          (push str lst -1))
      )
    )
  )
  ((sort lst) -1)
)

　こんな感じ。newLISP には組込で for がありますから楽です。
　組込関数string は引数を文字列に変換します。
　掛け算した結果が６桁なら、文字列にも暗黙のインデックス機能（Implicit indexing）が使えるので、前半と後半を分け、比較します。
　同じなら、変数 lst に入れておいて、最後に組込関数 sort で並べ替えます。この関数は数値でも文字列でもなんでも並べ替えます。
　そして、最後の値（文字列）を取り出せば、答えに 906609 が得られます。
　まっ、これで終了ですが、もう一つ解答例を、

(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)
  (let (res '(()()))
    (dolist (x lst)
      (push $idx (if x (res 0) (res 1)) -1))
  res))
(memoize divide2 (lambda (n)
  (let (res)
    (for (x 1 (- (/ (pow 2 n) 2) 1))
      (let (lst (bits x true))
        (push (if (< (length lst) n) (append lst (dup nil (- n (length lst)))) lst)
              res -1))
    )
  (map make-sublist res))))
(define (judge numbers digit)
  (letn (max-num (pow 10 digit)
         sublist (divide2 (length numbers))
         res)
    (dolist (x sublist res)
      (let (n1 (apply * (select numbers (x 0)))
            n2 (apply * (select numbers (x 1))))
        (if (and (< n1 max-num) (< n2 max-num)) (push (list n1 n2) res)))
     )
    res
  ))
(letn (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))
       res)
  (dolist (x (reverse palindromes) res)
    (let (primes (factor x))
      (when (< (apply max primes) max-num)
        (if (judge primes digit) (setq res x)))))
  res
)

　コードは長いですが、実行時間は二桁早くなります。
　やっているのは、最初に回文数のリストを作って、大きい方から三桁同士の掛け算になるかどうかを判定するというもの。
　解説は、、、次回に。

　以上、如何でしょうか？