;;; ranges
#|
Each range function must support the flags "check" and "filter".
Each range function returns a valid item from the range or nil (if the
check flag is set AND the value is invalid)
|#
;;; filters
(defun no-op1 (x) x)

(defun ration-int (min max &key  nudge value (validp nil))
  (ration  min  max :nudge nudge :value value :validp validp :filter 'round))

(defun ration (min max &key  nudge value validp  (filter 'no-op1))
 (cond ((< max min) (ration  max  min :nudge nudge
                             :value value :nudge nudge 
                             :validp validp :filter filter))
         (validp     (and (<= min value max) value))
         (nudge      (let
                       ((delta (* (- max min) nudge 0.5)))
                       (setf min   (- value delta)
                             max   (+ value delta))
                       (funcall filter (between min max))))
        (t          (funcall filter (between min max)))))

; gaussian
; beta 
(defun between (min max)
  (+ min (* (random 1.0) (- max min))))

(defun ordinal (range &key  nudge value (validp nil))
  (let ((dim (- (length range) 1)))
    (cond (validp (and (member value range) value))
          (nudge  (let*
                    ((pos0  (position value range))
                     (pos1  (ration-int  0  dim :value pos0 :nudge nudge)))
                    (elt range pos1)))
          (t     (let
                   ((pos1 (ration-int  0  dim)))
                   (elt range pos1))))))

 (defun nominal (range &key  nudge  value (validp nil))  
   (cond (validp                    (and (member value range) value))
         ((and nudge (zerop nudge)) value)
         (t                         (elt range  (random (length range))))))

(defmacro show (&rest tests)
  `(dolist (one (reverse ',tests))
    (format t "~a => ~a~%" one (eval one))))

(defun range-demos ()
  (show   (dotimes (i 10) (princ  (ordinal '(1 2 3  4 5 6 7 8 9 10) :value 6 :nudge 1)))
          (dotimes (i 10) (princ  (ordinal '(1 2 3  4 5 6 7 8 9 10) :value 6 :nudge 0.01)))
          (ordinal '(1 2 3) :value 3 :validp t)
          (ordinal '(1 2 3) :value 9 :validp t)
          (dotimes (i 10) (princ  (ordinal '(1 2 3))))
          (ration-int 0 12 :value 6 :nudge 1)
          (ration-int 0 12 :value 6 :nudge 0.01)
          (ration-int 0 12 :value 18 :validp t)
          (ration 0 12 :value 6 :nudge 1)
          (ration 0 12 :value 6 :nudge 0.01)
          (ration 0 12 :value 18 :validp t)
          (ration 0 12 :value 8 :validp t)
          (ration 0 12)
          (nominal  '(a b c))
          (nominal  '(a b c) :nudge 1 :value 'b)
          (nominal  '(a b c) :validp t :value 'b)
          (nominal  '(a b c) :validp t :value 'z)
          ))