day 16: implement bipartite-matching solution

16.rkt

@@ -17,34 +17,17 @@
 (define (part2 input)
   (match-define (list notes yours others) input)
   (define valid-tickets (filter #{andmap #{valid? notes %} %} others))
+  (define (match? idx cand-note)
+    (andmap #{valid? (list cand-note) (list-ref % idx)} valid-tickets))
 
-  (define mapping
-    (for/vector ([idx (in-range (length yours))])
-      (define matching-notes
-        (for/mutable-set ([cand-note (in-list notes)]
-                          #:when (andmap #{valid? (list cand-note) (list-ref % idx)} valid-tickets))
-          (note-name cand-note)))
-      (when (set-empty? matching-notes) (error "couldn't decide..."))
-      matching-notes))
+  (define G (undirected-graph
+              (for*/list ([idx (in-range (length yours))] [cand-note (in-list notes)]
+                          #:when (match? idx cand-note))
+                (list idx (note-name cand-note)))))
+  (for/product ([elem (in-list (maximum-bipartite-matching G))]
+                #:when (string-contains? (second elem) "departure"))
+    (list-ref yours (first elem))))
 
-  (let loop ()
-    (define has-conflicts #f)
-    (for ([v (in-vector mapping)] [k (in-naturals)])
-      (cond
-        [(= 1 (set-count v))
-         (define fst (set-first v))
-         (for ([v2 (in-vector mapping)] [k2 (in-naturals)] #:unless (= k2 k))
-           (set-remove! v2 fst))]
-        [else (set! has-conflicts #t)]))
-    (when has-conflicts
-      (loop)))
-
-  (for/product ([val (in-list yours)] [name-set (in-vector mapping)])
-    (if (string-contains? (set-first name-set) "departure")
-      val
-      1)))
-
-;; parse input file
 (define (parse fname)
   (define sn string->number)
   (match-define (list notes-in yours-in others-in) (string-split (file->string fname) "\n\n"))