问题
I am trying to write a function, (codeWords t), which traverses a Huffman tree (adds #\0 when it goes left, adds #\1 when it goes right...) and returns these values in pairs of the symbol at a leaf along with its associated encoding as a string over the characters #\0 and #\1. Similar to what this or this is trying to do.
My original code:
(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"))))
I revamped it after a friend's suggestion but my leaf? function is getting an error:
(mcar: contract violation
expected: mpair?
given: 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 '()))
I also came up with this code, which seems like it can work but its not passing my test cases:
(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 '()))
I am thinking there is probably a solution without having to make a leaf? function by using eq? and 'leaf like in my original code or trying to implement something like the encode function here, but I'm currently having writers block.
回答1:
'leaf is not necessary.
#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
来源：https://stackoverflow.com/questions/61144100/encoding-huffman-tree-scheme