I am continuing on what I did yesterday. Today, I would like to look at the Hosoya index of balanced binary trees. For that first, I need to generate all balanced binary trees on \(n\) leaves for all \(n\geq 1\).
Some utility functions first
(defun vertices (G)
(remove-duplicates
(reduce #'union G)))
(defun delete-vertices (G vs)
(if (or (null vs) (null G))
G
(delete-vertices (remove-if (lambda (edge) (member (car vs) edge)) G)
(cdr vs))))
(defun take (n xs &optional carry)
(if (or (zerop n) (null xs))
(nreverse carry)
(take (1- n) (cdr xs) (cons (car xs) carry))))
(defun extend-tree (tree n)
(let* ((V (sort (vertices tree) #'>))
(W (take n V)))
(append tree (mapcan (lambda (x) (list (list x (* 2 x))
(list x (1+ (* 2 x)))))
W))))VERTICES
DELETE-VERTICES
TAKE
EXTEND-TREEHere is a function that returns all balanced binary trees upto a certain depth:
(defun balanced-binary-trees (depth)
(let ((tree '((0 1))))
(loop repeat depth
append
(let ((tmp (copy-list tree))
(n (floor (length (vertices tree)) 2)))
(setf tree (extend-tree tree n))
(loop for i from 0 to (1- n)
collect
(extend-tree tmp i))))))
(format nil "~{~a~%~}" (balanced-binary-trees 4))BALANCED-BINARY-TREES
((0 1))
((0 1) (1 2) (1 3))
((0 1) (1 2) (1 3) (3 6) (3 7))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29) (13 26) (13 27))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29) (13 26) (13 27) (12 24)
(12 25))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29) (13 26) (13 27) (12 24)
(12 25) (11 22) (11 23))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29) (13 26) (13 27) (12 24)
(12 25) (11 22) (11 23) (10 20) (10 21))
((0 1) (1 2) (1 3) (3 6) (3 7) (2 4) (2 5) (7 14) (7 15) (6 12) (6 13) (5 10)
(5 11) (4 8) (4 9) (15 30) (15 31) (14 28) (14 29) (13 26) (13 27) (12 24)
(12 25) (11 22) (11 23) (10 20) (10 21) (9 18) (9 19))And now we map Hosoya index over it
(defun hosoya-index (G)
(labels
((helper (H)
(if (null H)
0
(+ 1
(helper (cdr H))
(helper (delete-vertices H (car H)))))))
(1+ (helper G))))
(mapcar #'hosoya-index (balanced-binary-trees 4))HOSOYA-INDEX
(2 4 10 24 58 132 318 720 1758 4068 9882 22680 55350 127980 310770)