;;; BASIC PROCEDURES for TREES ;; ;; the-empty-tree: (tree T) ;; tree-cons: (-> ((or T (tree T)) (tree T)) ;; (tree T)) ;; tree-empty?: (-> ((tree T)) boolean) ;; tree-first: (-> ((tree T)) ;; (or T (tree T))) ;; ; REQUIRES: the tree is not empty ;; ;; tree-rest: (-> ((tree T)) (tree T)) ;; ; REQUIRES: the tree is not empty (define the-empty-tree '()) (define tree-cons cons) (define tree-empty? null?) (define tree-first car) (define tree-rest cdr) (define atomic-item? ; TYPE: (-> (datum) boolean) (lambda (x) (not (or (pair? x) (null? x))))) (define sum-all ; TYPE: (-> ((tree number)) number) (lambda (ton) ; ENSURES: result is the sum of ; all the numbers in ton (cond ((tree-empty? ton) 0) ((number? (tree-first ton)) (+ (tree-first ton) (sum-all (tree-rest ton)))) (else (+ (sum-all (tree-first ton)) (sum-all (tree-rest ton)))) ))) (DEFINE tdepth ; TYPE: (-> ((tree atomic-item)) number) (LAMBDA (tr) (COND [(tree-empty? tr) 0] [(atomic-item? (tree-first tr)) (max 1 (tdepth (tree-rest tr)))] [ELSE (max (add1 (tdepth (tree-first tr))) (tdepth (tree-rest tr)))]))) (DEFINE remove-left-most ; TYPE: (-> ((atomic-item ; (tree atomic-item))) ; (tree atomic-item)) (LAMBDA (item tr) (COND [(tree-empty? tr) '()] [(atomic-item? (tree-first tr)) (COND [(equal? item (tree-first tr)) (tree-rest tr)] [ELSE (tree-cons (tree-first tr) (remove-left-most item (tree-rest tr)))])] [ELSE (COND [(member-all? item (tree-first tr)) (tree-cons (remove-left-most item (tree-first tr)) (tree-rest tr))] [ELSE (tree-cons (tree-first tr) (remove-left-most item (tree-rest tr)))])]))) ; - Program 4.16, pg. 113 - (define member-all? (lambda (item ls) (if (null? ls) #f (or (equal? (car ls) item) (and (not (pair? (car ls))) (member-all? item (cdr ls))) (and (pair? (car ls)) (or (member-all? item (car ls)) (member-all? item (cdr ls)))))))) ; - End Program - (DEFINE depth ; TYPE: (-> (s-expression) number) (LAMBDA (item) ; ENSURES: result is the maximum depth ; of item (COND [(atom? item) 0] [(pair? item) (max (add1 (depth (car item))) (depth (cdr item)))])))