フラットなリストを作る
入れ子になったリストをフラットなリストにする関数を考えてみた。
(define (flat-list a-wp)
(cond
((empty? a-wp) empty)
((symbol? (first a-wp)) (cons (first a-wp) (flat-list (rest a-wp))))
(else
(append
(flat-list (first a-wp))
(flat-list (rest a-wp))))))
(define (reverse-of-flatwp a-wp) ;逆にする。
(reverse (flat-list a-wp)))
----------example------------
(define sample2 '(k (i (a (m o))) d))
(reverse-of-wp-flatty sample2) evaluates to : (list 'd 'o 'm 'a 'i 'k) ;実行結果
消えてしまっていたので
(define (occurs1 a-wp s) ;;14.3.2 引数にとったシンボルがいくつか数える（入れ子になったリストは無視）
(cond
((empty? a-wp) 0)
((and
(symbol? (first a-wp))
(symbol=? (first a-wp) s)) (+ 1 (occurs1 (rest a-wp) s)))
(else
(occurs1 (rest a-wp) s))))
(define (occurs2 a-wp s) ;;入れ子になったリストも調べる
(cond
((empty? a-wp) 0)
((and
(symbol? (first a-wp))
(symbol=? (first a-wp) s)) (+ 1 (occurs2 (rest a-wp) s)))
((symbol? (first a-wp)) (occurs2 (rest a-wp) s))
(else (+ (occurs2 (first a-wp) s) (occurs2 (rest a-wp) s)))))
(define (replace new old a-wp) ;;14.3.3 oldをnewに置き換えてリストを作り直す
(cond
((empty? a-wp) empty)
((and
(symbol? (first a-wp))
(symbol=? (first a-wp) old ))
(cons new (replace new old (rest a-wp))))
((symbol? (first a-wp))
(cons (first a-wp) (replace new old (rest a-wp))))
(else
(cons
(replace new old (first a-wp))
(replace new old (rest a-wp))))))はてなの書き方がわかっていなくて前の日記に上書きしていました。
しっかりヘルプを読まなければ・・・
HTDP
勢いで書いていたらしく昨日の日記が意味のわからない文章になっている・・・
ちなみにexercises14.2.3も解けたのでメモ
(define a-BT ;Figure 38 A バイナリーツリー
(make-node 63 'top
(make-node 29 't
(make-node 15 'd
(make-node 10 'e false false)
(make-node 24 'f false false))false)
(make-node 89 'g
(make-node 77 'h false false)
(make-node 95 'i false
(make-node 99 'j false false)))))
(define (inorder BT) ;14.2.3 左から右の並びでリストをつくる
(cond
((boolean? BT) empty)
(else
(append
(inorder (node-left BT))
(list (node-ssn BT))
(inorder (node-right BT))))))
;--------------------------test
(inorder a-BT) eveluates to ; (list 10 15 24 29 63 77 89 95 99)
;---------------------------
(define (search-bst n BST) ;;14.2.4 できるだけ少ない計算でnを探しnameを表示する
(cond
((boolean? BST) false)
((equal? n (node-ssn BST)) (node-name BST))
(else
(cond
((< n (node-ssn BST)) (search-bst n (node-left BST)))
((> n (node-ssn BST)) (search-bst n (node-right BST)))
(else false)))))
;----------------------------------------以下14.2.5
(define (create-bst-left B N S) ;create left
(cond
((boolean? B) (make-node N S false false))
(else
(cond
((< N (node-ssn B)) (make-node (node-ssn B) (node-name B) (create-bst-left (node-left B) N S) false))
((> N (node-ssn B)) (make-node (node-ssn B) (node-name B) (node-left B) (create-bst-left (node-right B) N S)))
(else 'error?)))))
(define (create-bst-right B N S) ;create right
(cond
((boolean? B) (make-node N S false false))
(else
(cond
((> N (node-ssn B)) (make-node (node-ssn B) (node-name B) false (create-bst-right (node-right B) N S)))
((< N (node-ssn B)) (make-node (node-ssn B) (node-name B) (create-bst-right (node-left B) N S) (node-right B)))
(else 'error?)))))
(define (create-bst B N S) ;14.2.5
(cond
((boolean? B) (make-node N S false false))
((eqv? (node-ssn B) N) 'equal)
(else
(cond
((< N (node-ssn B))
(make-node (node-ssn B) (node-name B) (create-bst-left (node-left B) N S) (node-right B)))
((> N (node-ssn B))
(make-node (node-ssn B) (node-name B) (node-left B) (create-bst-right (node-right B) N S)))
(else 'error?))))) 解けたときは嬉しい。がもっときれいに書く方法があると思うのでいろいろと試してみようと思った。
解けた！
とりあえず答えがでてきた！！ create-bstの部分が
(define (create-bst B N S)
(cond
((boolean? B) (make-node N S false false))
((eqv? (node-ssn B) N) 'equal)
(else
(cond
((< N (node-ssn B))
(make-node (node-ssn B) (node-name B) (create-bst-left (node-left B) N S) (node-right B)))
((> N (node-ssn B))
(make-node (node-ssn B) (node-name B) (node-left B) (create-bst-right (node-right B) N S)))
(else 'error?)))))こうで良いのだと思う。
いつの間にか
昨日は夕方くらいに猛烈な睡魔に襲われたからお昼寝しかない、と思って寝たら朝の５時くらいまで寝てしまった・・・
これはいかんいかん。がんばって動き始めないと。
半歩くらい全身した予感・・・
バイナリーツリー関係の問題exercises14.2.3 で足踏み状態なのですが微妙に求めている答えに近いようなものがかけました。あとは条件分岐を考えれば答えにたどり着けそうなのでがんばってみようかと。
(define a-BT ;Figure 38 A
(make-node 63 'top
(make-node 29 't
(make-node 15 'd
(make-node 10 'e false false)
(make-node 24 'f false false))false)
(make-node 89 'g
(make-node 77 'h false false)
(make-node 95 'i false
(make-node 99 'j false false)))))
(define (inorder BT)
(cond
((boolean? BT) false)
(else
(append
(inorder-aux (node-left BT))
(list (node-ssn BT))
(inorder-aux (node-right BT))))))
(define (inorder-aux BT)
(cond
((boolean? BT) empty)
(else
(append
(cons (node-ssn BT) (inorder-aux (node-left BT)))
(cons (node-ssn BT) (inorder-aux (node-right BT)))))))
(inorder a-BT) evaluates to ; (list 29 15 10 10 15 24 24 29 63 89 77 77 89 95 95 99 99)なんか惜しい！ ホントは、(list 10 15 24 29 63 77 89 95 99) になることを求めているのですが・・・もうちょっとがんばってみよう。
■
ちょっと戻って飛ばしてしまっていた
section14.2 Binary Search Trees をやってみる。
(define-struct node (ssn name left right))
(define a-BT ;Figure 38 A
(make-node 63 'top
(make-node 29 't
(make-node 15 'd
(make-node 10 'e false false)
(make-node 24 'f false false))false)
(make-node 89 'g
(make-node 77 'h false false)
(make-node 95 'i false
(make-node 99 'j false false)))))
(define b-BT ;Figure 38 B
(make-node 63 'top
(make-node 2 '29
(make-node 3 '15
(make-node 4 '87 false false)
(make-node 4 '24 false false))false)
(make-node 2 '89
(make-node 3 '33 false false)
(make-node 3 '95 false
(make-node 4 '99 false false)))))
(define (contains-bt n BT) ; Exercises 14.2.1
(cond
((boolean? BT) false)
((eq? n (node-ssn BT)) true)
(else
(cond
((contains-bt n (node-left BT)) true)
((contains-bt n (node-right BT)) true)
(else false)))))
(define (search-bt n BT) ;Exercises14.2.2
(cond
((eq? n (node-ssn BT)) (node-name BT))
((boolean? BT) false)
(else
(cond
((contains-bt n (node-left BT)) (search-bt n (node-left BT)))
((contains-bt n (node-right BT)) (search-bt n (node-right BT)))
(else false)))))
(contains-bt 10 a-BT) evaluate to ; true
(contains-bt 11 a-BT) evaluate to ; false
(search-bt 10 a-BT) evaluate to ; 'e
(search-bt 11 a-BT) evaluate to ; falseここまでは問題ないと思うのですが二分木からリストを作る関数を定義するexercises14.2.3で足踏み中・・・。
