(defmacro dovs ((one two v1 v2 &optional out) &body body)
  (let ((i  (gensym)) (l3 (gensym)) 
	(v3 (gensym)) (v4 (gensym)))
    `(let* ((,v3 ,v1)
	    (,v4 ,v2)
	    (,l3 (length ,v3)))
       (do-nums (,i ,l3 ,out)
	 (let ((,one (svref ,v3 ,i)) 
	       (,two (svref ,v4 ,i)))
	   ,@body)))))

(defmacro dov ((one  v &optional out) &body body)
  (let ((i (gensym)))
    `(dotimes (,i (length ,v) ,out)
       (let ((,one (svref ,v ,i)))
	 ,@body))))
  
(defun dist (v1 v2) 
  "must avoid class vars"
  (let ((sum 0) (n 0) inc)
    (dovs (i j v1 v2) 
      (unless (or (eq i #\?) (eq j #\?))
	(setf inc (if (and (numberp i) (numberp j))
		      (- i j)
		      (if (eq i j) 0 1)))
	(incf sum (* inc inc))
	(incf n)))
    (/ (sqrt sum) (sqrt n))))

(defmacro dopairs ((one two vector &optional out) &body body)
  (let ((l (gensym))  (i (gensym))
	(j (gensym))  (v (gensym)))
    `(let* ((,v ,vector)
	    (,l (length ,v)))
       (dotimes (,i ,l ,out)
	 (dotimes (,j ,l)
	   (when (> ,j ,i)
	     (let ((,one (svref ,v ,i))
		   (,two (svref ,v ,j)))
	       ,@body)))))))

(defun anyv (v)
  (svref v (random (length v))))

(defun split (tbl &optional (enough 10))
  (with-slots (header rows) tbl 
    (let ((n (length rows)))
      (when (> n enough)
	(let (all
	      (any  (anyv rows))
	      (east (furthest-away any rows)))
	  (multiple-value-bind (west gamma)
	      (furthest-away east rows)
	    (dov (one rows)
	      (push (cons (xy east west one gamma)) one) all)
	    (setf all (sort all #'< :key #'car))
	    (let* ((half (floor (/ n 2)))
		   (below (make-table :parent tbl
				      :header header
				      :rows   (subseq all 0 half)))
		   (above (make-table :parent tbl
				      :header header
				      :rows   (subseq all half))))
	      (setf (table-above tbl) above
		    (table-below tbl) below)
	      (split below enough)
	      (split above enough))))))))
	    
(defun furthest-away (row rows)
  (let ((max -1) out)
    (dov (tmp rows (values out max))
      (let ((d (dist row tmp)))
	(when (> d max)
	  (setf max d
		out tmp))))))
	
(defun xy (east west other &optional (gamma (dist left right)))
  (let ((alpha (dist other west))
	(beta  (dist other east))
	(y     (/ (+ (* gamma gamma)
		     (* alpha alpha)
		     (* -1 beta beta))
		  (* 2 gamma)))
	(x     (sqrt (- (* alpha alpha)
			(* -1 y y)))))
    (values x y)))