Advent of Code 2024

(ql:quickload :uiop)
(ql:quickload :alexandria)

(defun yield-grid (input-file)
  (let* ((lines (uiop:read-file-lines input-file))
         (arr (make-array (list (length lines) (length (car lines)))
                          :initial-element nil)))
    (loop for i from 0 below (array-dimension arr 0)
          for line in lines do
            (loop for j from 0 below (array-dimension arr 1)
                  do (setf (aref arr i j) (char line j))))
    arr))

(defparameter *grid* (yield-grid "input.txt"))

(defparameter *cluster-grid* (make-array (array-dimensions *grid*)
                                         :initial-element -1))

(defun scaffold-cluster (init-id chr)
  (let ((charac chr)
        (id init-id)
        (indices (make-hash-table :test 'equal))
        (area 0)
        (perim 0)
        (vertex 0))
    (labels ((get-id ()
               id)
             (get-chr ()
               charac)
             (insert-pos (i j)
               (setf (gethash (list i j) indices) t))
             (indices ()
               (alexandria:hash-table-keys indices))
             (indexp (pos)
               (gethash pos indices))
             (g-area () area)
             (inc-area () (incf area))
             (g-perim () perim)
             (inc-perim () (incf perim))
             (g-vertex () vertex)
             (inc-vertex () (incf vertex))
             (orchestrate (msg)
               (case msg
                 (:id #'get-id)
                 (:chr #'get-chr)
                 (:insert #'insert-pos)
                 (:indices #'indices)
                 (:idxp #'indexp)
                 (:g-area #'g-area)
                 (:g-perim #'g-perim)
                 (:g-vertex #'g-vertex)
                 (:inc-area #'inc-area)
                 (:inc-perim #'inc-perim)
                 (:inc-vertex #'inc-vertex)
                 (otherwise (error 'invalid-msg msg)))))
      #'orchestrate)))

(defmacro cf (cluster msg &rest args)
  `(funcall (funcall ,cluster ,msg) ,@args))

(defparameter *clusters* (make-hash-table))

(defmacro cidf (id msg &rest args)
  `(cf ,(gethash id *clusters*) ,msg ,@args))


(defun unmarked (i j)
  (when (array-in-bounds-p *cluster-grid* i j)
    (= (aref *cluster-grid* i j) -1)))

(defun find-cluster (test-fn)
  (loop for i from 0 below (array-dimension *cluster-grid* 0)
        do (loop for j from 0 below (array-dimension *cluster-grid* 1)
                 do (when (funcall test-fn i j)
                      (return-from find-cluster  (list i j))))))

(defun find-unmarked () (find-cluster #'unmarked))

(defun surroundings (i j)
  (list
   (list i (1- j))
   (list (1- i) j)
   (list (1+ i) j)
   (list i (1+ j))))

(defparameter *corners* (list (list 1 1)
                              (list -1 -1)
                              (list 1 -1)
                              (list -1 1)))

(defun explore-root (id i j)
  (let* ((c-char (aref *grid* i j))
         (c (scaffold-cluster id c-char)))
    (setf (gethash id *clusters*) c)
    (labels ((same? (ic jc)
               (when (array-in-bounds-p *grid* ic jc)
                 (eq (aref *grid* ic jc) c-char)))
             (explore-dir-vertex (ic jc istep jstep)
               (when (array-in-bounds-p *grid* ic jc)
                 (let ((istpd (same? (+ ic istep) jc))
                       (jstpd (same? ic (+ jc jstep)))
                       (ijstpd (same? (+ ic istep) (+ jc jstep))))
                   (when  (or  (and (not istpd)
                                    (not jstpd))
                               (and (not ijstpd)
                                    istpd
                                    jstpd))
                     (cf c :inc-vertex)))))
             (explore-iter (ic jc)
               (if (array-in-bounds-p *grid* ic jc)
                   (cond
                     ((same? ic jc) (when (unmarked ic jc)
                                      (progn
                                        (cf c :inc-area)
                                        (setf (aref *cluster-grid* ic jc) id)
                                        (cf c :insert ic jc)
                                        (mapcar #'(lambda (pos)
                                                    (apply #'explore-iter pos))
                                                (surroundings ic jc)))))
                     (t (cf c :inc-perim)))
                   (cf c :inc-perim))))
      (explore-iter i j)
      (dolist (cpos (cf c :indices))
        (dolist (corner *corners*)
          (explore-dir-vertex (car cpos) (cadr cpos) (car corner) (cadr corner))))
      (values (cf c :g-area)
              (cf c :g-perim)
              (cf c :g-vertex)))))

(defun build-cluster-grid ()
  (let ((acc-area-perim 0)
        (acc-area-sides 0))
    (do ((next-unmarked (list 0 0) (find-unmarked))
         (id 0 (1+ id)))
        ((not next-unmarked) (list acc-area-perim acc-area-sides))
      (multiple-value-bind (area perim sides)
          (apply #'explore-root (cons id next-unmarked))
        (incf acc-area-perim (* area perim))
        (incf acc-area-sides (* area sides))))))

(ql:quickload :uiop)

(defparameter *stones* (uiop:split-string (uiop:read-file-line "input.txt")))

(defun even-str-p (string) (evenp (length string)))
(defun strip-string (stone) (write-to-string (parse-integer stone)))
(defun x2024 (stone) (write-to-string (* (parse-integer stone) 2024)))
(defun halves (string)
    (let ((split (/ (length string) 2)))
    (mapcar #'strip-string (list (subseq string 0 split) (subseq string split)))))

(defparameter *mem* (make-hash-table :test 'equal))
(defmacro ghsh (stone steps)
    `(gethash (list ,stone ,steps) *mem*))

(defun nstep (stone steps)
    (if (ghsh stone steps) (ghsh stone steps)
        (setf (ghsh stone steps)
            (cond ((= steps 0) 1)
                    ((equal stone "0") (nstep "1" (1- steps)))
                    ((even-str-p stone) (apply #'+ (mapcar #'(lambda (stone)
                                                                (nstep stone (1- steps)))
                                                            (halves stone))))
                    (t (nstep (x2024 stone) (1- steps)))))))

(defun solve (i)
    (apply #'+ (mapcar #'(lambda (stone) (nstep stone i)) *stones*)))

(ql:quickload :uiop)
(ql:quickload :alexandria)

;; dynamic prog

;; at an n (store current position if peak)
;; merge positions of all surrounding (n+1s)
;; at a base (collate results of the base+1)

(defparameter *base* 0)
(defparameter *peak* 9)

(defun char->int (char)
  (- (char-int char)
     (char-int #\0)))

(defun parse-topography (input-file)
  (let* ((lines (uiop:read-file-lines input-file))
         (arr (make-array (list (length lines) (length (car lines)))
                          :element-type 'integer)))
    (loop for row from 0 below (array-dimension arr 0)
          do (loop for col from 0 below (array-dimension arr 1)
                   do (setf (aref arr row col)
                            (char->int (aref  (nth row lines) col) ) )))
    arr))

(defparameter *topography* (parse-topography "input.txt"))

(defparameter *collates* (make-array (array-dimensions *topography*)
                                     :initial-element nil
                                     :element-type 'list))

(defun prot-get (arr i j)
  (when (array-in-bounds-p arr i j)
    (aref arr i j)))

(defun prot-set (arr i j val)
  (when (array-in-bounds-p arr i j)
    (setf (aref arr i j) val)))

(defun tget (i j) (prot-get *topography* i j))
(defun tset (i j val) (prot-set *topography* i j val))

(defun cget (i j) (prot-get *collates* i j))
(defun cset (i j val) (prot-set *collates* i j val))

(defun cpush (i j vals)
  (let ((init-vals (cget i j)))
    (setf (aref *collates* i j) (append vals init-vals))))

;; start from peak
;; iterate until base

(defparameter rows (array-dimension *topography* 0))
(defparameter cols (array-dimension *topography* 1))

(defun surroundings (i j)
  (list (list (1+ i) j)
        (list i (1+ j))
        (list (1- i) j)
        (list i (1- j))))

(defun mark-surrounding-inits (i j n)
  (loop for pos in (surroundings i j)
        do (if (eq (tget (car pos) (cadr pos)) (1- n))
               (cpush (car pos) (cadr pos) (cget i j)))))

(defun populate-collation ()
  (loop for curr from *peak* above *base*
        do (loop for i from 0 below rows do
                 (loop for j from 0 below cols
                       do (when (= (tget i j)
                                   curr)
                            (when (= curr  *peak*)
                              (cpush i j (list (list  i j))))
                            (mark-surrounding-inits i j curr))))))

(defun deduplicate ()
  (loop for i from 0 below rows do
                 (loop for j from 0 below cols
                       do (cset i j (remove-duplicates (cget i j)
                                                       :test #'equal)))))

(defun report-base-scores ()
  (let ((acc 0))
    (loop for i from 0 below rows do
      (loop for j from 0 below cols
            do (when (= (tget i j) *base*)
                 (incf acc (length (cget i j))))))
    acc))

(defun solve-p1 ()
  (populate-collation)
  (deduplicate)
  (report-base-scores))

(defun solve-p2 ()
  (populate-collation)
  ;; (deduplicate)
  (report-base-scores))

(ql:quickload :uiop)
(ql:quickload :alexandria)


(defun swap (arr i1 i2)
    (let ((temp (aref arr i1)))
    (setf (aref arr i1) (aref arr i2))
    (setf (aref arr i2) temp)))

(defun swap-lr (arr ll lr rl rr)
  (dotimes (i (1+ (- lr ll)) )
    (swap arr (+ ll i) (+ rl i))))

(defun len (r)
  (- (cadr r)
     (car r)
     -1))

(defun process-init-checksum (input)
  (let* ((checksum (mapcar  #'(lambda (char)  (- (char-int char)
                                                 (char-int #\0)))
                            (coerce (car (uiop:read-file-lines input)) 'list)))
         (total-blocks (apply #'+ checksum))
         (disk (make-array (list total-blocks) :initial-element -1))
         (flrs nil)
         (eyrs nil))
    (let ((i 0)
          (id 0)
          (empty nil))
      (dolist (j checksum)
        (if (not empty)
            (progn
              (push (list i (+ j i -1)) flrs)
              (dotimes (b j)
                (setf (aref disk i) id)
                (incf i))
              (incf id)
              (setf empty t))
            (progn
              (when (>= (+ j i -1) i)
                (push (list i (+ j i -1)) eyrs))
              (dotimes (b j)
                (setf (aref disk i) -1)
                (incf i))
              (setf empty nil)))))
    (setf eyrs (nreverse eyrs))

    (labels ((check-swap ()
               (let* ((eyr (car eyrs))
                      (flr (find-if #'(lambda (flr)
                                        (<= (len flr)
                                            (len eyr)))
                                    flrs)))
                 (if flr
                     (let* ((ll (car eyr))
                            (lr (+ ll (len flr) -1))
                            (rl (car flr))
                            (rr (cadr flr)))
                       (if (= (len flr) (len eyr))
                           (pop eyrs)
                           (let ((neweyr (list (1+ lr) (cadr eyr))))
                             (pop eyrs)
                             (push neweyr eyrs)))
                       (setf flrs
                             (remove-if #'(lambda (an-flr)
                                            (equal an-flr flr))
                                        flrs))
                       (swap-lr disk ll lr rl rr))
                     (pop eyrs)))))
      (do ()
          ((null eyrs) nil)
        (check-swap)))

    (do ((i 0 (+ 1 i))
         (acc 0 acc))
        ((eq i (length disk)) acc)
      (when (not (eq (aref disk i) -1))
        (incf acc (* (aref disk i) i))))))

(process-init-checksum "input.txt")

(ql:quickload :uiop)
(ql:quickload :alexandria)

(defun build-arr (input-file)
  (let* ((lines  (uiop:read-file-lines input-file))
         (arr (make-array (list (length lines) (length (car lines)))
                          :element-type 'character)))
    (loop for row from 0 below (array-dimension arr 0)
          for line in lines do
            (loop for col from 0 below (array-dimension arr 1)
                  do (setf (aref arr row col)
                           (aref line col))))
    arr))

(defparameter arr (build-arr "input.txt"))

(defun fetch (i j) (when (array-in-bounds-p arr i j) (aref arr i j)))

(defun setarr (i j val)
  (when (array-in-bounds-p arr i j) (setf (aref arr i j) val)))

(defparameter hash (make-hash-table))

(defun inshash (key val)
  (if (gethash key hash)
      (setf (gethash key hash) (cons val (gethash key hash)))
      (setf (gethash key hash) (list val))))

(defun build-hash-from-arr ()
  (loop for i from 0 below (array-dimension arr 0)
        do (loop for j from 0 below (array-dimension arr 1)
                 do (let ((chr (fetch i j)))
                      (when (not (eq chr #\.))
                        (inshash chr (list i j)))))))

(build-hash-from-arr)

(defun build-pairs (items)
  (remove-duplicates
   (remove-if #'(lambda (coords)  (or (equal (car coords)
                                             (cadr coords))))
              (alexandria:map-product #'list items items))
   :test #'(lambda (a b) (equal a (reverse b)))))

(defun vec-add (p1 p2)
  (mapcar #'+ p1 p2))

(defun vec-mul (p factor)
  (mapcar #'(lambda (ele) (* ele factor)) p))

(defun extrapolate (va vb)
  (let ((dir (vec-add vb (vec-mul va -1)))
        (antis '()))
    (do ((anti (vec-add va dir) (vec-add anti dir)))
        ((not (array-in-bounds-p arr (car anti) (cadr anti))) antis)
      (push anti antis))))

(defun calc-antinodes (va vb)
  (append (extrapolate va vb)
          (extrapolate vb va)))

(defun report-all-antinodes ()
  (remove-if-not #'(lambda (coord) (apply #'array-in-bounds-p arr coord))
                 (remove-duplicates
                  (reduce #'append
                          (mapcar #'(lambda (coord) (apply #'calc-antinodes coord))
                                  (reduce #'append
                                          (mapcar #'build-pairs
                                                  (alexandria:hash-table-values hash)))))
                  :test 'equal)))

(defun solve ()
    (length (report-all-antinodes)))

(ql:quickload :uiop)
(ql:quickload :cl-ppcre)

(defun parse-line (line)
  (let ((parsed (cl-ppcre:split ": " line)))
    (list (parse-integer (car parsed))
          (mapcar #'parse-integer
                  (uiop:split-string (cadr parsed))))))

(defun || (int1 int2)
  (parse-integer (format nil "~S~S" int1 int2)))

(defun dfs (target path)
  (labels ((dfs-iter (left acc)
             (macrolet ((fork (op) `(dfs-iter (cdr left) (,op acc (car left)))))
               (cond ((null left) (= acc target))
                     (t (or (fork *) (fork +) (fork ||)))))))
    (dfs-iter (cdr path) (car path))))

(defun solve (input-file)
  (apply #'+ (remove-if #'null
                    (mapcar #'(lambda (line)
                                (let ((parsed (parse-line line)))
                                  (when (dfs (car parsed) (cadr parsed))
                                    (car parsed))))
                            (uiop:read-file-lines input-file)))))

(ql:quickload :uiop)
(ql:quickload :alexandria)

(defvar input (uiop:read-file-lines "test.txt"))

(defun gen-util-funcs (arr)
  (macrolet ((in? (i low high)
               `(and (< ,i ,high)
                     (>= ,i ,low))))
    (let ((rows (length arr))
          (cols (length (car arr)))
          (utils (make-hash-table)))
      (setf (gethash :idx utils )
            (lambda (i j)
              ;; indexer
              (aref (nth i arr) j)))
      (setf (gethash :set utils)
            (lambda (i j char)
              (setf (aref (nth i arr) j) char)))
      (setf (gethash :chk utils)
            (lambda (i j)
              ;; validity checker
              (and (in? i 0 rows)
                   (in? j 0 cols))))
      utils)))

(defvar utils (gen-util-funcs input))

(defun fetch (i j)
  (when (funcall (gethash :chk utils) i j)
    (funcall (gethash :idx utils) i j)))

(defun setgr (i j char)
  (when (funcall (gethash :chk utils) i j)
    (funcall (gethash :set utils) i j char)))

(defun setgrl (l char)
  (setgr (car l) (cadr l) char))

(defun fetchl (l)
  (fetch (car l) (cadr l)))


;; orientation can be decided by current stepper func
;; storing such that when you cycling through them is turning right
(defvar dirs
  (list
   #'(lambda (i j)
       (list (1- i) j))
   #'(lambda (i j)
       (list i (1+ j)))
   #'(lambda (i j)
       (list (1+ i) j))
   #'(lambda (i j)
       (list  i (1- j)))))

(defvar dir-hash (make-hash-table))
(setf (gethash #\^ dir-hash) 0)
(setf (gethash #\> dir-hash) 1)
(setf (gethash #\v dir-hash) 2)
(setf (gethash #\< dir-hash) 3)

(defun yield-dir (dx)
  (nth dx dirs))

(defun turn-right (dx)
  (mod (1+ dx) 4))

(defun turn-left (dx)
  (mod (1- dx) 4))

(defun turn-around (dx)
  (mod (+ 2 dx) 4))

;; moving around
;; given initial directions
;; dowhile with a counter map and incf for new place
;; continue until fetch is nil
;; when fetch is obstacle, turn right
;; when fetch is ., step
;; recurse

(defun detect-initial-pos-dir ()
  (dotimes (i (length input))
    (dotimes (j (length (car input)))
      (let ((curr (fetch i j)))
        (when (not (find curr (list #\. #\#)))
          (setgr i j #\X)
          (return-from detect-initial-pos-dir (list i j (gethash curr dir-hash))))))))

;; store dirs walked at an x
;; when x and dir sync, stop step

(defun walkeds (input)
  (loop repeat (length input)
        collect (loop repeat (length (car input))
                      collect '())))

(defvar walkeds (walkeds input))

(defmacro fwalkeds (i j)
  `(nth  ,j (nth ,i walkeds)))

(defun inswalkeds (i j char)
  (setf (fwalkeds i j) (cons char (fwalkeds i j))))

(defun coincides? (i j dir)
  (find dir (fwalkeds i j)))

(defvar found-obs '())

(defun already-placed? (i j)
  (find -1 (fwalkeds i j)))

(defun potential-obs-ahead? (i j dir)
  (cond
    ((not (fetch i j)) nil)
    ((coincides? i j dir) t)
    (t
     (let ((next (funcall (yield-dir dir) i j)))
       (if (eq (fetchl next) #\#)
           (apply #'potential-obs-ahead? (append next (list (turn-right dir))))
           (potential-obs-ahead? (car next) (cadr next) dir))))))

(defun walk ()
  (let ((marked 1)
        (potential-obs 0)
        (obses '())
        (pos-dir (detect-initial-pos-dir)))
    (labels ((stp (dx i j)
               (let* ((next (funcall (yield-dir dx) i j))
                      (fnext (fetchl next)))
                 (inswalkeds i j dx)
                 (cond ((eq fnext #\.) (progn
                                         (when (potential-obs-ahead? i j (turn-right dx))
                                           (when (apply #'already-placed? next)
                                             (decf potential-obs))
                                           (setf obses  (cons  (list (list 'in-from  i j)
                                                                     `('obs-on ,@next) dx (turn-right dx))
                                                               obses))
                                           (incf potential-obs))
                                         (setgrl next #\X)
                                         (incf marked)
                                         (stp dx (car next) (cadr next))))
                       ((eq fnext #\#) (stp (turn-right dx) i j))
                       ((eq fnext #\X)
                        (progn
                          (when (potential-obs-ahead? i j (turn-right dx))
                            (when (apply #'already-placed? next)
                              (decf potential-obs))
                            (setf obses  (cons  (list (list 'in-from  i j)
                                                      `('obs-on ,@next) dx (turn-right dx))
                                                obses))
                            (incf potential-obs))
                          (stp dx (car next) (cadr next))))
                       (t (list obses marked potential-obs))))))
      (inswalkeds (car pos-dir)
                  (cadr pos-dir)
                  (caddr pos-dir))
      (stp (caddr pos-dir)
           (car pos-dir)
           (cadr pos-dir)))))

(ql:quickload :uiop)
(ql:quickload :alexandria)
(ql:quickload :cl-ppcre)

(defun parse-input (input-file)
  (let* ((parsed (cl-ppcre:split "\\n\\n" (uiop:read-file-string input-file)))
         (edges (cl-ppcre:split "\\n" (car parsed)))
         (updates (cl-ppcre:split "\\n" (cadr parsed))))
    (list edges updates)))

(defun gen-hash-manager ()
  (let ((hsh (make-hash-table)))
    #'(lambda (message)
        (cond ((eq message 'reset)
               #'(lambda ()
                   (clrhash hsh)))
              ((eq message 'table)
               #'(lambda ()
                   hsh))
              ((eq message 'insert)
               #'(lambda (key val)
                   (let ((existing (gethash key hsh)))
                     (if existing
                         (setf (gethash key hsh) (cons val existing))
                         (setf (gethash key hsh) (list val))))))
              ((eq message 'fetch)
               #'(lambda (key)
                   (gethash key hsh)))
              (t (error message "invalid message received"))))))

(defvar hasher (gen-hash-manager))

(defun insert (key val)
  (funcall (funcall hasher 'insert) key val))

(defun fetch (key)
  (funcall (funcall hasher 'fetch) key))

(defun build-hash (edges)
  (dolist (edge edges)
    (let ((split (cl-ppcre:split #\| edge)))
      (insert (parse-integer (cadr split))
              (parse-integer (car split))))))

(defvar input (parse-input "input.txt"))

(build-hash (car input))

(defun check-update (update)
  (let ((update (mapcar #'parse-integer update))
        (mid (ceiling (/ (length update)
                       2)))
        (middle nil))
    (do ((curr (car update) (car tail))
         (tail (cdr update) (cdr tail))
         (i 1 (+ i 1)))
        ((not tail) middle)
      (when (= i mid)
        (setf middle curr))
      (when (intersection tail (fetch curr))
        (return nil)))))

(defun solve-p1 ()
  (reduce #'(lambda (acc curr)
              (+ acc (if curr curr 0)))
          (mapcar #'check-update (mapcar (alexandria:curry #'cl-ppcre:split #\,) (cadr input)))
          :initial-value 0))

;; part 2

(defun insert-at-index (list element index)
  (if (zerop index)
      (cons element list)
      (let ((head (subseq list 0 index))
            (tail (nthcdr index list)))
        (append head (list element) tail))))

(defun curtail (curr tail intsction)
  (let ((fixes (insert-at-index tail
                                curr
                                (1+ (apply #'max
                                           (mapcar #'(lambda (ele)
                                                       (position ele tail))
                                                   intsction))))))
    (values (car fixes) (cdr fixes))))


(defun check-fixed-update (update)
  (let ((update (mapcar #'parse-integer update))
        (mid (ceiling (/ (length update)
                         2)))
        (fix-flag nil)
        (middle nil))
    (do ((curr (car update) (car tail))
         (tail (cdr update) (cdr tail))
         (i 1 (+ i 1)))
        ((not tail) (when fix-flag middle))
      (tagbody
         start
         (let ((intsction (intersection tail (fetch curr))))
           (when intsction
             (setf fix-flag t)
             (multiple-value-bind (cr tl)
                 (curtail curr tail intsction)
               (setf curr cr
                     tail tl))
             (go start)))
         (when (= i mid)
           (setf middle curr))))))

(defun solve-p2 ()
  (reduce #'(lambda (acc curr)
              (print curr)
              (+ acc (if curr curr 0)))
          (mapcar #'check-fixed-update (mapcar (alexandria:curry #'cl-ppcre:split #\,) (cadr input)))
          :initial-value 0))

;; for each cell, check 8 directions
;; checking in a direction can be generically identified as an accumulated past state and the stepper function
;; the stepper functions will then be 8 of them ranging cartesian product of +1,-1,0 for x,y except 0,0 (9-1)
;; can build steppers dynamically with macros


;; the checker actually uses a stepper func, has the current state and has the knowledge of the state machine baked in

(ql:quickload :uiop)
(ql:quickload :alexandria)

(defvar input (uiop:read-file-lines "input.txt"))

(defun gen-util-funcs (arr)
  (macrolet ((in? (i low high)
               `(and (< ,i ,high)
                     (>= ,i ,low))))
    (let ((rows (length arr))
          (cols (length (car arr)))
          (utils (make-hash-table)))
      (setf (gethash :idx utils )
            (lambda (i j)
                ;; indexer
                (aref (nth i arr) j)))
      (setf (gethash :chk utils)
            (lambda (i j)
                ;; validity checker
                (and (in? i 0 rows)
                     (in? j 0 cols))))
      utils)))

(defvar utils (gen-util-funcs input))

(defun fetch (i j)
  (when (funcall (gethash :chk utils) i j)
    (funcall (gethash :idx utils) i j)))

(defun build-stepper (steps)
  #'(lambda (x y)
      (list (+ x (car steps))
            (+ y (cadr steps)))))

(defvar steppers
  (cdr (mapcar #'build-stepper
               (loop for x in
                           (list 0 1 -1)
                     nconc
                     (loop for y in
                                 (list 0 1 -1)
                           collect (list x y)))) ))

(defun checker (i j stepper req)
  (labels ((iter-check (x y req-i)
             (let ((fetched (fetch x y))
                   (lreq (length req)))
               (cond ((= req-i lreq)
                      t)
                     ((not fetched)
                      nil)
                     ((equal fetched (aref req req-i))
                      (apply #'iter-check (append (funcall stepper x y) (list (+ 1 req-i)))))))))
    (iter-check i j 0)))


(defun collate-checks (i j req)
  (count 't (mapcar #'(lambda (stepper)
                        (checker i j stepper req))
                    steppers)))

(defun solve-p1 (req)
  (let ((acc 0))
    (dolist (i (alexandria:iota (length input)))
      (dolist (j (alexandria:iota (length (car input))))
        (incf acc (collate-checks i j req))))
    acc))


;; part 2
;; approach still the same via specific steppers, just validator can be monolithic

(defun check-X-MAS (i j)
  (when (equal (fetch i j) #\A)
    (and (eval `(or ,@(mapcar (alexandria:curry
                         #'checker (1- i) (1- j) (build-stepper (list 1 1)))
                        (list "MAS" "SAM"))))
         (eval `(or ,@(mapcar (alexandria:curry
                              #'checker (1+ i) (1- j) (build-stepper (list -1 1)))
                             (list "MAS" "SAM")))))))


(defun solve-p2 ()
  (let ((acc 0))
    (dolist (i (alexandria:iota (1- (length input)) :start 1))
      (dolist (j (alexandria:iota (1- (length (car input))) :start 1))
        (when (check-x-mas i j)
          (incf acc 1))))
    acc))

(ql:quickload :uiop)
(ql:quickload :cl-ppcre)

(defvar input (read-file-to-string "input"))

;; part 1

(defun extract-mul-parameters (input-string)
        (multiple-value-bind (matched-p matches)
                (cl-ppcre:scan-to-strings "mul\\((\\d+),(\\d+)\\)" input-string)
            (when matched-p
                    matches)))

(defun parse-mul (match)
        (let* ((parse-vec (extract-mul-parameters match))
                    (n1 (parse-integer (svref parse-vec 0)))
                    (n2 (parse-integer (svref parse-vec 1))))
            (* n1 n2)))

(defun solve-p1 (input)
        (apply #'+ (mapcar #'parse-mul
                                (cl-ppcre:all-matches-as-strings
                                    "mul\\((\\d+),(\\d+)\\)"
                                        input))))
;; part 2

(defun solve-p2 (input)
        (let ((do? t)
                (acc 0))
            (dolist (state (cl-ppcre:all-matches-as-strings
                                "mul\\((\\d+),(\\d+)\\)|do\\(\\)|don't\\(\\)"
                                    input)
                                acc)
                    (cond ((equal state "do()") (setf do? t))
                            ((equal state "don't()") (setf do? nil))
                                (t (when do?
                                            (incf acc (parse-mul state))))))))

(defvar test-input
  '((7 6 4 2 1)
    (1 2 7 8 9)
    (9 7 6 2 1)
    (1 3 2 4 5)
    (8 6 4 4 1)
    (1 3 6 7 9)))

(defun transit-diff-set (report)
  (let ((len (length report)))
    (remove-duplicates (mapcar #'(lambda (n-1 n)
                                   (- n n-1))
                               (subseq report 0 (- len 1))
                               (subseq report 1 len)) )))

(defun dampened-val-report (report)
  (if (val-report report)
      1
      (do ((i 0 (+ 1 i)))
          ((= i (length report)) 0)
        (let ((candidate (append
                          (subseq report 0 i)
                          (subseq report (+ i 1) (length report)))))
          (when (val-report candidate)
            (return 1))))))

(defun val-report (report)
  (let* ((diffs (transit-diff-set report))
         (abs-diffs (remove-duplicates (mapcar #'abs diffs))))
    (cond ((find 0 abs-diffs )  nil)
          ((> (apply #'max abs-diffs) 3) nil)
          ((= (length (remove-duplicates (mapcar #'signum diffs))) 2) nil)
          (t 1))))

(defun safe-reports (input)
  (apply #'+ (mapcar #'dampened-val-report input)))

(ql:quickload :alexandria)

(defvar test-input
  '((3   4)
    (4   3)
    (2   5)
    (1   3)
    (3   9)
    (3   3)))

;;
;; Part 1
(defmacro parse-sort (selector input)
  (let ((ele (gensym)))
    `(sort (mapcar #'(lambda (,ele)
                       (coerce (,selector ,ele) 'integer))
                   ,input)
      #'>)))


(defun add-abs-diff-solver (input)
 (apply #'+ (mapcar (lambda (x y) (abs (- x y) ))
                       (parse-sort car input)
                       (parse-sort cadr input))))

;; Part 2
;;

(defun build-hash (lis table)
  (labels ((increment-hash (ele)
             (if (gethash ele table)
                 (incf (gethash ele table) 1)
                 (setf (gethash ele table) 1))))
    (mapcar #'increment-hash lis)))

(defun built-hash (lis)
  (let ((hash (make-hash-table)))
    (build-hash lis hash)
    hash))

(defun freq-mul-add-solver (input)
  (let ((h-a (built-hash (parse-sort car input)))
        (h-b (built-hash (parse-sort cadr input)))
        (acc 0))
    (dolist (ka (alexandria:hash-table-keys h-a)
                acc)
      (incf acc (if (gethash ka h-b)
                 (* (gethash ka h-a)
                    (gethash ka h-b)
                    ka)
                 0)))))