;;; response to triangles challenge
;;; http://www.frank-buss.de/challenge/index.html
;;;
;;; author: Brian D. Caruso
;;; date:   20041019
;;; 
;;; Given a graph defined by the structure for the line nodes
;;; find all triangles. I did this by finding all 4 node paths
;;; that returned to the starting point and were not colinear,
;;; that is not found on the same line.  Colineararity is represented
;;; by the colinear-sets list with each list being a set of points
;;; that are on the same line.
;;;
;;; I first generate length 2 paths and length 3 paths avoiding
;;; circularity.  Then I grow these paths to length 4 disregarding
;;; circularity.  I then prune this list using trianglep which
;;; leaves me a list of length 4 circular paths ex (p1 p10 p0 p1).
;;;
;;; I remove the
;;; duplicates from each path in this result giving me length
;;; three paths in the format to be returned ex (p1 p10 p0).
;;; Paths that are colinear are filtered out.  The points of
;;; each path are sorted so that duplicates can be removed
;;; using remove-duplicates and the equal predicate.
;;;
;;; notes:
;;; I used the search examples in Lisp by Winston and Horn for
;;; my inspiration. I don't have much experience with lisp
;;; and had some strange problems.  Notice get-4note-paths
;;; and the variables l2-paths l3-paths and l4-paths, a
;;; better way must exist but I was have some odd problems
;;; from destructively modifying lists.  It took me about
;;; 2.5 hours to write this and add comments.  That time
;;; was interrupted by lunch and the first 1/2 hour was
;;; wasted on attempting to use a general list permutator
;;; function I wrote much earlier.  The result of
;;; (permutate *p-list*) is a bit big to easly work with.
;;;
;;; 128 lines of text, aprox. 60 lines of comments.
;;;
;;; I used clisp 2.33.2, slime/emacs on a debian box

;; return a list of points of all sub-triangles
(defun find-triangles ()
  (remove-duplicates 
   (sort-sublists ;sort list so the look the same to equal
    (remove-if-colinear
      (remove-triangle-ends
	(remove-if-not #'trianglep (get-4node-paths *p-list*)))))
   :test #'equal));test predicate for (remove-duplicates)

;; get permutated paths of length 4, paths may be circular
;; points -- list of points to consider, should be *p-list*
(defun get-4node-paths (points)
  (let ((l2-paths ())(l3-paths ())(l4-paths ()))
    (dolist (item points) ;1st step: make list of two node paths
      (setf l2-paths (append (extend-path-acircular (list item))l2-paths)))
     (dolist (path l2-paths);2nd step: list all 3 node path extensions
      (setf l3-paths (append (extend-path-acircular path) l3-paths)))
     (dolist (path l3-paths);3rd step: return circular paths
      (setf l4-paths (append (extend-path-circular path) l4-paths)))
  l4-paths))

;; remove all THREE node paths that are on the same line
;; list-in -- list of THREE node paths
(defun remove-if-colinear (list-in)
  (remove-if #'colinearp list-in))

;; are all points of path in the same colinear set?
;; path -- a THREE node path to consider, must not be null
(defun colinearp (path)
  (some #'(lambda(set)(and (member (first path) set)
			   (member (second path) set)
			   (member (third path) set))) colinear-sets))
  
;; returns true if a FOUR point path is a triangle path
;; path -- a Four node path, must not be null.
(defun trianglep (path)
  (and (eq (first path)(first(reverse path)));is it circular?
       (= (-(length path)1) (length(remove-duplicates path))))); not too circular?

;; return a list of paths extended one node that is non circular
;; path -- path of any length, may be null
(defun extend-path-acircular (path)
  (mapcar #'(lambda (new-node) (cons new-node path))
	  (remove-if #'(lambda (neighbor) (member neighbor path))
			 (get (first path) 'neighbors))))

;; returns a list of paths that extend to where the path starts
;; path -- path of any length, may be null
(defun extend-path-circular (path)
  (mapcar #'(lambda (new-node) (cons new-node path))
		     (get (first path) 'neighbors)))

;; sort each sublist of list-in, each element of list-in must be a list
(defun sort-sublists (list-in)
  (mapcar #'(lambda(sublist)(sort sublist #'less-than-p)) list-in))

;; remove duplicates from all sublists of list-in
(defun remove-triangle-ends(list-in)
  (mapcar #'(lambda(x) (remove-duplicates x))list-in))

;; test less-that-ness of symbol names eg (less-that-p 'p1 'p10) => T
(defun less-than-p (point-a point-b)
  (< (parse-integer (subseq (symbol-name point-a) 1))
     (parse-integer (subseq (symbol-name point-b) 1))))

(defparameter *p-list* '(P1 P2 P3 P4 P5 P6 P7 P8 P9 P10))

;;structure for the line nodes, from Winston and Horn pg275
(setf (get 'p0  'neighbors) '(p1 p2 p3 p4 p p5 p6 p7 p8 p9 p10)
      (get 'p1  'neighbors) '(p0 p2 p3 p4 p5 p6 p7 p8 p9 p10)
      (get 'p2  'neighbors) '(p1 p4 p6 p3 p5 p0)
      (get 'p3  'neighbors) '(p0 p7 p9 p5 p2 p1)
      (get 'p4  'neighbors) '(p0 p2 p6 p1 p7 p8)
      (get 'p5  'neighbors) '(p0 p8 p10 p3 p2 p1)
      (get 'p6  'neighbors) '(p1 p9 p10 p4 p2 p0 )
      (get 'p7  'neighbors) '(p0 p3 p9 p8 p4 p1)
      (get 'p8  'neighbors) '(p0 p5 p8 p10 p7 p4 p1)
      (get 'p9  'neighbors) '(p0 p3 p7 p1 p6 p1 p10)
      (get 'p10 'neighbors) '(p0 p5 p8 p1 p6 p9))

;sets of points that all line on the same line
(setf colinear-sets '((p0 p5 p8 p10)
		      (p0 p3 p7 p9)
		      (p0 p2 p4 p6)
		      (p1 p2 p3 p5)
		      (p1 p4 p7 p8)
		      (p1 p6 p9 p10)))