私は数日間この問題に苦しんでいます。次のサイトで指定されているデータを使用してツリーを構築するにはどうすればよいですか。
http://www.impulsadventure.com/photo/jpeg-huffman-coding.html、トピックの下:
JPEG ファイル内の実際の DHT
ここでもう一度簡単に説明しますので、
あなたが持っている ：
次に、これら 2 つの引数を使用してバイナリ ツリーを作成します。対応する長さのデータで毎回左から右に埋められます。木に深く入るほど、長さが長くなります。長さは 1 から 16 までさまざまです。サイトを見てください。
今度は、Scheme/Racket でそのようなツリーを作成して、ツリーに移動し、エンコードされた値ごとにテーブルを作成できるようにしたいと考えています。
私が考えているツリーは次のようになります。
'((x01 x02)((x03 (x11 x04))(((x00 ...)(...)))))
それは楽しかった！
わかりました、それが宿題ではなかったことを本当に願っています。
非常に単純な再帰的な解決策があることがわかりました。各レベルで必要なのは、ツリーのリストを取得し、それらをペアで集めてより深いツリーにし、このレベルで新しい葉を追加することです。これは「foldr」を使用して記述できますが、少しわかりにくいと思いました。
入力を少し明確にする必要があります。あなたが言及したページでは、仕様は次のようになります
レベル 0 の
葉 : レベル 1 の
葉 : レベル 2 の葉 : x23、x42、x23
レベル 3 の葉 : x24、x23
これは入力に対応します
'(() () (x23 x42 x23) (x24 x23))
以下のプログラムに。
また、ここで行われているのは、このテーブルをバイナリ ツリーにマッピングすることだけです。これは、デコード時にのみ役立ちます。エンコードの場合、このバイナリ ツリーは役に立ちません。
最後に、 How To Design Programsに大声で叫びます。私は慎重にデザインのレシピに従い、すべての i をドットで囲み、すべての t を交差させました。最初にテストケースをお願いします！
乾杯！
ジョン・クレメンツ
#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))))
#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))
)
First count every symbol then sort the resulting list then make a node out of the first 2 entries in the sorted listed and delete them out of the list. Continue until your list is empty. Building a tree is quite simple: If you have all symbols and frequency you can group 2 symbols to a node and make the left value the number of the left frequency and the right number the number of the left + right frequency. This also called a nested set or a Celko-Tree.