Chapter 2 of Structure and Interpretation of Compupter Programs.

2.1 Introduction to data abstraction

2.1.1 Example: arithmetic operations for rational numbers

The data is described by constructors and selectors.

(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))

(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))

(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))

(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

(define (make-rat n d)
  (let ([g (gcd n d)])
    (cons (/ n g) (/ d g))))

(define (numer x) (car x))

(define (denom x) (cdr x))

(define (print-rat x)
  (fprintf (current-output-port)
           "~a/~a\n"
           (car x)
           (cdr x)))

(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

Exercise 2.1

(define (make-rat-1 n d)
  (let* ([g (gcd n d)]
         [p (/ n g)]
         [q (/ d g)])
    (if (negative? q)
        (cons (* -1 p) (* -1 q))
        (cons p q))))

;; test cases
(print-rat (make-rat-1 1 3))
(print-rat (make-rat-1 -1 3))
(print-rat (make-rat-1 1 -3))
(print-rat (make-rat-1 -1 -3))
(print-rat (make-rat-1 0 -3))

2.1.2 Abstraction barriers

Exercise 2.2

(define (make-segment starting-p ending-p)
  (cons starting-p ending-p))

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cdr s))

(define (make-point x y)
  (cons x y))

(define (x-point p)
  (car p))

(define (y-point p)
  (cdr p))

(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))


(define (midpoint-segment s)
  (define (average a b)
    (/ (+ a b) 2))
  (let ([starting-p (start-segment s)]
        [ending-p (end-segment s)])
    (make-point (average (x-point starting-p)
                         (x-point ending-p))
                (average (y-point starting-p)
                         (y-point ending-p)))))
;; test cases
(define point-a (make-point 0 1))
(define point-b (make-point 5 5))
(define s (make-segment point-a point-b))
(print-point (midpoint-segment s))

Exercise 2.3

;; Exercise 2.3

2.1.3 What is meant by data?

(define (my-cons x y)
  (define (dispatch m)
    (cond [(= m 0) x]
          [(= m 1) y]
          [else (error "Argument not 0 0r 1 -- my-cons" m)]))
  dispatch)

(define (my-car z) (z 0))

(define (my-cdr z) (z 1))

Procedural representations of data will play a central role in our programming repertoire. This style of programming is often called message passing.

Exercise 2.4

(define (cons-1 x y)
  (lambda (m) (m x y)))

(define (car-1 z)
  (z (lambda (p q) p)))

(define (cdr-1 z)
  (z (lambda (p q) q)))

;; test cases
(newline)
(car-1 (cons-1 1 2))
(cdr-1 (cons-1 1 2))

Exercise 2.5

;; representing pairs of nonngative integers
(define (cons-2  a b)
  (define (expt b n)
    (if (= n 0)
        1
        (* b (expt b (- n 1)))))
  (* (expt 2 a) (expt 3 b)))

(define (car-2 n)
  (define (iter m r)
    (cond [(= (remainder m 2) 0) (iter (/ m 2) (+ r 1))]
          [else r]))
  (iter n 0))

(define (cdr-2 n)
  (define (iter m r)
    (cond [(= (remainder m 3) 0) (iter (/ m 3) (+ r 1))]
          [else r]))
  (iter n 0))

;; test cases
(car-2 (cons-2 5 2))
(cdr-2 (cons-2 5 2))
(cdr-2 (cons-2 5 0))

Exercise 2.6

;; #### Exercise 2.6
(define zero (lambda (f) (lambda (x) x)))
(define one  (lambda (f) (lambda (x) (f x))))
(define two  (lambda (f) (lambda (x) (f (f x)))))
(define (church+ n m)
  (lambda (f) (lambda (x) (n (m x)))))

2.2 Hierarchical Data and Closure Property

Closure is the key to power in any means of combination because it permits us to create hierarchical structures—structures made up of parts, which themselves are made up of parts, and so on.

#lang racket
;; 2.2 Hierarchical Data and Closure Property

(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))

;; test cases
(define squares (list 1 4 9 16 25))
(list-ref squares 3)

(define (safe-list-ref items n)
  (cond [(null? items) null]
        [(= n 0) (car items)]
        [else (safe-list-ref (cdr items) (- n 1))]))

;; test cases
(safe-list-ref squares 3)
(safe-list-ref squares 5)

(define (length items)
  (define (length-iter a count)
    (if (null? a)
        count
        (length-iter (cdr a) (+ count 1))))
  (length-iter items 0))

;; test cases
(define odds (list 1 3 5 7))
(length odds)

(define (my-append list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (my-append (cdr list1) list2))))
;; test cases
(my-append (list 1 2 3 4) (list 5 7 8))

2.2.1 Representing Sequences

Exercise 2.17

;; #### Exercise 2.17
(define (last-pair lst)
  (if (null? (cdr lst))
      (car lst)
      (last-pair (cdr lst))))
;; test cases
(last-pair (list 23 72 149 34))

Exercise 2.18

;; #### Exercise 2.18
(define (my-reverse lst)
  (define (reverse-iter l r)
    (if (null? l)
        r
        (reverse-iter (cdr l)
                      (cons (car l) r))))
  (reverse-iter lst null))
;; test cases
(my-reverse (list 1 2 3 4 5))
(my-reverse (list 2))
(my-reverse '())

Exercise 2.20

;; #### Exercise 2.20
(define (same-parity x . w)
  (define (collect f a b)
    (cond [(null? a) (reverse b)]
          [(f (car a)) (collect f (cdr a) (cons (car a) b))]
          [else (collect f (cdr a) b)]))
  (let ([ f (if (even? x) even? odd?)])
    (collect f w (list x))))
;; test cases
(same-parity 1 2 3 4 5 6 7)
(same-parity 2 3 4 5 6 7)
(same-parity 1)

Mapping over lists

(define (scale-list items factor)
  (if (null? items)
      null
      (cons (* (car items) factor)
            (scale-list (cdr items)
                        factor))))
;; test cases
(scale-list (list 1 2 3 4 5) 10)

(define (my-map proc items)
  (if (null? items)
      null
      (cons (proc (car items))
            (map proc (cdr items)))))
;; test cases
(my-map abs (list -10 2.5 -11.6 17))
(my-map (lambda (x) (* x x)) (list 1 2 3 4))

(define (scale-list-1 items factor)
  (my-map (lambda (x) (* x factor))
          items))
;; test cases
(scale-list-1 (list 1 2 3 4 5) 10)

Exercise 2.21

(define (square-list items)
  (if (null? items)
      nil
      (cons (square (car items))
            (square-list (cdr items)))))

(define (square-list items)
  (map square items))

Exercise 2.22

(cons e answer) puts the left elements in the original list into the right side of the new list.

(cons nil e) creates a list (() e) instead of (e).

Exercise 2.23

;; #### Exercise 2.23
(define (my-for-each proc items)
  (if (null? items)
      (display "")
      (begin
        (proc (car items))
        (my-for-each proc (cdr items)))))
;; test cases
(my-for-each (lambda (x) (newline) (display x))
          (list 52 321 88))

2.2.2 Hierarchical Structures

(define (count-leaves x)
  (cond [(null? x) 0]
        [(not (pair? x)) 1]
        [else (+ (count-leaves (car x))
                 (count-leaves (cdr x)))]))

Exercise 2.27

;; #### Exercise 2.27
(define (deep-reverse lst)
  (define (deep-reverse-iter l r)
    (cond [(null? l) r]
          [(not (pair? (car l))) (deep-reverse-iter (cdr l)
                                                    (cons (car l)
                                                          r))]
          [else (deep-reverse-iter (cdr l)
                                   (cons (deep-reverse-iter (car l) null)
                                         r))]))
  (deep-reverse-iter lst null))
;; test cases
(deep-reverse (list 1 2 3 4))
(deep-reverse (list (list 1 2) (list 3 4)))

Exercise 2.28

(define (fringe x)
  (cond [(null? x) nil]
        [(not (pair? (car x)))
         (cons (car x) (fringe (cdr x)))]
        [else (append (fringe (car x))
                      (fringe (cdr x)))]))

Mapping over trees

(define (scale-tree tree factor)
  (cond [(null? tree) nil]
        [(not (pair? tree)) (* tree factor)]
        [else (cons (scale-tree (car tree) factor)
                    (scale-tree (cdr tree) factor))]))

;; regard the tree as a sequence of sub-trees and use map
(define (scale-tree tree factor)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (scale-tree sub-tree factor)
             (* sub-tree factor)))
       tree))

(scale-tree (list 1 2 3 4) 10)
(scale-tree (list 1 2 (list 2 3 (list 3 4)) (list 2)) 10)

Exercise 2.30

;; #### Exercise 2.30
(define (square-tree tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree sub-tree)
             (* sub-tree sub-tree)))
       tree))
;; test cases
(square-tree
 (list 1
       (list 2 (list 3 4) 5)
       (list 6 7)))

Exercise 2.31

(define (tree-map f tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (tree-map f sub-tree)
             (f sub-tree)))
       tree))

(define (square-tree tree) (tree-map square tree))

Exercise 2.32

(define (subsets s)
  (if (null? s)
      (list nil)
      (let ([rest (subsets (cdr s))])
        (append rest (map (lambda (x) (cons (car s) x))
                          rest)))))

2.2.3 Sequences as conventional interfaces

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define fold-right accumulate)

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

Exercise 2.33

;; #### Exercise 2.33
(define (map-233 p sequence)
  (fold-right (lambda (x y) (cons (p x) y)) null sequence))
(define (append-233 seq1 seq2)
  (fold-right (lambda (x y) (cons x y)) seq2 seq1))
(define (length-233 sequence)
  (fold-right (lambda (x y) (+ 1 y)) 0 sequence))
;; test cases
(map-233 (lambda (x) (* x x)) '(1 2 3 4))
(append-233 '(1 2 3) '(4 5 6))
(length-233 '(2 3 4))
(length-233 '(1))
(length-233 '())

Exercise 2.35

(define (count-leaves-map t)
  (accumulate + 0 (map (lambda (x)
                         (if (not (pair? x))
                             1
                             (count-leaves-map x)))
                       t)))

Exercise 2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))


(accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))

Exercise 2.37

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
  (map (lambda (w) (dot-product v w)) m))

(define (transpose mat)
  (accumulate-n cons nil mat))

(define (matrix-*-matrix m n)
  (let ([cols (transpose n)])
    (map (lambda (v) (map (lambda (w) (dot-product v w))
                          cols))
         m)))

(define (matrix-*-matrix2 m n)
  (let ([cols (transpose n)])
    (transpose (map (lambda (v) (matrix-*-vector m v))
                    cols))))

(define m '((1 2 3 4) (4 5 6 6) (6 7 8 9) (1 1 1 1)))
(define v '(1 2 3 4))
(matrix-*-vector m v)
(transpose m)
(matrix-*-matrix m m)
(matrix-*-matrix2 m m)

Exercise 2.38

;; op should satisfy associative property, i.e.
;; (op x (op y z)) equals to (op (op x y) z)
;; #### Exercise 2.38
(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))
;; test cases
(fold-right / 1 (list 1 2 3))
(fold-left / 1 (list 1 2 3))
(fold-right list null (list 1 2 3))
(fold-left list null (list 1 2 3))
(fold-right + 0 (list 1 2 3 4 5))
(fold-left + 0 (list 1 2 3 4 5))

Exercise 2.39

(define (reverse-r sequence)
  (foldr (lambda (x y) (append y (list x))) nil sequence))

(define (reverse-l sequence)
  (foldl (lambda (x y) (cons x y)) nil sequence))

In Racket the initial is the last argument for both foldl and foldr which is different from the case in SICP.

Nested Mappings

(define (flatmap proc seq) ;; `append-map` in racket
  (foldr append null (map proc seq)))

(flatmap (lambda (i)
           (map (lambda (j) (list i j))
                (enumerate-interval 1 (- i 1))))
         (enumerate-interval 5 6))

(define (permutations s)
  (if (null? s)
      (list null)
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))

Exercise 2.40

(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j) (list i j))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

Exercise 2.41

(define (unique-triples n)
  (flatmap (lambda (i)
             (map (lambda (p) (cons i p))
                  (unique-pairs (- i 1))))
           (enumerate-interval 1 n)))

Exercise 2.42

(define (adjoin-position new-row k rest-of-queens)
  (cons (cons new-row k) rest-of-queens))

(define (safe? k positions)
  (let ([r (car (car positions))]
        [rest-positions (cdr positions)])
    (and (all-true? (map (lambda (p) (not (= r (car p)))) ;; check row
                         rest-positions))
         (all-true? (map (lambda (p) (not (= (abs (- r (car p))) ;; check diagonal
                                             (abs (- k (cdr p))))))
                         rest-positions)))))

(define (safe? k positions)
  (define (check-row r p)
    (not (= r (car p))))
  (define (check-diag r k p)
    (not (= (abs (- r (car p)))
            (abs (- k (cdr p))))))
  (let ([r (car (car positions))]
        [rest-positions (cdr positions)])
    (andmap (lambda (p)
              (and (check-row r p)
                   (check-diag r k p)))
            rest-positions)))    
         
(define empty-board nil)

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;(define positions-1 (list (cons 6 8) (cons 4 7) (cons 1 6) (cons 5 5)
;                          (cons 8 4) (cons 2 3) (cons 7 2) (cons 3 1)))
;(define positions-2 (list (cons 2 2) (cons 3 1)))
;(safe? 2 positions-2)

;(filter (lambda (x) (= 6 (car (car x)))) (queens 8))
;(length (queens 8))

2.2.4 Example: A Picture Language

The code in this subsection requires the following command

#lang racket
(require sicp-pict)

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ([smaller (right-split painter (- n 1))])
        (beside painter (below smaller smaller)))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ([smaller (up-split painter (- n 1))])
        (below painter (beside smaller smaller)))))

;(paint (right-split einstein 2))
;(paint (up-split einstein 2))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let* ([up (up-split painter (- n 1))]
             [right (right-split painter (- n 1))]
             [top-left (beside up up)]
             [bottom-right (below right right)]
             [corner (corner-split painter (- n 1))])
        (beside (below painter top-left)
                (below bottom-right corner)))))

;(paint (corner-split einstein 4))

(define (square-limit painter n)
  (let* ([quarter (corner-split painter n)]
         [half (beside (flip-horiz quarter) quarter)])
    (below (flip-vert half) half)))

;(paint (square-limit einstein 4))

Exercise 2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ([smaller (up-split painter (- n 1))])
        (below painter (beside smaller smaller)))))

(paint (up-split einstein 2))

2.3 Symbolic Data

2.3.1 Quotation

(define (memq item x)
  (cond [(null? x) #f]
        [(eq? item (car x)) x]
        [else (memq item (cdr x))]))

(eq? a b) only returns true if and only if a and b consist of the same characters in the same order.

(eq? '(a b) '(a b)) ; -> false, as '(a b) is not symbol but a list of symbol
(eq? ''a ''a) ; -> false, as ''a is a list of symbol
(equal? '(a b) '(a b)); -> true
(equal? ''a ''a); -> true
(= 'a 'a); -> nothing

#### Exercise 2.54

(define (my-equal? x y)
  (cond [(and (null? x) (null? y)) #t]
        [(or (and (null? x) (not (null? y)))
             (and (not (null? x)) (null? y))) #f]
        [else (and (eq? (car x) (car y))
                   (my-equal? (cdr x) (cdr y)))]))

(my-equal? '(this is a list) '(this is a list)) ; true

2.3.2 Example: Symbolic Differentiation

(define (deriv exp var)
  (cond [(number? exp) 0]
        [(variable? exp)
         (if (same-variable? exp var) 1 0)]
        [(sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var))]
        [(product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp)))]
        [else
         (error "unknown expression type -- DERIV" exp)]))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (make-sum a1 a2) (list '+ a1 a2))

(define (make-product m1 m2) (list '* m1 m2))

(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))

(define (product? x)
  (and (pair? x) (eq? (car x) '*)))

(define (addend s) (cadr s))

(define (augend s) (caddr s))

(define (multiplier p) (cadr p))

(define (multiplicand p) (caddr p))

(deriv '(* x y) 'x)
(deriv '(* (* x y) (+ x 3)) 'x)

2.3.3 Example: Representing Sets

Sets as unordered lists

(define (element-of-set? x set)
  (cond [(null? set) false]
        [(equal? x (car set)) true]
        [else (element-of-set? x (cdr set))]))

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))

(define (intersection-set set1 set2)
  (cond [(or (null? set1) (null? set2)) '()]
        [(element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2))]
        [else (intersection-set (cdr set1) set2)]))

Exercise 2.59

(define (union-set set1 set2)
  (cond [(null? set1) set2]
        [(null? set2) set1]
        [(element-of-set? (car set1) set2)
         (union-set (cdr set1) set2)]
        [else (cons (car set1)
                    (union-set (cdr set1) set2))]))

Exercise 2.60

(define (adjoin-set x set)
  (cons x set))

(define (union-set set1 set2)
  (append set1 set2))

Sets as ordered list

(define (element-of-set? x set)
  (cond [(null? set) false]
        [(= x (car set)) true]
        [(< x (car set)) false]
        [else (element-of-set? x (cdr set))]))

(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
      '()
      (let ([x1 (car set1)]
            [x2 (car set2)])
        (cond [(= x1 x2)
               (cons x1
                     (intersection-set (cdr set1)
                                       (cdr set2)))]
              [(< x1 x2)
               (intersection-set (cdr set1) set2)]
              [(< x2 x1)
               (intersection-set set1 (cdr set2))]))))

Exercise 2.62

(define (union-set set1 set2)
  (define (union-set-un-null set1 set2)
    (let ([x1 (car set1)]
          [x2 (car set2)])
      (cond [(= x1 x2)
             (cons x1
                   (union-set (cdr set1)
                              (cdr set2)))]
            [(< x1 x2)
             (cons x1
                   (union-set (cdr set1) set2))]
            [else
             (cons x2
                   (union-set set1 (cdr set2)))])))       
  (cond [(null? set1) set2]
        [(null? set2) set1]
        [else (union-set-un-null set1 set2)]))

Sets as binary trees

(define (entry tree) (car tree))

(define (left-branch tree) (cadr tree))

(define (right-branch tree) (caddr tree))

(define (make-tree entry left right)
  (list entry left right))

(define (element-of-set? x set)
  (cond [(null? set) false]
        [(= x (entry set)) true]
        [(< x (entry set))
         (element-of-set? x (left-branch set))]
        [(> x (entry set))
         (element-of-set? x (right-branch set))]))


(define (adjoin-set x set)
  (cond [(null? set) (make-tree x '() '())]
        [(= x (entry set)) set]
        [(< x (entry set))
         (make-tree (entry set)
                    (adjoin-set x (left-branch set))
                    (right-branch set))]
        [(> x (entry set))
         (make-tree (entry set)
                    (left-branch set)
                    (adjoin-set x (right-branch set)))]))

2.3.4 Example: Huffman Encoding Trees