SICP/ex-2_18-xx.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")