day 7: cleaned up version using graph-lib
this was a pain in the ass to write vs the initial implementation, but it's a lot more efficient due to not revisiting nodes that are already visited. i would warrant it's as efficient as possible at this point also, both part1 and part2 use the generalized do-dfs form provided by the graph package
This commit is contained in:
parent
69f78e5e6d
commit
bcce377a7d
78
7.rkt
78
7.rkt
|
@ -4,48 +4,68 @@
|
|||
|
||||
;; solution for day 7
|
||||
|
||||
(define (part1 adjlist all-colors wanted)
|
||||
(define (dfs src dest)
|
||||
(for/or ([item (in-list (hash-ref adjlist src '()))])
|
||||
(or (dfs (car item) dest) (string=? (car item) dest))))
|
||||
(define (part1 G wanted)
|
||||
(define-vertex-property G has-wanted #:init #f)
|
||||
(do-dfs G
|
||||
;; only visit when the to vertex is not already marked with has-wanted
|
||||
#:visit?: (if (and $from (has-wanted $to))
|
||||
(begin (has-wanted-set! $from #t) #f)
|
||||
#t)
|
||||
;; propagate has-wanted if the child has it
|
||||
#:epilogue: (when (and $from (or (has-wanted $to) (string=? wanted $to)))
|
||||
(has-wanted-set! $from #t)))
|
||||
;; count the results
|
||||
(for/sum ([(_ v) (in-hash (has-wanted->hash))] #:when v) 1))
|
||||
|
||||
;; bad solution
|
||||
(for/sum ([src (in-set all-colors)])
|
||||
(if (dfs src wanted) 1 0)))
|
||||
(define (part2 G wanted)
|
||||
;; initially, each vertex just counts the weight of itself, which is 1
|
||||
(define-vertex-property G all-weight #:init 1)
|
||||
|
||||
(define (part2 adjlist all-colors wanted)
|
||||
(define (part2-impl src)
|
||||
(add1
|
||||
(for/sum ([subbag (in-list (hash-ref adjlist src '()))])
|
||||
(* (cdr subbag) (part2-impl (car subbag))))))
|
||||
(sub1 (part2-impl wanted)))
|
||||
;; accumulates the result in the vertex property tracking all weights
|
||||
;; adds the total weight of $to multiplied by the edge weight of $from -> $to to the total weight
|
||||
;; of $from
|
||||
;; this will be called for each neighbor of $from, and $from's total weight starts at 1
|
||||
(define (increment $from $to)
|
||||
(when $from
|
||||
(all-weight-set! $from
|
||||
(+ (all-weight $from)
|
||||
(* (edge-weight G $from $to) (all-weight $to))))))
|
||||
|
||||
(do-dfs G
|
||||
#:order (lambda (_) (list wanted))
|
||||
;; always check already-visited nodes
|
||||
#:process-unvisited?: #t
|
||||
;; add already-visited nodes to the total
|
||||
#:process-unvisited: (increment $from $to)
|
||||
;; add nodes we finished visiting to the total
|
||||
#:epilogue: (increment $from $to))
|
||||
;; subtract 1 because we counted the shiny gold bag itself, when we only need the weight of
|
||||
;; what's inside it
|
||||
(sub1 (all-weight wanted)))
|
||||
|
||||
(module+ main
|
||||
(define input (file->lines "inputs/7"))
|
||||
(define all-colors (mutable-set))
|
||||
(define adjlist
|
||||
(for/hash ([line (in-list input)])
|
||||
(match line
|
||||
[(pregexp #px"^([a-z ]+) bags contain ([^\\.]+).$" (list _ src-color contains))
|
||||
(set-add! all-colors src-color)
|
||||
(values src-color
|
||||
(define input-lines (file->lines "inputs/7"))
|
||||
(define edges
|
||||
(apply append
|
||||
(for/list ([line (in-list input-lines)])
|
||||
(match line
|
||||
[(pregexp #px"^([a-z ]+) bags contain ([^\\.]+).$" (list _ src-color contains))
|
||||
(if (string=? "no other bags" contains)
|
||||
'()
|
||||
(for/list ([item (in-list (string-split contains ", "))])
|
||||
(match item
|
||||
[(pregexp #px"^([0-9]+) ([a-z ]+) bag[s]?"
|
||||
(list _ (app string->number number) color))
|
||||
(set-add! all-colors color)
|
||||
(cons color number)]
|
||||
[x (error "not shonks" x)]))))]
|
||||
[x (error "not shonks" x)])))
|
||||
|
||||
(list _ (app string->number number) dst-color))
|
||||
(list number src-color dst-color)]
|
||||
[x (error "not shonks" x)])))]
|
||||
[x (error "not shonks" x)]))))
|
||||
(define input (weighted-graph/directed edges))
|
||||
(define wanted "shiny gold")
|
||||
|
||||
;; part 1
|
||||
(answer 7 1 (part1 adjlist all-colors wanted))
|
||||
(answer 7 1 (part1 input wanted))
|
||||
|
||||
;; part 2
|
||||
(answer 7 2 (part2 adjlist all-colors wanted))
|
||||
(answer 7 2 (part2 input wanted))
|
||||
|
||||
(displayln "meow"))
|
||||
|
|
Loading…
Reference in New Issue