advent-of-code-2022/day-16/part-01.scm

(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:)
 ;; (ice-9 format)
 (srfi srfi-1)
 (pipeline)
 (debug)
 ;; (list-helpers)
 ;; (array-helpers)
 (segment)
 (parallelism)
 ;; (math)
 ;; (logic)
 ;; receive
 (srfi srfi-8)
 (srfi srfi-9 gnu)
 ;; hash tables
 (srfi srfi-69)
 ;; let-values
 (srfi srfi-11)
 ;; purely functional data structures
 (pfds sets)
 ;; (timing)
 (graph-algorithm))


(define input-filename "example-input")
;; (define input-filename "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 the distance 1 - it takes 1 minute to get to a
                   ;; neighboring valve
                   (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)))


;; Create lookup table to quickly get valves by name.
(define valves-table
  (alist->hash-table
   (map (λ (valve)
          ;; (simple-format #t "adding ~a\n" (valve-name valve))
          (cons (valve-name valve) valve))
        valves)
   string=?))


(define start-valve (hash-table-ref valves-table "AA"))


;;; OK, got it parsed. Now, lets consider a brute-force approach. At
;;; each iteration or "minute" it is clear, how much time is left and
;;; with that implicitly how much pressure a valve will release over
;;; the remaining time. We could write a recursive program, that from
;;; every visited valve moves to every yet unvisited neighbor, summing
;;; each path of valves and when returning to a recursive "split",
;;; taking the maximum.

;;; This could work, we can try it, but it might be a trap for the
;;; naive. The branching might be too much over the 30 iterations
;;; ("minutes").


;; Functional sets stuff.

;; (define make-empty-set
;;   (λ ()
;;     (make-set
;;      (λ (valve1 valve2)
;;        (let ([v1-name (valve-name valve1)]
;;              [v2-name (valve-name valve2)])
;;          (string< v1-name v2-name))))))


;; (define set-insert-multiple
;;   (λ (myset items)
;;     (cond
;;      [(null? items) myset]
;;      [else
;;       (set-insert-multiple (set-insert myset (car items))
;;                            (cdr items))])))


;; (define set-empty?
;;   (λ (set)
;;     (= (set-size set) 0)))

;; Puzzle logic.

(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)))


;; (define naive-find-max-pressure-released
;;   (λ (valves minutes)
;;     (let ([valves-count (length valves)])
;;       (let iter ([minutes° minutes]
;;                  [opened-valves° (make-empty-set)]
;;                  [current-valve° (hash-table-ref valves-table start-valve-name)]
;;                  [pressure-release° 0]
;;                  [path° (list start-valve-name)])
;;         ;; (simple-format #t "current path: ~a\n" path°)
;;         (cond
;;          ;; no more valves to open
;;          [(= (set-size opened-valves°) valves-count)
;;           (simple-format #t "ended: no more valves to open\n")
;;           (cons pressure-release° path°)]
;;          ;; no neighbors to go on from here (should not happen actually)
;;          [(null? (valve-neighbors current-valve°))
;;           (simple-format #t "ended: no more neighbors to go to\n")
;;           (cons pressure-release° path°)]
;;          ;; no time left
;;          [(= minutes° 0)
;;           ;; (simple-format #t "ended: time is up\n")
;;           (cons pressure-release° path°)]
;;          [else
;;           (let ([neighbor-results
;;                  ;; go to neighbor valves
;;                  (map (λ (neighbor-name)
;;                         (iter (- minutes° 1)
;;                               opened-valves°
;;                               (hash-table-ref valves-table neighbor-name)
;;                               pressure-release°
;;                               (cons neighbor-name path°)))
;;                       (valve-neighbors current-valve°))])
;;             (cond
;;              ;; current valve already opened?
;;              [(set-member? opened-valves° current-valve°)
;;               (apply path-max neighbor-results)]
;;              [else
;;               (apply path-max
;;                      ;; open current valve instead of moving on to the next
;;                      (cons (iter (- minutes° 1)
;;                                  (set-insert opened-valves° current-valve°)
;;                                  current-valve°
;;                                  (+ pressure-release°
;;                                     (valve-open-total-release current-valve° minutes°))
;;                                  (cons 'open-valve path°))
;;                            neighbor-results))]))])))))

;; (simple-format
;;  #t "result: ~a\n"
;;  (naive-find-max-pressure-released valves 30))

;;; As expected, it takes too long.

;;; Run it for a lower amount of minutes to see some result:

;; (simple-format
;;  #t "result: ~a\n"
;;  (naive-find-max-pressure-released valves 15))


;;; Ideas for solving the problem:

;;; For each node calculate the shortes paths to all other
;;; nodes. Moving from node to neighbor node takes 1 minute
;;; for all nodes. We can then calculate how much pressure
;;; release can be gained by moving to any other node. To
;;; calculate it, we substract the distance from the
;;; remaining minutes. Based on how much pressure can be
;;; released we decide where to move next.

;;; This could be a Dijkstra for each node. Or perhaps there
;;; is another algorithm to give all distances for all
;;; nodes?

;;; First try to implement Dijkstra and see if performance
;;; is acceptable.


(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)))
                              ;; In this case the distance is always 1.
                              (λ (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"))))


;; But moving then doing Dijkstra again is greedy and might lead to wrong result.

;; Check all permutations? But there are 50 nodes in the actual puzzle input ...