Throttle Functions with core.async - clojure

The number of possible executions of a function should be throttled. So after calling a function, any repeated call should be ignored within a time period. If there where calls in the meantime, the last one should be executed after the time period.
Here's my approach with core.async. The problem here is, that additional calls are summing up in the channel c. I'd need a channel with only one position inside, which will be overridden by put! everytime.
(defn throttle [f time]
(let [c (chan 1)]
(go-loop []
(apply f (<! c))
(<! (timeout time))
(recur))
(fn [& args]
(put! c (if args args [])))))
usage:
(def throttled (throttle #(print %) 4000))
(doseq [x (range 10)]
(throttled x))
; 0
;... after 4 seconds
; 9
Does anyone have an idea how to fix this?
Solution
(defn throttle [f time]
(let [c (chan (sliding-buffer 1))]
(go-loop []
(apply f (<! c))
(<! (timeout time))
(recur))
(fn [& args]
(put! c (or args [])))))

To solve your channel question you can use a chan with a sliding buffer:
user> (require '[clojure.core.async :as async])
nil
user> (def c (async/chan (async/sliding-buffer 1)))
#'user/c
user> (async/>!! c 1)
true
user> (async/>!! c 2)
true
user> (async/>!! c 3)
true
user> (async/<!! c)
3
that way only the last value put into the channel will be computed at the next interval.

You can use a debounce function.
I'll copy it out here:
(defn debounce [in ms]
(let [out (chan)]
(go-loop [last-val nil]
(let [val (if (nil? last-val) (<! in) last-val)
timer (timeout ms)
[new-val ch] (alts! [in timer])]
(condp = ch
timer (do (>! out val) (recur nil))
in (recur new-val))))
out))
Here only when in has not emitted a message for ms is the last value it emitted forwarded onto the out channel. While in continues to emit without a long enough pause between emits then all-but-the-last-message are continuously discarded.
I've tested this function. It waits 4 seconds and then prints out 9, which is nearly what you asked for - some tweaking required!
(defn my-sender [to-chan values]
(go-loop [[x & xs] values]
(>! to-chan x)
(when (seq xs) (recur xs))))
(defn my-receiver [from-chan f]
(go-loop []
(let [res (<! from-chan)]
(f res)
(recur))))
(defn setup-and-go []
(let [in (chan)
ch (debounce in 4000)
sender (my-sender in (range 10))
receiver (my-receiver ch #(log %))]))
And this is the version of debounce that will output as required by the question, which is 0 immediately, then wait four seconds, then 9:
(defn debounce [in ms]
(let [out (chan)]
(go-loop [last-val nil
first-time true]
(let [val (if (nil? last-val) (<! in) last-val)
timer (timeout (if first-time 0 ms))
[new-val ch] (alts! [in timer])]
(condp = ch
timer (do (>! out val) (recur nil false))
in (recur new-val false))))
out))
I've used log rather than print as you did. You can't rely on ordinary println/print functions with core.async. See here for an explanation.

This is taken from David Nolens blog's source code:
(defn throttle*
([in msecs]
(throttle* in msecs (chan)))
([in msecs out]
(throttle* in msecs out (chan)))
([in msecs out control]
(go
(loop [state ::init last nil cs [in control]]
(let [[_ _ sync] cs]
(let [[v sc] (alts! cs)]
(condp = sc
in (condp = state
::init (do (>! out v)
(>! out [::throttle v])
(recur ::throttling last
(conj cs (timeout msecs))))
::throttling (do (>! out v)
(recur state v cs)))
sync (if last
(do (>! out [::throttle last])
(recur state nil
(conj (pop cs) (timeout msecs))))
(recur ::init last (pop cs)))
control (recur ::init nil
(if (= (count cs) 3)
(pop cs)
cs)))))))
out))
(defn throttle-msg? [x]
(and (vector? x)
(= (first x) ::throttle)))
(defn throttle
([in msecs] (throttle in msecs (chan)))
([in msecs out]
(->> (throttle* in msecs out)
(filter #(and (vector? %) (= (first %) ::throttle)))
(map second))))
You probably also want to add a dedupe transducer to the channel.

I needed to pass a function to capture the args because I was using it for an input event and it was passing a mutable object. 🤷
(defn throttle-for-mutable-args [time f arg-capture-fn]
(let [c (async/chan (async/sliding-buffer 1))]
(async-m/go-loop []
(f (async/<! c))
(async/<! (async/timeout time))
(recur))
(fn [& args]
(async/put! c (apply arg-capture-fn (or args []))))))
And I use like
[:input
{:onChange (util/throttle-for-mutable-args
500
#(really-use-arg %)
#(-> % .-target .-value))}]

Related

Any difference between `(chan n)` and `(chan (buffer n))`?

As the title asks, is there any difference between (chan n) and (chan (buffer n)) when in use?
The question originates from the idea that I want to pull messages from a db (yeah, I do not want to use Kafka or RabbitMQ) and process them in order.
So the code segment looks like:
(defn processer [id]
(let [ch (chan (buffer 1000))] ;;(chan 1000) or (chan (buffer 1000))?
(go-loop []
(when-let [msg (<! ch)]
(process-msg msg))
(recur))
ch))
(defn enqueue [id]
(let [ch (processer id)]
(go-loop []
(let [msgs (take-100-msg-from-db id)]
(if (seq msgs)
(doseq [msg msgs]
(>! ch msg))
(<! (timeout 100))))
(recur))))
In my testing, their behaviours do not differ.
Yes, they are the same.
You can always look at the source:
(defn chan
([] (chan nil))
([buf-or-n] (chan buf-or-n nil))
([buf-or-n xform] (chan buf-or-n xform nil))
([buf-or-n xform ex-handler]
(channels/chan (if (number? buf-or-n) (buffer buf-or-n) buf-or-n) xform ex-handler)))

Start and Stop core.async Interval

consider the following core-async code. It prints the string "tick" every 2 seconds:
(go-loop []
(<! (timeout 2000))
(prn "tick")
(recur))
I'm looking for a possibility to start and stop the interval from outside via functions.
The only thing that came to my mind was this:
(def running (atom false))
(defn start []
(reset! running true)
(go (loop []
(<! (timeout 2000))
(prn "tick")
(when #running (recur)))))
(defn stop []
(reset! running false))
Is this the way to go? Or would you do something else?
Here's what I would do:
(require '[clojure.core.async :as a])
(defn interval [f msecs]
(let [timing (a/chan)
kickoff
#(a/go
(a/<! (a/timeout msecs))
(a/>! timing true))]
(a/go-loop []
(when (a/<! timing)
(a/go (f))
(kickoff)
(recur)))
(kickoff)
#(a/close! timing)))
Example:
(let [i (interval #(prn "tick") 2000)]
(Thread/sleep 7000)
(i))
;; "tick"
;; "tick"
;; "tick"
;;=> nil
This way, all your state is local and is handled via channels and go blocks, rather than using a global atom. Since the work done in each iteration of the loop is more or less constant, your actual interval time should be fairly close to the number of msecs you pass in.
Or if you want to guarantee that the different calls to f are executed in chronological order, you could do something like this instead:
(require '[clojure.core.async :as a])
(defn interval [f msecs]
(let [action (a/chan (a/dropping-buffer 1))
timing (a/chan)
kickoff
#(a/go
(a/<! (a/timeout msecs))
(a/>! timing true))]
(a/go-loop []
(when (a/<! action)
(f)
(recur)))
(a/go-loop []
(if (a/<! timing)
(do
(a/>! action true)
(kickoff)
(recur))
(a/close! action)))
(kickoff)
#(a/close! timing)))
(The usage of this function is the same as that of my earlier interval function.)
Here all the calls to f are in the same loop. I'm using a dropping buffer, so if a call to f takes longer than msecs, future calls may start getting dropped to keep up.
Here is another way, you could go
(defn start []
(let [ctl (chan 0 )]
(go-loop []
(alt!
(timeout 2000) (do
(prn "tick")
(recur))
ctl (prn "Exit ")))
ctl))
(let [w (start) ]
(Thread/sleep 7000)
(>!! w "stop"))
;;=> "tick"
"tick"
"Exit"
You don't need to define state in namespace. Start function is returning chan to do stop in future.

Sleeping barber in Clojure

I'm implementing Sleeping barber using core.async. My current code is:
(def workingtime 10000)
(defn barber [in waiting-room]
(go-loop [served-customers 0]
(let [[v] (alts! [waiting-room in])]
(if (= v :close)
served-customers
(do (Thread/sleep 20)
(recur (inc served-customers)))))))
(defn customers [in waiting-room]
(go-loop [customers-overall 0]
(let [customer-arrival-interval (timeout (+ 10 (rand-int 20)))
[v] (alts! [in customer-arrival-interval])]
(if (= v :close)
customers-overall
(do (>! waiting-room :customer)
(recur (inc customers-overall)))))))
(defn -main [& args]
(let [in (chan)
waiting-room (chan (dropping-buffer 3))
barber-ch (barber in waiting-room)
customers-ch (customers in waiting-room)]
(println "opening the shop for 10 seconds...")
(Thread/sleep workingtime)
(>!! in :close)
(>!! in :close)
(println "closing the shop...")
(println (str "Served " (<!! barber-ch) " customers"))
(println (str "Overall " (<!! customers-ch) " customers came"))))
Is it a correct solution? Can it be improved to make it more Clojure-like?
I wanted to use alt! instead of alts! which makes code easier to read:
(defn barber [in]
(go-loop [served-customers 0]
(alt!
waiting-room (do (Thread/sleep 20)
(recur (inc served-customers)))
in served-customers)))
Runtime throws an exception: Can only recur from tail position. Can I still use alt!?
You could solve the alt!/recur problem by rewriting to:
(defn barber [in]
(go-loop [served-customers 0]
(if (= :waiting-room
(a/alt!
waiting-room ([result] :waiting-room) ;; you could also use result if needed
in ([result] :in))) ;; same here
(do (Thread/sleep 20)
(recur (inc served-customers)))
served-customers)))

How to model Rx's `withLatestFrom` with core.async channels?

For example given a channel with operations and another channel with data, how to write a go block that will apply the operation on whatever was the last value on the data channel?
(go-loop []
(let [op (<! op-ch)
data (<! data-ch)]
(put! result-ch (op data))))
Obviously that doesn't work because it would require both channels to have the same frequency.
(see http://rxmarbles.com/#withLatestFrom)
Using alts! you could accomplish what you want.
The with-latest-from shown below implements the same behavior found in the withLatestFrom from RxJS (I think :P).
(require '[clojure.core.async :as async])
(def op-ch (async/chan))
(def data-ch (async/chan))
(defn with-latest-from [chs f]
(let [result-ch (async/chan)
latest (vec (repeat (count chs) nil))
index (into {} (map vector chs (range)))]
(async/go-loop [latest latest]
(let [[value ch] (async/alts! chs)
latest (assoc latest (index ch) value)]
(when-not (some nil? latest)
(async/put! result-ch (apply f latest)))
(when value (recur latest))))
result-ch))
(def result-ch (with-latest-from [op-ch data-ch] str))
(async/go-loop []
(prn (async/<! result-ch))
(recur))
(async/put! op-ch :+)
;= true
(async/put! data-ch 1)
;= true
; ":+1"
(async/put! data-ch 2)
;= true
; ":+2"
(async/put! op-ch :-)
;= true
; ":-2"
There's an :priority true option for the alts!.
An expression which always returns the latest seen value in some channel would look something like this:
(def in-chan (chan))
(def mem (chan))
(go (let [[ch value] (alts! [in-chan mem] :priority true)]
(take! mem) ;; clear mem (take! is non-blocking)
(>! mem value) ;; put the new (or old) value in the mem
value ;; return a chan with the value in
It's untested, it's probably not efficient (a volatile variable is probably better). The go-block returns a channel with only the value, but the idea could be expanded to some "memoized" channel.

How to launch two threads and wait for them

I can launch two threads and they work, but synchronously. What am I missing to get these threads independently launched?
main, thread, and output
(defn -main
[& args]
(do
(let [grid-dim-in [0 5]
mr1-pos [\N 2 4]
mr2-pos [\N 1 5]
mr1-movs "LMLMMRMM"
mr2-movs "RMRMMMLM"]
(reset! grid-dim grid-dim-in)
(reset! mr1-id {:mr1 mr1-pos})
(reset! mr2-id {:mr2 mr2-pos})
(.start (Thread. (rover-thread mr1-id mr1-movs update-work-block)))
(.start (Thread. (rover-thread mr2-id mr2-movs update-work-block))))))
(defn rover-thread [id movs update-ref]
(let [id-key (keys #id)
id-vals (vals #id)]
(doseq [mov movs]
(println "Rover " id-key " is moving ")
(let [new-mov (determine-rover-move (first id-vals) mov)]
(move-rover id new-mov update-ref)
(print "Rover ")
(print (first id-key))
(print " is at ")
(println new-mov)
(Thread/sleep (rand 1000)))))
Rover :mr1 is at [E 2 4]
Rover (:mr1) is moving
Rover :mr1 is at [N 2 5]
Rover (:mr1) is moving
Rover :mr1 is at [N 2 5]
Finished on Thread[main,5,main]
Rover (:mr2) is moving
Rover :mr2 is at [E 1 5]
Rover (:mr2) is moving
Rover :mr2 is at [N 1 6]
Take a close look at these two lines:
(.start (Thread. (rover-thread mr1-id mr1-movs update-work-block)))
(.start (Thread. (rover-thread mr2-id mr2-movs update-work-block))))))
This code evaluates the (rover-thread mr1-id mr1-movs update-work-block) first, and passes the result of that to the constructor of Thread, which is not what you want.
Here's a simple function to illustrate the principle. This doesn't work, because the (f ...) is evaluated before its result it passed to the Thread constructor:
(defn run-thread-thing-wrong []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(.start (Thread. (f 10 "A")))
(.start (Thread. (f 10 "B"))))
nil)
Here's a version that does work. A function is passed to the Thread constructor instead:
(defn run-thread-thing []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(.start (Thread. (fn [] (f 10 "A"))))
(.start (Thread. (fn [] (f 10 "B")))))
nil)
Note: instead of (fn [] ....) you can use the short form #(....) for anonymous functions.
Here's another version that does the same, but with a future instead of manually creating threads:
(defn run-thread-thing []
(let [f (fn [n s]
(doseq [i (range n)]
(prn s i)
(Thread/sleep (rand 1000))))]
(future (f 10 "A"))
(future (f 10 "B")))
nil)
Note that in this case, you pass a form to future instead of a function.
This seems like a really good place to use Clojure's agent feature. I am not qualified to fully explain how to use them, but a really good example of their usage can be found here. Starting threads using agents is dead-easy, and I think it is more idiomatic.
The code would look something like,
(def rover1 (agent [mr1-posn mr1-movs mr1-id]))
(def rover2 (agent [mr2-posn mr2-movs mr2-id]))
(defn rover-behave [[posn movs id]]
(send-off *agent* #'rover-behave)
(. Thread (sleep 1000))
(let [new-mov (determine-rover-move posn movs id)
new-posn (posn-after-move posn new-mov)]
;return value updates state of agent
[new-posn movs id]
)
)
(send-off rover1 rover-behave)
(send-off rover2 rover-behave)