Day 4: Ceres Search
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 1 point
Lisp
Not super happy with the code, but it got the job done.
Part 1 and 2
(defun p1-process-line (line)
(to-symbols line))
(defun found-word-h (word data i j)
"checks for a word existing from the point horizontally to the right"
(loop for j2 from j
for w in word
when (not (eql w (aref data i j2)))
return nil
finally (return t)))
(defun found-word-v (word data i j)
"checks for a word existing from the point vertically down"
(loop for i2 from i
for w in word
when (not (eql w (aref data i2 j)))
return nil
finally (return t)))
(defun found-word-d-l (word data i j)
"checks for a word existsing from the point diagonally to the left and down"
(destructuring-bind (n m) (array-dimensions data)
(declare (ignorable n))
(and (>= (- i (length word)) -1)
(>= m (+ j (length word)))
(loop for i2 from i downto 0
for j2 from j
for w in word
when (not (eql w (aref data i2 j2)))
return nil
finally (return t)))))
(defun found-word-d-r (word data i j)
"checks for a word existing from the point diagonally to the right and down"
(destructuring-bind (n m) (array-dimensions data)
(and (>= n (+ i (length word)))
(>= m (+ j (length word)))
(loop for i2 from i
for j2 from j
for w in word
when (not (eql w (aref data i2 j2)))
return nil
finally (return t)))
))
(defun count-word-h (data word)
"Counts horizontal matches of the word"
(let ((word-r (reverse word))
(word-l (length word)))
(destructuring-bind (n m) (array-dimensions data)
(loop for i from 0 below n
sum (loop for j from 0 upto (- m word-l)
count (found-word-h word data i j)
count (found-word-h word-r data i j))))))
(defun count-word-v (data word)
"Counts vertical matches of the word"
(let ((word-r (reverse word))
(word-l (length word)))
(destructuring-bind (n m) (array-dimensions data)
(loop for j from 0 below m
sum (loop for i from 0 upto (- n word-l)
count (found-word-v word data i j)
count (found-word-v word-r data i j))))))
(defun count-word-d (data word)
"Counts diagonal matches of the word"
(let ((word-r (reverse word)))
(destructuring-bind (n m) (array-dimensions data)
(loop for i from 0 below n
sum (loop for j from 0 below m
count (found-word-d-l word data i j)
count (found-word-d-l word-r data i j)
count (found-word-d-r word data i j)
count (found-word-d-r word-r data i j)
)))))
(defun run-p1 (file)
"cares about the word xmas in any direction"
(let ((word '(X M A S))
(data (list-to-2d-array (read-file file #'p1-process-line))))
(+
(count-word-v data word)
(count-word-h data word)
(count-word-d data word))))
(defun run-p2 (file)
"cares about an x of mas crossed with mas"
(let ((word '(M A S))
(word-r '(S A M))
(data (list-to-2d-array (read-file file #'p1-process-line))))
(destructuring-bind (n m) (array-dimensions data)
(loop for i from 0 below (- n 2)
sum (loop for j from 0 below (- m 2)
count (and (found-word-d-r word data i j)
(found-word-d-l word data (+ i 2) j))
count (and (found-word-d-r word-r data i j)
(found-word-d-l word data (+ i 2) j))
count (and (found-word-d-r word data i j)
(found-word-d-l word-r data (+ i 2) j))
count (and (found-word-d-r word-r data i j)
(found-word-d-l word-r data (+ i 2) j))
)))))
