[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)