在计划中构建huffman树

Question

我现在已经忍受了这个问题几天了。你怎么能建立一个树的数据访问以下网站作为指定：

http://www.impulseadventure.com/photo/jpeg-huffman-coding.html，该主题下：

在JPEG文件中的实际DHT

稍后我会在这里重释它的话，

您有：

1. ，长度（bytesvector）的表
2. 表与数据（bytesvector以及）

现在我想用这两个参数构建一个二叉树。每次从左到右填充相应长度的数据。你进入树越深，你的长度就越长。长度从1到16不等。看看网站，它应该变得清晰。

现在我想在Scheme/Racket中制作这样一棵树，以便我可以走到树上并为每个编码值构建一张表格。

树我在我的脑海里是这样的：

'((x01 x02)((x03 (x11 x04))(((x00 ...)(...))))) 

Answer 1

#lang r6rs 

(library 
(huffman-table) 
(export make-table find) 
(import (rnrs base (6)) 
     (rnrs io simple) 
     (only (racket base) bytes bytes-length bytes-ref make-hash hash-set! hash-ref do) 
     (rnrs mutable-pairs (6))) 

(define (make-node left right) 
    (list left right)) 
(define (left node) 
    (car node)) 
(define (right node) 
    (cadr node)) 
(define (left! node left) 
    (set-car! node left) 
    left) 
(define (right! node right) 
    (set-car! (cdr node) right) 
    right) 
(define (node? object) 
    (eq? (car object) 'node)) 

(define (make-leaf value) 
    (list 'leaf value)) 
(define (value leaf) 
    (cadr leaf)) 
(define (leaf? object) 
    (eq? (car object) 'leaf)) 

(define (generate-pairs lengths data) 
    (define length (bytes-length lengths)) 
    (let out-loop ((l-idx 0) 
        (d-idx 0) 
        (res '())) 
    (if (= l-idx length) 
     (reverse res) 
     (let in-loop 
      ((t 0) 
      (amt (bytes-ref lengths l-idx)) 
      (temp-res '())) 
      (if (= t amt) 
       (out-loop (+ l-idx 1)(+ d-idx (bytes-ref lengths l-idx))(cons temp-res res)) 
       (in-loop (+ t 1) amt (cons (bytes-ref data (+ d-idx t)) temp-res))))))) 


(define (add-nodes node-lst) 
    (let loop ((added-nodes '()) 
       (node-lst node-lst)) 
    (cond ((null? node-lst) (reverse added-nodes)) 
      (else (let ((node (car node-lst)) 
         (left-child (make-node '() '())) 
         (right-child (make-node '() '()))) 
        (if (null? (left node)) 
         (begin (left! node left-child) 
           (right! node right-child) 
           (loop (cons right-child (cons left-child added-nodes)) 
            (cdr node-lst))) 
         (begin (right! node right-child) 
           (loop (cons right-child added-nodes) 
            (cdr node-lst))))))))) 

(define (label-nodes! node-lst values) 
    (let loop ((node-lst node-lst) 
       (values values)) 
    (cond ((null? values) node-lst) 
      ((null? (cdr values))(if (null? (left (car node-lst))) 
            (left! (car node-lst) (car values)) 
            (right! (car node-lst) (car values))) 
           node-lst) 
      (else (if (null? (left (car node-lst))) 
        (begin (left! (car node-lst) (car values)) 
          (right! (car node-lst) (cadr values)) 
          (loop (cdr node-lst)(cddr values))) 
        (begin (right! (car node-lst)(make-leaf (car values))) 
          (loop (cdr node-lst)(cdr values)))))))) 

(define (make-tree pairs) 
    (define root (make-node '() '())) 
    ;(define curr-nodes (list root)) 
    (let loop ((curr-nodes (list root)) 
       (pairs pairs)) 
    (cond 
     ((null? pairs) root) 
     (else (loop (add-nodes (label-nodes! curr-nodes (car pairs))) 
        (cdr pairs)))))) 

(define (atom? el) 
    (not (pair? el))) 

(define (add bit bitstr) 
    (if bitstr 
     (string-append (number->string bit) bitstr) 
     #f)) 

(define (code symbol tree) 
    (cond ((null? tree) #f) 
     ((atom? tree) (if (= tree symbol) 
          "" 
          #f)) 
     (else (or (add 0 (code symbol (left tree))) 
        (add 1 (code symbol (right tree))))))) 

(define (make-table lengths data) 
    (define pairs (generate-pairs lengths data)) 
    (define tree (make-tree pairs)) 
    (define table (make-hash)) 
    (do ((i 0 (+ i 1))) 
    ((= i (bytes-length data)) table) 
    (let ((val (bytes-ref data i))) 
     (hash-set! table (code val tree) val)))) 

(define (find table bitstring) 
    (hash-ref table bitstring #f)) 


) 

Answer 2

首先计算每一个符号，然后排序结果列表，然后做出一个节点出在排序列出的第一个2项，并删除出来的列表。继续，直到您的列表为空。构建一棵树非常简单：如果具有所有符号和频率，则可以将2个符号分组到一个节点，并将左侧数值设为左侧频率，将右侧数字设为左侧+右侧频率的数量。这也被称为嵌套集或Celko-Tree。

Answer 3

这很有趣！

好吧，我真的很希望那不是功课。原来，有一个非常简单的递归解决方案。你想在每个级别上取得树木清单，成对收集到一个更深的树木，然后在这个级别追加新的树叶。这可以使用'foldr'来书写，但我认为它会有点不太清楚。

我应该澄清一点输入;你提到的页面上，规格看起来像

叶0级：
叶1级：
叶等级2：X23，X42，X23
离开第3级：X24，X23

这将对应于输入

“（（）（）（X23 X42 X23）（X24 X23））

下面的程序。

另外，这里唯一要做的就是将此表映射到二叉树，这仅在解码时才有用。对于编码，这个二叉树将是无用的。

最后，大喊一声给How To Design Programs;我仔细地遵循了设计方案，把我所有的东西都打成一团，然后穿过我所有的东西。请先测试用例！

干杯！

约翰克莱门特

#lang racket 

(require rackunit) 

;; a tree is either 
;; a symbol, or 
;; (list tree tree) 

;; a specification is 
;; (listof (listof symbol)) 

;; spec->tree : specification -> tree 
;; run spec->treelist, ensure that it's a list of length 1, return it. 
(define (spec->tree spec) 
    (match (spec->treelist spec) 
    [(list tree) tree] 
    [other (error 'spec->tree "multiple trees produced")])) 

;; spec->treelist : specification -> (listof tree) 
;; given a *legal* specification, produce 
;; the corresponding tree. ONLY WORKS FOR LEGAL SPECIFICATIONS... 
(define (spec->treelist spec) 
    (cond [(empty? spec) empty] 
     [else (append (first spec) (gather-pairs (spec->treelist (rest spec))))])) 

;; go "up one level" by grouping each pair of trees into one tree. 
;; The length of the list must be a number divisible by two. 
(define (gather-pairs trees) 
    (match trees 
    [(list) empty] 
    [(list-rest a b remaining) (cons (list a b) (gather-pairs remaining))] 
    [other (error 'gather "improperly formed specification")])) 


;; TEST CASES 

(check-equal? (gather-pairs '(a b c d)) '((a b) (c d))) 


(check-equal? (spec->treelist '((top))) '(top)) 
(check-equal? (spec->treelist '(() (two-a two-b))) '((two-a two-b))) 
(check-equal? (spec->treelist '(() (two-a) (three-a three-b))) 
       '((two-a (three-a three-b)))) 
(check-equal? (spec->treelist '(()() (three-a three-b three-c) (four-a four-b))) 
       '(((three-a three-b) (three-c (four-a four-b))))) 

(check-equal? (spec->tree '(()() (three-a three-b three-c) (four-a four-b))) 
       '((three-a three-b) (three-c (four-a four-b)))) 

Answer 4

霍夫曼编码树被用作Structure and Interpretation of Computer Programs一个例子和精美说明。