In Clojure how can I pass multiple arguments to a defmethod? - clojure

I wish to create a multi method which I call like this:
(defmethod some-method "some value"
[ a b ]
b)
: but which selects the function based only on the first paramter 'a'. How can I do this:
(defmulti some-method
WHAT GOES HERE?)

I didn't completely understand your question, but I think you want to
dispatch only on one argument. You can do that like this, I think:
user=> (defmulti even-or-odd (fn [x _] (even? x)))
#'user/even-or-odd
user=> (defmethod even-or-odd true [a _] :even)
#<MultiFn clojure.lang.MultiFn#293bdd36>
user=> (defmethod even-or-odd false [a _] :odd)
#<MultiFn clojure.lang.MultiFn#293bdd36>
user=> (even-or-odd 2 3)
:even
user=> (even-or-odd 3 3)
:odd
user=>

Do you mean select the function based on the value of a?
Then you just need
(defmulti some-method (fn [a b] a))

Related

fn and let inside clojure macro

I'm running into some limitations of Clojure macros. I wonder how to optimize the following code?
(defmacro ssplit-7-inefficient [x]
(let [t 7]
;; Duplicated computation here!
`(do [(first (split-with #(not (= '~t %)) '~x))
(drop 1 (second (split-with #(not (= '~t %)) '~x)))])))
(ssplit-7-inefficient (foo 7 bar baz))
;; Returns: [(foo) (bar baz)]
Here are some approaches that don't work:
(defmacro ssplit-7-fails [x]
(let [t 7]
`(do ((fn [[a b]] [a (drop 1 b)]) (split-with #(not (= '~t %)) '~x)))))
(ssplit-7-fails (foo 7 bar baz))
;; Error: Call to clojure.core/fn did not conform to spec.
(defmacro ssplit-7-fails-again [x]
(let [t 7]
`(do
(let [data (split-with #(not (= '~t %)) '~x)]
((fn [[a b]] [a (drop 1 b)]) data)))))
(ssplit-7-fails-again (foo 7 bar baz))
;; Error: Call to clojure.core/let did not conform to spec.
Note that split-with splits only once. You can use some destructuring to get what you want:
(defmacro split-by-7 [arg]
`((fn [[x# [_# & z#]]] [x# z#]) (split-with (complement #{7}) '~arg)))
(split-by-7 (foo 7 bar baz))
=> [(foo) (bar baz)]
In other use cases, partition-by can be also useful:
(defmacro split-by-7 [arg]
`(->> (partition-by #{7} '~arg)
(remove #{[7]})))
(split-by-7 (foo 7 bar baz))
=> ((foo) (bar baz))
It is not so easy to reason about macros in Clojure - (in my view macroexpand-1 alienates the code a lot - in contrast to Common Lisp's macroexpand-1 ...).
My way was first to build a helper function.
(defn %split-7 [x]
(let [y 7]
(let [[a b] (split-with #(not= y %) x)]
[a (drop 1 b)])))
This function uses destructuring so that the split-with is "efficient".
It does nearly exactly what the macro should do. Just that one has to quote
the argument - so that it works.
(%split-7 '(a 7 b c))
;;=> [(a) (b c)]
From this step to the macro is not difficult.
The macro should just automatically quote the argument when inserting into the helper function's call.
(defmacro split-7 [x]
`(%split-7 '~x))
So that we can call:
(split-7 (a 7 b c))
;; => [(a) (b c)]
Using this trick, even generalize the function to:
(defn %split-by [x y]able like this
(let [[a b] (split-with #(not= y %) x)]
[a (drop 1 b)]))
(defmacro split-by [x y]
`(%split-by '~x ~y))
(split-by (a 7 b c) 7)
;; => [(a) (b c)]
(split-by (a 7 b c 9 d e) 9)
;; => [(a 7 b c) (d e)]
The use of (helper) functions in the macro body - and even other macros - or recursive functions or recursive macros - macros which call other macros - shows how powerful lisp macros are. Because it shows that you can use the entirety of lisp when formulating/defining macros. Something what most language's macros usually aren't able to do.

Dispatching function calls on different formats of maps

I'm writing an agar.io clone. I've lately seen a lot of suggestions to limit use of records (like here), so I'm trying to do the whole project only using basic maps.*
I ended up creating constructors for different "types" of bacteria like
(defn new-bacterium [starting-position]
{:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
The "directed bacterium" has a new entry added to it. The :direction entry will be used to remember what direction it was heading in.
Here's the problem: I want to have one function take-turn that accepts the bacterium and the current state of the world, and returns a vector of [x, y] indicating the offset from the current position to move the bacterium to. I want to have a single function that's called because I can think right now of at least three kinds of bacteria that I'll want to have, and would like to have the ability to add new types later that each define their own take-turn.
A Can-Take-Turn protocol is out the window since I'm just using plain maps.
A take-turn multimethod seemed like it would work at first, but then I realized that I'd have no dispatch values to use in my current setup that would be extensible. I could have :direction be the dispatch function, and then dispatch on nil to use the "directed bacterium"'s take-turn, or default to get the base aimless behavior, but that doesn't give me a way of even having a third "player bacterium" type.
The only solution I can think of it to require that all bacterium have a :type field, and to dispatch on it, like:
(defn new-bacterium [starting-position]
{:type :aimless
:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :type :directed,
:direction starting-directions)))
(defmulti take-turn (fn [b _] (:type b)))
(defmethod take-turn :aimless [this world]
(println "Aimless turn!"))
(defmethod take-turn :directed [this world]
(println "Directed turn!"))
(take-turn (new-bacterium [0 0]) nil)
Aimless turn!
=> nil
(take-turn (new-directed-bacterium [0 0] nil) nil)
Directed turn!
=> nil
But now I'm back to basically dispatching on type, using a slower method than protocols. Is this a legitimate case to use records and protocols, or is there something about mutlimethods that I'm missing? I don't have a lot of practice with them.
* I also decided to try this because I was in the situation where I had a Bacterium record and wanted to create a new "directed" version of the record that had a single field direction added to it (inheritance basically). The original record implemented protocols though, and I didn't want to have to do something like nesting the original record in the new one, and routing all behavior to the nested instance. Every time I created a new type or changed a protocol, I would have to change all the routing, which was a lot of work.
You can use example-based multiple dispatch for this, as explained in this blog post. It is certainly not the most performant way to solve this problem, but arguably more flexible than multi-methods as it does not require you to declare a dispatch-method upfront. So it is open for extension to any data representation, even other things than maps. If you need performance, then multi-methods or protocols as you suggest, is probably the way to go.
First, you need to add a dependency on [bluebell/utils "1.5.0"] and require [bluebell.utils.ebmd :as ebmd]. Then you declare constructors for your data structures (copied from your question) and functions to test those data strucutres:
(defn new-bacterium [starting-position]
{:mass 0
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
(defn bacterium? [x]
(and (map? x)
(contains? x :position)))
(defn directed-bacterium? [x]
(and (bacterium? x)
(contains? x :direction)))
Now we are going to register those datastructures as so called arg-specs so that we can use them for dispatch:
(ebmd/def-arg-spec ::bacterium {:pred bacterium?
:pos [(new-bacterium [9 8])]
:neg [3 4]})
(ebmd/def-arg-spec ::directed-bacterium {:pred directed-bacterium?
:pos [(new-directed-bacterium [9 8] [3 4])]
:neg [(new-bacterium [3 4])]})
For each arg-spec, we need to declare a few example values under the :pos key, and a few non-examples under the :neg key. Those values are used to resolve the fact that a directed-bacterium is more specific than just a bacterium in order for the dispatch to work properly.
Finally, we are going to define a polymorphic take-turn function. We first declare it, using declare-poly:
(ebmd/declare-poly take-turn)
And then, we can provide different implementations for specific arguments:
(ebmd/def-poly take-turn [::bacterium x
::ebmd/any-arg world]
:aimless)
(ebmd/def-poly take-turn [::directed-bacterium x
::ebmd/any-arg world]
:directed)
Here, the ::ebmd/any-arg is an arg-spec that matches any argument. The above approach is open to extension just like multi-methods, but does not require you to declare a :type field upfront and is thus more flexible. But, as I said, it is also going to be slower than both multimethods and protocols, so ultimately this is a trade-off.
Here is the full solution: https://github.com/jonasseglare/bluebell-utils/blob/archive/2018-11-16-002/test/bluebell/utils/ebmd/bacteria_test.clj
Dispatching a multimethod by a :type field is indeed polymorphic dispatch that could be done with a protocol, but using multimethods allows you to dispatch on different fields. You can add a second multimethod that dispatches on something other than :type, which might be tricky to accomplish with a protocol (or even multiple protocols).
Since a multimethod can dispatch on anything, you could use a set as the dispatch value. Here's an alternative approach. It's not fully extensible, since the keys to select are determined within the dispatch function, but it might give you an idea for a better solution:
(defmulti take-turn (fn [b _] (clojure.set/intersection #{:direction} (set (keys b)))))
(defmethod take-turn #{} [this world]
(println "Aimless turn!"))
(defmethod take-turn #{:direction} [this world]
(println "Directed turn!"))
Fast paths exist for a reason, but Clojure doesn't stop you from doing anything you want to do, per say, including ad hoc predicate dispatch. The world is definitely your oyster. Observe this super quick and dirty example below.
First, we'll start off with an atom to store all of our polymorphic functions:
(def polies (atom {}))
In usage, the internal structure of the polies would look something like this:
{foo ; <- function name
{:dispatch [[pred0 fn0 1 ()] ; <- if (pred0 args) do (fn0 args)
[pred1 fn1 1 ()]
[pred2 fn2 2 '&]]
:prefer {:this-pred #{:that-pred :other-pred}}}
bar
{:dispatch [[pred0 fn0 1 ()]
[pred1 fn1 3 ()]]
:prefer {:some-pred #{:any-pred}}}}
Now, let's make it so that we can prefer predicates (like prefer-method):
(defn- get-parent [pfn x] (->> (parents x) (filter pfn) first))
(defn- in-this-or-parent-prefs? [poly v1 v2 f1 f2]
(if-let [p (-> #polies (get-in [poly :prefer v1]))]
(or (contains? p v2) (get-parent f1 v2) (get-parent f2 v1))))
(defn- default-sort [v1 v2]
(if (= v1 :poly/default)
1
(if (= v2 :poly/default)
-1
0)))
(defn- pref [poly v1 v2]
(if (-> poly (in-this-or-parent-prefs? v1 v2 #(pref poly v1 %) #(pref poly % v2)))
-1
(default-sort v1 v2)))
(defn- sort-disp [poly]
(swap! polies update-in [poly :dispatch] #(->> % (sort-by first (partial pref poly)) vec)))
(defn prefer [poly v1 v2]
(swap! polies update-in [poly :prefer v1] #(-> % (or #{}) (conj v2)))
(sort-disp poly)
nil)
Now, let's create our dispatch lookup system:
(defn- get-disp [poly filter-fn]
(-> #polies (get-in [poly :dispatch]) (->> (filter filter-fn)) first))
(defn- pred->disp [poly pred]
(get-disp poly #(-> % first (= pred))))
(defn- pred->poly-fn [poly pred]
(-> poly (pred->disp pred) second))
(defn- check-args-length [disp args]
((if (= '& (-> disp (nth 3) first)) >= =) (count args) (nth disp 2)))
(defn- args-are? [disp args]
(or (isa? (vec args) (first disp)) (isa? (mapv class args) (first disp))))
(defn- check-dispatch-on-args [disp args]
(if (-> disp first vector?)
(-> disp (args-are? args))
(-> disp first (apply args))))
(defn- disp*args? [disp args]
(and (check-args-length disp args)
(check-dispatch-on-args disp args)))
(defn- args->poly-fn [poly args]
(-> poly (get-disp #(disp*args? % args)) second))
Next, let's prepare our define macro with some initialization and setup functions:
(defn- poly-impl [poly args]
(if-let [poly-fn (-> poly (args->poly-fn args))]
(-> poly-fn (apply args))
(if-let [default-poly-fn (-> poly (pred->poly-fn :poly/default))]
(-> default-poly-fn (apply args))
(throw (ex-info (str "No poly for " poly " with " args) {})))))
(defn- remove-disp [poly pred]
(when-let [disp (pred->disp poly pred)]
(swap! polies update-in [poly :dispatch] #(->> % (remove #{disp}) vec))))
(defn- til& [args]
(count (take-while (partial not= '&) args)))
(defn- add-disp [poly poly-fn pred params]
(swap! polies update-in [poly :dispatch]
#(-> % (or []) (conj [pred poly-fn (til& params) (filter #{'&} params)]))))
(defn- setup-poly [poly poly-fn pred params]
(remove-disp poly pred)
(add-disp poly poly-fn pred params)
(sort-disp poly))
With that, we can finally build our polies by rubbing some macro juice on there:
(defmacro defpoly [poly-name pred params body]
`(do (when-not (-> ~poly-name quote resolve bound?)
(defn ~poly-name [& args#] (poly-impl ~poly-name args#)))
(let [poly-fn# (fn ~(symbol (str poly-name "-poly")) ~params ~body)]
(setup-poly ~poly-name poly-fn# ~pred (quote ~params)))
~poly-name))
Now you can build arbitrary predicate dispatch:
;; use defpoly like defmethod, but without a defmulti declaration
;; unlike defmethods, all params are passed to defpoly's predicate function
(defpoly myinc number? [x] (inc x))
(myinc 1)
;#_=> 2
(myinc "1")
;#_=> Execution error (ExceptionInfo) at user$poly_impl/invokeStatic (REPL:6).
;No poly for user$eval187$myinc__188#5c8eee0f with ("1")
(defpoly myinc :poly/default [x] (inc x))
(myinc "1")
;#_=> Execution error (ClassCastException) at user$eval245$fn__246/invoke (REPL:1).
;java.lang.String cannot be cast to java.lang.Number
(defpoly myinc string? [x] (inc (read-string x)))
(myinc "1")
;#_=> 2
(defpoly myinc
#(and (number? %1) (number? %2) (->> %& (filter (complement number?)) empty?))
[x y & z]
(inc (apply + x y z)))
(myinc 1 2 3)
;#_=> 7
(myinc 1 2 3 "4")
;#_=> Execution error (ArityException) at user$poly_impl/invokeStatic (REPL:5).
;Wrong number of args (4) passed to: user/eval523/fn--524
; ^ took the :poly/default path
And when using your example, we can see:
(defn new-bacterium [starting-position]
{:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
(defpoly take-turn (fn [b _] (-> b keys set (contains? :direction)))
[this world]
(println "Directed turn!"))
;; or, if you'd rather use spec
(defpoly take-turn (fn [b _] (->> b (s/valid? (s/keys :req-un [::direction])))
[this world]
(println "Directed turn!"))
(take-turn (new-directed-bacterium [0 0] nil) nil)
;#_=> Directed turn!
;nil
(defpoly take-turn :poly/default [this world]
(println "Aimless turn!"))
(take-turn (new-bacterium [0 0]) nil)
;#_=> Aimless turn!
;nil
(defpoly take-turn #(-> %& first :show) [this world]
(println :this this :world world))
(take-turn (assoc (new-bacterium [0 0]) :show true) nil)
;#_=> :this {:mass 0, :position [0 0], :show true} :world nil
;nil
Now, let's try using isa? relationships, a la defmulti:
(derive java.util.Map ::collection)
(derive java.util.Collection ::collection)
;; always wrap classes in a vector to dispatch off of isa? relationships
(defpoly foo [::collection] [c] :a-collection)
(defpoly foo [String] [s] :a-string)
(foo [])
;#_=> :a-collection
(foo "bob")
;#_=> :a-string
And of course we can use prefer to disambiguate relationships:
(derive ::rect ::shape)
(defpoly bar [::rect ::shape] [x y] :rect-shape)
(defpoly bar [::shape ::rect] [x y] :shape-rect)
(bar ::rect ::rect)
;#_=> :rect-shape
(prefer bar [::shape ::rect] [::rect ::shape])
(bar ::rect ::rect)
;#_=> :shape-rect
Again, the world's your oyster! There's nothing stopping you from extending the language in any direction you want.

How can I use with-redefs to mock multiple calls to the same function?

I would like to be able to mock MyFunction however I need the mock to return different values when MyFunction is called.
Is it possible to use with-redefs to return different values based on the call order of a function?
(testing "POST /foo/bar and return ok"
(with-redefs [->Baz (fn [_]
(reify MyProtocol (MyFunction [_] [{:something 1}]))
(reify MyProtocol (MyFunction [_] [{:something 2}])))]
(let [response (routes/foo {:request-method :post
:uri "/foo/bar"
:query-params {}
})]
(is (= (:status response) 200)))))
You could use a mutable collection of the return values, then return/remove values from it on each call.
(defn foo [x] (inc x)) ;; example fn to be mocked
If you wanted to mock three calls to foo returning 1, 2, and 3 respectively:
(with-redefs [foo (let [results (atom [1 2 3])]
(fn [_] (ffirst (swap-vals! results rest))))]
(prn (foo 0))
(prn (foo 0))
(prn (foo 0))
;; additional calls would return nil
(prn (foo 0)))
;; 1
;; 2
;; 3
;; nil
That uses swap-vals! to get the old/new values of the atom, but requires Clojure 1.9 or greater.
If you don't have swap-vals! you could do it (less atomically) like this:
(with-redefs [foo (let [results (atom [1 2 3])]
(fn [_]
(let [result (first #results)]
(swap! results rest)
result)))]
...)
We use Picomock for this, and to assert on the parameters for each call, and to assert on the number of calls. Recommended!

Combining methods in Clojure

Suppose we have a multimethod foo. It has several realizations. Let's say that one of them is called when argument of foo is a string that contains character \r and another is executed when argument of foo is a string containing character \!. Pseudocode:
(defmulti foo ???) ; can't come up with function..
(defmethod foo \r [_]
(println "one"))
(defmethod foo \! [_]
(println "two"))
So when we call our function like this:
(foo "right!") ;; desired output:
one
two
;; => nil
Important thing here is that list of supported methods should be not rigid, but expandable, so new methods can be added later without touching the original code.
Although I improved my Clojure skill significantly in last few days, I still lack experience. My best idea is to keep a map with pairs 'character - function' and then manually traverse it and execute right functions. In this case I will also need some interface to register new functions, etc. What is idiomatic solution?
I think multimethods don't work the way you expect them to work.
That is: the dispatch in multimethods is called only once for a single multimethod call, so there's no way of getting the result you expect (both 'one' and 'two' printed for "right!" as argument) unless you define one implementation that actually handles the case of having both \r and \! in the input string and prints the output you want.
This will not be easily expandable.
Nicer way to achieve what you want is to make multiple calls explicitly by iterating the input string:
; You want the dispatch function to just return the character passed to it.
(defmulti foo identity)
; The argument list here is mandatory, but we don't use them at all, hence '_'
(defmethod foo \r [_]
(println "one"))
(defmethod foo \! [_]
(println "two"))
; You need the default case for all the other characters
(defmethod foo :default [_]
())
; Iterates the string and executes foo for each character
(defn bar [s]
(doseq [x s]
(foo x)))
so calling
(bar "right!")
will print:
one
two
Edit
If you need to access the whole string inside the multimethod body, then pass it explicitly together with the character:
; You want the dispatch function to just return the character passed to it as the first arg.
(defmulti foo (fn [c _] c))
(defmethod foo \r [c s]
(println "one"))
(defmethod foo \! [c s]
(println "two"))
; The default now takes two arguments which we ignore
(defmethod foo :default [_ _] ())
; Iterates the string and executes foo for each character
(defn bar [s]
(doseq [x s]
(foo x s)))
A plain list of functions would allow arbitrary conditionals. Also Regexs may make your life simpler if you are dealing with strings:
;; start with some functions
(defn on-r [x]
(when (re-find #"r" x)
"one"))
(defn on-! [x]
(when (re-find #"!" x)
"two"))
(def fns (atom [on-r on-!]))
;; call all functions on some value
(keep #(% "right!") #fns)
=> ("one" "two")
(keep #(% "aaaa") #fns)
=> ()
;; later add more functions
(defn on-three [x]
(when (= 3 (count x))
"three"))
(swap! fns conj on-three)
(keep #(% "bar") #fns)
=> ("one" "three")
;; or just use different rules altogether
(def other-fns [#(when (rand-nth [true false])
(str % (rand-int 10)))
#(when (nil? %) "nil")])
(keep #(% nil) other-fns)
=> ("3" "nil")

How to set default values for fields in records in Clojure?

I am creating records in Clojure and would like to set some fields up with a default value. How can I do this?
Use a constructor function.
(defrecord Foo [a b c])
(defn make-foo
[& {:keys [a b c] :or {a 5 c 7}}]
(Foo. a b c))
(make-foo :b 6)
(make-foo :b 6 :a 8)
Of course there are various variations. You could for example require certain fields to be non-optional and without a default.
(defn make-foo
[b & {:keys [a c] :or {a 5 c 7}}]
(Foo. a b c))
(make-foo 6)
(make-foo 6 :a 8)
YMMV.
You can pass initial values to a record pretty easily when you construct it though an extension map:
(defrecord Foo [])
(def foo (Foo. nil {:bar 1 :baz 2}))
In light of this, I usually create a constructor function that merges in some default values (which you can override as you want):
(defn make-foo [values-map]
(let [default-values {:bar 1 :baz 2}]
(Foo. nil (merge default-values values-map))))
(make-foo {:fiz 3 :bar 8})
=> #:user.Foo{:fiz 3, :bar 8, :baz 2}
After having the same question, I ended up wrapping the defrecord and the factory function up into a single definition using a macro.
The macro:
(defmacro make-model
[name args & body]
(let [defaults (if (map? (first body)) (first body) {})
constructor-name (str/lower-case (str "make-" name))]
`(do (defrecord ~name ~args ~#(if (map? (first body)) (rest body) body))
(defn ~(symbol constructor-name)
([] (~(symbol constructor-name) {}))
([values#] (~(symbol (str "map->" name)) (merge ~defaults values#)))))))
Usage
(make-model User [firstName lastName] {:lastName "Smith"})
=> #'user/make-user
(make-user {:firstName "John"})
=> #user.User{:firstName "John", :lastName "Smith"}