Simple Event Simulation in Clojure

core.clj

(ns sim-cincyfp.core)

(def min (* 1000 60))
(def min5 (* 5 min))
(def min10 (* 10 min))
(def min15 (* 15 min))
(def min30 (* 30 min))

;; ---------------------------------------------------------------------
;; Generating Events

(defn uniform [time-start time-end]
  (let [diff (- time-end time-start)]
    (long (+ time-start (* diff (rand))))))

(defn next-events [clock future-events]
  (->> future-events
       (sort-by :timestamp)
       (partition-by #(>= clock (:timestamp %)))))

(defn gen-trans [clock id]
  (let [del-time (uniform clock (+ clock min5))
        pick-time (uniform (+ del-time min15)
                           (+ del-time min30))]
    [{:type :delivery
      :timestamp del-time
      :id id}
     {:type :pickup
      :timestamp pick-time
      :id id}]))

(defn generate-events
  ([clock num-trans]
   (generate-events clock num-trans 1 [] []))
  ([clock num-trans id events future-events]
   (if (zero? num-trans)
     (into events future-events)
     (let [next-trans (gen-trans clock id)
           new-clock (get-in next-trans [0 :timestamp])
           new-futures (into future-events next-trans)
           [ev-proc ev-keep] (next-events new-clock new-futures)]
       (recur new-clock
              (dec num-trans)
              (inc id)
              (into events ev-proc)
              ev-keep)))))

;; ---------------------------------------------------------------------
;; Simulating Events

(defn deliver-item [{:keys [lockers shelf]} {:keys [id]}]
  (let [new-lockers (reduce (fn [lockers idx]
                              (let [{:keys [state]} (nth lockers idx)]
                                (if (= :empty state)
                                  (reduced
                                    (update lockers idx
                                            assoc
                                            :item id
                                            :state :occupied))
                                  lockers)))
                            lockers
                            (range (count lockers)))
        shelf (if (= lockers new-lockers)
                (conj shelf id)
                shelf)]
    {:lockers new-lockers
     :shelf shelf}))

(defn pickup-item [{:keys [lockers shelf]} {:keys [id]}]
  (let [new-lockers (reduce (fn [lockers idx]
                              (let [{:keys [item]} (nth lockers idx)]
                                (if (= id item)
                                  (reduced (assoc lockers idx {:state :empty}))
                                  lockers)))
                            lockers
                            (range (count lockers)))
        new-shelf (if (= lockers new-lockers)
                    (into [] (filter #(= % id) shelf))
                    shelf)]
    {:lockers new-lockers
     :shelf new-shelf}))

(defn simulate-event [world event]
  (let [{:keys [type]} event]
    (case type
      :delivery (deliver-item world event)
      :pickup (pickup-item world event))))

;; ---------------------------------------------------------------------
;; Optimizing

(defn add-locker [world]
  (update world :lockers conj {:state :empty}))

(defn optimized-sim [world event]
  (let [new-world (simulate-event world event)]
    (if (<= (count (:shelf new-world))
            (count (:shelf world)))
      new-world
      (simulate-event (add-locker world) event))))

;; ---------------------------------------------------------------------
;; Entry Point

(defn run-simulation []
  (let [init-world {:lockers [{:state :empty}], :shelf []}
        events (generate-events (System/currentTimeMillis) 4000000)]
    (loop [world init-world
           [event & r-events] events]
      (when (or (nil? event) (zero? (mod (:id event) 100000)))
        (println (count (:lockers world))
                 (count (filter #(= :empty (:state %)) (:lockers world)))))
      (if (nil? event)
        world
        (recur (optimized-sim world event) r-events)))))