From dc4fb90f0808bc08a0048d59f8dd800cfdac44ea Mon Sep 17 00:00:00 2001 From: haskal Date: Wed, 16 Dec 2020 01:18:43 -0500 Subject: [PATCH] day 16: implement bipartite-matching solution --- 16.rkt | 35 +++++++++-------------------------- 1 file changed, 9 insertions(+), 26 deletions(-) diff --git a/16.rkt b/16.rkt index 238fa53..c318cf6 100644 --- a/16.rkt +++ b/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"))