commit 868e1bd403b3fcda7e5d538c5fe0250abe289667 parent 0aed7db76e994aed8ae0b9890c15d415222f1e37 Author: Yuval Langer <yuval.langer@gmail.com> Date: Fri, 10 Mar 2023 17:59:01 +0200 Exercises 2.25 to 2.31. Diffstat:
| M | guile.scm | | | 287 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 287 insertions(+), 0 deletions(-)
diff --git a/guile.scm b/guile.scm @@ -1886,3 +1886,290 @@ Iterative. (list 1 (list 2 (list 3 4))) xs-1234) (test-end "2.24")) + +;; Exercise 2.25 + +(test-begin "2.25") +(test-equal + 7 + (car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))) +(test-equal + 7 + (car (car '((7))))) +(test-equal + 7 + (car ;; 7 + (cdr ;; (cons 7 '()) + (car ;; (cons 2 (cons (cons 3 ...) '())) + (cdr ;; (cons (cons 6 (cons 7 '())) '()) + (car ;; (cons 5 (cons (cons 6 (cons 7 '()) '()))) + (cdr ;; (cons (cons 5 ...) '()) + (car ;; (cons 4 (cons (cons 5 ...) '())) + (cdr ;; (cons (cons 4 ...) '()) + (car ;; (cons 3 (cons (cons 4 ...) '())) + (cdr ;; (cons (cons 3 ...) '()) + (car ;; (cons 2 (cons (cons 3 ...) '())) + (cdr ;; (cons (cons 2 ...) '()) + ;; (cons 1 (cons (cons 2 ...) '())) + '(1 (2 (3 (4 (5 (6 7))))))))))))))))))) +(test-end "2.25") + +;; Exercise 2.26 + +;; (define x (list 1 2 3)) +;; (define y (list 4 5 6)) +;; (append x y) => (1 2 3 4 5 6) +;; (cons x y) => ((1 2 3) 4 5 6) +;; (list x y) => ((1 2 3) (4 5 6)) + +;; scheme@(guile-user)> (define x (list 1 2 3)) +;; scheme@(guile-user)> (define y (list 4 5 6)) +;; scheme@(guile-user)> (append x y) +;; $1 = (1 2 3 4 5 6) +;; scheme@(guile-user)> (cons x y) +;; $2 = ((1 2 3) 4 5 6) +;; scheme@(guile-user)> (list x y) +;; $3 = ((1 2 3) (4 5 6)) + +(let ([x (list 1 2 3)] + [y (list 4 5 6)]) + (test-begin "2.26") + (test-equal + "(1 2 3 4 5 6)" + (format #f "~a" (append x y))) + (test-equal + "((1 2 3) 4 5 6)" + (format #f "~a" (cons x y))) + (test-equal + "((1 2 3) (4 5 6))" + (format #f "~a" (list x y))) + (test-end "2.26")) + +;; Exercise 2.27 + +(letrec ([deep-reverse + (lambda (xs) + (cond + ((null? xs) '()) + ((pair? xs) + (append (deep-reverse (cdr xs)) + (list (deep-reverse (car xs))))) + (else xs)))] + [x (list (list 1 2) + (list 3 4))]) + (test-begin "2.27") + (test-equal + '((3 4) (1 2)) + (reverse x)) + (test-equal + '((4 3) (2 1)) + (deep-reverse x)) + (test-end "2.27")) + +;; Exercise 2.28 + +(define (exercise-2.28) + (define (fringe a-tree) + (cond + ((null? a-tree) '()) + ((pair? a-tree) + (cond + ((pair? (car a-tree)) + (append (fringe (car a-tree)) + (fringe (cdr a-tree)))) + (else (cons (car a-tree) + (fringe (cdr a-tree)))))) + (else a-tree))) + + (define x '((1 2) (3 4))) + + (test-begin "2.28") + (test-equal + '(1 2 3 4) + (fringe x)) + (test-equal + '(1 2 3 4 1 2 3 4) + (fringe (list x x))) + (test-end "2.28")) + +(exercise-2.28) + +;; Exercise 2.29 + +(define (exercise-2.29) + '(define (make-mobile left-branch right-branch) + (list left-branch right-branch)) + + (define (make-mobile left-branch right-branch) + (cons left-branch right-branch)) + + '(define (make-branch length structure) + (list length structure)) + + (define (make-branch length structure) + (cons length structure)) + + (define (left-branch mobile) + (car mobile)) + + '(define (right-branch mobile) + (cadr mobile)) + + (define (right-branch mobile) + (cdr mobile)) + + (define (branch-length branch) + (car branch)) + + '(define (branch-structure branch) + (cadr branch)) + + (define (branch-structure branch) + (cdr branch)) + + (define (total-weight mobile) + (cond + ((number? mobile) mobile) + (else + (let ([left-branch-structure + (branch-structure (left-branch mobile))] + [right-branch-structure + (branch-structure (right-branch mobile))]) + + (+ (if (number? left-branch-structure) + left-branch-structure + (total-weight left-branch-structure)) + (if (number? right-branch-structure) + right-branch-structure + (total-weight right-branch-structure))))))) + + (define (branch-torque branch) + (* (branch-length branch) + (total-weight (branch-structure branch)))) + + (define (balanced mobile) + (= (branch-torque (left-branch mobile)) + (branch-torque (right-branch mobile)))) + + + (test-begin "2.29") + (test-equal + 10 + (total-weight + (make-mobile (make-branch 2 3) + (make-branch 5 7)))) + (test-equal + 64 + (total-weight + (make-mobile (make-branch 2 + (make-mobile (make-branch 3 5) + (make-branch 7 11))) + (make-branch 13 + (make-mobile (make-branch 17 19) + (make-branch 23 29)))))) + (test-equal + 6 + (branch-torque (make-branch 2 3))) + (test-equal + #t + (balanced (make-mobile (make-branch 3 5) + (make-branch 5 3)))) + (test-equal + #t + (balanced (make-mobile (make-branch 3 + (make-mobile (make-branch 4 1) + (make-branch 1 4))) + (make-branch 5 + (make-mobile (make-branch 1 2) + (make-branch 2 1)))))) + (test-equal + #f + (balanced (make-mobile (make-branch 3 + (make-mobile (make-branch 4 1) + (make-branch 1 3))) + (make-branch 5 + (make-mobile (make-branch 1 2) + (make-branch 2 1)))))) + (test-end "2.29")) + +(exercise-2.29) + +;; Exercise 2.30 + +(define (exercise-2.30) + (define (directly-square-tree tree) + (cond + ((null? tree) '()) + ((pair? tree) (cons (directly-square-tree (car tree)) + (directly-square-tree (cdr tree)))) + (else (* tree tree)))) + + (define (higher-order-square-tree tree) + (map (lambda (sub-tree) + (if (pair? sub-tree) + (higher-order-square-tree sub-tree) + (* sub-tree sub-tree))) + tree)) + + (define a-tree + '(1 (2 (3 4) 5) + (6 7))) + + (define a-tree-squared + '(1 (4 (9 16) 25) + (36 49))) + + (test-begin "2.30") + (test-equal + a-tree-squared + (directly-square-tree a-tree)) + (test-equal + a-tree-squared + (higher-order-square-tree a-tree)) + (test-end "2.30")) + +(exercise-2.30) + +;; Exercise 2.31 + +(define (exercise-2.31) + (define (tree-map proc tree) + (map (lambda (sub-tree) + (if (pair? sub-tree) + (tree-map proc + sub-tree) + (proc sub-tree))) + tree)) + + (define (square-tree tree) + (tree-map (lambda (x) (* x x)) + tree)) + + (define a-tree + '(1 (2 (3 4) 5) + (6 7))) + + (define a-tree-squared + '(1 (4 (9 16) 25) + (36 49))) + + (test-begin "2.31") + (test-equal + a-tree-squared + (square-tree a-tree)) + (test-equal + a-tree-squared + (square-tree a-tree)) + (test-end "2.31")) + +(exercise-2.31) + +;; Exercise 2.32 + +(define (exercise-2.32) + '() + + (test-begin "2.32") + (test-end "2.32")) + +(exercise-2.32)