diff options
Diffstat (limited to 'huffman-coding/huffman-test.scm')
| -rw-r--r-- | huffman-coding/huffman-test.scm | 179 |
1 files changed, 179 insertions, 0 deletions
diff --git a/huffman-coding/huffman-test.scm b/huffman-coding/huffman-test.scm new file mode 100644 index 0000000..b30c4ca --- /dev/null +++ b/huffman-coding/huffman-test.scm @@ -0,0 +1,179 @@ +;; -*- compile-command: "guile -L . huffman-test.scm"; -*- +(use-modules (srfi srfi-64) + (pq) + (huffman)) + +(define runner "a fast runner need never be afraid of the dark") +(define runner-opt-key '((#\v . "111001") (#\u . "111000") (#\t . "0100") (#\s . "111011") (#\r . "100") (#\o . "111010") (#\n . "1111") (#\k . "101101") (#\i . "101100") (#\h . "101111") (#\f . "1010") (#\e . "110") (#\d . "0101") (#\b . "101110") (#\a . "011") (#\space . "00"))) +(define abcde "A_DEAD_DAD_CEDED_A_BAD_BABE_A_BEADED_ABACA_BED") +(define abcde-opt-key '((#\_ . "01") (#\E . "110") (#\D . "00") (#\C . "1110") (#\B . "1111") (#\A . "10"))) +(define abcde-encoded "1001001101000010010000111101100011000011001111110000111111011111100110011111110100011000011011111011101001111111000") +(define (hash-table->alist ht) + (hash-map->list cons ht)) + +(define (node-pq->char-alist pq) + (map (lambda (ele) + (cons (node-char (car ele)) + (cdr ele))) + (car pq))) + +(define (extract-tree pq) + (car (pq-front pq))) + + +(test-begin "harness") + +(test-equal "hash-frequency zero chars, empty hash" + '() + (sort-rao (hash-table->alist (hash-frequency "")))) + +(test-equal "hash-frequency single 'c' key pair correct" + '((#\c . 1)) + (sort-rao (hash-table->alist (hash-frequency "c")))) + +(test-equal "hash-frequency double 'c' key pair correct" + '((#\c . 2)) + (sort-rao (hash-table->alist (hash-frequency "cc")))) + +(test-equal "hash-frequency couple letters key pair correct" + '((#\c . 2) (#\Y . 1)) + (sort-rao (hash-table->alist (hash-frequency "cYc")))) + +(test-equal "hash-frequency couple letters key pair correct" + '((#\c . 2) (#\Y . 1)) + (sort-rao (hash-table->alist (hash-frequency "cYc")))) + +(test-equal "hash-frequency abcde" + '((#\_ . 10) (#\E . 7) (#\D . 10) (#\C . 2) (#\B . 6) (#\A . 11)) + (sort-rao (hash-table->alist (hash-frequency abcde)))) + +(test-assert "frequencies->pq accepts hashtable and returns a pq" + (pq? (frequencies->pq (make-hash-table)))) + +(test-equal "frequencies->pq single entry" + '((#\a . -3)) + (node-pq->char-alist (frequencies->pq (hash-frequency "aaa")))) + +(test-equal "frequencies->pq double entry" + '((#\a . -3) (#\b . -3)) + (node-pq->char-alist (frequencies->pq (hash-frequency "aaabbb")))) + +(test-equal "frequencies->pq tie natural order" + '((#\a . -3) (#\b . -3) (#\c . -4)) + (node-pq->char-alist (frequencies->pq (hash-frequency "cabababccc")))) + +(test-equal "frequencies->pq tie reverse order" + '((#\a . -3) (#\b . -3) (#\c . -4)) + (node-pq->char-alist (frequencies->pq (hash-frequency "cbababaccc")))) + +(test-equal "frequencies->pq abcde" + '((#\C . -2) (#\B . -6) (#\E . -7) (#\D . -10) (#\_ . -10) (#\A . -11)) + (node-pq->char-alist (frequencies->pq (hash-frequency abcde)))) + +(let* ((pq (frequencies->pq (hash-frequency "aab"))) + (pqo (frequencies->pq (hash-frequency "aab"))) + (lc (car (pq-front pq))) + (rc (car (pq-rear pq))) + (p (begin (combine-and-reinsert! pq) + (car (pq-front pq))))) + + (test-assert "pq and pqo now different objects, but both pqs" + (and (not (equal? pq pqo)) + (pq? pq) + (pq? pqo))) + + (test-assert "combine-and-reinsert! left child is correct" + (equal? (node-left p) lc)) + + (test-assert "combine-and-reinsert! right child is correct" + (equal? (node-right p) rc)) + + (test-equal "combine-and-reinsert! correctly sums priority" + -3 + (cdr (pq-front pq)))) + +(let* ((pq (frequencies->pq (hash-frequency "aaabbbcccc")))) + (combine-and-reinsert! pq) + + (test-equal "combine-and-reinsert! first elements combined" + #\c + (node-char (car (pq-front pq)))) + + (test-equal "combine-and-reinsert! new node inserted in correct spot" + -6 + (cdr (pq-rear pq)))) + +(let ((pq (combine-all! (frequencies->pq (hash-frequency runner))))) + + (test-assert "combine-all! returns a pq" + (pq? pq)) + + (test-equal "combine-all! pq is of length one" + 1 + (pq-length pq)) + + (test-assert "combine-all! root item is a node" + (node? (car (pq-front pq)))) + + (test-equal "combine-all! root frequency matches length of str" + -46 + (cdr (pq-front pq)))) + +(test-equal "create-encodings level-1 tree" + '((#\a . "0")) + (sort-rao (create-encodings (extract-tree + (combine-all! + (frequencies->pq + (hash-frequency "a"))))))) + +;;;; note: verified manually: https://en.wikipedia.org/wiki/Huffman_coding +(test-equal "create-encodings abcde" + abcde-opt-key + (sort-rao (create-encodings (extract-tree + (combine-all! + (frequencies->pq + (hash-frequency abcde))))))) + +(test-equal "create-encodings runner" + runner-opt-key + (sort-rao (create-encodings (extract-tree + (combine-all! + (frequencies->pq + (hash-frequency runner))))))) + +(let ((none (encode-text ""))) + + (test-assert "encode-text nothing empty string" + (string-null? (car none))) + + (test-assert "encode-text nothing empty alist" + (null? (cdr none)))) + +(let ((limit (encode-text abcde))) + + (test-equal "encode-text abcde string" + abcde-encoded + (car limit)) + + (test-equal "encode-text abcde alist" + abcde-opt-key + (sort-rao (cdr limit)))) + +(test-equal "decode single char" + "x" + (decode-text "00011" '((#\x . "00011") (#\y . "001")))) + +(test-equal "decode two chars" + "xq" + (decode-text "00011" '((#\x . "000") (#\y . "011") (#\q . "11")))) + +(test-equal "decode abcde" + abcde + (decode-text abcde-encoded abcde-opt-key)) + +(test-error "decode abcde nonsense key" + #t + (decode-text abcde-encoded runner-opt-key)) + + +(test-end "harness") |