forked from threatgrid/naga
-
Notifications
You must be signed in to change notification settings - Fork 2
/
queue.cljc
74 lines (67 loc) · 2.66 KB
/
queue.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(ns ^{:doc "Defines a Queue structure that can be added to the tail, and removed from the head.
Anything already in the queue (compared by ID) will not be added again, but a function can
be provided that will update the element when it is already present.
Includes a 'salience' which allows elements to be promoted through the queue ahead
of less salient elements."
:author "Paula Gearon"}
naga.queue
(:refer-clojure :exclude [pop])
(:require [schema.core :as s :refer [=>]]))
(defprotocol PQueue
(q-count [queue] "Returns the number of items in the queue")
(head [queue] "Returns the head of the queue")
(pop [queue] "Removes the head from the queue")
(add
[queue element]
[queue update-fn element]
"Adds an element to the queue if it isn't already present, returning the new queue. Uses update-fn on the element if it is already in the queue"))
(def PQueueType (s/pred #(satisfies? PQueue %)))
(s/defn insert-by :- [s/Any]
[s :- [s/Any]
salience :- (s/maybe (=> s/Num s/Any)) ;; element -> number
e :- s/Any]
(let [preamble (if (and salience (salience e))
(take-while #(>= (salience e) (salience %)) s)
s)]
(concat preamble
(cons e
(drop (count preamble) s)))))
(declare ->SalienceQueue)
(defrecord SalienceQueue
[q ;; :- [s/Any]
h ;; :- #{s/Any}
id-fn ;; :- (=> s/Any s/Any) ;; element -> ID (id: string, number, etc)
salience-fn ;; :- (s/maybe (=> s/Num s/Any)) ;; element -> number
]
PQueue
(q-count [_] (count q))
(head [_] (first q))
(pop [_] (->SalienceQueue (rest q) (disj h (id-fn (first q))) id-fn salience-fn))
(add [e element] (add e identity element))
(add
[this update-fn element]
(let [id (id-fn element)]
(if (h id) ;; TODO: can salience be updated on the fly?
(if (= identity update-fn)
this ;; shortcut to avoid redundant work when using identity
(let [updater-fn (fn [e] (if (= id (id-fn e)) (update-fn e) e))]
(->SalienceQueue (map updater-fn q) h id-fn salience-fn)))
(->SalienceQueue (insert-by q salience-fn element)
(conj h id)
id-fn
salience-fn)))))
(s/defn new-queue
"Create an empty queue. When called without arguments, salience is ignored,
and update and ID are just identity."
([]
(new-queue nil identity))
([salience-fn :- (s/maybe (=> s/Num s/Any))
id-fn :- (=> s/Any s/Any)]
(->SalienceQueue '() #{} id-fn salience-fn)))
(defn drain
"Pulls everything off a queue into a seq."
[queue]
(loop [s [] q queue]
(if-let [e (head q)]
(recur (conj s e) (pop q))
s)))