(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")