SICP/ex-2_24-32.scm

207 lines
4.9 KiB
Scheme
Raw Normal View History

2021-04-25 14:57:17 +02:00
(load "shared/util.scm")
2020-10-30 14:44:03 +01:00
2020-10-29 16:47:13 +01:00
(display "\nex-2.24\n")
(define x (cons (list 1 2) (list 3 4)))
(define (display-spaces n)
2020-10-29 22:33:06 +01:00
(cond ((= n 0) ()) (else (display " ") (display-spaces (- n 1)))))
2020-10-29 16:47:13 +01:00
; Procedure to print a tree (in an ugly way)
(define (display-tree tree level)
2020-10-29 22:33:06 +01:00
(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))))
2020-10-29 16:47:13 +01:00
2020-10-29 22:33:06 +01:00
(define x (list 1 (list 2 (list 3 4))))
2020-10-29 16:47:13 +01:00
(display-tree x 0)
2020-10-29 22:33:06 +01:00
; (1 (2 (3 4))) ; result interpreter
; [. .]->[. /]
; | |
; 1 [. .]->[. /]
; | |
; 2 [. .]->[. /]
; | |
; 3 4
; /\
; 1 \
; /\
; 2 \
; \
; /\
; 3 4
2020-10-29 16:47:13 +01:00
(display "\nex-2.25\n")
2020-10-29 22:33:06 +01:00
(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)
2020-10-29 16:47:13 +01:00
(display "\nex-2.26\n")
2020-10-29 22:33:06 +01:00
(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)
2020-10-29 16:47:13 +01:00
2020-10-29 22:33:06 +01:00
; 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))
2020-10-29 16:47:13 +01:00
2020-10-30 14:44:03 +01:00
(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)))
2020-10-29 16:47:13 +01:00