编码霍夫曼树方案

Question

我正在尝试编写一个函数(codeWords t)，它遍历一棵霍夫曼树（向左添加#\0，向右添加#\1...）并成对返回这些值叶上的符号及其关联的编码为字符#\0 和#\1 上的字符串。类似于 this 或 this 正在尝试做的事情。

我的原始代码：

(define (last l)
 (car (reverse l)))
(define (codeWords t)
  (define (helper t l)
    (cond ((null? t) l)
      ((eq? (car t) 'internal) (append (helper (caddr t) l)
                                       (helper (last t) l)))
      ((eq? (car t) 'leaf) (helper '() (cons (cons (caddr t) (cadr t)) l)))))
(helper t '()))

(codeWords (huffman (get-freq (get-count "hello"))))

在朋友的建议下我对其进行了修改，但我的 leaf? 函数出现错误：

（mcar：违反合同
预期：mpair？
给定：1）：

(define (leaf? T) (eq? (car T) 'leaf))
(define (subtree T c)
  (cond ((eq? c #\0) (cadr T))
    ((eq? c #\1) (caddr T))))
(define (codeWords t)
 (define (helper x y)
   (if (leaf? x)
    (list (cons (value x) (reverse y)))
    (append (helper (subtree x #\0)
                    (cons #\0 y))
            (helper (subtree x #\1)
                    (cons #\1 y)))))
  (helper t '()))

我也想出了这段代码，看起来它可以工作，但它没有通过我的测试用例：

(define (codeWords t)
 (define (encode char tree)
   (cond
     ((null? tree) t)
     ((eq? (caar tree) char) '())
     (else
      (let ((left (encode char (cadr tree))) (right (encode char (caddr tree))))
        (cond
          ((not (or left right)) #f)
          (left (cons #\0 left))
          (right (cons #\1 right)))))))
 (encode t '()))

我认为可能有一个解决方案，而不必像在我的原始代码中那样使用eq? 和'leaf 来创建leaf? 函数，或者尝试实现类似编码函数here 的东西，但我'我目前有作家阻止。

Answer 1

'叶子不是必须的。

#lang racket
;;; no symbol no freq version
(define (build-basic-count-list char-lst count-list)
  (cond
    [(empty? char-lst)
     count-list]
    [else
     (cond
       [(in-list? (first char-lst) count-list)
        (build-basic-count-list
         (rest char-lst)
         (char-count-add1 (first char-lst) count-list))]
       [else
        (build-basic-count-list
         (rest char-lst)
         (cons (cons (first char-lst) 1)
               count-list))])])) 

(define (char-count-add1 char count-list)
  (map (λ (u) (if (eq? char (car u))
                  (cons char (+ 1 (cdr u)))
                  u))
       count-list))

(define (in-list? char count-list)
  (cond
    [(empty? count-list)
     #false]
    [(eq? char (car (first count-list)))
     #true]
    [else
     (in-list? char (rest count-list))]))

(define (get-count text)(build-basic-count-list (string->list text) '()))
(define (htree-leaf letter weight) (list weight letter))
(define (htree-node t0 t1) (list (+ (htree-weight t0) (htree-weight t1)) t0 t1))
(define (htree-weight t) (first t))
(define (char-freq->leaf t) (htree-leaf (car t) (cdr t)))
(define (leaf<? L0 L1) (< (first L0) (first L1)))
(define (sort-leafs< leafs) (sort leafs leaf<?))
(define (text->leafs text) (map char-freq->leaf (get-count text)))

(define (huffman leafs)
  (local ((define sorted-leafs (sort-leafs< leafs)))
    (cond
      [(empty? (rest sorted-leafs))
       (first sorted-leafs)]
      [else
       (local ((define leaf-0 (first sorted-leafs))
               (define leaf-1 (second sorted-leafs))
               (define new-h-tree
                 (htree-node leaf-0 leaf-1)))
         (huffman
          (append (rest (rest sorted-leafs)) (list new-h-tree))))])))

(define codes '())
(define (codeWords t path-record)
  (cond
    [(char? (second t))
     (set! codes
           (cons (cons (second t) (list->string (reverse path-record)))
            codes))]
    [else
     (begin
       (codeWords (second t) (cons #\0 path-record))
       (codeWords (third t) (cons #\1 path-record)))]))

;;; Test
;;; ;;; '((#\a . "11") (#\b . "10") (#\d . "011") (#\e . "010") (#\c . "00"))
(set! codes '())
(codeWords (huffman (text->leafs "aaaaabbbbcccdde")) '())
codes

---

CSE1729 – Introduction to Programming

; https://s3.amazonaws.com/mimirplatform.production/files/84d78626-f3b7-4482-b9e4-8819cff9f5f7/problem-set-08.pdf
; Exercise 1
(define (get-count text)
  (build-basic-count-list (string->list text) '()))
(define (build-basic-count-list char-lst count-list)
  (cond
    [(empty? char-lst)
     count-list]
    [else
     (cond
       [(in-list? (first char-lst) count-list)
        (build-basic-count-list
         (rest char-lst)
         (char-count-add1 (first char-lst) count-list))]
       [else
        (build-basic-count-list
         (rest char-lst)
         (cons (cons (first char-lst) 1)
               count-list))])]))      
(define (char-count-add1 char count-list)
  (map (λ (u) (if (eq? char (car u))
                  (cons char (+ 1 (cdr u)))
                  u))
       count-list))
(define (in-list? char count-list)
  (cond
    [(empty? count-list)
     #false]
    [(eq? char (car (first count-list)))
     #true]
    [else
     (in-list? char (rest count-list))]))
;;; Test
(get-count "this is test")

;;; Exercise 2
(define (get-freq count-char-lst)
  (local ((define total-n (total-char-num count-char-lst)))
    (map (λ (u)
           (cons (car u)
                 (/ (cdr u) total-n)))
         count-char-lst)))

(define (total-char-num count-char-lst)
  (foldr + 0 (map cdr count-char-lst)))

;;; Test
(total-char-num (get-count "this is test"))
(get-freq (get-count "aaaabbbccd"))

;;; Exercise 3
;;; given function can use
(define (htree-leaf letter weight) (list 'leaf weight letter))
(define (htree-node t0 t1) (list 'internal (+ (htree-weight t0)
                                              (htree-weight t1)) t0 t1))
(define (htree-weight t) (cadr t))
(define (char-freq->leaf t)
  (htree-leaf (car t) (cdr t)))
(define (leaf<? L0 L1)
  (< (second L0) (second L1)))
(define (sort-leafs< leafs)
  (sort leafs leaf<?))
(define (text->leafs text)
  (map char-freq->leaf (get-freq (get-count text))))

;;; huffman : list of characters and frequencies -> Huffman encoding tree
(define (huffman leafs)
  (local ((define sorted-leafs (sort-leafs< leafs)))
    (cond
      [(empty? (rest sorted-leafs))
       (first sorted-leafs)]
      [else
       (local ((define leaf-0 (first sorted-leafs))
               (define leaf-1 (second sorted-leafs))
               (define new-h-tree
                 (htree-node leaf-0 leaf-1)))
         (huffman
          (append (rest (rest sorted-leafs)) (list new-h-tree))))])))
; don't cons use append because ...
; don't use (append  (list new-h-tree) (rest (rest sorted-leafs)))) because ...
;;; Test
(huffman (text->leafs "1"))
(huffman (text->leafs "12"))
(huffman (text->leafs "123"))
(huffman (text->leafs "1234"))
(huffman (text->leafs "12345"))

;;; Exercise 4
;;; left tree is 0 right tree is 1
(define codes '())
(define (codeWords t path-record)
  (cond
    [(char? (third t))
     (set! codes (cons (cons (third t) (list->string (reverse path-record)))
                       codes))] ; path have to reverse
    [else
     (begin
       (codeWords (third t) (cons #\0 path-record))
       (codeWords (fourth t) (cons #\1 path-record)))]))

;;; Test

;;; '((#\a . ""))
(set! codes '())
(codeWords (huffman (text->leafs "a")) '())
codes

;;; ((#\a . "0") (#\b . "10") (#\c . "11")) .
(set! codes '())
(codeWords (huffman (text->leafs "aaaccb")) '())
codes

;;; '((#\a . "11") (#\b . "10") (#\d . "011") (#\e . "010") (#\c . "00"))
(set! codes '())
(codeWords (huffman (text->leafs "aaaaabbbbcccdde")) '())
codes