1 665c255d 2023-08-04 jrmu (load "common")
 2 665c255d 2023-08-04 jrmu (defun make-leaf (symbol weight)
 3 665c255d 2023-08-04 jrmu   (list 'leaf sym weight))
 4 665c255d 2023-08-04 jrmu (defun leaf? (obj)
 5 665c255d 2023-08-04 jrmu   (eq (car obj) 'leaf))
 6 665c255d 2023-08-04 jrmu (defun symbol-leaf (x)
 7 665c255d 2023-08-04 jrmu   (cadr x))
 8 665c255d 2023-08-04 jrmu (defun weight-leaf (x)
 9 665c255d 2023-08-04 jrmu   (caddr x))
10 665c255d 2023-08-04 jrmu (defun make-code-tree (left right)
11 665c255d 2023-08-04 jrmu   (list left
12 665c255d 2023-08-04 jrmu 	right
13 665c255d 2023-08-04 jrmu 	(append (symbols left) (symbols right))
14 665c255d 2023-08-04 jrmu 	(+ (weight left) (weight right))))
15 665c255d 2023-08-04 jrmu (defun left-branch (tree)
16 665c255d 2023-08-04 jrmu   (car tree))
17 665c255d 2023-08-04 jrmu (defun right-branch (tree)
18 665c255d 2023-08-04 jrmu   (cadr tree))
19 665c255d 2023-08-04 jrmu (defun symbols (tree)
20 665c255d 2023-08-04 jrmu   (if (leaf? tree)
21 665c255d 2023-08-04 jrmu       (list (symbol-leaf tree))
22 665c255d 2023-08-04 jrmu       (caddr tree)))
23 665c255d 2023-08-04 jrmu (defun weight (tree)
24 665c255d 2023-08-04 jrmu   (if (leaf? tree)
25 665c255d 2023-08-04 jrmu       (weight-leaf tree)
26 665c255d 2023-08-04 jrmu       (cadddr tree)))
27 665c255d 2023-08-04 jrmu (defun adjoin-set (x set)
28 665c255d 2023-08-04 jrmu   "Add a new element _x_ into a set of elements, sorted by weight"
29 665c255d 2023-08-04 jrmu   (cond ((null set) (list x))
30 665c255d 2023-08-04 jrmu 	((< (weight x) (weight (car set)))
31 665c255d 2023-08-04 jrmu 	 (cons x set))
32 665c255d 2023-08-04 jrmu 	(t (cons (car set)
33 665c255d 2023-08-04 jrmu 		 (adjoin-set x (cdr set))))))