Secret santa

frivolous-secret-santa.clj

(defn- rand-🎁
  [🎅 🎁-pool exclusions]
  (let [potential-🎁 (-> 🎁-pool
                        (disj 🎅)
                        (set/difference (get exclusions 🎅)))]
    (first (shuffle potential-🎁))))

(defn frivolously-draw-secret-santa
  "Tries to randomize 🎅s hoping that with power of Christmas everything will just work.
  Will give up after some retrials."
  ([names]
   (frivolously-draw-secret-santa names {}))
  ([names exclusions]
   (frivolously-draw-secret-santa names exclusions 1))
  ([names exclusions attempt]
   {:pre [(s/valid? ::names names)
          (s/valid? ::exclusions exclusions)
          (s/valid? ::attempt attempt)]}
   (let [result (reduce
                  (fn [acc 🎅]
                    (let [🎁 (rand-🎁 🎅 (get acc :🎁-pool) exclusions)]
                      (-> acc
                          (update :🎁-pool disj 🎁)
                          (update :🎅s assoc 🎅 🎁))))
                  {:🎁-pool names
                   :🎅s {}}
                  names)
         🎅s (get result :🎅s)]
     (if (some #(nil? (val %)) 🎅s)
       (do
         (println "Some 🎅 drew themselves. Retrying...")
         (if (> attempt 10)
           (frivolously-draw-secret-santa names exclusions (inc attempt))
           (throw (Exception. "Couldn't find a solution in 10 retrials. Giving up."))))
       🎅s))))

serious-secret-santa.clj

(defn- gen-santa-tree
  [names exclusions]
  (let [start {:🎅->🎁 {}
               :available-🎁 names}]
    (tree-seq
      (fn [x]
        (and (get x :🎅->🎁)
             (get x :available-🎁)))
      (fn [{:keys [available-🎁 🎅->🎁] :as node}]
        (let [available-🎅 (set/difference names (set (keys 🎅->🎁)))]
          (let [new-children
                (reduce (fn [acc 🎅]
                          (let [available-🎁 (set/difference
                                              (disj available-🎁 🎅)
                                              (get exclusions 🎅))
                                children-for-🎅 (map (fn [🎁]
                                                      (-> node
                                                          (update :🎅->🎁 assoc 🎅 🎁)
                                                          (update :available-🎁 disj 🎁)))
                                                    available-🎁)]
                            (concat acc children-for-🎅)))
                        []
                        available-🎅)]
            new-children)))
      start)))

(defn seriously-draw-secret-santa
  "Christmas is serious business. Builds a tree of possible solutions and randomly chooses a valid one."
  ([names]
   (seriously-draw-secret-santa names {}))
  ([names exclusions]
   {:pre [(s/valid? ::names names)
          (s/valid? ::exclusions exclusions)]}
   (let [possible-solutions (->>
                              (gen-santa-tree names exclusions)
                              (filter #(empty? (:available-🎁 %))))]
     (if (seq possible-solutions)
       (-> possible-solutions
           rand-nth
           (get :🎅->🎁))
       (throw (Exception. "Solution doesn't exist! Check your exclusions"))))))

spec.clj

(s/def ::names (s/and set?
                      (s/coll-of string? :min-count 2)))

(s/def ::exclusions (s/map-of string?
                              (s/and set?
                                     (s/coll-of string?))))

(s/def ::attempt int?)

(frivolously-draw-secret-santa #{"a" "b" "c"} {"a" #{"b" "c"}})
Some 🎅 drew themselves. Retrying...
Execution error at local/frivolously-draw-secret-santa (local.clj:238).
Couldn't find a solution in 10 retrials. Giving up.

(seriously-draw-secret-santa #{"a" "b" "c"} {"a" #{"b" "c"}})
Execution error at local/seriously-draw-secret-santa (local.clj:279).
Solution doesn't exist! Check your exclusions

(frivolously-draw-secret-santa #{"a" "b" "c"} {"a" #{"b"}})
=> {"a" "c", "b" "a", "c" "b"}

(seriously-draw-secret-santa #{"a" "b" "c"} {"a" #{"b"}})
=> {"a" "c", "b" "a", "c" "b"}