diff --git a/2018/07.rkt b/2018/07.rkt index 4748f7c..17bea3c 100644 --- a/2018/07.rkt +++ b/2018/07.rkt @@ -8,40 +8,68 @@ but track the state of the prerequisites with another dag (in the reverse direct (define dag (directed-graph null)) (define prereqs (weighted-graph/directed null)) -(for ([ln (in-lines (open-input-file "07.txt"))]) - (match-define (list left right) (regexp-match* #rx"(?<=[Ss]tep )." ln)) - (add-directed-edge! dag left right) - (add-directed-edge! prereqs right left +inf.0)) -(define (activate-prereq! v1 v2) +(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) ;; 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 - (andmap zero? (map (λ (n) (edge-weight prereqs v n)) (get-neighbors prereqs v)))) + (zero? (for/sum ([n (in-list (get-neighbors prereqs v))]) + (edge-weight prereqs v n)))) (define (find-available g) (filter prereqs-met? (get-vertices g))) (define (★) - (let loop ([vs-available (find-available prereqs)] [visited null]) + (init-graphs!) + (let loop ([vs-available (find-available prereqs)] [done null]) (cond - [(= (length visited) (length (get-vertices dag))) - (apply string-append (reverse visited))] + [(= (length done) (length (get-vertices dag))) (list->string (reverse done))] [else - (match (sort vs-available stringinteger char) 65)))) -#;(define (★★) - ) -#;(★★) +(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