day-18.lisp (2364B)
1 (defpackage #:aoc/day-18 2 (:use #:cl #:aoc/utils) 3 (:export #:day-18)) 4 (in-package #:aoc/day-18) 5 6 (defun parse-line (line) 7 (multiple-value-bind (dig-length end) 8 (parse-integer line :start 2 :junk-allowed t) 9 (list (switch ((aref line 0)) 10 (#\U :up) 11 (#\L :left) 12 (#\R :right) 13 (#\D :down)) 14 dig-length 15 (switch ((aref line (+ end 3 5))) 16 (#\0 :right) 17 (#\1 :down) 18 (#\2 :left) 19 (#\3 :up)) 20 (parse-integer line 21 :start (+ end 3) 22 :end (+ end 3 5) 23 :radix 16)))) 24 25 (defun dir-diff (dir length) 26 (ecase dir 27 (:up (cons 0 (- length))) 28 (:left (cons (- length) 0)) 29 (:right (cons length 0)) 30 (:down (cons 0 length)))) 31 32 (declaim (ftype (function ((simple-array cons)) fixnum) shoelace)) 33 (defun shoelace (vertices) 34 (loop with n = (- (length vertices) 2) 35 repeat n 36 for i from 0 37 for j = (1+ i) 38 for x-1 fixnum = (car (aref vertices i)) 39 for y-1 fixnum = (cdr (aref vertices i)) 40 for x-2 fixnum = (car (aref vertices j)) 41 for y-2 fixnum = (cdr (aref vertices j)) 42 sum (the fixnum (* x-1 y-2)) into sum-1 fixnum 43 sum (the fixnum (* x-2 y-1)) into sum-2 fixnum 44 finally (return (/ (the fixnum (abs (- sum-1 sum-2))) 2)))) 45 46 47 (defun day-18 (input) 48 (loop with vertices-1 = (list (cons 0 0)) 49 with vertices-2 = (list (cons 0 0)) 50 with current-1 = (cons 0 0) 51 with current-2 = (cons 0 0) 52 for line = (read-line input nil) 53 while line 54 for (dir-1 length-1 dir-2 length-2) = (parse-line line) 55 sum length-1 into length-1-sum 56 sum length-2 into length-2-sum 57 do (setf current-1 (point+ current-1 (dir-diff dir-1 length-1))) 58 do (setf current-2 (point+ current-2 (dir-diff dir-2 length-2))) 59 do (push current-1 vertices-1) 60 do (push current-2 vertices-2) 61 finally (return (values (+ (shoelace (coerce (nreverse vertices-1) 'vector)) 62 (/ length-1-sum 2) 63 1) 64 (+ (shoelace (coerce (nreverse vertices-2) 'vector)) 65 (/ length-2-sum 2) 66 1)))))