sicp-2-2-2-hierarchical-structures

#lang racket

;;;;;;;;;;
;; 2.24 ;;
;;;;;;;;;;

(list 1 (list 2 (list 3 4)))
;; '(1 (2 (3 4)))

;; Note that, at each nesting level, there is one cons cell for each list element.
;; If the list element is an atom, the car points to the atom.  If the list
;; element is a sub-list, the car points to a new cons cell.

;; car | cdr ----> car | cdr ----> empty
 ;; |               |
 ;; 1              car | cdr ----> car | cdr ----> empty
                 ;; |               |
                 ;; 2              car | cdr ----> car | cdr ----> empty
                                 ;; |               |
                                 ;; 3               4

;; (list 1 (list 2 (list 3 4)))
    ;; |       \
    ;; 1       (list 2 (list 3 4))
                ;; |       \
                ;; 2       (list 3 4)
                            ;; |   \
                            ;; 3    4

;;;;;;;;;;
;; 2.25 ;;
;;;;;;;;;;

;; Note that a car composed with n - 1 cdr's selects the n-th element of a list.

(define nl1 (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr nl1)))))
;; 7
(second (third nl1))
;; 7

(define nl2 (list (list 7)))
(car  (car nl2))
;; 7
(first (first nl2))
;; 7

(define nl3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr nl3))))))))))))
;; 7
(second (second (second (second (second (second nl3))))))
;; 7

;;;;;;;;;;
;; 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))

;;;;;;;;;;
;; 2.27 ;;
;;;;;;;;;;

(define (my-reverse lst)
  (define (iter old-lst new-lst)
    (if (empty? old-lst)
      new-lst
      (iter (rest old-lst) (cons (first old-lst) new-lst))))
  (iter lst empty))

(my-reverse (list (list 1 2) (list 3 4)))
;; '((3 4) (1 2))

(define (deep-reverse lst)
  (define (iter old-lst new-lst)
    (cond [(empty? old-lst) new-lst]
          [(pair? (first old-lst))
           (iter (rest old-lst)
                 (cons (deep-reverse (first old-lst)) new-lst))]
          [else (iter (rest old-lst)
                      (cons (first old-lst) new-lst))]))
  (iter lst empty))

(deep-reverse (list (list 1 2) (list 3 4)))
;; '((4 3) (2 1))

;;;;;;;;;;
;; 2.28 ;;
;;;;;;;;;;

;; Use recursion instead of iteration to keep the order.
;; Use append for sub-lists instead of cons to flatten the list.

(define (fringe lst)
  (cond [(empty? lst) empty]
        [(pair? (first lst))
         (append (fringe (first lst)) (fringe (rest lst)))]
        [else (cons (first lst) (fringe (rest lst)))]))

(fringe (list (list 1 2) (list 3 4)))
;; '(1 2 3 4)

;;;;;;;;;;
;; 2.29 ;;
;;;;;;;;;;

(define (make-mobile left right) (list left right))
(define (make-branch len str) (list len str))
(define (left-branch mobile) (first mobile))
(define (right-branch mobile) (second mobile))
(define (branch-length branch) (first branch))
(define (branch-structure branch) (second branch)) ; can be a weight or a mobile

(define (is-branch-mobile? branch)
  (list? (branch-structure branch)))

(define (total-branch-weight branch)
  (if (is-branch-mobile? branch)
    (total-weight (branch-structure branch))
    (branch-structure branch)))

(define (total-weight mobile)
  (+ (total-branch-weight (left-branch mobile))
     (total-branch-weight (right-branch mobile))))

(define (branch-balanced? branch)
  (if (is-branch-mobile? branch)
    (balanced? (branch-structure branch))
    #t))

(define (balanced? mobile)
  (and (branch-balanced? (left-branch mobile))
       (branch-balanced? (right-branch mobile))
       (= (* (branch-length (left-branch mobile))
             (total-branch-weight (left-branch mobile)))
          (* (branch-length (right-branch mobile))
             (total-branch-weight (right-branch mobile))))))

(define mobile1
  (make-mobile (make-branch 1 2)
               (make-branch 2 1)))
(total-weight mobile1)
;; 3
(balanced? mobile1)
;; #t

(define mobile2
  (make-mobile (make-branch 1 3)
               (make-branch 2 2)))
(total-weight mobile2)
;; 5
(balanced? mobile2)
;; #f

(define mobile3
  (make-mobile (make-branch 3 2)
               (make-branch 2 mobile1)))
(total-weight mobile3)
;; 5
(balanced? mobile3)
;; #t

;; If we changed the mobile and branch constructors to use cons instead of list,
;; then we would have to change the selectors to use first and rest instead of
;; first and second.  Nothing else would have to change.

;;;;;;;;;;
;; 2.30 ;;
;;;;;;;;;;

(define (square-tree tree)
  (cond [(empty? tree) empty]
        [(pair? (first tree))
         (cons (square-tree (first tree))
               (square-tree (rest tree)))]
        [else (cons (sqr (first tree))
                    (square-tree (rest tree)))]))

(square-tree (list (list 1 2) (list 3 4)))
;; '((1 4) (9 16))

(define (square-tree2 tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
           (square-tree2 sub-tree)
           (sqr sub-tree)))
       tree))

(square-tree2 (list (list 1 2) (list 3 4)))
;; '((1 4) (9 16))

;;;;;;;;;;
;; 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-tree3 tree) (tree-map sqr tree))

(square-tree3 (list (list 1 2) (list 3 4)))
;; '((1 4) (9 16))

;;;;;;;;;;
;; 2.32 ;;
;;;;;;;;;;

(define (subsets s)
  (cond [(empty? s) (list empty)]
        [else
          (define rst (subsets (rest s)))
          (append rst
                  (map (lambda (st) (cons (first s) st))
                       rst))]))

;; For any element x of a non-empty set, the set of all subsets can be evenly
;; split into two collections, those subsets that contain x and those that don't.
;; Furthermore, the collection of subsets that do contain x looks exactly like
;; the collection of subsets that do not contain x, except that each has had x
;; added to it.

(subsets (list 1 2))
;; '(() (2) (1) (1 2))

(subsets (list 1 2 3))
;; '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))