#lang racket

(define (length items)

  (if (null? items)

      (+  (length (cdr items)))))

(define (element-of-set? x set)

  (cond ((null? set) false)

        ((equal? x (car set)) true)

        (else (element-of-set? x (cdr set)))))

(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- 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- (cdr bits) tree))

              (decode- (cdr bits) next-branch)))))

  (decode- bits tree))

(define (choose-branch bit branch)

  (cond ((= bit ) (left-branch branch))

        ((= bit ) (right-branch branch))

        (else (error "bad bit -- CHOOSE-BRANCH" bit))))

(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 (make-leaf-set pairs)

  (if (null? pairs)

      '()

      (let ((pair (car pairs)))

        (adjoin-set (make-leaf (car pair)

                               (cadr pair))

                    (make-leaf-set (cdr pairs))))))

(define (encode message tree)

  (if (null? message)

      '()

      (append (encode-symbol (car message) tree)

              (encode (cdr message) tree))))

(define (encode-symbol symbol tree)

  (if (element-of-set? symbol (symbols tree))

      (if (leaf? tree)

          '()

          (let ((left-tree (left-branch tree))

                (right-tree (right-branch tree)))

            (if (or (null? left-tree) (not (element-of-set? symbol (symbols left-tree))))

                (cons  (encode-symbol symbol right-tree))

                (cons  (encode-symbol symbol left-tree)))))

      (error "symbol does not exist -- ENCODE-SYMBOL" symbol)))

(define (generate-huffman-tree pairs)

  (successive-merge (make-leaf-set pairs)))

(define (successive-merge set)

  (cond ((null? set) '())

        ((=  (length set)) (car set))

        (else (successive-merge

               (adjoin-set (make-code-tree (car set) (cadr set))

                           (cddr set))))))

(define sample-tree

  (make-code-tree (make-leaf 'A 4)

                  (make-code-tree

                   (make-leaf 'B 2)

                   (make-code-tree (make-leaf 'D 1)

                                   (make-leaf 'C 1)))))

(encode '(A D A B B C A) sample-tree)

(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(decode sample-message sample-tree)

(define hip-tree

  (generate-huffman-tree '((a 2) (boom 1) (Get 2) (job 2) (na 16) (Sha 3) (yip 9) (Wah 1))))

(display hip-tree)

(define hip-message

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

(length (encode hip-message hip-tree))