Periodic Scheduler

periodic-scheduler.lisp

(in-package :cl-user)

;;; Vince, A. "Scheduling periodic events." Discrete Applied Mathematics 25.3 (1989): 299-310.
;;; http://www.sciencedirect.com/science/article/pii/0166218X89900085

;; * Events E_1, ..., E_n occur periodically with periods m_1, ..., m_n.
;; * x_i denote any occurence time of E_i.
;; * 0 <= x_i <= m_i for all i since E_i recurs at intervals m_i.
;; * Other occurences of E_i are given by x_i + k*m_i, k an integer.
;; * Therefore an n-tuple of times x = (x_1, ..., x_n) determines all occurences of
;;   all events.
;; * d_ij(x_i, y_j) denotes the least distance between an occurrence of events
;; * |x|_m denotes the distance from x to the closest multiple of m
;; * f(x) = min d_ij(xi,xj)


(defun distance-to-closest-multiple (x m)
  (min (mod x m)
       (mod (- m x) m)))

(defun least-distance (x x-period y y-period &optional (alpha 1))
  (distance-to-closest-multiple (- x y)
                                (* alpha (gcd x-period y-period))))

(defun f (n alpha deltas periods)
  (loop for i from 0 below (1- n)
        minimize (loop for j from (1+ i) below n
                       minimize (least-distance (aref deltas i)
                                                (aref periods i)
                                                (aref deltas j)
                                                (aref periods j)
                                                alpha))))

(defun m (n alpha periods granularity)
  (let ((aux-deltas (make-array n))
        (max-min-distance nil)
        (best-deltas (make-array n)))
    (labels ((combine (i acc-deltas)
               (cond ((< i n)
                      (loop for x from 1 below (* alpha (aref periods i)) by granularity
                            do (combine (1+ i) (cons x acc-deltas))))
                     (t
                      (loop for idx downfrom (1- n)
                            for delta in acc-deltas
                            do (setf (aref aux-deltas idx) delta))
                      (let ((min-distance (f n alpha aux-deltas periods)))
                        (when (or (null max-min-distance)
                                  (> min-distance max-min-distance))
                          (setf max-min-distance min-distance)
                          (map-into best-deltas #'identity aux-deltas)))))))
      (combine 1 '(0)))
    (values max-min-distance best-deltas)))

(defun periodic-scheduler (periods &optional (granularity 0.5))
  (let ((n (length periods))
        (max-min-distance nil)
        (best-deltas nil))
    (loop for alpha from 1 upto n do
      (multiple-value-bind (min-distance deltas)
          (m n alpha periods granularity)
        (let ((adjusted-min-distance (/ min-distance alpha)))
          (when (or (null max-min-distance)
                    (> adjusted-min-distance max-min-distance))
            (setf max-min-distance adjusted-min-distance
                  best-deltas (map 'vector (lambda (x) (/ x alpha)) deltas))))))
    (values max-min-distance best-deltas)))

;; (periodic-scheduler #(10 20)) => 5.0, #(0 5.0)
;; (periodic-scheduler #(5 10)) => 2.5, #(0 2.5)
;; (periodic-scheduler #(15 15 15)) => 5.0, #(0 5.0 10.0)

#|
CL-USER> (periodic-scheduler #(5 10 15))
1.6666666
#(0 1.6666666 3.3333333)
CL-USER> (periodic-scheduler #(5 10 15 20))
1.6666666
#(0 1.6666666 3.3333333 6.6666665)
|#