1.rkt 2.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283
  1. #lang racket
  2. (require "../lib/utils.rkt")
  3. (define lines
  4. (call-with-input-file "input"
  5. (λ (fp)
  6. (get-lines fp))))
  7. (define diagram (list->vector lines))
  8. (define height (vector-length diagram))
  9. (define width (string-length (vector-ref diagram 0)))
  10. (define (char-at x y)
  11. (string-ref (vector-ref diagram y) x))
  12. (define (find-start)
  13. (let loop ((x 0) (y 0))
  14. (if (>= y height)
  15. #f
  16. (if (>= x width)
  17. (loop 0 (+ y 1))
  18. (if (char=? #\S (char-at x y))
  19. (cons x y)
  20. (loop (+ x 1) y))))))
  21. (define start (find-start))
  22. (define (valid-pos? pos)
  23. (define x (car pos))
  24. (define y (cdr pos))
  25. (and (and (>= x 0) (< x width))
  26. (and (>= y 0) (< y height))))
  27. (define first-pos
  28. (let ()
  29. (define up (cons (car start) (- (cdr start) 1)))
  30. (define down (cons (car start) (+ (cdr start) 1)))
  31. (define left (cons (- (car start) 1) (cdr start)))
  32. (define right (cons (+ (car start) 1) (cdr start)))
  33. (cond ((and (valid-pos? up)
  34. (member (char-at (car up) (cdr up)) (list #\| #\F #\7)))
  35. up)
  36. ((and (valid-pos? down)
  37. (member (char-at (car down) (cdr down)) (list #\| #\L #\J )))
  38. down)
  39. ((and (valid-pos? left)
  40. (member (char-at (car left) (cdr left)) (list #\- #\F #\L )))
  41. left)
  42. ((and (valid-pos? right)
  43. (member (char-at (car right) (cdr right)) (list #\- #\7 #\J)))
  44. right))))
  45. (define (next cur recent)
  46. (define up (cons (car cur) (- (cdr cur) 1)))
  47. (define down (cons (car cur) (+ (cdr cur) 1)))
  48. (define left (cons (- (car cur) 1) (cdr cur)))
  49. (define right (cons (+ (car cur) 1) (cdr cur)))
  50. (define c (char-at (car cur) (cdr cur)))
  51. (define possible-pos
  52. (cond ((char=? c #\|) (list up down))
  53. ((char=? c #\-) (list left right))
  54. ((char=? c #\F) (list right down))
  55. ((char=? c #\L) (list up right))
  56. ((char=? c #\7) (list left down))
  57. ((char=? c #\J) (list up left))))
  58. (let loop ((cur possible-pos))
  59. (if (not (equal? (car cur) recent))
  60. (car cur)
  61. (loop (cdr cur)))))
  62. (define (simulate)
  63. (let loop ((i 0) (cur first-pos) (recent start))
  64. (if (equal? cur start)
  65. i
  66. (let ()
  67. (define next-loc (next cur recent))
  68. (loop (+ i 1) next-loc cur)))))
  69. (define loop-length (simulate))
  70. (if (= 0 (modulo loop-length 2))
  71. (/ loop-length 2)
  72. (+ 1 (quotient loop-length 2)))