我正在尝试编写一个遍历霍夫曼树的函数(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：违反合同
预期：对吗？
给出的：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 '()))
我认为可能有一种解决方案，而不必像原始代码中那样使用leaf?和eq?来创建'leaf函数，或者尝试实现类似encode函数{ {3}}，但我目前正在阻止作家。
答案 0 :(得分：0)
不需要叶子。
#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