1 files changed, 119 insertions, 0 deletions
diff --git a/day03.lisp b/day03.lisp
new file mode 100644
index 0000000..aedf078
--- /dev/null
+++ b/day03.lisp
@@ -0,0 +1,119 @@
+(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