(define-module (embddr random))

(import (srfi srfi-1)
        (srfi srfi-27))

(export clean-constraints
        constrained-random-generator)

;;;
;;; Remove redundant (zero range) constraints.
;;; Limit weight in range (0..1]
;;;
(define (clean-constraints constrs)
  (remove (lambda (c)
            (let ((from (car c))
                  (to (cadr c))
                  (w (caddr c)))
              (or (= from to)
                  (zero? w))))
          (map (lambda (c)
                 (let ((from (inexact->exact (round (car c))))
                       (to (inexact->exact (round (cadr c))))
                       (w (caddr c)))
                   (let ((w (cond
                             ((< w 0) 0)
                             ((> w 1) 1)
                             (else w))))
                     (if (> from to)
                         (list to from w)
                         (list from to w)))))
               constrs)))
;;;
;;; Make constrained random number generator.
;;; Constraints is list of '(from to weight), where
;;; 'from' - inclusive bottom limit, 'to' - exclusive
;;; top limit or random range.
;;;
(define (constrained-random-generator constrs)
  (let ((constrs (clean-constraints constrs)))
    (let* (;; Max weight / min weight ration
           (weight-scale
            (let ((weights (map caddr constrs)))
              (/ (apply max weights) (apply min weights))))

           ;; Place constraints to uniform linear axis
           (constrs
            (let loop ((constrs constrs)
                       (position 0)
                       (result '()))
              (if (null? constrs)
                  (reverse result)
                  (let* ((c (car constrs))
                         (from (car c))
                         (to (cadr c))
                         (w (caddr c))
                         (l-range (* w weight-scale
                                     (- to from))))
                    (loop (cdr constrs)
                          (+ position l-range)
                          (cons (list position (+ position l-range)
                                      from to w)
                                result))))))

           ;; Linear range of required random number
           (range
            (apply max (map cadr constrs))))

      ;; Make generator
      (lambda ()
        (let* (;; Generate random from linear space
               (rand-lin (random-integer range))

               ;; Find corresponding constraint
               (c
                (find (lambda (c)
                        (and (>= rand-lin (car c))
                             (< rand-lin (cadr c))))
                      constrs)))

          ;; Scale random
          (inexact->exact
           (floor
            (+ (caddr c)
               (/ (- rand-lin (car c))
                  (* weight-scale (list-ref c 4)))))))))))