vallog

2009/01/28

[scheme][Gauche][DrScheme]組み合わせ（combination）

この記事を見て、組み合わせを書いてみたくなり、書いてみました。
[アルゴリズム][C#2.0][C#3.0]C#で順列(Permutation)と組み合わせ(Combination)をすべて列挙してみよう
 http://d.hatena.ne.jp/zecl/20090127/p1

結局この辺をカンニングしまくりorz

[scheme]組合せのアルゴリズム
 http://d.hatena.ne.jp/ibaza/20080303/1204476552

ArcでL-99 (P26 リストから指定した個数を抜き出す組み合わせ)
http://cadr.g.hatena.ne.jp/g000001/20080302/1204443536

組合せ
 http://katamayu.net/archives/2006/05/11/012239

最初に書いてみたcombination手続き。

参考にしたのは[scheme]組合せのアルゴリズムのこのアルゴリズム。

nCr（n個からr個取り出す組合せ）は、

1. リストの先頭要素を除いた残りのリストからr-1個を選ぶ組合せのそれぞれに先頭要素を加えたものと、

2. リストの先頭要素を除いたリストからr個を選ぶ組合せ
の合計となる(1および2はそれぞれ再帰処理となる)。

3. n = r のときは選び方は一つなのでリストをそのままリストにして返す。例：(a b c) なら ((a b c)) にして返す

4. r = 1 のときは選び方はn通りあるのでリストの要素をそれぞれリストにして返す。例：(a b c) なら ((a) (b) (c)) にして返す

5. r = 0 または r がリストの要素数より大きいときは空リストを返す。

で、上記のアルゴリズムをそのまま写経したつもりなのがこれ。

;; combination
(define (combination ls r)
(cond
   ((or (null? ls)(null? ls)) '())
   ((or (zero? r)(> r (length ls))) '())
   ((= r 1)(map list ls))
   ((= r (length ls))(list ls))
   (else
    (cons (map (lambda (n)(cons (car ls) n))(combination (cdr ls)(- r 1)))
        (combination (cdr ls) r)))))

出力結果。
出力結果のリストがネストしてる・・・。

(combination '() 1) ;; => ()
(combination '(1 2 3) 4) ;; => ()
(combination '(1 2 3) 1) ;; => ((1) (2) (3))
(combination '(1 2 3) 3) ;; => ((1 2 3))
(combination '(1 2 3 4 5) 2)
;; => (((1 2) (1 3) (1 4) (1 5)) ((2 3) (2 4) (2 5)) ((3 4) (3 5)) (4 5))
(combination '(1 2 3 4 5) 3)
;; => (((1 (2 3) (2 4) (2 5)) (1 (3 4) (3 5)) (1 . #0=(4 5))) ((2 (3 4) (3 5)) (2 . #0#)) (3 . #0#))
(combination '(1 2 3 4 5) 4)
;; => (((1 (2 (3 4) (3 5)) (2 . #0=(4 5))) (1 . #1=(3 . #0#))) (2 . #1#))

cond ～ elseのelseのとこのconsがまずいことに気づく。
組合せをみてappend手続きがあることを知る。修正版combination。

;; combination
(define (combination ls r)
(cond
   ((or (null? ls)(null? ls)) '())
   ((or (zero? r)(> r (length ls))) '())
   ((= r 1)(map list ls))
   ((= r (length ls))(list ls))
   (else
    (append (map (lambda (n)(cons (car ls) n))
         (combination (cdr ls)(- r 1)))
        (combination (cdr ls) r)))))

出力結果。
今度はうまくいったはず！と、思いきや「#0=」「#1=」「#0#」「#1#」ってのが混ざってる・・・。これなに？なんか変な対ができてる・・・orz

(combination '() 1) ;; => ()
(combination '(1 2 3) 4) ;; => ()
(combination '(1 2 3) 1) ;; => ((1) (2) (3))
(combination '(1 2 3) 3) ;; => ((1 2 3))
(combination '(1 2 3 4 5) 2)
;; => ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
(combination '(1 2 3 4 5) 3)
;; => ((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 . #0=(4 5)) (2 3 4) (2 3 5) (2 . #0#) (3 . #0#))
(combination '(1 2 3 4 5) 4)
;; => ((1 2 3 4) (1 2 3 5) (1 2 . #0=(4 5)) (1 . #1=(3 . #0#)) (2 . #1#))

試しに同じcombination手続きをDrSchemeで実行してみたら、意図した通りに出力されてるっぽいのに・・・。

(combination '() 1)
(combination '(1 2 3) 4)
(combination '(1 2 3) 1)
(combination '(1 2 3) 3)
(combination '(1 2 3 4 5) 2)
(combination '(1 2 3 4 5) 3)
(combination '(1 2 3 4 5) 4)

DrSchemeでの実行結果。うまくいってるっぽい・・・。

()
()
((1) (2) (3))
((1 2 3))
((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5))
((1 2 3 4) (1 2 3 5) (1 2 4 5) (1 3 4 5) (2 3 4 5))

Gauche（gosh）でのこの結果はどういうこと？

;; => ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
(combination '(1 2 3 4 5) 3)
;; => ((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 . #0=(4 5)) (2 3 4) (2 3 5) (2 . #0#) (3 . #0#))
(combination '(1 2 3 4 5) 4)
;; => ((1 2 3 4) (1 2 3 5) (1 2 . #0=(4 5)) (1 . #1=(3 . #0#)) (2 . #1#))

追記：

Twitterにて

valvallow	Gauche で #0# とか #0= とか #1= とか出力されちゃってる状態なんだけど、これなに？
valvallow	(((1 (2 (3 4) (3 5)) (2 . #0=(4 5))) (1 . #1=(3 . #0#))) (2 . #1#))
valvallow	みたいな
valvallow	gosh> ((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 . #0=(4 5)) (2 3 4) (2 3 5) (2 . #0#) (3 . #0#))
valvallow	DrScheme で同じコード実行してもでてこねー。
kosugi	@valvallow 同じオブジェクト参照の意じゃないかな
valvallow	@kosugi なるほど！ぽいですね！ありがとうございます＞＜

2009/01/26

[scheme][Gauche]for-each, tree-walk, reverse-tree-walk

「プログラミングGauche」P.64～ 66 7.2 手続きを取る手続き

ようは高階関数ということで。foldも高階関数ですね。

for-eachを試してみる。

(for-each (lambda (n) (print (* n n))) '(1 2 3 4 5))

;; => gosh> 1
;; => 4
;; => 9
;; => 16
;; => 25
;; => #<undef>

tree-walk写経。

;; tree-walk
(define (tree-walk tree walker proc)
(walker (lambda (ele)
        (if (list? ele)
        (tree-walk ele walker proc)
        (proc ele)))
      tree))

(tree-walk '(1 (2 3 (4 5 6)) 7 8 9 (10 (11 (12)))) for-each print)
;; => gosh> 1
;; => 2
;; => 3
;; => 4
;; => 5
;; => 6
;; => 7
;; => 8
;; => 9
;; => 10
;; => 11
;; => 12
;; => #<undef>

listを反転させるreverse。

;; reverse
(define (reverse ls)
(define (rev-iter ls ret)
    (if (null? ls)
    ret
    (rev-iter (cdr ls)(cons (car ls) ret))))
(rev-iter ls '()))

(reverse '(1 2 3 4 5)) ;; => (5 4 3 2 1)

listを反転後にfor-eachするreverse-for-each。

;; reverse-for-each
(define (reverse-for-each proc ls)
(for-each proc (reverse ls)))

(reverse-for-each print '(1 2 3 4 5))
;; => gosh> 5
;; => 4
;; => 3
;; => 2
;; => 1
;; => #<undef>

tree-walkにreverse-for-eachとprintを渡してみる。
今気づいたけど、本に書いてあるコードと引数の順番違う。

(tree-walk '(1 (2 3 (4 5 6)) 7 8 9 (10 (11 (12)))) reverse-for-each print)
;; => gosh> 12
;; => 11
;; => 10
;; => 9
;; => 8
;; => 7
;; => 6
;; => 5
;; => 4
;; => 3
;; => 2
;; => 1
;; => #<undef>

[scheme][Gauche]末尾再帰

「プログラミングGauche」P.56～59 6.6 ２種類の再帰

末尾再帰とは

処理の一番最後に再帰呼び出しをして、その結果がそのまま現在の処理の結果として返されるパターンを末尾再帰と呼びます

末尾再帰length

;; length tail-recursive
(define (length3 ls)
(define (len-iter ls n)
    (if (null? ls)
    n
    (len-iter (cdr ls)(+ n 1))))
(len-iter ls 0))

(length3 '(1 2 3 4 5)) ;; => 5
(length3 '()) ;; => 0
(length3 (cons 1 2)) ;; => ERROR: pair required, but got 2

末尾再帰reverse

;; tail-recursive reverse
(define (reverse ls)
(define (reverse-iter ls ret)
    (if (null? ls)
    ret
    (reverse-iter (cdr ls)(cons (car ls) ret))))
(reverse-iter ls '()))

(reverse '(1 2 3 4 5)) ;; => (5 4 3 2 1)
(reverse '()) ;; => ()

SICPの末尾再帰のところ読んでもあまりピンとこなかったんだけど、「プログラミングGauche」の末尾再帰の説明読んでみて、ようやくわかった。あとここ参考になった。

[scheme][Gauche]プログラミングGauche(P.56)練習問題

「プログラミングGauche」P.56 練習問題

リストの長さを計算するlengthを直接(foldを使わずに)定義してみる
リストの中から、条件を満たす要素だけを抜き出したリストを返すfilterを定義してみる

length手続き。

これはいまいち。nullでもリストでもないものが渡されたときの処理を書くべきかも。

;; リストの長さを計算するlengthを直接(foldを使わずに)定義してみる
(define (length2 ls)
(if (null? ls)
0
(+ 1 (length2 (cdr ls)))))

(length2 '(1 2 3 4 5)) ;; => 5
(length2 '()) ;; => 0
(length2 (cons 1 2)) ;; => ERROR: pair required, but got 2

filter手続き。

これは前回（find）の最後のとこで同じのをすでに書いてた。

;; リストの中から、条件を満たす要素だけを抜き出したリストを返すfilterを定義してみる
(define (filter predicate ls)
(cond
   ((null? ls) '())
   ((predicate (car ls))(cons (car ls)(filter predicate (cdr ls))))
   (else (filter predicate (cdr ls)))))

(filter even? '(1 2 3 4 5 6 7 8 9 10)) ;; => (2 4 6 8 10)
(filter odd? '(1 2 3 4 5 6 7 8 9 10)) ;; => (1 3 5 7 9)
(filter even? '()) ;; => ()

2009/01/24

[scheme][Gauche]append2, reverse, find

「プログラミングGauche」P.54 ～ 55

リストとリストを連結するappend2

;; append list
(define (append2 a b)
(if (pair? a)
(cons (car a)(append2 (cdr a) b))
b))

(append2 '(1 2 3) '(4 5 6)) ;; => (1 2 3 4 5 6)
(append2 '(1 (2 3) (4 5 (6))) '(((7 8) 9) 10))
;; => (1 (2 3) (4 5 (6)) ((7 8) 9) 10)

リストを反転させるreverse

;; reverse list
(define (reverse ls)
(fold cons '() ls))

(reverse '(1 2 3 4 5)) ;; => (5 4 3 2 1)

;; reverse list 2

(define (reverse2 ls)
(if (null? (cdr ls))
ls
(append2 (reverse2 (cdr ls))(list (car ls)))))

(reverse2 '(1 2 3 4 5)) ;; => (5 4 3 2 1)

(define (reverse2 ls)
(if (null? (cdr ls))
ls
(append2 (reverse2 (cdr ls)) (cons (car ls) '()))))

(reverse2 '(1 2 3 4 5)) ;; => (5 4 3 2 1)

リストから最初に条件に合致した要素を探し出すfind

;; find
(define (find predicate ls)
(if (null? ls)
      #f
      (if (predicate (car ls))
      (car ls)
      (find predicate (cdr ls)))))

(find odd? '(1 2 3 4 5)) ;; => 1
(find odd? '(1)) ;; => 1
(find odd? '()) ;; => #f
(find odd? '(2 4 6 8 10)) ;; => #f
(find odd? (cons 1 2)) ;; => 1

;; find - cond

(define (find predicate ls)
(cond
   ((null? ls) #f)
   ((predicate (car ls)) (car ls))
   (else (find predicate (cdr ls)))))

(find even? '(1 2 3 4 5)) ;; => 2
(find even? '(1)) ;; => #f
(find even? '(1 3 5 7)) ;; => #f

リストから条件に合致したすべての要素をリストにして返すfind

(define (find predicate ls)
(cond
   ((null? ls) '())
   ((predicate (car ls)) (cons (car ls) (find predicate (cdr ls))))
   (else (find predicate (cdr ls)))))

(find odd? '(1 2 3 4 5 6 7 8 9 10)) ;; => (1 3 5 7 9)
(find even? '(1 2 3 4 5 6 7 8 9 10)) ;; => (2 4 6 8 10)

[scheme][Gauche]deep-copy-list

「プログラミングGauche」P.53
copy-list
deep-copy-list

(use slib)
(require 'trace)

;; copy-list
;; リストを構成する対を複製する。
;; リストの要素（car側）に別のリストがあったとしても、それはコピーしません。
(define (copy-list ls)
(if (pair? ls)
(cons (car ls) (copy-list (cdr ls)))
ls))

(trace copy-list)
(copy-list '(1 2 3 4 5))

traceの結果

CALL copy-list (1 2 3 4 5)
CALL copy-list (2 3 4 5)
CALL copy-list (3 4 5)
   CALL copy-list (4 5)
    CALL copy-list (5)
    RETN copy-list (5 . #[unknown])
   RETN copy-list (4 5 . #[unknown])
RETN copy-list (3 4 5 . #[unknown])
RETN copy-list (2 3 4 5 . #[unknown])
RETN copy-list (1 2 3 4 5 . #[unknown])
(1 2 3 4 5 . #<undef>)

deep-copy-listを定義してみる。
冗長。

;; ネストしたリストもすべてコピーするdeep-copy-list
(define (deep-copy-list ls)
(if (pair? ls)
      (if (pair? (car ls))
        (cons (deep-copy-list (car ls))(deep-copy-list (cdr ls)))
        (cons (car ls)(deep-copy-list (cdr ls))))
      ls))

(trace deep-copy-list)
(deep-copy-list '(1 (2 3) (4 5 6) (7 8) 9 (10 11 12)))

一応うまくいってるみたい。

gosh> CALL deep-copy-list (1 (2 ...) (4 ...) (7 ...) 9 (10 11 12))
CALL deep-copy-list ((2 ...) (4 ...) (7 ...) 9 (10 11 12))
CALL deep-copy-list (2 3)
   CALL deep-copy-list (3)
    CALL deep-copy-list ()
    RETN deep-copy-list ()
   RETN deep-copy-list (3)
RETN deep-copy-list (2 3)
CALL deep-copy-list ((4 ...) (7 8) 9 (10 11 12))
   CALL deep-copy-list (4 5 6)
    CALL deep-copy-list (5 6)
    RETN deep-copy-list (5 6)
   RETN deep-copy-list (4 5 6)
   CALL deep-copy-list ((7 8) 9 (10 11 12))
    CALL deep-copy-list (7 8)
    RETN deep-copy-list (7 8)
    CALL deep-copy-list (9 (10 11 12))
    RETN deep-copy-list (9 (10 11 12))
   RETN deep-copy-list ((7 8) 9 (10 11 12))
RETN deep-copy-list ((4 ...) (7 8) 9 (10 11 12))
RETN deep-copy-list ((2 ...) (4 ...) (7 ...) 9 (10 11 12))
RETN deep-copy-list (1 (2 ...) (4 ...) (7 ...) 9 (10 11 12))
(1 (2 3) (4 5 6) (7 8) 9 (10 11 12))
gosh>

;; cons手続きが重複していたので一つにまとめてみる。
(define (deep-copy-list2 ls)
(if (pair? ls)
      (cons
       (if (pair? (car ls))
         (deep-copy-list2 (car ls))
         (car ls))
       (deep-copy-list2 (cdr ls)))
      ls))

(trace deep-copy-list2)
(deep-copy-list2 '(1 (2 3) (4 5 6) (7 8) 9 (10 11 12)))

CALL deep-copy-list2 (1 (2 ...) (4 ...) (7 ...) 9 (10 11 12))
CALL deep-copy-list2 ((2 ...) (4 ...) (7 ...) 9 (10 11 12))
CALL deep-copy-list2 (2 3)
   CALL deep-copy-list2 (3)
    CALL deep-copy-list2 ()
    RETN deep-copy-list2 ()
   RETN deep-copy-list2 (3)
RETN deep-copy-list2 (2 3)
CALL deep-copy-list2 ((4 ...) (7 8) 9 (10 11 12))
   CALL deep-copy-list2 (4 5 6)
    CALL deep-copy-list2 (5 6)
    RETN deep-copy-list2 (5 6)
   RETN deep-copy-list2 (4 5 6)
   CALL deep-copy-list2 ((7 8) 9 (10 11 12))
    CALL deep-copy-list2 (7 8)
    RETN deep-copy-list2 (7 8)
    CALL deep-copy-list2 (9 (10 11 12))
    RETN deep-copy-list2 (9 (10 11 12))
   RETN deep-copy-list2 ((7 8) 9 (10 11 12))
RETN deep-copy-list2 ((4 ...) (7 8) 9 (10 11 12))
RETN deep-copy-list2 ((2 ...) (4 ...) (7 ...) 9 (10 11 12))
RETN deep-copy-list2 (1 (2 ...) (4 ...) (7 ...) 9 (10 11 12))
(1 (2 3) (4 5 6) (7 8) 9 (10 11 12))

(car ls)が三度も出現するのが嫌だったのでlambdaでくるんでみた。
letもまだいまいちわかんないので、lambdaで。
いまんとこコレが限界ー。

あ、名前もdeep-copy-listからdclに。

(define (dcl3 ls)
(if (pair? ls)
      (cons
       ((lambda (l)
         (if (pair? l)
            (dcl3 l)
            l)) (car ls))
       (dcl3 (cdr ls)))
      ls))

(trace dcl3)
(dcl3 '(1 (2 3) (4 5 6) (7 8) 9 (10 11 12)))

CALL dcl3 (1 (2 ...) (4 ...) (7 8) 9 (10 11 12))
CALL dcl3 ((2 ...) (4 ...) (7 8) 9 (10 11 12))
CALL dcl3 (2 3)
   CALL dcl3 (3)
    CALL dcl3 ()
    RETN dcl3 ()
   RETN dcl3 (3)
RETN dcl3 (2 3)
CALL dcl3 ((4 5 ...) (7 8) 9 (10 11 12))
   CALL dcl3 (4 5 6)
    CALL dcl3 (5 6)
    RETN dcl3 (5 6)
   RETN dcl3 (4 5 6)
   CALL dcl3 ((7 8) 9 (10 11 12))
    CALL dcl3 (7 8)
    RETN dcl3 (7 8)
    CALL dcl3 (9 (10 11 12))
    RETN dcl3 (9 (10 11 12))
   RETN dcl3 ((7 8) 9 (10 11 12))
RETN dcl3 ((4 5 ...) (7 8) 9 (10 11 12))
RETN dcl3 ((2 ...) (4 ...) (7 8) 9 (10 11 12))
RETN dcl3 (1 (2 ...) (4 ...) (7 8) 9 (10 11 12))
(1 (2 3) (4 5 6) (7 8) 9 (10 11 12))

ちょっとインデントを変えてみた。
インデントのタイミングというか位置が、まだよくわからない。
他人のSchemeコードをもっと見るとか、SICPをもっと読み進めるとわかってくるかなー。

(define (dcl3 ls)
(if (pair? ls)
      (cons
       ((lambda (l)
        (if (pair? l)(dcl3 l) l)) (car ls))
       (dcl3 (cdr ls)))
      ls))

(dcl3 '((1 2) 3 4 (5 6 7 8 9) 10 (11 (12 13 14)(15 (16 17 (18)))(19 20) 21) 22))

CALL dcl3 ((...) 3 4 (5 ...) 10 (11 (...) (...) ...) 22)
CALL dcl3 (1 2)
CALL dcl3 (2)
   CALL dcl3 ()
   RETN dcl3 ()
RETN dcl3 (2)
RETN dcl3 (1 2)
CALL dcl3 (3 4 (5 6 ...) 10 (11 (...) (...) ...) 22)
CALL dcl3 (4 (5 6 ...) 10 (11 (...) (...) ...) 22)
   CALL dcl3 ((5 6 ...) 10 (11 (...) (...) ...) 22)
    CALL dcl3 (5 6 7 8 9)
    RETN dcl3 (5 6 7 8 9)
    CALL dcl3 (10 (11 (...) (...) (...) ...) 22)
    RETN dcl3 (10 (11 (...) (...) (...) ...) 22)
   RETN dcl3 ((5 6 ...) 10 (11 (...) (...) ...) 22)
RETN dcl3 (4 (5 6 ...) 10 (11 (...) (...) ...) 22)
RETN dcl3 (3 4 (5 6 ...) 10 (11 (...) (...) ...) 22)
RETN dcl3 ((...) 3 4 (5 ...) 10 (11 (...) (...) ...) 22)
((1 2) 3 4 (5 6 7 8 9) 10 (11 (12 13 14) (15 (16 17 (18))) (19 20) 21) 22)

2009/01/23

[scheme][Gauche]last-pair写経

定義済みのlast-pairを使ってみる。

;; last-pair
(last-pair '(1 2 3));; => (3)
(last-pair (cons 1 (cons 2 3))) ;; => (2 . 3)
(last-pair '()) ;; => ERRO: pair required: ()

pair?の動作も確認してみる。

;; pair?
(pair? '(1 2 3)) ;; => #t
(pair? '()) ;; => #f
(pair? (cons 1 (cons 1 2))) ;; => #t
(pair? (cons 1 2)) ;; => #t
(pair? (cons 1 '())) ;; => #t

いまさらcdrも。

;; cdr
(cdr '()) ;; => ERROR: pair required, but got ()
(cdr (cons 1 2)) ;; => 2
(cdr (cons 1 (cons 2 3))) ;; => (2 . 3)
(cdr '(1 2)) ;; => (2)
(cdr '(1)) ;; => ()

my-last-pairを定義してみる。

;; define my-last-pair
(define (my-last-pair ls)
(if (pair? (cdr ls))
(my-last-pair (cdr ls))
ls))

(my-last-pair '()) ;; => ERROR: pair required, but got ()
(my-last-pair '(1)) ;; => (1)
(my-last-pair (cons 1 2)) ;; => (1 . 2)
(my-last-pair (cons 1 (cons 2 3))) ;; => (2 . 3)
(last-pair (cons 1 (cons 2 3))) ;; => (2 . 3)

2009/01/22

[scheme][Gauche]slibのtraceを使ったデバッグ

Gauche(Scheme) でデバッグをする4つの方法

↑こんな記事があったのでやってみたらすごく便利。trace。

(define (fact n)            
  (if (zero? n)             
      1             
      (* n (fact (- n 1)))))  ;; => fact             
(use slib) ;; => #<undef>            
(require 'trace) ;; => #t             
(trace fact) ;; => #<closure (debug:trace-procedure debug:trace-procedure)>
 
(fact 5)

実行結果

gosh> CALL fact 5 CALL fact 4 CALL fact 3 CALL fact 2 CALL fact 1 RETN fact 1 RETN fact 2 RETN fact 6 RETN fact 24 RETN fact 120 120

追記

vallog: Scheme マクロのデバッグ4種

[Emacs][Meadow]ツールバー（ボタンが並んでるバー）を消す

Meadowのツールバーがウザかったので消しました。

↑これを消してこんな感じに↓

.emacsファイルに以下の一行を追加する

(tool-bar-mode -1)

参考：ツールバーを非表示にする

[Scheme][Gauche]デバッグのリーダーマクロ（#?=）

Gaucheユーザーリファレンス 3.4 デバッグ

;; #?= プリントスタブ リーダーマクロ            
(define (fold2 proc init lis)             
  (if (null? lis)             
      init             
      (fold2 proc #?=(proc (car lis) init) #?=(cdr lis)))) 
 
(fold2 (lambda (a b)(+ b 1)) 0 '(1 2 3 4 5)) 
 
;; => #?="(stdin)":4:(proc (car lis) init)            
;; => #?-    1             
;; => #?="(stdin)":4:(cdr lis)             
;; => #?-    (2 3 4 5)             
;; => #?="(stdin)":4:(proc (car lis) init)             
;; => #?-    2             
;; => #?="(stdin)":4:(cdr lis)             
;; => #?-    (3 4 5)             
;; => #?="(stdin)":4:(proc (car lis) init)             
;; => #?-    3             
;; => #?="(stdin)":4:(cdr lis)             
;; => #?-    (4 5)             
;; => #?="(stdin)":4:(proc (car lis) init)             
;; => #?-    4             
;; => #?="(stdin)":4:(cdr lis)             
;; => #?-    (5)             
;; => #?="(stdin)":4:(proc (car lis) init)             
;; => #?-    5             
;; => #?="(stdin)":4:(cdr lis)             
;; => #?-    ()             
;; => 5

追記

vallog: Scheme マクロのデバッグ4種

登録: 投稿 (Atom)