Question

我正在编写agar.io克隆。我最近看到了很多限制记录使用的建议（例如here），因此我试图仅使用基本地图来完成整个项目。*

我最终为诸如细菌的不同“类型”创建了构造函数

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

“定向细菌”已添加新条目。 :direction条目将用于记住其前进的方向。

这是问题：我想拥有一个一个函数take-turn，该函数接受细菌和世界的当前状态，并返回{ {1}}指示将细菌移到当前位置的偏移量。我想要一个被调用的函数，因为我现在可以想到至少要有的三种细菌，并且希望以后可以添加新类型的细菌。每个人都定义自己的[x, y]。

take-turn协议不在我的视野范围内，因为我只是在使用普通地图。

一个Can-Take-Turn多重方法似乎一开始就可以工作，但是后来我意识到我没有可在当前设置中使用的调度值。我可以将take-turn用作调度函数，然后在:direction上调度以使用“定向细菌”的nil，或者默认为获得基本的无目的行为，但这没有实现。不能给我提供第三种“玩家细菌”类型的方法。

我能想到的唯一解决方案是要求所有细菌都具有take-turn字段，并对其进行调度，例如：

:type

但是，现在我回到使用类型比协议慢的方法上的基本分派类型上。这是使用记录和协议的合理案例，还是我缺少的关于多种方法的东西？我对他们没有太多练习。

(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我也决定尝试此操作，因为当时我有一个*记录，并且想要创建一个具有单个字段{{ 1}}添加到它（基本上是继承）。尽管原始记录实现了协议，但我不想做诸如将原始记录嵌套在新记录中，然后将所有行为路由到嵌套实例的操作。每次创建新类型或更改协议时，都必须更改所有路由，这是很多工作。

Answer 1

为此，您可以使用基于基于示例的多次调度，如this blog post中所述。当然，这不是解决此问题的最有效方法，但可以说它比多方法更灵活，因为它不需要您预先声明调度方法。因此，它可以扩展任何数据表示形式，甚至可以扩展到地图以外的其他形式。如果您需要性能，那么建议的多方法或协议可能是可行的方法。

首先，您需要添加对[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-spec，我们需要在: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是一个与任何参数匹配的arg-spec。上面的方法像多种方法一样可以扩展，但是不需要您预先声明:type字段，因此更加灵活。但是，正如我所说，它也将比多方法和协议都要慢，所以最终这是一个权衡。

这是完整的解决方案：https://github.com/jonasseglare/bluebell-utils/blob/archive/2018-11-16-002/test/bluebell/utils/ebmd/bacteria_test.clj

Answer 2

通过:type字段调度多方法确实是可以通过协议完成的多态调度，但是使用多方法可以使您在不同字段上调度。您可以添加第二个多方法，该方法可以在:type以外的其他对象上调度，而要用一个协议（甚至是多个协议）来完成可能很难。

由于多方法可以对任何对象进行调度，因此可以将set作为调度值。这是另一种方法。它不是完全可扩展的，因为要选择的键是在调度功能中确定的，但是它可能会为您提供一个更好的解决方案：

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

Answer 3

快速路径的存在是有原因的，但是Clojure并不能阻止您做任何您想做的事情，包括临时谓词派发。世界绝对是您的牡蛎。观察下面的这个超级快速和肮脏的例子。

首先，我们将从一个原子开始以存储我们所有的多态函数：

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

接下来，让我们使用一些初始化和设置功能来准备我们的define宏：

(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

再次，世界就是您的牡蛎！没有什么可以阻止您将语言扩展到您想要的任何方向。

在不同格式的地图上调度函数调用

3 个答案: