day 21: implement stable bipartite matching result
This commit is contained in:
parent
318749e6b3
commit
16a6abf9b5
8
21.rkt
8
21.rkt
|
@ -16,10 +16,10 @@
|
||||||
|
|
||||||
(define (part2 input)
|
(define (part2 input)
|
||||||
(match-define (data lines all-is all-as tainted) input)
|
(match-define (data lines all-is all-as tainted) input)
|
||||||
(define G (undirected-graph
|
(define matching
|
||||||
(for*/list ([(k v*) (in-hash tainted)] [v (in-set v*)])
|
(maximum-bipartite-matching/stable
|
||||||
(list k v))))
|
(for*/list ([(k v*) (in-hash tainted)] [v (in-set v*)])
|
||||||
(define matching (maximum-bipartite-matching G))
|
(list k v))))
|
||||||
|
|
||||||
(string-join
|
(string-join
|
||||||
(map second (sort matching string<? #:key first))
|
(map second (sort matching string<? #:key first))
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
(require "aoc-lib.rkt" threading syntax/parse/define (for-syntax racket/syntax) graph)
|
(require "aoc-lib.rkt" threading syntax/parse/define (for-syntax racket/syntax) graph)
|
||||||
(provide answer dbg memoize define/memoized
|
(provide answer dbg memoize define/memoized
|
||||||
band bor bxor bnot bshl bshr bset? bfield
|
band bor bxor bnot bshl bshr bset? bfield
|
||||||
|
maximum-bipartite-matching/stable
|
||||||
(all-from-out threading syntax/parse/define graph)
|
(all-from-out threading syntax/parse/define graph)
|
||||||
(for-syntax (all-from-out racket/syntax)))
|
(for-syntax (all-from-out racket/syntax)))
|
||||||
|
|
||||||
|
@ -31,6 +32,22 @@
|
||||||
(define-simple-macro (define/memoized (name:id arg:id) body:expr ...+)
|
(define-simple-macro (define/memoized (name:id arg:id) body:expr ...+)
|
||||||
(define name (memoize (λ (arg) body ...))))
|
(define name (memoize (λ (arg) body ...))))
|
||||||
|
|
||||||
|
;; helper for maximum-bipartite-matching
|
||||||
|
;; given an edge list where each first item corresponds to the left set and each second item
|
||||||
|
;; corresponds to the right set, return a matching list where the first item is from the left set
|
||||||
|
;; and the second item is from the right
|
||||||
|
(define (maximum-bipartite-matching/stable edges)
|
||||||
|
(when (empty? edges) (error "provided empty edges list"))
|
||||||
|
(define left (list->set (map first edges)))
|
||||||
|
(define G (undirected-graph edges))
|
||||||
|
(define matching (maximum-bipartite-matching G))
|
||||||
|
(define num-first-lefts
|
||||||
|
(for/sum ([m (in-list matching)] #:when (set-member? left (first m)))
|
||||||
|
1))
|
||||||
|
(if (> num-first-lefts (/ (set-count left) 2))
|
||||||
|
matching
|
||||||
|
(map #{list (second %) (first %)} matching)))
|
||||||
|
|
||||||
;; submit a solution to the server if not already submitted
|
;; submit a solution to the server if not already submitted
|
||||||
(define (answer day part answer)
|
(define (answer day part answer)
|
||||||
(printf "answer ~a.~a: ~s\n" day part answer)
|
(printf "answer ~a.~a: ~s\n" day part answer)
|
||||||
|
|
Loading…
Reference in New Issue