Or: Writing Goals with Pattern Matching

I’d been looking for an excuse to use core.logic for something, and I finally created an opportunity when I wrote a Secret Santa picker.

(Familiarize yourself with this primer for background on how core.logic works and looks.)

Zipping lists

At the end of running a Secret Santa program, you effectively want a map of the people involved to the people they’re giving gifts to. Unfortunately, working with maps isn’t straightforward in core.logic, but lists are. I figured I’d take a list of participants and a list of recipients and zip them together.

1
2
3
4
5
6
7

(defne zipo
  "zipped is zipped pairs of xl and yl"
  [xl yl zipped]
  ([() () ()])
  ([[x . xs] [y . ys] [z . zs]]
     (== z [x y])
     (zipo xs ys zs)))

Like conso, firsto, and resto, this is a goal, so the “result” of zipping the first two arguments must be supplied as well.

In the first case (line 4), we’re saying that two empty lists zipped together is the empty list. In the second case (line 5), we destructure the lists into their heads and tails, saying that the head (z) is the vector [x y], and that the tails have the same zipped relationship.

I find that running goals on non-grounded vars can be illuminating:

1
2
3
4
5

(run 4 [q] (fresh [a b] (zipo a b q)))
;; => (()
;;     ([_.0 _.1])
;;     ([_.0 _.1] [_.2 _.3])
;;     ([_.0 _.1] [_.2 _.3] [_.4 _.5]))

But here are some regular sanity checks:

1
2
3
4

(run* [q] (zipo '(1 2 3) '(a b c) q))
;; => (([1 a] [2 b] [3 c]))
(run* [q] (zipo q '(a b c) '([1 a] [2 b] [3 c])))
;; => ((1 2 3))

That’s working. It zips, or unzips, depending on where you query.

Preventing someone from buying their own gift

We can’t just take our list of names, generate a permutation of them (with permuteo) and zip those together:

1
2
3
4
5
6
7
8
9
10
11
12

(def names ["Chris" "Christine" "Russell" "Marie" "Sumeet" "Harish"])

(run 1 [q]
  (fresh [recipients]
    (permuteo names recipients)
    (zipo names recipients q)))
;; => ((["Chris" "Chris"]
;;      ["Christine" "Christine"]
;;      ["Russell" "Russell"]
;;      ["Marie" "Marie"]
;;      ["Sumeet" "Sumeet"]
;;      ["Harish" "Harish"]))

Everyone’s buying for themselves! We’ll need to add a constraint against that:

1
2
3
4
5
6
7

(defne no-doubleso
  "pairs does not have a pair with identical members"
  [pairs]
  ([()])
  ([[[a b] . ps]]
    (!= a b)
    (no-doubleso ps)))

Once again, pattern matching. The degenerate case, the empty list (line 4), simply succeeds. If we have a head and tail (line 5), we destructure the head, too, so we can assert that the two members of that vector pair are not equal.

This gets us a solution that works:

1
2
3
4
5
6
7
8
9
10
11

(run 1 [q]
  (fresh [recipients]
    (permuteo names recipients)
    (zipo names recipients q)
    (no-doubleso q)))
;; => ((["Chris" "Christine"]
;;      ["Christine" "Russell"]
;;      ["Russell" "Marie"]
;;      ["Marie" "Sumeet"]
;;      ["Sumeet" "Harish"]
;;      ["Harish" "Chris"]))

But it still might not be ideal.

Prohibiting certain pairs

It may be necessary (for personal or HR reasons) that some people shouldn’t give gifts to certain others.

1
2
3
4
5
6
7
8

(defne not-pairedo
  "x and y aren't paired in pairs"
  [pairs x y]
  ([() _ _])
  ([[p . ps] _ _]
     (!= p [x y])
     (!= p [y x])
     (not-pairedo ps x y)))

Hopefully, this pattern-matching pattern is clear now.

And now we can add further constraints:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

(run 1 [q]
  (fresh [recipients]
    (permuteo names recipients)
    (zipo names recipients q)
    (no-doubleso q)
    (not-pairedo q "Chris" "Christine")
    (not-pairedo q "Chris" "Russell")
    (not-pairedo q "Christine" "Russell")
    (not-pairedo q "Russell" "Marie")
    (not-pairedo q "Rusell" "Sumeet")))
;; => ((["Chris" "Marie"]
;;      ["Christine" "Sumeet"]
;;      ["Russell" "Harish"]
;;      ["Marie" "Chris"]
;;      ["Sumeet" "Christine"]
;;      ["Harish" "Russell"]))

Doing that with slips of paper in a hat would be tiresome.

This code (plus some helper functions) is on github.