AoC '21, first problem, rvc

  
 $ cat 12a.rkt  
 #lang racket 
  
 (provide 
   problem-input 
   ) 
  
  
 (define (aoc-12a input) 
  
   ; Return all the paths between the start and end nodes in 
   ; the given graph. 
  
   (let loop 
  
     ((path-count 0) 
      (pending-paths (pending-paths:new input))) 
  
     (let-values 
  
       (((pending-path pending-paths) 
           (pending-paths:pick pending-paths))) 
  
       (let-values 
  
         (((pc pp) (advance-path pending-path pending-paths))) 
  
         (let ((path-count (+ path-count pc))) 
           (if (pending-paths:empty? pp) 
             path-count 
             (loop path-count pp))))))) 
  
  
 (define (advance-path pending-path pending-paths) 
  
   ; Extend the given pending-path along all possible legal 
   ; next nodes; return the values (pc pp) where pc is the 
   ; number of completed paths found and pp is a collection 
   ; of pending paths containing all the given pending paths 
   ; plus the new pending paths found when extending the 
   ; given pending path. 
  
   (let loop 
  
     ((next-nodes (pending-path:next-nodes pending-path)) 
      (path-count 0) 
      (pending-paths pending-paths)) 
  
     (if (null? next-nodes) 
  
         (values path-count pending-paths) 
  
       (let ((next-node (car next-nodes)) 
             (next-nodes (cdr next-nodes))) 
  
         (if (node:is-end? next-node) 
  
           (loop next-nodes (+ path-count 1) pending-paths) 
  
           (loop 
             next-nodes 
             path-count 
             (pending-paths:add 
               pending-paths 
               (pending-path:extend-to 
                 pending-path next-node)))))))) 
  
  
 (define (node:is-end? node) 
  
   ; Return #t iff the given node is the end node. 
  
   (string=? node "end")) 
  
  
 (define (node:is-large? node) 
  
   ; Return #t iff the given node is a large node. 
  
   (char-upper-case? (string-ref node 0))) 
  
  
 (define (pending-path:current-node pending-path) 
  
   ; Return the given pending paths' current node. 
  
   (car pending-path)) 
  
  
 (define (pending-path:extend-to pending-path node) 
  
   ; Return a pending path that's an extension of the given 
   ; pending path via the given node. 
  
   (list 
     node 
     (set:add (pending-path:visited-nodes pending-path) node) 
     (pending-path:neighbors pending-path))) 
  
  
 (define (pending-path:initial input) 
  
   ; Return the inital pending path for the graph described 
   ; by the given input. 
  
   (list "start" 
         (set:add (set:new) "start") 
         (read-graph input))) 
  
  
 (define (pending-path:neighbors pending-path) 
  
   ; Return the adjacency matrix for the graph of which the 
   ; given pending path is a part. 
  
   (caddr pending-path)) 
  
  
 (define (pending-path:next-nodes pending-path) 
  
   ; Return a list of all acceptable next nodes for the given 
   ; pending path. 
  
   (let 
  
     ((visited-nodes 
        (pending-path:visited-nodes pending-path))) 
  
     (filter 
  
       (lambda (n) 
         (or (node:is-large? n) 
             (not (set:member? visited-nodes n)))) 
  
       (hash-ref 
         (pending-path:neighbors pending-path) 
         (pending-path:current-node pending-path))))) 
  
  
 (define (pending-path:unvisited? pending-path node) 
  
   ; Return #t if the given node has not yet been visited by 
   ; the given pending path, #f otherwise. 
  
   (not 
     (set:member? 
       (pending-path:visited-nodes pending-path) 
       node))) 
  
  
 ; Return a list of all nodes visited by the given pending 
 ; path. 
  
   (define pending-path:visited-nodes cadr) 
  
  
 (define (pending-paths:add pending-paths new-path) 
  
   ; Return pending paths containing all the given pending 
   ; paths and the given new path. 
    
   (set:add pending-paths new-path)) 
  
  
 (define (pending-paths:empty? pending-paths) 
  
   ; Return #t if the given pending paths is empty, #f 
   ; otherwise. 
  
   (set:empty? pending-paths)) 
  
  
 (define (pending-paths:new input) 
  
   ; Return a new collection of pending paths based on the 
   ; given graph description. 
    
   (set:new (pending-path:initial input))) 
  
  
 (define (pending-paths:pick pending-paths) 
  
   ; Pick a pending path from the given pending paths, return 
   ; the values (p pp) where p is the path picked and pp 
   ; contains all the given pending paths except the one 
   ; picked. 
  
   (set:pick pending-paths)) 
  
  
 (define (read-graph input) 
  
   ; Read a graph from the given input and return a 
   ; hash-table giving node adjacencies. 
  
   (let* 
  
     ((neighbors (make-hash)) 
  
     (add-neighbor 
       (lambda (n1 n2) 
         (if (hash-has-key? neighbors n1) 
           (hash-set! neighbors n1 
             (set:add (hash-ref neighbors n1) n2)) 
           (hash-set! neighbors n1 
             (set:new n2)))))) 
  
     (for-each 
       (lambda (l) 
         (let* ((edge (string-split l "-")) 
                (n1 (car edge)) 
                (n2 (cadr edge))) 
           (add-neighbor n1 n2) 
           (add-neighbor n2 n1))) 
       (string-split input)) 
  
     neighbors)) 
  
  
 ; These sets are sloppy because they don't check for 
 ; duplicates. 
  
 (define (set:add set e) 
  
   ; Return a set containing all the elements of the given 
   ; set plus the given element. 
  
   (cons e set)) 
  
  
 (define (set:empty? set) 
  
   ; Return #t if the given set is empty, #f otherwise. 
  
   (null? set)) 
  
  
 (define (set:member? set e) 
  
   ; Return #t if the given element is a member of the given 
   ; set, #f otherwise. 
  
   ; member does not return #f. 
    
   (if (member e set) #t #f)) 
  
  
 (define (set:new . elts) 
  
   ; Return a set containing the given elements. 
  
   elts) 
  
  
 (define (set:pick set) 
  
   ; Pick an element from the given set, return the values (e 
   ; s) where e is the element picked and s is a set 
   ; containing all the elements of the given set except the 
   ; one picked. 
  
   (if (set:empty? set) 
     (error) 
     (values (car set) (cdr set)))) 
  
  
 (define problem-input 
   (string-join '( 
     "qi-UD"     "start-qi"       
     "jt-br"     "end-aa"         
     "wb-TF"     "hf-HA"  
     "VO-aa"     "hf-UD"  
     "UD-aa"     "aa-hf"  
     "br-end"    "TF-hf"  
     "end-HA"    "VO-start"       
     "qi-br"     "wb-aa"  
     "br-HA"     "UD-wb"  
     "UD-start"  "KX-wb"  
     "TF-qi"     "qi-VO"  
     "br-hf"     "br-TF"      
     "VO-hf" 
     ) 
     "\n")) 
  
 (module+ main 
   (aoc-12a problem-input)) 
  
  
 (module+ test 
  
   (require rackunit "aoc.rkt") 
    
   (check-eq? (aoc-12a "start-a") 0) 
   (check-eq? (aoc-12a "start-end") 1) 
  
   (define two-bits 
     (string-join '( 
       "start-o0" 
       "start-z0" 
       "o0-j0" 
       "z0-j0" 
       "j0-o1" 
       "j0-z1" 
       "o1-end" 
       "z1-end" 
       ) 
       "\n")) 
   (check-eq? (aoc-12a two-bits) 4) 
  
   (define three-bits 
     (string-join '( 
       "start-o0"  "start-z0"  "o0-j0"   "z0-j0" 
       "j0-o1"     "j0-z1"     "o1-j1"   "z1-j1" 
       "j1-o2"     "j1-z2"     "o2-end"  "z2-end" 
       ) 
       "\n")) 
   (check-eq? (aoc-12a three-bits) 8) 
  
   (define example1-input 
     (string-join '( 
       "start-A" 
       "start-b" 
       "A-c" 
       "A-b" 
       "b-d" 
       "A-end" 
       "b-end" 
       ) 
       "\n")) 
   (check-eq? (aoc-12a example1-input) 10) 
  
   (define example2-input 
     (string-join '( 
       "dc-end"    "LN-dc"        
       "HN-start"  "HN-end"       
       "start-kj"  "kj-sa"        
       "dc-start"  "kj-HN"        
       "dc-HN"     "kj-dc"    
       ) 
       "\n")) 
   (check-eq? (aoc-12a example2-input) 19) 
  
   (define example3-input 
     (string-join '( 
       "fs-end"    "RW-he"         
       "he-DX"     "fs-DX"         
       "fs-he"     "pj-RW"         
       "start-DX"  "zg-RW"         
       "pj-DX"     "start-pj"      
       "end-zg"    "he-WI"         
       "zg-sl"     "zg-he"         
       "zg-pj"     "pj-fs"         
       "pj-he"     "start-RW"   
       ) 
       "\n")) 
   (check-eq? (aoc-12a example3-input) 226) 
  
   (check-eq? (aoc-12a problem-input) 3856)) 
  
 $ raco test 12a.rkt  
 raco test: (submod "12a.rkt" test) 
 8 tests passed 
  
 $