1 665c255d 2023-08-04 jrmu (defun make-mobile (left right)
 2 665c255d 2023-08-04 jrmu   (list left right))
 3 665c255d 2023-08-04 jrmu (defun left-branch (mobile)
 4 665c255d 2023-08-04 jrmu   (first mobile))
 5 665c255d 2023-08-04 jrmu (defun right-branch (mobile)
 6 665c255d 2023-08-04 jrmu   (second mobile))
 7 665c255d 2023-08-04 jrmu (defun make-branch (len structure)
 8 665c255d 2023-08-04 jrmu   (list len structure))
 9 665c255d 2023-08-04 jrmu (defun branch-len (branch)
10 665c255d 2023-08-04 jrmu   (first branch))
11 665c255d 2023-08-04 jrmu (defun branch-structure (branch)
12 665c255d 2023-08-04 jrmu   (second branch))
13 665c255d 2023-08-04 jrmu 
14 665c255d 2023-08-04 jrmu (defun structure-is-weight? (structure)
15 665c255d 2023-08-04 jrmu   (atom structure))
16 665c255d 2023-08-04 jrmu (defun weight-of-branch (branch)
17 665c255d 2023-08-04 jrmu   (let ((struct (branch-structure branch)))
18 665c255d 2023-08-04 jrmu     (if (structure-is-weight? struct)
19 665c255d 2023-08-04 jrmu 	struct
20 665c255d 2023-08-04 jrmu 	(weight-of-mobile struct))))
21 665c255d 2023-08-04 jrmu (defun weight-of-mobile (mobile)
22 665c255d 2023-08-04 jrmu   (+ (weight-of-branch (left-branch mobile))
23 665c255d 2023-08-04 jrmu      (weight-of-branch (right-branch mobile))))
24 665c255d 2023-08-04 jrmu (defun torque-of-branch (branch)
25 665c255d 2023-08-04 jrmu   (* (branch-len branch)
26 665c255d 2023-08-04 jrmu      (weight-of-branch branch)))
27 665c255d 2023-08-04 jrmu (defun branch-balanced? (branch)
28 665c255d 2023-08-04 jrmu   "A branch is balanced either when it has a structure
29 665c255d 2023-08-04 jrmu   that's a simple weight, or when the structure is
30 665c255d 2023-08-04 jrmu   a balanced mobile" 
31 665c255d 2023-08-04 jrmu   (let ((struct (branch-structure branch)))
32 665c255d 2023-08-04 jrmu     (or
33 665c255d 2023-08-04 jrmu      (structure-is-weight? struct)
34 665c255d 2023-08-04 jrmu      (mobile-balanced? struct))))
35 665c255d 2023-08-04 jrmu (defun mobile-balanced? (mobile)
36 665c255d 2023-08-04 jrmu   (let ((lb (left-branch mobile))
37 665c255d 2023-08-04 jrmu 	(rb (right-branch mobile)))
38 665c255d 2023-08-04 jrmu     (and
39 665c255d 2023-08-04 jrmu      (= (torque-of-branch lb)
40 665c255d 2023-08-04 jrmu 	(torque-of-branch rb))
41 665c255d 2023-08-04 jrmu      (branch-balanced? lb)
42 665c255d 2023-08-04 jrmu      (branch-balanced? rb))))
43 665c255d 2023-08-04 jrmu