Chapter 2. Data Abstraction

Exercise 2.1

Bigits implementation

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(define base 10)

(define (set-base! n)
  (set! base n))

(define (zero) '())

(define is-zero? null?)

(define (successor n)
  (cond [(is-zero? n)
         '(1)]
        [(< (car n) (- base 1))
         (cons (+ 1 (car n)) (cdr n))]
        [else
          (cons 0 (successor (cdr n)))]))

(define (predecessor n)
  (cond [(= 1 (car n))
         (if (null? (cdr n)) (zero) (cons 0 (cdr n)))]
        [(> (car n) 0)
         (cons (- (car n) 1) (cdr n))]
        [else
          (cons (- base 1) (predecessor (cdr n)))]))

(define (integer->bigits n)
  (if (zero? n)
    (zero)
    (successor (integer->bigits (- n 1)))))

(define (bigits->integer n)
  (if (is-zero? n)
    0
    (+ 1 (bigits->integer (predecessor n)))))

(define (plus x y)
  (if (is-zero? x)
    y
    (successor (plus (predecessor x) y))))

(define (multiply x y)
  (cond [(is-zero? x) (zero)]
        [(is-zero? (predecessor x)) y]
        [else
          (plus y (multiply (predecessor x) y))]))

(define (factorial n)
  (if (is-zero? n)
    (successor (zero))
    (multiply n (factorial (predecessor n)))))

Factorial experiments

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
(define (with-base n thunk)
  (let [(orig-base base)]
    (begin
      (set-base! n)
      (thunk)
      (set-base! orig-base))))

(define (print-factorial base n)
  (with-base
    base
    (lambda ()
      (collect-garbage)
      (eopl:printf
        "Base ~s: ~s! = ~s~%"
        base
        n
        (bigits->integer (factorial (integer->bigits n)))))))

Conclusions:

  1. The larger the argument is, the longer the execution time is.

    This is because of inherent time complexity of factorial.

  2. The larger the base is, the shorter the execution time is.

    Because larger base takes fewer bigits to represent a given number.

Exercise 2.2

  1. Unary representation:

    Pros:
    • Fully conforms to the specification, limited by physical memory capacity only.
    • Simple implementation
    Cons:
    • Poor performance
    • Hardly readable when used to represent large numbers

  2. Scheme number representation

    Pros:
    • Simple implementation
    • The representation is easy to read
    • Good performance (completely decided by the underlying concrete Scheme implementation)
    Cons:
    • For Scheme implementations that doesn’t have built-in bignum support, calculation result may overflow, thus doesn’t fully conform to the specification.

  3. Bignum representation

    Pros:
    • Fully conforms to the specification.
    • Relatively good performance. Essentially, larger base leads to better performance.
    • The representation is relatively easier to read
    Cons:
    • Depends on a global state (base)

Exercise 2.3

Question 1

Proof

\(\forall n \in N\), let \(S\) be the set of all representations of \(\lceil n \rceil\). Then, \(\forall x \in S\), we can always construct \(S' \subseteq S\) using the following generation rules:

\[x \in S\]
\[\frac { y \in S } { \text{(diff} \; x \; \text{(diff} \; \text{(one)} \; \text{(one))} \text{)} }\]

Apparently, we have \(\lvert S' \rvert = \infty\). Thus \(\lvert S \rvert = \infty\).

Q.E.D.

Question 2

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
(define-datatype diff-tree diff-tree?
                 (one)
                 (diff (lhs diff-tree?)
                       (rhs diff-tree?)))

(define (zero) (diff (one) (one)))

(define (integer->diff-tree n)
  (cond [(= 1 n) (one)]
        [(> n 0) (successor (integer->diff-tree (- n 1)))]
        [else (predecessor (integer->diff-tree (+ n 1)))]))

(define (diff-tree->integer n)
  (cases diff-tree n
         [one () 1]
         [diff (lhs rhs) (- (diff-tree->integer lhs)
                            (diff-tree->integer rhs))]))

(define (diff-tree=? n m)
  (= (diff-tree->integer n) (diff-tree->integer m)))

(define (is-zero? n)
  (cases diff-tree n
         (one () #f)
         (diff (lhs rhs) (diff-tree=? lhs rhs))))

(define (successor n)
  (diff n (diff (zero) (one))))

(define (predecessor n)
  (diff n (one)))

Question 3

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
(define (diff-tree-plus n m)
  (diff n (diff (zero) m)))

(check-diff-tree=? (diff-tree-plus (zero) (one))
                   (one))

(check-diff-tree=? (diff-tree-plus (integer->diff-tree 1024)
                                   (integer->diff-tree 2048))
                   (integer->diff-tree 3072))
;; end

Exercise 2.4

Constructors:

\[\begin{split}(\text{empty-stack}) &= \lceil \emptyset \rceil \\ (\text{push} \; \lceil e \rceil \; \lceil stk \rceil) &= \lceil stk' \rceil, \text{where } (\text{top} \; \lceil stk' \rceil) = \lceil e \rceil \\\end{split}\]

Observers:

\[\begin{split}(\text{empty-stack?} \; \lceil stk \rceil) &= \begin{cases} \text{#t} & \text{if } stk = \lceil \emptyset \rceil \\ \text{#f} & \text{otherwise} \end{cases} \\ (\text{top} \; \lceil stk \rceil) &= \lceil e \rceil, \text{where } \lceil stk \rceil = (\text{push} \; \lceil e \rceil \; (\text{pop} \; \lceil stk \rceil)) \\ (\text{pop} \; \lceil stk \rceil) &= \lceil stk' \rceil, \text{where } (\text{push} \; (\text{top} \; \lceil stk \rceil) \; \lceil stk' \rceil) = \lceil stk \rceil\end{split}\]

Exercise 2.5

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
(define (empty-env) '())

(define (extend-env var val env)
  (cons (cons var val) env))

(define (apply-env env search-var)
  (cond [(null? env)
         (report-no-binding-found search-var)]
        [(eqv? (caar env) search-var)
         (cdar env)]
        [else
          (apply-env env (cdr env))]))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Exercise 2.6

Implementation 1

Represent environments as functions.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
(define (empty-env)
  (lambda (search-var)
    (eopl:error 'apply-env "No binding for ~s" search-var)))

(define (extend-env var val env)
  (lambda (search-var)
    (if (eqv? var search-var) val (apply-env env search-var))))

(define (apply-env env search-var)
  (env search-var))

Implementation 2

A representation that doesn’t allow variable “shadowing”:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
(define (empty-env) '())

(define (extend-env var val env)
  (cond [(null? env)
         (list (cons var val))]
        [(eqv? var (caar env))
         (cons (cons var val)
               (cdr env))]
        [else
          (cons (car env)
                (extend-env var val (cdr env)))]))

(define (apply-env env search-var)
  (cond [(null? env)
         (report-no-binding-found search-var)]
        [(eqv? search-var (caar env))
         (cdar env)]
        [else
          (apply-env (cdr env) search-var)]))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Implementation 3

Represent environments as “ribs”: a pair consists of a list of variables and a list of values.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
(define (empty-env) (cons '() '()))

(define (extend-env var val env)
  (let [(vars (car env))
        (vals (cdr env))]
    (cons (cons var vars)
          (cons val vals))))

(define (apply-env env search-var)
  (let* [(vars (car env))
         (vals (cdr env))]
    (cond [(null? vars)
           (report-no-binding-found search-var)]
          [(eqv? search-var (car vars))
           (car vals)]
          [else
            (apply-env (cons (cdr vars)
                             (cdr vals)))])))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Exercise 2.7

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
(define (apply-env env search-var)
  (let apply-env-impl [(env* env)
                       (search-var* search-var)]
    (cond [(eqv? (car env*) 'empty-env)
           (report-no-binding-found search-var* env)]
          [(eqv? (car env*) 'extend-env)
           (let [(saved-var (cadr env*))
                 (saved-val (caddr env*))
                 (saved-env (cadddr env*))]
             (if (eqv? search-var* saved-var)
               saved-val
               (apply-env saved-env search-var*)))]
          [else
            (report-invalid-env env*)])))

(define (report-no-binding-found search-var env)
  (eopl:error 'apply-env "No binding for ~s in environment ~s" search-var env))

Exercise 2.8

1
(define empty-env? null?)

Exercise 2.9

1
2
3
4
(define (has-binding? env s)
  (cond [(empty-env? env) #f]
        [(eqv? s (caar env)) #t]
        [else (has-binding? (cdr env) s)]))

Exercise 2.10

1
2
3
4
5
6
7
8
(define (extend-env* vars vals env)
  (if (null? vars)
    env
    (extend-env* (cdr vars)
                 (cdr vals)
                 (extend-env (car vars)
                             (car vals)
                             env))))

Exercise 2.11

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(define (empty-env) '())

(define (extend-env* vars vals env)
  (cons (cons vars vals) env))

(define (extend-env var val env)
  (extend-env* (list var) (list val) env))

(define (apply-env env search-var)
  (cond [(null? env)
         (report-no-binding-found search-var)]
        [else
          (let apply-ribs [(ribs (car env))]
            (let [(vars (car ribs))
                  (vals (cdr ribs))]
              (cond [(null? vars)
                     (apply-env (cdr env) search-var)]
                    [(eqv? (car vars) search-var)
                     (car vals)]
                    [else
                      (apply-ribs (cons (cdr vars) (cdr vals)))])))]))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Exercise 2.12

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(define (empty-stack)
  (list #t
        (lambda ()
          (eopl:error 'top "Stack is empty"))
        (lambda ()
          (eopl:error 'pop "Stack is empty"))))

(define (push e stk)
  (list #f
        (lambda () e)
        (lambda () stk)))

(define (empty-stack? stk)
  (list-ref stk 0))

(define (top stk)
  ((list-ref stk 1)))

(define (pop stk)
  ((list-ref stk 2)))

(define (stack=? s1 s2)
  (cond [(empty-stack? s1)
         (empty-stack? s2)]
        [(empty-stack? s2)
         (empty-stack? s1)]
        [else
          (and (eqv? (top s1) (top s2))
               (stack=? (pop s1) (pop s2)))]))

(define-binary-check
  (check-stack=? stack=? actual expected))

Exercise 2.13

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
(define (empty-env)
  (cons (lambda (search-var)
          (report-no-binding-found search-var))
        (lambda () #t)))

(define (extend-env saved-var saved-val saved-env)
  (cons (lambda (search-var)
          (if (eqv? search-var saved-var)
            saved-val
            (apply-env saved-env search-var)))
        (lambda () #f)))

(define (apply-env env search-var)
  ((car env) search-var))

(define (empty-env? env)
  ((cdr env)))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Exercise 2.14

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
(define (empty-env)
  (list (lambda (search-var)
          (report-no-binding-found search-var))
        (lambda () #t)
        (lambda (search-var) #f)))

(define (extend-env saved-var saved-val saved-env)
  (list (lambda (search-var)
          (if (eqv? search-var saved-var)
            saved-val
            (apply-env saved-env search-var)))
        (lambda () #f)
        (lambda (search-var)
          (if (eqv? search-var saved-var)
            #t
            ((list-ref saved-env 2) search-var)))))

(define (apply-env env search-var)
  ((list-ref env 0) search-var))

(define (empty-env? env)
  ((list-ref env 1)))

(define (has-binding? env search-var)
  ((list-ref env 2) search-var))

(define (report-no-binding-found search-var)
  (eopl:error 'apply-env "No binding for ~s" search-var))

Exercise 2.15

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(define (var-exp var)
  `(var-exp ,var))

(define (lambda-exp bound-var body)
  `(lambda-exp (,bound-var) ,body))

(define (app-exp rator rand)
  `(app-exp ,rator ,rand))

(define (var-exp? exp)
  (match exp
    [(list 'var-exp (? symbol?)) #t]
    [_ #f]))

(define (lambda-exp? exp)
  (match exp
    [(list 'lambda-exp (list (? var-exp?)) (? lc-exp?)) #t]
    [_ #f]))

(define (app-exp? exp)
  (match exp
    [(list 'app-exp (? lc-exp?) (? lc-exp?)) #t]
    [_ #f]))

(define (lc-exp? exp)
  (or (var-exp? exp)
      (lambda-exp? exp)
      (app-exp? exp)))

(define (var-exp->var exp)
  (match exp
    [(list 'var-exp var) var]))

(define (lambda-exp->bound-var exp)
  (match exp
    [(list 'lambda-exp (list bound-var) _) bound-var]))

(define (lambda-exp->body exp)
  (match exp
    [(list 'lambda-exp _ body) body]))

(define (app-exp->rator exp)
  (match exp
    [(list 'app-exp rator _) rator]))

(define (app-exp->rand exp)
  (match exp
    [(list 'app-exp _ rand) rand]))

Exercise 2.16

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(define (var-exp var)
  `(var-exp ,var))

(define (lambda-exp bound-var body)
  `(lambda-exp ,bound-var ,body))

(define (app-exp rator rand)
  `(app-exp ,rator ,rand))

(define (var-exp? exp)
  (match exp
         [(list 'var-exp (? symbol?)) #t]
         [_ #f]))

(define (lambda-exp? exp)
  (match exp
         [(list 'lambda-exp (? var-exp?) (? lc-exp?)) #t]
         [_ #f]))

(define (app-exp? exp)
  (match exp
         [(list 'app-exp (? lc-exp?) (? lc-exp?)) #t]
         [_ #f]))

(define (lc-exp? exp)
  (or (var-exp? exp)
      (lambda-exp? exp)
      (app-exp? exp)))

(define (var-exp->var exp)
  (match exp
         [(list 'var-exp var) var]))

(define (lambda-exp->bound-var exp)
  (match exp
         [(list 'lambda-exp bound-var _) bound-var]))

(define (lambda-exp->body exp)
  (match exp
         [(list 'lambda-exp _ body) body]))

(define (app-exp->rator exp)
  (match exp
         [(list 'app-exp rator _) rator]))

(define (app-exp->rand exp)
  (match exp
         [(list 'app-exp _ rand) rand]))

Exercise 2.17

Representation 1

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(define (var-exp var) var)

(define (lambda-exp bound-var body)
  `(,bound-var ,body))

(define (app-exp rator rand)
  `(,rator ,rand))

(define (var-exp? exp) (symbol? exp))

(define (lambda-exp? exp)
  (match exp
         [(list (? var-exp?) (? lc-exp?)) #t]
         [_ #f]))

(define (app-exp? exp)
  (match exp
         [(list (? lc-exp?) (? lc-exp?)) #t]
         [_ #f]))

(define (lc-exp? exp)
  (or (var-exp? exp)
      (lambda-exp? exp)
      (app-exp? exp)))

(define (var-exp->var exp) exp)

(define (lambda-exp->bound-var exp)
  (match exp
         [(list bound-var _) bound-var]))

(define (lambda-exp->body exp)
  (match exp
         [(list _ body) body]))

(define (app-exp->rator exp)
  (match exp
         [(list rator _) rator]))

(define (app-exp->rand exp)
  (match exp
         [(list _ rand) rand]))

Representation 2

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(define (var-exp var)
  (cons 'var-exp
        (lambda () var)))

(define (lambda-exp bound-var body)
  (cons 'lambda-exp
        (lambda (field)
          (match field
                 ['bound-var bound-var]
                 ['body body]))))

(define (app-exp rator rand)
  (cons 'app-exp
        (lambda (field)
          (match field
                 ['rator rator]
                 ['rand rand]))))

(define (var-exp? exp)
  (match exp
         [(cons 'var-exp _) #t]
         [_ #f]))

(define (lambda-exp? exp)
  (match exp
         [(cons 'lambda-exp _) #t]
         [_ #f]))

(define (app-exp? exp)
  (match exp
         [(cons 'app-exp _) #t]
         [_ #f]))

(define (lc-exp? exp)
  (or (var-exp? exp)
      (lambda-exp? exp)
      (app-exp? exp)))

(define (var-exp->var exp)
  ((cdr exp)))

(define (lambda-exp->bound-var exp)
  ((cdr exp) 'bound-var))

(define (lambda-exp->body exp)
  ((cdr exp) 'body))

(define (app-exp->rator exp)
  ((cdr exp) 'rator))

(define (app-exp->rand exp)
  ((cdr exp) 'rand))

Exercise 2.18

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
(define (number->sequence n)
  (list n '() '()))

(define (current-element seq)
  (car seq))

(define (move-to-left seq)
  (if (at-left-end? seq)
    (eopl:error 'move-to-left
                "Sequence ~s is already at its left end" seq)
    (let* [(n (car seq))
           (left (cadr seq))
           (right (caddr seq))
           (new-n (car left))
           (new-left (cdr left))
           (new-right (cons n right))]
      (list new-n new-left new-right))))

(define (move-to-right seq)
  (if (at-right-end? seq)
    (eopl:error 'move-to-right
                "Sequence ~s is already at its right end" seq)
    (let* [(n (car seq))
           (left (cadr seq))
           (right (caddr seq))
           (new-n (car right))
           (new-left (cons n left))
           (new-right (cdr right))]
      (list new-n new-left new-right))))

(define (insert-to-left n seq)
  (let* [(current (car seq))
         (left (cadr seq))
         (right (caddr seq))
         (new-left (cons n left))]
    (list current new-left right)))

(define (insert-to-right n seq)
  (let* [(current (car seq))
         (left (cadr seq))
         (right (caddr seq))
         (new-right (cons n right))]
    (list current left new-right)))

(define (at-left-end? seq)
  (null? (cadr seq)))

(define (at-right-end? seq)
  (null? (caddr seq)))

Exercise 2.19

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
(define (number->bintree n)
  `(,n () ()))

(define (current-element bintree)
  (car bintree))

(define (move-to-left-son bintree)
  (cadr bintree))

(define (move-to-right-son bintree)
  (caddr bintree))

(define (at-leaf? bintree)
  (null? bintree))

(define (insert-to-left n bintree)
  (let* [(root (car bintree))
         (lhs (move-to-left-son bintree))
         (rhs (move-to-right-son bintree))
         (lhs* `(,n ,lhs ()))]
    `(,root ,lhs* ,rhs)))

(define (insert-to-right n bintree)
  (let* [(root (car bintree))
         (lhs (move-to-left-son bintree))
         (rhs (move-to-right-son bintree))
         (rhs* `(,n ,rhs ()))]
    `(,root ,lhs ,rhs*)))