在Scheme中构建哈夫曼树

3
我已经遭受这个问题几天了。你如何使用以下网站指定的数据构建树形结构:

http://www.impulseadventure.com/photo/jpeg-huffman-coding.html,在主题下:

JPEG文件中的实际DHT

我会在这里简要地重新解释一下:

你有:

  1. 一个长度表(字节向量)
  2. 一个数据表(也是字节向量)

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

现在我想在Scheme/Racket中创建这样的树,以便我可以遍历树并为每个编码值构建一个表。

我脑海中的树形结构应该是这样的:

'((x01 x02)((x03 (x11 x04))(((x00 ...)(...)))))
3个回答

2
那很有趣!
好的,我真的希望这不是作业。
事实证明,有一个非常简单的递归解决方案。在每个级别上,您想要获取树的列表,将它们成对聚合成更深的树,然后附加此级别的新叶子。这可以使用'foldr'编写,但我认为可能不太清晰。
我应该澄清一下输入;在您提到的页面上,规格说明看起来像
0级叶子:
1级叶子:
2级叶子:x23、x42、x23
3级叶子:x24、x23

这将对应于以下输入:
'(() () (x23 x42 x23) (x24 x23))
下面是程序。
此外,这里唯一发生的事情就是将此表映射到二叉树,这只有在解码时才有帮助。对于编码,此二叉树将无用。
最后,向如何设计程序致以热烈的欢呼声;我认真遵循了设计配方,仔细检查并测试了所有情况。请先进行测试用例!

干杯!

约翰·克莱门茨

#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))))

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


)

0

首先计算每个符号的出现次数,然后对结果列表进行排序,接着将排序后列表中的前两个条目制作成一个节点,并将它们从列表中删除。重复此过程直到列表为空。构建树非常简单:如果您拥有所有符号和频率,可以将2个符号分组为一个节点,并将左值设置为左频率的数量,右值设置为左+右频率的数量。这也被称为嵌套集或Celko-Tree。


你能再详细解释一下吗?我想你是指根据某种出现频率构建哈夫曼树。我认为这应该以不同的方式完成,因为只有一定数量的比特串表示了特定长度的数量。 - Jeremy Knees
完成了,我不是一个Scheme程序员,而且哈夫曼树也不是很容易。 - Micromega

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接