;;;; -*- Lisp -*-
;;;;
;;;; To execute, call (count-triangles (make-graph))
(defstruct link
line
destination)
(defun count-paths (links current-line destination length)
"Count the paths starting from the position that has links LINKS and reaches DESTINATION
that are of length LEGNTH"
(if (zerop length)
(if (eql links destination)
1
0)
(let ((num-paths-accum 0))
(dolist (link links)
(when (not (eql (link-line link) current-line))
(incf num-paths-accum
(count-paths (funcall (link-destination link))
(link-line link)
destination
(1- length)))))
num-paths-accum)))
(defun count-triangles (graph)
"Count the number of triangles formed in the paths available by the graph.
This is the number of paths minus any redundant paths"
(let ((num-triangles-accum 0))
(dolist (point graph)
(incf num-triangles-accum (count-paths point nil point 3)))
;; There are six ways to describe each triangle "A-B-C"
;; A-B-C A-C-B
;; B-A-C B-C-A
;; C-A-B C-B-A
(/ num-triangles-accum 6)))
(defmacro ref (to-ref)
`(lambda () ,to-ref))
(defmacro push-line (points line)
(let (accum)
(push 'progn accum)
(dolist (start-point points)
(dolist (end-point points)
(when (not (eq start-point end-point))
(push `(push (make-link :line ,line
:destination (ref ,end-point))
,start-point)
accum))))
(reverse accum)))
(defun make-graph ()
"Makes a graph as in the progblem"
(let (p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)
(push-line (p0 p5 p8 p10) 'p0-p10)
(push-line (p0 p3 p7 p9) 'p0-p9)
(push-line (p0 p2 p4 p6) 'p0-p6)
(push-line (p0 p1) 'p0-p1)
(push-line (p1 p2 p3 p5) 'p1-p5)
(push-line (p1 p4 p7 p8) 'p1-p8)
(push-line (p1 p6 p9 p10) 'p1-p10)
(list p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)))