You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
aoc-racket/2018/07.rkt

75 lines
2.8 KiB
Racket

6 years ago
#lang debug br
(require graph)
#|
Track the progress through the steps with a dag,
but track the state of the prerequisites with another dag (in the reverse direction)
|#
(define dag (directed-graph null))
(define prereqs (weighted-graph/directed null))
6 years ago
(define (init-graphs!)
(for ([ln (in-lines (open-input-file "07.txt"))])
(match-define (list (list left) (list right))
(map string->list (regexp-match* #rx"(?<=[Ss]tep )." ln)))
(add-directed-edge! dag left right)
(add-directed-edge! prereqs right left +inf.0)))
(define (meet-prereq! v1 v2)
6 years ago
;; a prereq is "met" if the edge weight is zero
(add-directed-edge! prereqs v2 v1 0))
(define (prereqs-met? v)
;; check if all v's edges in the prereq graph are zero
6 years ago
(zero? (for/sum ([n (in-list (get-neighbors prereqs v))])
(edge-weight prereqs v n))))
6 years ago
(define (find-available g)
(filter prereqs-met? (get-vertices g)))
(define ()
6 years ago
(init-graphs!)
(let loop ([vs-available (find-available prereqs)] [done null])
6 years ago
(cond
6 years ago
[(= (length done) (length (get-vertices dag))) (list->string (reverse done))]
6 years ago
[else
6 years ago
(match-define (list this-v others ...) (sort vs-available char<?))
(for ([n (in-list (get-neighbors dag this-v))])
(meet-prereq! this-v n))
(define this-visited (cons this-v done))
(loop (filter-not (λ (v) (memv v this-visited)) (find-available prereqs))
this-visited)])))
(define (worker-done? worker)
(match-define (cons char time) worker)
(= time (+ 60 (- (char->integer char) 65))))
6 years ago
6 years ago
(define (★★)
(init-graphs!)
(define worker-count 5)
(let loop ([workers null][done null][steps 0])
(cond
[(= (length done) (length (get-vertices dag))) (sub1 steps)]
[else
(define-values (done-ws working-ws) (partition worker-done? workers))
(define done-vs (map car done-ws))
(for* ([v (in-list done-vs)]
[n (in-list (get-neighbors dag v))])
(meet-prereq! v n))
(define next-done (append done-vs done))
(define updated-ws (for/list ([w (in-list working-ws)])
(match-define (cons v time) w)
(cons v (add1 time))))
(define vs-available (for/list ([v (in-list (find-available prereqs))]
#:unless (memv v (append next-done (map car updated-ws))))
v))
(define new-vs (take (sort vs-available char<?)
(min (length vs-available) (- worker-count (length working-ws)))))
(define new-workers (map (λ (v) (cons v 0)) new-vs))
(loop (append new-workers updated-ws) next-done (add1 steps))])))
6 years ago
(module+ test
(require rackunit)
(check-equal? (time ()) "GNJOCHKSWTFMXLYDZABIREPVUQ")
6 years ago
(check-equal? (time (★★)) 886))