;; 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*)))