在計劃中構建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一個例子和精美說明。