projecteuler11．．．または、関数を作る関数

　projecteuler の問題11 は、20 行 20 列の数値から縦、横、対角方向で連続する四つの数値の積の最大値を求めるの。
　まずは、一行から四つの数値の積を求める関数を考えます。

(define (make_product-n n)
  (letex (n n)
(fn (lst)
  (let (res)
    (dotimes (i (- (length lst) n 1))
      (if (for-all number? (i n lst))
        (push (apply * (i n lst)) res -1)))
    res))))

　これは、いわゆる関数を作る関数です。マクロでも良かったのですが（笑）。
　引数の n に 4 を与えれば、リスト中の連続する四つの数値の積を計算してリストで返してくれます。組込 letex を使って、戻り値の関数（ラムダ式）に引数の n の評価値を渡すのがポイント。戻り値の関数に即値を渡すなら、マクロによりも引数が評価される関数の方が都合が良かったりします。組込 letex は、newLISP のマクロ（fexpr）作成の要。いずれ、詳細に紹介したいところですが、、、
　さて、戻り値の関数は、渡された n の評価値を使って、slice 的な暗黙な要素指定で取り出される要素の積を変数 res に入れていきます。
　繰り返し関数 dotimes は指定した回数分だけ繰り返し動作を行います。for-all も組込関数で、引数の述語に対してリストの中身が全て true になる時、true を返します。
　さて、動作例は、

> ((make_product-n 4) (sequence 1 10))
(24 120 360 840 1680)
> 

　こんな感じ。
　後は、与えられた行列数値文字を数値に直して、計算するだけ。

> [cmd]
(let (product-n (make_product-n 4)
      matrix
  (map (fn(x) (map (fn (y) (int y nil 10)) (parse x " ")))
    (clean null? 
      (parse [text]
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48
[/text] {\r|\n} 0))))
  (let (res (map product-n matrix))
    (push (map product-n (transpose matrix)) res -1)
    (let (len (length matrix) tmp1 nil tmp2 nil)
      (dolist (x matrix)
        (push (append (dup nil (- len 1 $idx)) x (dup nil $idx)) tmp1 -1)
        (push (append (dup nil $idx) x (dup nil (- len 1 $idx))) tmp2 -1))
      (push (map product-n (transpose tmp1)) res -1)
      (push (map product-n (transpose tmp2)) res -1))
    (apply max (clean nil? (flat res)))))
[/cmd]
70600674
> 

　説明するまでもないかもしれませんが、最初に行ごとに四つの積を求め、

(map product-n matrix)

　次に関数 transpose 使って行と列を入れ替え、列の値も求めます。

(map product-n (transpose matrix))

　transpose は組込関数で、転置行列を返します。
　残りは対角方向。対角方向が一列になるよう、各行に対応した nil を追加します。対角方向は二つあるので、

      (dolist (x matrix)
        (push (append (dup nil (- len 1 $idx)) x (dup nil $idx)) tmp1 -1)
        (push (append (dup nil $idx) x (dup nil (- len 1 $idx))) tmp2 -1))

　両方作成し、関数 transpose 使って行と列を入れ替え、行にして計算します。
　計算結果は全て、変数 res に入れておき、最後に、

(apply max (clean nil? (flat res)))

　で、求める値を出すわけです。
　flat は組込関数で、リスト内の余分な括弧を全て取り払ってくれます。v.10.5 からは取り去る括弧の階層も指定できるようになり、さらに便利に（笑）。
　関数 product-n は計算対象に nil が入っているものには nil を返すので、組込関数 clean で nil を片付けから、組込関数 max に引渡します。
　と、こんなところ。

　以上、如何でしょうか？

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 文は答えになる数字の組みを表示するためのもので、問題には必要のないコード。無くても、構いません。

　以上、如何でしょうか？

projecteuler8．．．または、newLISP の文字列

　今回の projecteuler は、順当に問題 8 だけ。問題で指定された 1000 個の数字から連続する 5 個の数字を取り出し、その積を計算し、最大値を求めるもの。

(let (str (replace {\D} [text]
73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450
[/text] "" 0))
  (let (n (length str) 
        nums (map int (explode str))
        res 0)
    (for (i 1 (- n 5))
      (let (x (apply * (i 5 nums)))
        (when  (> x res)
          (swap res x) (println (i 5 nums))
        )))
  res)
)

　与えられた 1000 個の数字は 20 桁 20 行の文字列。
　newLISP の文字列には、三種類の形式があります。よく使われるのが、""（ダブル・クォート）で囲むもの。文字列の中に ＼（バックスラッシュ、日本語環境下では ¥ 記号）によるエスケープ・シーケンスが使えます。二つ目は、{}（波括弧）で囲むもの。この中では、エスケープ・シーケンスは使えませんが、そのおかげでエスケープ・シーケンス開始文字のかぶる正規表現の書式指定を書く時に便利です。もう一つが、2048 文字を超える文字列には必須の [text] と [/text] のタグで囲むもの。
　ということで、今回は三種類とも使ってみました。
　与えられた数値の文字列を [text] と [/text] のタグで囲み、改行を除いて一連の数列にするために、組込関数 replace を使います。replace の検索文字には正規表現が使えるので、数字以外を表す \D を {}（波括弧）で囲んでいます。数字以外を削除するために、置換文字を ""（空文字列）にしています。
　文字列の説明はこれくらいにして、スクリプトの動作を。と言っても、説明するまでもないかもしれません（笑）。
　一連の数列の文字列を組込関数 explode を使って一個ずつの数値文字にばらし、組込関数 map と int で数値リストに変換して、変数 nums に入れておきます。
　後は、数値リストから 五個ずつ取り出し、その積を計算し、最大値を入れてある変数 res と比較して大きければ、組込関数 swap を使って値を交換します。この場合、組込関数 setq でも十分ですが、swap を紹介しておきたかったので（笑）。
　when 内の println 文は答えになる数字の組みを表示するためのもので、問題には必要のないコードです。一行コメントの ;（セミコロン）をつけて、外しておいてもいいでしょう。
　さて、このスクリプト動作は、

(3 1 6 7 1)
(1 6 7 1 7)
(6 7 1 7 6)
(9 6 7 4 4)
(4 9 6 9 8)
(9 4 7 8 8)
(7 6 6 8 9)
(9 9 8 7 9)
40824
> 

　こんな感じ。答えは 9✕9✕8✕7✕9＝40824 となります。

　以上、如何でしょうか？

projecteuler7 と 10．．．または、newLISP の関数 format

　今回の projecteuler は、10001 番目の素数を求めるという問題 7 と 2000000 以下の素数の和 を求める 問題 10 の二つ。どちらも素数を探し出すために繰り返し処理を実行するので、まとめました。

(let (i 3 res '(2))
  (while (< (res -1) 2000000)
    (when (= (length (factor i)) 1) (push i res -1))
    (++ i 2))
  (println "The answer of Problem  7 = " (format "%12d" (res 10000)))
  (print "The answer of Problem 10 = ") (apply + (chop res)))

　このスクリプトの動作は、リスト変数 res に予め素数の初期値を 2 入れて置き、3 から二つ置き（奇数だけ）に組込関数 factor を使って、因数分解数が一個のものを素数と判定し、res に追加していきます。最後に見つかった素数 (res -1) が 2000000 を超えたら while を抜けて、各問題の答えを表示します。
　++ は組込で、Common Lisp の incf に相当します。ちなみに、++ は整数用で、浮動小数点数には inc を使います。上記スクリプトに inc を使っても動作します。newLISP の方で必要に応じて型変換してくれますから。もちろん、減算用の –– と dec もあります。
　println と print も組込で、共に引数を評価して表示します（正確にはカレントI/Oデバイスに出力する）。違いは改行出力の有無です。
　また、組込 chop は Common Lisp の butlast に相当します。つまり、リストの最後の要素を取り除いて返します。リストだけでなく、文字列にも使えるのが newLISP 流です（笑）。これを使って、2000000 超の素数を取り除いています。
　残る副題にもなっている組込 format は文字列を整形する書式関数ですが、Common Lisp の書式を大きく異なります。と言うより、C 言語の printf の書式とほぼ同等です。Lisper には馴染めなくとも、私のような C 言語習得者にとっては救いの神です（笑）。注意が必要なのは、newLISP の整数は 64 ビットですが、通常の整数書式は 32 ビット対応である点 と 32 ビット以上の整数を整形するのに必要な 64 ビット用の書式が OS によって異なる点くらいでしょうか。詳しくは、マニュアルの format の項を見てください。
　さて、気になる答えは、

> [cmd]
(let (i 3 res '(2))
  (while (< (res -1) 2000000)
    (when (= (length (factor i)) 1) (push i res -1))
    (++ i 2))
  (println "The answer of Problem  7 = " (format "%12d" (res 10000)))
  (print "The answer of Problem 10 = ") (apply + (chop res)))
[/cmd]
The answer of Problem  7 =       104743
The answer of Problem 10 = 142913828922
> 

　こんな感じ。

　以上、如何でしょうか？

追記：2013/6/9 スクリプト修正、検討途中のスクリプトを入れてしまった、、、（汗）

projecteuler6．．．または、newLISP の無名関数

　projecteuler の問題 6 は、1 から 100 までの自然数の和を二乗したものと、1 から 100 までを各々二乗してから和を求めたものとの差。
　と、projecteuler にしては至極単純な計算。これを newLISP 風に料理する（笑）と、

(let (numbers (sequence 1 100)
      square (fn (x) (* x x)))
  (- (square (apply + numbers))
     (apply + (map square numbers))))

　こんな感じ。newLISP にはｍのｎ乗を計算してくれる組込関数pow もありますが、ここでは二乗する関数 square をラムダ式で定義しています。LISP で一般的な無名関数lambda は当然 newLISP でも使えますが、newLISP では組込関数fn を使うのが普通。fn と言えば、マニュアルにも記載がある通り、

Paul Graham氏 が Arc 言語プロジェクトで提案している代替構文

　です。新世代 LISP にふさわしい構文と言えましょう。まっ、欠点といえば、fn というシンボル名が使えないことくらい（笑）。
　さて、気になる答えは、

> [cmd]
(let (numbers (sequence 1 100)
      square (fn (x) (* x x)))
  (- (square (apply + numbers))
     (apply + (map square numbers))))
[/cmd]
25164150
> 

　以上、如何でしょうか？

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 っぽい（笑）。

　以上、如何でしょうか？