;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of ICCLE2.
;
; ICCLE2 is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; ICCLE2 is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with ICCLE2.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun <~ (n1 n2)
  (if (= n1 n2)
      (< (my-randone) 0.5)
      (< n1 n2)))

(defmethod any ((x list))
  (nth (my-random-int (length x)) x))

(defmethod any ((x hash-table))
  (let ((count (hash-table-count x)))
    (unless (zerop count)
      (let  ((n (1+ (my-random-int count))))
        (dohash (key value x)
          (if (<= (decf n) 0)
              (return-from any value)))))))

(defmethod any ((x range))
  (let ((max (range-min x))
        (min (range-max x)))
    (if (> min max)
        (any max min)    
        (+ min (random (+ 1 (- max min)))))))

(defmethod any ((x gaussian))
  (range-ready! x)
  (normal (gaussian-mean x) (gaussian-stdev x)))

(defmethod any ((x dist))
  (range-ready! x)
  (labels ((val  (y) (funcall (dist-value x) y))
           (key  (y) (funcall (dist-key   x) y)))
    (let* ((r   (my-random (dist-sum x)))
           (n   (dist-sum  x))
           (all (dist-all x))
           (out (val (first all))))
      (dolist (one (rest all) out)
        (decf n (key one))
        (if (<= n r)
            (return-from any out))
        (setf out (val one))))))
          
(defun range+ (x n)
  (setf (range-ready?   x) nil)
  (range++ x n)
  n)

(defmethod range++ ((x range) n)
  (setf (dist-max    x) (max (dist-max x) n)
        (dist-min    x) (min (dist-min x) n)))

(defmethod range++ ((x dist) n)
  (let ((key (funcall (dist-key   x) n))
        (val (funcall (dist-value x) n)))
    (setf (dist-max    x) (max (dist-max x) key)
          (dist-min    x) (min (dist-min x) key))
    (incf (dist-sum x) key)
    (push n (dist-all x))))

(defmethod range++ ((x gaussian) n)
  (incf (gaussian-n     x))
  (incf (gaussian-sum   x) n)
  (incf (gaussian-sumsq x) (* n n)))
  
(defun range-ready! (x)
  (unless (range-ready? x)
    (range-ready!! x)
    (setf (range-ready? x) t)))

(defmethod range-ready!! ((x range)) t)

(defmethod range-ready!! ((x dist))
  (setf (dist-all x) 
        (sort (dist-all x) #'> :key (dist-key x))))

(defmethod range-ready!! ((x gaussian))
  (let* ((n     (gaussian-n x))
         (sum   (gaussian-sum x))
         (sumsq (gaussian-sumsq x)))
    (setf (gaussian-stdev x)  (stdev n sum sumSq)
          (gaussian-mean x)   (mean n sum))))

                    
(deftest test-dists ()
  (reset-seed)
  (let (out
        (d (make-dist))
        (values '(a b c d e f g h i j k l m 
                  n o p q r s t u v w x y z)))
    (doitems (one n values)
      (range+  d (cons n one)))
    (dotimes (i 100)
      (push (any d) out))
    (check 
      (equalp (sort out #'string>)
             '(Z Z Z Z Z Z Z Z Z Y Y Y Y Y Y Y X X X X 
               W W W W W W W W V V V V V V U U U U T T 
               T T T T T T S S S S S S S S S R R R Q Q
               Q Q Q P P P P P P O O O O O N N L K K K 
               K J J J J I H G G G F E E D A A A A A A)))))

(deftest test-gaussians ()
  (reset-seed)
  (let (out
        (g (make-gaussian))
        (values '(2 4.5 5 6 7 8)))
    (dolist (one values)
      (range+  g one))
    (range-ready! g)
    (dotimes (i 20)
     (push (any g) out))
    (check (equal
            (mapcar #'(lambda (x) 
                        (/ (round x 0.01) 100.0))
                    (sort out #'<))
            '(2.3 3.53 3.84 4.13 4.44 4.7  4.7  4.71 
              5.1 5.32 5.67 6.11 6.56 7.05 7.34 7.44
              8.76 9.49 9.8 9.81)))))