sol.scm (3346B) [raw]
1 #!/usr/local/bin/chicken-csi -ss 2 (import srfi-69 3 (chicken string) 4 (chicken io)) 5 6 (define (n-of-v n v) 7 (if (= 0 n) 8 '() 9 (cons v (n-of-v (sub1 n) v)))) 10 11 (define (parse-line l) 12 (let* ((parts (string-split l)) 13 (v (string->symbol (car parts))) 14 (n (string->number (cadr parts)))) 15 (n-of-v n v))) 16 17 (define (move pt dir) 18 (let ((x (car pt)) (y (cadr pt))) 19 (cond ((eq? dir 'U) (list x (add1 y))) 20 ((eq? dir 'D) (list x (sub1 y))) 21 ((eq? dir 'L) (list (sub1 x) y)) 22 ((eq? dir 'R) (list (add1 x) y)) 23 (else (error "Bad dir " dir))))) 24 25 (define (adjacent? a b) 26 (let ((xa (car a)) (ya (cadr a)) 27 (xb (car b)) (yb (cadr b))) 28 (and (<= (abs (- xa xb)) 1) 29 (<= (abs (- ya yb)) 1)))) 30 31 ; -10 -> -1, 4 -> 1, 0 -> 0 32 (define (unitize v) 33 (if (= v 0) 34 0 35 (/ v (abs v)))) 36 37 ; idea: head has moved, t to follow, returns new t 38 ; (0 2) (0 0) -> (0 1) 39 ; (1 3) (0 1) -> (1 2) 40 ; if one dim is the same -> just move 1 in other dim 41 ; if both dims diff -> move 1 in both dims 42 ; IOW, move 1 in all directions changed 43 (define (follow h t) 44 (if (adjacent? h t) 45 t 46 (let* ((xh (car h)) (yh (cadr h)) 47 (xt (car t)) (yt (cadr t)) 48 (dx (- xh xt)) (dy (- yh yt))) 49 (list (+ xt (unitize dx)) (+ yt (unitize dy)))))) 50 51 (define (move-all dir knots tail-locs) 52 ; only the head moves according to dir, everything else follows 53 (let ((new-head (move (car knots) dir))) 54 (let loop ((nh new-head) (tails (cdr knots))) 55 (if (null? tails) 56 (begin 57 (hash-table-set! tail-locs nh 'seen) 58 (list nh)) 59 (if (adjacent? nh (car tails)) 60 ; omptimization: can stop -- nothing else will move 61 (cons nh tails) 62 (cons nh (loop (follow nh (car tails)) (cdr tails)))))))) 63 64 ;; NOTE: at first I was purely functional with cons-ing the 65 ;; the h2,t2 to a history and then pulling unique t2's later 66 ;; but that took 10s and it takes .2s to use a hash table :shrug: 67 (define (play-out dirs knots tail-locs) 68 (let loop ((knots knots) (dirs dirs)) 69 (if (null? dirs) 70 'done 71 (let ((ks (move-all (car dirs) knots tail-locs))) 72 ; (newline) 73 ; (plot-state ks) 74 ; (newline) 75 (loop ks (cdr dirs)))))) 76 77 (define (main args) 78 (let* ((dirs (flatten (map parse-line (read-lines)))) 79 (tail-locs-1 (make-hash-table)) 80 (tail-locs-2 (make-hash-table))) 81 (hash-table-set! tail-locs-1 '(0 0) 'start) 82 (hash-table-set! tail-locs-2 '(0 0) 'start) 83 (play-out dirs (n-of-v 2 '(0 0)) tail-locs-1) 84 (play-out dirs (n-of-v 10 '(0 0)) tail-locs-2) 85 (print (hash-table-size tail-locs-1)) 86 (print (hash-table-size tail-locs-2)))) 87 88 89 ;; helpful for debugging! 90 (define (plot-state knots) 91 (print knots) 92 (let loopi ((i -20)) 93 (if (<= i 20) 94 (let loopj ((j -20)) 95 (if (<= j 20) 96 (begin 97 (if (member (list j (* -1 i)) knots) 98 (display "#") 99 (display ".")) 100 (loopj (add1 j))) 101 (begin 102 (newline) 103 (loopi (add1 i)))))))) 104 105 ;; For repl 106 (define slines '("R 4" 107 "U 4" 108 "L 3" 109 "D 1" 110 "R 4" 111 "D 1" 112 "L 5" 113 "R 2"))