day 19 part 1 done
This commit is contained in:
parent
72e1b88b45
commit
c611d65437
4 changed files with 274 additions and 14 deletions
2
aoc.asd
2
aoc.asd
|
@ -47,6 +47,7 @@
|
||||||
(:file "2024/day16")
|
(:file "2024/day16")
|
||||||
(:file "2024/day17")
|
(:file "2024/day17")
|
||||||
(:file "2024/day18")
|
(:file "2024/day18")
|
||||||
|
(:file "2024/day19")
|
||||||
)))
|
)))
|
||||||
:description "Advent of Code challenges and solutions."
|
:description "Advent of Code challenges and solutions."
|
||||||
:long-description "Solutions for the AOC challenges."
|
:long-description "Solutions for the AOC challenges."
|
||||||
|
@ -81,6 +82,7 @@
|
||||||
(:file "2024/day16-test")
|
(:file "2024/day16-test")
|
||||||
(:file "2024/day17-test")
|
(:file "2024/day17-test")
|
||||||
(:file "2024/day18-test")
|
(:file "2024/day18-test")
|
||||||
|
(:file "2024/day19-test")
|
||||||
)))
|
)))
|
||||||
:description "Test system for aoc"
|
:description "Test system for aoc"
|
||||||
:perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))
|
:perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))
|
||||||
|
|
|
@ -27,19 +27,6 @@
|
||||||
(#\> (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
|
(#\> (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
|
||||||
))
|
))
|
||||||
|
|
||||||
(defun show-map (map &optional (dest t))
|
|
||||||
(let ((w (array-dimension map 1))
|
|
||||||
(h (array-dimension map 0)))
|
|
||||||
(format
|
|
||||||
dest "~{~A~}"
|
|
||||||
(loop
|
|
||||||
for row from 0 below h
|
|
||||||
collect (format nil "~A~%"
|
|
||||||
(coerce
|
|
||||||
(loop for col from 0 below w
|
|
||||||
collect (aref map row col))
|
|
||||||
'string))))))
|
|
||||||
|
|
||||||
(defun get-pos (map pos)
|
(defun get-pos (map pos)
|
||||||
(aref map (pos-y pos) (pos-x pos)))
|
(aref map (pos-y pos) (pos-x pos)))
|
||||||
|
|
||||||
|
@ -186,7 +173,6 @@
|
||||||
(best-tm 0))
|
(best-tm 0))
|
||||||
(loop
|
(loop
|
||||||
for x = 1
|
for x = 1
|
||||||
do (format t "delta: ~A, tm: ~A, best-tm: ~A~%" delta tm best-tm)
|
|
||||||
until (zerop delta)
|
until (zerop delta)
|
||||||
if (best-path mem tm)
|
if (best-path mem tm)
|
||||||
do (progn
|
do (progn
|
||||||
|
|
188
src/2024/day19.lisp
Normal file
188
src/2024/day19.lisp
Normal file
|
@ -0,0 +1,188 @@
|
||||||
|
|
||||||
|
(defpackage :aoc/2024/19
|
||||||
|
(:use :cl :aoc :alexandria :trivia :lla)
|
||||||
|
(:export
|
||||||
|
#:sample-data
|
||||||
|
#:sample-data2
|
||||||
|
#:part1
|
||||||
|
#:part2
|
||||||
|
#:towel-tree
|
||||||
|
#:valid-pattern-p
|
||||||
|
#:make-onsen
|
||||||
|
#:onsen-towels
|
||||||
|
#:onsen-patterns
|
||||||
|
#:remaining-patterns
|
||||||
|
#:reset-patterns
|
||||||
|
#:possible-patterns
|
||||||
|
))
|
||||||
|
|
||||||
|
(in-package :aoc/2024/19)
|
||||||
|
|
||||||
|
|
||||||
|
(defun parse-line (line)
|
||||||
|
(ppcre:split ", " line))
|
||||||
|
|
||||||
|
(defstruct onsen towels patterns)
|
||||||
|
(defun parse-input (lines)
|
||||||
|
(make-onsen
|
||||||
|
:towels (parse-line (first lines))
|
||||||
|
:patterns (mapcar (compose #'first #'parse-line) (subseq lines 2))))
|
||||||
|
|
||||||
|
(defparameter input-text (test-input 2024 19))
|
||||||
|
(defparameter input-data (parse-input input-text))
|
||||||
|
|
||||||
|
(defparameter sample-text (aoc:split-lines "r, wr, b, g, bwu, rb, gb, br
|
||||||
|
|
||||||
|
brwrr
|
||||||
|
bggr
|
||||||
|
gbbr
|
||||||
|
rrbgbr
|
||||||
|
ubwu
|
||||||
|
bwurrg
|
||||||
|
brgr
|
||||||
|
bbrgwb"))
|
||||||
|
(defparameter sample-data
|
||||||
|
(parse-input sample-text))
|
||||||
|
|
||||||
|
(defstruct node
|
||||||
|
name
|
||||||
|
terminates
|
||||||
|
next)
|
||||||
|
|
||||||
|
(defun towel-tree (towels word)
|
||||||
|
(let ((towel-tree (make-hash-table))
|
||||||
|
(terminates nil))
|
||||||
|
(loop
|
||||||
|
for towel in towels
|
||||||
|
if (emptyp towel
|
||||||
|
do (setf terminates t)
|
||||||
|
else
|
||||||
|
do (setf (gethash (char towel 0) towel-tree)
|
||||||
|
(sort
|
||||||
|
(let ((r (subseq towel 1)))
|
||||||
|
(cons r (gethash (char towel 0) towel-tree)))
|
||||||
|
#'(lambda (a b)
|
||||||
|
(cond
|
||||||
|
((< (length a) (length b)) t)
|
||||||
|
((> (length a) (length b)) nil)
|
||||||
|
(t (string-lessp a b)))
|
||||||
|
))))
|
||||||
|
(loop
|
||||||
|
for k being the hash-keys in towel-tree
|
||||||
|
for v being the hash-values in towel-tree
|
||||||
|
do (setf (gethash k towel-tree) (towel-tree v (concatenate 'string word (list k))))
|
||||||
|
)
|
||||||
|
(make-node
|
||||||
|
:name word
|
||||||
|
:terminates terminates
|
||||||
|
:next towel-tree)))
|
||||||
|
|
||||||
|
(defun show-tree (tree &optional (depth 0))
|
||||||
|
(loop
|
||||||
|
for k being the hash-keys in (node-next tree)
|
||||||
|
for v being the hash-values in (node-next tree)
|
||||||
|
do (format t "~v@{~A~:*~}" depth " ")
|
||||||
|
(format t "~A(~A)~%" k (if (node-terminates v) " OK" ""))
|
||||||
|
(show-tree v (1+ depth))))
|
||||||
|
|
||||||
|
(defun valid-pattern-p-old (og-tree pattern)
|
||||||
|
(defun check (tree pattern word words)
|
||||||
|
(let ((terminate (node-terminates tree)))
|
||||||
|
(if (emptyp pattern)
|
||||||
|
terminate
|
||||||
|
(let* ((c (char pattern 0))
|
||||||
|
(np (subseq pattern 1))
|
||||||
|
(nw (concatenate 'string word (list c))))
|
||||||
|
(or
|
||||||
|
(if-let ((nt (gethash c (node-next tree))))
|
||||||
|
(check nt np nw words))
|
||||||
|
(and terminate
|
||||||
|
(if-let ((nt (gethash c (node-next og-tree))))
|
||||||
|
(check nt np "" (cons word words))
|
||||||
|
))
|
||||||
|
)))))
|
||||||
|
(check og-tree pattern "" '()))
|
||||||
|
|
||||||
|
(defvar *patterns* (make-hash-table :test #'equal))
|
||||||
|
(defvar *valid-patterns* (make-hash-table :test #'equal))
|
||||||
|
(defvar *possible-patterns* (make-hash-table :test #'equal))
|
||||||
|
(defun reset-patterns ()
|
||||||
|
(setf *patterns* (make-hash-table :test #'equal))
|
||||||
|
(setf *valid-patterns* (make-hash-table :test #'equal))
|
||||||
|
(setf *possible-patterns* (make-hash-table :test #'equal))
|
||||||
|
)
|
||||||
|
|
||||||
|
(defun string-prefix-p (prefix string)
|
||||||
|
(and
|
||||||
|
(>= (length string) (length prefix))
|
||||||
|
(equal prefix (subseq string 0 (length prefix)))))
|
||||||
|
|
||||||
|
(defun remaining-patterns (towels pattern)
|
||||||
|
(or
|
||||||
|
(gethash pattern *patterns*)
|
||||||
|
(let ((remaining (loop
|
||||||
|
for towel in towels
|
||||||
|
if (string-prefix-p towel pattern)
|
||||||
|
collect (subseq pattern (length towel))
|
||||||
|
)))
|
||||||
|
(setf (gethash pattern *patterns*) remaining))))
|
||||||
|
|
||||||
|
(defun valid-pattern-p (towels pattern)
|
||||||
|
(multiple-value-bind (is-valid found)
|
||||||
|
(gethash pattern *valid-patterns*)
|
||||||
|
(if found
|
||||||
|
is-valid
|
||||||
|
(setf (gethash pattern *valid-patterns*)
|
||||||
|
(if (emptyp pattern)
|
||||||
|
t
|
||||||
|
(if-let (ps (remaining-patterns towels pattern))
|
||||||
|
(loop
|
||||||
|
for p in ps
|
||||||
|
for pok = (valid-pattern-p towels p)
|
||||||
|
thereis pok
|
||||||
|
)))))
|
||||||
|
))
|
||||||
|
|
||||||
|
(defun towels-to-regex (onsen)
|
||||||
|
(format nil "^(~{~A~^|~})*$" (onsen-towels onsen)))
|
||||||
|
|
||||||
|
(defun valid-patterns (onsen)
|
||||||
|
(reset-patterns)
|
||||||
|
(loop
|
||||||
|
for pattern in (onsen-patterns onsen)
|
||||||
|
if (valid-pattern-p (onsen-towels onsen) pattern)
|
||||||
|
collect pattern))
|
||||||
|
|
||||||
|
(defun possible-patterns (towels pattern)
|
||||||
|
(multiple-value-bind (is-valid found)
|
||||||
|
(gethash pattern *possible-patterns*)
|
||||||
|
(format t "~A ~A ~A~%" pattern is-valid found)
|
||||||
|
(if found
|
||||||
|
(if is-valid 1 0)
|
||||||
|
(setf (gethash pattern *possible-patterns*)
|
||||||
|
(if (emptyp pattern)
|
||||||
|
1
|
||||||
|
(if-let (ps (remaining-patterns towels pattern))
|
||||||
|
(loop
|
||||||
|
for p in ps
|
||||||
|
for n = (possible-patterns towels p)
|
||||||
|
sum n
|
||||||
|
)
|
||||||
|
0))))
|
||||||
|
))
|
||||||
|
|
||||||
|
(defun part1 (onsen)
|
||||||
|
(format nil "~A" (length (valid-patterns onsen))))
|
||||||
|
|
||||||
|
(defun part2 (data)
|
||||||
|
(length data))
|
||||||
|
|
||||||
|
(defun solve-day ()
|
||||||
|
(format t "part1: ~A~%" (part1 input-data))
|
||||||
|
(format t "part2: ~A~%" (part2 input-data)))
|
||||||
|
|
||||||
|
(defun submit ()
|
||||||
|
(let ((p1 (part1 input-data))
|
||||||
|
(p2 (part2 input-data)))
|
||||||
|
(if p1 (submit-part1 2024 19 p1))
|
||||||
|
(if p2 (submit-part2 2024 19 p2))))
|
84
tests/2024/day19-test.lisp
Normal file
84
tests/2024/day19-test.lisp
Normal file
|
@ -0,0 +1,84 @@
|
||||||
|
(defpackage :aoc/2024/19/tests
|
||||||
|
(:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/19))
|
||||||
|
|
||||||
|
(in-package :aoc/2024/19/tests)
|
||||||
|
|
||||||
|
(define-test suite-2024-19
|
||||||
|
;:parent suite-2024
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-test test-valid-pattern-p
|
||||||
|
:parent suite-2024-19
|
||||||
|
(let ((tt (onsen-towels sample-data)))
|
||||||
|
(false (valid-pattern-p tt "z"))
|
||||||
|
(true (valid-pattern-p tt "r"))
|
||||||
|
(true (valid-pattern-p tt "rb"))
|
||||||
|
(false (valid-pattern-p tt "bw"))
|
||||||
|
(true (valid-pattern-p tt "gbb"))
|
||||||
|
|
||||||
|
;;brwrr can be made with a br towel, then a wr towel, and then finally an r towel.
|
||||||
|
(true (valid-pattern-p tt "brwrr"))
|
||||||
|
;;bggr can be made with a b towel, two g towels, and then an r towel.
|
||||||
|
(true (valid-pattern-p tt "bggr"))
|
||||||
|
;; gbbr can be made with a gb towel and then a br towel.
|
||||||
|
(true (valid-pattern-p tt "gbbr"))
|
||||||
|
;; rrbgbr can be made with r, rb, g, and br.
|
||||||
|
(true (valid-pattern-p tt "rrbgbr"))
|
||||||
|
;; ubwu is impossible.
|
||||||
|
(false (valid-pattern-p tt "ubwu"))
|
||||||
|
;; bwurrg can be made with bwu, r, r, and g.
|
||||||
|
(true (valid-pattern-p tt "bwurrg"))
|
||||||
|
;; brgr can be made with br, g, and r.
|
||||||
|
(true (valid-pattern-p tt "brgr"))
|
||||||
|
;; bbrgwb is impossible.
|
||||||
|
(false (valid-pattern-p tt "bbrgwb")))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-test test-possible-patterns
|
||||||
|
:parent suite-2024-19
|
||||||
|
(reset-patterns)
|
||||||
|
(let ((tt (onsen-towels sample-data)))
|
||||||
|
(is = 0 (possible-patterns tt "z"))
|
||||||
|
(is = 1 (possible-patterns tt "r"))
|
||||||
|
(is = 2 (possible-patterns tt "rb"))
|
||||||
|
(is = 0 (possible-patterns tt "bw"))
|
||||||
|
(is = 2 (possible-patterns tt "gbb"))
|
||||||
|
|
||||||
|
;;brwrr can be made with a br towel, then a wr towel, and then finally an r towel.
|
||||||
|
(is = 2 (possible-patterns tt "brwrr"))
|
||||||
|
;;bggr can be made with a b towel, two g towels, and then an r towel.
|
||||||
|
(is = 1 (possible-patterns tt "bggr"))
|
||||||
|
;; gbbr can be made with a gb towel and then a br towel.
|
||||||
|
(is = 4 (possible-patterns tt "gbbr"))
|
||||||
|
;; rrbgbr can be made with r, rb, g, and br.
|
||||||
|
(is = 6 (possible-patterns tt "rrbgbr"))
|
||||||
|
;; ubwu is impossible.
|
||||||
|
(is = 0 (possible-patterns tt "ubwu"))
|
||||||
|
;; bwurrg can be made with bwu, r, r, and g.
|
||||||
|
(is = 1 (possible-patterns tt "bwurrg"))
|
||||||
|
;; brgr can be made with br, g, and r.
|
||||||
|
(is = 2 (possible-patterns tt "brgr"))
|
||||||
|
;; bbrgwb is impossible.
|
||||||
|
(is = 0 (possible-patterns tt "bbrgwb")))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define-test test-bar
|
||||||
|
:parent suite-2024-19
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define-test+run test-part1
|
||||||
|
:parent suite-2024-19
|
||||||
|
(is equal "6" (part1 sample-data)))
|
||||||
|
|
||||||
|
(define-test+run test-part2
|
||||||
|
:parent suite-2024-19
|
||||||
|
(is equal nil (part2 sample-data)))
|
||||||
|
|
||||||
|
(defun run-tests ()
|
||||||
|
(test 'suite-2024-19))
|
Loading…
Reference in a new issue