day08.scm (3287B)
1 (use-modules (ice-9 popen))
2 (use-modules (ice-9 rdelim))
3 (use-modules (ice-9 format))
4 (use-modules (ice-9 hash-table))
5 (use-modules (ice-9 receive))
6 (use-modules (ice-9 regex))
7 (use-modules (srfi srfi-1))
8
9 (define (parse-input filename)
10 (let ((file (open-input-file filename))
11 (instructions '())
12 (left-map (make-hash-table))
13 (right-map (make-hash-table)))
14 (let ((line (car (%read-line file))))
15 (set! instructions (string->list line)))
16 (%read-line file)
17 (while #t
18 (let ((line (car (%read-line file))))
19 (if (eof-object? line)
20 (break)
21 (let* ((tmp (string-split (regexp-substitute #f (string-match "([A-Z]{3}) = \\(([A-Z]{3}), ([A-Z]{3})\\)" line) 1 " " 2 " " 3) #\ ))
22 (curr (car tmp))
23 (left (list-ref tmp 1))
24 (right (list-ref tmp 2)))
25 (hash-set! left-map curr left)
26 (hash-set! right-map curr right)))))
27 (values instructions left-map right-map)))
28
29 (define (is-zzz start step-count)
30 (equal? start "ZZZ"))
31
32 (define (count-step instructions left-map right-map start end-checker step-count)
33 (if (end-checker start step-count)
34 (cons step-count start)
35 (let* ((curr-dir (list-ref instructions (floor-remainder step-count (length instructions))))
36 (next-start (cond ((eq? curr-dir #\L) (hash-ref left-map start))
37 ((eq? curr-dir #\R) (hash-ref right-map start))
38 (#t #nil)))
39 (next-step-count (1+ step-count)))
40 (count-step instructions left-map right-map next-start end-checker next-step-count))))
41
42 (receive (instructions left-map right-map) (parse-input "input.txt")
43 ;; 11309
44 (format #t "Part 1: ~d" (car (count-step instructions left-map right-map "AAA" is-zzz 0)))
45 (newline))
46
47 (define (is-any-z start step-count)
48 (and (> step-count 0) (equal? (string-ref start 2) #\Z)))
49
50 (define (check-z-cycle instructions left-map right-map start)
51 (let* ((tmp (count-step instructions left-map right-map start is-any-z 0))
52 (tmp2 (count-step instructions left-map right-map start is-any-z 0)))
53 (if (and (= 0 (floor-remainder (car tmp) (length instructions)))
54 (= 0 (floor-remainder (car tmp) (length instructions)))
55 (= (car tmp) (car tmp2)))
56 (car tmp)
57 #nil)))
58
59 (define (solve-extended-eculidean a b)
60 (let ((r_prev a)
61 (r_curr b))
62 (while (> r_curr 0)
63 (receive (q_curr r_next) (euclidean/ r_prev r_curr)
64 (set! r_prev r_curr)
65 (set! r_curr r_next)))
66 r_prev))
67
68 (define (find-lcm a b)
69 (let ((gcd (solve-extended-eculidean a b)))
70 (/ (* a b) gcd)))
71
72 (receive (instructions left-map right-map) (parse-input "input.txt")
73 ;; turned out all xxA->xxZ at full cycles of the instructions and xxZ->xxZ the
74 ;; same, so we can freely add cycles after.
75 (let* ((starts (filter (lambda (x) (equal? (string-ref x 2) #\A)) (hash-map->list (lambda (k v) k) left-map)))
76 (cycle-spec (map (lambda (x) (check-z-cycle instructions left-map right-map x)) starts)))
77 ;; 13740108158591
78 (format #t "Part 2: ~d" (reduce find-lcm #nil cycle-spec))
79 (newline)))