(defun leaves (fn tbl)
  (when tbl
    (cond ((leafp tbl) (funcall fn tbl))
	  (t           (leaves fn (table-left  tbl))
		       (leaves fn (table-right tbl))))))

(defun leafp (tbl)
  (and (not (table-left tbl))
       (not (table-right tbl))))

(defun anyleaf (tbl &optional (last tbl))
  (if (null tbl)
      last
      (if (zerop (randi 2))
	  (anyleaf (table-left tbl) tbl)
	  (anyleaf (table-right tbl) tbl))))

(defun !anyleaf ()
  (anyleaf (data2tree 'weather 2)))

(defun anylabel (tbl)
  (let* ((leaf (anyleaf tbl))
	 (row (anyv (table-rows leaf))))
     (values (sym-klass1 row tbl)
	     leaf)))

(defun !anylabel ()
  (let (all (tbl (!idea0 'weather 2)))
    (dotimes (i 1000 (sort-syms all))
      (push (anylabel tbl) all))))

(defun label-up (label tbl &optional gray-below?)
  (if tbl
      (with-slots (color gray? up rows) tbl
	(cond (gray-below? (setf color nil gray? t))
	      (gray?       (setf color nil gray? t))
	      (color       (if (equal color label)
			       (setf color color gray? nil)
			       (setf color nil   gray? t)))
	      ((not color) (setf color label gray? nil)))
	(label-up color up gray?))))

(defun !label-up (&optional (f 'weather) (n 100))
  (reset-seed)
  (let ((tbl (data2tree f 2)))
    (dotimes (i n)
      (format t "~%---| round #~a |--------------~%" (1+ i))
      (!label-up1 tbl)
      (printt tbl))))
    
(defun !label-up1 (tbl)
  (multiple-value-bind (label leaf)
      (anylabel tbl)
    (label-up label leaf))
  tbl)