Решение упражнения 2.68 из SICP

15 February, 2008 (21:24) | Решения упражнений

Я предлагаю реализацию encode-symbol, приведенную ниже. Она заключается в том, что для символа мы начиная от корня просматриваем вершины дерева кодирования и ищем символ в левом и правом поддеревьях каждой вершины. Если символ найден в левом поддереве, мы дописываем в его код 0, если в правом – 1. Остальная часть кода возвращается вызовом той же процедуры encode-symbol для поддерева, в котором найден символ.

Если, спускаясь по поддеревьям, мы достигли листового элемента, значит генерация кода для символа окончена.

Если символ не найден в обоих поддеревьях, это ошибочная ситуация, о чем мы и сообщаем.

Определение процедуры ниже:

(define (encode-symbol symbol tree) 
  (if (leaf? tree) 
      null 
      (cond ((element-of-set? symbol (symbols (left-branch tree))) 
             (cons 0 (encode-symbol symbol (left-branch tree)))) 
            ((element-of-set? symbol (symbols (right-branch tree))) 
             (cons 1 (encode-symbol symbol (right-branch tree)))) 
            (else (error "символ не найден в дереве -- ENCODE-SYMBOL" symbol)))))
(define (element-of-set? x set) 
  (cond ((null? set) false) 
        ((equal? x (car set)) true) 
        (else (element-of-set? x (cdr set)))))

Процедура element-of-set? – это процедура проверки принадлежности элемента множеству, представленному неупорядоченным списком, данная в разделе 2.3.3.

Проверка также отрабатывает:

> (encode '(A D A B B C A) sample-tree) 
(0 1 1 0 0 1 0 1 0 1 1 1 0)

Comments

Comment from anton0xf
Date: September 1, 2009, 7:40 pm

немного проще, имхо:

(define (encode-symbol symbol tree)
(define (choose-bit symbol tree)
(if (member symbol (symbols (left-branch tree))) 0 1))
(cond ((not (member symbol (symbols tree)))
(error "incorrect symbol"))
((leaf? tree) '())
(else (let ((bit (choose-bit symbol tree)))
(cons bit (encode-symbol symbol (choose-branch bit tree)))))))

вместо member можно memq, встречавшуюся раньше

Comment from Denis Larionov
Date: January 8, 2017, 4:48 pm

(define (contains? x arr)
  (pair?
   (filter
    (lambda(i) (eq? i x))
    arr)))

(define (encode-symbol x tree)
  (if (leaf? tree)
      '()
      (let ((l (left-branch tree))
            (r (right-branch tree)))
        (let ((ls (symbols l))
              (rs (symbols r)))         
            (cond ((contains? x ls) (cons 0 (encode-symbol x l)))
                  ((contains? x rs) (cons 1 (encode-symbol x r)))
                  (else (error "bad x" x)))))))

Write a comment