Построить дерево Хаффмана в схеме

Question

Я страдаю от этой проблемы уже несколько дней. Как вы можете построить дерево с данными, указанными на следующем сайте:

http://www.impulseadventure.com/photo/jpeg-huffman-coding.html, по теме:

Фактическая DHT в файле JPEG

Я скоро объясню это так,

У вас есть:

1. таблица с длинами (в байтах)
2. таблица с данными (также bytesvector)

Теперь я хочу построить двоичное дерево с этими двумя аргументами. Заполняется каждый раз слева направо данными для соответствующей длины. Чем глубже вы входите в дерево, тем длиннее ваши длины. Длины варьируются от 1 до 16. Посмотрите на сайт, и он должен стать ясным.

Теперь я хочу создать такое дерево в Scheme / Racket, чтобы я мог дойти до дерева и построить таблицу для каждого закодированного значения.

Дерево, которое я имею в виду, будет выглядеть так:

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

Answer 1

Это было весело!

Хорошо, я действительно надеюсь, что это не домашняя работа.

Оказывается, есть очень простое рекурсивное решение.На каждом уровне вам нужно взять список деревьев, собрать их по парам в более глубокие деревья, а затем добавить новые листья на этом уровне.Это может быть написано с использованием '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))))

Answer 2

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

Деревья кодирования Хаффмана используются в качестве примера в Структура и интерпретация компьютерных программ и прекрасно объясняются.

Answer 4

Сначала посчитайте каждый символ, затем отсортируйте результирующий список, затем сделайте узел из первых двух записей в отсортированном списке и удалите их из списка.Продолжайте, пока ваш список не станет пустым.Построить дерево довольно просто: если у вас есть все символы и частота, вы можете сгруппировать 2 символа в узел и сделать левое значение номером левой частоты, а правое число номером левой + правой частоты.Это также называется вложенным множеством или Celko-Tree.