(defconstant maxbars 12)

(defvar *kb* 
    '((=        
       a 10 20
       *********
       ***
       *
       *
       *
       *
       *)
      (=
       b 2 3
       *
       *
       *
       *****
       )
      )) 

(defun slength (x) 
  (length (format nil "~a" x)))

(defmacro $= (sym min max &rest bars)
  `(myequal ,sym ,min ,max ',bars))

(defmacro o (x) `(print (list ',x ,x)))

(defun bars2hist (bars max)
  (let* ((arity       (length bars))
	 (step (floor (/ max arity)))
	 (out '())
	 (total    0))
    (dolist (bar bars)
      (let ((one (- (slength bar) 1)))
	(dotimes (i step)
	  (setf total (+ one total))
	  (push one out))))
    (values (reverse out)
	    total)))
    
(defstruct dist (min 0) (max 1) total (n  maxbars) bars)

(defun defdist (min max bars)
  (multiple-value-bind (d total)
      (bars2hist bars maxbars)
    (make-dist :min min :max max 
	       :total total :bars d)))

(defun normalize (d) 
  (unless (equalp 1 (dist-total d))
    (let ((total (dist-total d))
	  (old   (dist-bars d)))
      (setf (dist-bars d)  (mapcar 
			    #'(lambda (one) (/ one total)) 
			    old)
	    (dist-total d) 1)))
  d)

(defvar *dist0* 
  (normalize 
   (defdist 0 1 '(**))))

(defun d1 ()
  (defdist 10 20 '(**** * ** **)))

(defun $and (kb all)
  (kombine kb #'+ *dist0* all))
   
(defun kombine (kb combiner old-dist rest) 
  (if (null rest)  
      old-dist
      (kombine1 kb combiner old-dist 
		(cdr (assoc (pop rest) kb))
		rest)))

(defun kombine1 (kb combiner old-dist next-dist rest)
  (let* ((total 0)
	 (bars0 (dist-bars next-dist))
	 (bars1 (dist-bars old-dist))
	 (bars  (mapcar #'(lambda(bar0 bar1)
			    (let ((tmp				  
				   (funcall combiner bar0 bar1)))
			      (setf total (+ tmp total))
			      tmp))
			bars0 bars1)))
    ;(o bars)
    (kombine kb combiner
	     (make-dist :total total :bars bars) 
	     rest)))

(defun d2 ()
  (let ((kb `((a . ,(defdist  10 20 '(***** ** * * *    )))
	      (b . ,(defdist  10 20 '(**    *  * * *****))))))
    (distogram (cdr (assoc 'a kb))) (terpri)
    (distogram (cdr (assoc 'b kb))) (terpri)
    
    (distogram ($and kb '(a b)))))

(defun distogram (d &key (fmt " ~5,2f | ") (shrink 2)
					(on "*")  (pad 4) (str t))
  (let 
	((total       (dist-total d))
	 (bars        (dist-bars  d))
	 (min         (or (dist-min   d) 0))
	 (max         (or (dist-max   d) 1))
	 (n           (dist-n     d))
	 (format-str1 (format nil "~a~ad~a : " "~" pad "%"))
	 (bin         0))
	(dolist (bar bars d)
	  (let* ((value (floor (* 100 (/ bar total))))
			 (stars (floor (/ value shrink))))
		(format str fmt 
				(* 1.0 
				   (+ min (* bin (/ (- max min) n)))))
		(format str format-str1 stars)
		(chars stars on)
		(terpri str)
		)
	  (incf bin))))

(defun chars (n &optional (c "*") (str t))
  (if (> n 0)
      (dotimes (i n) (princ c str))))


(defun d3 ()
  (distogram (defdist 10 20 '(***** **** *** **)) :shrink 0.5))

(defun d4 ()
  (distogram (d2)))