bst scm Binary search trees define reduce op initial sequence if null

  • Anonymous
  • Scheme
  • 29 Apr 2009 
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
; bst.scm

; Binary search trees



(define (reduce op initial sequence)

  (if (null? sequence)

      initial

      (op (car sequence)

          (reduce op initial (cdr sequence)))))



;;;

; Pairs

;;;



; Consructors

(define bst-pair cons)

(define bst-pair-empty

  (bst-pair '() '()))



; Selectors

(define bst-pair-key car)

(define bst-pair-val cdr)



; Predicate to find out if pair is empty

(define (bst-pair-empty? pair)

  (null? (bst-pair-key pair)))





;;;

; Nodes

;;;



; Constructors

(define (bst-node value lchild rchild)

  (list value lchild rchild))



(define (bst-root-node value)

  (bst-node value '() '()))



(define bst-node-empty

  (bst-root-node '()))



; Selectors

(define bst-node-value car)

(define bst-node-lchild cadr)

(define bst-node-rchild caddr)



; Predicate to find out if node is empty

(define (bst-node-empty? node)

  (null? (bst-node-value node)))



; Predicate to find out if node is a left (haven't children)

(define (bst-node-leaf? node)

  (and (null? (bst-node-lchild node)) (null? (bst-node-rchild node))))



;;;

; Trees

;;;



; Contructors

(define (bst node lbranch rbranch)

  (bst-node (bst-node-value node)

            lbranch

            rbranch))



(define (bst-root tree) tree)



(define bst-empty bst-node-empty)



; Selectors

(define (bst-lbranch tree)

  (cond ((null? (bst-node-lchild (bst-root tree))) bst-empty)

        (else (bst-node-lchild (bst-root tree)))))

       

(define (bst-rbranch tree)

  (cond ((null? (bst-node-rchild (bst-root tree))) bst-empty)

        (else (bst-node-rchild (bst-root tree)))))



; Predicate to find out if tree is empty

(define bst-empty? bst-node-empty?)



; Insertion

(define (bst-insert pair tree)

  (cond ((bst-empty? tree) (bst-root (bst-root-node pair)))

        ((> (bst-pair-key pair)

            (bst-pair-key (bst-node-value (bst-root tree))))

         (bst (bst-root tree)

              (bst-lbranch tree)

              (bst-insert pair (bst-rbranch tree))))

        (else 

         (bst (bst-root tree)

              (bst-insert pair (bst-lbranch tree))

              (bst-rbranch tree)))))



; Searching

(define (bst-find key tree)

  (cond ((bst-empty? tree) #f)

        ((let ((ckey (bst-pair-key (bst-node-value (bst-root tree)))))

           (cond ((= key ckey) (bst-pair-val (bst-node-value (bst-root tree))))

                 ((> key ckey) (bst-find key (bst-rbranch tree)))

                 (else (bst-find key (bst-lbranch tree))))))))



; Traversal

(define (bst-traversal tree)

  (let ((value (list (bst-node-value (bst-root tree)))))

       (cond ((bst-node-leaf? tree) value)

             ((bst-node-empty? (bst-rbranch tree))

              (append (bst-traversal (bst-lbranch tree)) value))

             ((bst-node-empty? (bst-lbranch tree))

              (append value (bst-traversal (bst-rbranch tree))))

             (else

              (append (bst-traversal (bst-lbranch tree))

                      value

                      (bst-traversal (bst-rbranch tree)))))))



; Deleting

(define (bst-remove key tree)

  (cond ((bst-empty? tree) #f)

        ((let ((ckey (bst-pair-key (bst-node-value (bst-root tree)))))

           (cond ((= key ckey) (bst-pair-val (bst-node-value (bst-root tree))))

                 ((> key ckey) (bst-find key (bst-rbranch tree)))

                 (else (bst-find key (bst-lbranch tree))))))))



;;;

; Sorting using bst

;;;

(define (bst-sort nums)

  (reduce cons '() (bst-traversal (reduce bst-insert bst-empty (map (lambda (num) (bst-pair num num)) nums)))))



;;;

; Examples

;;;



(define array

  (list (bst-pair 2 "foo!")

        (bst-pair 5 "xyz!")

        (bst-pair 3 "bar!")

        (bst-pair 1 "abc!")))



(define my-tree

  (bst-insert (cadddr array) (bst-insert (caddr array) (bst-insert (cadr array) (bst-insert (car array) bst-empty)))))



(display my-tree)



(display (bst-find 7 my-tree))



(map (lambda (pair) (display (bst-pair-val pair))) (bst-traversal my-tree))



(bst-sort (list 8 2 7 0 1 3 5 4))



(define Y (reduce bst-insert bst-empty (map (lambda (num) (bst-pair num (* num 10))) (list 8 2 9 7 0 1 3 5 4))))



(bst-traversal Y)
← newer dump
older dump →