Lisp Scheme

[Lisp] 手続きを返す手続き (プログラミングGauche リストの基本操作 p68 練習問題)

Lispは手続きを受け取る手続きや手続きを返す手続きを組み合わせて大きなシステムを作っていくそうです。
Lisp初心者にはハードルがきつい...
「プログラミングGauche」のp68の練習問題を考えてみます。

for-each-numbers

まずはfilterの手続きです。

;; filter をcondを使って定義
(define (filter pred lis)
  (cond ((null? lis) ())
        ((pred (car lis)) (cons (car lis) (filter pred (cdr lis))))
        (else (filter pred (cdr lis)))))

condを使ってfilterを定義しています。
lisがnullだったらからのリストを返して、そうでなければリスト再帰呼び出しした結果に連結します。

次は、filterを使って数値の時だけて手続きを適応するfor-each-numberを考えます。
filterがあれば、for-eachを使って...

1 2	`(define (for-each-numbers proc lis)` `(for-each proc (filter number? lis)))`

for-eachに渡すリストを数値のみにすれば簡単です。

;; filter をcondを使って定義
(define (filter pred lis)
  (cond ((null? lis) ())
        ((pred (car lis)) (cons (car lis) (filter pred (cdr lis))))
        (else (filter pred (cdr lis)))))
 
(define (for-each-numbers proc lis)
  (for-each proc (filter number? lis)))
 
(define (main args)
    (print (for-each-numbers print '(1 2 #f 3 4 #t)))
    0)
gosh>1
2
3
4
#<undef>

map-numbers

map-numbersはどのようにするでしょうか...
mapとfilterを組み合わせれば作成できます。
テストする時には、何かしらか処理を与えないといけないので、2倍してみます。

(define (map-numbers proc lis)
  (map proc (filter number? lis)))
 
(define (main args)
    (print (map-numbers (lambda (x) (* x 2)) '(1 2 #f 3 4 #t)))
    0)
 
gosh> (2 4 6 8)

numbers-only

for-eachやmapなどの手続きを引数にとって数値だけに適応するnumbers-onlyは以下のようのなります。

(define (numbers-only proc)
  (lambda (sub-proc lis) (proc sub-proc (filter number? lis))))
 
(define (main args)
    (print ((numbers-only map) (lambda (x) (* x 2)) '(1 2 #f 3 4 #t)))
    0)
 
gosh> (2 4 6 8)

lambdaを返すようにするのがポイントでしょうか。

numbers-only-for-tree

はじめに考えたのは以下の物でした。(問題の意図とは違いますが答えはあっている?)

(define (numbers-only-tree-walk walker proc tree)
  (walker (lambda (elt)
            (if (list? elt)
                (numbers-only-tree-walk walker proc elt)
                (if (number? elt)
                    (proc elt)
                    )))
            tree))
(define (main args)
    (print (numbers-only-tree-walk for-each print
                      '((1 2 3 #f) 4 5 #t (6 (7 8)))))
    0)
 
gosh>1
2
3
4
5
6
7
8
#<undef>

上記の物は、結果はあっているのですが、tree-walkに渡す形式になっていません。
tree-walkにそのままfilterを使うとどうなるのでしょうか。

(define (filter pred lis)
  (cond ((null? lis) ())
        ((pred (car lis)) (cons (car lis) (filter pred (cdr lis))))
        (else (filter pred (cdr lis)))))
 
(define (tree-walk walker proc tree)
  (walker (lambda (elt)
            (if (list? elt)
                (tree-walk walker proc elt)
                (proc elt)))
          tree))
 
(define (numbers-only proc)
  (lambda (sub-proc lis) (proc sub-proc (filter number? lis))))
 
(define (main args)
    (print (tree-walk (numbers-only map) (lambda (x) (* x 1))
                            '((1 2 3 #f) 4 5 (#f 6 (7 8)))))
    0)
 
gosh> (4 5)

(4 5)になってしまいました。
numbers-onlyで使っているfilterは要素が対(pair)の場合は(pred (car lis))が成り立たないので読み捨てられてしまいます。
解決するには、ネストしたリストに対応したfilterを作成する必要があります。

ネストしたリストに対応したfilter

;; filter をcondを使って定義
(define (filter pred lis)
  (cond ((null? lis) ())
        ((pred (car lis)) (cons (car lis) (filter pred (cdr lis))))
        (else (filter pred (cdr lis)))))
 
;; pairの場合はcar, cdr両方にfilter-for-treeを適応する
(define (filter-for-tree pred lis)
  (cond ((null? lis) ())
        ((pair? (car lis)) (cons (filter-for-tree pred (car lis)) (filter-for-tree pred (cdr lis))))
        ((pred  (car lis)) (cons (car lis) (filter-for-tree pred (cdr lis))))
        (else (filter-for-tree pred (cdr lis)))))
 
;; filter-for-treeを使って数値のみに適応するnumbers-only-tree-walk
;; (numbers-onlyのfilterをfilter-for-treeに変更しただけ)
(define (numbers-only-tree-walk walker)
  (lambda (proc lis)
    (walker proc (filter-for-tree number? lis))))
 
(define (tree-walk walker proc tree)
  (walker (lambda (elt)
            (if (list? elt)
                (tree-walk walker proc elt)
                (proc elt)))
          tree))
 
(define (main args)
    (print (filter-for-tree number?
                      '((#f #t (#f #f)) (1 2 3 #f) 4 5 #t (#f 6 (7 8)))))
 
    (print (tree-walk (numbers-only-tree-walk map) (lambda (x) (* x 1))
                      ;'(() 1 2 3 #f 4 5 6 7 8 9 #t)))
                      ;'((#f #t) (1 2 3 #f) 4 5 #t (#f 6 (7 8)))))
                      '((#f #t (#f #f)) (1 2 3 #f) 4 5 #t (#f 6 (7 8)))))
    0)
 
 
gosh>((()) (1 2 3) 4 5 (6 (7 8)))
gosh>(() (1 2 3) 4 5 (6 (7 8)))

filter-for-treeではpair(対)の場合にcarとcdr両方にfilter-for-treeを再度適応しています。
ググるといくつか別のfilterの定義があって参考にしましたが、filter単体でうまく動作しないけど、tree-walkと一緒に使うと正しく動作するものもありました。

;; treeに対してfilterを適応するfilter-for-tree これでも動くけど, filter単体でうまく動作しない
(define (filter-for-tree pred tree)
  (filter (lambda (x) (or (pred x) (pair? x))) tree))
 
;; これも正しく動作した
(define (filter-for-tree pred lis)
  (cond ((null? lis) lis)
        ((pair? (car lis)) (cons (filter-for-tree pred (car lis)) (filter-for-tree pred (cdr lis))))
        ((pred (car lis)) (cons (car lis) (filter-for-tree pred (cdr lis))))
        (else (filter-for-tree pred (cdr lis)))))