Chan of chars to chan of words - clojure

How can I make a words chan out of chars chan?
I have chan c that read all characters from file. And i need words(str) chan from c chan.(
words need to be made from с, not from a file)
(def file-as-str (slurp "src/clojure2/text.txt"))
(def read (str/split file-as-str #""))
(defn ch
[c]
(go
(doseq [o read]
(>! c o)
))
)
(defn word
[c]
(let [k (chan)]
(go-loop []
(let [o (<! c)]
(when (not= " " o)
(>! k o)
(recur))))
k))
(defn -main
[& args]
(let [c (chan)
words (chan)]
;(go-loop []
; (let [o (<! c)]
; (println o))
; (recur))
(ch c)
(word c)
)
)
UPDATE
And so I made a function that returns a chan of characters for 1 word. But I don’t understand how to combine this into 1 word

You can create chan with transducer which converts incoming characters to outgoing words.
(let [ch (async/chan 100 (comp
(partition-by (complement #{\space}))
(map #(apply str %))
(remove #{" "})))]
(doseq [c "Hello, world! "]
(async/>!! ch c))
(async/<!! (async/into [] (async/take 2 ch))))
=> ["Hello," "world!"]

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)))

Throttle Functions with core.async

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))}]

conj not adding to end of vector when called via recur

Why does this keep asking Jack if he wants a cup of tea and not the other fathers.
(defn tea-anyone
"Ask 'fathers' if they would like some tea"
[fathers]
(loop [asks 0 to-ask fathers]
(let [[father & others] to-ask]
(println (str "Cup of tea " father "? "))
(if (> asks 6)
(println (str father ": All right then!"))
(recur (inc asks) (conj others father))))))
(tea-anyone ["Jack" "Ted" "Dougle"])
Because others isn't a vector. See for yourself:
(let [[f & o :as a] [1 2 3 4]]
(println f)
(println o)
(println a)
(println (type f))
(println (type o))
(println (type a))
(println (type (conj o 5)))
(println (type (conj a 5))))
To achieve the effect you want, you could use cycle.
Try this:
(recur (inc asks) (conj (vec others) father))

Redirecting clojure's *out* to a core.async channel

I'm trying to make all print statements in a clojure program put their strings on a core.async channel. Is there a way I can do this?
(I'm trying to get cljsbuild to send its compiler messages to a frontend.)
(def is (java.io.PipedInputStream.))
(def os (java.io.PipedOutputStream. is))
(def channel (chan))
(.start (Thread. (fn []
(let [buffer (byte-array 1024)]
(while true
(let [n (.read is buffer 0 1024)]
(>!! channel (vec (take n buffer)))))))))
(binding [*out* (java.io.OutputStreamWriter. os)]
(println "Hello, world!"))
gfredericks gave me this reference in the #clojure irc. He recommended I adapt what nREPL does:
(defn- session-out
"Returns a PrintWriter suitable for binding as *out* or *err*. All of
the content written to that PrintWriter will (when .flush-ed) be sent on the
given transport in messages specifying the given session-id.
`channel-type` should be :out or :err, as appropriate."
[channel-type session-id transport]
(let [buf (clojure.tools.nrepl.StdOutBuffer.)]
(PrintWriter. (proxy [Writer] []
(close [] (.flush ^Writer this))
(write [& [x ^Integer off ^Integer len]]
(locking buf
(cond
(number? x) (.append buf (char x))
(not off) (.append buf x)
; the CharSequence overload of append takes an *end* idx, not length!
(instance? CharSequence x) (.append buf ^CharSequence x (int off) (int (+ len off)))
:else (.append buf ^chars x off len))
(when (<= *out-limit* (.length buf))
(.flush ^Writer this))))
(flush []
(let [text (locking buf (let [text (str buf)]
(.setLength buf 0)
text))]
(when (pos? (count text))
(t/send (or (:transport *msg*) transport)
(response-for *msg* :session session-id
channel-type text))))))
true)))
from nREPL source here

Simplify this monad expression

I'm working through some of my own examples after watching this tutorial: http://www.infoq.com/presentations/Why-is-a-Monad-Like-a-Writing-Desk and reading http://blog.sigfpe.com/2006/08/you-could-have-invented-monads-and.html.
I have come up with the following functions:
(defn unit [v s]
(fn [] [v s]))
(defn bind [mv f]
(f (mv)))
(defn inc+ [mv]
(bind
mv
(fn [[v s]]
(let [r (inc v)]
(unit r (apply str (concat s " inc+(" (str r) ")")))))))
(defn double+ [mv]
(bind
mv
(fn [[v s]]
(let [r (* 2 v)]
(unit r (apply str (concat s " double+(" (str r) ")")))))))
(defn triple+ [mv]
(bind
mv
(fn [[v s]]
(let [r (* 3 v)]
(unit r (apply str (concat s " triple+(" (str r) ")")))))))
;; Testing:
((-> (unit 1 "1 ->") inc+))
;; => [2 "1 -> inc+(2)"]
((-> (unit 3 "3 ->") inc+ double+ inc+))
;; => [27 "3 -> inc+(4) double+(8) inc+(9) triple+(27)"]
I wish to rewrite bind to encapsulate the patterns the methods inc+ double+ and triple+ and get the same output as before. How would this be done?
I figured it out in two stages:
(defn unit [v s]
(fn [] [v s]))
(defn bind [mv f]
(let [[iv is] (mv)
[av as] (f iv)]
(unit av (str is " " as))))
(defn inc+ [mv]
(bind
mv
(fn [v]
[(inc v) (str " inc+(" (inc v) ")")])))
(defn double+ [mv]
(bind
mv
(fn [v]
[(inc v) (str " double+(" (inc v) ")")])))
(defn triple+ [mv]
(bind
mv
(fn [v]
[(inc v) (str " triple+(" (inc v) ")")])))
then:
(defn unit [v s]
(fn [] [v s]))
(defn bind [mv f]
(let [[v s] (mv)
r (f v)
xs (->> (str (type f))
(re-find #"\$([^\$]*)\$?")
second) ]
(unit r (str s " " (str xs "(" r ")")))))
(defn inc+ [mv]
(bind mv inc))
(defn double+ [mv]
(bind mv #(* 2 %)))
(defn triple+ [mv]
(bind mv #(* 3 %)))
((-> (unit 3 "3 ->") inc+ double+ inc+ triple+))
;;=> [27 "3 -> inc_PLUS_(4) double_PLUS_(8) inc_PLUS_(9) triple_PLUS_(27)"]
So looking at other Monad tutorials, especially http://channel9.msdn.com/Shows/Going+Deep/Brian-Beckman-Dont-fear-the-Monads, I think I understand the core principles now. 'Monads' really is all about being able to reuse the functions we have on hand. unit and bind have to be designed to work together. Then, its almost quite trivial to compose together functions.
Then one more abstraction to write the do-m operator:
(defn unit [v s]
(fn [] [v s]))
(defn bind [mv f]
(let [[v s] (mv)
r (f v)
xs (->> (str (type f))
(re-find #"\$([^\$]*)\$?")
second) ]
(unit r (str s " " (str xs "(" r ")")))))
(defn double [v] (* 2 v))
(defn triple [v] (* 3 v))
(defn do-m [v & fs]
(let [fn-ms (map #(fn [mv] (bind mv %)) fs)]
(((apply comp (reverse fn-ms)) (unit v (str v "->"))))))
(do-m 3 inc double triple)
;;=> [24 "3 -> inc(4) double(8) triple(24)"]
This is another way to write achieve the same result, notice that the change was to take out the lambda function in unit and the associated calls for bind and do-m.
(defn unit [v s] [v s])
(defn bind [mv f]
(let [[v s] mv
r (f v)
xs (->> (str (type f))
(re-find #"\$([^\$]*)\$?")
second) ]
(unit r (str s " " (str xs "(" r ")")))))
(defn double [v] (* 2 v))
(defn triple [v] (* 3 v))
(defn sqrt [v] (Math/sqrt v))
(defn do-m [v & fs]
(let [fn-ms (map #(fn [mv] (bind mv %)) fs)]
((apply comp (reverse fn-ms)) (unit v (str v " ->")))))
(do-m 3 inc double double triple triple sqrt)
;; => [12.0 "3 -> inc(4) double(8) double(16) triple(48) triple(144) sqrt(12.0)"]