;; The basic algorithm is to be able to recognize whether a
;; list of three points forms a valid triangle, then test
;; every possible permutation of the given points list,
;; collecting the ones that form a valid triangle.
;; from the figure in http://www.frank-buss.de/challenge/index.html
;; this is the list of lines forming the figure.
(defparameter *lines* '(( 0 5 8 10)
( 0 3 7 9)
( 0 2 4 6)
( 0 1)
( 1 2 3 5)
( 1 4 7 8)
( 1 6 9 10)))
;; test whether there is an element of a list which
;; makes an expression (or the last of several expressions non-nil.
;; E.g.,
;; (exists x '( 1 2 3 4) (evenp x))
;; ==> ( 2 3 4 )
(defmacro exists ( var some-list &rest sexprs)
`(member-if (lambda ( ,var) ,@sexprs) ,some-list))
;; test whether all the elements of the given list
;; match the given condition.
;; E.g., (forall x '( 1 2 3 4 5) (evenp x)) ==> nil
;; (forall x '( 2 4 6 8 ) (evenp x)) ==> t
(defmacro forall ( var some-list &rest sexprs)
`(null (exists ,var ,some-list (null (progn ,@sexprs)))))
;; test whether three given point (integers) form a triangle
;; according to the connectivity described in the given list
;; of lines.
(defun triangle-p ( pts lines)
(let (( seg1 (list (nth 0 pts) (nth 1 pts)))
( seg2 (list (nth 1 pts) (nth 2 pts)))
( seg3 (list (nth 2 pts) (nth 0 pts))))
(segs-from-distinct-lines-p (list seg1 seg2 seg3) lines)))
;; test whether the given list of segments all come from different
;; lines in the given list of lines.
;; note that t is returned if no segs are given.
(defun segs-from-distinct-lines-p ( segs lines)
(or (null segs)
(exists line lines
(and (seg-from-line-p (car segs) line)
(segs-from-distinct-lines-p (cdr segs)
(remove line lines))))))
;; are all the points in seg also in the list of points, line?
(defun seg-from-line-p ( seg line)
(forall pt seg (member pt line)))
;; iterate over the list of lines, and collect all the points into
;; a unique list.
(defun uniq-points ( lines)
(let ( points )
(dolist ( line lines)
(dolist ( pt line)
(unless (member pt points)
(push pt points))))
points))
;; look at every permutation of 3 points from the given list
;; of lines.
(defun filter-triangles ( lines )
(let (( points (uniq-points lines))
triangles
triangle
pt1 pt2)
(loop for pts1 on points
do
(setf pt1 (car pts1))
(loop for pts2 on (cdr pts1)
do
(setf pt2 (car pts2))
(dolist ( pt3 (cdr pts2))
(setf triangle (list pt1 pt2 pt3 ))
(when (triangle-p triangle lines)
(push triangle triangles)))))
triangles))
(format t "how many triangles? ~A~%" (length (filter-triangles *lines*)))