我现在已经忍受了这个问题几天了。如何使用以下站点上指定的数据构建树：
http://www.impulseadventure.com/photo/jpeg-huffman-coding.html，主题为：
JPEG文件中的实际DHT
我很快就会在这里重新解释一下，
你有：
现在我想用这两个参数构建一个二叉树。每次从左到右填充相应长度的数据。进入树的越深，你的长度越长。长度从1到16不等。看看网站，它应该变得清晰。
现在我想在Scheme / Racket中创建这样一个树，这样我就可以走到树上为每个编码值构建一个表。
我心中的那棵树看起来像是：
'((x01 x02)((x03 (x11 x04))(((x00 ...)(...)))))
答案 0 :(得分：2)
这很有趣！
好的，我真的希望这不是作业。
事实证明，这是一个非常简单的递归解决方案。你想要的每个级别是获取树木列表，成对地将它们聚集到一个更深的树木中，然后将新叶子附加到这个级别。这可以使用'foldr'编写，但我认为它不太清楚。
我应该澄清一下输入;在你提到的页面上，规格看起来像
离开0级：
离开1级：
离开2级：x23，x42，x23
离开3级：x24，x23
这将对应于输入
'（（）（）（x23 x42 x23）（x24 x23））
到下面的程序。
此外，这里唯一要做的就是将此表映射到二叉树，这只有在解码时才有帮助。对于编码，这个二叉树将是无用的。
最后，向How To Design Programs大声喊叫;我仔细地按照设计方案，点了我所有的东西，穿过我所有的东西。首先是测试用例！
干杯！
John Clements
#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))))
答案 1 :(得分：0)
首先计算每个符号，然后对结果列表进行排序，然后从列出的排序中的前2个条目中创建一个节点，并将其从列表中删除。继续，直到您的列表为空。构建树非常简单：如果您拥有所有符号和频率，则可以将2个符号分组到一个节点，并使左侧值为左侧频率，右侧数字为左侧+右侧频率。这也称为嵌套集或Celko树。
答案 2 :(得分：0)
霍夫曼编码树在Structure and Interpretation of Computer Programs中用作一个例子，并且有很好的解释。
答案 3 :(得分：0)
#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))
)