Диспетчеризация вызовов функций по разным форматам карт

Для этого можно использовать многократную отправку на основе примеров, как описано в этот пост в блоге. Это, безусловно, не самый эффективный способ решения этой проблемы, но, возможно, более гибкий, чем мультиметоды, поскольку он не требует, чтобы вы заранее объявляли метод диспетчеризации. Таким образом, он открыт для расширения любого представления данных, даже кроме карт. Если вам нужна производительность, то, как вы предлагаете, вероятно, подойдет несколько методов или протоколов.

Во-первых, вам нужно добавить зависимость от [bluebell/utils "1.5.0"] и потребовать [bluebell.utils.ebmd :as ebmd]. Затем вы объявляете конструкторы для своих структур данных (скопированные из вашего вопроса) и функции для проверки этих структур данных:

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

Теперь мы собираемся зарегистрировать эти структуры данных как так называемые arg-specs, чтобы мы могли использовать их для отправки:

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

Для каждой спецификации arg нам нужно объявить несколько примерных значений в ключе :pos и несколько не-примеров в ключе :neg. Эти значения используются для устранения того факта, что directed-bacterium является более конкретным, чем просто bacterium, чтобы отправка работала правильно.

Наконец, мы собираемся определить полиморфную функцию take-turn. Сначала мы объявляем его, используя declare-poly:

(ebmd/declare-poly take-turn)

И затем мы можем предоставить разные реализации для конкретных аргументов:

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

Здесь ::ebmd/any-arg — это спецификация аргумента, которая соответствует любому аргументу. Приведенный выше подход открыт для расширения, как и мультиметоды, но не требует объявления поля :type заранее и, таким образом, является более гибким. Но, как я уже сказал, он также будет медленнее, чем мультиметоды и протоколы, так что в конечном итоге это компромисс.

Вот полное решение: https://github.com/jonasseglare/bluebell-utils/blob/archive/2018-11-16-002/test/bluebell/utils/ebmd/bacteria_test.clj

Отправка мультиметода по полю :type на самом деле является полиморфной отправкой, которую можно выполнить с помощью протокола, но использование нескольких методов позволяет отправлять по разным полям. Вы можете добавить второй мультиметод, который выполняет диспетчеризацию по чему-то другому, кроме :type, что может быть сложно реализовать с помощью протокола (или даже нескольких протоколов).

Поскольку мультиметод может выполнять отправку чего угодно, вы можете использовать набор в качестве значения отправки. Вот альтернативный подход. Он не является полностью расширяемым, поскольку ключи для выбора определяются в функции диспетчеризации, но это может дать вам представление о лучшем решении:

(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!"))

Быстрые пути существуют по какой-то причине, но Clojure не мешает вам делать все, что вы хотите, например, включая отправку предикатов ad hoc. Мир, безусловно, ваша устрица. Обратите внимание на этот очень быстрый и грязный пример ниже.

Во-первых, мы начнем с атома для хранения всех наших полиморфных функций:

(def polies (atom {}))

При использовании внутренняя структура polies будет выглядеть примерно так:

{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}}}}

Теперь давайте сделаем так, чтобы мы могли использовать предикаты prefer (например, 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)

Теперь давайте создадим нашу систему поиска отправки:

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

Далее давайте подготовим наш макрос определения с некоторыми функциями инициализации и настройки:

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

Теперь мы можем, наконец, построить наши полигоны, втирая в них немного макросока:

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

Теперь вы можете построить произвольную отправку предиката:

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

И на вашем примере мы видим:

(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

Теперь давайте попробуем использовать отношения isa?, а-ля 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

И, конечно же, мы можем использовать prefer для устранения неоднозначности отношений:

(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

Опять же, весь мир в ваших руках! Ничто не мешает вам расширять язык в любом направлении.