(defun idea (tbl &optional (enough 2) (cell-func #'row-cells))
  (with-slots (rows left right break c east west) tbl 
    (when (>= (length rows) enough)
      (let* (all half above below
		 (any  (anyv rows))               ; 1) pick anything
		 (west1 (furthest tbl any rows cell-func))) ; 2) find furthest from (1)
	(multiple-value-bind (east1 c1)
	    (furthest tbl west1 rows cell-func)         ; 3) find furthest from (2)
	  (setf c    c1                     ; 4) update tbl with results from 1,2,3
		west west1
		east east1)	  
	  ; 5) sort the rows along a line running west to east
	  (setf all   (rows-sorted-west-to-east tbl rows west east c cell-func))
	  ; 6) split the rows
	  (setf  half  (floor (/ (length all) 2))
		 below (sub-table tbl (vector! (subseq all 0 half)))
		 above (sub-table tbl (vector! (subseq all half))))	   
	  ; 7) fund the break
	  (setf break (location-of-break tbl below west east c cell-func))
	  ; 8) update the pointers in the tree
	  (setf left  below
		right above
		(table-up left) tbl
		(table-up right) tbl)
	  ; 9) recurse
	  (idea left  enough)
	  (idea right enough)))))
  tbl)

(defun cell-to-list (iteminput)
  (coerce (row-cells iteminput) 'list))

(defun idea-k2 (tbl &optional (enough 2) (cell-func #'row-cells))
  (with-slots (rows north-east north-west south-east south-west xbreak ybreak c east west) tbl
      (when (>= (length rows) enough)
	(let* (xall yall half above below left right ne nw se sw
		    ;begin fastmap
		   (any (anyv rows))  ; pick any row.
		   (west1 (furthest tbl any rows cell-func))) ; find the furthest point from the random row. (west)
	  (multiple-value-bind (east1 c1) 
	      (furthest tbl west1 rows cell-func)  ;find the furthest point from west (east.)
	    ;end fastmap
	    (setf c c1
		  west west1
		  east east1)
	    ; Sort rows running west-to-east and north-to-south
	    (setf xall (rows-sorted-west-to-east tbl rows west east c cell-func)
		  yall (rows-sorted-north-to-south tbl rows west east c cell-func))
	    ; Divide the two regions in half.
	    (setf half (floor (/ (length xall) 2))
		  below (map 'list (lambda (item) (coerce (row-cells item) 'list)) (subseq xall 0 half))
		  above (map 'list (lambda (item) (coerce (row-cells item) 'list)) (subseq xall half))
		  left (map 'list (lambda (item) (coerce (row-cells item) 'list)) (subseq yall 0 half))
		  right (map 'list (lambda (item) (coerce (row-cells item) 'list)) (subseq yall half)))
	    ; Go through the table and split the table into four quadrants.
	    (dov (one rows)
	      (if (member (cell-to-list one) above :test #'equal)
		  (if (member (cell-to-list one) left :test #'equal)
		      (push one nw)
		      (push one ne))
		  (if (member (cell-to-list  one) left :test #'equal)
		      (push one sw)
		      (push one se))))
	    ; Properly create the tree structures and update their reference to the parent.
	    (setf north-west (sub-table tbl (vector! nw))
		  north-east (sub-table tbl (vector! ne))
		  south-west (sub-table tbl (vector! sw))
		  south-east (sub-table tbl (vector! se))
		  (table-up north-west) tbl
		  (table-up north-east) tbl
		  (table-up south-west) tbl
		  (table-up south-east) tbl)
	    ; Set the locations of the x and the y breaks in the current level of the tree.
	    (setf xbreak (location-of-break tbl (sub-table tbl (vector! (subseq xall 0 half))) west east c cell-func)
		  ybreak (location-of-y-break tbl (sub-table tbl (vector! (subseq yall 0 half))) west east c cell-func))
	    ; recurse
	    (idea-k2 north-west enough)
	    (idea-k2 north-east enough)
	    (idea-k2 south-west enough)
	    (idea-k2 south-east enough)))))
  tbl)

; Create a sub-table from a vector containing rows.
(defun sub-table (tbl new-rows)
  (let ((out (copy-table tbl)))
    (with-slots (color gray? left right up break c east west rows) out
	(setf left nil right nil up nil color nil gray? nil
	      break nil c nil east nil west nil)
	(setf rows new-rows))
    out))

; Find the location of the x-axis break. Named to keep compatibility with the single-break IDEA.
(defun location-of-break (tbl below west east c &optional (cell-func #'row-cells))
  (let ((last-row-below (svref (table-rows below)
			       (1- (length (table-rows below))))))
    (x (dist tbl last-row-below west cell-func)
       (dist tbl last-row-below east cell-func)
       c)))

; Find the location of the y-axis break point.
(defun location-of-y-break (tbl below west east c &optional (cell-func #'row-cells))
  (let* ((last-row-below (svref (table-rows below)
			       (1- (length (table-rows below)))))
	(a (dist tbl last-row-below west cell-func))
	(b (dist tbl last-row-below east cell-func)))
    (y a (x a b c))))

; Needed for the x break point.
(defun rows-sorted-west-to-east (tbl rows west east c &optional (cell-func #'row-cells) &aux all)
  (dov (one rows)
    (let ((place  (x (dist tbl one west cell-func)
		     (dist tbl one east cell-func)
		     c)))
      (push (cons place one) all)))
  (mapcar #'cdr (sort all #'< :key #'car)))

(defun x (a b c)
  "Find x of (x,y) that is distance 'a' from (0,0) and 'b' fron (c,0)"
  (cond ((zerop c)  0)
	((>=   b c) 0) ; not really true, but we only need to divide, so fair enough
	((>=   a c) c) ; ditto
	(t         (/ (+ (* a a) (* c c) (* -1 b b)) 
		      (* 2 c)))))

(defun y (a x)
  "Find x of (x,y) that is distance 'a' from (0,0) and 'b' fron (c,0)"
  (sqrt (+ (* a a) (* -1 x x))))

; Needed for the y break point.
(defun rows-sorted-north-to-south (tbl rows west east c &optional (cell-func #'row-cells) &aux all)
  (dov (one rows)
       (let* ((a (dist tbl one west cell-func))                                         
              (b (dist tbl one east cell-func))                                         
              (place (y a (x a b c))))
         (push (cons place one) all)))
  (mapcar #'cdr (sort all #'< :key #'car)))

(let (n)
  (defun printt (tbl &key (depth 0) (pre "") (str t) (pad "|  ") (max-depth 50))
    (when tbl
      (with-slots (rows gray? left right color c west east break) tbl
	(let* ((m (length rows))
	       (dist-display (if (= 1 m)
				 0
				 (round (* 100 c))))
	       (break-display (if  (<=  m 3)
				   ""
				   (format nil "/ ~a" (round (* 100 break)))))
	       (color-display (if  color
				   (format nil "[~(~a~)]" color)
				   "")))
	  (if (zerop depth) (setf n 0))
	  (format str "~5a~a " (incf n) (if gray? "?" "!"))
	  (dotimes (i depth) (format str "~a" pad))
	  (format str "~a~a at ~a ~a looks ~(~a~) ~a~%"		      
		      pre  m    dist-display break-display 
		      (zeror tbl) color-display)
	  (when  (< depth max-depth) 
	    (printt left  :depth (1+ depth) :pre "< " :str str :pad pad )
	    (printt right :depth (1+ depth) :pre "> " :str str :pad pad ))))))
  )


;;;;;;;;;;;;;;;;;;

(defmethod print-object ((tbl table) str)
  (format str "#T(:c ~a :xbreak ~a :ybreak ~a :rows ~a)" (table-c tbl) (table-xbreak tbl) (table-ybreak tbl) (length (table-rows tbl))))


(defun data2tree (f &optional (enough 30))
  (idea (data (string-downcase (format nil "data/~a.lisp" f))) enough))

(deftest !idea0 (&optional (f 'labor) (enough 2))
  (let (out)
    (time (setf out (data2tree f enough)))
    out))

(deftest !idea1 ()
  (dolist (what '( 2 4 8 16 32 64 128))
    (!idea1-prim  "data/autos32.lisp" what)))

(defun !idea1-prim (f &optional (enough 30))
  (let ((tbl (data f))
	(time (time-it 1 (idea (data f) enough))))
    (print `(,enough ,time))))