Add delay in clojure.core.async - asynchronous

When using clojure.core.async, is there a way to have one channel wait for the first item to be put on it, then wait some small amount of time, then get all the items currently on the channel (that could have arrived while waiting) and get all of them without blocking?
I.e. is there a way to implement get-available-items:
(defn delayer [ch ch2]
(go (loop []
(when-let [v (<! ch)]
(<! (timeout 500))
(let [vs (get-available-items ch)
items (cons v vs)]
(>! ch2 items))
(recur)))))
Basically, something like BlockingQueue.drain in Java.

There are plans to offer this feature with channels, though for now you can check for the presence of something on a channel with:
(alts!! [my-chan] :default :nothing-immediately-in-chan)
by iterating that you can drain a channel without blocking.
PS: extra thanks to tbaldridge and julianlevis on #clojure for helping with this one

You can just alt on the same timeout channel until you run out of "waiting time", collecting any incoming values meanwhile.
These seems to work:
(require '[clojure.core.async :as a :refer [<! >! go chan]])
(defn delayer [in out]
(a/go-loop []
(when-let [v (<! in)]
(loop [batch [v] timeout-ch (a/timeout 500)]
(let [[v ch] (a/alts! [in timeout-ch])]
(if (= in ch)
(recur (conj batch v) timeout-ch)
(>! out batch))))
(recur))))
Notice that we create the timeout channel just once and we reuse it. A simple test to prove that it works:
(def out (chan))
(def in (chan))
(delayer in out)
; print batches as soon as available
(a/go-loop []
(>pprint (str (java.util.Date.) (<! out)))
(recur))
; put a value every 100 millis
(a/go-loop [i 100]
(when-not (zero? i)
(<! (a/timeout 100))
(>! in i)
(recur (dec i))))

Related

Core.async: map channel over async function

With Clojure's Core.Async one can map over a channel by using transducers:
(def my-chan (chan (buffer 10) (map inc)))
But what happens if the mapper function itself is async?
Say, we have a:
(defn async-inc [n]
(let [c (promise-chan)]
(put! (inc n))
c))
Is there a similar concise way to map the channel over this function? Or would one have to do something like this:
(def my-chan (chan (buffer 10)))
(def my-chan2 (chan (buffer 10)))
(go (while true
(>! my-chan2
(<! (async-inc (<! my-chan))))))
It would not really be mapping, since two channels are needed instead of one.
There is a general advice not to create channel inside a function and return it out because it forces user of that function to use core.async. You can either return an output through a promise or return through callback function.
Assuming what you want to do with an output from async-inc is to print it out using println function.
Return through a promise
(defn async-inc [n]
(let [p (promise)]
(deliver p (inc n))
p))
(println #(async-inc (<! my-chan)))
Return through callback
(defn async-inc [n callback]
(callback (inc n)))
(async-inc (<! my-chan) println)
But if you don't have a control over async-inc. Here are your options.
Use <!!
(println (<!! (go (<! (async-inc (<! my-chan))))))
or
Use take!
(take! (go (<! (async-inc (<! my-chan)))) println)

Clojure: alternative to using a mutex/lock and a counter

Scenario: I have a server listening to six active TCP/IP connections. When a "ready" message comes in, an event will be raised on its own thread. When the server has received a "ready" message from each connection, it needs to run the "start" function.
My object oriented solution would likely involve using a mutex and a counter. Something like:
int _countDown= 6;
object _lock;
void ReadyMessageReceivedForTheFirstTimeFromAConnection() {
lock(_lock) {
--_countDown; //
if (_countDown==0) Start();
}
}
How could this problem be solved in Clojure without resorting to locks/mutexes?
When you prefer a pure clojure version, you can use a promise to give your futures a go.
Every time you receive message you increment the conn-count
the watch checks if the treshold is reached and delivers :go to the barrier promise.
(def wait-barrier (promise))
(def conn-count (atom 0))
(add-watch conn-count :barrier-watch
(fn [key ref old-state new-state]
(when (== new-state 6)
(deliver wait-barrier :go))))
dummy-example:
(def wait-barrier (promise))
(def conn-count (atom 0))
(defn worker-dummy []
(when (= #wait-barrier :go)
(println "I'm a worker")))
(defn dummy-receive-msg []
(doall (repeatedly 6,
(fn []
(println "received msg")
(swap! conn-count inc)))))
(let [workers (doall (repeatedly 6 (fn [] (future (worker-dummy)))))]
(add-watch conn-count :barrier-watch
(fn [key ref old-state new-state]
(when (== new-state 6)
(deliver wait-barrier :go))))
(dummy-receive-msg)
(doall (map deref workers)))
You can use a CountDownLatch or a Phaser for this purpose.
In my futures library, imminent, I used both. CountDownLatch first and then replaced it with a Phaser for ForkJoin compatibility (might not be necessary in your case). You can see the change in this diff. Hopefully it gives you an idea of usage for both.
With latches the general idea would be:
(let [latch (CountDownLatch. 6)]
(on-receive-message this (fn [_] (.countDown latch)))
(.await latch)
...or something like that.
Since it hasn't been mentioned so far: you could easily do that with core.async. Have a look at this MCVE:
(let [conn-count 6
ready-chan (chan)]
;; Spawn a thread for each connection.
(doseq [conn-id (range conn-count)]
(thread
(Thread/sleep (rand-int 2000))
(>!! ready-chan conn-id)))
;; Block until all connections are established.
(doseq [total (range 1 (inc conn-count))]
(println (<!! ready-chan) "connected," total "overall"))
;; Invoke start afterwards.
(println "start"))
;; 5 connected, 1 overall
;; 3 connected, 2 overall
;; 4 connected, 3 overall
;; 0 connected, 4 overall
;; 1 connected, 5 overall
;; 2 connected, 6 overall
;; start
;;=> nil
You could also use a channel to implement a countdown latch (borrowed from Christophe Grand):
(defn count-down-latch-chan [n]
(chan 1 (comp (drop (dec n)) (take 1))))
For a short introduction into core.async, check out this Gist. For a longer one, read the corresponding chapter in "Clojure for the Brave and True".

Echo server in common lisp with cl-usocket

I am trying a simple echo server in common lisp (I use clisp). I've tried the example in http://rosettacode.org/wiki/Echo_server#Common_Lisp
The CLISP version (without usocket) works fine.
When I try the usocket version (with clisp) I get the following error:
* - The condition
CDR: :INPUT is not a list
occurred.
Thank you in advance for your replies,
Dimitris
I'm not sure of the answer, but I think this can be tracked down to wait-for-input and wait-for-input-internal. The function wait-for-input has the following definition (abbreviated):
(defun wait-for-input (socket-or-sockets &key timeout ready-only)
"Waits for one or more streams to become ready for reading from
the socket. When `timeout' (a non-negative real number) is
specified, wait `timeout' seconds, or wait indefinitely when
it isn't specified. A `timeout' value of 0 (zero) means polling. …"
(unless (wait-list-p socket-or-sockets)
(let ((wl (make-wait-list (if (listp socket-or-sockets)
socket-or-sockets (list socket-or-sockets)))))
(multiple-value-bind
(socks to)
(wait-for-input wl :timeout timeout :ready-only ready-only)
(return-from wait-for-input
(values (if ready-only socks socket-or-sockets) to)))))
(let* ((start (get-internal-real-time))
(sockets-ready 0))
(dolist (x (wait-list-waiters socket-or-sockets))
(when (setf (state x)
#+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
#-(and win32 (or sbcl ecl))
(if (and (stream-usocket-p x)
(listen (socket-stream x)))
:read
nil))
(incf sockets-ready)))
;; the internal routine is responsibe for
;; making sure the wait doesn't block on socket-streams of
;; which theready- socket isn't ready, but there's space left in the
;; buffer
(wait-for-input-internal socket-or-sockets
:timeout (if (zerop sockets-ready) timeout 0))
(let ((to-result (when timeout
(let ((elapsed (/ (- (get-internal-real-time) start)
internal-time-units-per-second)))
(when (< elapsed timeout)
(- timeout elapsed))))))
(values (if ready-only
(remove-if #'null (wait-list-waiters socket-or-sockets) :key #'state)
socket-or-sockets)
to-result))))
Note that the last section calls wait-for-input-internal with
(wait-for-input-internal socket-or-sockets
:timeout (if (zerop sockets-ready) timeout 0))
Now, the name socket-or-sockets implies that its value may be a single socket or a list of sockets. However, let's take a look at the definition of wait-for-input-internal for CLISP (it's defined in the backend/<implementation>.lisp):
(defmethod wait-for-input-internal (wait-list &key timeout)
(with-mapped-conditions ()
(multiple-value-bind
(secs musecs)
(split-timeout (or timeout 1))
(dolist (x (wait-list-%wait wait-list))
(setf (cdr x) :INPUT))
(let* ((request-list (wait-list-%wait wait-list))
(status-list (if timeout
(socket:socket-status request-list secs musecs)
(socket:socket-status request-list)))
(sockets (wait-list-waiters wait-list)))
(do* ((x (pop sockets) (pop sockets))
(y (cdr (pop status-list)) (cdr (pop status-list))))
((null x))
(when (member y '(T :INPUT))
(setf (state x) :READ)))
wait-list))))
There are two uses of :INPUT there. It appears that each element of the wait-list is supposed to be a cons whose cdr contains some sort of state. Perhaps wait-for-input is getting called with a single socket (after all, the argument name is socket-or-sockets, and when wait-for-input-internal is called, it's expecting a list. That could lead to the latter getting (<something> . :INPUT) when expecting ((<something . :INPUT)). I'm not sure, though. In any case, though, the error is coming from somewhere around here.

Avoiding mutable state when I need to store (current-seconds) multiple times

I've put together the following rudimentary stopwatch in Racket (just learning now, the final aim is a pomodoro-timer).
#lang racket
(define start-time 0)
(define end-times '())
(define (start);; stores start-time
(set! start-time (current-seconds)))
(define (lap);; stores "laps" in list
(set! end-times (cons (current-seconds) end-times)))
(define (stop);; stores final time, displays lap-times in h, m, s and resets end-times
(begin
(set! end-times (cons (current-seconds) end-times))
(display
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
(set! end-times '())
))
While this does exactly what it should, I was wondering how I could avoid mutable state. If I follow HTDP, this is the kind of situation where mutable state is warranted, but after browsing Wadler's "Monads for Functional Programming", I'm still curious about how I could do without set!.
I know that to make it functional, I should add arguments to my functions. For instance, start would become
(define (start [now (current-seconds)])
now)
and a similar approach could work with lap and stop.
Still, while I know that after adding additional arguments to restore functionality, I should also pass arguments rather than storing values in variables, I don't see how in this case I can leverage this to avoid set! as well.
Update: Since all three answers below are highly valuable (thanks!), I didn't mark any of them as the unique correct one. Below is the minimal solution to my initial question. It is a combination of the loop-proposal of #Metaxal, with the example-usage of #Greg Hendershott.
#lang racket
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([t0 (current-seconds)] [times '()])
(match (read-line)
["quit" (reverse
(map (lambda (x)
(let ((the-date (seconds->date x)))
(list
(sub1(date-hour the-date))
(date-minute the-date)
(date-second the-date)))) times))]
["lap" (loop t0 (cons (- (current-seconds) t0) times))]
[_ (loop t0 times)])))
What will likely happen in the following of your program is that you will have a loop.
Then this loop can be a function that takes as input the whole current state, and when you want to update its state, just call the loop again with the new state (you may also call the loop again with the same exact state of course).
Simplified example:
(define (loop [t0 (current-seconds)] [times '()])
;; ... do things here, possibly depending on user input ...
;; then loop with a new state:
(cond [<some-start-condition> (loop (current-seconds) '())]
[<some-lap-condition> (loop t0 (cons (- (current-seconds) t0) times))]
[<some-stop-condition> times])) ; stop, no loop, return value
This certainly changes the approach to your design though.
It's harder to use this approach when designing GUI programs, because the event loop often prevents you from (or makes it difficult) passing values from one event to the next.
However, in Racket, there is (the pedagogical, but still very good) big-bang that is made just for that.
In this case using set! is justified and hard to avoid, because we must "remember" state between invocations of the procedures. What we can do is improving the encapsulation of state, by hiding the variables that change inside a procedure and using a message dispatcher for accessing the procedures that refer to the mutable state. This is very similar to what we do with object-oriented programming, but only lambdas are required to implement it!
(define (make-timer)
; the "attributes" of the object
(let ([start-time 0]
[end-times '()])
; the "methods" of the object
(define (start)
(set! start-time (current-seconds)))
(define (lap)
(set! end-times (append end-times (list (current-seconds)))))
(define (stop)
(lap)
(display
(map (lambda (an-end)
(let ((the-date (seconds->date (- an-end start-time))))
(list
(sub1 (date-hour the-date))
(date-minute the-date)
(date-second the-date))))
end-times))
(set! end-times '()))
; return a dispatch procedure
(lambda (msg)
(case msg
((start) (start)) ; call the start procedure defined above
((lap) (lap)) ; call the lap procedure defined above
((stop) (stop)) ; call the stop procedure defined above
(else (error "unknown message:" msg))))))
I took the liberty of modifying some of your procedures to make them a bit simpler. Here's how we would use the timer object we just created:
(define timer (make-timer))
(timer 'start)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'stop)
=> ((18 0 1) (18 0 2) (18 0 3) (18 0 4))
This technique is called "message passing", learn more about it in the wonderful SICP book.
For a simple example like this, I would probably do what #Metaxal
suggested.
However another approach is that you could explicitly define the state
as a struct:
(struct state (start-time end-times))
Then change the start, lap, and stop to be functions on state:
;; start : -> state
;; stores start-time
(define (start)
(state (current-seconds) '()))
;; lap : state -> state
;; stores "laps" in list
(define (lap st)
(match-define (state start-time end-times) st)
(state start-time
(cons (current-seconds) end-times)))
;; stop : state -> list
;; stores final time, displays lap-times in h, m, s
(define (stop st)
(match-define (state start-time end-times*) st)
(define end-times (cons (current-seconds) end-times*))
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
As in #Metaxal's answer, your "main loop" needs to handle the state and "thread" it through the functions as appropriate:
Example usage:
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([st (start)])
(match (read-line)
["quit" (stop st)]
["lap" (loop (lap st))]
[_ (loop st)])))
Whereas #Óscar López's answer shows a style of OOP as explained in SICP.
A nice thing about Racket (and Scheme) is that you can choose whatever approach on the spectrum you think best fits the problem at hand, and your taste -- simple imperative, OOP imperative, pure functional.

Simple Calculator (Addition function input) in Clojure

I'm trying to write a simple calculator with addition, subtraction, etc.
My problem is with getting the user input. How do I turn the string of numerical values into a vector? And also what is a better way to write the program?
(ns scalc.core)
(defn add
[numbers]
(println (apply + numbers)))
(defn numchoose
[]
(println "What numbers?: ")
(let [numbers (read-line)] numbers))
(defn opchoose
[]
(println "What operation would you like to do?: ")
(let [operation (read-line)]
(if (= operation "add")
(do
(println "You chose to add.")
(let [numvect (numchoose)]
(add [numvect]))))))
(defn -main
[& args]
(opchoose)
(numchoose))
And this is the error:
~/clj/scalc 1/7 % lein trampoline run -m scalc.core
What operation would you like to do?:
add
You chose to add.
What numbers?:
5 7
Exception in thread "main" java.lang.ClassCastException: Cannot cast java.lang.String to java.lang.Number
at java.lang.Class.cast(Class.java:3005)
at clojure.core$cast.invoke(core.clj:318)
at clojure.core$_PLUS_.invoke(core.clj:927)
at clojure.lang.AFn.applyToHelper(AFn.java:161)
at clojure.lang.RestFn.applyTo(RestFn.java:132)
at clojure.core$apply.invoke(core.clj:601)
at scalc.core$add.invoke(core.clj:5)
at scalc.core$opchoose.invoke(core.clj:21)
at scalc.core$_main.doInvoke(core.clj:27)
at clojure.lang.RestFn.invoke(RestFn.java:397)
at clojure.lang.Var.invoke(Var.java:411)
at user$eval15.invoke(NO_SOURCE_FILE:1)
at clojure.lang.Compiler.eval(Compiler.java:6511)
at clojure.lang.Compiler.eval(Compiler.java:6501)
at clojure.lang.Compiler.eval(Compiler.java:6477)
at clojure.core$eval.invoke(core.clj:2797)
at clojure.main$eval_opt.invoke(main.clj:297)
at clojure.main$initialize.invoke(main.clj:316)
at clojure.main$null_opt.invoke(main.clj:349)
at clojure.main$main.doInvoke(main.clj:427)
at clojure.lang.RestFn.invoke(RestFn.java:421)
at clojure.lang.Var.invoke(Var.java:419)
at clojure.lang.AFn.applyToHelper(AFn.java:163)
at clojure.lang.Var.applyTo(Var.java:532)
at clojure.main.main(main.java:37)
EDIT: the solved program now looks like this:
(ns scalc.core)
(defn add [numbers]
(reduce + numbers))
(defn numchoose []
(let [nums (re-seq #"\d+" (read-line))]
(map #(Integer/parseInt %) nums)))
(defn delegate []
(println "What operation would you like to do?: ")
(let [operation (read-line)]
(when (= operation "add")
(println "You chose to add.")
(println "What numbers? ")
(add (numchoose)))))
(defn -main
[& args]
(delegate))
For getting the numbers, you can use re-seq:
(re-seq #"\d+" "123 456 789") => ("123" "456" 789")
You still only have strings rather than numbers though. You can use read-string to get the numbers (read-string is convenient, but not safe in all cases. Here we make sure there are really only numbers in these strings so it's fine).
(read-string "5") => 5
Instead of (apply + numbers) you could use reduce: (reduce + numbers), also your add function really shouldn't print anything (you should try to separate functional functions from side-effecty functions whenever possible).
This (let [numbers (read-line)] numbers) is equal to (read-line). Don't overcomplicate things!
Instead of
(if (= operation "add")
(do ... ))
you can write
(when (= operation "add")
...)
when is just a macro that's useful when you don't need the else case in your ifs (it wraps everything after the condition in a do, and evaluates to nil when the condition evaluates to false).

Resources