(defun input-lines (f) (with-open-file (s f) (loop for line = (read-line s nil 'eof) until (eq line 'eof) collect line))) (defun is-symbol (s i) (and (>= i 0) (< i (length s)) (let ((c (aref s i))) (and (not (digit-char-p c)) (not (equal #\. c)))))) (defun has-symbol (s j k) (and s (loop for i from j upto k if (is-symbol s i) return t))) (defun is-valid-number (prv cur nxt j k) (or (is-symbol cur (1- j)) (is-symbol cur k) (has-symbol prv (1- j) k) (has-symbol nxt (1- j) k))) (defun sum-valid-numbers-line (prv cur nxt &key (start 0) (acc 0)) (if (= start (length cur)) acc (multiple-value-bind (n end) (parse-integer cur :start start :junk-allowed t) (if (and n (digit-char-p (aref cur start))) (if (is-valid-number prv cur nxt start end) (sum-valid-numbers-line prv cur nxt :start end :acc (+ acc n)) (sum-valid-numbers-line prv cur nxt :start end :acc acc)) (sum-valid-numbers-line prv cur nxt :start (1+ start) :acc acc))))) (defun sum-valid-numbers (rem &key prv (acc 0)) (if rem (sum-valid-numbers (cdr rem) :prv (car rem) :acc (+ acc (sum-valid-numbers-line prv (car rem) (cadr rem)))) acc)) (defun solve1(f) (let ((lines (input-lines f))) (sum-valid-numbers lines))) (defstruct mynumber num loweri lowerj upperi upperj) (defstruct mysymbol symb i j) (defun collect-numbers (lines) (labels ((collect-numbers-line (line i start acc) (if (< start (length line)) (if (digit-char-p (aref line start)) (multiple-value-bind (n end) (parse-integer line :start start :junk-allowed t) (collect-numbers-line line i end (cons (make-mynumber :num n :loweri (1- i) :lowerj (1- start) :upperi (1+ i) :upperj end) acc))) (collect-numbers-line line i (1+ start) acc)) acc)) (collect-numbers-rec (lines i acc) (if lines (collect-numbers-rec (cdr lines) (1+ i) (collect-numbers-line (car lines) i 0 acc)) acc))) (collect-numbers-rec lines 0 ()))) (defun has-adjacent-symbol (gear numbers) (loop for number in numbers if (is-adjacent number gear) collect (mynumber-num number))) (defun collect-gears (lines) (loop for i = 0 then (1+ i) for line in lines append (loop for j = 0 then (1+ j) for c across line if (equal #\* c) collect (make-mysymbol :symb c :i i :j j)))) (defun is-adjacent (number symbol) (and (>= (mysymbol-i symbol) (mynumber-loweri number)) (<= (mysymbol-i symbol) (mynumber-upperi number)) (>= (mysymbol-j symbol) (mynumber-lowerj number)) (<= (mysymbol-j symbol) (mynumber-upperj number)))) (defun find-adjacent-numbers (gear numbers) (loop for number in numbers if (is-adjacent number gear) collect (mynumber-num number))) (defun solve2 (f) (let ((lines (input-lines f))) (let ((numbers (collect-numbers lines)) (gears (collect-gears lines))) (loop for gear in gears as nums = (find-adjacent-numbers gear numbers) if (= (length nums) 2) sum (* (car nums) (cadr nums)))))) (print (solve1 "data/03/example.txt")) ;; 4361 (print (solve1 "data/03/input.txt")) ;; 553079 (print (solve2 "data/03/example.txt")) ;; 467835 (print (solve2 "data/03/input.txt")) ;; 84363105