Huffman encoding tree. SICP 2.68 - 2.72

 I can't help but notice that the further I get into sicp, the more of the blogs chronicling other peoples progress on it seem to just drop off, which is unfortunate. Honestly, if I was to post detailed solutions to everything, I doubt I would keep at it myself either.

 Anyway, the huffman encoding trees stuff was pretty cool, so I'll post my solutions here.

 First, some general implementation details for the trees(as always looking in the text for the explanations):

 This is all straight out of sicp.

(define (make-leaf symbol weight)
(list 'leaf symbol weight))

(define (make-leaf symbol weight)
  (list 'leaf symbol weight))
        
(define (leaf? object)
  (eq? (car object) 'leaf))

(define (symbol-leaf x) (cadr x))

(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)
  (list left
        right
        (append (symbols left) (symbols right))
        (+ (weight left) (weight right))))

(define (left-branch tree)
  (car tree))

(define (right-branch tree)
  (cadr tree))

(define (symbols tree)
  (if (leaf? tree)
      (list (symbol-leaf tree))
      (caddr tree)))

(define (weight tree)
  (if (leaf? tree)
      (weight-leaf tree)
      (cadddr tree)))

(define (decode bits tree)
  (define (decode-1 bits current-branch)
    (if (null? bits)
        '()
        (let ((next-branch
               (choose-branch (car bits) current-branch)))
          (if (leaf? next-branch)
              (cons (symbol-leaf next-branch)
                    (decode-1 (cdr bits) tree))
              (decode-1 (cdr bits) next-branch)))))          
  (decode-1 bits tree))

(define (choose-branch bit branch)
  (cond ((= bit 0) (left-branch branch))
        ((= bit 1) (right-branch branch))
        (else (error "bad bit -- CHOOSE-BRANCH" bit))))

Also, as a "setup" sicp supplies a couple of functions for working with sets, to which I add one(element-of-set, which checks if a pair corresponding to a symbol is present)

(define (adjoin-set x set)
  (cond ((null? set) (list x))
        ((< (weight x) (weight (car set))) (cons x set))
        (else (cons (car set)
                    (adjoin-set x (cdr set))))))

(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((eq? (symbol x) (symbol (car set))) #t)
        (else (element-of-set? x (cdr set)))))

(define (make-leaf-set pairs)
  (if (null? pairs)
      '()
      (let ((pair (car pairs)))
        (adjoin-set (make-leaf (car pair)
                               (cadr pair))
                    (make-leaf-set (cdr pairs))))))

SICP 2.68 encoding a message:

 Idea here is to encode one symbol at a time from the tree. SICP supplies us with encode:

(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
              (encode (cdr message) tree))))

And here's my implementation of encode-symbol:

(define (encode-symbol sym tree)
  (define (get-encoding branch)
    (cond ((leaf? branch) '())
          ((element-of-set? sym
                            (symbols (left-branch branch)))
           (cons 0 (get-encoding (left-branch branch))))
          ((element-of-set? sym
                            (symbols (right-branch branch)))
           (cons 1 (get-encoding (right-branch branch))))))
  (if (element-of-set? sym (symbols tree))
      (get-encoding tree)
      (error "Symbol not part of encoding set")))

 I start out with a simple check that the symbol is part of the set. From there we check which branch the element is, and work down the tree, consing on the relevant bits until we hit a leaf which returns a null and completes the encoded symbol.

  SICP 2.69 generating a huffman tree:

  Here's the real meat, and a surprisingly simple case once you get to it. First as part of the problem definition we're given generate-huffman-tree and told to implement successive-merge.

(define (generate-huffman-tree pairs)
  (successive-merge (make-leaf-set pairs)))

Here's my take on successive-merge:

(define (successive-merge pairs)
  (if (= (length pairs) 1)
      (car pairs)
      (successive-merge
       (adjoin-set (make-code-tree (cadr pairs)
                                   (car pairs))
                   (cddr pairs)))))

Note that as the pairs are sorted, we need only grab the smallest(first two) pairs, join them together into a new sub-tree, and then place it in the correct position in the list(according to its weight. This is achieved with the modified adjoin-set detailed earlier).

SICP 2.70 a huffman song:

 Not much to this question. Apply the routines to some sample data.

(define song-tree
  (generate-huffman-tree
   '((A 2) (BOOM 1) (GET 2) (JOB 2) (NA 16) (SHA 3) (YIP 9) (WAH 1))))

(length (encode '(get a job
                      sha na na na na na na na na
                      get a job 
                      sha na na na na na na na na
                      wah yip yip yip yip yip yip yip yip yip
                      sha boom) song-tree))
;Value: 84

As we can see it comes out to 84 bits. As a fixed-length code each word would be 3 bits, and with 36 words, we would get a grand total of 108 bits, which of course is longer.

SICP 2.71 and 2.72 some theory

 It should be quite apparent that if we form a tree in a pattern of 1,2,4,8,16... that each sub-tree formed would be merged one at a time with the next item, giving a tree of n-1 levels. The most frequent symbol would be a single access away, while the least would be n-1 levels away(since the final level has 2 leaves, not 1). All remaining items would be on the nth level.

 The interesting thing though is, that as we're dealing with a sorted list, to get the first(most frequent) item, it is right at the end of the list. We thus end up going through every entry of (symbols tree) to find it, but only once, giving a complexity of n. The final entry on the other hand is at the very head of the list, and thus immediately found each time. However it has to go through n levels of the tree, also giving an order of growth n, though we can assume there would be more overhead from cons and whatnot.

In-fix derivation (sicp exercise 2.58 b)

In part 2.3.2 Symbolic Differentiation, we develop a system to calculate simple derivations of calculations in prefix form( such as: + 2 5).

In 2.58 the task is to change this to in-fix form (going with the last example 2 + 5). In addition, it should be able to handle several different operations in a single list(for example 2 * x * x + 5 * x + 3), and correctly prioritize the operations so as to give a correct derivative, without modifying the original deriv procedure.

After going through a lot of dead-end solutions(many of which involved playing around with make-sum and make-product to read ahead and see what else is in the list but were cumbersome and lacking in "elegance") I finally figured out an elegant solution that makes sense.

Here's the initial code that the new data must be matched to:

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

To achieve it, the "detector functions" (in this case sum? and product?) must be changed to figure if there is a corresponding operation anywhere in the top level.

(define (has-operation? x target)
  (cond ((and (pair? x) (pair? (cdr x)) (eq? (cadr x) target)) #t)
        ((and (pair? x) (pair? (cdr x))) (sum? (cddr x)))
        (else #f)))
(define (sum? x)
        (has-operation? x '+))

(define (product? x)
        (has-operation? x '*))

With this
x * 5 + x * 4

Would be detected as a sum (it would also be detected as a product, but it is derivs job to make sure the operations are handled in the right order).

We want it to be correctly handled as
(x * 5) + (x * 4)

To this end, we redefine addend and augend as:

addend => everything before the +
augend => everything after the +

(define (addend s)
  (before-op s '+))
       
(define (augend s)
  (after-op s '+))

(define (before-op s target)
  (define (list-before s target)
    (if (or (null? s) (eq? (car s) target))
        '()
        (cons (car s) (list-before (cdr s) target))))
  (clean (list-before s target)))

(define (after-op s target)
  (define (list-after s target)
    (cond ((null? (cdddr s)) (caddr s))
          ((eq? target (cadr s)) (cddr s))
          (else (list-after (cddr s) target))))
  (clean (list-after s target)))
    
(define (clean target)
  (cond ((not (pair? target)) target)
        ((null? (cdr target)) (car target))
        (else target)))

In the same way we handle mutiplier and multiplicand(reusing the overlapping code of course)

(define (multiplier p) (before-op p '*))

(define (multiplicand p) 
  (after-op p '*))

The make-product and make-sums are barely changed. The order of the outputted list is about all that changes:

(define (make-sum a1 a2)
  (cond ((and (number? a1) (number? a2)) (+ a1 a2))
        ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        (else (list a1 '+ a2))))

(define (make-product m1 m2) 
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list m1 '* m2))))

The other stuff provided by the problem needed for the program to work:

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

(define (=number? exp num)
  (and (number? exp) (= exp num)))

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

As a test of all this, passing some derivations:

; x^2 + 2x + 5
(deriv '(x * x + (x + x + 5)) 'x)
;Value 120: ((x + x) + 2)
; 2x + 2

;x^3 + 5x^2 - 3x + 8
(deriv '(x * x * x + x * x * 5 + x * -3 + 8) 'x)
;Value 121: (((x * (x + x)) + (x * x)) + (((x * 5) + (x * 5)) + -3))
;3x^2 + 10x - 3

As to further improvements... Well there is still a lot of work that could be done on simplifying the outputs.

Overall though I am very happy with this solution and would be comfortable adding more operations to deriv(simply add the most "top-level" ops at the top, and they will then properly calculate their subs before operating on them)

Regarding the difficulty of sicp

Sicp(Structure and interpretation of computer programs) if anything has made me aware of weaknesses and strengths.

Getting around lambda notation has been one challenge. It is gradually coming more naturally, but after programming for years mainly in C++ getting used to functions as first order has put my brain for a twist. Several times.

Similarly, I have been really poor about data hiding for a long time. Nowadays I am certainly better about it, but I still have difficulty considering ideas such as flatmap as a black box. I try to think about what is going on inside it rather than "what does flatmap do?", making a relatively simple problem(the queens problem from my last post) a lot more mentally challenging.

On the other hand, working with the picture language described in part 2.2.4 came very naturally. I can only presume this was from working in computer graphics which I studied as part of my computer games development course at university.

Of course the natural thing to do would be to describe all the transformations in matrices...

That being said, despite being an "introductory" textbook, sicp really challenges a lot of preconceived notions and habits, and opens up new ways of thinking. It is certainly challenging, but it is definitely worth taking the time to read(at least so far).

I can't wait to get to the interpreter implementation. If only I could balance more time into it from all the other reading I'm doing now(Programming Pearls just arrived but it may be a while till I get around to that).

Sicp exercise 2.42

Got bitten by a bug tonight... the bug to work a little bit more on sicp, so I went back to the 8 queens problem that had been giving me some hassle before and solved it. It's a fun problem and it seems like the solution I came up for the safety test was a bit different from the usual, so here we go.

For starters, the problem involves figuring out all the possible ways to set down n queens on an n*n chess board in such a manner that no queen is in check from another.

The solution to it involves breaking down the problem by working out the way to set down n-1 queens and trying to place a new queen in all possible positions in the next row, then filtering any out that are poorly placed. This recurses down to 0 queens placed from where it then builds up the queens.

The main routine is provided as part of the problem leaving the solver to work out how to represent boards, and how to check that a set of positions is good.

The code

;; Heres a solution with a recursive test based on the number of columns away the 
;; queen being tested against is
;; if the distance horizontally is the same as the vertical difference it's not 
;; valid
(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 empty-board '())
 
 
(define (adjoin-position new-row k rest-of-queens)
  (append (list new-row) rest-of-queens))
 
 
(define (safe? k positions)
  (check-safe
   (car positions)
   1
   (cdr positions)))
 
 
;; Check the queens column position against that of all other columns
;; One if vertical distance = horizontal distance it's a diagonal hit
(define (check-safe position distance cols)
  (cond ((null? cols) #t)
 ((= (car cols) position) #f)
 ((= (- (car cols) distance) position) #f)
 ((= (+ (car cols) distance) position) #f)
 (else (check-safe position (+ distance 1) (cdr cols)))))

Auxiliary functions



Here are the auxiliary routines(pretty much as they are in sicp):

(define (flatmap proc seq)
  (accumulate append (list) (map proc seq)))
 
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
   (accumulate op initial (cdr sequence)))))
 
(define (enumerate-interval initial end)
  (if (> initial end)
      '()
      (cons initial (enumerate-interval (+ initial 1) end))))
  
 
(define (filter predicate sequence)
  (cond ((null? sequence) '())
 ((predicate (car sequence))
  (cons (car sequence)
        (filter predicate (cdr sequence))))
 (else (filter predicate (cdr sequence)))))

Everything else should be in GNU/MIT scheme.

Alternate solutions

Some other solutions can be found here, though I found many of them long-winded and no more clear. I posted my own solution there for good measure.

MovableType and Code Complete

Some objectives

  I've set up this little whiteboard in the back of my room with a list of things I need to do in the near future. On it I have a few things written like:

• Find a creative writing class
• Set up movable type blog
• Write resume
• Take some time to play with the scheme debugger.

 Today I decided to tackle the second one of those. I felt I should really move to movable type. I setup a hosting account, got a domain name, and installed movable type, but while it was nice, I came to the realization that ultimately for what I want to do blogger should be more than up to the job. The time I could've spent making my Movable Type pretty could have been better spent on other things like reading or programming.

  Maintaining a blog, and a few static pages. Once I get that resume rewritten, I should have it up here. The advice from Andy Lester's "Find the tech job you love" should come in very useful. I'd heartily recommend it to anyone who wants to keep on top of their game even if they're not currently looking.

Code Complete

  Code Complete(by Steve McConnell) is that book I wish I'd read when I started out programming. Steve McConnell(SMC) considers it the first book on code construction, and I think it's only fair to admit that's the case, and it should probably be required reading for any serious programmer.

  The book as a whole is highly pragmatic. SMC avoids religious wars and accepts the validity of certain practices while warning strongly about their associated dangers and risks. He thoroughly references everything, covering it with statistics from past research. His advice is solid and can be applied immediately.

  Some highlights for me:

• Chapter 9. The Pseudocode Programming Process. This chapter describes a way of writing code by starting out with a general description of what a routine does. From there it is fleshed out into code, and the final result is a well commented routine that makes sense. If you've ever gone back to a piece of code that you wrote a long time ago, trying to figure out what it does, this may well be what you need.
• Chapter 11. The Power of Variable Names. Unfortunately for myself, I don't take much time to think of variable names. I think of the first thing that kind of describes a variable and have no rules for how I lay them out. At least until now. 
• Chapter 25. Code-Tuning Strategies. I'm pretty confident with optimization. Chapter 26 (Code-Tuning Techniques) was pretty much all familiar territory. But this chapter really kicked my ass. Until now, I have tended to optimize from the get go, and believed that makes me a superior programmer. An unfortunate attitude which SMC has succeeded in changing my outlook on. To summarize his approach: keep it simple and readable, find the bottlenecks, then fix them. Simple code is going to be easier to maintain in the first place, and optimizing it will certainly be less effort.
• Chapter 28. Managing Construction. This chapter did a good job of describing how I'd like to see software managers work. 28.6. Managing Your Manager was a good laugh, if unfortunate.
• Chapter 33. Personal Character. An excellent breakdown of qualities it takes to become a great programmer. I went on to read Djikstra's the humble programmer afterwards. In a field as complex as software development, accepting that complexity, and breaking down complex issues into simpler parts our simple brains can handle is an important task, and the ability to admit our own lacking there is important.

  I don't think it can ever be too late to read this excellent book, and I will be sure to review it from time to time in the future.

Joining the ACM

  I joined the ACM not too long ago and it has certainly been worth it so far. Access to a huge backlog of journal articles and back issues of Communications of the ACM is already great, in addition gaining access to a boatload of books and courses is the topping to the cake. The available book collections contain most of the books I have recently bought, which is making me feel just a bit silly. In fact, I left my copy of Code Complete at work after completing it, but in writing this simple opinion piece, I was simply able to refer to the copy I have access to via online.