123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283 |
- (import
- (except (rnrs base)
- let-values
- map
- error
- vector-map)
- (only (guile)
- lambda* λ
- simple-format
- current-output-port)
- (fileio)
- (ice-9 pretty-print)
- (ice-9 peg)
- (ice-9 match)
- (prefix (peg-tree-utils) peg-tree:)
-
- (srfi srfi-1)
- (pipeline)
- (debug)
-
-
- (segment)
- (parallelism)
-
-
-
- (srfi srfi-8)
- (srfi srfi-9 gnu)
-
- (srfi srfi-69)
-
- (srfi srfi-11)
-
- (pfds sets)
-
- (graph-algorithm))
- (define input-filename "example-input")
- (define-peg-pattern NUMBER body (and (? (or "-" "+")) (+ (range #\0 #\9))))
- (define-peg-pattern SPACE none " ")
- (define-peg-pattern SEMICOLON none ";")
- (define-peg-pattern VALVE-LABEL none "Valve")
- (define-peg-pattern TUNNELS-LABEL none (or "tunnel leads to valve" "tunnels lead to valves"))
- (define-peg-pattern ANYTHING-EXCEPT-NUMBER none
- (* (and (not-followed-by NUMBER) peg-any)))
- (define-peg-pattern WORD-DELIMITER none (or "," "." ";" " "))
- (define-peg-pattern NEXT-WORD body
- (* (and (not-followed-by WORD-DELIMITER) peg-any)))
- (define-peg-pattern FLOWRATE all NUMBER)
- (define-peg-pattern NAME body NEXT-WORD)
- (define-peg-pattern VALVE-NAME all NAME)
- (define-peg-pattern NEIGHBOR-NAME all NAME)
- (define-peg-pattern NEIGHBOR-NAMES all
- (+ (and NEIGHBOR-NAME (? NEIGHBOR-NAME-SEP))))
- (define-peg-pattern NEIGHBOR-NAME-SEP none (and "," " "))
- (define-peg-pattern VALVE-INFO body
- (and (and VALVE-LABEL SPACE VALVE-NAME)
- (and ANYTHING-EXCEPT-NUMBER FLOWRATE)
- (and SEMICOLON SPACE TUNNELS-LABEL SPACE)
- NEIGHBOR-NAMES))
- (define-immutable-record-type <valve>
- (make-valve name flowrate neighbors)
- valve?
- (name valve-name set-valve-name)
- (flowrate valve-flowrate set-valve-flowrate)
- (neighbors valve-neighbors set-valve-neighbors))
- (define parse-valves
- (λ (line)
- (-> line
- (match-pattern VALVE-INFO)
- peg:tree
- ((λ (valve-parsed-tree)
- (make-valve
- (car (peg-tree:tree-refs valve-parsed-tree '(VALVE-NAME)))
- (string->number (car (peg-tree:tree-refs valve-parsed-tree '(FLOWRATE))))
- (map (λ (neighbor-name)
-
-
- (cons (car (peg-tree:tree-refs neighbor-name '(NEIGHBOR-NAME)))
- 1))
- (peg-tree:tree-refs valve-parsed-tree '(NEIGHBOR-NAMES)))))))))
- (define valves
- (-> (get-lines-from-file input-filename)
- (map parse-valves)))
- (define valves-table
- (alist->hash-table
- (map (λ (valve)
-
- (cons (valve-name valve) valve))
- valves)
- string=?))
- (define start-valve (hash-table-ref valves-table "AA"))
- (define valve-open-total-release
- (λ (valve remaining-minutes)
- "Returns the amount of pressure, that will be released by
- the valve, if opened. It takes 1 minute to open the valve,
- so the remaining minutes - 1 are used for calculation."
- (* (- remaining-minutes 1)
- (valve-flowrate valve))))
- (define cost-move-to-valve 1)
- (define cost-open-valve 1)
- (define path<
- (λ (p1 p2)
- (< (car p1) (car p2))))
- (define path-max
- (λ (. paths)
- (reduce (λ (p1 acc) (if (path< p1 acc) acc p1))
- 0
- paths)))
- (let-values
- ([(distances routes)
- (dijkstra-shortest-path start-valve
- valves
- (λ (valve)
- (map (λ (neighbor-name-distance-pair)
- (hash-table-ref valves-table
- (car neighbor-name-distance-pair)))
- (valve-neighbors valve)))
-
- (λ (current-node neighbor) 1)
- (λ (valve1 valve2)
- (let ([v1-name (valve-name valve1)]
- [v2-name (valve-name valve2)])
- (string< v1-name v2-name)))
- #:distance< <)])
- (simple-format #t "distances:\n")
- (pretty-print (hash-table->alist distances))
- (simple-format #t "routes:\n")
- (pretty-print (hash-table->alist routes))
- (simple-format #t "shortest path from AA to HH:\n")
- (pretty-print (routes->path routes (hash-table-ref valves-table "HH"))))
|