bst scm Binary search trees Pairs Consructors define bst-pair cons def

 ``` 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``` ```; bst.scm ; Binary search trees ;;; ; 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) ```