Skip to content

Instantly share code, notes, and snippets.

@Hendekagon
Last active July 2, 2020 16:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Hendekagon/80d94f9d64e13857ece9d6004adf77d7 to your computer and use it in GitHub Desktop.
Save Hendekagon/80d94f9d64e13857ece9d6004adf77d7 to your computer and use it in GitHub Desktop.
I needed to dispatch on sets with multimethods, here's how I did it
(ns mms
(:require
[clojure.math.combinatorics :as x]
[clojure.set :as set]))
(defn derive-set
"
A copy of derive for sets
"
([h a-set parent-set]
(assert (not= a-set parent-set))
(let [tp (:parents h)
td (:descendants h)
ta (:ancestors h)
tf (fn [m source sources target targets]
(reduce (fn [ret k]
(assoc ret k
(reduce conj (get targets k #{}) (cons target (targets target)))))
m (cons source (sources source))))]
(or
(when-not (contains? (tp a-set) parent-set)
(when (contains? (ta a-set) parent-set)
(throw (#?(:cljs (js/Error.) :clj (Exception.)) (str a-set "already has" parent-set "as ancestor"))))
(when (contains? (ta parent-set) a-set)
(throw (#?(:cljs (js/Error.) :clj (Exception.)) (str "Cyclic derivation:" parent-set "has" a-set "as ancestor"))))
{:parents (assoc (:parents h) a-set (conj (get tp a-set #{}) parent-set))
:ancestors (tf (:ancestors h) a-set td parent-set ta)
:descendants (tf (:descendants h) parent-set ta a-set td)})
h))))
(defn project-sets
[h subset-elements target-set]
(reduce
(fn [h s]
(derive-set h s target-set))
h (map (partial into target-set) (rest (x/subsets subset-elements)))))
(defn make-set-hierarchy []
(-> (make-hierarchy)
(derive-set #{:x :y :z} #{:y})
(project-sets [:a :b :c :d] #{:e})
(project-sets [:a :b :d] #{:f :c})))
(defmulti dispatch identity
:hierarchy (atom (make-set-hierarchy)))
(defmethod dispatch :default [x] #{})
(defmethod dispatch #{:e} [x] #{:e})
(defmethod dispatch #{:y} [x] #{:y})
(defmethod dispatch #{:f :c} [x] #{:f :c})
(defmethod dispatch #{:x :y} [x] #{:x :y})
(defmethod dispatch #{:a :b} [x] #{:a :b})
@Hendekagon
Copy link
Author

Hendekagon commented Jun 25, 2020

This allows for dispatch on sets, with the option to project onto smaller sets:

(map dispatch (reductions conj #{:e} [:a :b :c :d]))
=> (#{:e} #{:e} #{:e} #{:e} #{:e})

(dispatch #{:a :b :c :d :f})
=> #{:c :f}

(dispatch #{:x :y :z})
=> #{:y}

I found this useful for building a UI where one wants to display elements conditional on various combinations of states the data might be in, where the display of those elements isn't always additive in those states and where the order of the states doesn't matter, only their combination.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment