;; -*- 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")