Archive for the ‘filter’ Tag

projecteuler2...または、newLISP リストのインデックス操作

 projecteuler も2回目。
 問題2は 1, 2 から始まるフィボナッチ(Fibonacci)数列で四百万を超えない偶数値の和。
 まずは、フィボナッチ数列を求めます。

> [cmd]
(let (fibo '(1 2))
  (while (< (fibo -1) 4000000)
    (push (apply + (-2 2 fibo)) fibo -1))
 (chop fibo))
[/cmd]
(1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 
 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578)
> 

 こんな感じ。ここで、関数chop は組込関数で Common Lisp の butlast に相当します。つまり、リストの最後の要素を削除するもの。また Common Lisp では自分で定義する必要のある while も newLISP では組込です。動作は、、、説明いりませんね(笑)。
 今回のもう一つの主題、リストのインデックス操作。そのための関数(nthslice)もありますが、インデックス数を使って直接操作するのが newLISP 流(笑)。暗黙のインデックス機能(Implicit indexing)です。
 上記の中では、リストから最後の要素を取り出す

(fibo -1)

 や最後から二つの要素の部分リストを作る

(-2 2 fibo)

 がそれに相当します。
 そして、本題。求めたフィボナッチ数列から偶数を取り出すのに前回の select-numbers を使ってもよいのですが、述語(条件式)が一つですから、ここは newLISP組込filter を使います。この関数は、リストから述語(条件式)で真(true)になるものだけ返します。

> (filter even? (sequence 1 10))
(2 4 6 8 10)
> 

 もちろん、この関数とは逆に、述語(条件式)で真(true)になるものだけリストから削除する関数clean もあります。
 さてと、問題2の解答は、

> [cmd]
(let (fibo '(1 2))
  (while (< (fibo -1) 4000000)
    (push (apply + (-2 2 fibo)) fibo -1))
  (apply + (filter even? (chop fibo))))
[/cmd]
4613732
> 

 となります。
 あっ、述語(条件式)even? も組込です。説明、、、いりませんね(笑)。

 以上、如何でしょうか?

広告

newLISP で On Lisp する...第4章(その2)

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

今回は、第4章 の リストに対する操作
リストに作用する小さな関数 は、以下のようになります。

(module "macro.lsp")
(define last1 last)
(macro (single L)
  (and L (list? L) (not (rest L))))
(macro (append1 L Obj)
  (append L (list Obj)))
(macro (conc1 L Obj)
  (extend L (list Obj)))
(macro (mklist Obj)
  (if (listp Obj) Obj (list Obj)))

newLISP に、インライン宣言はありません。
そのため、効率性のために、macro を使います(macro の日本語訳はこちら)。
macro を有効にするためにスクリプトの先頭で

(module "macro.lsp")

としていますが、前に紹介した include を使って、

(include "macro.lsp")

としておけば、二重ロードを防げます。
動作は、

> (single '())
()
> (single 'a)
nil
> (single '(a))
true
> (single '(a b))
nil
> (let (x '(1 2))(println (append1 x 3)) x)
(1 2 3)
(1 2)
> (let (x '(1 2))(println (conc1 x 3)) x)
(1 2 3)
(1 2 3)
> (let (x '(1 2))(println (append1 x 3)) x)
(1 2 3)
(1 2)

こんな感じです。
macro を使いたくない場合は、conc1 以外は、macrodefine に置き換えれば、そのまま使えます。
ただし、conc1 は破壊的関数です。newLISP で破壊的関数を書くには、マクロが必要です。
macro を使いたくない場合、conc1 は、

(define-macro (conc1)
  (letex (_lst0 (args 0)
          _lst1 (args 1))
    (extend _lst0 (list _lst1))))

となります。
newLISP の組込関数last は、Common Lisp の last とは違いって、リストではなく、要素で返します。つまり、last1 と同じ。
では、Common Lisp 流の last を使いたい時は、どうするのか?
インデックス機構を使って、

> (-1 '(a b c))
(c)
> (-2 '(a b c))
(b c)
> (-3 '(a b c))
(a b c)
> (0 '(a b c))
(a b c)
> (1 '(a b c))
(b c)
> (2 '(a b c))
(c)

直接リストから、取り出せます。
ちなみに、Common Lisp 流の last を newLISP で定義すると

(context 'clisp)
(defun clisp:last (lst n)
  (if (consp lst)
      (if (and n (number? n))
          (let (len (length lst))
            (if (< len n) lst
                ((- (length lst) n) lst)))
        (-1 lst))
    lst))
(context MAIN) 

こんな感じ?

続いて、リストに作用する関数の大規模なもの の方です。

(defun longer (x y)
  (labels ((compare (x y)
             (and (consp x)
                  (or (null y)
                      (compare (cdr x) (cdr y))))))
    (if (and (listp x) (listp y))
        (compare x y)
      (> (length x) (length y)))))

(defun filter+ (f lst)
  (local (acc)
    (dolist (x lst)
      (let (val (f x))
        (if val (push val acc -1))))
    acc))

(defun group (src n)
  (if (zerop n) (error "zero length"))
  (labels ((rec (src acc)
             (let ((rests (nthcdr n src)))
               (if (consp rests)
                   (rec rests (cons (subseq src 0 n) acc))
                 (reverse (cons src acc))))))
    (if src (rec src '()) nil))) 

zerop と labels は、newlisp-utility.lsp に定義してありますので、関数longer は、何の変更もなく動きます。
動作はというと、

> (longer '(a b (c (d)) e f g) '(a b (c d) e f g))
nil
> (longer '(a b c d e f g) '(a b (c d) e f g))
true

関数filter+ は、newLISP組込関数に filter があるので filter+ と名前を変えています。
newLISP の組込push は、項目をリストの最後に挿入できるので、reverse を使っていません。

> (filter+ (fn (x) (if (numberp x) (+ 1 x))) '(a 1 b 3 c d 4))
(2 4 5)

newLISP では、λ式に fn が使えるので楽です。また、関数filter+ を使わなくても、

> (replace nil (mapcar (fn (x) (if (numberp x) (+ 1 x))) '(a 1 b 3 c d 4)))
(2 4 5)

で、実現できます(“On Lisp” 後注48より)。
次の関数group は、newLISP にはない関数 nthcdr と subseq を使っています。newLISP ではどちらもインデックス機構で実現できるので、わざわざ組込関数にしていないのでしょう。以下に、それらの定義を記しておきます。

(defun nthcdr (num lst)
  (when (consp lst) (num lst)))

(defun subseq (lst start end)
  (if (nil? end)
      (start lst)
    (let (len (- end start))
      (start len lst))))

また、newLISPには組込関数rest があるので内部変数rest は、rests に変えてあります。
動作はというと。

> (group '(a b c d e f g) 2)
((a b) (c d) (e f) (g))

しかし、newLISP では組込関数explode が関数group と同様な機能を持っています。

> (explode '(a b c d e f g) 2)
((a b) (c d) (e f) (g))

本書にもあるように、関数group は後でも使われるので、以降は、こう定義します。

(define group explode)

さて、リストに対する操作 の最後は、関数flatten と prune 。

(defun flatten (x)
  (labels ((rec (x acc)
             (cond ((null x) acc)
                   ((atom x) (cons x acc))
                   (t (rec (car x) (rec (cdr x) acc))))))
    (rec x '())))

(defun prune (test tree)
  (labels ((rec (tree acc)
           (cond ((null tree) (reverse acc))
                 ((consp (car tree))
                  (rec (cdr tree)
                  (cons (rec (car tree) '()) acc)))
                 (t (rec (cdr tree)
                         (if (test (car tree))
                             acc
                           (cons (car tree) acc)))))))
    (rec tree '())))

関数flatten は、内部関数rec の引数 nil'() に変えてあるほかは、本文と同じです。
動作はというと、

> (flatten '(a (b c) ((d e) f)))
(a b c d e f)

この機能もまた、newLISP で組込関数flat として、用意されています。

> (flat '(a (b c) ((d e) f)))
(a b c d e f)

以降は、こう定義します。

(define flatten flat)

先ほどの 組込関数explode と同様、newLISP には、ユーティリティに相応しい関数が、最初から組み込まれています。
さて、次の関数prune も、関数flatten のときと同様、nil'() に変えてあります。nil のままだと、flattenも同様ですが、nil が cons されてそのままリストに残ってしまいます。また、funcall もはずしてあります。動作はというと、

> (prune evenp '(1 2 (3 (4 5) 6) 7 8 (9)))
(1 (3 (5)) 7 (9))
> (prune oddp '(1 2 (3 (4 5) 6) 7 8 (9)))
(2 ((4) 6) 8 ())

もちろん、#' は要りません。
ちなみに、CommonLisp(xyzzyを含む)で、oddp 使った時は、

> (prune oddp '(1 2 (3 (4 5) 6) 7 8 (9)))
(2 ((4) 6) 8 nil)

となります。意味的には同じですが、気になる方は最後の行を

(replace '() (rec tree '()) nil)))

とすれば見た目も同じになります。どちらをとるかはお好みで。
検索 からは、次回に。

以上、如何でしょうか?