(load "shared/util.scm") (display "\nex-2.24\n") (define x (cons (list 1 2) (list 3 4))) (define (display-spaces n) (cond ((= n 0) ()) (else (display " ") (display-spaces (- n 1))))) ; Procedure to print a tree (in an ugly way) (define (display-tree tree level) (cond ((null? tree) ()) ((not (pair? tree)) (display-spaces level) (display tree) (newline)) (else (display-spaces level) (display tree) (newline) (map (lambda (tree) (display-tree tree (+ level 1))) tree)))) (define x (list 1 (list 2 (list 3 4)))) (display-tree x 0) ; (1 (2 (3 4))) ; result interpreter ; [. .]->[. /] ; | | ; 1 [. .]->[. /] ; | | ; 2 [. .]->[. /] ; | | ; 3 4 ; /\ ; 1 \ ; /\ ; 2 \ ; \ ; /\ ; 3 4 (display "\nex-2.25\n") (define x (list 1 3 (list 5 7) 9)) (display x) (newline) ; (1 3 (5 7) 9) (display (car (cdr (car (cdr (cdr x)))))) (newline) (define x (list (list 7))) (display x) (newline) ; ((7)) (display (car (car x))) (newline) (define x (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7))))))) (display x) (newline) ; (1 (2 (3 (4 (5 (6 7)))))) (display (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr x))))))))))))) (newline) (display (cadr (cadr (cadr (cadr (cadr (cadr x))))))) (newline) (display "\nex-2.26\n") (define x (list 1 2 3)) (define y (list 4 5 6)) (display (append x y)) (newline) ; (1 2 3 4 5 6) (display (cons x y)) (newline) ; ((1 2 3) 4 5 6) (display (list x y)) (newline) ; ((1 2 3) (4 5 6)) (display "\nex-2.27 - deep reverse\n") (define x (list (list 1 2) (list 3 4))) ; I didn't implement in this elegantly when I first did this exercise. I am ; learning and growing! (define (deep-reverse xs) (if (pair? xs) (reverse (map deep-reverse xs)) xs)) (display x) (newline) (display (reverse x)) (newline) (display (deep-reverse x)) (newline) (display "\nex-2.28 - fringe aka flatten\n") (define (fringe xs) (cond ((null? xs) xs) ((pair? xs) (append (fringe (car xs)) (fringe (cdr xs)))) (else (list xs)))) (display (fringe x)) (newline) (display (fringe (list x x))) (newline) (display "\nex-2.29 - mobile balancing\n") (define (make-mobile left right) (list left right)) (define (make-branch length structure) (list length structure)) (define m1 (make-mobile (make-branch 10 20) (make-branch 5 41))) (define m2 (make-mobile (make-branch 1 70) (make-branch 2 (make-mobile (make-branch 3 20) (make-branch 4 15))))) ; 2.29 a) (define left-branch car) (define right-branch cadr) (define branch-length car) (define branch-structure cadr) (display (branch-length (right-branch m1))) (newline) ; 2.29 b) (define (total-weight m) (if (pair? m) (+ (total-weight (branch-structure (left-branch m))) (total-weight (branch-structure (right-branch m)))) m)) (display (total-weight m1)) (newline) (display (total-weight m2)) (newline) ; 2.29 c) (define (balanced? m) (define (torque b) (* (branch-length b) (total-weight (branch-structure b)))) (if (pair? m) (let ((l (left-branch m)) (r (right-branch m))) (and (balanced? (branch-structure l)) (balanced? (branch-structure r)) (= (torque l) (torque r)))) #t))) (display (balanced? m1)) (newline) (display (balanced? m2)) (newline) ; 2.29 d) ; Only the selectors must be changed if we change the constructors. (define (make-mobile left right) (cons left right)) (define (make-branch length structure) (cons length structure)) (display "\nex-2.30 - tree square\n") ; using tail recursion (define (square-tree t) (cond ((null? t) nil) ((not (pair? t)) (square t)) (else (cons (square-tree (car t)) (square-tree (cdr t)))))) (display x) (newline) (display (square-tree x)) (newline) ; using map (define (square-tree t) (cond ((null? t) nil) ((not (pair? t)) (square t)) (else (map square-tree t)))) (display (square-tree x)) (newline) (display "\nex-2.31\n") (define (tree-map proc tree) (cond ((null? tree) tree) ((not (pair? tree)) (proc tree)) (else (map (lambda (t) tree-map proc t) tree)))) (define (square-tree tree) (tree-map square tree)) (display (square-tree x)) (newline) (display "\nex-2.32\n") (define (subsets s) (if (null? s) (list nil) (let ((rest (subsets (cdr s)))) (append rest (map (lambda (r) (cons (car s) r)) rest))))) ; Assuming we have an oracle procedure subsets and we get a new list that we ; split into car and cdr). If we use the oracle to compute the subsets for cdr ; then we get a new list rest. To compute the new subsets from that list we ; have to a) keep the rest as it is and b) add the current element (car) to all ; the subsets (rest). The only other tricky part (that was already given) is ; that when we get an empty list we want to return a list including that empty ; list. (display (subsets (list 1 2 3)))