sol.scm (3736B) [raw]
1 #!/usr/local/bin/chicken-csi -ss 2 (import srfi-69 3 (chicken io)) 4 5 (define (filter pred lst) 6 (cond ((null? lst) '()) 7 ((pred (car lst)) 8 (cons (car lst) (filter pred (cdr lst)))) 9 (else (filter pred (cdr lst))))) 10 11 (define (lvl c) 12 (cond ((equal? c #\S) 0) 13 ((equal? c #\E) 25) 14 (else (- (char->integer c) 97)))) 15 16 (define (get grid r c) 17 (vector-ref (vector-ref grid r) c)) 18 19 (define (find grid needle) 20 (let ((n (vector-length grid)) 21 (m (vector-length (vector-ref grid 0)))) 22 (let iloop ((i 0)) 23 (if (>= i n) 24 #f 25 (let jloop ((j 0)) 26 (if (>= j m) 27 (iloop (add1 i)) 28 (let ((x (get grid i j))) 29 (if (equal? x needle) 30 (list i j) 31 (jloop (add1 j)))))))))) 32 33 (define (make-grid lines transform) 34 (list->vector (map (lambda (l) (list->vector (map transform (string->list l)))) 35 lines))) 36 37 (define (ident x) x) 38 39 40 (define (neigh grid pos dir) 41 (define (in-bounds? pt) 42 (let ((n (vector-length grid)) 43 (m (vector-length (vector-ref grid 0)))) 44 (and (>= (cadr pt) 0) 45 (< (cadr pt) n) 46 (>= (caddr pt) 0) 47 (< (caddr pt) m)))) 48 (define (in-reach? pt) 49 (let* ((d (car pos)) 50 (i (cadr pos)) 51 (j (caddr pos)) 52 (i2 (cadr pt)) 53 (j2 (caddr pt)) 54 (l1 (get grid i j)) 55 (l2 (get grid i2 j2))) 56 (if (eq? dir 'up) 57 (and (<= l2 (add1 l1))) 58 (and (>= (add1 l2) l1))))) 59 (let* ((d (car pos)) 60 (i (cadr pos)) 61 (j (caddr pos))) 62 (filter (lambda (pt) (and (in-bounds? pt) (in-reach? pt))) 63 `((,(add1 d) ,(add1 i) ,j) 64 (,(add1 d) ,(sub1 i) ,j) 65 (,(add1 d) ,i ,(add1 j)) 66 (,(add1 d) ,i ,(sub1 j)))))) 67 68 69 (define (dist grid start goal) 70 ;; BFS to find the goal, each item is (D i j) where D is depth 71 (let ((seen (make-hash-table))) 72 (let loop ((Q (list (cons 0 start)))) 73 (if (null? Q) 74 #f 75 (let ((pos (car Q))) 76 (hash-table-set! seen (cdr pos) 'seen) 77 (if (equal? (cdr pos) goal) 78 (car pos) 79 (let ((neighs (filter (lambda (p) (not (hash-table-exists? seen (cdr p)))) 80 (neigh grid pos 'up)))) 81 (for-each (lambda (p) (hash-table-set! seen (cdr p) 1)) neighs) 82 (loop (append (cdr Q) neighs))))))))) 83 84 ;; Part 2 is a simple flip of the search: don't search for one goal loc 85 ;; search starting at E and until depth 0 (with inverted 'in-reach?) 86 (define (dist-down grid start) 87 ;; BFS to find the goal, each item is (D i j) where D is depth 88 (let ((seen (make-hash-table))) 89 (let loop ((Q (list (cons 0 start)))) 90 (if (null? Q) 91 #f 92 (let ((pos (car Q))) 93 (hash-table-set! seen (cdr pos) 'seen) 94 (if (equal? (get grid (cadr pos) (caddr pos)) 0) 95 (car pos) 96 (let ((neighs (filter (lambda (p) (not (hash-table-exists? seen (cdr p)))) 97 (neigh grid pos 'down)))) 98 (for-each (lambda (p) (hash-table-set! seen (cdr p) 1)) neighs) 99 (loop (append (cdr Q) neighs))))))))) 100 101 102 (define (main args) 103 (let* ((lines (read-lines)) 104 (cgrid (make-grid lines ident)) 105 (lgrid (make-grid lines lvl)) 106 (start (find cgrid #\S)) 107 (goal (find cgrid #\E))) 108 (print (dist lgrid start goal)) 109 (print (dist-down lgrid goal)))) 110 111 ; for repl 112 (define ln '("Sabqponm" 113 "abcryxxl" 114 "accszExk" 115 "acctuvwj" 116 "abdefghi")) 117