From c611d65437e52532ab3d4ad78bac078ffaa8b228 Mon Sep 17 00:00:00 2001 From: Peter Tillemans Date: Thu, 19 Dec 2024 13:02:16 +0100 Subject: [PATCH] day 19 part 1 done --- aoc.asd | 2 + src/2024/day18.lisp | 14 --- src/2024/day19.lisp | 188 +++++++++++++++++++++++++++++++++++++ tests/2024/day19-test.lisp | 84 +++++++++++++++++ 4 files changed, 274 insertions(+), 14 deletions(-) create mode 100644 src/2024/day19.lisp create mode 100644 tests/2024/day19-test.lisp diff --git a/aoc.asd b/aoc.asd index 3eeeea6..4e0d649 100644 --- a/aoc.asd +++ b/aoc.asd @@ -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))) diff --git a/src/2024/day18.lisp b/src/2024/day18.lisp index f4a25c1..093efcd 100644 --- a/src/2024/day18.lisp +++ b/src/2024/day18.lisp @@ -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 diff --git a/src/2024/day19.lisp b/src/2024/day19.lisp new file mode 100644 index 0000000..e5ece2d --- /dev/null +++ b/src/2024/day19.lisp @@ -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)))) diff --git a/tests/2024/day19-test.lisp b/tests/2024/day19-test.lisp new file mode 100644 index 0000000..f016c08 --- /dev/null +++ b/tests/2024/day19-test.lisp @@ -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))