pti/aoc-cl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

day 19 part 1 done

Browse source
This commit is contained in:
Peter Tillemans 2024-12-19 13:02:16 +01:00
parent 72e1b88b45
commit c611d65437
4 changed files with 274 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
aoc.asd
View file

@ -47,6 +47,7 @@
(:file "2024/day16")
(:file "2024/day17")
(:file "2024/day18")
(:file "2024/day19")
)))
:description "Advent of Code challenges and solutions."
:long-description "Solutions for the AOC challenges."
@ -81,6 +82,7 @@
(:file "2024/day16-test")
(:file "2024/day17-test")
(:file "2024/day18-test")
(:file "2024/day19-test")
)))
:description "Test system for aoc"
:perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))

14
src/2024/day18.lisp
View file

@ -27,19 +27,6 @@
(#\> (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)
(aref map (pos-y pos) (pos-x pos)))
@ -186,7 +173,6 @@
(best-tm 0))
(loop
for x = 1
do (format t "delta: ~A, tm: ~A, best-tm: ~A~%" delta tm best-tm)
until (zerop delta)
if (best-path mem tm)
do (progn

188
src/2024/day19.lisp Normal file
View 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
View 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))