SICP 2.5 exercises cont. 5

2.91

Made some heavy changes to the dense polynomial package to get it working. A bit frustrating, but this was great to get back into the groove. I only implemented division for dense polynomials, maybe I’ll go back and do sparse polynomials in the future.

(define (install-dense-polynomial-package)
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- ADD-POLY"
               (list p1 p2))))
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
      (error "Polys not in same var -- MUL-POLY"
             (list p1 p2))))

  (define (div-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (div-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- DIV-POLY"
               (list p1 p2))))

  ;; internal procedures
  ;; representation of poly
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (variable? x) (symbol? x))
  (define (term-list p) (cdr p))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))

  (define (adjoin-term term term-list)
    (cons term term-list))
  (define (the-empty-termlist) '())
  (define (first-term term-list)
    (make-term (length term-list) (car term-list)))
  (define (rest-terms term-list)
    (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))

  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          ((> (length L1) (length L2)) (adjoin-term (coeff (first-term L1)) (add-terms (rest-terms L1) L2)))
          (( (order t2) (order t1))
            (list (the-empty-termlist) L1)
          (let ((new-c (div (coeff t1) (coeff t2)))
                (new-o (- (order t1) (order t2))))
            (display t1) (display t2) (display new-o) (display (term2terms (make-term new-o new-c))) (newline) (newline)
            (let ((rest-of-result
                   (div-terms (trim (add-terms L1 (negate-terms (mul-terms (term2terms (make-term new-o new-c)) L2)))) L2)))
              (list (add-terms (car rest-of-result) (term2terms (make-term new-o new-c)))
                    (cadr rest-of-result))))))))

  (define (negate-poly p)
    (make-poly (variable p) (negate-terms (term-list p))))
  ;; interface to rest of the system
  (define (tag p) (attach-tag 'dense p))
  (put 'add '(dense dense)
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(dense dense)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'div '(dense dense)
       (lambda (p1 p2) (tag (div-poly p1 p2))))
  (put 'make 'dense
       (lambda (var terms) (tag (make-poly var terms))))
  (put '=zero? '(dense) (lambda (p) (zero-terms? (term-list p))))
  (put 'negate '(dense) (lambda (p) (tag (negate-poly p))))
  'done)

(define (negate x) (apply-generic 'negate x))

(define (sub x y)
  (add x (negate y)))

(define (install-polynomial-package)
  (define (make-dense-proc var terms)
    ((get 'make 'dense) var terms))
  (define (make-sparse-proc var terms)
    ((get 'make 'sparse) var terms))
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul p1 p2))))
  (put 'div '(polynomial polynomial)
       (lambda (p1 p2) (tag (div p1 p2))))
  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (sub p1 p2))))
  (put 'negate '(polynomial) (lambda (p) (tag (negate p))))
  (put 'make-dense 'polynomial
       (lambda (var terms) (tag (make-dense-proc var terms))))
  (put 'make-sparse 'polynomial
       (lambda (var terms) (tag (make-sparse-proc var terms)))))

Still Busy

Well, I’ve completely failed my New Year’s Resolution at this point. I’ll just summarize some things I’ve been doing.

– Research: Been progressing. What’s interesting is that through my work I’ve had a lot of practice working with tree structures. I also started using Postgres which has been great. At this point it’s my favorite relational database.

– C practice: I feel like my C skills have been stagnating so I did some simple exercises like implementing linked lists and binary trees. Nothing too interesting, but it’s been great for reinforcing my knowledge of C and especially pointer and memory management.

– Various tech: I’ve been going over technologies like LLVM, Twisted, and Ruby on Rails for fun. They’re all things I want to eventually sit down and put time an effort into learning properly but for now I’m just randomly dabbling.


SICP 2.5 exercises cont. 4

2.90

This took a really long time. Not only was I very busy with school and work, but also I kept getting lost in my code when I could actually spare some time. Here I repost a lot of the code from the previous exercise. Changes include the addition of public make polynomial methods, and new procedures and tags to the dense and sparse polynomial packages. Finally a general install-polynomial package is implemented

(define (make-dense-polynomial var terms)
  ((get 'make-dense 'polynomial) var terms))

(define (make-sparse-polynomial var terms)
  ((get 'make-sparse 'polynomial) var terms))

(define (install-sparse-polynomial-package)
  (define (add-poly p1 p2)
    (display (list (variable p1) (variable p2)))
    (newline)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same var -- ADD-POLY"
               (list p1 p2))))
  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
      (error "Polys not in same var -- MUL-POLY"
             (list p1 p2))))

  ;; internal procedures
  ;; representation of poly
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (variable? x) (symbol? x))
  (define (term-list p) (cdr p))
  (define (same-variable? v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2)))

  (define (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
      (cons term term-list)))
  (define (the-empty-termlist) '())
  (define (first-term term-list) (car term-list))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
  (define (make-term order coeff) (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))

  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
          ((empty-termlist? L2) L1)
          (else
           (let ((t1 (first-term L1)) (t2 (first-term L2)))
             (cond ((> (order t1) (order t2))
                    (adjoin-term
                     t1 (add-terms (rest-terms L1) L2)))
                   (( (length L1) (length L2)) (adjoin-term (first-term L1) (add-terms (rest-terms L1) L2)))
          ((< (length L1) (length L2)) (adjoin-term (first-term L2) (add-terms L1 (rest-terms L2))))
          (else
           (let ((t1 (first-term L1)) (t2 (first-term L2)))
             (adjoin-term (+ t1 t2) (add-terms (rest-terms L1) (rest-terms L2)))))))

  (define (mul-terms L1 L2)
    (if (empty-termlist? L1)
        (the-empty-termlist)
      (add-terms (mul-term-by-all-terms (length L1) (car L1) L2)
                 (mul-terms (rest-terms L1) L2))))

  (define (mul-term-by-all-terms t1-order t1-coeff L)
    (cond ((and (= t1-order 1) (empty-termlist? L)) (the-empty-termlist))
          ((empty-termlist? L) (cons 0 (mul-term-by-all-terms (- t1-order 1) t1-coeff L)))
          (else (cons (* t1-coeff (car L)) (mul-term-by-all-terms t1-order t1-coeff (cdr L))))))

  (define (zero-terms? term-list)
    (cond ((empty-termlist? term-list) #t)
          ((not (= 0 (coeff (first-term term-list)))) #f)
          (else (zero-terms? (rest-terms term-list)))))

  (define (negate-terms term-list)
    (if (empty-termlist? term-list)
        (the-empty-termlist)
        (cons (- (first-term term-list))
              (negate-terms (rest-terms term-list)))))
  (define (negate-poly p)
    (make-polynomial (variable p) (negate-terms (term-list p))))
  ;; interface to rest of the system
  (define (tag p) (attach-tag 'dense p))
  (put 'add '(dense dense)
       (lambda (p1 p2) (tag (add-poly p1 p2))))
  (put 'mul '(dense dense)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))
  (put 'make 'dense
       (lambda (var terms) (tag (make-poly var terms))))
  (put '=zero? '(dense) (lambda (p) (zero-terms? (term-list p))))
  (put 'negate '(dense) negate-poly)
  'done)

(define (install-polynomial-package)
  (define (make-dense-proc var terms)
    ((get 'make 'dense) var terms))
  (define (make-sparse-proc var terms)
    ((get 'make 'sparse) var terms))
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul p1 p2))))
  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (sub p1 p2))))
  (put 'negate '(polynomial) negate)
  (put 'make-dense 'polynomial
       (lambda (var terms) (tag (make-dense-proc var terms))))
  (put 'make-sparse 'polynomial
       (lambda (var terms) (tag (make-sparse-proc var terms)))))

The results are what I wanted but I am quite muddled. Going to move on but perhaps I’ll revisit this later.


Busy Busy

So I haven’t posted anything in two weeks because real world commitments are demanding much of my attention. In between research work, schoolwork, and job search, I’ve been finding it very difficult to focus on anything else.


SICP 2.2 exercises cont.

2.29

Part a)

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (car (cdr mobile)))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (car (cdr branch)))

Part b)

(define (total-weight mobile)
  (define (branch-weight branch)
    (let ((b (branch-structure branch)))
     (if (pair? b)
         (total-weight b)
         b)))
  (+ (branch-weight (left-branch mobile))
     (branch-weight (right-branch mobile))))

Part c)

(define (balanced? mobile)
  (define (weight s)
    (if (pair? s) (total-weight s) s))
  (let ((ls (branch-structure (left-branch mobile)))
        (rs (branch-structure (right-branch mobile)))
        (ll (branch-length (left-branch mobile)))
        (rl (branch-length (right-branch mobile))))
    (and (if (pair? ls) (balanced? ls) #t)
         (if (pair? rs) (balanced? rs) #t)
         (= (* ll (weight ls)) (* rl (weight rs))))))

Part d)

Simply change the selectors since the other procedures are built on top of them.

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (cdr mobile))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (cdr branch))

Fun implementation that took about a few hours. Defining helper functions made a world of difference in terms of difficulty.

2.30

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

Pretty much the same as in the example.

2.31

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

Logical next step given what we’ve read so far.

2.32

(define (subsets s)
  (if (null? s)
      (list '())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (item) (cons (car s) item)) rest)))))

Had to stop and think for this one.

2.33

(define (map-2 p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))

(define (append-2 seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length-2 sequence)
  (accumulate (lambda (x y) (+ 1 y)) 0 sequence))

2.34

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
              0
              coefficient-sequence))

2.35

(define (count-leaves-2 t)
  (accumulate (lambda (x y) (+ 1 y)) 0 (map identity (fringe t))))

I made it fit the template given in the exercise, but the map here is very pointless. Apparently other people answered by using + instead of the lambda like so

(define (count-leaves t)
   (accumulate + 0 (map (lambda (x) 1)
                        (enumerate-tree t))))

Which makes more sense and adheres to the template.

2.36

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

Nothing to say here, the answer pretty much screams at you.

2.37

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

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

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

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (rows) (matrix-*-vector cols rows)) m)))

This looks annoying at first glance but turns out to be fine.

2.38

guile> (fold-right / 1 (list 1 2 3))
3/2
guile> (fold-left / 1 (list 1 2 3))
1/6
guile> (fold-right list '() (list 1 2 3))
(1 (2 (3 ())))
guile> (fold-left list '() (list 1 2 3))
(((() 1) 2) 3)

Associativity is the obvious property that is needed for fold right and fold left to act the same as it is all about the order of which the operation is performed.

2.39

(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))
(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) '() sequence))

2.40

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))

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

Just isolating the code in the examples.

2.41

(define (unique-triples n)
  (flatmap (lambda (pair)
             (map (lambda (third)
                    (append pair (list third)))
                  (enumerate-interval 1 (- (car (cdr pair)) 1))))
           (unique-pairs n)))

Maybe there’s a better way, but this is the first one that comes to my mind. A unique-list procedure could probably be extracted out of the above.

I did most of these questions yesterday. Currently I’m working on the eight queens problem, but there are so many ways to do it that I get bogged down in the decision making.


SICP 2.1 exercises cont.

2.5

I uh.. tried to prove the fundamental theorem of arithmetic which turned out to be beyond me. Anyway it’s easily found on wikipedia or somewhere else.

My implementation is kind of silly as I never even made an exponent procedure, and it uses none of the speedups in the last chapter.

(define (cons-2 x y)
  (if (= x 0)
      (if (= y 0)
          1
          (* 3 (cons-2 x (- y 1))))
      (* 2 (cons-2 (- x 1) y))))

(define (car-2 z)
  (if (not (= 0 (remainder z 2)))
      0
      (+ 1 (car-2 (/ z 2)))))

(define (cdr-2 z)
  (if (not (= 0 (remainder z 3)))
      0
      (+ 1 (cdr-2 (/ z 3)))))

2.6

This… was crazy. I again needed some help from the internet. The key is realizing that the function takes in a function and returns a function which takes an input and applies the input function however many number of times depending on what number it’s representing. I may rewrite the previous sentence some time.

So we’re given these two functions and need to create a function that represents one.

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

We’re told to use substitution, so that’s what we do.

(add-1 zero)
(add-1 (lambda (f) (lambda (x) x)))
(lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) x)) f) x))))
(lambda (f) (lambda (x) (f ((lambda (x) x)) x))))
(lambda (f) (lambda (x) (f x)))

Hence the definition of one is

(define one
  (lambda (f) (lambda (x) (f x))))

Similarly for two

(add-1 one)
(add-1 (lambda (f) (lambda (x) (f x))))
(lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) (f x))) f) x))))
(lambda (f) (lambda (x) (f (f x))))
(define two
  (lambda (f) (lambda (x) (f (f x)))))

And as for addition

(define (add-m n m)
  (lambda (f) (lambda (x) ((m f) ((n f) x)))))

The key is that all the procedures that represent numbers transform functions into function that repeat however many number of times. That is, (four f) would become (f (f (f (f x)))). Therefore we replace f from add-1 with (m f).

Comments: The insanity was strong within this question. I did the substitution at least five times before I was clear about what was happening. I used Bill the Lizard’s site which omits some of the steps in between, but without which I would not have finished this for a much longer amount of time.

2.7

(define (upper-bound x)
  (car x))

(define (lower-bound x)
  (cdr x))

2.8

(define (sub-interval x y)
  (make-interval (- (upper-bound x) (lower-bound y))
                 (- (lower-bound x) (upper-bound y))))

Comments: Sped through two more questions. I used the scheme wiki a bit, which explains things very well.


SICP 2.1 exercises

Was busy today with real work, but I managed to squeeze in an hour or so.

2.1

(define (make-rat n d)
  (let ((g (abs (gcd n d))))
    (if (< d 0)
        (cons (/ (* -1 n) g) (/ (* -1 d) g))
        (cons (/ n g) (/ d g)))))


Comments:
I was impatient with this one and got the answer from here. However, just that doesn’t work because the gcd given in the previous chapter cannot deal with negatives, hence the additional absolute value operator.

2.2

(define (make-segment p1 p2)
  (cons p1 p2))

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

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

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

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

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

(define (midpoint-segment line-segment)
  (make-point (/ (+ (x-point (start-segment line-segment))
                    (x-point (end-segment line-segment)))
                 2)
              (/ (+ (y-point (start-segment line-segment))
                    (y-point (end-segment line-segment)))
                 2)))


Comments:
Straightforward implementation again. It would probably have been better to abstract out some things, but I decided to work with messy scheme code to get used to it.

2.3

(define (rectangle-1 top-left bottom-right)
  (cons top-left bottom-right))

(define (top-left-1 rectangle)
  (car rectangle))

(define (bottom-right-1 rectangle)
  (cdr rectangle))

(define (rectangle-2 top-left w h)
  (cons top-left (cons w h)))

(define (top-left-2 rectangle)
  (car rectangle))

(define (bottom-right-2 rectangle)
  (make-point (+ (x-point (car rectangle)) (car (cdr rectangle)))
              (+ (y-point (car rectangle)) (cdr (cdr rectangle)))))

(define (area rectangle)
  (* (abs (- (x-point (top-left rectangle))
             (x-point (bottom-right rectangle))))
     (abs (- (y-point (top-left rectangle))
             (y-point (bottom-right rectangle))))))


Comments:
Not too hard again. In order to test I ran something like (define top-left top-left-1) within the interpreter.

2.4

Just work through the substitution…

(car (cons x y))
(car (lambda (m) (m x y)))
((lambda (m) (m x y)) (lambda (p q) p))
((lambda (x y) x))
x

Clearly the corresponding cdr is just to return q instead of p.

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

Comments: Again pretty easy as expected from introductory exercises.